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 20 72 70 63 29 0a 28 xtras tcp rpc).(
02b0: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 import (prefix r
02c0: 70 63 20 72 70 63 3a 29 29 0a 0a 28 75 73 65 20 pc rpc:))..(use
02d0: 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 sqlite3 srfi-1 p
02e0: 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 78 osix regex regex
02f0: 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 63 73 -case srfi-69 cs
0300: 76 2d 78 6d 6c 20 73 31 31 6e 20 7a 6d 71 29 0a v-xml s11n zmq).
0310: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
0320: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
0330: 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e ))..(declare (un
0340: 69 74 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 it db)).(declare
0350: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
0360: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6b (declare (uses k
0370: 65 79 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 eys)).(declare (
0380: 75 73 65 73 20 6f 64 73 29 29 0a 0a 28 69 6e 63 uses ods))..(inc
0390: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
03a0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
03b0: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records.
03c0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
03d0: 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 key_records.scm"
03e0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f ).(include "run_
03f0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b records.scm")..;
0400: 3b 20 74 69 6d 65 73 74 61 6d 70 20 74 79 70 65 ; timestamp type
0410: 20 28 76 61 6c 31 20 76 61 6c 32 20 2e 2e 2e 29 (val1 val2 ...)
0420: 0a 3b 3b 20 74 79 70 65 3a 20 6d 65 74 61 2d 69 .;; type: meta-i
0430: 6e 66 6f 2c 20 73 74 65 70 0a 28 64 65 66 69 6e nfo, step.(defin
0440: 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 e *incoming-data
0450: 2a 20 20 20 20 20 20 27 28 29 29 0a 28 64 65 66 * '()).(def
0460: 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6c 61 ine *incoming-la
0470: 73 74 2d 74 69 6d 65 2a 20 28 63 75 72 72 65 6e st-time* (curren
0480: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 t-seconds)).(def
0490: 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 ine *incoming-mu
04a0: 74 65 78 2a 20 20 20 20 20 28 6d 61 6b 65 2d 6d tex* (make-m
04b0: 75 74 65 78 29 29 0a 28 64 65 66 69 6e 65 20 2a utex)).(define *
04c0: 63 61 63 68 65 2d 6f 6e 2a 20 23 66 29 0a 0a 28 cache-on* #f)..(
04d0: 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 73 define (db:set-s
04e0: 79 6e 63 20 64 62 29 0a 20 20 28 6c 65 74 2a 20 ync db). (let*
04f0: 28 28 73 79 6e 63 76 61 6c 20 20 28 63 6f 6e 66 ((syncval (conf
0500: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
0510: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 20 20 gdat* "setup"
0520: 20 20 22 73 79 6e 63 68 72 6f 6e 6f 75 73 22 29 "synchronous")
0530: 29 0a 09 20 28 76 61 6c 20 20 20 20 20 20 28 63 ).. (val (c
0540: 6f 6e 64 20 20 20 3b 3b 20 30 20 7c 20 4f 46 46 ond ;; 0 | OFF
0550: 20 7c 20 31 20 7c 20 4e 4f 52 4d 41 4c 20 7c 20 | 1 | NORMAL |
0560: 32 20 7c 20 46 55 4c 4c 3b 0a 09 09 20 20 20 20 2 | FULL;...
0570: 28 28 6e 6f 74 20 73 79 6e 63 76 61 6c 29 20 23 ((not syncval) #
0580: 66 29 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e f)... ((strin
0590: 67 2d 3e 6e 75 6d 62 65 72 20 73 79 6e 63 76 61 g->number syncva
05a0: 6c 29 0a 09 09 20 20 20 20 20 28 6c 65 74 20 28 l)... (let (
05b0: 28 76 61 6c 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (val (string->nu
05c0: 6d 62 65 72 20 73 79 6e 63 76 61 6c 29 29 29 0a mber syncval))).
05d0: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 .. (if (me
05e0: 6d 62 65 72 20 76 61 6c 20 27 28 30 20 31 20 32 mber val '(0 1 2
05f0: 29 29 20 76 61 6c 20 23 66 29 29 29 0a 09 09 20 )) val #f)))...
0600: 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 63 ((string-matc
0610: 68 20 28 72 65 67 65 78 70 20 22 79 65 73 22 20 h (regexp "yes"
0620: 23 74 29 20 73 79 6e 63 76 61 6c 29 20 31 29 0a #t) syncval) 1).
0630: 09 09 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d .. ((string-m
0640: 61 74 63 68 20 28 72 65 67 65 78 70 20 22 6e 6f atch (regexp "no
0650: 22 20 20 23 74 29 20 73 79 6e 63 76 61 6c 29 20 " #t) syncval)
0660: 30 29 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e 0)... ((strin
0670: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
0680: 22 28 6f 66 66 7c 6e 6f 72 6d 61 6c 7c 66 75 6c "(off|normal|ful
0690: 6c 29 22 20 23 74 29 20 73 79 6e 63 76 61 6c 29 l)" #t) syncval)
06a0: 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 20 syncval)...
06b0: 28 65 6c 73 65 20 0a 09 09 20 20 20 20 20 28 64 (else ... (d
06c0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
06d0: 52 4f 52 3a 20 73 79 6e 63 68 72 6f 6e 6f 75 73 ROR: synchronous
06e0: 20 6d 75 73 74 20 62 65 20 30 2c 31 2c 32 2c 4f must be 0,1,2,O
06f0: 46 46 2c 4e 4f 52 4d 41 4c 20 6f 72 20 46 55 4c FF,NORMAL or FUL
0700: 4c 2c 20 79 6f 75 20 70 72 6f 76 69 64 65 64 3a L, you provided:
0710: 20 22 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 " syncval)...
0720: 20 20 20 23 66 29 29 29 29 0a 20 20 20 20 28 69 #f)))). (i
0730: 66 20 76 61 6c 0a 09 28 62 65 67 69 6e 0a 09 20 f val..(begin..
0740: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
0750: 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d 73 79 fo 11 "db:set-sy
0760: 6e 63 2c 20 73 65 74 74 69 6e 67 20 70 72 61 67 nc, setting prag
0770: 6d 61 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 74 ma synchronous t
0780: 6f 20 22 20 76 61 6c 29 0a 09 20 20 28 73 71 6c o " val).. (sql
0790: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
07a0: 28 63 6f 6e 63 20 22 50 52 41 47 4d 41 20 73 79 (conc "PRAGMA sy
07b0: 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 27 22 20 76 nchronous = '" v
07c0: 61 6c 20 22 27 3b 22 29 29 29 29 29 29 0a 0a 28 al "';"))))))..(
07d0: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 64 62 29 define (open-db)
07e0: 20 3b 3b 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 ;; (conc *topp
07f0: 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e ath* "/megatest.
0800: 64 62 22 29 20 28 63 61 72 20 2a 63 6f 6e 66 69 db") (car *confi
0810: 67 69 6e 66 6f 2a 29 29 29 0a 20 20 28 69 66 20 ginfo*))). (if
0820: 28 6e 6f 74 20 2a 74 6f 70 70 61 74 68 2a 29 28 (not *toppath*)(
0830: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a setup-for-run)).
0840: 20 20 28 6c 65 74 2a 20 28 28 64 62 70 61 74 68 (let* ((dbpath
0850: 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 (conc *toppa
0860: 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 th* "/megatest.d
0870: 62 22 29 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 b")) ;; fname)..
0880: 20 28 64 62 65 78 69 73 74 73 20 20 28 66 69 6c (dbexists (fil
0890: 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 e-exists? dbpath
08a0: 29 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 20 )).. (db
08b0: 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 (sqlite3:open-da
08c0: 74 61 62 61 73 65 20 64 62 70 61 74 68 29 29 20 tabase dbpath))
08d0: 3b 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 ;; (never-give-u
08e0: 70 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 p-open-db dbpath
08f0: 29 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 )).. (handler
0900: 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f (make-busy-timeo
0910: 75 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 ut (if (args:get
0920: 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d -arg "-override-
0930: 74 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 20 timeout")......
0940: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
0950: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
0960: 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f "-override-timeo
0970: 75 74 22 29 29 0a 09 09 09 09 09 20 20 20 31 33 ut"))...... 13
0980: 36 30 30 30 29 29 29 29 20 3b 3b 20 31 33 36 30 6000)))) ;; 1360
0990: 30 30 29 29 29 20 3b 3b 20 31 33 36 30 30 30 20 00))) ;; 136000
09a0: 3d 20 32 2e 32 20 6d 69 6e 75 74 65 73 0a 20 20 = 2.2 minutes.
09b0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
09c0: 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 64 62 2c nfo 11 "open-db,
09d0: 20 64 62 70 61 74 68 3d 22 20 64 62 70 61 74 68 dbpath=" dbpath
09e0: 20 22 20 61 72 67 76 3d 22 20 28 61 72 67 76 29 " argv=" (argv)
09f0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 73 ). (sqlite3:s
0a00: 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 et-busy-handler!
0a10: 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 20 20 db handler).
0a20: 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 73 (if (not dbexis
0a30: 74 73 29 0a 09 28 64 62 3a 69 6e 69 74 69 61 6c ts)..(db:initial
0a40: 69 7a 65 20 64 62 29 29 0a 20 20 20 20 28 64 62 ize db)). (db
0a50: 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 :set-sync db).
0a60: 20 20 64 62 29 29 0a 0a 3b 3b 20 6b 65 65 70 69 db))..;; keepi
0a70: 6e 67 20 69 74 20 61 72 6f 75 6e 64 20 66 6f 72 ng it around for
0a80: 20 64 65 62 75 67 67 69 6e 67 20 70 75 72 70 6f debugging purpo
0a90: 73 65 73 20 6f 6e 6c 79 0a 28 64 65 66 69 6e 65 ses only.(define
0aa0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
0ab0: 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 -no-exception-ha
0ac0: 6e 64 6c 69 6e 67 20 20 70 72 6f 63 20 69 64 62 ndling proc idb
0ad0: 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 64 65 . params). (de
0ae0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
0af0: 31 20 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 1 "open-run-clos
0b00: 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 e-no-exception-h
0b10: 61 6e 64 6c 69 6e 67 20 53 54 41 52 54 20 67 69 andling START gi
0b20: 76 65 6e 20 61 20 64 62 3d 22 20 28 69 66 20 69 ven a db=" (if i
0b30: 64 62 20 22 79 65 73 20 22 20 22 6e 6f 20 22 29 db "yes " "no ")
0b40: 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 ", params=" par
0b50: 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 ams). (let* ((d
0b60: 62 20 20 20 28 69 66 20 69 64 62 20 0a 09 09 20 b (if idb ...
0b70: 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 72 65 (if (procedure
0b80: 3f 20 69 64 62 29 0a 09 09 20 20 20 20 20 20 20 ? idb)...
0b90: 28 69 64 62 29 0a 09 09 20 20 20 20 20 20 20 69 (idb)... i
0ba0: 64 62 29 0a 09 09 20 20 20 28 6f 70 65 6e 2d 64 db)... (open-d
0bb0: 62 29 29 29 0a 09 20 28 72 65 73 20 23 66 29 29 b))).. (res #f))
0bc0: 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 . (set! res (
0bd0: 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 70 61 apply proc db pa
0be0: 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 20 28 rams)). (if (
0bf0: 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 65 33 not idb)(sqlite3
0c00: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
0c10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0c20: 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 -info 11 "open-r
0c30: 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 un-close-no-exce
0c40: 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 45 ption-handling E
0c50: 4e 44 22 20 29 0a 20 20 20 20 72 65 73 29 29 0a ND" ). res)).
0c60: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 72 .(define (open-r
0c70: 75 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70 74 69 un-close-excepti
0c80: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 on-handling proc
0c90: 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 idb . params).
0ca0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
0cb0: 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 28 62 ons. exn. (b
0cc0: 65 67 69 6e 0a 20 20 20 20 20 28 64 65 62 75 67 egin. (debug
0cd0: 3a 70 72 69 6e 74 20 30 20 22 45 58 43 45 50 54 :print 0 "EXCEPT
0ce0: 49 4f 4e 3a 20 64 61 74 61 62 61 73 65 20 70 72 ION: database pr
0cf0: 6f 62 61 62 6c 79 20 6f 76 65 72 6c 6f 61 64 65 obably overloade
0d00: 64 3f 22 29 0a 20 20 20 20 20 28 64 65 62 75 67 d?"). (debug
0d10: 3a 70 72 69 6e 74 20 30 20 22 20 20 22 20 28 28 :print 0 " " ((
0d20: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
0d30: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
0d40: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
0d50: 0a 20 20 20 20 20 28 70 72 69 6e 74 2d 63 61 6c . (print-cal
0d60: 6c 2d 63 68 61 69 6e 29 0a 20 20 20 20 20 28 74 l-chain). (t
0d70: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 72 61 hread-sleep! (ra
0d80: 6e 64 6f 6d 20 31 32 30 29 29 0a 20 20 20 20 20 ndom 120)).
0d90: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
0da0: 6f 20 30 20 22 74 72 79 69 6e 67 20 64 62 20 63 o 0 "trying db c
0db0: 61 6c 6c 20 6f 6e 65 20 6d 6f 72 65 20 74 69 6d all one more tim
0dc0: 65 2e 2e 2e 2e 22 29 0a 20 20 20 20 20 28 61 70 e...."). (ap
0dd0: 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ply open-run-clo
0de0: 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d se-no-exception-
0df0: 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 20 69 64 handling proc id
0e00: 62 20 70 61 72 61 6d 73 29 29 0a 20 20 20 28 61 b params)). (a
0e10: 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c pply open-run-cl
0e20: 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e ose-no-exception
0e30: 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 20 69 -handling proc i
0e40: 64 62 20 70 61 72 61 6d 73 29 29 29 0a 0a 28 64 db params)))..(d
0e50: 65 66 69 6e 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 efine open-run-c
0e60: 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c lose open-run-cl
0e70: 6f 73 65 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 ose-exception-ha
0e80: 6e 64 6c 69 6e 67 29 0a 0a 28 64 65 66 69 6e 65 ndling)..(define
0e90: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 *global-delta*
0ea0: 30 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 73 74 0).(define *last
0eb0: 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 -global-delta-pr
0ec0: 69 6e 74 65 64 2a 20 30 29 0a 0a 28 64 65 66 69 inted* 0)..(defi
0ed0: 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ne (open-run-clo
0ee0: 73 65 2d 6d 65 61 73 75 72 65 20 20 70 72 6f 63 se-measure proc
0ef0: 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 idb . params).
0f00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
0f10: 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 75 6e 2d fo 11 "open-run-
0f20: 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 53 54 close-measure ST
0f30: 41 52 54 2c 20 69 64 62 3d 22 20 69 64 62 20 22 ART, idb=" idb "
0f40: 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 61 6d , params=" param
0f50: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 s). (let* ((sta
0f60: 72 74 2d 6d 73 20 28 63 75 72 72 65 6e 74 2d 6d rt-ms (current-m
0f70: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 20 illiseconds))..
0f80: 28 64 62 20 20 20 20 20 20 20 28 69 66 20 69 64 (db (if id
0f90: 62 20 69 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 b idb (open-db))
0fa0: 29 0a 20 20 20 20 20 20 20 20 20 28 74 68 72 6f ). (thro
0fb0: 74 74 6c 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ttle (string->nu
0fc0: 6d 62 65 72 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f mber (config-loo
0fd0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
0fe0: 22 73 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c "setup" "throttl
0ff0: 65 22 29 29 29 29 0a 20 20 20 20 28 64 62 3a 73 e")))). (db:s
1000: 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 20 20 et-sync db).
1010: 28 73 65 74 21 20 72 65 73 20 20 20 20 20 20 28 (set! res (
1020: 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 70 61 apply proc db pa
1030: 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 20 28 rams)). (if (
1040: 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 65 33 not idb)(sqlite3
1050: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a :finalize! db)).
1060: 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 79 20 ;; scale by
1070: 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 74 68 10, average with
1080: 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 2e 0a current value..
1090: 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 (set! *globa
10a0: 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b 20 2a l-delta* (/ (+ *
10b0: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2a global-delta* (*
10c0: 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c (- (current-mil
10d0: 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 liseconds) start
10e0: 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 66 20 -ms)....... (if
10f0: 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 74 6c throttle throttl
1100: 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 20 20 e 0.01)))....
1110: 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 3e 20 2)). (if (>
1120: 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d 67 6c (abs (- *last-gl
1130: 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 obal-delta-print
1140: 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 ed* *global-delt
1150: 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 64 6f a*)) 0.08) ;; do
1160: 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 74 68 n't print all th
1170: 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 66 20 e time, only if
1180: 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 69 74 it changes a bit
1190: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
11a0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
11b0: 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 6c 65 "launch throttle
11c0: 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f 62 61 factor=" *globa
11d0: 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 73 65 l-delta*).. (se
11e0: 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d t! *last-global-
11f0: 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 2a delta-printed* *
1200: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 29 global-delta*)))
1210: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
1220: 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d t-info 11 "open-
1230: 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 run-close-measur
1240: 65 20 45 4e 44 22 20 29 0a 20 20 20 20 72 65 73 e END" ). res
1250: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
1260: 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 0a 20 initialize db).
1270: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1280: 66 6f 20 31 31 20 22 64 62 3a 69 6e 69 74 69 61 fo 11 "db:initia
1290: 6c 69 7a 65 20 53 54 41 52 54 22 29 0a 20 20 28 lize START"). (
12a0: 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 64 61 74 let* ((configdat
12b0: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
12c0: 6f 2a 29 29 20 20 3b 3b 20 74 75 74 20 74 75 74 o*)) ;; tut tut
12d0: 2c 20 67 6c 6f 62 61 6c 20 77 61 72 6e 69 6e 67 , global warning
12e0: 2e 2e 2e 0a 09 20 28 6b 65 79 73 20 20 20 20 20 ..... (keys
12f0: 28 63 6f 6e 66 69 67 2d 67 65 74 2d 66 69 65 6c (config-get-fiel
1300: 64 73 20 63 6f 6e 66 69 67 64 61 74 29 29 0a 09 ds configdat))..
1310: 20 28 68 61 76 65 6b 65 79 73 20 28 3e 20 28 6c (havekeys (> (l
1320: 65 6e 67 74 68 20 6b 65 79 73 29 20 30 29 29 0a ength keys) 0)).
1330: 09 20 28 6b 65 79 73 74 72 20 20 20 28 6b 65 79 . (keystr (key
1340: 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 29 s->keystr keys))
1350: 0a 09 20 28 66 69 65 6c 64 73 74 72 20 28 6b 65 .. (fieldstr (ke
1360: 79 73 2d 3e 6b 65 79 2f 66 69 65 6c 64 20 6b 65 ys->key/field ke
1370: 79 73 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 ys))). (for-e
1380: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 ach (lambda (key
1390: 29 0a 09 09 28 6c 65 74 20 28 28 6b 65 79 6e 20 )...(let ((keyn
13a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 79 20 (vector-ref key
13b0: 30 29 29 29 0a 09 09 20 20 28 69 66 20 28 6d 65 0)))... (if (me
13c0: 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 64 6f 77 mber (string-dow
13d0: 6e 63 61 73 65 20 6b 65 79 6e 29 0a 09 09 09 20 ncase keyn)....
13e0: 20 20 20 20 20 28 6c 69 73 74 20 22 72 75 6e 6e (list "runn
13f0: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 ame" "state" "st
1400: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 atus" "owner" "e
1410: 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d vent_time" "comm
1420: 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 ent" "fail_count
1430: 22 0a 09 09 09 09 20 20 20 20 22 70 61 73 73 5f "..... "pass_
1440: 63 6f 75 6e 74 22 29 29 0a 09 09 20 20 20 20 20 count"))...
1450: 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e (begin....(prin
1460: 74 20 22 45 52 52 4f 52 3a 20 79 6f 75 72 20 6b t "ERROR: your k
1470: 65 79 20 63 61 6e 6e 6f 74 20 62 65 20 6e 61 6d ey cannot be nam
1480: 65 64 20 22 20 6b 65 79 6e 20 22 20 61 73 20 74 ed " keyn " as t
1490: 68 69 73 20 63 6f 6e 66 6c 69 63 74 73 20 77 69 his conflicts wi
14a0: 74 68 20 74 68 65 20 73 61 6d 65 20 6e 61 6d 65 th the same name
14b0: 64 20 66 69 65 6c 64 20 69 6e 20 74 68 65 20 72 d field in the r
14c0: 75 6e 73 20 74 61 62 6c 65 22 29 0a 09 09 09 28 uns table")....(
14d0: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d system (conc "rm
14e0: 20 2d 66 20 22 20 64 62 70 61 74 68 29 29 0a 09 -f " dbpath))..
14f0: 09 09 28 65 78 69 74 20 31 29 29 29 29 29 0a 09 ..(exit 1)))))..
1500: 20 20 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 keys).
1510: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1520: 20 64 62 20 22 50 52 41 47 4d 41 20 73 79 6e 63 db "PRAGMA sync
1530: 68 72 6f 6e 6f 75 73 20 3d 20 4f 46 46 3b 22 29 hronous = OFF;")
1540: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
1550: 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 ecute db "CREATE
1560: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 TABLE IF NOT EX
1570: 49 53 54 53 20 6b 65 79 73 20 28 69 64 20 49 4e ISTS keys (id IN
1580: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
1590: 59 2c 20 66 69 65 6c 64 6e 61 6d 65 20 54 45 58 Y, fieldname TEX
15a0: 54 2c 20 66 69 65 6c 64 74 79 70 65 20 54 45 58 T, fieldtype TEX
15b0: 54 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 6b 65 T, CONSTRAINT ke
15c0: 79 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 yconstraint UNIQ
15d0: 55 45 20 28 66 69 65 6c 64 6e 61 6d 65 29 29 3b UE (fieldname));
15e0: 22 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 "). (for-each
15f0: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
1600: 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 .(sqlite3:execut
1610: 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 e db "INSERT INT
1620: 4f 20 6b 65 79 73 20 28 66 69 65 6c 64 6e 61 6d O keys (fieldnam
1630: 65 2c 66 69 65 6c 64 74 79 70 65 29 20 56 41 4c e,fieldtype) VAL
1640: 55 45 53 20 28 3f 2c 3f 29 3b 22 20 28 6b 65 79 UES (?,?);" (key
1650: 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b :get-fieldname k
1660: 65 79 29 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c ey)(key:get-fiel
1670: 64 74 79 70 65 20 6b 65 79 29 29 29 0a 09 20 20 dtype key)))..
1680: 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 73 keys). (s
1690: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
16a0: 62 20 28 63 6f 6e 63 20 0a 09 09 09 20 22 43 52 b (conc .... "CR
16b0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
16c0: 54 20 45 58 49 53 54 53 20 72 75 6e 73 20 28 69 T EXISTS runs (i
16d0: 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 d INTEGER PRIMAR
16e0: 59 20 4b 45 59 2c 20 22 20 0a 09 09 09 20 66 69 Y KEY, " .... fi
16f0: 65 6c 64 73 74 72 20 28 69 66 20 68 61 76 65 6b eldstr (if havek
1700: 65 79 73 20 22 2c 22 20 22 22 29 0a 09 09 09 20 eys "," "")....
1710: 22 72 75 6e 6e 61 6d 65 20 54 45 58 54 2c 22 0a "runname TEXT,".
1720: 09 09 09 20 22 73 74 61 74 65 20 54 45 58 54 20 ... "state TEXT
1730: 44 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 DEFAULT '',"....
1740: 20 22 73 74 61 74 75 73 20 54 45 58 54 20 44 45 "status TEXT DE
1750: 46 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 FAULT '',".... "
1760: 6f 77 6e 65 72 20 54 45 58 54 20 44 45 46 41 55 owner TEXT DEFAU
1770: 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 65 76 65 LT '',".... "eve
1780: 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d nt_time TIMESTAM
1790: 50 2c 22 0a 09 09 09 20 22 63 6f 6d 6d 65 6e 74 P,".... "comment
17a0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
17b0: 2c 22 0a 09 09 09 20 22 66 61 69 6c 5f 63 6f 75 ,".... "fail_cou
17c0: 6e 74 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 nt INTEGER DEFAU
17d0: 4c 54 20 30 2c 22 0a 09 09 09 20 22 70 61 73 73 LT 0,".... "pass
17e0: 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 _count INTEGER D
17f0: 45 46 41 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 EFAULT 0,".... "
1800: 43 4f 4e 53 54 52 41 49 4e 54 20 72 75 6e 73 63 CONSTRAINT runsc
1810: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
1820: 20 28 72 75 6e 6e 61 6d 65 22 20 28 69 66 20 68 (runname" (if h
1830: 61 76 65 6b 65 79 73 20 22 2c 22 20 22 22 29 20 avekeys "," "")
1840: 6b 65 79 73 74 72 20 22 29 29 3b 22 29 29 0a 20 keystr "));")).
1850: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
1860: 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 43 52 ute db (conc "CR
1870: 45 41 54 45 20 49 4e 44 45 58 20 72 75 6e 73 5f EATE INDEX runs_
1880: 69 6e 64 65 78 20 4f 4e 20 72 75 6e 73 20 28 72 index ON runs (r
1890: 75 6e 6e 61 6d 65 22 20 28 69 66 20 68 61 76 65 unname" (if have
18a0: 6b 65 79 73 20 22 2c 22 20 22 22 29 20 6b 65 79 keys "," "") key
18b0: 73 74 72 20 22 29 3b 22 29 29 0a 20 20 20 20 28 str ");")). (
18c0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
18d0: 64 62 20 0a 09 09 20 20 20 20 20 22 43 52 45 41 db ... "CREA
18e0: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
18f0: 45 58 49 53 54 53 20 74 65 73 74 73 20 0a 20 20 EXISTS tests .
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1910: 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 (id INTEGER PR
1920: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1940: 72 75 6e 5f 69 64 20 20 20 20 20 49 4e 54 45 47 run_id INTEG
1950: 45 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 ER,.
1960: 20 20 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d testnam
1970: 65 20 20 20 54 45 58 54 2c 0a 20 20 20 20 20 20 e TEXT,.
1980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 68 h
1990: 6f 73 74 20 20 20 20 20 20 20 54 45 58 54 20 44 ost TEXT D
19a0: 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 EFAULT 'n/a',.
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 20 63 70 75 6c 6f 61 64 20 20 20 20 52 45 cpuload RE
19d0: 41 4c 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 AL DEFAULT -1,.
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 20 20 64 69 73 6b 66 72 65 65 20 20 20 49 diskfree I
1a00: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 2d NTEGER DEFAULT -
1a10: 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1,.
1a20: 20 20 20 20 20 20 20 20 75 6e 61 6d 65 20 20 20 uname
1a30: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
1a40: 27 6e 2f 61 27 2c 20 0a 20 20 20 20 20 20 20 20 'n/a', .
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
1a60: 64 69 72 20 20 20 20 20 54 45 58 54 20 44 45 46 dir TEXT DEF
1a70: 41 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 AULT 'n/a',.
1a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a90: 20 73 68 6f 72 74 64 69 72 20 20 20 54 45 58 54 shortdir TEXT
1aa0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ac0: 20 20 69 74 65 6d 5f 70 61 74 68 20 20 54 45 58 item_path TEX
1ad0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af0: 20 20 20 73 74 61 74 65 20 20 20 20 20 20 54 45 state TE
1b00: 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f XT DEFAULT 'NOT_
1b10: 53 54 41 52 54 45 44 27 2c 0a 20 20 20 20 20 20 STARTED',.
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
1b30: 74 61 74 75 73 20 20 20 20 20 54 45 58 54 20 44 tatus TEXT D
1b40: 45 46 41 55 4c 54 20 27 46 41 49 4c 27 2c 0a 20 EFAULT 'FAIL',.
1b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b60: 20 20 20 20 61 74 74 65 6d 70 74 6e 75 6d 20 49 attemptnum I
1b70: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 NTEGER DEFAULT 0
1b80: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
1b90: 20 20 20 20 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 final_log
1ba0: 66 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 f TEXT DEFAULT '
1bb0: 6c 6f 67 73 2f 66 69 6e 61 6c 2e 6c 6f 67 27 2c logs/final.log',
1bc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1bd0: 20 20 20 20 20 20 6c 6f 67 64 61 74 20 20 20 20 logdat
1be0: 20 42 4c 4f 42 2c 20 0a 20 20 20 20 20 20 20 20 BLOB, .
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
1c00: 5f 64 75 72 61 74 69 6f 6e 20 49 4e 54 45 47 45 _duration INTEGE
1c10: 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 R DEFAULT 0,.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c30: 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 54 45 58 comment TEX
1c40: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c60: 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 event_time TI
1c70: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 fa
1c90: 69 6c 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 il_count INTEGER
1ca0: 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 DEFAULT 0,.
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cc0: 20 70 61 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 pass_count INTE
1cd0: 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 GER DEFAULT 0,.
1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cf0: 20 20 20 20 61 72 63 68 69 76 65 64 20 20 20 49 archived I
1d00: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 NTEGER DEFAULT 0
1d10: 2c 20 2d 2d 20 30 3d 6e 6f 2c 20 31 3d 69 6e 20 , -- 0=no, 1=in
1d20: 70 72 6f 67 72 65 73 73 2c 20 32 3d 79 65 73 0a progress, 2=yes.
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d40: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
1d50: 74 65 73 74 73 63 6f 6e 73 74 72 61 69 6e 74 20 testsconstraint
1d60: 55 4e 49 51 55 45 20 28 72 75 6e 5f 69 64 2c 20 UNIQUE (run_id,
1d70: 74 65 73 74 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 testname, item_p
1d80: 61 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 29 ath). )
1d90: 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ;"). (sqlite3
1da0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 :execute db "CRE
1db0: 41 54 45 20 49 4e 44 45 58 20 74 65 73 74 73 5f ATE INDEX tests_
1dc0: 69 6e 64 65 78 20 4f 4e 20 74 65 73 74 73 20 28 index ON tests (
1dd0: 72 75 6e 5f 69 64 2c 20 74 65 73 74 6e 61 6d 65 run_id, testname
1de0: 2c 20 69 74 65 6d 5f 70 61 74 68 29 3b 22 29 0a , item_path);").
1df0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
1e00: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 cute db "CREATE
1e10: 56 49 45 57 20 72 75 6e 73 5f 74 65 73 74 73 20 VIEW runs_tests
1e20: 41 53 20 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d AS SELECT * FROM
1e30: 20 72 75 6e 73 20 49 4e 4e 45 52 20 4a 4f 49 4e runs INNER JOIN
1e40: 20 74 65 73 74 73 20 4f 4e 20 72 75 6e 73 2e 69 tests ON runs.i
1e50: 64 3d 74 65 73 74 73 2e 72 75 6e 5f 69 64 3b 22 d=tests.run_id;"
1e60: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
1e70: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
1e80: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
1e90: 58 49 53 54 53 20 74 65 73 74 5f 73 74 65 70 73 XISTS test_steps
1ea0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ec0: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
1ed0: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY KEY,.
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ef0: 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 test_id
1f00: 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 20 20 INTEGER, .
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f20: 20 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d stepnam
1f30: 65 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 20 e TEXT, .
1f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f50: 20 20 20 20 20 20 20 20 73 74 61 74 65 20 54 45 state TE
1f60: 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f XT DEFAULT 'NOT_
1f70: 53 54 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 STARTED', .
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 status
1fa0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e TEXT DEFAULT 'n
1fb0: 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 /a',.
1fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fd0: 20 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 event_time T
1fe0: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 IMESTAMP,.
1ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2000: 20 20 20 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 comment
2010: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
2020: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
2030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2040: 20 6c 6f 67 66 69 6c 65 20 54 45 58 54 20 44 45 logfile TEXT DE
2050: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
2060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2070: 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 CONSTRA
2080: 49 4e 54 20 74 65 73 74 5f 73 74 65 70 73 5f 63 INT test_steps_c
2090: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
20a0: 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 (test_id,stepna
20b0: 6d 65 2c 73 74 61 74 65 29 29 3b 22 29 0a 20 20 me,state));").
20c0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
20d0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
20e0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
20f0: 53 20 65 78 74 72 61 64 61 74 20 28 69 64 20 49 S extradat (id I
2100: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
2110: 45 59 2c 20 72 75 6e 5f 69 64 20 49 4e 54 45 47 EY, run_id INTEG
2120: 45 52 2c 20 6b 65 79 20 54 45 58 54 2c 20 76 61 ER, key TEXT, va
2130: 6c 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 l TEXT);"). (
2140: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
2150: 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 db "CREATE TABLE
2160: 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 6d IF NOT EXISTS m
2170: 65 74 61 64 61 74 20 28 69 64 20 49 4e 54 45 47 etadat (id INTEG
2180: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 ER PRIMARY KEY,
2190: 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45 var TEXT, val TE
21a0: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 XT,.
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21c0: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
21d0: 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 metadat_constra
21e0: 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 int UNIQUE (var)
21f0: 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 );"). (sqlite
2200: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
2210: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
2220: 54 20 45 58 49 53 54 53 20 61 63 63 65 73 73 5f T EXISTS access_
2230: 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52 20 log (id INTEGER
2240: 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 75 73 65 PRIMARY KEY, use
2250: 72 20 54 45 58 54 2c 20 61 63 63 65 73 73 65 64 r TEXT, accessed
2260: 20 54 49 4d 45 53 54 41 4d 50 2c 20 61 72 67 73 TIMESTAMP, args
2270: 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 73 TEXT);"). (s
2280: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
2290: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
22a0: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 IF NOT EXISTS te
22b0: 73 74 5f 6d 65 74 61 20 28 69 64 20 49 4e 54 45 st_meta (id INTE
22c0: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
22d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22f0: 20 20 20 20 20 20 74 65 73 74 6e 61 6d 65 20 20 testname
2300: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
2310: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2330: 20 20 20 20 20 20 20 20 61 75 74 68 6f 72 20 20 author
2340: 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 TEXT DEFAULT
2350: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
2360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2370: 20 20 20 20 20 20 20 20 20 20 6f 77 6e 65 72 20 owner
2380: 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 TEXT DEFAU
2390: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b0: 20 20 20 20 20 20 20 20 20 20 20 20 64 65 73 63 desc
23c0: 72 69 70 74 69 6f 6e 20 54 45 58 54 20 44 45 46 ription TEXT DEF
23d0: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
23e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
2400: 76 69 65 77 65 64 20 20 20 20 54 49 4d 45 53 54 viewed TIMEST
2410: 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 AMP,.
2420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2430: 20 20 20 20 20 20 20 20 20 20 69 74 65 72 61 74 iterat
2440: 65 64 20 20 20 20 54 45 58 54 20 44 45 46 41 55 ed TEXT DEFAU
2450: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
2460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2470: 20 20 20 20 20 20 20 20 20 20 20 20 61 76 67 5f avg_
2480: 72 75 6e 74 69 6d 65 20 52 45 41 4c 2c 0a 20 20 runtime REAL,.
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24b0: 20 20 20 61 76 67 5f 64 69 73 6b 20 20 20 20 52 avg_disk R
24c0: 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EAL,.
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e0: 20 20 20 20 20 20 20 20 20 20 74 61 67 73 20 20 tags
24f0: 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 TEXT DEFAU
2500: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2520: 20 20 20 20 20 20 20 20 20 20 20 20 6a 6f 62 67 jobg
2530: 72 6f 75 70 20 20 20 20 54 45 58 54 20 44 45 46 roup TEXT DEF
2540: 41 55 4c 54 20 27 64 65 66 61 75 6c 74 27 2c 0a AULT 'default',.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 74 5f CONSTRAINT test_
2580: 6d 65 74 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 meta_constraint
2590: 55 4e 49 51 55 45 20 28 74 65 73 74 6e 61 6d 65 UNIQUE (testname
25a0: 29 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 ));"). (sqlit
25b0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
25c0: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
25d0: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 OT EXISTS test_d
25e0: 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 20 ata (id INTEGER
25f0: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
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 20 20 20 20 74 65 73 tes
2620: 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 t_id INTEGER,.
2630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 ca
2650: 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 46 41 tegory TEXT DEFA
2660: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
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 76 61 72 69 61 62 6c 65 variable
2690: 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 20 20 TEXT,..
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26b0: 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 value REAL,..
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 20 65 78 70 65 63 74 65 64 20 52 45 expected RE
26e0: 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 AL,..
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 6c tol
2700: 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 REAL,.
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 units TEX
2730: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 comment TEXT
2760: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
2770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2780: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 stat
2790: 75 73 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 us TEXT DEFAULT
27a0: 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 'n/a',.
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27c0: 20 20 20 20 20 20 20 74 79 70 65 20 54 45 58 54 type TEXT
27d0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
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 43 4f 4e 53 54 CONST
2800: 52 41 49 4e 54 20 74 65 73 74 5f 64 61 74 61 5f RAINT test_data_
2810: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
2820: 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 67 E (test_id,categ
2830: 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b 22 ory,variable));"
2840: 29 0a 20 20 20 20 3b 3b 20 4d 75 73 74 20 64 6f ). ;; Must do
2850: 20 74 68 69 73 20 2a 61 66 74 65 72 2a 20 72 75 this *after* ru
2860: 6e 6e 69 6e 67 20 70 61 74 63 68 20 64 62 20 21 nning patch db !
2870: 21 20 4e 6f 20 6d 6f 72 65 2e 20 0a 20 20 20 20 ! No more. .
2880: 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 (db:set-var db "
2890: 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e MEGATEST_VERSION
28a0: 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 " megatest-versi
28b0: 6f 6e 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 on). (debug:p
28c0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 rint-info 11 "db
28d0: 3a 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 22 :initialize END"
28e0: 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d ). ))..;;====
28f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2930: 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 54 20 20 20 ==.;; T E S T
2940: 53 20 50 20 45 20 43 20 49 20 46 20 49 20 43 20 S P E C I F I C
2950: 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d D B .;;=======
2960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
29a0: 0a 3b 3b 20 43 72 65 61 74 65 20 74 68 65 20 73 .;; Create the s
29b0: 71 6c 69 74 65 20 64 62 20 66 6f 72 20 74 68 65 qlite db for the
29c0: 20 69 6e 64 69 76 69 64 75 61 6c 20 74 65 73 74 individual test
29d0: 28 73 29 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 (s).(define (ope
29e0: 6e 2d 74 65 73 74 2d 64 62 20 74 65 73 74 70 61 n-test-db testpa
29f0: 74 68 29 20 0a 20 20 28 64 65 62 75 67 3a 70 72 th) . (debug:pr
2a00: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 int-info 11 "ope
2a10: 6e 2d 74 65 73 74 2d 64 62 20 22 20 74 65 73 74 n-test-db " test
2a20: 70 61 74 68 29 0a 20 20 28 69 66 20 28 61 6e 64 path). (if (and
2a30: 20 28 64 69 72 65 63 74 6f 72 79 3f 20 74 65 73 (directory? tes
2a40: 74 70 61 74 68 29 0a 09 20 20 20 28 66 69 6c 65 tpath).. (file
2a50: 2d 72 65 61 64 2d 61 63 63 65 73 73 3f 20 74 65 -read-access? te
2a60: 73 74 70 61 74 68 29 29 0a 20 20 20 20 20 20 28 stpath)). (
2a70: 6c 65 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 let* ((dbpath
2a80: 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 68 20 (conc testpath
2a90: 22 2f 74 65 73 74 64 61 74 2e 64 62 22 29 29 0a "/testdat.db")).
2aa0: 09 20 20 20 20 20 28 64 62 65 78 69 73 74 73 20 . (dbexists
2ab0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 (file-exists? d
2ac0: 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 28 64 bpath)).. (d
2ad0: 62 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 b (sqlite
2ae0: 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 3:open-database
2af0: 64 62 70 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 dbpath)) ;; (nev
2b00: 65 72 2d 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d er-give-up-open-
2b10: 64 62 20 64 62 70 61 74 68 29 29 0a 09 20 20 20 db dbpath))..
2b20: 20 20 28 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 (handler (ma
2b30: 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 ke-busy-timeout
2b40: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
2b50: 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d g "-override-tim
2b60: 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 20 20 eout")......
2b70: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
2b80: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
2b90: 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 "-override-time
2ba0: 6f 75 74 22 29 29 0a 09 09 09 09 09 20 20 20 20 out"))......
2bb0: 20 20 20 31 33 36 30 30 30 29 29 29 29 0a 09 28 136000))))..(
2bc0: 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 sqlite3:set-busy
2bd0: 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 61 6e -handler! db han
2be0: 64 6c 65 72 29 0a 09 28 69 66 20 28 6e 6f 74 20 dler)..(if (not
2bf0: 64 62 65 78 69 73 74 73 29 0a 09 20 20 20 20 28 dbexists).. (
2c00: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 71 begin.. (sq
2c10: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
2c20: 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f "PRAGMA synchro
2c30: 6e 6f 75 73 20 3d 20 46 55 4c 4c 3b 22 29 0a 09 nous = FULL;")..
2c40: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2c50: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 49 6e 69 74 nt-info 11 "Init
2c60: 69 61 6c 69 7a 65 64 20 74 65 73 74 20 64 61 74 ialized test dat
2c70: 61 62 61 73 65 20 22 20 64 62 70 61 74 68 29 0a abase " dbpath).
2c80: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 64 . (db:testd
2c90: 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 b-initialize db)
2ca0: 29 29 0a 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a ))..;; (sqlite3:
2cb0: 65 78 65 63 75 74 65 20 64 62 20 22 50 52 41 47 execute db "PRAG
2cc0: 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d MA synchronous =
2cd0: 20 30 3b 22 29 0a 09 28 64 65 62 75 67 3a 70 72 0;")..(debug:pr
2ce0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 int-info 11 "ope
2cf0: 6e 2d 74 65 73 74 2d 64 62 20 45 4e 44 20 28 73 n-test-db END (s
2d00: 75 63 65 73 73 66 75 6c 29 22 20 74 65 73 74 70 ucessful)" testp
2d10: 61 74 68 29 0a 09 64 62 29 0a 20 20 20 20 20 20 ath)..db).
2d20: 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 (begin..(debug:p
2d30: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 rint-info 11 "op
2d40: 65 6e 2d 74 65 73 74 2d 64 62 20 45 4e 44 20 28 en-test-db END (
2d50: 75 6e 73 75 63 65 73 73 66 75 6c 29 22 20 74 65 unsucessful)" te
2d60: 73 74 70 61 74 68 29 0a 09 23 66 29 29 29 0a 0a stpath)..#f)))..
2d70: 3b 3b 20 66 69 6e 64 20 61 6e 64 20 6f 70 65 6e ;; find and open
2d80: 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 the testdat.db
2d90: 66 69 6c 65 20 66 6f 72 20 61 6e 20 65 78 69 73 file for an exis
2da0: 74 69 6e 67 20 74 65 73 74 0a 28 64 65 66 69 6e ting test.(defin
2db0: 65 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d e (db:open-test-
2dc0: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
2dd0: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 test-id). (let
2de0: 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 28 64 * ((test-path (d
2df0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
2e00: 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 r-from-test-id d
2e10: 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 b test-id))).
2e20: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 (debug:print 3
2e30: 22 54 45 53 54 20 50 41 54 48 3a 20 22 20 74 65 "TEST PATH: " te
2e40: 73 74 2d 70 61 74 68 29 0a 20 20 20 20 28 6f 70 st-path). (op
2e50: 65 6e 2d 74 65 73 74 2d 64 62 20 74 65 73 74 2d en-test-db test-
2e60: 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 path)))..(define
2e70: 20 28 64 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 (db:testdb-init
2e80: 69 61 6c 69 7a 65 20 64 62 29 0a 20 20 28 64 65 ialize db). (de
2e90: 62 75 67 3a 70 72 69 6e 74 20 31 31 20 22 64 62 bug:print 11 "db
2ea0: 3a 74 65 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 :testdb-initiali
2eb0: 7a 65 20 53 54 41 52 54 22 29 0a 20 20 28 66 6f ze START"). (fo
2ec0: 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 r-each. (lambd
2ed0: 61 20 28 73 71 6c 63 6d 64 29 0a 20 20 20 20 20 a (sqlcmd).
2ee0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
2ef0: 20 64 62 20 73 71 6c 63 6d 64 29 29 0a 20 20 20 db sqlcmd)).
2f00: 28 6c 69 73 74 20 22 43 52 45 41 54 45 20 54 41 (list "CREATE TA
2f10: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
2f20: 53 20 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a S test_rundat (.
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 64 id
2f40: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
2f50: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
2f60: 20 20 20 20 75 70 64 61 74 65 5f 74 69 6d 65 20 update_time
2f70: 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 TIMESTAMP,.
2f80: 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 cpuload
2f90: 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 INTEGER DEFAULT
2fa0: 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 -1,.
2fb0: 20 20 20 64 69 73 6b 66 72 65 65 20 49 4e 54 45 diskfree INTE
2fc0: 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a GER DEFAULT -1,.
2fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 di
2fe0: 73 6b 75 73 61 67 65 20 49 4e 54 47 45 52 20 44 skusage INTGER D
2ff0: 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 EFAULT -1,.
3000: 20 20 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 run_dur
3010: 61 74 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 ation INTEGER DE
3020: 46 41 55 4c 54 20 30 29 3b 22 0a 09 20 22 43 52 FAULT 0);".. "CR
3030: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
3040: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 T EXISTS test_da
3050: 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 ta (.
3060: 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 id INTEGER PR
3070: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
3080: 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 test_id
3090: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
30a0: 20 20 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 category
30b0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
30c0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
30d0: 76 61 72 69 61 62 6c 65 20 54 45 58 54 2c 0a 09 variable TEXT,..
30e0: 20 20 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c value REAL
30f0: 2c 0a 09 20 20 20 20 20 20 65 78 70 65 63 74 65 ,.. expecte
3100: 64 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 74 d REAL,.. t
3110: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
3120: 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 units TEX
3130: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
3140: 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 comment TEXT DE
3150: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
3160: 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 status T
3170: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 EXT DEFAULT 'n/a
3180: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
3190: 20 74 79 70 65 20 54 45 58 54 20 44 45 46 41 55 type TEXT DEFAU
31a0: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
31b0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
31c0: 74 65 73 74 5f 64 61 74 61 5f 63 6f 6e 73 74 72 test_data_constr
31d0: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 aint UNIQUE (tes
31e0: 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 t_id,category,va
31f0: 72 69 61 62 6c 65 29 29 3b 22 0a 09 20 22 43 52 riable));".. "CR
3200: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
3210: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 T EXISTS test_st
3220: 65 70 73 20 28 0a 20 20 20 20 20 20 20 20 20 20 eps (.
3230: 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 id INTEGER P
3240: 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 RIMARY KEY,.
3250: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
3260: 64 20 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 d INTEGER, .
3270: 20 20 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 stepna
3280: 6d 65 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 me TEXT, .
3290: 20 20 20 20 20 20 20 20 73 74 61 74 65 20 54 45 state TE
32a0: 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f XT DEFAULT 'NOT_
32b0: 53 54 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 STARTED', .
32c0: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 status
32d0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f TEXT DEFAULT 'n/
32e0: 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 a',.
32f0: 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d event_time TIM
3300: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 ESTAMP,.
3310: 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 comment TE
3320: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
3330: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
3340: 66 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c file TEXT DEFAUL
3350: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
3360: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 CONSTRAINT t
3370: 65 73 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 72 est_steps_constr
3380: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 aint UNIQUE (tes
3390: 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 t_id,stepname,st
33a0: 61 74 65 29 29 3b 22 0a 09 20 3b 3b 20 74 65 73 ate));".. ;; tes
33b0: 74 5f 6d 65 74 61 20 63 61 6e 20 62 65 20 75 73 t_meta can be us
33c0: 65 64 20 66 6f 72 20 68 61 6e 64 69 6e 67 20 63 ed for handing c
33d0: 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 74 ommands to the t
33e0: 65 73 74 0a 09 20 3b 3b 20 65 2e 67 2e 20 4b 49 est.. ;; e.g. KI
33f0: 4c 4c 52 45 51 0a 09 20 3b 3b 20 20 20 20 20 20 LLREQ.. ;;
3400: 74 68 65 20 61 63 6b 73 74 61 74 65 20 69 73 20 the ackstate is
3410: 73 65 74 20 74 6f 20 31 20 6f 6e 63 65 20 74 68 set to 1 once th
3420: 65 20 63 6f 6d 6d 61 6e 64 20 68 61 73 20 62 65 e command has be
3430: 65 6e 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 22 en completed.. "
3440: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
3450: 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f NOT EXISTS test_
3460: 6d 65 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 meta (.
3470: 20 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 id INTEGER
3480: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
3490: 20 20 20 20 20 20 20 20 20 20 20 76 61 72 20 54 var T
34a0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
34b0: 20 20 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 val TEXT,.
34c0: 20 20 20 20 20 20 20 20 20 20 20 61 63 6b 73 74 ackst
34d0: 61 74 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 ate INTEGER DEFA
34e0: 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 ULT 0,.
34f0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
3500: 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 metadat_constrai
3510: 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 nt UNIQUE (var))
3520: 3b 22 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 ;")). (debug:pr
3530: 69 6e 74 20 31 31 20 22 64 62 3a 74 65 73 74 64 int 11 "db:testd
3540: 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 b-initialize END
3550: 22 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d "))..;;=========
3560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
35a0: 20 4c 20 4f 20 47 20 47 20 49 20 4e 20 47 20 20 L O G G I N G
35b0: 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d D B .;;=======
35c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
35f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
3600: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c .(define (open-l
3610: 6f 67 67 69 6e 67 2d 64 62 29 20 3b 3b 20 20 28 ogging-db) ;; (
3620: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
3630: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 /megatest.db") (
3640: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
3650: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 ))). (let* ((db
3660: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 28 69 path (conc (i
3670: 66 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e f *toppath* (con
3680: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 22 29 c *toppath* "/")
3690: 20 22 22 29 20 22 6c 6f 67 67 69 6e 67 2e 64 62 "") "logging.db
36a0: 22 29 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 20 ")) ;; fname)..
36b0: 28 64 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 (dbexists (file
36c0: 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 -exists? dbpath)
36d0: 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 20 28 ).. (db (
36e0: 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 sqlite3:open-dat
36f0: 61 62 61 73 65 20 64 62 70 61 74 68 29 29 20 3b abase dbpath)) ;
3700: 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 ; (never-give-up
3710: 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 -open-db dbpath)
3720: 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 28 ).. (handler (
3730: 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 make-busy-timeou
3740: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
3750: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 arg "-override-t
3760: 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 imeout")......
3770: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
3780: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3790: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
37a0: 74 22 29 29 0a 09 09 09 09 09 20 20 20 31 33 36 t"))...... 136
37b0: 30 30 30 29 29 29 29 20 3b 3b 20 31 33 36 30 30 000)))) ;; 13600
37c0: 30 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 0))). (sqlite
37d0: 33 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 3:set-busy-handl
37e0: 65 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a er! db handler).
37f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 (if (not dbe
3800: 78 69 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 xists)..(begin..
3810: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3820: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
3830: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
3840: 53 20 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 S log (id INTEGE
3850: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 65 76 R PRIMARY KEY,ev
3860: 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 ent_time TIMESTA
3870: 4d 50 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 MP DEFAULT (strf
3880: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
3890: 29 2c 6c 6f 67 6c 69 6e 65 20 54 45 58 54 2c 70 ),logline TEXT,p
38a0: 77 64 20 54 45 58 54 2c 63 6d 64 6c 69 6e 65 20 wd TEXT,cmdline
38b0: 54 45 58 54 2c 70 69 64 20 49 4e 54 45 47 45 52 TEXT,pid INTEGER
38c0: 29 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 );").. (sqlite3
38d0: 3a 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e :execute db (con
38e0: 63 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 c "PRAGMA synchr
38f0: 6f 6e 6f 75 73 20 3d 20 30 3b 22 29 29 29 29 0a onous = 0;")))).
3900: 20 20 20 20 64 62 29 29 0a 0a 28 64 65 66 69 6e db))..(defin
3910: 65 20 28 64 62 3a 6c 6f 67 2d 65 76 65 6e 74 20 e (db:log-event
3920: 2e 20 6c 6f 67 6c 73 74 29 0a 20 20 28 6c 65 74 . loglst). (let
3930: 20 28 28 64 62 20 20 20 20 20 20 28 6f 70 65 6e ((db (open
3940: 2d 6c 6f 67 67 69 6e 67 2d 64 62 29 29 0a 09 28 -logging-db))..(
3950: 6c 6f 67 6c 69 6e 65 20 28 61 70 70 6c 79 20 63 logline (apply c
3960: 6f 6e 63 20 6c 6f 67 6c 73 74 29 29 29 0a 20 20 onc loglst))).
3970: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3980: 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e te db "INSERT IN
3990: 54 4f 20 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 2c TO log (logline,
39a0: 70 77 64 2c 63 6d 64 6c 69 6e 65 2c 70 69 64 29 pwd,cmdline,pid)
39b0: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f VALUES (?,?,?,?
39c0: 29 3b 22 20 6c 6f 67 6c 69 6e 65 20 28 63 75 72 );" logline (cur
39d0: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 28 rent-directory)(
39e0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
39f0: 73 65 20 28 61 72 67 76 29 20 22 20 22 29 28 63 se (argv) " ")(c
3a00: 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
3a10: 64 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 d)). (sqlite3
3a20: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 :finalize! db).
3a30: 20 20 20 6c 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b logline))..;;
3a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a80: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 4f 44 4f 3a 0a ======.;; TODO:.
3a90: 3b 3b 20 20 20 70 75 74 20 64 65 6c 74 61 73 20 ;; put deltas
3aa0: 69 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 6c 69 into an assoc li
3ab0: 73 74 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 st with version
3ac0: 6e 75 6d 62 65 72 73 0a 3b 3b 20 20 20 61 70 70 numbers.;; app
3ad0: 6c 79 20 61 6c 6c 20 66 72 6f 6d 20 6c 61 73 74 ly all from last
3ae0: 20 74 6f 20 63 75 72 72 65 6e 74 0a 3b 3b 3d 3d to current.;;==
3af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b30: 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 70 61 ====.(define (pa
3b40: 74 63 68 2d 64 62 20 64 62 29 0a 20 20 28 68 61 tch-db db). (ha
3b50: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
3b60: 20 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e exn. (begin
3b70: 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 78 . (print "Ex
3b80: 63 65 70 74 69 6f 6e 3a 20 22 20 65 78 6e 29 0a ception: " exn).
3b90: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR
3ba0: 4f 52 3a 20 50 6f 73 73 69 62 6c 65 20 6f 75 74 OR: Possible out
3bb0: 20 6f 66 20 64 61 74 65 20 73 63 68 65 6d 61 2c of date schema,
3bc0: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 61 attempting to a
3bd0: 64 64 20 74 61 62 6c 65 20 6d 65 74 61 64 61 74 dd table metadat
3be0: 61 2e 2e 2e 22 29 0a 20 20 20 20 20 28 73 71 6c a..."). (sql
3bf0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
3c00: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
3c10: 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 NOT EXISTS meta
3c20: 64 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 2c dat (id INTEGER,
3c30: 20 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 var TEXT, val T
3c40: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
3c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c60: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
3c70: 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 metadat_constra
3c80: 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 int UNIQUE (var)
3c90: 29 3b 22 29 0a 20 20 20 20 20 28 69 66 20 28 6e );"). (if (n
3ca0: 6f 74 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 ot (db:get-var d
3cb0: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
3cc0: 49 4f 4e 22 29 29 0a 09 20 28 64 62 3a 73 65 74 ION")).. (db:set
3cd0: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
3ce0: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 29 T_VERSION" 1.17)
3cf0: 29 29 0a 20 20 20 28 6c 65 74 20 28 28 6d 76 65 )). (let ((mve
3d00: 72 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 r (db:get-var db
3d10: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 "MEGATEST_VERSI
3d20: 4f 4e 22 29 29 0a 09 20 28 74 65 73 74 2d 6d 65 ON")).. (test-me
3d30: 74 61 2d 64 65 66 20 22 43 52 45 41 54 45 20 54 ta-def "CREATE T
3d40: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
3d50: 54 53 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 TS test_meta (id
3d60: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
3d70: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d90: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e testn
3da0: 61 6d 65 20 20 20 20 54 45 58 54 20 44 45 46 41 ame TEXT DEFA
3db0: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
3dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 aut
3de0: 68 6f 72 20 20 20 20 20 20 54 45 58 54 20 44 45 hor TEXT DE
3df0: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f o
3e20: 77 6e 65 72 20 20 20 20 20 20 20 54 45 58 54 20 wner TEXT
3e30: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e60: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 description TEX
3e70: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
3e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ea0: 20 20 20 72 65 76 69 65 77 65 64 20 20 20 20 54 reviewed T
3eb0: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 IMESTAMP,.
3ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
3ee0: 74 65 72 61 74 65 64 20 20 20 20 54 45 58 54 20 terated TEXT
3ef0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f20: 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 avg_runtime REA
3f30: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 L,.
3f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f50: 20 20 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b avg_disk
3f60: 20 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 REAL,.
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
3f90: 61 67 73 20 20 20 20 20 20 20 20 54 45 58 54 20 ags TEXT
3fa0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
3fd0: 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 TRAINT test_meta
3fe0: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
3ff0: 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 UE (testname));"
4000: 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 )). (print "
4010: 43 75 72 72 65 6e 74 20 73 63 68 65 6d 61 20 76 Current schema v
4020: 65 72 73 69 6f 6e 3a 20 22 20 6d 76 65 72 20 22 ersion: " mver "
4030: 20 63 75 72 72 65 6e 74 20 6d 65 67 61 74 65 73 current megates
4040: 74 20 76 65 72 73 69 6f 6e 3a 20 22 20 6d 65 67 t version: " meg
4050: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 atest-version).
4060: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
4070: 28 28 6e 6f 74 20 6d 76 65 72 29 0a 20 20 20 20 ((not mver).
4080: 20 20 20 28 70 72 69 6e 74 20 22 41 64 64 69 6e (print "Addin
4090: 67 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 g megatest-versi
40a0: 6f 6e 20 74 6f 20 6d 65 74 61 64 61 74 61 22 29 on to metadata")
40b0: 20 3b 3b 20 4e 65 65 64 20 74 6f 20 72 65 63 72 ;; Need to recr
40c0: 65 61 74 65 20 74 68 65 20 74 61 62 6c 65 0a 20 eate the table.
40d0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
40e0: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
40f0: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
4100: 6d 65 74 61 64 61 74 3b 22 29 0a 20 20 20 20 20 metadat;").
4110: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4120: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
4130: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
4140: 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e S metadat (id IN
4150: 54 45 47 45 52 2c 20 76 61 72 20 54 45 58 54 2c TEGER, var TEXT,
4160: 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 val TEXT,.
4170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4180: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
4190: 53 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f STRAINT metadat_
41a0: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
41b0: 45 20 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 E (var));").
41c0: 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 (db:set-var d
41d0: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
41e0: 49 4f 4e 22 20 31 2e 31 37 29 0a 20 20 20 20 20 ION" 1.17).
41f0: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
4200: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
4210: 31 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 1). (sqlit
4220: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 e3:execute db "D
4230: 52 4f 50 20 54 41 42 4c 45 20 49 46 20 45 58 49 ROP TABLE IF EXI
4240: 53 54 53 20 6d 65 74 61 64 61 74 3b 22 29 0a 20 STS metadat;").
4250: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4260: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
4270: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
4280: 58 49 53 54 53 20 6d 65 74 61 64 61 74 20 28 69 XISTS metadat (i
4290: 64 20 49 4e 54 45 47 45 52 2c 20 76 61 72 20 54 d INTEGER, var T
42a0: 45 58 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 EXT, val TEXT,.
42b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42d0: 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 61 CONSTRAINT meta
42e0: 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 dat_constraint U
42f0: 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 29 0a NIQUE (var));").
4300: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4310: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4320: 56 45 52 53 49 4f 4e 22 20 31 2e 32 31 29 20 3b VERSION" 1.21) ;
4330: 3b 20 73 65 74 20 62 65 66 6f 72 65 2c 20 6a 75 ; set before, ju
4340: 73 74 20 69 6e 20 63 61 73 65 20 74 68 65 20 63 st in case the c
4350: 68 61 6e 67 65 73 20 61 72 65 20 61 6c 72 65 61 hanges are alrea
4360: 64 79 20 61 70 70 6c 69 65 64 0a 20 20 20 20 20 dy applied.
4370: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4380: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
4390: 64 65 66 29 0a 09 09 09 09 09 3b 28 66 6f 72 2d def)......;(for-
43a0: 65 61 63 68 20 0a 09 09 09 09 09 3b 20 28 6c 61 each ......; (la
43b0: 6d 62 64 61 20 28 73 74 6d 74 29 0a 09 09 09 09 mbda (stmt).....
43c0: 09 3b 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 .; (sqlite3:ex
43d0: 65 63 75 74 65 20 64 62 20 73 74 6d 74 29 29 0a ecute db stmt)).
43e0: 09 09 09 09 09 3b 20 28 6c 69 73 74 20 0a 09 09 .....; (list ...
43f0: 09 09 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 ...; "ALTER TAB
4400: 4c 45 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c LE tests ADD COL
4410: 55 4d 4e 20 66 69 72 73 74 5f 65 72 72 20 54 45 UMN first_err TE
4420: 58 54 3b 22 0a 09 09 09 09 09 3b 20 20 22 41 4c XT;"......; "AL
4430: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 TER TABLE tests
4440: 41 44 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 ADD COLUMN first
4450: 5f 77 61 72 6e 20 54 45 58 54 3b 22 0a 09 09 09 _warn TEXT;"....
4460: 09 09 3b 20 20 29 29 0a 20 20 20 20 20 20 20 28 ..; )). (
4470: 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 patch-db)).
4480: 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 34 29 0a ((< mver 1.24).
4490: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
44a0: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
44b0: 56 45 52 53 49 4f 4e 22 20 31 2e 32 34 29 0a 20 VERSION" 1.24).
44c0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
44d0: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
44e0: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
44f0: 74 65 73 74 5f 64 61 74 61 3b 22 29 0a 20 20 20 test_data;").
4500: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
4510: 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 cute db "DROP TA
4520: 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 74 65 BLE IF EXISTS te
4530: 73 74 5f 6d 65 74 61 3b 22 29 0a 20 20 20 20 20 st_meta;").
4540: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4550: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
4560: 64 65 66 29 0a 20 20 20 20 20 20 20 28 73 71 6c def). (sql
4570: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
4580: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
4590: 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 NOT EXISTS test
45a0: 5f 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 _data (id INTEGE
45b0: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
45e0: 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a est_id INTEGER,.
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 20 20 20 20
4610: 63 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 category TEXT DE
4620: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4640: 20 20 20 20 20 20 20 20 20 20 76 61 72 69 61 62 variab
4650: 6c 65 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 le TEXT,..
4660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4670: 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 value REAL,..
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4690: 20 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 expected
46a0: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 REAL,..
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
46c0: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
46d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46e0: 20 20 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 units T
46f0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
4700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4710: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 comment TEX
4720: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
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 73 74 st
4750: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
4760: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
4770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4780: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
4790: 54 20 74 65 73 74 5f 64 61 74 61 20 55 4e 49 51 T test_data UNIQ
47a0: 55 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 UE (test_id,cate
47b0: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b gory,variable));
47c0: 22 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 "). (print
47d0: 20 22 57 41 52 4e 49 4e 47 3a 20 54 61 62 6c 65 "WARNING: Table
47e0: 20 74 65 73 74 5f 64 61 74 61 20 61 6e 64 20 74 test_data and t
47f0: 65 73 74 5f 6d 65 74 61 20 77 65 72 65 20 72 65 est_meta were re
4800: 63 72 65 61 74 65 64 2e 20 50 6c 65 61 73 65 20 created. Please
4810: 64 6f 20 6d 65 67 61 74 65 73 74 20 2d 75 70 64 do megatest -upd
4820: 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 20 ate-meta").
4830: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
4840: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
4850: 37 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 7). (db:se
4860: 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 t-var db "MEGATE
4870: 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 32 37 ST_VERSION" 1.27
4880: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
4890: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 3:execute db "AL
48a0: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 64 TER TABLE test_d
48b0: 61 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 74 ata ADD COLUMN t
48c0: 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ype TEXT DEFAULT
48d0: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 70 '';"). (p
48e0: 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 atch-db)).
48f0: 28 28 3c 20 6d 76 65 72 20 31 2e 32 39 29 0a 20 ((< mver 1.29).
4900: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 (db:set-va
4910: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 r db "MEGATEST_V
4920: 45 52 53 49 4f 4e 22 20 31 2e 32 39 29 0a 20 20 ERSION" 1.29).
4930: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
4940: 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 ecute db "ALTER
4950: 54 41 42 4c 45 20 74 65 73 74 5f 73 74 65 70 73 TABLE test_steps
4960: 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6c 6f 67 66 ADD COLUMN logf
4970: 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ile TEXT DEFAULT
4980: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 73 '';"). (s
4990: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
49a0: 62 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 b "ALTER TABLE t
49b0: 65 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 ests ADD COLUMN
49c0: 73 68 6f 72 74 64 69 72 20 54 45 58 54 20 44 45 shortdir TEXT DE
49d0: 46 41 55 4c 54 20 27 27 3b 22 29 29 0a 20 20 20 FAULT '';")).
49e0: 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 33 36 ((< mver 1.36
49f0: 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 ). (db:set
4a00: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
4a10: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 33 36 29 T_VERSION" 1.36)
4a20: 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 . (sqlite3
4a30: 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 :execute db "ALT
4a40: 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 6d 65 ER TABLE test_me
4a50: 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6a 6f ta ADD COLUMN jo
4a60: 62 67 72 6f 75 70 20 54 45 58 54 20 44 45 46 41 bgroup TEXT DEFA
4a70: 55 4c 54 20 27 64 65 66 61 75 6c 74 27 3b 22 29 ULT 'default';")
4a80: 29 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 ). ((< mver
4a90: 20 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 64 1.37). (d
4aa0: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
4ab0: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
4ac0: 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 73 71 1.37). (sq
4ad0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4ae0: 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 "ALTER TABLE te
4af0: 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 61 sts ADD COLUMN a
4b00: 72 63 68 69 76 65 64 20 49 4e 54 45 47 45 52 20 rchived INTEGER
4b10: 44 45 46 41 55 4c 54 20 30 3b 22 29 29 20 0a 20 DEFAULT 0;")) .
4b20: 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20 6d 65 ((< mver me
4b30: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
4b40: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4b50: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4b60: 56 45 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 VERSION" megates
4b70: 74 2d 76 65 72 73 69 6f 6e 29 29 29 29 29 29 0a t-version)))))).
4b80: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 65 74 =========.;; met
4bd0: 61 20 67 65 74 20 61 6e 64 20 73 65 74 20 76 61 a get and set va
4be0: 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d rs.;;===========
4bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
4c30: 72 65 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 returns number i
4c40: 66 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 f string->number
4c50: 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 is successful,
4c60: 73 74 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 string otherwise
4c70: 0a 3b 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 .;; also updates
4c80: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a *global-delta*.
4c90: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
4ca0: 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 28 64 var db var). (d
4cb0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
4cc0: 31 31 20 22 64 62 3a 67 65 74 2d 76 61 72 20 53 11 "db:get-var S
4cd0: 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 28 6c TART " var). (l
4ce0: 65 74 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 et* ((start-ms (
4cf0: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
4d00: 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 onds)).
4d10: 28 74 68 72 6f 74 74 6c 65 20 28 6c 65 74 20 28 (throttle (let (
4d20: 28 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b (t (config-look
4d30: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
4d40: 73 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c 65 setup" "throttle
4d50: 22 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 ")))... (if
4d60: 74 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 t (string->numbe
4d70: 72 20 74 29 20 74 29 29 29 0a 09 20 28 72 65 73 r t) t))).. (res
4d80: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 #f)). (
4d90: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
4da0: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
4db0: 61 20 28 76 61 6c 29 0a 20 20 20 20 20 20 20 28 a (val). (
4dc0: 73 65 74 21 20 72 65 73 20 76 61 6c 29 29 0a 20 set! res val)).
4dd0: 20 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 76 db "SELECT v
4de0: 61 6c 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 al FROM metadat
4df0: 57 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 WHERE var=?;" va
4e00: 72 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 r). ;; conver
4e10: 74 20 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 t to number if c
4e20: 61 6e 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 an. (if (stri
4e30: 6e 67 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 ng? res)..(let (
4e40: 28 76 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d (valnum (string-
4e50: 3e 6e 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 >number res)))..
4e60: 20 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 (if valnum (se
4e70: 74 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 t! res valnum)))
4e80: 29 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 ). ;; scale b
4e90: 79 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 y 10, average wi
4ea0: 74 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 th current value
4eb0: 2e 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
4ec0: 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b bal-delta* (/ (+
4ed0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 *global-delta*
4ee0: 28 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d (* (- (current-m
4ef0: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 illiseconds) sta
4f00: 72 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 rt-ms)....... (i
4f10: 66 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 f throttle throt
4f20: 74 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 tle 0.01)))....
4f30: 20 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 2)). (if (
4f40: 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d > (abs (- *last-
4f50: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 global-delta-pri
4f60: 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 nted* *global-de
4f70: 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 lta*)) 0.08) ;;
4f80: 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 don't print all
4f90: 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 the time, only i
4fa0: 66 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 f it changes a b
4fb0: 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 it..(begin.. (d
4fc0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
4fd0: 34 20 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 4 "launch thrott
4fe0: 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f le factor=" *glo
4ff0: 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 bal-delta*).. (
5000: 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 set! *last-globa
5010: 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a l-delta-printed*
5020: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*)
5030: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
5040: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
5050: 67 65 74 2d 76 61 72 20 45 4e 44 20 22 20 76 61 get-var END " va
5060: 72 20 22 20 76 61 6c 3d 22 20 72 65 73 29 0a 20 r " val=" res).
5070: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
5080: 65 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 e (db:set-var db
5090: 20 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 var val). (deb
50a0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
50b0: 20 22 64 62 3a 73 65 74 2d 76 61 72 20 53 54 41 "db:set-var STA
50c0: 52 54 20 22 20 76 61 72 20 22 20 22 20 76 61 6c RT " var " " val
50d0: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
50e0: 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 cute db "INSERT
50f0: 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 OR REPLACE INTO
5100: 6d 65 74 61 64 61 74 20 28 76 61 72 2c 76 61 6c metadat (var,val
5110: 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 ) VALUES (?,?);"
5120: 20 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 var val). (deb
5130: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
5140: 20 22 64 62 3a 73 65 74 2d 76 61 72 20 45 4e 44 "db:set-var END
5150: 20 22 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 " var " " val))
5160: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 ..(define (db:de
5170: 6c 2d 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 l-var db var).
5180: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
5190: 6f 20 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 o 11 "db:del-var
51a0: 20 53 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 START " var).
51b0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
51c0: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
51d0: 20 6d 65 74 61 64 61 74 20 57 48 45 52 45 20 76 metadat WHERE v
51e0: 61 72 3d 3f 3b 22 20 76 61 72 29 0a 20 20 28 64 ar=?;" var). (d
51f0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
5200: 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 20 45 11 "db:del-var E
5210: 4e 44 20 22 20 76 61 72 29 29 0a 0a 3b 3b 20 75 ND " var))..;; u
5220: 73 65 20 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 se a global for
5230: 73 6f 6d 65 20 70 72 69 6d 69 74 69 76 65 20 63 some primitive c
5240: 61 63 68 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 aching, it is ju
5250: 73 74 20 73 69 6c 6c 79 20 74 6f 20 72 65 2d 72 st silly to re-r
5260: 65 61 64 20 74 68 65 20 64 62 20 0a 3b 3b 20 6f ead the db .;; o
5270: 76 65 72 20 61 6e 64 20 6f 76 65 72 20 61 67 61 ver and over aga
5280: 69 6e 20 66 6f 72 20 74 68 65 20 6b 65 79 73 20 in for the keys
5290: 73 69 6e 63 65 20 74 68 65 79 20 6e 65 76 65 72 since they never
52a0: 20 63 68 61 6e 67 65 0a 0a 28 64 65 66 69 6e 65 change..(define
52b0: 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (db:get-keys db
52c0: 29 0a 20 20 28 69 66 20 2a 64 62 2d 6b 65 79 73 ). (if *db-keys
52d0: 2a 20 2a 64 62 2d 6b 65 79 73 2a 20 0a 20 20 20 * *db-keys* .
52e0: 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 (let ((res '(
52f0: 29 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e )))..(debug:prin
5300: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
5310: 74 2d 6b 65 79 73 20 53 54 41 52 54 20 28 63 61 t-keys START (ca
5320: 63 68 65 20 6d 69 73 73 29 22 29 0a 09 28 73 71 che miss)")..(sq
5330: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
5340: 6f 77 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 6b ow .. (lambda (k
5350: 65 79 20 6b 65 79 74 79 70 65 29 0a 09 20 20 20 ey keytype)..
5360: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
5370: 28 76 65 63 74 6f 72 20 6b 65 79 20 6b 65 79 74 (vector key keyt
5380: 79 70 65 29 20 72 65 73 29 29 29 0a 09 20 64 62 ype) res))).. db
5390: 0a 09 20 22 53 45 4c 45 43 54 20 66 69 65 6c 64 .. "SELECT field
53a0: 6e 61 6d 65 2c 66 69 65 6c 64 74 79 70 65 20 46 name,fieldtype F
53b0: 52 4f 4d 20 6b 65 79 73 20 4f 52 44 45 52 20 42 ROM keys ORDER B
53c0: 59 20 69 64 20 44 45 53 43 3b 22 29 0a 09 28 73 Y id DESC;")..(s
53d0: 65 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 72 65 et! *db-keys* re
53e0: 73 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 s)..(debug:print
53f0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
5400: 2d 6b 65 79 73 20 45 4e 44 20 28 63 61 63 68 65 -keys END (cache
5410: 20 6d 69 73 73 29 22 29 0a 09 72 65 73 29 29 29 miss)")..res)))
5420: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 ..(define (db:ge
5430: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
5440: 72 20 72 6f 77 20 68 65 61 64 65 72 20 66 69 65 r row header fie
5450: 6c 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 ld). (debug:pri
5460: 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 nt-info 4 "db:ge
5470: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
5480: 72 20 72 6f 77 3a 20 22 20 72 6f 77 20 22 20 68 r row: " row " h
5490: 65 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 eader: " header
54a0: 22 20 66 69 65 6c 64 3a 20 22 20 66 69 65 6c 64 " field: " field
54b0: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 68 ). (if (null? h
54c0: 65 61 64 65 72 29 20 23 66 0a 20 20 20 20 20 20 eader) #f.
54d0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
54e0: 28 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 09 (car header))...
54f0: 20 28 74 61 6c 20 28 63 64 72 20 68 65 61 64 65 (tal (cdr heade
5500: 72 29 29 0a 09 09 20 28 6e 20 20 20 30 29 29 0a r))... (n 0)).
5510: 09 28 69 66 20 28 65 71 75 61 6c 3f 20 68 65 64 .(if (equal? hed
5520: 20 66 69 65 6c 64 29 0a 09 20 20 20 20 28 76 65 field).. (ve
5530: 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 6e 29 0a ctor-ref row n).
5540: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
5550: 74 61 6c 29 20 23 66 20 28 6c 6f 6f 70 20 28 63 tal) #f (loop (c
5560: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
5570: 28 2b 20 6e 20 31 29 29 29 29 29 29 29 0a 0a 3b (+ n 1)))))))..;
5580: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55c0: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 20 =======.;; R U
55d0: 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N S.;;==========
55e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
55f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
5620: 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 2d efine (runs:get-
5630: 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 20 6b std-run-fields k
5640: 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29 0a 20 eys remfields).
5650: 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 20 (let* ((header
5660: 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 (append (map
5670: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
5680: 65 20 6b 65 79 73 29 0a 09 09 09 20 20 20 20 72 e keys).... r
5690: 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28 6b 65 emfields)).. (ke
56a0: 79 73 74 72 20 20 20 20 28 63 6f 6e 63 20 28 6b ystr (conc (k
56b0: 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 eys->keystr keys
56c0: 29 20 22 2c 22 0a 09 09 09 20 20 28 73 74 72 69 ) ",".... (stri
56d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 ng-intersperse r
56e0: 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 29 emfields ","))))
56f0: 0a 20 20 20 20 28 6c 69 73 74 20 6b 65 79 73 74 . (list keyst
5700: 72 20 68 65 61 64 65 72 29 29 29 0a 0a 3b 3b 20 r header)))..;;
5710: 6d 61 6b 65 20 61 20 71 75 65 72 79 20 28 66 69 make a query (fi
5720: 65 6c 64 6e 61 6d 65 20 6c 69 6b 65 20 27 70 61 eldname like 'pa
5730: 74 74 31 27 20 4f 52 20 66 69 65 6c 64 6e 61 6d tt1' OR fieldnam
5740: 65 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 70 e .(define (db:p
5750: 61 74 74 2d 3e 6c 69 6b 65 20 66 69 65 6c 64 6e att->like fieldn
5760: 61 6d 65 20 70 61 74 74 73 74 72 20 23 21 6b 65 ame pattstr #!ke
5770: 79 20 28 63 6f 6d 70 61 72 61 74 6f 72 20 22 20 y (comparator "
5780: 4f 52 20 22 29 29 0a 20 20 28 6c 65 74 20 28 28 OR ")). (let ((
5790: 70 61 74 74 73 20 28 69 66 20 28 73 74 72 69 6e patts (if (strin
57a0: 67 3f 20 70 61 74 74 73 74 72 29 0a 09 09 20 20 g? pattstr)...
57b0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 (string-split p
57c0: 61 74 74 73 74 72 20 22 2c 22 29 0a 09 09 20 20 attstr ",")...
57d0: 20 27 28 22 25 22 29 29 29 29 0a 20 20 20 20 28 '("%")))). (
57e0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
57f0: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
5800: 28 70 61 74 74 29 0a 09 09 09 20 20 20 20 20 20 (patt)....
5810: 20 28 6c 65 74 20 28 28 77 69 6c 64 74 79 70 65 (let ((wildtype
5820: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
5830: 69 6e 64 65 78 20 22 25 22 20 70 61 74 74 29 20 index "%" patt)
5840: 22 4c 49 4b 45 22 20 22 47 4c 4f 42 22 29 29 29 "LIKE" "GLOB")))
5850: 0a 09 09 09 09 20 28 63 6f 6e 63 20 66 69 65 6c ..... (conc fiel
5860: 64 6e 61 6d 65 20 22 20 22 20 77 69 6c 64 74 79 dname " " wildty
5870: 70 65 20 22 20 27 22 20 70 61 74 74 20 22 27 22 pe " '" patt "'"
5880: 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 ))).... (if
5890: 28 6e 75 6c 6c 3f 20 70 61 74 74 73 29 0a 09 09 (null? patts)...
58a0: 09 09 20 27 28 22 22 29 0a 09 09 09 09 20 70 61 .. '("")..... pa
58b0: 74 74 73 29 29 0a 09 09 09 63 6f 6d 70 61 72 61 tts))....compara
58c0: 74 6f 72 29 29 29 0a 0a 3b 3b 20 72 65 70 6c 61 tor)))..;; repla
58d0: 63 65 20 68 65 61 64 65 72 20 61 6e 64 20 6b 65 ce header and ke
58e0: 79 73 74 72 20 77 69 74 68 20 61 20 63 61 6c 6c ystr with a call
58f0: 20 74 6f 20 72 75 6e 73 3a 67 65 74 2d 73 74 64 to runs:get-std
5900: 2d 72 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b 0a 3b -run-fields.;;.;
5910: 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b ; keypatts: ( (K
5920: 45 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b EY1 "abc%def")(K
5930: 45 59 32 20 22 25 22 29 20 29 0a 3b 3b 20 72 75 EY2 "%") ).;; ru
5940: 6e 70 61 74 74 73 3a 20 70 61 74 74 31 2c 70 61 npatts: patt1,pa
5950: 74 74 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 tt2 ....;;.(defi
5960: 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 ne (db:get-runs
5970: 64 62 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 db runpatt count
5980: 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 offset keypatts
5990: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 ). (let* ((res
59a0: 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 6b 65 '()).. (ke
59b0: 79 73 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 ys (db:get
59c0: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 72 75 -keys db)).. (ru
59d0: 6e 70 61 74 74 73 74 72 20 28 64 62 3a 70 61 74 npattstr (db:pat
59e0: 74 2d 3e 6c 69 6b 65 20 22 72 75 6e 6e 61 6d 65 t->like "runname
59f0: 22 20 72 75 6e 70 61 74 74 29 29 0a 09 20 28 72 " runpatt)).. (r
5a00: 65 6d 66 69 65 6c 64 73 20 20 28 6c 69 73 74 20 emfields (list
5a10: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
5a20: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
5a30: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
5a40: 69 6d 65 22 29 29 0a 09 20 28 68 65 61 64 65 72 ime")).. (header
5a50: 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 (append (ma
5a60: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
5a70: 61 6d 65 20 6b 65 79 73 29 0a 09 09 20 20 20 20 ame keys)...
5a80: 20 20 20 20 20 20 20 20 20 72 65 6d 66 69 65 6c remfiel
5a90: 64 73 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 ds)).. (keystr
5aa0: 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e (conc (keys->
5ab0: 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 keystr keys) ","
5ac0: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 28 73 ... (s
5ad0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
5ae0: 65 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 e remfields ",")
5af0: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 )).. (qrystr
5b00: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 (conc "SELECT "
5b10: 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 keystr " FROM r
5b20: 75 6e 73 20 57 48 45 52 45 20 28 22 20 72 75 6e uns WHERE (" run
5b30: 70 61 74 74 73 74 72 20 22 29 20 22 20 3b 3b 20 pattstr ") " ;;
5b40: 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 22 runname LIKE ? "
5b50: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 3b 3b ... ;;
5b60: 20 47 65 6e 65 72 61 74 65 3a 20 22 20 41 4e 44 Generate: " AND
5b70: 20 78 20 4c 49 4b 45 20 27 6b 65 79 70 61 74 74 x LIKE 'keypatt
5b80: 27 20 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 20 ' ..."...
5b90: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6b (if (null? k
5ba0: 65 79 70 61 74 74 73 29 20 22 22 0a 09 09 20 20 eypatts) ""...
5bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5bc0: 6e 63 20 22 20 41 4e 44 20 22 0a 09 09 09 09 20 nc " AND ".....
5bd0: 20 20 20 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e (string-join
5be0: 20 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 ..... (map
5bf0: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 70 61 74 (lambda (keypat
5c00: 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 t)...... (le
5c10: 74 20 28 28 6b 65 79 20 20 28 63 61 72 20 6b 65 t ((key (car ke
5c20: 79 70 61 74 74 29 29 0a 09 09 09 09 09 09 20 20 ypatt)).......
5c30: 20 28 70 61 74 74 20 28 63 61 64 72 20 6b 65 79 (patt (cadr key
5c40: 70 61 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 patt)))......
5c50: 20 20 20 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 (db:patt->li
5c60: 6b 65 20 6b 65 79 20 70 61 74 74 29 29 29 0a 09 ke key patt)))..
5c70: 09 09 09 09 20 20 20 6b 65 79 70 61 74 74 73 29 .... keypatts)
5c80: 0a 09 09 09 09 20 20 20 20 20 20 22 20 41 4e 44 ..... " AND
5c90: 20 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 ")))...
5ca0: 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 " ORDER BY ev
5cb0: 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a ent_time DESC ".
5cc0: 09 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66 .. (if
5cd0: 20 28 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 (number? count)
5ce0: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 ...
5cf0: 20 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 (conc " LIMIT
5d00: 22 20 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 " count)...
5d10: 20 20 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 "")...
5d20: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5d30: 6e 75 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a number? offset).
5d40: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
5d50: 20 28 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 (conc " OFFSET
5d60: 22 20 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 " offset)...
5d70: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 29 29 "")))
5d80: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
5d90: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 nt-info 11 "db:g
5da0: 65 74 2d 72 75 6e 73 20 53 54 41 52 54 20 71 72 et-runs START qr
5db0: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
5dc0: 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 keypatts: " key
5dd0: 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 patts " offset:
5de0: 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 " offset " limit
5df0: 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 : " count). (
5e00: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
5e10: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
5e20: 61 20 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 a (a . x).
5e30: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
5e40: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
5e50: 20 78 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 x) res))).
5e60: 64 62 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 db. qrystr.
5e70: 20 20 20 20 29 0a 20 20 20 20 28 64 65 62 75 67 ). (debug
5e80: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
5e90: 64 62 3a 67 65 74 2d 72 75 6e 73 20 45 4e 44 20 db:get-runs END
5ea0: 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 qrystr: " qrystr
5eb0: 20 22 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b " keypatts: " k
5ec0: 65 79 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 eypatts " offset
5ed0: 3a 20 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d : " offset " lim
5ee0: 69 74 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 it: " count).
5ef0: 20 28 76 65 63 74 6f 72 20 68 65 61 64 65 72 20 (vector header
5f00: 72 65 73 29 29 29 0a 0a 3b 3b 20 6a 75 73 74 20 res)))..;; just
5f10: 67 65 74 20 63 6f 75 6e 74 20 6f 66 20 72 75 6e get count of run
5f20: 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 s.(define (db:ge
5f30: 74 2d 6e 75 6d 2d 72 75 6e 73 20 64 62 20 72 75 t-num-runs db ru
5f40: 6e 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 npatt). (let ((
5f50: 6e 75 6d 72 75 6e 73 20 30 29 29 0a 20 20 20 20 numruns 0)).
5f60: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
5f70: 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d o 11 "db:get-num
5f80: 2d 72 75 6e 73 20 53 54 41 52 54 20 22 20 72 75 -runs START " ru
5f90: 6e 70 61 74 74 29 0a 20 20 20 20 28 73 71 6c 69 npatt). (sqli
5fa0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
5fb0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
5fc0: 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 count). (s
5fd0: 65 74 21 20 6e 75 6d 72 75 6e 73 20 63 6f 75 6e et! numruns coun
5fe0: 74 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 t)). db.
5ff0: 20 22 53 45 4c 45 43 54 20 43 4f 55 4e 54 28 69 "SELECT COUNT(i
6000: 64 29 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 d) FROM runs WHE
6010: 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 RE runname LIKE
6020: 3f 3b 22 20 72 75 6e 70 61 74 74 29 0a 20 20 20 ?;" runpatt).
6030: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
6040: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 fo 11 "db:get-nu
6050: 6d 2d 72 75 6e 73 20 45 4e 44 20 22 20 72 75 6e m-runs END " run
6060: 70 61 74 74 29 0a 20 20 20 20 6e 75 6d 72 75 6e patt). numrun
6070: 73 29 29 0a 0a 3b 3b 20 75 73 65 20 28 67 65 74 s))..;; use (get
6080: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
6090: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
60a0: 72 75 6e 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d runinfo)(db:get-
60b0: 72 6f 77 20 72 75 6e 69 6e 66 6f 29 29 0a 28 64 row runinfo)).(d
60c0: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 efine (db:get-ru
60d0: 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 n-info db run-id
60e0: 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 ). (if (hash-ta
60f0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
6100: 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 65 2a *run-info-cache*
6110: 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 20 20 20 run-id #f).
6120: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
6130: 66 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 f *run-info-cach
6140: 65 2a 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 e* run-id).
6150: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 20 (let* ((res
6160: 20 20 23 66 29 0a 09 20 20 20 20 20 28 6b 65 79 #f).. (key
6170: 73 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b s (db:get-k
6180: 65 79 73 20 64 62 29 29 0a 09 20 20 20 20 20 28 eys db)).. (
6190: 72 65 6d 66 69 65 6c 64 73 20 28 6c 69 73 74 20 remfields (list
61a0: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
61b0: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
61c0: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
61d0: 69 6d 65 22 29 29 0a 09 20 20 20 20 20 28 68 65 ime")).. (he
61e0: 61 64 65 72 20 20 20 20 28 61 70 70 65 6e 64 20 ader (append
61f0: 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 (map key:get-fie
6200: 6c 64 6e 61 6d 65 20 6b 65 79 73 29 0a 09 09 09 ldname keys)....
6210: 09 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 20 .remfields))..
6220: 20 20 20 28 6b 65 79 73 74 72 20 20 20 20 28 63 (keystr (c
6230: 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 onc (keys->keyst
6240: 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 09 09 20 r keys) ","....
6250: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
6260: 65 72 73 70 65 72 73 65 20 72 65 6d 66 69 65 6c ersperse remfiel
6270: 64 73 20 22 2c 22 29 29 29 29 0a 09 28 64 65 62 ds ","))))..(deb
6280: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
6290: 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 "db:get-run-inf
62a0: 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d o run-id: " run-
62b0: 69 64 20 22 20 68 65 61 64 65 72 3a 20 22 20 68 id " header: " h
62c0: 65 61 64 65 72 20 22 20 6b 65 79 73 74 72 3a 20 eader " keystr:
62d0: 22 20 6b 65 79 73 74 72 29 0a 09 28 73 71 6c 69 " keystr)..(sqli
62e0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
62f0: 0a 09 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 .. (lambda (a .
6300: 78 29 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 x).. (set! res
6310: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
6320: 20 78 29 29 29 0a 09 20 64 62 0a 09 20 28 63 6f x))).. db.. (co
6330: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 79 nc "SELECT " key
6340: 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 str " FROM runs
6350: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 20 WHERE id=?;")..
6360: 72 75 6e 2d 69 64 29 0a 09 28 64 65 62 75 67 3a run-id)..(debug:
6370: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 print-info 11 "d
6380: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 b:get-run-info r
6390: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 un-id: " run-id
63a0: 22 20 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 " header: " head
63b0: 65 72 20 22 20 6b 65 79 73 74 72 3a 20 22 20 6b er " keystr: " k
63c0: 65 79 73 74 72 29 0a 09 28 6c 65 74 20 28 28 66 eystr)..(let ((f
63d0: 69 6e 61 6c 72 65 73 20 28 76 65 63 74 6f 72 20 inalres (vector
63e0: 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 09 20 header res)))..
63f0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
6400: 21 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 ! *run-info-cach
6410: 65 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c 72 e* run-id finalr
6420: 65 73 29 0a 09 20 20 66 69 6e 61 6c 72 65 73 29 es).. finalres)
6430: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
6440: 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 6f 72 :set-comment-for
6450: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 63 -run db run-id c
6460: 6f 6d 6d 65 6e 74 29 0a 20 20 28 64 65 62 75 67 omment). (debug
6470: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
6480: 64 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 db:set-comment-f
6490: 6f 72 2d 72 75 6e 20 53 54 41 52 54 20 72 75 6e or-run START run
64a0: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 -id: " run-id "
64b0: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
64c0: 6e 74 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 nt). (sqlite3:e
64d0: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
64e0: 45 20 72 75 6e 73 20 53 45 54 20 63 6f 6d 6d 65 E runs SET comme
64f0: 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b nt=? WHERE id=?;
6500: 22 20 63 6f 6d 6d 65 6e 74 20 72 75 6e 2d 69 64 " comment run-id
6510: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
6520: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 -info 11 "db:set
6530: 2d 63 6f 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e -comment-for-run
6540: 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 72 END run-id: " r
6550: 75 6e 2d 69 64 20 22 20 63 6f 6d 6d 65 6e 74 3a un-id " comment:
6560: 20 22 20 63 6f 6d 6d 65 6e 74 29 29 0a 0a 3b 3b " comment))..;;
6570: 20 64 6f 65 73 20 6e 6f 74 20 28 6f 62 76 69 6f does not (obvio
6580: 75 73 6c 79 21 29 20 72 65 6d 6f 76 65 64 20 64 usly!) removed d
6590: 65 70 65 6e 64 65 6e 74 20 64 61 74 61 2e 20 42 ependent data. B
65a0: 75 74 20 77 68 79 20 6e 6f 74 21 21 3f 0a 28 64 ut why not!!?.(d
65b0: 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 efine (db:delete
65c0: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 29 0a -run db run-id).
65d0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
65e0: 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 te db "DELETE FR
65f0: 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 OM runs WHERE id
6600: 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 =?;" run-id))..(
6610: 64 65 66 69 6e 65 20 28 64 62 3a 75 70 64 61 74 define (db:updat
6620: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
6630: 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 db run-id). (d
6640: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
6650: 31 31 20 22 64 62 3a 75 70 64 61 74 65 2d 72 75 11 "db:update-ru
6660: 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 53 54 41 n-event_time STA
6670: 52 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e RT run-id: " run
6680: 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 3a -id). (sqlite3:
6690: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
66a0: 54 45 20 72 75 6e 73 20 53 45 54 20 65 76 65 6e TE runs SET even
66b0: 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 t_time=strftime(
66c0: 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 '%s','now') WHER
66d0: 45 20 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 E id=?;" run-id)
66e0: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
66f0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 75 70 64 61 info 11 "db:upda
6700: 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d te-run-event_tim
6710: 65 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 e END run-id: "
6720: 72 75 6e 2d 69 64 29 29 20 0a 0a 28 64 65 66 69 run-id)) ..(defi
6730: 6e 65 20 28 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f ne (db:lock/unlo
6740: 63 6b 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 ck-run db run-id
6750: 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 lock unlock use
6760: 72 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 6c r). (let ((newl
6770: 6f 63 6b 76 61 6c 20 28 69 66 20 6c 6f 63 6b 20 ockval (if lock
6780: 22 6c 6f 63 6b 65 64 22 0a 09 09 09 28 69 66 20 "locked"....(if
6790: 75 6e 6c 6f 63 6b 0a 09 09 09 20 20 20 20 22 75 unlock.... "u
67a0: 6e 6c 6f 63 6b 65 64 22 0a 09 09 09 20 20 20 20 nlocked"....
67b0: 22 6c 6f 63 6b 65 64 22 29 29 29 29 20 3b 3b 20 "locked")))) ;;
67c0: 73 65 6d 69 2d 66 61 69 6c 73 61 66 65 0a 20 20 semi-failsafe.
67d0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
67e0: 74 65 20 64 62 20 22 55 50 44 41 54 45 20 72 75 te db "UPDATE ru
67f0: 6e 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 ns SET state=? W
6800: 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c HERE id=?;" newl
6810: 6f 63 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 ockval run-id).
6820: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
6830: 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 ute db "INSERT I
6840: 4e 54 4f 20 61 63 63 65 73 73 5f 6c 6f 67 20 28 NTO access_log (
6850: 75 73 65 72 2c 61 63 63 65 73 73 65 64 2c 61 72 user,accessed,ar
6860: 67 73 29 20 56 41 4c 55 45 53 28 3f 2c 73 74 72 gs) VALUES(?,str
6870: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
6880: 29 2c 3f 29 3b 22 0a 09 09 20 20 20 20 20 75 73 ),?);"... us
6890: 65 72 20 28 63 6f 6e 63 20 6e 65 77 6c 6f 63 6b er (conc newlock
68a0: 76 61 6c 20 22 20 22 20 72 75 6e 2d 69 64 29 29 val " " run-id))
68b0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
68c0: 74 2d 69 6e 66 6f 20 31 20 22 22 20 6e 65 77 6c t-info 1 "" newl
68d0: 6f 63 6b 76 61 6c 20 22 20 72 75 6e 20 6e 75 6d ockval " run num
68e0: 62 65 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a ber " run-id))).
68f0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 =========.;; K E
6940: 20 59 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d Y S.;;=========
6950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
6990: 3b 20 67 65 74 20 6b 65 79 20 76 61 6c 20 70 61 ; get key val pa
69a0: 69 72 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 irs for a given
69b0: 72 75 6e 2d 69 64 0a 3b 3b 20 28 20 28 46 49 45 run-id.;; ( (FIE
69c0: 4c 44 4e 41 4d 45 31 20 6b 65 79 76 61 6c 31 29 LDNAME1 keyval1)
69d0: 20 28 46 49 45 4c 44 4e 41 4d 45 32 20 6b 65 79 (FIELDNAME2 key
69e0: 76 61 6c 32 29 20 2e 2e 2e 20 29 0a 28 64 65 66 val2) ... ).(def
69f0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d ine (db:get-key-
6a00: 76 61 6c 2d 70 61 69 72 73 20 64 62 20 72 75 6e val-pairs db run
6a10: 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b -id). (let* ((k
6a20: 65 79 73 20 28 67 65 74 2d 6b 65 79 73 20 64 62 eys (get-keys db
6a30: 29 29 0a 09 20 28 72 65 73 20 20 27 28 29 29 29 )).. (res '()))
6a40: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
6a50: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
6a60: 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 t-key-val-pairs
6a70: 53 54 41 52 54 20 6b 65 79 73 3a 20 22 20 6b 65 START keys: " ke
6a80: 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 ys " run-id: " r
6a90: 75 6e 2d 69 64 29 0a 20 20 20 20 28 66 6f 72 2d un-id). (for-
6aa0: 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 each . (lamb
6ab0: 64 61 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 da (key).
6ac0: 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 (let ((qry (conc
6ad0: 20 22 53 45 4c 45 43 54 20 22 20 28 6b 65 79 3a "SELECT " (key:
6ae0: 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 get-fieldname ke
6af0: 79 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 y) " FROM runs W
6b00: 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a 09 HERE id=?;")))..
6b10: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
6b20: 20 30 20 22 71 72 79 3a 20 22 20 71 72 79 29 0a 0 "qry: " qry).
6b30: 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 . (sqlite3:for-e
6b40: 61 63 68 2d 72 6f 77 20 0a 09 20 20 28 6c 61 6d ach-row .. (lam
6b50: 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09 20 bda (key-val)..
6b60: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
6b70: 6e 73 20 28 6c 69 73 74 20 28 6b 65 79 3a 67 65 ns (list (key:ge
6b80: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 t-fieldname key)
6b90: 20 6b 65 79 2d 76 61 6c 29 20 72 65 73 29 29 29 key-val) res)))
6ba0: 0a 09 20 20 64 62 20 71 72 79 20 72 75 6e 2d 69 .. db qry run-i
6bb0: 64 29 29 29 0a 20 20 20 20 20 6b 65 79 73 29 0a d))). keys).
6bc0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6bd0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6be0: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 45 -key-val-pairs E
6bf0: 4e 44 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 ND keys: " keys
6c00: 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d " run-id: " run-
6c10: 69 64 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 id). (reverse
6c20: 20 72 65 73 29 29 29 0a 0a 3b 3b 20 67 65 74 20 res)))..;; get
6c30: 6b 65 79 20 76 61 6c 73 20 66 6f 72 20 61 20 67 key vals for a g
6c40: 69 76 65 6e 20 72 75 6e 2d 69 64 0a 28 64 65 66 iven run-id.(def
6c50: 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d ine (db:get-key-
6c60: 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vals db run-id).
6c70: 20 20 28 6c 65 74 20 28 28 6d 79 6b 65 79 76 61 (let ((mykeyva
6c80: 6c 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ls (hash-table-r
6c90: 65 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 ef/default *keyv
6ca0: 61 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 als* run-id #f))
6cb0: 29 0a 20 20 20 20 28 69 66 20 6d 79 6b 65 79 76 ). (if mykeyv
6cc0: 61 6c 73 20 0a 09 6d 79 6b 65 79 76 61 6c 73 0a als ..mykeyvals.
6cd0: 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 28 67 .(let* ((keys (g
6ce0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 et-keys db))..
6cf0: 20 20 20 20 20 28 72 65 73 20 20 27 28 29 29 29 (res '()))
6d00: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
6d10: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6d20: 2d 6b 65 79 2d 76 61 6c 73 20 53 54 41 52 54 20 -key-vals START
6d30: 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 72 keys: " keys " r
6d40: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 un-id: " run-id)
6d50: 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 .. (for-each ..
6d60: 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 (lambda (key)
6d70: 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 .. (let ((qr
6d80: 79 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 y (conc "SELECT
6d90: 22 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 " (key:get-field
6da0: 6e 61 6d 65 20 6b 65 79 29 20 22 20 46 52 4f 4d name key) " FROM
6db0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
6dc0: 3b 22 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ;"))).. ;;
6dd0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6de0: 22 71 72 79 3a 20 22 20 71 72 79 29 0a 09 20 20 "qry: " qry)..
6df0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f (sqlite3:fo
6e00: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 09 28 6c r-each-row ...(l
6e10: 61 6d 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a ambda (key-val).
6e20: 09 09 20 20 28 73 65 74 21 20 72 65 73 20 28 63 .. (set! res (c
6e30: 6f 6e 73 20 6b 65 79 2d 76 61 6c 20 72 65 73 29 ons key-val res)
6e40: 29 29 0a 09 09 64 62 20 71 72 79 20 72 75 6e 2d ))...db qry run-
6e50: 69 64 29 29 29 0a 09 20 20 20 6b 65 79 73 29 0a id))).. keys).
6e60: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
6e70: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
6e80: 6b 65 79 2d 76 61 6c 73 20 45 4e 44 20 6b 65 79 key-vals END key
6e90: 73 3a 20 22 20 6b 65 79 73 20 22 20 72 75 6e 2d s: " keys " run-
6ea0: 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 20 id: " run-id)..
6eb0: 20 28 6c 65 74 20 28 28 66 69 6e 61 6c 2d 72 65 (let ((final-re
6ec0: 73 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 s (reverse res))
6ed0: 29 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ).. (hash-tab
6ee0: 6c 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 le-set! *keyvals
6ef0: 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c 2d 72 * run-id final-r
6f00: 65 73 29 0a 09 20 20 20 20 66 69 6e 61 6c 2d 72 es).. final-r
6f10: 65 73 29 29 29 29 29 0a 0a 3b 3b 20 54 68 65 20 es)))))..;; The
6f20: 74 61 72 67 65 74 20 69 73 20 6b 65 79 76 61 6c target is keyval
6f30: 31 2f 6b 65 79 76 61 6c 32 2e 2e 2e 2c 20 63 61 1/keyval2..., ca
6f40: 63 68 65 64 20 69 6e 20 2a 74 61 72 67 65 74 2a ched in *target*
6f50: 20 61 73 20 69 74 20 69 73 20 75 73 65 64 20 6f as it is used o
6f60: 66 74 65 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 ften.(define (db
6f70: 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 :get-target db r
6f80: 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 un-id). (let ((
6f90: 6d 79 74 61 72 67 20 28 68 61 73 68 2d 74 61 62 mytarg (hash-tab
6fa0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
6fb0: 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 64 20 23 target* run-id #
6fc0: 66 29 29 29 0a 20 20 20 20 28 69 66 20 6d 79 74 f))). (if myt
6fd0: 61 72 67 0a 09 6d 79 74 61 72 67 0a 09 28 6c 65 arg..mytarg..(le
6fe0: 74 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 64 62 t* ((keyvals (db
6ff0: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 :get-key-vals db
7000: 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 run-id))..
7010: 20 20 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 (thekey (stri
7020: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
7030: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 map (lambda (x)(
7040: 69 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 if x x "-na-"))
7050: 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 29 0a keyvals) "/"))).
7060: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
7070: 65 74 21 20 2a 74 61 72 67 65 74 2a 20 72 75 6e et! *target* run
7080: 2d 69 64 20 74 68 65 6b 65 79 29 0a 09 20 20 74 -id thekey).. t
7090: 68 65 6b 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d hekey))))..;;===
70a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
70e0: 3d 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 ===.;; T E S T
70f0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
7100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7110: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
7140: 69 6e 65 20 28 64 62 3a 74 65 73 74 73 2d 72 65 ine (db:tests-re
7150: 67 69 73 74 65 72 2d 74 65 73 74 20 64 62 20 72 gister-test db r
7160: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
7170: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 64 65 item-path). (de
7180: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
7190: 31 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 69 1 "db:tests-regi
71a0: 73 74 65 72 2d 74 65 73 74 20 53 54 41 52 54 20 ster-test START
71b0: 64 62 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 db=" db ", run-i
71c0: 64 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 d=" run-id ", te
71d0: 73 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e st-name=" test-n
71e0: 61 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 ame ", item-path
71f0: 3d 5c 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 =\"" item-path "
7200: 5c 22 22 29 0a 20 20 28 6c 65 74 20 28 28 69 74 \""). (let ((it
7210: 65 6d 2d 70 61 74 68 73 20 28 69 66 20 28 65 71 em-paths (if (eq
7220: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
7230: 22 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d ")....(list item
7240: 2d 70 61 74 68 29 0a 09 09 09 28 6c 69 73 74 20 -path)....(list
7250: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 29 item-path ""))))
7260: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a . (for-each .
7270: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 74 (lambda (pt
7280: 68 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 h). (sqlit
7290: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 e3:execute db "I
72a0: 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 NSERT OR IGNORE
72b0: 49 4e 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f INTO tests (run_
72c0: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e id,testname,even
72d0: 74 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 t_time,item_path
72e0: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 ,state,status) V
72f0: 41 4c 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 ALUES (?,?,strft
7300: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c ime('%s','now'),
7310: 3f 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c ?,'NOT_STARTED',
7320: 27 6e 2f 61 27 29 3b 22 20 0a 09 09 09 72 75 6e 'n/a');" ....run
7330: 2d 69 64 20 0a 09 09 09 74 65 73 74 2d 6e 61 6d -id ....test-nam
7340: 65 0a 09 09 09 70 74 68 29 29 0a 20 20 20 20 20 e....pth)).
7350: 69 74 65 6d 2d 70 61 74 68 73 29 0a 20 20 28 64 item-paths). (d
7360: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7370: 31 31 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 11 "db:tests-reg
7380: 69 73 74 65 72 2d 74 65 73 74 20 45 4e 44 20 64 ister-test END d
7390: 62 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 64 b=" db ", run-id
73a0: 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 =" run-id ", tes
73b0: 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61 t-name=" test-na
73c0: 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 3d me ", item-path=
73d0: 5c 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 5c \"" item-path "\
73e0: 22 22 29 0a 20 20 20 20 23 66 29 29 0a 0a 0a 3b ""). #f))...;
73f0: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 ; states and sta
7400: 74 75 73 65 73 20 61 72 65 20 6c 69 73 74 73 2c tuses are lists,
7410: 20 74 75 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20 turn them into
7420: 28 22 50 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e ("PASS","FAIL"..
7430: 2e 29 20 61 6e 64 20 75 73 65 20 4e 4f 54 20 49 .) and use NOT I
7440: 4e 0a 3b 3b 20 69 2e 65 2e 20 74 68 65 73 65 20 N.;; i.e. these
7450: 6c 69 73 74 73 20 64 65 66 69 6e 65 20 77 68 61 lists define wha
7460: 74 20 74 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b t to NOT show..;
7470: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 ; states and sta
7480: 74 75 73 65 73 20 61 72 65 20 72 65 71 75 69 72 tuses are requir
7490: 65 64 20 74 6f 20 62 65 20 6c 69 73 74 73 2c 20 ed to be lists,
74a0: 65 6d 70 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e empty is ok.;; n
74b0: 6f 74 2d 69 6e 20 23 74 20 3d 20 61 62 6f 76 65 ot-in #t = above
74c0: 20 62 65 68 61 76 69 6f 75 72 2c 20 23 66 20 3d behaviour, #f =
74d0: 20 6d 75 73 74 20 6d 61 74 63 68 0a 28 64 65 66 must match.(def
74e0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ine (db:get-test
74f0: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e s-for-run db run
7500: 2d 69 64 20 74 65 73 74 70 61 74 74 20 73 74 61 -id testpatt sta
7510: 74 65 73 20 73 74 61 74 75 73 65 73 20 0a 09 09 tes statuses ...
7520: 09 20 20 20 20 20 20 23 21 6b 65 79 20 28 6e 6f . #!key (no
7530: 74 2d 69 6e 20 23 74 29 0a 09 09 09 20 20 20 20 t-in #t)....
7540: 20 20 28 73 6f 72 74 2d 62 79 20 23 66 29 20 3b (sort-by #f) ;
7550: 3b 20 27 72 75 6e 64 69 72 20 27 65 76 65 6e 74 ; 'rundir 'event
7560: 5f 74 69 6d 65 0a 09 09 09 20 20 20 20 20 20 29 _time.... )
7570: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
7580: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
7590: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 tests-for-run ST
75a0: 41 52 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e ART run-id=" run
75b0: 2d 69 64 20 22 2c 20 74 65 73 74 70 61 74 74 3d -id ", testpatt=
75c0: 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 " testpatt ", st
75d0: 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c ates=" states ",
75e0: 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 statuses=" stat
75f0: 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 uses ", not-in="
7600: 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d not-in ", sort-
7610: 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 by=" sort-by).
7620: 28 6c 65 74 2a 20 28 28 72 65 73 20 27 28 29 29 (let* ((res '())
7630: 0a 09 20 3b 3b 20 69 66 20 73 74 61 74 65 73 20 .. ;; if states
7640: 6f 72 20 73 74 61 74 75 73 65 73 20 61 72 65 20 or statuses are
7650: 6e 75 6c 6c 20 74 68 65 6e 20 61 73 73 75 6d 65 null then assume
7660: 20 6d 61 74 63 68 20 61 6c 6c 20 77 68 65 6e 20 match all when
7670: 6e 6f 74 2d 69 6e 20 69 73 20 66 61 6c 73 65 0a not-in is false.
7680: 09 20 28 73 74 61 74 65 73 2d 71 72 79 20 20 20 . (states-qry
7690: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 (if (null? st
76a0: 61 74 65 73 29 20 0a 09 09 09 20 20 20 20 20 20 ates) ....
76b0: 23 66 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e #f.... (con
76c0: 63 20 22 20 73 74 61 74 65 20 22 20 20 0a 09 09 c " state " ...
76d0: 09 09 20 20 20 20 28 69 66 20 6e 6f 74 2d 69 6e .. (if not-in
76e0: 20 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 09 09 "NOT" "") .....
76f0: 20 20 20 20 22 20 49 4e 20 28 27 22 20 0a 09 09 " IN ('" ...
7700: 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e .. (string-in
7710: 74 65 72 73 70 65 72 73 65 20 73 74 61 74 65 73 tersperse states
7720: 20 20 20 22 27 2c 27 22 29 0a 09 09 09 09 20 20 "','").....
7730: 20 20 22 27 29 22 29 29 29 0a 09 20 28 73 74 61 "')"))).. (sta
7740: 74 75 73 65 73 2d 71 72 79 20 20 20 20 28 69 66 tuses-qry (if
7750: 20 28 6e 75 6c 6c 3f 20 73 74 61 74 75 73 65 73 (null? statuses
7760: 29 0a 09 09 09 20 20 20 20 20 20 23 66 0a 09 09 ).... #f...
7770: 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 73 . (conc " s
7780: 74 61 74 75 73 20 22 0a 09 09 09 09 20 20 20 20 tatus ".....
7790: 28 69 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54 22 (if not-in "NOT"
77a0: 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 22 20 "") ..... "
77b0: 49 4e 20 28 27 22 20 0a 09 09 09 09 20 20 20 20 IN ('" .....
77c0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
77d0: 72 73 65 20 73 74 61 74 75 73 65 73 20 22 27 2c rse statuses "',
77e0: 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29 22 '")..... "')"
77f0: 29 29 29 0a 09 20 28 74 65 73 74 73 2d 6d 61 74 ))).. (tests-mat
7800: 63 68 2d 71 72 79 20 28 74 65 73 74 73 3a 6d 61 ch-qry (tests:ma
7810: 74 63 68 2d 3e 73 71 6c 71 72 79 20 74 65 73 74 tch->sqlqry test
7820: 70 61 74 74 29 29 0a 09 20 28 71 72 79 20 20 20 patt)).. (qry
7830: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 (conc
7840: 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e 5f 69 "SELECT id,run_i
7850: 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 d,testname,state
7860: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
7870: 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c me,host,cpuload,
7880: 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 diskfree,uname,r
7890: 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c undir,item_path,
78a0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e run_duration,fin
78b0: 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 al_logf,comment
78c0: 22 0a 09 09 09 09 22 20 46 52 4f 4d 20 74 65 73 "....." FROM tes
78d0: 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d ts WHERE run_id=
78e0: 3f 20 22 0a 09 09 09 09 28 69 66 20 73 74 61 74 ? ".....(if stat
78f0: 65 73 2d 71 72 79 20 20 20 28 63 6f 6e 63 20 22 es-qry (conc "
7900: 20 41 4e 44 20 22 20 73 74 61 74 65 73 2d 71 72 AND " states-qr
7910: 79 29 20 20 20 22 22 29 0a 09 09 09 09 28 69 66 y) "").....(if
7920: 20 73 74 61 74 75 73 65 73 2d 71 72 79 20 28 63 statuses-qry (c
7930: 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 onc " AND " stat
7940: 75 73 65 73 2d 71 72 79 29 20 22 22 29 0a 09 09 uses-qry) "")...
7950: 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 74 63 ..(if tests-matc
7960: 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 41 4e h-qry (conc " AN
7970: 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 63 68 D (" tests-match
7980: 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 0a 09 -qry ") ") "")..
7990: 09 09 09 28 63 61 73 65 20 73 6f 72 74 2d 62 79 ...(case sort-by
79a0: 0a 09 09 09 09 20 20 28 28 72 75 6e 64 69 72 29 ..... ((rundir)
79b0: 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 " ORDER BY
79c0: 6c 65 6e 67 74 68 28 72 75 6e 64 69 72 29 20 44 length(rundir) D
79d0: 45 53 43 3b 22 29 0a 09 09 09 09 20 20 28 28 65 ESC;")..... ((e
79e0: 76 65 6e 74 5f 74 69 6d 65 29 20 22 20 4f 52 44 vent_time) " ORD
79f0: 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 ER BY event_time
7a00: 20 41 53 43 3b 22 29 0a 09 09 09 09 20 20 28 65 ASC;")..... (e
7a10: 6c 73 65 20 20 20 20 20 20 20 20 20 22 3b 22 29 lse ";")
7a20: 29 0a 09 09 09 20 29 29 29 0a 20 20 20 20 28 64 ).... ))). (d
7a30: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7a40: 38 20 22 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 8 "db:get-tests-
7a50: 66 6f 72 2d 72 75 6e 20 71 72 79 3d 22 20 71 72 for-run qry=" qr
7a60: 79 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a y). (sqlite3:
7a70: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 for-each-row .
7a80: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 (lambda (a .
7a90: 62 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 b) ;; id run-id
7aa0: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
7ab0: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
7ac0: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
7ad0: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
7ae0: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
7af0: 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n-duration final
7b00: 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 20 -logf comment).
7b10: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
7b20: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 (cons (apply vec
7b30: 74 6f 72 20 61 20 62 29 20 72 65 73 29 29 29 20 tor a b) res)))
7b40: 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 ;; id run-id tes
7b50: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
7b60: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
7b70: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
7b80: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
7b90: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 item-path run-d
7ba0: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c 6f uration final-lo
7bb0: 67 66 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 gf comment) res)
7bc0: 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 )). db .
7bd0: 20 71 72 79 0a 20 20 20 20 20 72 75 6e 2d 69 64 qry. run-id
7be0: 0a 20 20 20 20 20 3b 3b 20 28 69 66 20 74 65 73 . ;; (if tes
7bf0: 74 70 61 74 74 20 74 65 73 74 70 61 74 74 20 22 tpatt testpatt "
7c00: 25 22 29 0a 20 20 20 20 20 3b 3b 20 28 69 66 20 %"). ;; (if
7c10: 69 74 65 6d 70 61 74 74 20 69 74 65 6d 70 61 74 itempatt itempat
7c20: 74 20 22 25 22 29 29 0a 20 20 20 20 20 29 0a 20 t "%")). ).
7c30: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
7c40: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
7c50: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 tests-for-run ST
7c60: 41 52 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e ART run-id=" run
7c70: 2d 69 64 20 22 2c 20 74 65 73 74 70 61 74 74 3d -id ", testpatt=
7c80: 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 " testpatt ", st
7c90: 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c ates=" states ",
7ca0: 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 statuses=" stat
7cb0: 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 uses ", not-in="
7cc0: 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d not-in ", sort-
7cd0: 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 by=" sort-by).
7ce0: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 74 68 69 73 res))..;; this
7cf0: 20 6f 6e 65 20 69 73 20 61 20 62 69 74 20 62 72 one is a bit br
7d00: 6f 6b 65 6e 20 42 55 47 20 46 49 58 4d 45 0a 28 oken BUG FIXME.(
7d10: 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 define (db:delet
7d20: 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f e-test-step-reco
7d30: 72 64 73 20 64 62 20 74 65 73 74 2d 69 64 29 0a rds db test-id).
7d40: 20 20 3b 3b 20 42 72 65 61 6b 69 6e 67 20 69 74 ;; Breaking it
7d50: 20 69 6e 74 6f 20 74 77 6f 20 71 75 65 72 69 65 into two querie
7d60: 73 20 66 6f 72 20 62 65 74 74 65 72 20 66 69 6c s for better fil
7d70: 65 20 61 63 63 65 73 73 20 69 6e 74 65 72 6c 65 e access interle
7d80: 61 76 69 6e 67 0a 20 20 28 6c 65 74 2a 20 28 28 aving. (let* ((
7d90: 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 tdb (db:open-tes
7da0: 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
7db0: 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 db test-id))).
7dc0: 20 20 3b 3b 20 74 65 73 74 20 64 62 27 73 20 63 ;; test db's c
7dd0: 61 6e 20 67 6f 20 61 77 61 79 20 2d 20 6d 75 73 an go away - mus
7de0: 74 20 63 68 65 63 6b 20 65 76 65 72 79 20 74 69 t check every ti
7df0: 6d 65 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 me. (if tdb..
7e00: 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
7e10: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
7e20: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
7e30: 5f 73 74 65 70 73 3b 22 29 0a 09 20 20 28 73 71 _steps;").. (sq
7e40: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 lite3:execute td
7e50: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
7e60: 65 73 74 5f 64 61 74 61 3b 22 29 0a 09 20 20 28 est_data;").. (
7e70: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
7e80: 21 20 74 64 62 29 29 29 29 29 0a 0a 3b 3b 20 0a ! tdb)))))..;; .
7e90: 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 (define (db:dele
7ea0: 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 te-test-records
7eb0: 64 62 20 74 64 62 20 74 65 73 74 2d 69 64 20 23 db tdb test-id #
7ec0: 21 6b 65 79 20 28 66 6f 72 63 65 20 23 66 29 29 !key (force #f))
7ed0: 0a 20 20 28 69 66 20 74 64 62 20 0a 20 20 20 20 . (if tdb .
7ee0: 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 (begin..(sqlit
7ef0: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
7f00: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
7f10: 5f 73 74 65 70 73 3b 22 29 0a 09 28 73 71 6c 69 _steps;")..(sqli
7f20: 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 te3:execute tdb
7f30: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 "DELETE FROM tes
7f40: 74 5f 64 61 74 61 3b 22 29 29 29 0a 20 20 3b 3b t_data;"))). ;;
7f50: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
7f60: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f e db "DELETE FRO
7f70: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 M tests WHERE id
7f80: 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 29 0a 20 =?;" test-id)).
7f90: 20 28 69 66 20 64 62 20 0a 20 20 20 20 20 20 28 (if db . (
7fa0: 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 65 33 3a begin..(sqlite3:
7fb0: 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 execute db "DELE
7fc0: 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 TE FROM test_ste
7fd0: 70 73 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 ps WHERE test_id
7fe0: 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 0a 09 28 =?;" test-id)..(
7ff0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
8000: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 db "DELETE FROM
8010: 74 65 73 74 5f 64 61 74 61 20 20 57 48 45 52 45 test_data WHERE
8020: 20 74 65 73 74 5f 69 64 3d 3f 3b 22 20 74 65 73 test_id=?;" tes
8030: 74 2d 69 64 29 0a 09 28 69 66 20 66 6f 72 63 65 t-id)..(if force
8040: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 .. (sqlite3:e
8050: 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 xecute db "DELET
8060: 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 E FROM tests WHE
8070: 52 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 RE id=?;" test-i
8080: 64 29 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 d).. (sqlite3
8090: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
80a0: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
80b0: 61 74 65 3d 27 44 45 4c 45 54 45 44 27 2c 73 74 ate='DELETED',st
80c0: 61 74 75 73 3d 27 6e 2f 61 27 20 57 48 45 52 45 atus='n/a' WHERE
80d0: 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 id=?;" test-id)
80e0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ))))..(define (d
80f0: 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 66 b:delete-tests-f
8100: 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 or-run db run-id
8110: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
8120: 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 cute db "DELETE
8130: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
8140: 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 72 75 6e 2d run_id=?;" run-
8150: 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 id))..(define (d
8160: 62 3a 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c b:delete-old-del
8170: 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 eted-test-record
8180: 73 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 74 s db). (let ((t
8190: 61 72 67 74 69 6d 65 20 28 2d 20 28 63 75 72 72 argtime (- (curr
81a0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2a 20 33 ent-seconds)(* 3
81b0: 30 20 32 34 20 36 30 20 36 30 29 29 29 29 20 3b 0 24 60 60)))) ;
81c0: 3b 20 6f 6e 65 20 6d 6f 6e 74 68 20 69 6e 20 74 ; one month in t
81d0: 68 65 20 70 61 73 74 0a 20 20 20 20 28 73 71 6c he past. (sql
81e0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
81f0: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 "DELETE FROM tes
8200: 74 73 20 57 48 45 52 45 20 73 74 61 74 65 3d 27 ts WHERE state='
8210: 44 45 4c 45 54 45 44 27 20 41 4e 44 20 65 76 65 DELETED' AND eve
8220: 6e 74 5f 74 69 6d 65 3c 3f 3b 22 20 74 61 72 67 nt_time<?;" targ
8230: 74 69 6d 65 29 29 29 0a 0a 3b 3b 20 73 65 74 20 time)))..;; set
8240: 74 65 73 74 73 20 77 69 74 68 20 73 74 61 74 65 tests with state
8250: 20 63 75 72 72 73 74 61 74 65 20 61 6e 64 20 73 currstate and s
8260: 74 61 74 75 73 20 63 75 72 72 73 74 61 74 75 73 tatus currstatus
8270: 20 74 6f 20 6e 65 77 73 74 61 74 65 20 61 6e 64 to newstate and
8280: 20 6e 65 77 73 74 61 74 75 73 0a 3b 3b 20 75 73 newstatus.;; us
8290: 65 20 63 75 72 72 73 74 61 74 65 20 3d 20 23 66 e currstate = #f
82a0: 20 61 6e 64 20 6f 72 20 63 75 72 72 73 74 61 74 and or currstat
82b0: 75 73 20 3d 20 23 66 20 74 6f 20 61 70 70 6c 79 us = #f to apply
82c0: 20 74 6f 20 61 6e 79 20 73 74 61 74 65 20 6f 72 to any state or
82d0: 20 73 74 61 74 75 73 20 72 65 73 70 65 63 74 69 status respecti
82e0: 76 65 6c 79 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a vely.;; WARNING:
82f0: 20 53 51 4c 20 69 6e 6a 65 63 74 69 6f 6e 20 72 SQL injection r
8300: 69 73 6b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a isk.(define (db:
8310: 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
8320: 73 74 61 74 75 73 20 64 62 20 72 75 6e 2d 69 64 status db run-id
8330: 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 72 73 testnames currs
8340: 74 61 74 65 20 63 75 72 72 73 74 61 74 75 73 20 tate currstatus
8350: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 newstate newstat
8360: 75 73 29 0a 20 20 28 66 6f 72 2d 65 61 63 68 20 us). (for-each
8370: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d (lambda (testnam
8380: 65 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 e).. (let (
8390: 28 71 72 79 20 28 63 6f 6e 63 20 22 55 50 44 41 (qry (conc "UPDA
83a0: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
83b0: 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 te=?,status=? WH
83c0: 45 52 45 20 22 0a 09 09 09 20 20 20 20 20 20 20 ERE "....
83d0: 28 69 66 20 63 75 72 72 73 74 61 74 65 20 20 28 (if currstate (
83e0: 63 6f 6e 63 20 22 73 74 61 74 65 3d 27 22 20 63 conc "state='" c
83f0: 75 72 72 73 74 61 74 65 20 22 27 20 41 4e 44 20 urrstate "' AND
8400: 22 29 20 22 22 29 0a 09 09 09 20 20 20 20 20 20 ") "")....
8410: 20 28 69 66 20 63 75 72 72 73 74 61 74 75 73 20 (if currstatus
8420: 28 63 6f 6e 63 20 22 73 74 61 74 75 73 3d 27 22 (conc "status='"
8430: 20 63 75 72 72 73 74 61 74 75 73 20 22 27 20 41 currstatus "' A
8440: 4e 44 20 22 29 20 22 22 29 0a 09 09 09 20 20 20 ND ") "")....
8450: 20 20 20 20 22 20 72 75 6e 5f 69 64 3d 3f 20 41 " run_id=? A
8460: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
8470: 44 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 68 D NOT (item_path
8480: 3d 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 ='' AND testname
8490: 20 69 6e 20 28 53 45 4c 45 43 54 20 44 49 53 54 in (SELECT DIST
84a0: 49 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 INCT testname FR
84b0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 74 OM tests WHERE t
84c0: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
84d0: 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 3b em_path != ''));
84e0: 22 29 29 29 0a 09 09 3b 3b 28 64 65 62 75 67 3a ")))...;;(debug:
84f0: 70 72 69 6e 74 20 30 20 22 51 52 59 3a 20 22 20 print 0 "QRY: "
8500: 71 72 79 29 0a 09 09 28 73 71 6c 69 74 65 33 3a qry)...(sqlite3:
8510: 65 78 65 63 75 74 65 20 64 62 20 71 72 79 20 72 execute db qry r
8520: 75 6e 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e un-id newstate n
8530: 65 77 73 74 61 74 75 73 20 74 65 73 74 6e 61 6d ewstatus testnam
8540: 65 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 20 e testname)))..
8550: 20 20 20 74 65 73 74 6e 61 6d 65 73 29 29 0a 0a testnames))..
8560: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 64 65 6c (define (cdb:del
8570: 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 ete-tests-in-sta
8580: 74 65 20 7a 6d 71 73 6f 63 6b 65 74 20 72 75 6e te zmqsocket run
8590: 2d 69 64 20 73 74 61 74 65 29 0a 20 20 28 63 64 -id state). (cd
85a0: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d b:client-call zm
85b0: 71 73 6f 63 6b 65 74 20 27 64 65 6c 65 74 65 2d qsocket 'delete-
85c0: 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 65 20 23 tests-in-state #
85d0: 74 20 72 75 6e 2d 69 64 20 73 74 61 74 65 29 29 t run-id state))
85e0: 0a 0a 3b 3b 20 73 70 65 65 64 20 75 70 20 66 6f ..;; speed up fo
85f0: 72 20 63 6f 6d 6d 6f 6e 20 63 61 73 65 73 20 77 r common cases w
8600: 69 74 68 20 61 20 6c 69 74 74 6c 65 20 6c 6f 67 ith a little log
8610: 69 63 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 ic.(define (db:t
8620: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
8630: 61 74 75 73 2d 62 79 2d 69 64 20 64 62 20 74 65 atus-by-id db te
8640: 73 74 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e st-id newstate n
8650: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
8660: 65 6e 74 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 ent). (cond.
8670: 28 28 61 6e 64 20 6e 65 77 73 74 61 74 65 20 6e ((and newstate n
8680: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
8690: 65 6e 74 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ent). (sqlite
86a0: 33 3a 65 78 65 63 74 75 74 65 20 64 62 20 22 55 3:exectute db "U
86b0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
86c0: 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f state=?,status=?
86d0: 2c 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 ,comment=? WHERE
86e0: 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 id=?;" newstate
86f0: 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 74 2d newstatus test-
8700: 69 64 29 29 0a 20 20 20 28 28 61 6e 64 20 6e 65 id)). ((and ne
8710: 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 wstate newstatus
8720: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
8730: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
8740: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
8750: 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 45 e=?,status=? WHE
8760: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 RE id=?;" newsta
8770: 74 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 te newstatus tes
8780: 74 2d 69 64 29 29 0a 20 20 20 28 65 6c 73 65 0a t-id)). (else.
8790: 20 20 20 20 28 69 66 20 6e 65 77 73 74 61 74 65 (if newstate
87a0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
87b0: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
87c0: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f ests SET state=?
87d0: 20 20 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 WHERE id=?;"
87e0: 6e 65 77 73 74 61 74 65 20 20 20 74 65 73 74 2d newstate test-
87f0: 69 64 29 29 0a 20 20 20 20 28 69 66 20 6e 65 77 id)). (if new
8800: 73 74 61 74 75 73 20 20 28 73 71 6c 69 74 65 33 status (sqlite3
8810: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
8820: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
8830: 61 74 75 73 3d 3f 20 20 57 48 45 52 45 20 69 64 atus=? WHERE id
8840: 3d 3f 3b 22 20 6e 65 77 73 74 61 74 75 73 20 20 =?;" newstatus
8850: 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 28 69 test-id)). (i
8860: 66 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 28 73 71 f newcomment (sq
8870: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
8880: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
8890: 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 ET comment=? WHE
88a0: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 63 6f 6d RE id=?;" newcom
88b0: 6d 65 6e 74 20 74 65 73 74 2d 69 64 29 29 29 29 ment test-id))))
88c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 )..(define (db:t
88d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
88e0: 61 74 75 73 2d 62 79 2d 72 75 6e 2d 69 64 2d 74 atus-by-run-id-t
88f0: 65 73 74 6e 61 6d 65 20 64 62 20 72 75 6e 2d 69 estname db run-i
8900: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
8910: 2d 70 61 74 68 20 73 74 61 74 75 73 20 73 74 61 -path status sta
8920: 74 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 te). (sqlite3:e
8930: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
8940: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
8950: 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 65 76 65 e=?,status=?,eve
8960: 6e 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 nt_time=strftime
8970: 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 ('%s','now') WHE
8980: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
8990: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
89a0: 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 0a 09 09 tem_path=?;" ...
89b0: 20 20 20 73 74 61 74 65 20 73 74 61 74 75 73 20 state status
89c0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
89d0: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 item-path))..(d
89e0: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 63 6f efine (db:get-co
89f0: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
8a00: 67 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 g db). (let ((r
8a10: 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 6c 69 es 0)). (sqli
8a20: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
8a30: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 . (lambda (c
8a40: 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 ount). (se
8a50: 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 t! res count)).
8a60: 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c db. "SEL
8a70: 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 ECT count(id) FR
8a80: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 73 OM tests WHERE s
8a90: 74 61 74 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e tate in ('RUNNIN
8aa0: 47 27 2c 27 4c 41 55 4e 43 48 45 44 27 2c 27 52 G','LAUNCHED','R
8ab0: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 29 EMOTEHOSTSTART')
8ac0: 3b 22 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 ;"). res))..(
8ad0: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 63 define (db:get-c
8ae0: 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 ount-tests-runni
8af0: 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 64 ng-in-jobgroup d
8b00: 62 20 6a 6f 62 67 72 6f 75 70 29 0a 20 20 28 69 b jobgroup). (i
8b10: 66 20 28 6e 6f 74 20 6a 6f 62 67 72 6f 75 70 29 f (not jobgroup)
8b20: 0a 20 20 20 20 20 20 30 20 3b 3b 20 0a 20 20 20 . 0 ;; .
8b30: 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 (let ((res 0)
8b40: 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d )..(sqlite3:for-
8b50: 65 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 each-row.. (lamb
8b60: 64 61 20 28 63 6f 75 6e 74 29 0a 09 20 20 20 28 da (count).. (
8b70: 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 set! res count))
8b80: 0a 09 20 64 62 0a 09 20 22 53 45 4c 45 43 54 20 .. db.. "SELECT
8b90: 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 count(id) FROM t
8ba0: 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 ests WHERE state
8bb0: 20 3d 20 27 52 55 4e 4e 49 4e 47 27 20 4f 52 20 = 'RUNNING' OR
8bc0: 73 74 61 74 65 20 3d 20 27 4c 41 55 4e 43 48 45 state = 'LAUNCHE
8bd0: 44 27 20 4f 52 20 73 74 61 74 65 20 3d 20 27 52 D' OR state = 'R
8be0: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 0a EMOTEHOSTSTART'.
8bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 41 4e 44 AND
8c00: 20 74 65 73 74 6e 61 6d 65 20 69 6e 20 28 53 45 testname in (SE
8c10: 4c 45 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 LECT testname FR
8c20: 4f 4d 20 74 65 73 74 5f 6d 65 74 61 20 57 48 45 OM test_meta WHE
8c30: 52 45 20 6a 6f 62 67 72 6f 75 70 3d 3f 3b 22 0a RE jobgroup=?;".
8c40: 09 20 6a 6f 62 67 72 6f 75 70 29 0a 09 72 65 73 . jobgroup)..res
8c50: 29 29 29 0a 0a 3b 3b 20 64 6f 6e 65 20 77 69 74 )))..;; done wit
8c60: 68 20 72 75 6e 20 77 68 65 6e 3a 0a 3b 3b 20 20 h run when:.;;
8c70: 20 30 20 74 65 73 74 73 20 69 6e 20 4c 41 55 4e 0 tests in LAUN
8c80: 43 48 45 44 2c 20 4e 4f 54 5f 53 54 41 52 54 45 CHED, NOT_STARTE
8c90: 44 2c 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 D, REMOTEHOSTSTA
8ca0: 52 54 2c 20 52 55 4e 4e 49 4e 47 0a 28 64 65 66 RT, RUNNING.(def
8cb0: 69 6e 65 20 28 64 62 3a 65 73 74 69 6d 61 74 65 ine (db:estimate
8cc0: 64 2d 74 65 73 74 73 2d 72 65 6d 61 69 6e 69 6e d-tests-remainin
8cd0: 67 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 g db run-id). (
8ce0: 6c 65 74 20 28 28 72 65 73 20 30 29 29 0a 20 20 let ((res 0)).
8cf0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
8d00: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
8d10: 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 mbda (count).
8d20: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 63 6f (set! res co
8d30: 75 6e 74 29 29 0a 20 20 20 20 20 64 62 20 3b 3b unt)). db ;;
8d40: 20 4e 42 2f 2f 20 4b 49 4c 4c 52 45 51 20 6d 65 NB// KILLREQ me
8d50: 61 6e 73 20 74 68 65 20 6a 6f 62 73 20 69 73 20 ans the jobs is
8d60: 73 74 69 6c 6c 20 70 72 6f 62 61 62 6c 79 20 72 still probably r
8d70: 75 6e 6e 69 6e 67 0a 20 20 20 20 20 22 53 45 4c unning. "SEL
8d80: 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 ECT count(id) FR
8d90: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 73 OM tests WHERE s
8da0: 74 61 74 65 20 69 6e 20 28 27 4c 41 55 4e 43 48 tate in ('LAUNCH
8db0: 45 44 27 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 ED','NOT_STARTED
8dc0: 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 ','REMOTEHOSTSTA
8dd0: 52 54 27 2c 27 52 55 4e 4e 49 4e 47 27 2c 27 4b RT','RUNNING','K
8de0: 49 4c 4c 52 45 51 27 29 20 41 4e 44 20 72 75 6e ILLREQ') AND run
8df0: 5f 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 0a _id=?;" run-id).
8e00: 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 6d 61 res))..;; ma
8e10: 70 20 72 75 6e 2d 69 64 2c 20 74 65 73 74 6e 61 p run-id, testna
8e20: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 74 6f 20 me item-path to
8e30: 74 65 73 74 2d 69 64 0a 28 64 65 66 69 6e 65 20 test-id.(define
8e40: 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 2d (db:get-test-id-
8e50: 63 61 63 68 65 64 20 64 62 20 72 75 6e 2d 69 64 cached db run-id
8e60: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
8e70: 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 ath). (let* ((t
8e80: 65 73 74 2d 6b 65 79 20 28 63 6f 6e 63 20 72 75 est-key (conc ru
8e90: 6e 2d 69 64 20 22 2d 22 20 74 65 73 74 6e 61 6d n-id "-" testnam
8ea0: 65 20 22 2d 22 20 69 74 65 6d 2d 70 61 74 68 29 e "-" item-path)
8eb0: 29 0a 09 20 28 72 65 73 20 20 20 20 20 20 28 68 ).. (res (h
8ec0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
8ed0: 66 61 75 6c 74 20 2a 74 65 73 74 2d 69 64 73 2a fault *test-ids*
8ee0: 20 74 65 73 74 2d 6b 65 79 20 23 66 29 29 29 0a test-key #f))).
8ef0: 20 20 20 20 28 69 66 20 72 65 73 20 0a 09 72 65 (if res ..re
8f00: 73 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 s..(begin.. (sq
8f10: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
8f20: 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 ow.. (lambda (
8f30: 69 64 29 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 id) ;; run-id t
8f40: 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 estname state st
8f50: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 atus event-time
8f60: 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 host cpuload dis
8f70: 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 kfree uname rund
8f80: 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e ir item-path run
8f90: 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f _duration final_
8fa0: 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 29 0a 09 logf comment )..
8fb0: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 69 (set! res i
8fc0: 64 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 20 69 d)) ;; (vector i
8fd0: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d d run-id testnam
8fe0: 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 e state status e
8ff0: 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 vent-time host c
9000: 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 puload diskfree
9010: 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 uname rundir ite
9020: 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 m-path run_durat
9030: 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 ion final_logf c
9040: 6f 6d 6d 65 6e 74 20 29 29 29 0a 09 20 20 20 64 omment ))).. d
9050: 62 20 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 b .. "SELECT i
9060: 64 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 d FROM tests WHE
9070: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
9080: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
9090: 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 0a 09 20 20 tem_path=?;"..
90a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
90b0: 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 20 20 28 item-path).. (
90c0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
90d0: 2a 74 65 73 74 2d 69 64 73 2a 20 74 65 73 74 2d *test-ids* test-
90e0: 6b 65 79 20 72 65 73 29 0a 09 20 20 72 65 73 29 key res).. res)
90f0: 29 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 75 6e 2d )))..;; map run-
9100: 69 64 2c 20 74 65 73 74 6e 61 6d 65 20 69 74 65 id, testname ite
9110: 6d 2d 70 61 74 68 20 74 6f 20 74 65 73 74 2d 69 m-path to test-i
9120: 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 d.(define (db:ge
9130: 74 2d 74 65 73 74 2d 69 64 2d 6e 6f 74 2d 63 61 t-test-id-not-ca
9140: 63 68 65 64 20 64 62 20 72 75 6e 2d 69 64 20 74 ched db run-id t
9150: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
9160: 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 h). (let* ((res
9170: 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 #f)). (sqlit
9180: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
9190: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 (lambda (id
91a0: 29 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 ) ;; run-id tes
91b0: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
91c0: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
91d0: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
91e0: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
91f0: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 item-path run_d
9200: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f uration final_lo
9210: 67 66 20 63 6f 6d 6d 65 6e 74 20 29 0a 20 20 20 gf comment ).
9220: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 69 64 (set! res id
9230: 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 20 69 64 )) ;; (vector id
9240: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
9250: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
9260: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
9270: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
9280: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d name rundir item
9290: 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 -path run_durati
92a0: 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f on final_logf co
92b0: 6d 6d 65 6e 74 20 29 29 29 0a 20 20 20 20 20 64 mment ))). d
92c0: 62 20 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 b . "SELECT
92d0: 69 64 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 id FROM tests WH
92e0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
92f0: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
9300: 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 0a 20 20 item_path=?;".
9310: 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 run-id testna
9320: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 me item-path).
9330: 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 res))..(define
9340: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 db:get-test-id
9350: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 2d 6e db:get-test-id-n
9360: 6f 74 2d 63 61 63 68 65 64 29 0a 0a 3b 3b 20 67 ot-cached)..;; g
9370: 69 76 65 6e 20 61 20 74 65 73 74 2d 69 6e 66 6f iven a test-info
9380: 20 72 65 63 6f 72 64 2c 20 70 61 74 63 68 20 69 record, patch i
9390: 6e 20 74 68 65 20 6c 61 74 65 73 74 20 64 61 74 n the latest dat
93a0: 61 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 64 a from the testd
93b0: 61 74 2e 64 62 20 66 69 6c 65 0a 3b 3b 20 66 6f at.db file.;; fo
93c0: 75 6e 64 20 69 6e 20 74 68 65 20 74 65 73 74 20 und in the test
93d0: 72 75 6e 20 64 69 72 65 63 74 6f 72 79 0a 28 64 run directory.(d
93e0: 65 66 69 6e 65 20 28 64 62 3a 70 61 74 63 68 2d efine (db:patch-
93f0: 74 64 62 2d 64 61 74 61 2d 69 6e 74 6f 2d 74 65 tdb-data-into-te
9400: 73 74 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 2d st-info db test-
9410: 69 64 20 72 65 73 29 0a 20 20 28 6c 65 74 20 28 id res). (let (
9420: 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 (tdb (db:open-te
9430: 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 st-db-by-test-id
9440: 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 db test-id))).
9450: 20 20 20 3b 3b 20 67 65 74 20 73 74 61 74 65 20 ;; get state
9460: 61 6e 64 20 73 74 61 74 75 73 20 66 72 6f 6d 20 and status from
9470: 6d 65 67 61 74 65 73 74 2e 64 62 20 69 6e 20 72 megatest.db in r
9480: 65 61 6c 20 74 69 6d 65 0a 20 20 20 20 3b 3b 20 eal time. ;;
9490: 6f 74 68 65 72 20 66 69 65 6c 64 73 20 74 68 61 other fields tha
94a0: 74 20 70 65 72 68 61 70 73 20 73 68 6f 75 6c 64 t perhaps should
94b0: 20 62 65 20 75 70 64 61 74 65 64 3a 0a 20 20 20 be updated:.
94c0: 20 3b 3b 20 20 20 66 61 69 6c 5f 63 6f 75 6e 74 ;; fail_count
94d0: 0a 20 20 20 20 3b 3b 20 20 20 70 61 73 73 5f 63 . ;; pass_c
94e0: 6f 75 6e 74 0a 20 20 20 20 3b 3b 20 20 20 66 69 ount. ;; fi
94f0: 6e 61 6c 5f 6c 6f 67 66 0a 20 20 20 20 28 73 71 nal_logf. (sq
9500: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
9510: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
9520: 28 73 74 61 74 65 20 73 74 61 74 75 73 20 66 69 (state status fi
9530: 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 nal_logf).
9540: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
9550: 61 74 65 21 20 20 20 20 20 20 20 20 72 65 73 20 ate! res
9560: 73 74 61 74 65 29 0a 20 20 20 20 20 20 20 28 64 state). (d
9570: 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 b:test-set-statu
9580: 73 21 20 20 20 20 20 20 20 72 65 73 20 73 74 61 s! res sta
9590: 74 75 73 29 0a 20 20 20 20 20 20 20 28 64 62 3a tus). (db:
95a0: 74 65 73 74 2d 73 65 74 2d 66 69 6e 61 6c 5f 6c test-set-final_l
95b0: 6f 67 66 21 20 20 20 72 65 73 20 66 69 6e 61 6c ogf! res final
95c0: 5f 6c 6f 67 66 29 29 0a 20 20 20 20 20 64 62 0a _logf)). db.
95d0: 20 20 20 20 20 22 53 45 4c 45 43 54 20 73 74 61 "SELECT sta
95e0: 74 65 2c 73 74 61 74 75 73 2c 66 69 6e 61 6c 5f te,status,final_
95f0: 6c 6f 67 66 20 46 52 4f 4d 20 74 65 73 74 73 20 logf FROM tests
9600: 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 20 WHERE id=?;".
9610: 20 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 28 test-id). (
9620: 69 66 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 if tdb..(begin..
9630: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
9640: 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d ach-row.. (lam
9650: 62 64 61 20 28 75 70 64 61 74 65 5f 74 69 6d 65 bda (update_time
9660: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 5f 66 72 cpuload disk_fr
9670: 65 65 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 29 ee run_duration)
9680: 0a 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d .. (db:test-
9690: 73 65 74 2d 63 70 75 6c 6f 61 64 21 20 20 20 20 set-cpuload!
96a0: 20 20 72 65 73 20 63 70 75 6c 6f 61 64 29 0a 09 res cpuload)..
96b0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 (db:test-se
96c0: 74 2d 64 69 73 6b 66 72 65 65 21 20 20 20 20 20 t-diskfree!
96d0: 72 65 73 20 64 69 73 6b 5f 66 72 65 65 29 0a 09 res disk_free)..
96e0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 (db:test-se
96f0: 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f 6e 21 20 t-run_duration!
9700: 72 65 73 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e res run_duration
9710: 29 29 0a 09 20 20 20 74 64 62 0a 09 20 20 20 22 )).. tdb.. "
9720: 53 45 4c 45 43 54 20 75 70 64 61 74 65 5f 74 69 SELECT update_ti
9730: 6d 65 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 me,cpuload,diskf
9740: 72 65 65 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e ree,run_duration
9750: 20 46 52 4f 4d 20 74 65 73 74 5f 72 75 6e 64 61 FROM test_runda
9760: 74 20 4f 52 44 45 52 20 42 59 20 69 64 20 44 45 t ORDER BY id DE
9770: 53 43 20 4c 49 4d 49 54 20 31 3b 22 29 0a 09 20 SC LIMIT 1;")..
9780: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
9790: 7a 65 21 20 74 64 62 29 29 0a 09 3b 3b 20 69 66 ze! tdb))..;; if
97a0: 20 74 68 65 20 74 65 73 74 20 64 62 20 69 73 20 the test db is
97b0: 6e 6f 74 20 66 6f 75 6e 64 20 77 68 61 74 20 74 not found what t
97c0: 6f 20 64 6f 3f 0a 09 3b 3b 20 31 2e 20 73 65 74 o do?..;; 1. set
97d0: 20 73 74 61 74 65 20 74 6f 20 44 45 4c 45 54 45 state to DELETE
97e0: 44 0a 09 3b 3b 20 32 2e 20 73 65 74 20 73 74 61 D..;; 2. set sta
97f0: 74 75 73 20 74 6f 20 6e 2f 61 0a 09 28 62 65 67 tus to n/a..(beg
9800: 69 6e 0a 09 20 20 28 64 62 3a 74 65 73 74 2d 73 in.. (db:test-s
9810: 65 74 2d 73 74 61 74 65 21 20 20 72 65 73 20 22 et-state! res "
9820: 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 0a 09 20 NOT_STARTED")..
9830: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
9840: 61 74 75 73 21 20 72 65 73 20 22 6e 2f 61 22 29 atus! res "n/a")
9850: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2a 6c ))))..(define *l
9860: 61 73 74 2d 74 65 73 74 2d 63 61 63 68 65 2d 64 ast-test-cache-d
9870: 65 6c 65 74 65 2a 20 28 63 75 72 72 65 6e 74 2d elete* (current-
9880: 73 65 63 6f 6e 64 73 29 29 0a 0a 28 64 65 66 69 seconds))..(defi
9890: 6e 65 20 28 64 62 3a 63 6c 65 61 6e 2d 61 6c 6c ne (db:clean-all
98a0: 2d 63 61 63 68 65 73 29 0a 20 20 28 73 65 74 21 -caches). (set!
98b0: 20 2a 74 65 73 74 2d 69 6e 66 6f 2a 20 28 6d 61 *test-info* (ma
98c0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
98d0: 20 20 28 73 65 74 21 20 2a 74 65 73 74 2d 69 64 (set! *test-id
98e0: 2d 63 61 63 68 65 2a 20 28 6d 61 6b 65 2d 68 61 -cache* (make-ha
98f0: 73 68 2d 74 61 62 6c 65 29 29 29 0a 0a 3b 3b 20 sh-table)))..;;
9900: 47 65 74 20 74 65 73 74 20 64 61 74 61 20 75 73 Get test data us
9910: 69 6e 67 20 74 65 73 74 5f 69 64 0a 28 64 65 66 ing test_id.(def
9920: 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ine (db:get-test
9930: 2d 69 6e 66 6f 2d 63 61 63 68 65 64 2d 62 79 2d -info-cached-by-
9940: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 id db test-id).
9950: 20 3b 3b 20 69 73 20 61 6c 6c 20 74 68 69 73 20 ;; is all this
9960: 63 72 61 70 20 72 65 61 6c 6c 79 20 77 6f 72 74 crap really wort
9970: 68 20 69 74 3f 20 49 20 73 6f 6d 65 68 6f 77 20 h it? I somehow
9980: 64 6f 75 62 74 20 69 74 2e 0a 20 20 28 6c 65 74 doubt it.. (let
9990: 2a 20 28 28 6c 61 73 74 2d 64 65 6c 65 74 65 2d * ((last-delete-
99a0: 73 74 72 20 28 64 62 3a 67 65 74 2d 76 61 72 20 str (db:get-var
99b0: 64 62 20 22 44 45 4c 45 54 45 44 5f 54 45 53 54 db "DELETED_TEST
99c0: 53 22 29 29 0a 09 20 28 6c 61 73 74 2d 64 65 6c S")).. (last-del
99d0: 65 74 65 20 20 20 20 20 28 69 66 20 28 73 74 72 ete (if (str
99e0: 69 6e 67 3f 20 6c 61 73 74 2d 64 65 6c 65 74 65 ing? last-delete
99f0: 2d 73 74 72 29 28 73 74 72 69 6e 67 2d 3e 6e 75 -str)(string->nu
9a00: 6d 62 65 72 20 6c 61 73 74 2d 64 65 6c 65 74 65 mber last-delete
9a10: 2d 73 74 72 29 20 23 66 29 29 29 0a 20 20 20 20 -str) #f))).
9a20: 28 69 66 20 28 61 6e 64 20 6c 61 73 74 2d 64 65 (if (and last-de
9a30: 6c 65 74 65 20 28 3e 20 6c 61 73 74 2d 64 65 6c lete (> last-del
9a40: 65 74 65 20 2a 6c 61 73 74 2d 74 65 73 74 2d 63 ete *last-test-c
9a50: 61 63 68 65 2d 64 65 6c 65 74 65 2a 29 29 0a 09 ache-delete*))..
9a60: 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 (begin.. (set!
9a70: 2a 74 65 73 74 2d 69 6e 66 6f 2a 20 28 6d 61 6b *test-info* (mak
9a80: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table))..
9a90: 20 20 28 73 65 74 21 20 2a 74 65 73 74 2d 69 64 (set! *test-id
9aa0: 2d 63 61 63 68 65 2a 20 28 6d 61 6b 65 2d 68 61 -cache* (make-ha
9ab0: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 28 73 sh-table)).. (s
9ac0: 65 74 21 20 2a 6c 61 73 74 2d 74 65 73 74 2d 63 et! *last-test-c
9ad0: 61 63 68 65 2d 64 65 6c 65 74 65 2a 20 6c 61 73 ache-delete* las
9ae0: 74 2d 64 65 6c 65 74 65 29 0a 09 20 20 28 64 65 t-delete).. (de
9af0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
9b00: 20 22 43 6c 65 61 72 69 6e 67 20 74 65 73 74 20 "Clearing test
9b10: 64 61 74 61 20 63 61 63 68 65 22 29 29 29 29 0a data cache")))).
9b20: 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 74 2d (if (not test-
9b30: 69 64 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e id). (begin
9b40: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
9b50: 6e 66 6f 20 34 20 22 64 62 3a 67 65 74 2d 74 65 nfo 4 "db:get-te
9b60: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 63 61 st-info-by-id ca
9b70: 6c 6c 65 64 20 77 69 74 68 20 74 65 73 74 2d 69 lled with test-i
9b80: 64 3d 22 20 74 65 73 74 2d 69 64 29 0a 09 23 66 d=" test-id)..#f
9b90: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
9ba0: 72 65 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d res (hash-table-
9bb0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 65 73 ref/default *tes
9bc0: 74 2d 69 6e 66 6f 2a 20 74 65 73 74 2d 69 64 20 t-info* test-id
9bd0: 23 66 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 #f)))..(if (and
9be0: 72 65 73 0a 09 09 20 28 6d 65 6d 62 65 72 20 28 res... (member (
9bf0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
9c00: 65 20 72 65 73 29 20 27 28 22 52 55 4e 4e 49 4e e res) '("RUNNIN
9c10: 47 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 G" "COMPLETED"))
9c20: 29 0a 09 20 20 20 20 28 64 62 3a 70 61 74 63 68 ).. (db:patch
9c30: 2d 74 64 62 2d 64 61 74 61 2d 69 6e 74 6f 2d 74 -tdb-data-into-t
9c40: 65 73 74 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 est-info db test
9c50: 2d 69 64 20 72 65 73 29 0a 09 20 20 20 20 3b 3b -id res).. ;;
9c60: 20 69 66 20 6e 6f 20 63 61 63 68 65 64 20 76 61 if no cached va
9c70: 6c 75 65 20 74 68 65 6e 20 66 75 6c 6c 20 72 65 lue then full re
9c80: 61 64 20 61 6e 64 20 77 72 69 74 65 20 74 6f 20 ad and write to
9c90: 63 61 63 68 65 0a 09 20 20 20 20 28 62 65 67 69 cache.. (begi
9ca0: 6e 0a 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 n.. (sqlite
9cb0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 3:for-each-row..
9cc0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
9cd0: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna
9ce0: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
9cf0: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host
9d00: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
9d10: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it
9d20: 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 em-path run_dura
9d30: 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 tion final_logf
9d40: 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 3b 3b 20 20 comment)... ;;
9d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0
9d60: 20 20 20 20 31 20 20 20 20 20 20 20 32 20 20 20 1 2
9d70: 20 20 20 33 20 20 20 20 20 20 34 20 20 20 20 20 3 4
9d80: 20 20 20 35 20 20 20 20 20 20 20 36 20 20 20 20 5 6
9d90: 20 20 37 20 20 20 20 20 20 20 20 38 20 20 20 20 7 8
9da0: 20 39 20 20 20 20 20 31 30 20 20 20 20 20 20 31 9 10 1
9db0: 31 20 20 20 20 20 20 20 20 20 20 31 32 20 20 20 1 12
9dc0: 20 20 20 20 20 20 20 31 33 20 20 20 20 20 20 20 13
9dd0: 31 34 0a 09 09 20 28 73 65 74 21 20 72 65 73 20 14... (set! res
9de0: 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 (vector id run-i
9df0: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
9e00: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
9e10: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
9e20: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
9e30: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
9e40: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
9e50: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 al_logf comment)
9e60: 29 29 0a 09 20 20 20 20 20 20 20 64 62 20 0a 09 )).. db ..
9e70: 20 20 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 "SELECT i
9e80: 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d d,run_id,testnam
9e90: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 e,state,status,e
9ea0: 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 vent_time,host,c
9eb0: 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c puload,diskfree,
9ec0: 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 uname,rundir,ite
9ed0: 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 m_path,run_durat
9ee0: 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 ion,final_logf,c
9ef0: 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 omment FROM test
9f00: 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 09 s WHERE id=?;"..
9f10: 20 20 20 20 20 20 20 74 65 73 74 2d 69 64 29 0a test-id).
9f20: 09 20 20 20 20 20 20 28 69 66 20 72 65 73 20 28 . (if res (
9f30: 64 62 3a 70 61 74 63 68 2d 74 64 62 2d 64 61 74 db:patch-tdb-dat
9f40: 61 2d 69 6e 74 6f 2d 74 65 73 74 2d 69 6e 66 6f a-into-test-info
9f50: 20 64 62 20 74 65 73 74 2d 69 64 20 72 65 73 29 db test-id res)
9f60: 29 0a 09 20 20 20 20 20 20 72 65 73 29 29 29 29 ).. res))))
9f70: 29 0a 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 64 )..;; Get test d
9f80: 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f 69 ata using test_i
9f90: 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 d.(define (db:ge
9fa0: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 6e 6f 74 2d t-test-info-not-
9fb0: 63 61 63 68 65 64 2d 62 79 2d 69 64 20 64 62 20 cached-by-id db
9fc0: 74 65 73 74 2d 69 64 29 0a 20 20 28 69 66 20 28 test-id). (if (
9fd0: 6e 6f 74 20 74 65 73 74 2d 69 64 29 0a 20 20 20 not test-id).
9fe0: 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 (begin..(debu
9ff0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 g:print-info 4 "
a000: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
a010: 2d 62 79 2d 69 64 20 63 61 6c 6c 65 64 20 77 69 -by-id called wi
a020: 74 68 20 74 65 73 74 2d 69 64 3d 22 20 74 65 73 th test-id=" tes
a030: 74 2d 69 64 29 0a 09 23 66 29 0a 20 20 20 20 20 t-id)..#f).
a040: 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 (let ((res #f))
a050: 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 ..(sqlite3:for-e
a060: 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 ach-row.. (lambd
a070: 61 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73 a (id run-id tes
a080: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
a090: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
a0a0: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
a0b0: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
a0c0: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 item-path run_d
a0d0: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f uration final_lo
a0e0: 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 gf comment)..
a0f0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
a100: 20 20 20 30 20 20 20 20 31 20 20 20 20 20 20 20 0 1
a110: 32 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20 2 3 4
a120: 20 20 20 20 20 20 20 35 20 20 20 20 20 20 20 36 5 6
a130: 20 20 20 20 20 20 37 20 20 20 20 20 20 20 20 38 7 8
a140: 20 20 20 20 20 39 20 20 20 20 20 31 30 20 20 20 9 10
a150: 20 20 20 31 31 20 20 20 20 20 20 20 20 20 20 31 11 1
a160: 32 20 20 20 20 20 20 20 20 20 20 31 33 20 20 20 2 13
a170: 20 20 20 20 31 34 0a 09 20 20 20 28 73 65 74 21 14.. (set!
a180: 20 72 65 73 20 28 76 65 63 74 6f 72 20 69 64 20 res (vector id
a190: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
a1a0: 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 state status eve
a1b0: 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 nt-time host cpu
a1c0: 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e load diskfree un
a1d0: 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d ame rundir item-
a1e0: 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f path run_duratio
a1f0: 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d n final_logf com
a200: 6d 65 6e 74 29 29 29 0a 09 20 64 62 20 0a 09 20 ment))).. db ..
a210: 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e 5f 69 "SELECT id,run_i
a220: 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 d,testname,state
a230: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
a240: 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c me,host,cpuload,
a250: 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 diskfree,uname,r
a260: 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c undir,item_path,
a270: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e run_duration,fin
a280: 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 al_logf,comment
a290: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
a2a0: 20 69 64 3d 3f 3b 22 0a 09 20 74 65 73 74 2d 69 id=?;".. test-i
a2b0: 64 29 0a 09 72 65 73 29 29 29 0a 0a 28 64 65 66 d)..res)))..(def
a2c0: 69 6e 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d ine db:get-test-
a2d0: 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 3a 67 65 info-by-id db:ge
a2e0: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 6e 6f 74 2d t-test-info-not-
a2f0: 63 61 63 68 65 64 2d 62 79 2d 69 64 29 0a 0a 28 cached-by-id)..(
a300: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
a310: 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d est-info db run-
a320: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
a330: 2d 70 61 74 68 29 0a 20 20 28 64 62 3a 67 65 74 -path). (db:get
a340: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
a350: 20 64 62 20 28 64 62 3a 67 65 74 2d 74 65 73 74 db (db:get-test
a360: 2d 69 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 -id db run-id te
a370: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 stname item-path
a380: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
a390: 3a 74 65 73 74 2d 73 65 74 2d 63 6f 6d 6d 65 6e :test-set-commen
a3a0: 74 20 64 62 20 74 65 73 74 2d 69 64 20 63 6f 6d t db test-id com
a3b0: 6d 65 6e 74 29 0a 20 20 28 73 71 6c 69 74 65 33 ment). (sqlite3
a3c0: 3a 65 78 65 63 75 74 65 20 0a 20 20 20 64 62 20 :execute . db
a3d0: 0a 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 . "UPDATE test
a3e0: 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 s SET comment=?
a3f0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 20 WHERE id=?;".
a400: 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d 69 64 29 comment test-id)
a410: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
a420: 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 test-set-rundir!
a430: 20 7a 6d 71 73 6f 63 6b 65 74 20 72 75 6e 2d 69 zmqsocket run-i
a440: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
a450: 2d 70 61 74 68 20 72 75 6e 64 69 72 29 0a 20 20 -path rundir).
a460: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c (cdb:client-call
a470: 20 7a 6d 71 73 6f 63 6b 65 74 20 27 74 65 73 74 zmqsocket 'test
a480: 2d 73 65 74 2d 72 75 6e 64 69 72 20 23 74 20 72 -set-rundir #t r
a490: 75 6e 64 69 72 20 72 75 6e 2d 69 64 20 74 65 73 undir run-id tes
a4a0: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
a4b0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
a4c0: 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 :test-set-rundir
a4d0: 2d 62 79 2d 74 65 73 74 2d 69 64 20 7a 6d 71 73 -by-test-id zmqs
a4e0: 6f 63 6b 65 74 20 74 65 73 74 2d 69 64 20 72 75 ocket test-id ru
a4f0: 6e 64 69 72 29 0a 20 20 28 63 64 62 3a 63 6c 69 ndir). (cdb:cli
a500: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
a510: 65 74 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e et 'test-set-run
a520: 64 69 72 2d 62 79 2d 74 65 73 74 2d 69 64 20 23 dir-by-test-id #
a530: 74 20 72 75 6e 64 69 72 20 74 65 73 74 2d 69 64 t rundir test-id
a540: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
a550: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d test-get-rundir-
a560: 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 20 from-test-id db
a570: 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 20 test-id). (let
a580: 28 28 72 65 73 20 23 66 29 29 20 3b 3b 20 28 68 ((res #f)) ;; (h
a590: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
a5a0: 66 61 75 6c 74 20 2a 74 65 73 74 2d 70 61 74 68 fault *test-path
a5b0: 73 2a 20 74 65 73 74 2d 69 64 20 23 66 29 29 29 s* test-id #f)))
a5c0: 0a 20 20 20 20 3b 3b 20 28 69 66 20 72 65 73 0a . ;; (if res.
a5d0: 20 20 20 20 3b 3b 20 20 20 20 20 72 65 73 0a 20 ;; res.
a5e0: 20 20 20 3b 3b 20 20 20 20 20 28 62 65 67 69 6e ;; (begin
a5f0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
a600: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
a610: 28 6c 61 6d 62 64 61 20 28 74 70 61 74 68 29 0a (lambda (tpath).
a620: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
a630: 20 74 70 61 74 68 29 29 0a 20 20 20 20 20 64 62 tpath)). db
a640: 20 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 72 . "SELECT r
a650: 75 6e 64 69 72 20 46 52 4f 4d 20 74 65 73 74 73 undir FROM tests
a660: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 WHERE id=?;".
a670: 20 20 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 test-id).
a680: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ;; (hash-table-s
a690: 65 74 21 20 2a 74 65 73 74 2d 70 61 74 68 73 2a et! *test-paths*
a6a0: 20 74 65 73 74 2d 69 64 20 72 65 73 29 0a 20 20 test-id res).
a6b0: 20 20 72 65 73 29 29 20 3b 3b 20 29 29 0a 0a 28 res)) ;; ))..(
a6c0: 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 define (cdb:test
a6d0: 2d 73 65 74 2d 6c 6f 67 21 20 7a 6d 71 73 6f 63 -set-log! zmqsoc
a6e0: 6b 65 74 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 ket test-id logf
a6f0: 29 0a 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f ). (if (string?
a700: 20 6c 6f 67 66 29 28 63 64 62 3a 63 6c 69 65 6e logf)(cdb:clien
a710: 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 t-call zmqsocket
a720: 20 27 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 23 'test-set-log #
a730: 66 20 6c 6f 67 66 20 74 65 73 74 2d 69 64 29 29 f logf test-id))
a740: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
a750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
a790: 69 73 63 2e 20 74 65 73 74 20 72 65 6c 61 74 65 isc. test relate
a7a0: 64 20 71 75 65 72 69 65 73 0a 3b 3b 3d 3d 3d 3d d queries.;;====
a7b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a7f0: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ==..(define (db:
a800: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
a810: 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 atching db keyna
a820: 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 mes target fname
a830: 70 61 74 74 20 23 21 6b 65 79 20 28 72 65 73 20 patt #!key (res
a840: 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 '())). (let* ((
a850: 74 65 73 74 70 61 74 74 20 20 20 28 69 66 20 28 testpatt (if (
a860: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
a870: 65 73 74 70 61 74 74 22 29 28 61 72 67 73 3a 67 estpatt")(args:g
a880: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
a890: 74 22 29 20 22 25 22 29 29 0a 09 20 28 73 74 61 t") "%")).. (sta
a8a0: 74 65 70 61 74 74 20 20 28 69 66 20 28 61 72 67 tepatt (if (arg
a8b0: 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 s:get-arg ":stat
a8c0: 65 22 29 20 20 20 28 61 72 67 73 3a 67 65 74 2d e") (args:get-
a8d0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 arg ":state")
a8e0: 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 75 73 "%")).. (status
a8f0: 70 61 74 74 20 28 69 66 20 28 61 72 67 73 3a 67 patt (if (args:g
a900: 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 et-arg ":status"
a910: 29 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ) (args:get-arg
a920: 20 22 3a 73 74 61 74 75 73 22 29 20 20 20 22 25 ":status") "%
a930: 22 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 ")).. (runname
a940: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
a950: 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 arg ":runname")
a960: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
a970: 72 75 6e 6e 61 6d 65 22 29 20 20 22 25 22 29 29 runname") "%"))
a980: 0a 09 20 28 6b 65 79 73 74 72 20 28 73 74 72 69 .. (keystr (stri
a990: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
a9a0: 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 .. (map (lambda
a9b0: 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 28 (key val).... (
a9c0: 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 20 conc "r." key "
a9d0: 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 27 22 29 like '" val "'")
a9e0: 29 0a 09 09 20 20 20 20 20 20 20 6b 65 79 6e 61 )... keyna
a9f0: 6d 65 73 20 0a 09 09 20 20 20 20 20 20 20 28 73 mes ... (s
aa00: 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 67 tring-split targ
aa10: 65 74 20 22 2f 22 29 29 0a 09 09 20 20 22 20 41 et "/"))... " A
aa20: 4e 44 20 22 29 29 0a 09 20 28 74 65 73 74 71 72 ND ")).. (testqr
aa30: 79 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e y (tests:match->
aa40: 73 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 29 sqlqry testpatt)
aa50: 29 0a 09 20 28 71 72 79 73 74 72 20 28 63 6f 6e ).. (qrystr (con
aa60: 63 20 22 53 45 4c 45 43 54 20 74 2e 72 75 6e 64 c "SELECT t.rund
aa70: 69 72 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53 ir FROM tests AS
aa80: 20 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 72 75 t INNER JOIN ru
aa90: 6e 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 75 6e ns AS r ON t.run
aaa0: 5f 69 64 3d 72 2e 69 64 20 57 48 45 52 45 20 22 _id=r.id WHERE "
aab0: 0a 09 09 20 20 20 20 20 20 20 6b 65 79 73 74 72 ... keystr
aac0: 20 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 6d 65 " AND r.runname
aad0: 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d 65 LIKE '" runname
aae0: 20 22 27 20 41 4e 44 20 22 20 74 65 73 74 71 72 "' AND " testqr
aaf0: 79 0a 09 09 20 20 20 20 20 20 20 22 20 41 4e 44 y... " AND
ab00: 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 22 t.state LIKE '"
ab10: 20 73 74 61 74 65 70 61 74 74 20 22 27 20 41 4e statepatt "' AN
ab20: 44 20 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 20 D t.status LIKE
ab30: 27 22 20 73 74 61 74 75 73 70 61 74 74 20 0a 09 '" statuspatt ..
ab40: 09 20 20 20 20 20 20 20 22 27 20 4f 52 44 45 52 . "' ORDER
ab50: 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 6d 65 BY t.event_time
ab60: 20 41 53 43 3b 22 29 29 29 0a 20 20 20 20 28 64 ASC;"))). (d
ab70: 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 71 72 ebug:print 3 "qr
ab80: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 29 0a ystr: " qrystr).
ab90: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
aba0: 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 -each-row .
abb0: 28 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 20 (lambda (p).
abc0: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
abd0: 6e 73 20 70 20 72 65 73 29 29 29 0a 20 20 20 20 ns p res))).
abe0: 20 64 62 20 0a 20 20 20 20 20 71 72 79 73 74 72 db . qrystr
abf0: 29 0a 20 20 20 20 28 69 66 20 66 6e 61 6d 65 70 ). (if fnamep
ac00: 61 74 74 0a 09 28 61 70 70 6c 79 20 61 70 70 65 att..(apply appe
ac10: 6e 64 20 0a 09 20 20 20 20 20 20 20 28 6d 61 70 nd .. (map
ac20: 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 20 (lambda (p)...
ac30: 20 20 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 (glob (conc
ac40: 20 70 20 22 2f 22 20 66 6e 61 6d 65 70 61 74 74 p "/" fnamepatt
ac50: 29 29 29 0a 09 09 20 20 20 20 72 65 73 29 29 0a )))... res)).
ac60: 09 72 65 73 29 29 29 0a 0a 3b 3b 20 6c 6f 6f 6b .res)))..;; look
ac70: 20 74 68 72 6f 75 67 68 20 74 65 73 74 73 20 66 through tests f
ac80: 72 6f 6d 20 6d 61 74 63 68 69 6e 67 20 72 75 6e rom matching run
ac90: 73 20 66 6f 72 20 61 20 66 69 6c 65 0a 28 64 65 s for a file.(de
aca0: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 fine (db:test-ge
acb0: 74 2d 66 69 72 73 74 2d 70 61 74 68 2d 6d 61 74 t-first-path-mat
acc0: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
acd0: 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 29 0a s target fname).
ace0: 20 20 3b 3b 20 5b 72 65 66 70 61 74 68 73 5d 20 ;; [refpaths]
acf0: 69 73 20 74 68 65 20 73 65 63 74 69 6f 6e 20 77 is the section w
ad00: 68 65 72 65 20 72 65 66 65 72 65 6e 63 65 73 20 here references
ad10: 74 6f 20 6f 74 68 65 72 20 6d 65 67 61 74 65 73 to other megates
ad20: 74 20 64 61 74 61 62 61 73 65 73 20 61 72 65 20 t databases are
ad30: 73 74 6f 72 65 64 0a 20 20 28 6c 65 74 20 28 28 stored. (let ((
ad40: 6d 74 2d 70 61 74 68 73 20 28 63 6f 6e 66 69 67 mt-paths (config
ad50: 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 22 72 f:get-section "r
ad60: 65 66 70 61 74 68 73 22 29 29 0a 09 28 72 65 73 efpaths"))..(res
ad70: 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d (db:test-
ad80: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
ad90: 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 ng db keynames t
ada0: 61 72 67 65 74 20 66 6e 61 6d 65 29 29 29 0a 20 arget fname))).
adb0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 70 (let loop ((p
adc0: 61 74 68 64 61 74 20 28 69 66 20 28 6e 75 6c 6c athdat (if (null
add0: 3f 20 70 61 74 68 73 29 20 23 66 20 28 63 61 72 ? paths) #f (car
ade0: 20 6d 74 2d 70 61 74 68 73 29 29 29 0a 09 20 20 mt-paths)))..
adf0: 20 20 20 20 20 28 74 61 6c 20 20 20 20 20 28 69 (tal (i
ae00: 66 20 28 6e 75 6c 6c 3f 20 70 61 74 68 73 29 20 f (null? paths)
ae10: 27 28 29 28 63 64 72 20 6d 74 2d 70 61 74 68 73 '()(cdr mt-paths
ae20: 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 )))). (if (
ae30: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 73 29 29 not (null? res))
ae40: 0a 09 20 20 28 63 61 72 20 72 65 73 29 20 3b 3b .. (car res) ;;
ae50: 20 72 65 74 75 72 6e 20 66 69 72 73 74 20 66 6f return first fo
ae60: 75 6e 64 0a 09 20 20 28 69 66 20 70 61 74 68 0a und.. (if path.
ae70: 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 . (let* ((d
ae80: 62 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 20 70 b (open-db p
ae90: 61 74 68 3a 20 28 63 61 64 72 20 70 61 74 68 64 ath: (cadr pathd
aea0: 61 74 29 29 29 0a 09 09 20 20 20 20 20 28 6e 65 at)))... (ne
aeb0: 77 72 65 73 20 28 64 62 3a 74 65 73 74 2d 67 65 wres (db:test-ge
aec0: 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 t-paths-matching
aed0: 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 db keynames tar
aee0: 67 65 74 20 66 6e 61 6d 65 29 29 29 0a 09 09 28 get fname)))...(
aef0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
af00: 20 34 20 22 54 72 79 69 6e 67 20 22 20 28 63 61 4 "Trying " (ca
af10: 72 20 70 61 74 68 64 61 74 29 20 22 20 61 74 20 r pathdat) " at
af20: 22 20 28 63 61 64 72 20 70 61 74 68 64 61 74 29 " (cadr pathdat)
af30: 29 0a 09 09 28 73 71 6c 69 74 65 33 3a 66 69 6e )...(sqlite3:fin
af40: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 28 69 66 alize! db)...(if
af50: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6e 65 77 (not (null? new
af60: 72 65 73 29 29 0a 09 09 20 20 20 20 28 63 61 72 res))... (car
af70: 20 6e 65 77 72 65 73 29 0a 09 09 20 20 20 20 28 newres)... (
af80: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 if (null? tal)..
af90: 09 09 23 66 0a 09 09 09 28 6c 6f 6f 70 20 28 63 ..#f....(loop (c
afa0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
afb0: 29 29 29 29 29 29 29 29 29 0a 0a 0a 28 64 65 66 )))))))))...(def
afc0: 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ine (db:test-get
afd0: 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 2d 6d 61 -test-records-ma
afe0: 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d tching db keynam
aff0: 65 73 20 74 61 72 67 65 74 29 0a 20 20 28 6c 65 es target). (le
b000: 74 2a 20 28 28 72 65 73 20 27 28 29 29 0a 09 20 t* ((res '())..
b010: 28 69 74 65 6d 70 61 74 74 20 20 20 28 69 66 20 (itempatt (if
b020: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
b030: 69 74 65 6d 70 61 74 74 22 29 28 61 72 67 73 3a itempatt")(args:
b040: 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d 70 61 get-arg "-itempa
b050: 74 74 22 29 20 22 25 22 29 29 0a 09 20 28 74 65 tt") "%")).. (te
b060: 73 74 70 61 74 74 20 20 20 28 69 66 20 28 61 72 stpatt (if (ar
b070: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 gs:get-arg "-tes
b080: 74 70 61 74 74 22 29 28 61 72 67 73 3a 67 65 74 tpatt")(args:get
b090: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
b0a0: 29 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 65 ) "%")).. (state
b0b0: 70 61 74 74 20 20 28 69 66 20 28 61 72 67 73 3a patt (if (args:
b0c0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 get-arg ":state"
b0d0: 29 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ) (args:get-ar
b0e0: 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 20 22 g ":state") "
b0f0: 25 22 29 29 0a 09 20 28 73 74 61 74 75 73 70 61 %")).. (statuspa
b100: 74 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 tt (if (args:get
b110: 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 20 -arg ":status")
b120: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
b130: 3a 73 74 61 74 75 73 22 29 20 20 20 22 25 22 29 :status") "%")
b140: 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 ).. (runname
b150: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
b160: 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 28 61 g ":runname") (a
b170: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 rgs:get-arg ":ru
b180: 6e 6e 61 6d 65 22 29 20 20 22 25 22 29 29 0a 09 nname") "%"))..
b190: 20 28 6b 65 79 73 74 72 20 28 73 74 72 69 6e 67 (keystr (string
b1a0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 -intersperse ...
b1b0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
b1c0: 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 28 63 6f key val).... (co
b1d0: 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 20 6c 69 nc "r." key " li
b1e0: 6b 65 20 27 22 20 76 61 6c 20 22 27 22 29 29 0a ke '" val "'")).
b1f0: 09 09 20 20 20 20 20 20 20 6b 65 79 6e 61 6d 65 .. keyname
b200: 73 20 0a 09 09 20 20 20 20 20 20 20 28 73 74 72 s ... (str
b210: 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 67 65 74 ing-split target
b220: 20 22 2f 22 29 29 0a 09 09 20 20 22 20 41 4e 44 "/"))... " AND
b230: 20 22 29 29 0a 09 20 28 71 72 79 73 74 72 20 28 ")).. (qrystr (
b240: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 0a 20 20 conc "SELECT .
b250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b260: 20 20 20 20 20 20 20 20 20 20 74 2e 69 64 0a 20 t.id.
b270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b280: 20 20 20 20 20 20 20 20 20 20 20 74 2e 72 75 6e t.run
b290: 5f 69 64 20 20 20 20 20 0a 20 20 20 20 20 20 20 _id .
b2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2b0: 20 20 20 20 20 74 2e 74 65 73 74 6e 61 6d 65 20 t.testname
b2c0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
b2e0: 2e 68 6f 73 74 20 20 20 20 20 20 20 0a 20 20 20 .host .
b2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b300: 20 20 20 20 20 20 20 20 20 74 2e 63 70 75 6c 6f t.cpulo
b310: 61 64 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 ad .
b320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b330: 20 20 20 74 2e 64 69 73 6b 66 72 65 65 20 20 20 t.diskfree
b340: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b350: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 75 t.u
b360: 6e 61 6d 65 20 20 20 20 20 20 0a 20 20 20 20 20 name .
b370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b380: 20 20 20 20 20 20 20 74 2e 72 75 6e 64 69 72 20 t.rundir
b390: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
b3a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3b0: 20 74 2e 73 68 6f 72 74 64 69 72 20 20 20 0a 20 t.shortdir .
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3d0: 20 20 20 20 20 20 20 20 20 20 20 74 2e 69 74 65 t.ite
b3e0: 6d 5f 70 61 74 68 20 20 0a 20 20 20 20 20 20 20 m_path .
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b400: 20 20 20 20 20 74 2e 73 74 61 74 65 20 20 20 20 t.state
b410: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
b430: 2e 73 74 61 74 75 73 20 20 20 20 20 0a 20 20 20 .status .
b440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b450: 20 20 20 20 20 20 20 20 20 74 2e 61 74 74 65 6d t.attem
b460: 70 74 6e 75 6d 20 0a 20 20 20 20 20 20 20 20 20 ptnum .
b470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b480: 20 20 20 74 2e 66 69 6e 61 6c 5f 6c 6f 67 66 20 t.final_logf
b490: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 6c t.l
b4b0: 6f 67 64 61 74 20 20 20 20 20 0a 20 20 20 20 20 ogdat .
b4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4d0: 20 20 20 20 20 20 20 74 2e 72 75 6e 5f 64 75 72 t.run_dur
b4e0: 61 74 69 6f 0a 20 20 20 20 20 20 20 20 20 20 20 atio.
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b500: 20 74 2e 63 6f 6d 6d 65 6e 74 20 20 20 20 0a 20 t.comment .
b510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b520: 20 20 20 20 20 20 20 20 20 20 20 74 2e 65 76 65 t.eve
b530: 6e 74 5f 74 69 6d 65 20 0a 20 20 20 20 20 20 20 nt_time .
b540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b550: 20 20 20 20 20 74 2e 66 61 69 6c 5f 63 6f 75 6e t.fail_coun
b560: 74 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t .
b570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
b580: 2e 70 61 73 73 5f 63 6f 75 6e 74 20 0a 20 20 20 .pass_count .
b590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5a0: 20 20 20 20 20 20 20 20 20 74 2e 61 72 63 68 69 t.archi
b5b0: 76 65 64 20 20 20 0a 20 20 20 20 20 20 20 20 20 ved .
b5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5d0: 20 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53 20 FROM tests AS
b5e0: 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 72 75 6e t INNER JOIN run
b5f0: 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 75 6e 5f s AS r ON t.run_
b600: 69 64 3d 72 2e 69 64 20 57 48 45 52 45 20 22 0a id=r.id WHERE ".
b610: 09 09 20 20 20 20 20 20 20 6b 65 79 73 74 72 20 .. keystr
b620: 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 6d 65 20 " AND r.runname
b630: 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d 65 20 LIKE '" runname
b640: 22 27 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 "' AND item_path
b650: 20 4c 49 4b 45 20 27 22 20 69 74 65 6d 70 61 74 LIKE '" itempat
b660: 74 20 22 27 20 41 4e 44 20 74 65 73 74 6e 61 6d t "' AND testnam
b670: 65 20 4c 49 4b 45 20 27 22 0a 09 09 20 20 20 20 e LIKE '"...
b680: 20 20 20 74 65 73 74 70 61 74 74 20 22 27 20 41 testpatt "' A
b690: 4e 44 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 ND t.state LIKE
b6a0: 27 22 20 73 74 61 74 65 70 61 74 74 20 22 27 20 '" statepatt "'
b6b0: 41 4e 44 20 74 2e 73 74 61 74 75 73 20 4c 49 4b AND t.status LIK
b6c0: 45 20 27 22 20 73 74 61 74 75 73 70 61 74 74 20 E '" statuspatt
b6d0: 0a 09 09 20 20 20 20 20 20 20 22 27 4f 52 44 45 ... "'ORDE
b6e0: 52 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 6d R BY t.event_tim
b6f0: 65 20 41 53 43 3b 22 29 29 29 0a 20 20 20 20 28 e ASC;"))). (
b700: 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 71 debug:print 3 "q
b710: 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 29 rystr: " qrystr)
b720: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
b730: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
b740: 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 (lambda (p).
b750: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
b760: 6f 6e 73 20 70 20 72 65 73 29 29 29 0a 20 20 20 ons p res))).
b770: 20 20 64 62 20 0a 20 20 20 20 20 71 72 79 73 74 db . qryst
b780: 72 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b r). res))..;;
b790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b7d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 55 45 55 45 20 ======.;; QUEUE
b7e0: 55 50 20 4d 45 54 41 2c 20 54 45 53 54 20 53 54 UP META, TEST ST
b7f0: 41 54 55 53 20 41 4e 44 20 53 54 45 50 53 20 52 ATUS AND STEPS R
b800: 45 4d 4f 54 45 20 41 43 43 45 53 53 0a 3b 3b 3d EMOTE ACCESS.;;=
b810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b850: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 64 62 3a 75 70 64 =====..;; db:upd
b860: 61 74 65 72 20 69 73 20 72 75 6e 20 69 6e 20 61 ater is run in a
b870: 20 74 68 72 65 61 64 20 74 6f 20 77 72 69 74 65 thread to write
b880: 20 6f 75 74 20 74 68 65 20 63 61 63 68 65 64 20 out the cached
b890: 64 61 74 61 20 70 65 72 69 6f 64 69 63 61 6c 6c data periodicall
b8a0: 79 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 62 y.;; (define (db
b8b0: 3a 75 70 64 61 74 65 72 29 0a 3b 3b 20 20 20 28 :updater).;; (
b8c0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
b8d0: 20 34 20 22 53 74 61 72 74 69 6e 67 20 63 61 63 4 "Starting cac
b8e0: 68 65 20 70 72 6f 63 65 73 73 69 6e 67 22 29 0a he processing").
b8f0: 3b 3b 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 ;; (let loop (
b900: 29 0a 3b 3b 20 20 20 20 20 28 74 68 72 65 61 64 ).;; (thread
b910: 2d 73 6c 65 65 70 21 20 31 30 29 20 3b 3b 20 6d -sleep! 10) ;; m
b920: 6f 76 65 20 73 61 76 65 20 74 69 6d 65 20 61 72 ove save time ar
b930: 6f 75 6e 64 20 74 6f 20 6d 69 6e 69 6d 69 7a 65 ound to minimize
b940: 20 72 65 67 75 6c 61 72 20 63 6f 6c 6c 69 73 69 regular collisi
b950: 6f 6e 73 3f 0a 3b 3b 20 20 20 20 20 28 64 62 3a ons?.;; (db:
b960: 77 72 69 74 65 2d 63 61 63 68 65 64 2d 64 61 74 write-cached-dat
b970: 61 29 0a 3b 3b 20 20 20 20 20 28 6c 6f 6f 70 29 a).;; (loop)
b980: 29 29 0a 0a 3b 3b 20 63 64 62 3a 63 61 63 68 65 ))..;; cdb:cache
b990: 64 2d 61 63 63 65 73 73 20 69 73 20 63 61 6c 6c d-access is call
b9a0: 65 64 20 62 79 20 74 68 65 20 73 65 72 76 65 72 ed by the server
b9b0: 20 6c 6f 6f 70 20 74 6f 20 64 69 73 70 61 74 63 loop to dispatc
b9c0: 68 20 63 6f 6d 6d 61 6e 64 73 20 6f 72 20 71 75 h commands or qu
b9d0: 65 75 65 20 75 70 0a 3b 3b 20 64 62 20 61 63 63 eue up.;; db acc
b9e0: 65 73 73 65 73 0a 3b 3b 0a 3b 3b 20 70 61 72 61 esses.;;.;; para
b9f0: 6d 73 20 3a 3d 20 71 72 79 2d 6e 61 6d 65 20 63 ms := qry-name c
ba00: 61 63 68 65 64 3f 20 76 61 6c 31 20 76 61 6c 32 ached? val1 val2
ba10: 20 76 61 6c 33 20 2e 2e 2e 0a 28 64 65 66 69 6e val3 ....(defin
ba20: 65 20 28 63 64 62 3a 63 61 63 68 65 64 2d 61 63 e (cdb:cached-ac
ba30: 63 65 73 73 20 70 61 72 61 6d 73 29 0a 20 20 28 cess params). (
ba40: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
ba50: 20 31 32 20 22 63 64 62 3a 63 61 63 68 65 64 2d 12 "cdb:cached-
ba60: 61 63 63 65 73 73 20 70 61 72 61 6d 73 3d 22 20 access params="
ba70: 70 61 72 61 6d 73 29 0a 20 20 28 69 66 20 28 3c params). (if (<
ba80: 20 28 6c 65 6e 67 74 68 20 70 61 72 61 6d 73 29 (length params)
ba90: 20 32 29 0a 20 20 20 20 20 20 22 45 52 52 4f 52 2). "ERROR
baa0: 22 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 71 ". (let ((q
bab0: 72 79 2d 6e 61 6d 65 20 28 63 61 72 20 70 61 72 ry-name (car par
bac0: 61 6d 73 29 29 0a 09 20 20 20 20 28 63 61 63 68 ams)).. (cach
bad0: 65 64 3f 20 20 28 63 61 64 72 20 70 61 72 61 6d ed? (cadr param
bae0: 73 29 29 0a 09 20 20 20 20 28 72 65 6d 70 61 72 s)).. (rempar
baf0: 61 6d 20 28 6c 69 73 74 2d 74 61 69 6c 20 70 61 am (list-tail pa
bb00: 72 61 6d 73 20 32 29 29 29 20 0a 09 28 64 65 62 rams 2))) ..(deb
bb10: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 32 ug:print-info 12
bb20: 20 22 63 64 62 3a 63 61 63 68 65 64 2d 61 63 63 "cdb:cached-acc
bb30: 65 73 73 20 71 72 79 2d 6e 61 6d 65 3d 22 20 71 ess qry-name=" q
bb40: 72 79 2d 6e 61 6d 65 20 22 20 70 61 72 61 6d 73 ry-name " params
bb50: 3d 22 20 70 61 72 61 6d 73 29 0a 09 28 69 66 20 =" params)..(if
bb60: 28 6e 6f 74 20 63 61 63 68 65 64 3f 29 28 64 62 (not cached?)(db
bb70: 3a 77 72 69 74 65 2d 63 61 63 68 65 64 2d 64 61 :write-cached-da
bb80: 74 61 29 29 0a 09 3b 3b 20 41 6e 79 20 73 70 65 ta))..;; Any spe
bb90: 63 69 61 6c 20 63 61 6c 6c 73 20 61 72 65 20 64 cial calls are d
bba0: 69 73 70 61 74 63 68 65 64 20 68 65 72 65 2e 20 ispatched here.
bbb0: 0a 09 3b 3b 20 52 65 6d 61 69 6e 64 65 72 20 61 ..;; Remainder a
bbc0: 72 65 20 70 75 74 20 69 6e 20 74 68 65 20 64 62 re put in the db
bbd0: 20 71 75 65 75 65 0a 09 28 63 61 73 65 20 71 72 queue..(case qr
bbe0: 79 2d 6e 61 6d 65 0a 09 20 20 28 28 6c 6f 67 69 y-name.. ((logi
bbf0: 6e 29 20 3b 3b 20 6c 6f 67 69 6e 20 63 68 65 63 n) ;; login chec
bc00: 6b 73 20 74 68 61 74 20 74 68 65 20 6d 65 67 61 ks that the mega
bc10: 74 65 73 74 20 70 61 74 68 20 6d 61 74 63 68 65 test path matche
bc20: 73 0a 09 20 20 20 28 69 66 20 28 3c 20 28 6c 65 s.. (if (< (le
bc30: 6e 67 74 68 20 72 65 6d 70 61 72 61 6d 29 20 32 ngth remparam) 2
bc40: 29 20 3b 3b 20 73 68 6f 75 6c 64 20 67 65 74 20 ) ;; should get
bc50: 74 6f 70 70 61 74 68 20 61 6e 64 20 73 69 67 6e toppath and sign
bc60: 61 74 75 72 65 0a 09 20 20 20 20 20 20 20 27 28 ature.. '(
bc70: 23 66 20 22 6c 6f 67 69 6e 20 66 61 69 6c 65 64 #f "login failed
bc80: 20 64 75 65 20 74 6f 20 6d 69 73 73 69 6e 67 20 due to missing
bc90: 70 61 72 61 6d 73 22 29 20 3b 3b 20 6d 69 73 73 params") ;; miss
bca0: 69 6e 67 20 70 61 72 61 6d 73 0a 09 20 20 20 20 ing params..
bcb0: 20 20 20 28 6c 65 74 20 28 28 63 61 6c 6c 69 6e (let ((callin
bcc0: 67 2d 70 61 74 68 20 28 63 61 72 20 72 65 6d 70 g-path (car remp
bcd0: 61 72 61 6d 29 29 0a 09 09 20 20 20 20 20 28 63 aram))... (c
bce0: 6c 69 65 6e 74 2d 6b 65 79 20 20 20 28 63 61 64 lient-key (cad
bcf0: 72 20 72 65 6d 70 61 72 61 6d 29 29 29 0a 09 09 r remparam)))...
bd00: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 63 61 6c (if (equal? cal
bd10: 6c 69 6e 67 2d 70 61 74 68 20 2a 74 6f 70 70 61 ling-path *toppa
bd20: 74 68 2a 29 0a 09 09 20 20 20 20 20 28 62 65 67 th*)... (beg
bd30: 69 6e 0a 09 09 20 20 20 20 20 20 20 28 68 61 73 in... (has
bd40: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 6c 6f h-table-set! *lo
bd50: 67 67 65 64 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a gged-in-clients*
bd60: 20 63 6c 69 65 6e 74 2d 6b 65 79 20 28 63 75 72 client-key (cur
bd70: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
bd80: 09 20 20 20 20 20 20 20 27 28 23 74 20 22 73 75 . '(#t "su
bd90: 63 63 65 73 73 66 75 6c 20 6c 6f 67 69 6e 22 29 ccessful login")
bda0: 29 20 20 20 20 20 20 3b 3b 20 70 61 74 68 20 6d ) ;; path m
bdb0: 61 74 63 68 65 73 20 2d 20 70 61 73 73 21 20 53 atches - pass! S
bdc0: 68 6f 75 6c 64 20 76 65 74 20 74 68 65 20 63 61 hould vet the ca
bdd0: 6c 6c 65 72 20 61 74 20 74 68 69 73 20 74 69 6d ller at this tim
bde0: 65 20 2e 2e 2e 0a 09 09 20 20 20 20 20 28 6c 69 e ...... (li
bdf0: 73 74 20 23 66 20 28 63 6f 6e 63 20 22 4c 6f 67 st #f (conc "Log
be00: 69 6e 20 66 61 69 6c 65 64 20 64 75 65 20 74 6f in failed due to
be10: 20 6d 69 73 6d 61 74 63 68 20 70 61 74 68 73 3a mismatch paths:
be20: 20 22 20 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 " calling-path
be30: 22 2c 20 22 20 2a 74 6f 70 70 61 74 68 2a 29 29 ", " *toppath*))
be40: 29 29 29 29 0a 09 20 20 28 28 6c 6f 67 6f 75 74 )))).. ((logout
be50: 29 0a 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 ).. (if (and (
be60: 3e 20 28 6c 65 6e 67 74 68 20 72 65 6d 70 61 72 > (length rempar
be70: 61 6d 29 20 31 29 0a 09 09 20 20 20 20 28 65 71 am) 1)... (eq
be80: 3f 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 61 72 ? *toppath* (car
be90: 20 72 65 6d 70 61 72 61 6d 29 29 0a 09 09 20 20 remparam))...
bea0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
beb0: 66 2f 64 65 66 61 75 6c 74 20 2a 6c 6f 67 67 65 f/default *logge
bec0: 64 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 28 63 d-in-clients* (c
bed0: 61 64 72 20 72 65 6d 70 61 72 61 6d 29 20 23 66 adr remparam) #f
bee0: 29 29 0a 09 20 20 20 20 20 20 20 23 74 0a 09 20 )).. #t..
bef0: 20 20 20 20 20 20 23 66 29 29 0a 09 20 20 28 28 #f)).. ((
bf00: 6e 75 6d 63 6c 69 65 6e 74 73 29 0a 09 20 20 20 numclients)..
bf10: 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 (length (hash-ta
bf20: 62 6c 65 2d 6b 65 79 73 20 2a 6c 6f 67 67 65 64 ble-keys *logged
bf30: 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 29 29 29 0a -in-clients*))).
bf40: 09 20 20 28 28 66 6c 75 73 68 29 0a 09 20 20 20 . ((flush)..
bf50: 28 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 64 (db:write-cached
bf60: 2d 64 61 74 61 29 0a 09 20 20 20 23 74 29 0a 09 -data).. #t)..
bf70: 20 20 28 28 69 6d 6d 65 64 69 61 74 65 29 0a 09 ((immediate)..
bf80: 20 20 20 28 64 62 3a 77 72 69 74 65 2d 63 61 63 (db:write-cac
bf90: 68 65 64 2d 64 61 74 61 29 0a 09 20 20 20 28 69 hed-data).. (i
bfa0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 f (not (null? re
bfb0: 6d 70 61 72 61 6d 29 29 0a 09 20 20 20 20 20 20 mparam))..
bfc0: 20 28 61 70 70 6c 79 20 28 63 61 72 20 72 65 6d (apply (car rem
bfd0: 70 61 72 61 6d 29 20 28 63 64 72 20 72 65 6d 70 param) (cdr remp
bfe0: 61 72 61 6d 29 29 0a 09 20 20 20 20 20 20 20 22 aram)).. "
bff0: 45 52 52 4f 52 22 29 29 0a 09 20 20 28 28 6b 69 ERROR")).. ((ki
c000: 6c 6c 73 65 72 76 65 72 29 0a 09 20 20 20 3b 3b llserver).. ;;
c010: 20 28 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 (db:write-cache
c020: 64 2d 64 61 74 61 29 0a 09 20 20 20 28 64 65 62 d-data).. (deb
c030: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
c040: 22 52 65 6d 6f 74 65 6c 79 20 6b 69 6c 6c 65 64 "Remotely killed
c050: 20 73 65 72 76 65 72 20 6f 6e 20 68 6f 73 74 20 server on host
c060: 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 " (get-host-name
c070: 29 20 22 20 70 69 64 20 22 20 28 63 75 72 72 65 ) " pid " (curre
c080: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 0a nt-process-id)).
c090: 09 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d . (set! *time-
c0a0: 74 6f 2d 65 78 69 74 2a 20 23 74 29 0a 09 20 20 to-exit* #t)..
c0b0: 20 23 74 29 0a 09 20 20 28 28 73 65 74 2d 76 65 #t).. ((set-ve
c0c0: 72 62 6f 73 69 74 79 29 0a 09 20 20 20 28 73 65 rbosity).. (se
c0d0: 74 21 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 t! *verbosity* (
c0e0: 63 61 64 64 72 20 70 61 72 61 6d 73 29 29 0a 09 caddr params))..
c0f0: 20 20 20 2a 76 65 72 62 6f 73 69 74 79 2a 29 0a *verbosity*).
c100: 09 20 20 28 28 67 65 74 2d 76 65 72 62 6f 73 69 . ((get-verbosi
c110: 74 79 29 0a 09 20 20 20 2a 76 65 72 62 6f 73 69 ty).. *verbosi
c120: 74 79 2a 29 0a 09 20 20 28 65 6c 73 65 0a 09 20 ty*).. (else..
c130: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a (mutex-lock! *
c140: 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 incoming-mutex*)
c150: 0a 09 20 20 20 28 73 65 74 21 20 2a 6c 61 73 74 .. (set! *last
c160: 2d 64 62 2d 61 63 63 65 73 73 2a 20 28 63 75 72 -db-access* (cur
c170: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 rent-seconds))..
c180: 20 20 20 28 73 65 74 21 20 2a 69 6e 63 6f 6d 69 (set! *incomi
c190: 6e 67 2d 64 61 74 61 2a 20 28 63 6f 6e 73 20 0a ng-data* (cons .
c1a0: 09 09 09 09 20 20 28 76 65 63 74 6f 72 20 71 72 .... (vector qr
c1b0: 79 2d 6e 61 6d 65 0a 09 09 09 09 09 20 20 28 63 y-name...... (c
c1c0: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f urrent-milliseco
c1d0: 6e 64 73 29 0a 09 09 09 09 09 20 20 72 65 6d 70 nds)...... remp
c1e0: 61 72 61 6d 29 0a 09 09 09 09 20 20 2a 69 6e 63 aram)..... *inc
c1f0: 6f 6d 69 6e 67 2d 64 61 74 61 2a 29 29 0a 09 20 oming-data*))..
c200: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
c210: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 *incoming-mutex
c220: 2a 29 0a 09 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 *).. ;; NOTE:
c230: 69 66 20 63 61 63 68 65 64 3f 20 69 73 20 23 66 if cached? is #f
c240: 20 74 68 65 6e 20 74 68 69 73 20 63 61 6c 6c 20 then this call
c250: 6d 75 73 74 20 62 65 20 72 75 6e 20 69 6d 6d 65 must be run imme
c260: 64 69 61 74 65 6c 79 0a 09 20 20 20 3b 3b 20 20 diately.. ;;
c270: 20 20 20 20 20 62 75 74 20 66 69 72 73 74 20 61 but first a
c280: 6c 6c 20 63 61 6c 6c 73 20 69 6e 20 74 68 65 20 ll calls in the
c290: 71 75 65 75 65 20 61 72 65 20 72 75 6e 20 66 69 queue are run fi
c2a0: 72 73 74 20 69 6e 20 74 68 65 20 6f 72 64 65 72 rst in the order
c2b0: 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 6f 66 .. ;; of
c2c0: 20 74 68 65 69 72 20 74 69 6d 65 20 73 74 61 6d their time stam
c2d0: 70 0a 09 20 20 20 28 69 66 20 28 61 6e 64 20 63 p.. (if (and c
c2e0: 61 63 68 65 64 3f 20 2a 63 61 63 68 65 2d 6f 6e ached? *cache-on
c2f0: 2a 29 0a 09 20 20 20 20 20 20 20 28 62 65 67 69 *).. (begi
c300: 6e 0a 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e n... (debug:prin
c310: 74 2d 69 6e 66 6f 20 31 32 20 22 2a 63 61 63 68 t-info 12 "*cach
c320: 65 2d 6f 6e 2a 20 69 73 20 22 20 2a 63 61 63 68 e-on* is " *cach
c330: 65 2d 6f 6e 2a 20 22 2c 20 73 6b 69 70 70 69 6e e-on* ", skippin
c340: 67 20 63 61 63 68 65 20 77 72 69 74 65 22 29 0a g cache write").
c350: 09 09 20 22 43 41 43 48 45 44 22 29 0a 09 20 20 .. "CACHED")..
c360: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 28 (begin... (
c370: 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 64 2d db:write-cached-
c380: 64 61 74 61 29 0a 09 09 20 22 57 52 49 54 54 45 data)... "WRITTE
c390: 4e 22 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 N")))))))..(defi
c3a0: 6e 65 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 ne (db:obj->stri
c3b0: 6e 67 20 6f 62 6a 29 28 77 69 74 68 2d 6f 75 74 ng obj)(with-out
c3c0: 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c put-to-string (l
c3d0: 61 6d 62 64 61 20 28 29 28 73 65 72 69 61 6c 69 ambda ()(seriali
c3e0: 7a 65 20 6f 62 6a 29 29 29 29 0a 28 64 65 66 69 ze obj)))).(defi
c3f0: 6e 65 20 28 64 62 3a 73 74 72 69 6e 67 2d 3e 6f ne (db:string->o
c400: 62 6a 20 6d 73 67 29 28 77 69 74 68 2d 69 6e 70 bj msg)(with-inp
c410: 75 74 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 20 6d ut-from-string m
c420: 73 67 20 28 6c 61 6d 62 64 61 20 28 29 28 64 65 sg (lambda ()(de
c430: 73 65 72 69 61 6c 69 7a 65 29 29 29 29 0a 0a 28 serialize))))..(
c440: 64 65 66 69 6e 65 20 28 63 64 62 3a 63 6c 69 65 define (cdb:clie
c450: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b nt-call zmq-sock
c460: 65 74 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 et . params). (
c470: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
c480: 20 31 31 20 22 63 64 62 3a 63 6c 69 65 6e 74 2d 11 "cdb:client-
c490: 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b 65 74 3d call zmq-socket=
c4a0: 22 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 22 20 70 " zmq-socket " p
c4b0: 61 72 61 6d 73 3d 22 20 70 61 72 61 6d 73 29 0a arams=" params).
c4c0: 20 20 28 6c 65 74 20 28 28 7a 64 61 74 20 28 64 (let ((zdat (d
c4d0: 62 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 70 61 b:obj->string pa
c4e0: 72 61 6d 73 29 29 20 3b 3b 20 28 77 69 74 68 2d rams)) ;; (with-
c4f0: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
c500: 20 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69 (lambda ()(seri
c510: 61 6c 69 7a 65 20 70 61 72 61 6d 73 29 29 29 29 alize params))))
c520: 0a 09 28 72 65 73 20 20 23 66 29 29 0a 20 20 20 ..(res #f)).
c530: 20 28 73 65 6e 64 2d 6d 65 73 73 61 67 65 20 7a (send-message z
c540: 6d 71 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 0a mq-socket zdat).
c550: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 64 (set! res (d
c560: 62 3a 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 28 72 b:string->obj (r
c570: 65 63 65 69 76 65 2d 6d 65 73 73 61 67 65 20 7a eceive-message z
c580: 6d 71 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 29 mq-socket zdat))
c590: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
c5a0: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 7a 6d 71 2d nt-info 11 "zmq-
c5b0: 73 6f 63 6b 65 74 20 22 20 28 63 61 72 20 70 61 socket " (car pa
c5c0: 72 61 6d 73 29 20 22 20 72 65 73 3d 22 20 72 65 rams) " res=" re
c5d0: 73 29 0a 20 20 20 20 72 65 73 29 29 0a 20 20 0a s). res)). .
c5e0: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65 74 (define (cdb:set
c5f0: 2d 76 65 72 62 6f 73 69 74 79 20 7a 6d 71 2d 73 -verbosity zmq-s
c600: 6f 63 6b 65 74 20 76 61 6c 29 0a 20 20 28 63 64 ocket val). (cd
c610: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d b:client-call zm
c620: 71 2d 73 6f 63 6b 65 74 20 27 73 65 74 2d 76 65 q-socket 'set-ve
c630: 72 62 6f 73 69 74 79 20 23 66 20 76 61 6c 29 29 rbosity #f val))
c640: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6c ..(define (cdb:l
c650: 6f 67 69 6e 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 ogin zmq-socket
c660: 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72 65 keyval signature
c670: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d ). (cdb:client-
c680: 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 call zmq-socket
c690: 27 6c 6f 67 69 6e 20 23 74 20 6b 65 79 76 61 6c 'login #t keyval
c6a0: 20 73 69 67 6e 61 74 75 72 65 29 29 0a 0a 28 64 signature))..(d
c6b0: 65 66 69 6e 65 20 28 63 64 62 3a 6c 6f 67 6f 75 efine (cdb:logou
c6c0: 74 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 6b 65 79 t zmq-socket key
c6d0: 76 61 6c 20 73 69 67 6e 61 74 75 72 65 29 0a 20 val signature).
c6e0: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
c6f0: 6c 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 27 6c 6f l zmq-socket 'lo
c700: 67 6f 75 74 20 23 74 20 6b 65 79 76 61 6c 20 73 gout #t keyval s
c710: 69 67 6e 61 74 75 72 65 29 29 0a 0a 28 64 65 66 ignature))..(def
c720: 69 6e 65 20 28 63 64 62 3a 6e 75 6d 2d 63 6c 69 ine (cdb:num-cli
c730: 65 6e 74 73 20 7a 6d 71 2d 73 6f 63 6b 65 74 29 ents zmq-socket)
c740: 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 . (cdb:client-c
c750: 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b 65 74 20 27 all zmq-socket '
c760: 6e 75 6d 63 6c 69 65 6e 74 73 20 23 74 29 29 0a numclients #t)).
c770: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 .(define (cdb:te
c780: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 st-set-status-st
c790: 61 74 65 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 ate zmqsocket te
c7a0: 73 74 2d 69 64 20 73 74 61 74 75 73 20 73 74 61 st-id status sta
c7b0: 74 65 20 6d 73 67 29 0a 20 20 28 69 66 20 6d 73 te msg). (if ms
c7c0: 67 0a 20 20 20 20 20 20 28 63 64 62 3a 63 6c 69 g. (cdb:cli
c7d0: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
c7e0: 65 74 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 et 'state-status
c7f0: 2d 6d 73 67 20 23 74 20 73 74 61 74 65 20 73 74 -msg #t state st
c800: 61 74 75 73 20 6d 73 67 20 74 65 73 74 2d 69 64 atus msg test-id
c810: 29 0a 20 20 20 20 20 20 28 63 64 62 3a 63 6c 69 ). (cdb:cli
c820: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
c830: 65 74 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 et 'state-status
c840: 20 23 74 20 73 74 61 74 65 20 73 74 61 74 75 73 #t state status
c850: 20 74 65 73 74 2d 69 64 29 29 29 20 3b 3b 20 72 test-id))) ;; r
c860: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
c870: 69 74 65 6d 2d 70 61 74 68 20 6d 69 6e 75 74 65 item-path minute
c880: 73 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 s cpuload diskfr
c890: 65 65 20 74 6d 70 66 72 65 65 29 20 0a 0a 28 64 ee tmpfree) ..(d
c8a0: 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d efine (cdb:test-
c8b0: 72 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 rollup-test_data
c8c0: 2d 70 61 73 73 2d 66 61 69 6c 20 7a 6d 71 73 6f -pass-fail zmqso
c8d0: 63 6b 65 74 20 74 65 73 74 2d 69 64 29 0a 20 20 cket test-id).
c8e0: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c (cdb:client-call
c8f0: 20 7a 6d 71 73 6f 63 6b 65 74 20 27 74 65 73 74 zmqsocket 'test
c900: 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 20 _data-pf-rollup
c910: 23 74 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d #t test-id test-
c920: 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d id test-id test-
c930: 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 id))..(define (c
c940: 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 db:pass-fail-cou
c950: 6e 74 73 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 nts zmqsocket te
c960: 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 st-id fail-count
c970: 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a 20 20 28 pass-count). (
c980: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
c990: 7a 6d 71 73 6f 63 6b 65 74 20 27 70 61 73 73 2d zmqsocket 'pass-
c9a0: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 23 74 20 66 fail-counts #t f
c9b0: 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 ail-count pass-c
c9c0: 6f 75 6e 74 20 74 65 73 74 2d 69 64 29 29 0a 0a ount test-id))..
c9d0: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 (define (cdb:tes
c9e0: 74 73 2d 72 65 67 69 73 74 65 72 2d 74 65 73 74 ts-register-test
c9f0: 20 7a 6d 71 73 6f 63 6b 65 74 20 72 75 6e 2d 69 zmqsocket run-i
ca00: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
ca10: 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 -path). (let ((
ca20: 69 74 65 6d 2d 70 61 74 68 73 20 28 69 66 20 28 item-paths (if (
ca30: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
ca40: 20 22 22 29 0a 09 09 09 28 6c 69 73 74 20 69 74 "")....(list it
ca50: 65 6d 2d 70 61 74 68 29 0a 09 09 09 28 6c 69 73 em-path)....(lis
ca60: 74 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 t item-path ""))
ca70: 29 29 0a 20 20 20 20 28 63 64 62 3a 63 6c 69 65 )). (cdb:clie
ca80: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
ca90: 74 20 27 72 65 67 69 73 74 65 72 2d 74 65 73 74 t 'register-test
caa0: 20 23 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d #t run-id test-
cab0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
cac0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
cad0: 66 6c 75 73 68 2d 71 75 65 75 65 20 7a 6d 71 73 flush-queue zmqs
cae0: 6f 63 6b 65 74 29 0a 20 20 28 63 64 62 3a 63 6c ocket). (cdb:cl
caf0: 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 ient-call zmqsoc
cb00: 6b 65 74 20 27 66 6c 75 73 68 20 23 66 29 29 0a ket 'flush #f)).
cb10: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6b 69 .(define (cdb:ki
cb20: 6c 6c 2d 73 65 72 76 65 72 20 7a 6d 71 73 6f 63 ll-server zmqsoc
cb30: 6b 65 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 ket). (cdb:clie
cb40: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
cb50: 74 20 27 6b 69 6c 6c 73 65 72 76 65 72 20 23 66 t 'killserver #f
cb60: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
cb70: 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 :roll-up-pass-fa
cb80: 69 6c 2d 63 6f 75 6e 74 73 20 7a 6d 71 73 6f 63 il-counts zmqsoc
cb90: 6b 65 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ket run-id test-
cba0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
cbb0: 74 61 74 75 73 29 0a 20 20 28 63 64 62 3a 63 6c tatus). (cdb:cl
cbc0: 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 ient-call zmqsoc
cbd0: 6b 65 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23 ket 'immediate #
cbe0: 66 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 f open-run-close
cbf0: 20 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 db:roll-up-pass
cc00: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 23 66 20 -fail-counts #f
cc10: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
cc20: 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 item-path statu
cc30: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 s))..(define (cd
cc40: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 b:get-test-info
cc50: 7a 6d 71 73 6f 63 6b 65 74 20 72 75 6e 2d 69 64 zmqsocket run-id
cc60: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
cc70: 70 61 74 68 29 0a 20 20 28 63 64 62 3a 63 6c 69 path). (cdb:cli
cc80: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
cc90: 65 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 et 'immediate #f
cca0: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 open-run-close
ccb0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
ccc0: 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d #f run-id test-
ccd0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
cce0: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 67 ..(define (cdb:g
ccf0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
cd00: 69 64 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 id zmqsocket tes
cd10: 74 2d 69 64 29 0a 20 20 28 63 64 62 3a 63 6c 69 t-id). (cdb:cli
cd20: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
cd30: 65 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 et 'immediate #f
cd40: 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 open-run-close
cd50: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
cd60: 2d 62 79 2d 69 64 20 23 66 20 74 65 73 74 2d 69 -by-id #f test-i
cd70: 64 29 29 0a 0a 3b 3b 20 64 62 20 73 68 6f 75 6c d))..;; db shoul
cd80: 64 20 62 65 20 64 62 20 6f 70 65 6e 20 70 72 6f d be db open pro
cd90: 63 20 6f 72 20 23 66 0a 28 64 65 66 69 6e 65 20 c or #f.(define
cda0: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
cdb0: 70 72 6f 63 20 64 62 20 2e 20 70 61 72 61 6d 73 proc db . params
cdc0: 29 0a 20 20 28 61 70 70 6c 79 20 63 64 62 3a 63 ). (apply cdb:c
cdd0: 6c 69 65 6e 74 2d 63 61 6c 6c 20 2a 72 75 6e 72 lient-call *runr
cde0: 65 6d 6f 74 65 2a 20 27 69 6d 6d 65 64 69 61 74 emote* 'immediat
cdf0: 65 20 23 66 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c e #f open-run-cl
ce00: 6f 73 65 20 70 72 6f 63 20 23 66 20 70 61 72 61 ose proc #f para
ce10: 6d 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ms))..(define (d
ce20: 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 b:test-get-logfi
ce30: 6c 65 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 le-info db run-i
ce40: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
ce50: 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 let ((res #f)).
ce60: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
ce70: 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 each-row . (
ce80: 6c 61 6d 62 64 61 20 28 70 61 74 68 20 66 69 6e lambda (path fin
ce90: 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 al_logf).
cea0: 28 73 65 74 21 20 6c 6f 67 66 20 66 69 6e 61 6c (set! logf final
ceb0: 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 28 73 _logf). (s
cec0: 65 74 21 20 72 65 73 20 28 6c 69 73 74 20 70 61 et! res (list pa
ced0: 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a th final_logf)).
cee0: 20 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 (if (dire
cef0: 63 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 ctory? path)..
cf00: 20 28 70 72 69 6e 74 20 22 46 6f 75 6e 64 20 70 (print "Found p
cf10: 61 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 ath: " path)..
cf20: 20 28 70 72 69 6e 74 20 22 4e 6f 20 73 75 63 68 (print "No such
cf30: 20 70 61 74 68 3a 20 22 20 70 61 74 68 29 29 29 path: " path)))
cf40: 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 22 . db . "
cf50: 53 45 4c 45 43 54 20 72 75 6e 64 69 72 2c 66 69 SELECT rundir,fi
cf60: 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20 74 65 nal_logf FROM te
cf70: 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 sts WHERE run_id
cf80: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
cf90: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
cfa0: 27 27 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 '';". run-id
cfb0: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 test-name).
cfc0: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 res))..(define d
cfd0: 62 3a 71 75 65 72 69 65 73 20 0a 20 20 28 6c 69 b:queries . (li
cfe0: 73 74 20 27 28 72 65 67 69 73 74 65 72 2d 74 65 st '(register-te
cff0: 73 74 20 20 20 20 20 20 20 20 20 20 22 49 4e 53 st "INS
d000: 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e ERT OR IGNORE IN
d010: 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 TO tests (run_id
d020: 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f ,testname,event_
d030: 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 time,item_path,s
d040: 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c tate,status) VAL
d050: 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d UES (?,?,strftim
d060: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c e('%s','now'),?,
d070: 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 'NOT_STARTED','n
d080: 2f 61 27 29 3b 22 29 0a 09 27 28 73 74 61 74 65 /a');")..'(state
d090: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
d0a0: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d0b0: 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 SET state=?,stat
d0c0: 75 73 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b us=? WHERE id=?;
d0d0: 22 29 0a 09 27 28 73 74 61 74 65 2d 73 74 61 74 ")..'(state-stat
d0e0: 75 73 2d 6d 73 67 20 20 20 20 20 20 20 22 55 50 us-msg "UP
d0f0: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 DATE tests SET s
d100: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c tate=?,status=?,
d110: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
d120: 69 64 3d 3f 3b 22 29 0a 09 27 28 70 61 73 73 2d id=?;")..'(pass-
d130: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 20 20 20 20 fail-counts
d140: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d150: 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f SET fail_count=?
d160: 2c 70 61 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 ,pass_count=? WH
d170: 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 3b 3b 20 ERE id=?;")..;;
d180: 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c test_data-pf-rol
d190: 6c 75 70 20 69 73 20 75 73 65 64 20 74 6f 20 73 lup is used to s
d1a0: 65 74 20 61 20 74 65 73 74 73 20 50 41 53 53 2f et a tests PASS/
d1b0: 46 41 49 4c 20 62 61 73 65 64 20 6f 6e 20 74 68 FAIL based on th
d1c0: 65 20 70 61 73 73 2f 66 61 69 6c 20 69 6e 66 6f e pass/fail info
d1d0: 20 66 72 6f 6d 20 74 68 65 20 73 74 65 70 73 0a from the steps.
d1e0: 09 27 28 74 65 73 74 5f 64 61 74 61 2d 70 66 2d .'(test_data-pf-
d1f0: 72 6f 6c 6c 75 70 20 20 20 20 22 55 50 44 41 54 rollup "UPDAT
d200: 45 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 E tests.
d210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d220: 20 20 20 20 20 20 20 20 20 20 20 20 53 45 54 20 SET
d230: 73 74 61 74 75 73 3d 43 41 53 45 20 57 48 45 4e status=CASE WHEN
d240: 20 28 53 45 4c 45 43 54 20 66 61 69 6c 5f 63 6f (SELECT fail_co
d250: 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 57 unt FROM tests W
d260: 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 0a HERE id=?) > 0 .
d270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d290: 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 49 4c THEN 'FAIL
d2a0: 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 '.
d2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2c0: 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 WHEN (SELE
d2d0: 43 54 20 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 CT pass_count FR
d2e0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 OM tests WHERE i
d2f0: 64 3d 3f 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 d=?) > 0 AND .
d300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d320: 20 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 (SELECT stat
d330: 75 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 us FROM tests WH
d340: 45 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e ERE id=?) NOT IN
d350: 20 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 ('WARN','FAIL')
d360: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d380: 20 20 20 20 20 54 48 45 4e 20 27 50 41 53 53 27 THEN 'PASS'
d390: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d3a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d3b0: 20 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 ELSE status
d3c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d3d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d3e0: 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 69 END WHERE i
d3f0: 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 2d 73 d=?;")..'(test-s
d400: 65 74 2d 6c 6f 67 20 20 20 20 20 20 20 20 20 20 et-log
d410: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d420: 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f SET final_logf=?
d430: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 WHERE id=?;")..
d440: 27 28 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 '(test-set-rundi
d450: 72 2d 62 79 2d 74 65 73 74 2d 69 64 20 22 55 50 r-by-test-id "UP
d460: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 DATE tests SET r
d470: 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 69 64 undir=? WHERE id
d480: 3d 3f 22 29 0a 09 27 28 74 65 73 74 2d 73 65 74 =?")..'(test-set
d490: 2d 72 75 6e 64 69 72 20 20 20 20 20 20 20 20 20 -rundir
d4a0: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
d4b0: 54 20 72 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 T rundir=? WHERE
d4c0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
d4d0: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
d4e0: 6d 5f 70 61 74 68 3d 3f 3b 22 29 0a 09 27 28 64 m_path=?;")..'(d
d4f0: 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 elete-tests-in-s
d500: 74 61 74 65 20 20 20 22 44 45 4c 45 54 45 20 46 tate "DELETE F
d510: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
d520: 73 74 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f state=? AND run_
d530: 69 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 73 id=?;")..'(tests
d540: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 :test-set-toplog
d550: 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 "UPDATE test
d560: 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 s SET final_logf
d570: 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d =? WHERE run_id=
d580: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f ? AND testname=?
d590: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 AND item_path='
d5a0: 27 3b 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 ';"). ))..;;
d5b0: 64 6f 20 6e 6f 74 20 72 75 6e 20 74 68 65 73 65 do not run these
d5c0: 20 61 73 20 70 61 72 74 20 6f 66 20 74 68 65 20 as part of the
d5d0: 74 72 61 6e 73 61 63 74 69 6f 6e 0a 28 64 65 66 transaction.(def
d5e0: 69 6e 65 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 ine db:special-q
d5f0: 75 65 72 69 65 73 20 20 20 27 28 72 6f 6c 6c 75 ueries '(rollu
d600: 70 2d 74 65 73 74 73 2d 70 61 73 73 2d 66 61 69 p-tests-pass-fai
d610: 6c 0a 09 09 09 20 20 20 20 20 20 20 64 62 3a 72 l.... db:r
d620: 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c oll-up-pass-fail
d630: 2d 63 6f 75 6e 74 73 29 29 0a 0a 3b 3b 20 6e 6f -counts))..;; no
d640: 74 20 75 73 65 64 2c 20 69 6e 74 65 6e 64 65 64 t used, intended
d650: 20 74 6f 20 69 6e 64 69 63 61 74 65 20 74 6f 20 to indicate to
d660: 72 75 6e 20 69 6e 20 63 61 6c 6c 69 6e 67 20 70 run in calling p
d670: 72 6f 63 65 73 73 0a 28 64 65 66 69 6e 65 20 64 rocess.(define d
d680: 62 3a 72 75 6e 2d 6c 6f 63 61 6c 2d 71 75 65 72 b:run-local-quer
d690: 69 65 73 20 27 28 29 29 20 3b 3b 20 72 6f 6c 6c ies '()) ;; roll
d6a0: 75 70 2d 74 65 73 74 73 2d 70 61 73 73 2d 66 61 up-tests-pass-fa
d6b0: 69 6c 29 29 0a 0a 3b 3b 20 54 68 65 20 71 75 65 il))..;; The que
d6c0: 75 65 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 ue is a list of
d6d0: 76 65 63 74 6f 72 73 20 77 68 65 72 65 20 74 68 vectors where th
d6e0: 65 20 7a 65 72 6f 74 68 20 73 6c 6f 74 20 69 6e e zeroth slot in
d6f0: 64 69 63 61 74 65 73 20 74 68 65 20 74 79 70 65 dicates the type
d700: 20 6f 66 20 71 75 65 72 79 20 74 6f 0a 3b 3b 20 of query to.;;
d710: 61 70 70 6c 79 20 61 6e 64 20 74 68 65 20 73 65 apply and the se
d720: 63 6f 6e 64 20 73 6c 6f 74 20 69 73 20 74 68 65 cond slot is the
d730: 20 74 69 6d 65 20 6f 66 20 74 68 65 20 71 75 65 time of the que
d740: 72 79 20 61 6e 64 20 74 68 65 20 74 68 69 72 64 ry and the third
d750: 20 65 6e 74 72 79 20 69 73 20 61 20 6c 69 73 74 entry is a list
d760: 20 6f 66 20 0a 3b 3b 20 76 61 6c 75 65 73 20 74 of .;; values t
d770: 6f 20 62 65 20 61 70 70 6c 69 65 64 0a 3b 3b 0a o be applied.;;.
d780: 28 64 65 66 69 6e 65 20 28 64 62 3a 77 72 69 74 (define (db:writ
d790: 65 2d 63 61 63 68 65 64 2d 64 61 74 61 29 0a 20 e-cached-data).
d7a0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
d7b0: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 20 . (lambda (db
d7c0: 2e 20 6a 75 6e 6b 70 61 72 61 6d 73 29 0a 20 20 . junkparams).
d7d0: 20 20 20 28 6c 65 74 20 28 28 71 75 65 72 69 65 (let ((querie
d7e0: 73 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d s (make-hash-
d7f0: 74 61 62 6c 65 29 29 0a 09 20 20 20 28 64 61 74 table)).. (dat
d800: 61 20 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 a #f)).
d810: 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 (mutex-lock!
d820: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 *incoming-mutex
d830: 2a 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 *). (set!
d840: 64 61 74 61 20 28 73 6f 72 74 20 2a 69 6e 63 6f data (sort *inco
d850: 6d 69 6e 67 2d 64 61 74 61 2a 20 28 6c 61 6d 62 ming-data* (lamb
d860: 64 61 20 28 61 20 62 29 28 3c 20 28 76 65 63 74 da (a b)(< (vect
d870: 6f 72 2d 72 65 66 20 61 20 31 29 28 76 65 63 74 or-ref a 1)(vect
d880: 6f 72 2d 72 65 66 20 62 20 31 29 29 29 29 29 0a or-ref b 1))))).
d890: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 69 6e (set! *in
d8a0: 63 6f 6d 69 6e 67 2d 64 61 74 61 2a 20 27 28 29 coming-data* '()
d8b0: 29 0a 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d ). (mutex-
d8c0: 75 6e 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e unlock! *incomin
d8d0: 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 g-mutex*).
d8e0: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
d8f0: 64 61 74 61 29 20 30 29 0a 09 20 20 20 28 64 65 data) 0).. (de
d900: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
d910: 20 22 57 72 69 74 69 6e 67 20 63 61 63 68 65 64 "Writing cached
d920: 20 64 61 74 61 20 22 20 64 61 74 61 29 29 0a 0a data " data))..
d930: 20 20 20 20 20 20 20 3b 3b 20 70 72 65 70 61 72 ;; prepar
d940: 65 20 74 68 65 20 6e 65 65 64 65 64 20 73 74 61 e the needed sta
d950: 74 65 6d 65 6e 74 73 2c 20 64 6f 20 65 61 63 68 tements, do each
d960: 20 6f 6e 6c 79 20 6f 6e 63 65 0a 20 20 20 20 20 only once.
d970: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
d980: 62 64 61 20 28 72 65 71 75 65 73 74 2d 69 74 65 bda (request-ite
d990: 6d 29 0a 09 09 20 20 20 28 6c 65 74 20 28 28 73 m)... (let ((s
d9a0: 74 6d 74 2d 6b 65 79 20 28 76 65 63 74 6f 72 2d tmt-key (vector-
d9b0: 72 65 66 20 72 65 71 75 65 73 74 2d 69 74 65 6d ref request-item
d9c0: 20 30 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 0)))... (if
d9d0: 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c (not (hash-tabl
d9e0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 71 75 e-ref/default qu
d9f0: 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 20 23 eries stmt-key #
da00: 66 29 29 0a 09 09 09 20 28 6c 65 74 20 28 28 73 f)).... (let ((s
da10: 74 6d 74 20 28 61 6c 69 73 74 2d 72 65 66 20 73 tmt (alist-ref s
da20: 74 6d 74 2d 6b 65 79 20 64 62 3a 71 75 65 72 69 tmt-key db:queri
da30: 65 73 29 29 29 0a 09 09 09 20 20 20 28 69 66 20 es))).... (if
da40: 73 74 6d 74 0a 09 09 09 20 20 20 20 20 20 20 28 stmt.... (
da50: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
da60: 71 75 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 queries stmt-key
da70: 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 (sqlite3:prepar
da80: 65 20 64 62 20 28 63 61 72 20 73 74 6d 74 29 29 e db (car stmt))
da90: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ).... (if
daa0: 28 70 72 6f 63 65 64 75 72 65 3f 20 73 74 6d 74 (procedure? stmt
dab0: 2d 6b 65 79 29 0a 09 09 09 09 20 20 20 28 68 61 -key)..... (ha
dac0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 71 75 sh-table-set! qu
dad0: 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 20 23 eries stmt-key #
dae0: 66 29 0a 09 09 09 09 20 20 20 28 64 65 62 75 67 f)..... (debug
daf0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
db00: 20 4d 69 73 73 69 6e 67 20 71 75 65 72 79 20 73 Missing query s
db10: 70 65 63 20 66 6f 72 20 22 20 73 74 6d 74 2d 6b pec for " stmt-k
db20: 65 79 20 22 21 22 29 29 29 29 29 29 29 0a 09 09 ey "!")))))))...
db30: 20 64 61 74 61 29 0a 20 20 20 20 20 20 20 0a 20 data). .
db40: 20 20 20 20 20 20 3b 3b 20 6f 75 74 65 72 20 6c ;; outer l
db50: 6f 6f 70 20 74 6f 20 68 61 6e 64 6c 65 20 73 70 oop to handle sp
db60: 65 63 69 61 6c 20 71 75 65 72 69 65 73 20 74 68 ecial queries th
db70: 61 74 20 63 61 6e 6e 6f 74 20 62 65 20 68 61 6e at cannot be han
db80: 64 6c 65 64 20 69 6e 20 74 68 65 0a 20 20 20 20 dled in the.
db90: 20 20 20 3b 3b 20 74 72 61 6e 73 61 63 74 69 6f ;; transactio
dba0: 6e 2e 0a 20 20 20 20 20 20 20 28 6c 65 74 20 6f n.. (let o
dbb0: 75 74 65 72 6c 6f 6f 70 20 28 28 73 70 65 63 69 uterloop ((speci
dbc0: 61 6c 2d 71 72 79 20 23 66 29 0a 09 09 20 20 20 al-qry #f)...
dbd0: 20 20 20 20 28 73 74 6d 74 73 20 20 20 20 20 20 (stmts
dbe0: 20 64 61 74 61 29 29 0a 09 20 28 69 66 20 73 70 data)).. (if sp
dbf0: 65 63 69 61 6c 2d 71 72 79 0a 0a 09 20 20 20 20 ecial-qry...
dc00: 20 3b 3b 20 68 61 6e 64 6c 65 20 61 20 71 75 65 ;; handle a que
dc10: 72 79 20 74 68 61 74 20 63 61 6e 6e 6f 74 20 62 ry that cannot b
dc20: 65 20 70 61 72 74 20 6f 66 20 74 68 65 20 67 72 e part of the gr
dc30: 6f 75 70 65 64 20 71 75 65 72 69 65 73 0a 09 20 ouped queries..
dc40: 20 20 20 20 28 6c 65 74 2a 20 28 28 73 74 6d 74 (let* ((stmt
dc50: 2d 6b 65 79 20 28 76 65 63 74 6f 72 2d 72 65 66 -key (vector-ref
dc60: 20 73 70 65 63 69 61 6c 2d 71 72 79 20 30 29 29 special-qry 0))
dc70: 0a 09 09 20 20 20 20 28 71 72 79 20 20 20 20 20 ... (qry
dc80: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
dc90: 20 71 75 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 queries stmt-ke
dca0: 79 29 29 0a 09 09 20 20 20 20 28 70 61 72 61 6d y))... (param
dcb0: 73 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 s (vector-ref
dcc0: 73 70 65 63 69 61 6c 2d 71 72 79 20 32 29 29 29 special-qry 2)))
dcd0: 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 73 74 .. (if (st
dce0: 72 69 6e 67 3f 20 71 72 79 29 0a 09 09 20 20 20 ring? qry)...
dcf0: 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 (apply sqlite3:e
dd00: 78 65 63 75 74 65 20 64 62 20 71 72 79 20 70 61 xecute db qry pa
dd10: 72 61 6d 73 29 0a 09 09 20 20 20 28 69 66 20 28 rams)... (if (
dd20: 70 72 6f 63 65 64 75 72 65 3f 20 73 74 6d 74 2d procedure? stmt-
dd30: 6b 65 79 29 0a 09 09 20 20 20 20 20 20 20 28 62 key)... (b
dd40: 65 67 69 6e 0a 09 09 09 20 3b 3b 20 77 65 20 61 egin.... ;; we a
dd50: 72 65 20 62 65 69 6e 67 20 68 61 6e 64 65 64 20 re being handed
dd60: 61 20 70 72 6f 63 65 64 75 72 65 20 73 6f 20 63 a procedure so c
dd70: 61 6c 6c 20 69 74 0a 09 09 09 20 28 64 65 62 75 all it.... (debu
dd80: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
dd90: 22 52 75 6e 6e 69 6e 67 20 28 61 70 70 6c 79 20 "Running (apply
dda0: 22 20 73 74 6d 74 2d 6b 65 79 20 22 20 22 20 64 " stmt-key " " d
ddb0: 62 20 22 20 22 20 70 61 72 61 6d 73 20 22 29 22 b " " params ")"
ddc0: 29 0a 09 09 09 20 28 61 70 70 6c 79 20 73 74 6d ).... (apply stm
ddd0: 74 2d 6b 65 79 20 64 62 20 70 61 72 61 6d 73 29 t-key db params)
dde0: 29 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 )... (debu
ddf0: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
de00: 3a 20 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 71 : Unrecognised q
de10: 75 65 75 65 64 20 63 61 6c 6c 20 22 20 71 72 79 ueued call " qry
de20: 20 22 20 22 20 70 61 72 61 6d 73 29 29 29 0a 09 " " params)))..
de30: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
de40: 28 6e 75 6c 6c 3f 20 73 74 6d 74 73 29 29 0a 09 (null? stmts))..
de50: 09 20 20 20 28 6f 75 74 65 72 6c 6f 6f 70 20 23 . (outerloop #
de60: 66 20 73 74 6d 74 73 29 29 29 0a 0a 09 20 20 20 f stmts)))...
de70: 20 20 3b 3b 20 68 61 6e 64 6c 65 20 6e 6f 72 6d ;; handle norm
de80: 61 6c 20 71 75 65 72 69 65 73 0a 09 20 20 20 20 al queries..
de90: 20 28 6c 65 74 20 28 28 72 65 6d 20 28 73 71 6c (let ((rem (sql
dea0: 69 74 65 33 3a 77 69 74 68 2d 74 72 61 6e 73 61 ite3:with-transa
deb0: 63 74 69 6f 6e 20 0a 09 09 09 20 64 62 0a 09 09 ction .... db...
dec0: 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 . (lambda ()....
ded0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
dee0: 69 6e 66 6f 20 31 31 20 22 66 6c 75 73 68 69 6e info 11 "flushin
def0: 67 20 22 20 73 74 6d 74 73 20 22 20 74 6f 20 64 g " stmts " to d
df00: 62 22 29 0a 09 09 09 20 20 20 28 69 66 20 28 6e b").... (if (n
df10: 75 6c 6c 3f 20 73 74 6d 74 73 29 0a 09 09 09 20 ull? stmts)....
df20: 20 20 20 20 20 20 73 74 6d 74 73 0a 09 09 09 20 stmts....
df30: 20 20 20 20 20 20 28 6c 65 74 20 69 6e 6e 65 72 (let inner
df40: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
df50: 73 74 6d 74 73 29 29 0a 09 09 09 09 09 20 20 20 stmts))......
df60: 20 20 20 20 28 74 61 6c 20 28 63 64 72 20 73 74 (tal (cdr st
df70: 6d 74 73 29 29 29 0a 09 09 09 09 20 28 6c 65 74 mts)))..... (let
df80: 20 28 28 70 61 72 61 6d 73 20 20 20 28 76 65 63 ((params (vec
df90: 74 6f 72 2d 72 65 66 20 68 65 64 20 32 29 29 0a tor-ref hed 2)).
dfa0: 09 09 09 09 20 20 20 20 20 20 20 28 73 74 6d 74 .... (stmt
dfb0: 2d 6b 65 79 20 28 76 65 63 74 6f 72 2d 72 65 66 -key (vector-ref
dfc0: 20 68 65 64 20 30 29 29 29 0a 09 09 09 09 20 20 hed 0))).....
dfd0: 20 28 69 66 20 28 6f 72 20 28 70 72 6f 63 65 64 (if (or (proced
dfe0: 75 72 65 3f 20 73 74 6d 74 2d 6b 65 79 29 0a 09 ure? stmt-key)..
dff0: 09 09 09 09 20 20 20 28 6d 65 6d 62 65 72 20 73 .... (member s
e000: 74 6d 74 2d 6b 65 79 20 64 62 3a 73 70 65 63 69 tmt-key db:speci
e010: 61 6c 2d 71 75 65 72 69 65 73 29 29 0a 09 09 09 al-queries))....
e020: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
e030: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
e040: 74 2d 69 6e 66 6f 20 31 31 20 22 48 61 6e 64 6c t-info 11 "Handl
e050: 69 6e 67 20 73 70 65 63 69 61 6c 20 73 74 61 74 ing special stat
e060: 65 6d 65 6e 74 20 22 20 73 74 6d 74 2d 6b 65 79 ement " stmt-key
e070: 29 0a 09 09 09 09 09 20 28 63 6f 6e 73 20 68 65 )...... (cons he
e080: 64 20 74 61 6c 29 29 0a 09 09 09 09 20 20 20 20 d tal)).....
e090: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 (begin......
e0a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
e0b0: 6f 20 31 31 20 22 45 78 65 63 75 74 69 6e 67 20 o 11 "Executing
e0c0: 22 20 73 74 6d 74 2d 6b 65 79 20 22 20 66 6f 72 " stmt-key " for
e0d0: 20 22 20 70 61 72 61 6d 73 29 0a 09 09 09 09 09 " params)......
e0e0: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
e0f0: 65 78 65 63 75 74 65 20 28 68 61 73 68 2d 74 61 execute (hash-ta
e100: 62 6c 65 2d 72 65 66 20 71 75 65 72 69 65 73 20 ble-ref queries
e110: 73 74 6d 74 2d 6b 65 79 29 20 70 61 72 61 6d 73 stmt-key) params
e120: 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e 6f 74 )...... (if (not
e130: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 (null? tal))...
e140: 09 09 09 20 20 20 20 20 28 69 6e 6e 65 72 6c 6f ... (innerlo
e150: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
e160: 20 74 61 6c 29 29 0a 09 09 09 09 09 20 20 20 20 tal))......
e170: 20 27 28 29 29 29 0a 09 09 09 09 20 20 20 20 20 '())).....
e180: 20 20 29 29 29 29 29 29 29 29 0a 09 20 20 20 20 ))))))))..
e190: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul
e1a0: 6c 3f 20 72 65 6d 29 29 0a 09 09 20 20 20 28 6f l? rem))... (o
e1b0: 75 74 65 72 6c 6f 6f 70 20 28 63 61 72 20 72 65 uterloop (car re
e1c0: 6d 29 28 63 64 72 20 72 65 6d 29 29 29 29 29 29 m)(cdr rem))))))
e1d0: 0a 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 . (for-eac
e1e0: 68 20 28 6c 61 6d 62 64 61 20 28 73 74 6d 74 2d h (lambda (stmt-
e1f0: 6b 65 79 29 0a 09 09 20 20 20 28 73 71 6c 69 74 key)... (sqlit
e200: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 28 68 61 e3:finalize! (ha
e210: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 71 75 65 sh-table-ref que
e220: 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 29 29 29 ries stmt-key)))
e230: 0a 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ... (hash-table-
e240: 6b 65 79 73 20 71 75 65 72 69 65 73 29 29 0a 20 keys queries)).
e250: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 61 63 (let ((cac
e260: 68 65 2d 73 69 7a 65 20 28 6c 65 6e 67 74 68 20 he-size (length
e270: 64 61 74 61 29 29 29 0a 09 20 28 69 66 20 28 3e data))).. (if (>
e280: 20 63 61 63 68 65 2d 73 69 7a 65 20 2a 6d 61 78 cache-size *max
e290: 2d 63 61 63 68 65 2d 73 69 7a 65 2a 29 0a 09 20 -cache-size*)..
e2a0: 20 20 20 20 28 73 65 74 21 20 2a 6d 61 78 2d 63 (set! *max-c
e2b0: 61 63 68 65 2d 73 69 7a 65 2a 20 63 61 63 68 65 ache-size* cache
e2c0: 2d 73 69 7a 65 29 29 29 0a 20 20 20 20 20 20 20 -size))).
e2d0: 29 29 0a 20 20 20 23 66 29 29 0a 0a 28 64 65 66 )). #f))..(def
e2e0: 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ine (db:test-get
e2f0: 2d 72 65 63 6f 72 64 73 2d 66 6f 72 2d 69 6e 64 -records-for-ind
e300: 65 78 2d 66 69 6c 65 20 64 62 20 72 75 6e 2d 69 ex-file db run-i
e310: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
e320: 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a let ((res '())).
e330: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
e340: 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 -each-row .
e350: 28 6c 61 6d 62 64 61 20 28 69 64 20 69 74 65 6d (lambda (id item
e360: 70 61 74 68 20 73 74 61 74 65 20 73 74 61 74 75 path state statu
e370: 73 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 6c s run_duration l
e380: 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 ogf comment).
e390: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
e3a0: 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 20 69 ons (vector id i
e3b0: 74 65 6d 70 61 74 68 20 73 74 61 74 65 20 73 74 tempath state st
e3c0: 61 74 75 73 20 72 75 6e 5f 64 75 72 61 74 69 6f atus run_duratio
e3d0: 6e 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 20 n logf comment)
e3e0: 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 0a 20 res))). db.
e3f0: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 69 "SELECT id,i
e400: 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 tem_path,state,s
e410: 74 61 74 75 73 2c 72 75 6e 5f 64 75 72 61 74 69 tatus,run_durati
e420: 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f on,final_logf,co
e430: 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 mment FROM tests
e440: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
e450: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
e460: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
e470: 27 27 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 '';". run-id
e480: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 test-name).
e490: 72 65 73 29 29 0a 0a 3b 3b 20 52 6f 6c 6c 75 70 res))..;; Rollup
e4a0: 20 74 68 65 20 70 61 73 73 2f 66 61 69 6c 20 63 the pass/fail c
e4b0: 6f 75 6e 74 73 20 66 72 6f 6d 20 69 74 65 6d 69 ounts from itemi
e4c0: 7a 65 64 20 74 65 73 74 73 20 69 6e 74 6f 20 66 zed tests into f
e4d0: 61 69 6c 5f 63 6f 75 6e 74 20 61 6e 64 20 70 61 ail_count and pa
e4e0: 73 73 5f 63 6f 75 6e 74 0a 28 64 65 66 69 6e 65 ss_count.(define
e4f0: 20 28 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 (db:roll-up-pas
e500: 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 64 62 s-fail-counts db
e510: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
e520: 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 e item-path stat
e530: 75 73 29 0a 20 20 3b 3b 20 28 63 64 62 3a 66 6c us). ;; (cdb:fl
e540: 75 73 68 2d 71 75 65 75 65 20 2a 72 75 6e 72 65 ush-queue *runre
e550: 6d 6f 74 65 2a 29 0a 20 20 28 69 66 20 28 61 6e mote*). (if (an
e560: 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 d (not (equal? i
e570: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 20 tem-path ""))..
e580: 20 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 73 74 (or (equal? st
e590: 61 74 75 73 20 22 50 41 53 53 22 29 0a 09 20 20 atus "PASS")..
e5a0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 (equal? sta
e5b0: 74 75 73 20 22 57 41 52 4e 22 29 0a 09 20 20 20 tus "WARN")..
e5c0: 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (equal? stat
e5d0: 75 73 20 22 46 41 49 4c 22 29 0a 09 20 20 20 20 us "FAIL")..
e5e0: 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 (equal? statu
e5f0: 73 20 22 57 41 49 56 45 44 22 29 0a 09 20 20 20 s "WAIVED")..
e600: 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (equal? stat
e610: 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 29 29 0a us "RUNNING"))).
e620: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 73 (begin..(s
e630: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a qlite3:execute .
e640: 09 20 64 62 0a 09 20 22 55 50 44 41 54 45 20 74 . db.. "UPDATE t
e650: 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 20 20 ests .
e660: 20 20 20 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e SET fail_coun
e670: 74 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 t=(SELECT count(
e680: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 id) FROM tests W
e690: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
e6a0: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
e6b0: 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 item_path != ''
e6c0: 20 41 4e 44 20 73 74 61 74 75 73 3d 27 46 41 49 AND status='FAI
e6d0: 4c 27 29 2c 0a 20 20 20 20 20 20 20 20 20 20 20 L'),.
e6e0: 20 20 20 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 pass_count
e6f0: 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 =(SELECT count(i
e700: 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 d) FROM tests WH
e710: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
e720: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
e730: 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 item_path != ''
e740: 41 4e 44 20 28 73 74 61 74 75 73 3d 27 50 41 53 AND (status='PAS
e750: 53 27 20 4f 52 20 73 74 61 74 75 73 3d 27 57 41 S' OR status='WA
e760: 52 4e 27 20 4f 52 20 73 74 61 74 75 73 3d 27 57 RN' OR status='W
e770: 41 49 56 45 44 27 29 29 0a 20 20 20 20 20 20 20 AIVED')).
e780: 20 20 20 20 20 20 57 48 45 52 45 20 72 75 6e 5f WHERE run_
e790: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
e7a0: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
e7b0: 68 3d 27 27 3b 22 0a 09 20 72 75 6e 2d 69 64 20 h='';".. run-id
e7c0: 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 test-name run-id
e7d0: 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 test-name run-i
e7e0: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 d test-name).
e7f0: 20 20 20 20 20 3b 3b 20 28 74 68 72 65 61 64 2d ;; (thread-
e800: 73 6c 65 65 70 21 20 30 2e 31 29 20 3b 3b 20 67 sleep! 0.1) ;; g
e810: 69 76 65 20 6f 74 68 65 72 20 70 72 6f 63 65 73 ive other proces
e820: 73 65 73 20 61 20 63 68 61 6e 63 65 20 68 65 72 ses a chance her
e830: 65 2c 20 6e 6f 2c 20 62 65 74 74 65 72 20 74 6f e, no, better to
e840: 20 62 65 20 64 6f 6e 65 20 41 53 41 50 3f 0a 09 be done ASAP?..
e850: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
e860: 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b 3b us "RUNNING") ;;
e870: 20 72 75 6e 6e 69 6e 67 20 74 61 6b 65 73 20 70 running takes p
e880: 72 69 6f 72 69 74 79 20 6f 76 65 72 20 61 6c 6c riority over all
e890: 20 6f 74 68 65 72 20 73 74 61 74 65 73 2c 20 66 other states, f
e8a0: 6f 72 63 65 20 74 68 65 20 74 65 73 74 20 73 74 orce the test st
e8b0: 61 74 65 20 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 ate to RUNNING..
e8c0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
e8d0: 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 cute db "UPDATE
e8e0: 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d tests SET state=
e8f0: 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f ? WHERE run_id=?
e900: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
e910: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
e920: 3b 22 20 22 52 55 4e 4e 49 4e 47 22 20 72 75 6e ;" "RUNNING" run
e930: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 -id test-name)..
e940: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
e950: 63 75 74 65 0a 09 20 20 20 20 20 64 62 0a 09 20 cute.. db..
e960: 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 "UPDATE test
e970: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
e980: 20 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 SET sta
e990: 74 65 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 te=CASE WHEN (SE
e9a0: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
e9b0: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
e9c0: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
e9d0: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
e9e0: 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 20 _path != '' AND
e9f0: 73 74 61 74 65 20 69 6e 20 28 27 52 55 4e 4e 49 state in ('RUNNI
ea00: 4e 47 27 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 NG','NOT_STARTED
ea10: 27 29 29 20 3e 20 30 20 54 48 45 4e 20 0a 20 20 ')) > 0 THEN .
ea20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea30: 20 20 20 20 20 20 20 20 27 52 55 4e 4e 49 4e 47 'RUNNING
ea40: 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 '.
ea50: 20 20 20 20 20 20 20 20 20 45 4c 53 45 20 27 43 ELSE 'C
ea60: 4f 4d 50 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 OMPLETED' END,.
ea70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea80: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 3d status=
ea90: 43 41 53 45 20 57 48 45 4e 20 66 61 69 6c 5f 63 CASE WHEN fail_c
eaa0: 6f 75 6e 74 20 3e 20 30 20 54 48 45 4e 20 27 46 ount > 0 THEN 'F
eab0: 41 49 4c 27 20 57 48 45 4e 20 70 61 73 73 5f 63 AIL' WHEN pass_c
eac0: 6f 75 6e 74 20 3e 20 30 20 41 4e 44 20 66 61 69 ount > 0 AND fai
ead0: 6c 5f 63 6f 75 6e 74 3d 30 20 54 48 45 4e 20 27 l_count=0 THEN '
eae0: 50 41 53 53 27 20 45 4c 53 45 20 27 55 4e 4b 4e PASS' ELSE 'UNKN
eaf0: 4f 57 4e 27 20 45 4e 44 0a 20 20 20 20 20 20 20 OWN' END.
eb00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eb10: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
eb20: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
eb30: 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 D item_path='';"
eb40: 0a 09 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 .. run-id te
eb50: 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 st-name run-id t
eb60: 65 73 74 2d 6e 61 6d 65 29 29 0a 09 23 66 29 0a est-name))..#f).
eb70: 20 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d #f))..;;==
eb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebc0: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 73 20 6d 65 ====.;; Tests me
ebd0: 74 61 20 64 61 74 61 0a 3b 3b 3d 3d 3d 3d 3d 3d ta data.;;======
ebe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec20: 0a 0a 3b 3b 20 72 65 61 64 20 74 68 65 20 72 65 ..;; read the re
ec30: 63 6f 72 64 20 67 69 76 65 6e 20 61 20 74 65 73 cord given a tes
ec40: 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 tname.(define (d
ec50: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 b:testmeta-get-r
ec60: 65 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d ecord db testnam
ec70: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 e). (let ((res
ec80: 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 #f)). (sqlite
ec90: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
eca0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
ecb0: 74 65 73 74 6e 61 6d 65 20 61 75 74 68 6f 72 20 testname author
ecc0: 6f 77 6e 65 72 20 64 65 73 63 72 69 70 74 69 6f owner descriptio
ecd0: 6e 20 72 65 76 69 65 77 65 64 20 69 74 65 72 61 n reviewed itera
ece0: 74 65 64 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 ted avg_runtime
ecf0: 61 76 67 5f 64 69 73 6b 20 74 61 67 73 29 0a 20 avg_disk tags).
ed00: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
ed10: 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74 6e (vector id testn
ed20: 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 ame author owner
ed30: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 description rev
ed40: 69 65 77 65 64 20 69 74 65 72 61 74 65 64 20 61 iewed iterated a
ed50: 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 vg_runtime avg_d
ed60: 69 73 6b 20 74 61 67 73 29 29 29 0a 20 20 20 20 isk tags))).
ed70: 20 64 62 20 22 53 45 4c 45 43 54 20 69 64 2c 74 db "SELECT id,t
ed80: 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f 72 2c 6f estname,author,o
ed90: 77 6e 65 72 2c 64 65 73 63 72 69 70 74 69 6f 6e wner,description
eda0: 2c 72 65 76 69 65 77 65 64 2c 69 74 65 72 61 74 ,reviewed,iterat
edb0: 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d 65 2c 61 ed,avg_runtime,a
edc0: 76 67 5f 64 69 73 6b 2c 74 61 67 73 20 46 52 4f vg_disk,tags FRO
edd0: 4d 20 74 65 73 74 5f 6d 65 74 61 20 57 48 45 52 M test_meta WHER
ede0: 45 20 74 65 73 74 6e 61 6d 65 3d 3f 3b 22 0a 20 E testname=?;".
edf0: 20 20 20 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 testname).
ee00: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 63 72 65 61 res))..;; crea
ee10: 74 65 20 61 20 6e 65 77 20 72 65 63 6f 72 64 20 te a new record
ee20: 66 6f 72 20 61 20 67 69 76 65 6e 20 74 65 73 74 for a given test
ee30: 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 62 name.(define (db
ee40: 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 :testmeta-add-re
ee50: 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d 65 cord db testname
ee60: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
ee70: 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 cute db "INSERT
ee80: 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 74 OR IGNORE INTO t
ee90: 65 73 74 5f 6d 65 74 61 20 28 74 65 73 74 6e 61 est_meta (testna
eea0: 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c me,author,owner,
eeb0: 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 description,revi
eec0: 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 ewed,iterated,av
eed0: 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 g_runtime,avg_di
eee0: 73 6b 2c 74 61 67 73 29 20 56 41 4c 55 45 53 20 sk,tags) VALUES
eef0: 28 3f 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 (?,'','','','','
ef00: 27 2c 27 27 2c 27 27 2c 27 27 29 3b 22 20 74 65 ','','','');" te
ef10: 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b 20 75 70 64 stname))..;; upd
ef20: 61 74 65 20 6f 6e 65 20 6f 66 20 74 68 65 20 74 ate one of the t
ef30: 65 73 74 6d 65 74 61 20 66 69 65 6c 64 73 0a 28 estmeta fields.(
ef40: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d define (db:testm
ef50: 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 eta-update-field
ef60: 20 64 62 20 74 65 73 74 6e 61 6d 65 20 66 69 65 db testname fie
ef70: 6c 64 20 76 61 6c 75 65 29 0a 20 20 28 73 71 6c ld value). (sql
ef80: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
ef90: 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 (conc "UPDATE te
efa0: 73 74 5f 6d 65 74 61 20 53 45 54 20 22 20 66 69 st_meta SET " fi
efb0: 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 74 65 eld "=? WHERE te
efc0: 73 74 6e 61 6d 65 3d 3f 3b 22 29 20 76 61 6c 75 stname=?;") valu
efd0: 65 20 74 65 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b e testname))..;;
efe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f020: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 ======.;; T E S
f030: 54 20 20 20 44 20 41 20 54 20 41 20 0a 3b 3b 3d T D A T A .;;=
f040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f080: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
f090: 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 db:csv->test-dat
f0a0: 61 20 64 62 20 74 65 73 74 2d 69 64 20 63 73 76 a db test-id csv
f0b0: 64 61 74 61 29 0a 20 20 28 64 65 62 75 67 3a 70 data). (debug:p
f0c0: 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 64 20 rint 4 "test-id
f0d0: 22 20 74 65 73 74 2d 69 64 20 22 2c 20 63 73 76 " test-id ", csv
f0e0: 64 61 74 61 3a 20 22 20 63 73 76 64 61 74 61 29 data: " csvdata)
f0f0: 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 20 20 . (let ((tdb
f100: 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d (db:open-test-
f110: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
f120: 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 test-id))).
f130: 28 69 66 20 74 64 62 0a 09 28 6c 65 74 20 28 28 (if tdb..(let ((
f140: 63 73 76 6c 69 73 74 20 28 63 73 76 2d 3e 6c 69 csvlist (csv->li
f150: 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d 72 65 61 st (make-csv-rea
f160: 64 65 72 0a 09 09 09 09 20 20 20 28 6f 70 65 6e der..... (open
f170: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 63 73 -input-string cs
f180: 76 64 61 74 61 29 0a 09 09 09 09 20 20 20 27 28 vdata)..... '(
f190: 28 73 74 72 69 70 2d 6c 65 61 64 69 6e 67 2d 77 (strip-leading-w
f1a0: 68 69 74 65 73 70 61 63 65 3f 20 23 74 29 0a 09 hitespace? #t)..
f1b0: 09 09 09 20 20 20 20 20 28 73 74 72 69 70 2d 74 ... (strip-t
f1c0: 72 61 69 6c 69 6e 67 2d 77 68 69 74 65 73 70 61 railing-whitespa
f1d0: 63 65 3f 20 23 74 29 29 20 29 29 29 29 20 3b 3b ce? #t)) )))) ;;
f1e0: 20 28 63 73 76 2d 3e 6c 69 73 74 20 63 73 76 64 (csv->list csvd
f1f0: 61 74 61 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 ata))).. (for-e
f200: 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 ach .. (lambda
f210: 20 28 63 73 76 72 6f 77 29 0a 09 20 20 20 20 20 (csvrow)..
f220: 28 6c 65 74 2a 20 28 28 70 61 64 64 65 64 2d 72 (let* ((padded-r
f230: 6f 77 20 20 28 74 61 6b 65 20 28 61 70 70 65 6e ow (take (appen
f240: 64 20 63 73 76 72 6f 77 20 28 6c 69 73 74 20 23 d csvrow (list #
f250: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
f260: 20 23 66 20 23 66 20 23 66 29 29 20 39 29 29 0a #f #f #f)) 9)).
f270: 09 09 20 20 20 20 28 63 61 74 65 67 6f 72 79 20 .. (category
f280: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 (list-ref pad
f290: 64 65 64 2d 72 6f 77 20 30 29 29 0a 09 09 20 20 ded-row 0))...
f2a0: 20 20 28 76 61 72 69 61 62 6c 65 20 20 20 20 28 (variable (
f2b0: 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
f2c0: 72 6f 77 20 31 29 29 0a 09 09 20 20 20 20 28 76 row 1))... (v
f2d0: 61 6c 75 65 20 20 20 20 20 20 20 28 61 6e 79 2d alue (any-
f2e0: 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69 >number-if-possi
f2f0: 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61 ble (list-ref pa
f300: 64 64 65 64 2d 72 6f 77 20 32 29 29 29 0a 09 09 dded-row 2)))...
f310: 20 20 20 20 28 65 78 70 65 63 74 65 64 20 20 20 (expected
f320: 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 (any->number-if
f330: 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 74 2d -possible (list-
f340: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 33 ref padded-row 3
f350: 29 29 29 0a 09 09 20 20 20 20 28 74 6f 6c 20 20 )))... (tol
f360: 20 20 20 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d (any->num
f370: 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 ber-if-possible
f380: 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 (list-ref padded
f390: 2d 72 6f 77 20 34 29 29 29 20 3b 3b 20 3e 2c 20 -row 4))) ;; >,
f3a0: 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 6f 72 20 61 20 <, >=, <=, or a
f3b0: 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 75 6e number... (un
f3c0: 69 74 73 20 20 20 20 20 20 20 28 6c 69 73 74 2d its (list-
f3d0: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 35 ref padded-row 5
f3e0: 29 29 0a 09 09 20 20 20 20 28 63 6f 6d 6d 65 6e ))... (commen
f3f0: 74 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 t (list-ref
f400: 70 61 64 64 65 64 2d 72 6f 77 20 36 29 29 0a 09 padded-row 6))..
f410: 09 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 . (status
f420: 20 20 28 6c 65 74 20 28 28 73 20 28 6c 69 73 74 (let ((s (list
f430: 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 -ref padded-row
f440: 37 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 7)))..... (if
f450: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 29 (and (string? s)
f460: 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (or (string-matc
f470: 68 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a h (regexp "^\\s*
f480: 24 22 29 20 73 29 0a 09 09 09 09 09 09 09 20 20 $") s)........
f490: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match (
f4a0: 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 22 29 20 regexp "^n/a$")
f4b0: 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 s))).....
f4c0: 23 66 0a 09 09 09 09 20 20 20 20 20 20 20 73 29 #f..... s)
f4d0: 29 29 20 3b 3b 20 69 66 20 73 70 65 63 69 66 69 )) ;; if specifi
f4e0: 65 64 20 6f 6e 20 74 68 65 20 69 6e 70 75 74 20 ed on the input
f4f0: 74 68 65 6e 20 75 73 65 2c 20 65 6c 73 65 20 63 then use, else c
f500: 61 6c 63 75 6c 61 74 65 0a 09 09 20 20 20 20 28 alculate... (
f510: 74 79 70 65 20 20 20 20 20 20 20 20 28 6c 69 73 type (lis
f520: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
f530: 20 38 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 8))).. ;;
f540: 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 63 74 65 look up expecte
f550: 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 72 6f 6d d,tol,units from
f560: 20 70 72 65 76 69 6f 75 73 20 62 65 73 74 20 66 previous best f
f570: 69 74 20 74 65 73 74 20 69 66 20 74 68 65 79 20 it test if they
f580: 61 72 65 20 61 6c 6c 20 65 69 74 68 65 72 20 23 are all either #
f590: 66 20 6f 72 20 27 27 0a 09 20 20 20 20 20 20 20 f or ''..
f5a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
f5b0: 42 45 46 4f 52 45 3a 20 63 61 74 65 67 6f 72 79 BEFORE: category
f5c0: 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 76 : " category " v
f5d0: 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 61 ariable: " varia
f5e0: 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 76 ble " value: " v
f5f0: 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c 20 alue .... ",
f600: 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 65 expected: " expe
f610: 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 6f cted " tol: " to
f620: 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e 69 l " units: " uni
f630: 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 73 ts " status: " s
f640: 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 3a tatus " comment:
f650: 20 22 20 63 6f 6d 6d 65 6e 74 20 22 20 74 79 70 " comment " typ
f660: 65 3a 20 22 20 74 79 70 65 29 0a 0a 09 20 20 20 e: " type)...
f670: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6f 72 (if (and (or
f680: 20 28 6e 6f 74 20 65 78 70 65 63 74 65 64 29 28 (not expected)(
f690: 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 equal? expected
f6a0: 22 22 29 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 ""))....(or (not
f6b0: 20 74 6f 6c 29 20 20 20 20 20 28 65 71 75 61 6c tol) (equal
f6c0: 3f 20 65 78 70 65 63 74 65 64 20 22 22 29 29 0a ? expected "")).
f6d0: 09 09 09 28 6f 72 20 28 6e 6f 74 20 75 6e 69 74 ...(or (not unit
f6e0: 73 29 20 20 20 28 65 71 75 61 6c 3f 20 65 78 70 s) (equal? exp
f6f0: 65 63 74 65 64 20 22 22 29 29 29 0a 09 09 20 20 ected "")))...
f700: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
f710: 6e 65 77 2d 65 78 70 65 63 74 65 64 20 6e 65 77 new-expected new
f720: 2d 74 6f 6c 20 6e 65 77 2d 75 6e 69 74 73 29 28 -tol new-units)(
f730: 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c 2d db:get-prev-tol-
f740: 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 for-test db test
f750: 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 -id category var
f760: 69 61 62 6c 65 29 29 29 0a 09 09 09 20 20 20 20 iable)))....
f770: 20 20 20 28 73 65 74 21 20 65 78 70 65 63 74 65 (set! expecte
f780: 64 20 6e 65 77 2d 65 78 70 65 63 74 65 64 29 0a d new-expected).
f790: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
f7a0: 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d 74 6f 6c tol new-tol
f7b0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
f7c0: 21 20 75 6e 69 74 73 20 20 20 20 6e 65 77 2d 75 ! units new-u
f7d0: 6e 69 74 73 29 29 29 0a 0a 09 20 20 20 20 20 20 nits)))...
f7e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
f7f0: 22 41 46 54 45 52 3a 20 20 63 61 74 65 67 6f 72 "AFTER: categor
f800: 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 y: " category "
f810: 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 variable: " vari
f820: 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 able " value: "
f830: 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c value .... ",
f840: 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 expected: " exp
f850: 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 ected " tol: " t
f860: 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e ol " units: " un
f870: 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 its " status: "
f880: 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 status " comment
f890: 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 : " comment)..
f8a0: 20 20 20 20 20 3b 3b 20 63 61 6c 63 75 6c 61 74 ;; calculat
f8b0: 65 20 73 74 61 74 75 73 20 69 66 20 4e 4f 54 20 e status if NOT
f8c0: 73 70 65 63 69 66 69 65 64 0a 09 20 20 20 20 20 specified..
f8d0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
f8e0: 73 74 61 74 75 73 29 28 6e 75 6d 62 65 72 3f 20 status)(number?
f8f0: 65 78 70 65 63 74 65 64 29 28 6e 75 6d 62 65 72 expected)(number
f900: 3f 20 76 61 6c 75 65 29 29 20 3b 3b 20 6e 65 65 ? value)) ;; nee
f910: 64 20 65 78 70 65 63 74 65 64 20 61 6e 64 20 76 d expected and v
f920: 61 6c 75 65 20 74 6f 20 62 65 20 6e 75 6d 62 65 alue to be numbe
f930: 72 73 0a 09 09 20 20 20 28 69 66 20 28 6e 75 6d rs... (if (num
f940: 62 65 72 3f 20 74 6f 6c 29 20 3b 3b 20 69 66 20 ber? tol) ;; if
f950: 74 6f 6c 20 69 73 20 61 20 6e 75 6d 62 65 72 20 tol is a number
f960: 74 68 65 6e 20 77 65 20 64 6f 20 74 68 65 20 73 then we do the s
f970: 74 61 6e 64 61 72 64 20 63 6f 6d 70 61 72 69 73 tandard comparis
f980: 6f 6e 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 on... (let
f990: 2a 20 28 28 6d 61 78 2d 76 61 6c 20 28 2b 20 65 * ((max-val (+ e
f9a0: 78 70 65 63 74 65 64 20 74 6f 6c 29 29 0a 09 09 xpected tol))...
f9b0: 09 20 20 20 20 20 20 28 6d 69 6e 2d 76 61 6c 20 . (min-val
f9c0: 28 2d 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 (- expected tol)
f9d0: 29 0a 09 09 09 20 20 20 20 20 20 28 72 65 73 75 ).... (resu
f9e0: 6c 74 20 20 28 61 6e 64 20 28 3e 3d 20 20 76 61 lt (and (>= va
f9f0: 6c 75 65 20 6d 69 6e 2d 76 61 6c 29 28 3c 3d 20 lue min-val)(<=
fa00: 76 61 6c 75 65 20 6d 61 78 2d 76 61 6c 29 29 29 value max-val)))
fa10: 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 ).... (debug:pri
fa20: 6e 74 20 34 20 22 6d 61 78 2d 76 61 6c 3a 20 22 nt 4 "max-val: "
fa30: 20 6d 61 78 2d 76 61 6c 20 22 20 6d 69 6e 2d 76 max-val " min-v
fa40: 61 6c 3a 20 22 20 6d 69 6e 2d 76 61 6c 20 22 20 al: " min-val "
fa50: 72 65 73 75 6c 74 3a 20 22 20 72 65 73 75 6c 74 result: " result
fa60: 29 0a 09 09 09 20 28 73 65 74 21 20 73 74 61 74 ).... (set! stat
fa70: 75 73 20 28 69 66 20 72 65 73 75 6c 74 20 22 70 us (if result "p
fa80: 61 73 73 22 20 22 66 61 69 6c 22 29 29 29 0a 09 ass" "fail")))..
fa90: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 73 74 . (set! st
faa0: 61 74 75 73 20 3b 3b 20 4e 42 2f 2f 20 6e 65 65 atus ;; NB// nee
fab0: 64 20 74 6f 20 61 73 73 65 73 73 20 65 61 63 68 d to assess each
fac0: 20 6f 6e 65 20 28 69 2e 65 2e 20 6e 6f 74 20 72 one (i.e. not r
fad0: 65 74 75 72 6e 20 6f 70 65 72 61 74 6f 72 20 73 eturn operator s
fae0: 69 6e 63 65 20 6e 65 65 64 20 74 6f 20 61 63 74 ince need to act
faf0: 20 69 66 20 6e 6f 74 20 76 61 6c 69 64 20 6f 70 if not valid op
fb00: 2e 0a 09 09 09 20 20 20 20 20 28 63 61 73 65 20 ..... (case
fb10: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
fb20: 74 6f 6c 29 20 3b 3b 20 74 6f 6c 20 73 68 6f 75 tol) ;; tol shou
fb30: 6c 64 20 62 65 20 3e 2c 20 3c 2c 20 3e 3d 2c 20 ld be >, <, >=,
fb40: 3c 3d 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e <=.... ((>
fb50: 29 20 20 28 69 66 20 28 3e 20 20 76 61 6c 75 65 ) (if (> value
fb60: 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
fb70: 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
fb80: 20 20 20 20 20 28 28 3c 29 20 20 28 69 66 20 28 ((<) (if (
fb90: 3c 20 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 < value expecte
fba0: 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
fbb0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e )).... ((>
fbc0: 3d 29 20 28 69 66 20 28 3e 3d 20 76 61 6c 75 65 =) (if (>= value
fbd0: 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
fbe0: 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
fbf0: 20 20 20 20 20 28 28 3c 3d 29 20 28 69 66 20 28 ((<=) (if (
fc00: 3c 3d 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 <= value expecte
fc10: 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
fc20: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 65 6c )).... (el
fc30: 73 65 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a se (conc "ERROR:
fc40: 20 62 61 64 20 74 6f 6c 20 63 6f 6d 70 61 72 61 bad tol compara
fc50: 74 6f 72 20 22 20 74 6f 6c 29 29 29 29 29 29 0a tor " tol)))))).
fc60: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
fc70: 72 69 6e 74 20 34 20 22 41 46 54 45 52 32 3a 20 rint 4 "AFTER2:
fc80: 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 category: " cate
fc90: 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c 65 3a gory " variable:
fca0: 20 22 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 " variable " va
fcb0: 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 lue: " value ...
fcc0: 09 20 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 . ", expected
fcd0: 3a 20 22 20 65 78 70 65 63 74 65 64 20 22 20 74 : " expected " t
fce0: 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 ol: " tol " unit
fcf0: 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73 74 61 s: " units " sta
fd00: 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 tus: " status "
fd10: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
fd20: 6e 74 29 0a 09 20 20 20 20 20 20 20 28 73 71 6c nt).. (sql
fd30: 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 ite3:execute tdb
fd40: 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
fd50: 41 43 45 20 49 4e 54 4f 20 74 65 73 74 5f 64 61 ACE INTO test_da
fd60: 74 61 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 ta (test_id,cate
fd70: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
fd80: 6c 75 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c lue,expected,tol
fd90: 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 ,units,comment,s
fda0: 74 61 74 75 73 2c 74 79 70 65 29 20 56 41 4c 55 tatus,type) VALU
fdb0: 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ES (?,?,?,?,?,?,
fdc0: 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 74 ?,?,?,?);".....t
fdd0: 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 est-id category
fde0: 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 variable value e
fdf0: 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 xpected tol unit
fe00: 73 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f s (if comment co
fe10: 6d 6d 65 6e 74 20 22 22 29 20 73 74 61 74 75 73 mment "") status
fe20: 20 74 79 70 65 29 0a 09 20 20 20 20 20 20 20 28 type).. (
fe30: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
fe40: 21 20 74 64 62 29 29 29 0a 09 20 20 20 63 73 76 ! tdb))).. csv
fe50: 6c 69 73 74 29 29 29 29 29 0a 0a 3b 3b 20 67 65 list)))))..;; ge
fe60: 74 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 t a list of test
fe70: 5f 64 61 74 61 20 72 65 63 6f 72 64 73 20 6d 61 _data records ma
fe80: 74 63 68 69 6e 67 20 63 61 74 65 67 6f 72 79 70 tching categoryp
fe90: 61 74 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a att.(define (db:
fea0: 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 read-test-data d
feb0: 62 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f b test-id catego
fec0: 72 79 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 rypatt). (let (
fed0: 28 74 64 62 20 20 28 64 62 3a 6f 70 65 6e 2d 74 (tdb (db:open-t
fee0: 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
fef0: 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a d db test-id))).
ff00: 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 6c 65 (if tdb..(le
ff10: 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 20 t ((res '()))..
ff20: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
ff30: 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c 61 6d ch-row .. (lam
ff40: 62 64 61 20 28 69 64 20 74 65 73 74 5f 69 64 20 bda (id test_id
ff50: 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c category variabl
ff60: 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 e value expected
ff70: 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f 6d 6d 65 tol units comme
ff80: 6e 74 20 73 74 61 74 75 73 20 74 79 70 65 29 0a nt status type).
ff90: 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 . (set! res
ffa0: 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 (cons (vector id
ffb0: 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f 72 test_id categor
ffc0: 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
ffd0: 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e expected tol un
ffe0: 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61 74 its comment stat
fff0: 75 73 20 74 79 70 65 29 20 72 65 73 29 29 29 0a us type) res))).
10000 09 20 20 20 74 64 62 0a 09 20 20 20 22 53 45 4c . tdb.. "SEL
10010 45 43 54 20 69 64 2c 74 65 73 74 5f 69 64 2c 63 ECT id,test_id,c
10020 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 ategory,variable
10030 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 2c ,value,expected,
10040 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e tol,units,commen
10050 74 2c 73 74 61 74 75 73 2c 74 79 70 65 20 46 52 t,status,type FR
10060 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 OM test_data WHE
10070 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 RE test_id=? AND
10080 20 63 61 74 65 67 6f 72 79 20 4c 49 4b 45 20 3f category LIKE ?
10090 20 4f 52 44 45 52 20 42 59 20 63 61 74 65 67 6f ORDER BY catego
100a0 72 79 2c 76 61 72 69 61 62 6c 65 3b 22 20 74 65 ry,variable;" te
100b0 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 st-id categorypa
100c0 74 74 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a tt).. (sqlite3:
100d0 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
100e0 20 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 (reverse res))
100f0 0a 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e ..'())))..(defin
10100 65 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d e (db:load-test-
10110 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 29 data db test-id)
10120 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c . (let loop ((l
10130 69 6e 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 in (read-line)))
10140 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
10150 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 69 6e 29 29 of-object? lin))
10160 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
10170 75 67 3a 70 72 69 6e 74 20 34 20 6c 69 6e 29 0a ug:print 4 lin).
10180 09 20 20 28 64 62 3a 63 73 76 2d 3e 74 65 73 74 . (db:csv->test
10190 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 -data db test-id
101a0 20 6c 69 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 28 lin).. (loop (
101b0 72 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 0a 20 read-line))))).
101c0 20 3b 3b 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 ;; roll up the
101d0 63 75 72 72 65 6e 74 20 72 65 73 75 6c 74 73 2e current results.
101e0 0a 20 20 3b 3b 20 46 49 58 4d 45 3a 20 41 64 64 . ;; FIXME: Add
101f0 20 74 68 65 20 73 74 61 74 75 73 20 74 6f 20 0a the status to .
10200 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data-
10210 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 rollup db test-i
10220 64 20 23 66 29 29 0a 0a 3b 3b 20 57 41 52 4e 49 d #f))..;; WARNI
10230 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 61 6c 6c 20 NG: Do NOT call
10240 74 68 69 73 20 66 6f 72 20 74 68 65 20 70 61 72 this for the par
10250 65 6e 74 20 74 65 73 74 20 6f 6e 20 61 6e 20 69 ent test on an i
10260 74 65 72 61 74 65 64 20 74 65 73 74 0a 3b 3b 20 terated test.;;
10270 52 6f 6c 6c 20 75 70 20 74 65 73 74 5f 64 61 74 Roll up test_dat
10280 61 20 70 61 73 73 2f 66 61 69 6c 20 72 65 73 75 a pass/fail resu
10290 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 lts.;; look at t
102a0 68 65 20 74 65 73 74 5f 64 61 74 61 20 73 74 61 he test_data sta
102b0 74 75 73 20 66 69 65 6c 64 2c 20 0a 3b 3b 20 20 tus field, .;;
102c0 20 20 69 66 20 61 6c 6c 20 61 72 65 20 70 61 73 if all are pas
102d0 73 20 28 61 6e 79 20 63 61 73 65 29 20 61 6e 64 s (any case) and
102e0 20 74 68 65 20 74 65 73 74 20 73 74 61 74 75 73 the test status
102f0 20 69 73 20 50 41 53 53 20 6f 72 20 4e 55 4c 4c is PASS or NULL
10300 20 6f 72 20 27 27 20 74 68 65 6e 20 73 65 74 20 or '' then set
10310 74 65 73 74 20 73 74 61 74 75 73 20 74 6f 20 50 test status to P
10320 41 53 53 2e 0a 3b 3b 20 20 20 20 69 66 20 6f 6e ASS..;; if on
10330 65 20 6f 72 20 6d 6f 72 65 20 61 72 65 20 66 61 e or more are fa
10340 69 6c 20 28 61 6e 79 20 63 61 73 65 29 20 74 68 il (any case) th
10350 65 6e 20 73 65 74 20 74 65 73 74 20 73 74 61 74 en set test stat
10360 75 73 20 74 6f 20 50 41 53 53 2c 20 6e 6f 6e 20 us to PASS, non
10370 22 70 61 73 73 22 20 6f 72 20 22 66 61 69 6c 22 "pass" or "fail"
10380 20 61 72 65 20 69 67 6e 6f 72 65 64 0a 28 64 65 are ignored.(de
10390 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 64 61 fine (db:test-da
103a0 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 ta-rollup db tes
103b0 74 2d 69 64 20 73 74 61 74 75 73 29 0a 20 20 28 t-id status). (
103c0 6c 65 74 20 28 28 74 64 62 20 28 6f 70 65 6e 2d let ((tdb (open-
103d0 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6f 70 65 run-close db:ope
103e0 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
103f0 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 t-id db test-id)
10400 29 0a 09 28 66 61 69 6c 2d 63 6f 75 6e 74 20 30 )..(fail-count 0
10410 29 0a 09 28 70 61 73 73 2d 63 6f 75 6e 74 20 30 )..(pass-count 0
10420 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 )). (if tdb..
10430 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
10440 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
10450 09 20 20 20 28 6c 61 6d 62 64 61 20 28 66 63 6f . (lambda (fco
10460 75 6e 74 20 70 63 6f 75 6e 74 29 0a 09 20 20 20 unt pcount)..
10470 20 20 28 73 65 74 21 20 66 61 69 6c 2d 63 6f 75 (set! fail-cou
10480 6e 74 20 66 63 6f 75 6e 74 29 0a 09 20 20 20 20 nt fcount)..
10490 20 28 73 65 74 21 20 70 61 73 73 2d 63 6f 75 6e (set! pass-coun
104a0 74 20 70 63 6f 75 6e 74 29 29 0a 09 20 20 20 74 t pcount)).. t
104b0 64 62 20 0a 09 20 20 20 22 53 45 4c 45 43 54 20 db .. "SELECT
104c0 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
104d0 29 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 ) FROM test_data
104e0 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
104f0 20 41 4e 44 20 73 74 61 74 75 73 20 6c 69 6b 65 AND status like
10500 20 27 66 61 69 6c 27 29 20 41 53 20 66 61 69 6c 'fail') AS fail
10510 5f 63 6f 75 6e 74 2c 0a 20 20 20 20 20 20 20 20 _count,.
10520 20 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 (SELE
10530 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
10540 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 52 M test_data WHER
10550 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 E test_id=? AND
10560 73 74 61 74 75 73 20 6c 69 6b 65 20 27 70 61 73 status like 'pas
10570 73 27 29 20 41 53 20 70 61 73 73 5f 63 6f 75 6e s') AS pass_coun
10580 74 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 t;".. test-id
10590 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 71 6c test-id).. (sql
105a0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
105b0 64 62 29 0a 0a 09 20 20 3b 3b 20 4e 6f 77 20 72 db)... ;; Now r
105c0 6f 6c 6c 75 70 20 74 68 65 20 63 6f 75 6e 74 73 ollup the counts
105d0 20 74 6f 20 74 68 65 20 63 65 6e 74 72 61 6c 20 to the central
105e0 6d 65 67 61 74 65 73 74 2e 64 62 0a 09 20 20 28 megatest.db.. (
105f0 63 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f cdb:pass-fail-co
10600 75 6e 74 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a unts *runremote*
10610 20 74 65 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f test-id fail-co
10620 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a unt pass-count).
10630 09 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 . ;; (sqlite3:e
10640 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
10650 45 20 74 65 73 74 73 20 53 45 54 20 66 61 69 6c E tests SET fail
10660 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f _count=?,pass_co
10670 75 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f unt=? WHERE id=?
10680 3b 22 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 ;" .. ;;
10690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 fa
106a0 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
106b0 75 6e 74 20 74 65 73 74 2d 69 64 29 0a 09 20 20 unt test-id)..
106c0 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 (cdb:flush-queue
106d0 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 09 20 *runremote*)..
106e0 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
106f0 70 21 20 31 29 20 3b 3b 20 70 6c 61 79 20 6e 69 p! 1) ;; play ni
10700 63 65 20 77 69 74 68 20 74 68 65 20 71 75 65 75 ce with the queu
10710 65 20 62 79 20 65 6e 73 75 72 69 6e 67 20 74 68 e by ensuring th
10720 65 20 72 6f 6c 6c 75 70 20 69 73 20 61 74 20 6c e rollup is at l
10730 65 61 73 74 20 31 30 6d 73 20 6c 61 74 65 72 20 east 10ms later
10740 74 68 61 6e 20 74 68 65 20 73 65 74 0a 09 20 20 than the set..
10750 0a 09 20 20 3b 3b 20 69 66 20 74 68 65 20 74 65 .. ;; if the te
10760 73 74 20 69 73 20 6e 6f 74 20 46 41 49 4c 20 74 st is not FAIL t
10770 68 65 6e 20 73 65 74 20 73 74 61 74 75 73 20 62 hen set status b
10780 61 73 65 64 20 6f 6e 20 74 68 65 20 66 61 69 6c ased on the fail
10790 20 61 6e 64 20 70 61 73 73 20 63 6f 75 6e 74 73 and pass counts
107a0 2e 0a 09 20 20 28 63 64 62 3a 74 65 73 74 2d 72 ... (cdb:test-r
107b0 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 2d ollup-test_data-
107c0 70 61 73 73 2d 66 61 69 6c 20 2a 72 75 6e 72 65 pass-fail *runre
107d0 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 0a 09 mote* test-id)..
107e0 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ;; (sqlite3:ex
107f0 65 63 75 74 65 0a 09 20 20 3b 3b 20 20 64 62 20 ecute.. ;; db
10800 20 20 3b 3b 3b 20 4e 4f 54 45 3a 20 53 68 6f 75 ;;; NOTE: Shou
10810 6c 64 20 74 68 69 73 20 62 65 20 57 41 52 4e 2c ld this be WARN,
10820 46 41 49 4c 3f 20 41 20 57 41 52 4e 20 69 73 20 FAIL? A WARN is
10830 6e 6f 74 20 61 20 46 41 49 4c 3f 3f 3f 3f 3f 20 not a FAIL?????
10840 42 55 47 20 46 49 58 4d 45 0a 09 20 20 3b 3b 20 BUG FIXME.. ;;
10850 20 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 "UPDATE tests.
10860 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
10870 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 SET stat
10880 75 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 us=CASE WHEN (SE
10890 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 20 LECT fail_count
108a0 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
108b0 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 20 id=?) > 0 .
108c0 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
108d0 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 THEN 'FA
108e0 49 4c 27 0a 20 20 20 20 20 20 20 20 20 20 3b 3b IL'. ;;
108f0 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 WHE
10900 4e 20 28 53 45 4c 45 43 54 20 70 61 73 73 5f 63 N (SELECT pass_c
10910 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 ount FROM tests
10920 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 WHERE id=?) > 0
10930 41 4e 44 20 0a 20 20 20 20 20 20 20 20 20 20 3b AND . ;
10940 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
10950 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 (SELECT statu
10960 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 s FROM tests WHE
10970 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 RE id=?) NOT IN
10980 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a ('WARN','FAIL').
10990 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
109a0 20 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 50 THEN 'P
109b0 41 53 53 27 0a 20 20 20 20 20 20 20 20 20 20 3b ASS'. ;
109c0 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c ; EL
109d0 53 45 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 SE status.
109e0 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 45 ;; E
109f0 4e 44 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a ND WHERE id=?;".
10a00 09 20 20 3b 3b 20 20 74 65 73 74 2d 69 64 20 74 . ;; test-id t
10a10 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 est-id test-id t
10a20 65 73 74 2d 69 64 29 0a 09 20 20 29 29 29 29 0a est-id).. )))).
10a30 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
10a40 2d 70 72 65 76 2d 74 6f 6c 2d 66 6f 72 2d 74 65 -prev-tol-for-te
10a50 73 74 20 64 62 20 74 65 73 74 2d 69 64 20 63 61 st db test-id ca
10a60 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 29 tegory variable)
10a70 0a 20 20 3b 3b 20 46 69 6e 69 73 68 20 6d 65 3f . ;; Finish me?
10a80 0a 20 20 28 76 61 6c 75 65 73 20 23 66 20 23 66 . (values #f #f
10a90 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #f))..;;=======
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 3d 3d 3d 3d 3d 3d ================
10ad0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10ae0 3b 3b 20 53 20 54 20 45 20 50 20 53 20 0a 3b 3b ;; S T E P S .;;
10af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10b30 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
10b40 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 74 69 6d (db:step-get-tim
10b50 65 2d 61 73 2d 73 74 72 69 6e 67 20 76 65 63 29 e-as-string vec)
10b60 0a 20 20 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d . (seconds->tim
10b70 65 2d 73 74 72 69 6e 67 20 28 64 62 3a 73 74 65 e-string (db:ste
10b80 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
10b90 20 76 65 63 29 29 29 0a 0a 3b 3b 20 64 62 2d 67 vec)))..;; db-g
10ba0 65 74 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 6f et-test-steps-fo
10bb0 72 2d 72 75 6e 0a 28 64 65 66 69 6e 65 20 28 64 r-run.(define (d
10bc0 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
10bd0 74 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 test db test-id)
10be0 0a 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 28 . (let* ((tdb (
10bf0 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d db:open-test-db-
10c00 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 by-test-id db te
10c10 73 74 2d 69 64 29 29 0a 09 20 28 72 65 73 20 27 st-id)).. (res '
10c20 28 29 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 ())). (if tdb
10c30 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c ..(begin.. (sql
10c40 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
10c50 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 w .. (lambda (
10c60 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e id test-id stepn
10c70 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
10c80 20 65 76 65 6e 74 2d 74 69 6d 65 20 6c 6f 67 66 event-time logf
10c90 69 6c 65 29 0a 09 20 20 20 20 20 28 73 65 74 21 ile).. (set!
10ca0 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 res (cons (vect
10cb0 6f 72 20 69 64 20 74 65 73 74 2d 69 64 20 73 74 or id test-id st
10cc0 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 epname state sta
10cd0 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 tus event-time (
10ce0 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 if (string? logf
10cf0 69 6c 65 29 20 6c 6f 67 66 69 6c 65 20 22 22 29 ile) logfile "")
10d00 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 62 ) res))).. tdb
10d10 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c .. "SELECT id,
10d20 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 test_id,stepname
10d30 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
10d40 65 6e 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 ent_time,logfile
10d50 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 FROM test_steps
10d60 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
10d70 20 4f 52 44 45 52 20 42 59 20 69 64 20 41 53 43 ORDER BY id ASC
10d80 3b 22 20 3b 3b 20 65 76 65 6e 74 5f 74 69 6d 65 ;" ;; event_time
10d90 20 44 45 53 43 2c 69 64 20 41 53 43 3b 0a 09 20 DESC,id ASC;..
10da0 20 20 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 test-id).. (s
10db0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
10dc0 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 72 73 tdb).. (revers
10dd0 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 29 0a e res))..'()))).
10de0 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 79 .;; get a pretty
10df0 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 72 table to summar
10e00 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 64 65 ize steps.;;.(de
10e10 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 fine (db:get-ste
10e20 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 73 74 ps-table db test
10e30 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 73 74 -id). (let ((st
10e40 65 70 73 20 20 20 28 64 62 3a 67 65 74 2d 73 74 eps (db:get-st
10e50 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 eps-for-test db
10e60 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 3b test-id))). ;
10e70 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 20 73 ; organise the s
10e80 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 72 20 teps for better
10e90 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 20 20 readability.
10ea0 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
10eb0 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 -hash-table))).
10ec0 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
10ed0 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
10ee0 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 3a 70 step).. (debug:p
10ef0 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 20 73 rint 6 "step=" s
10f00 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 72 65 tep).. (let ((re
10f10 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cord (hash-table
10f20 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 09 09 -ref/default ...
10f30 09 72 65 73 20 0a 09 09 09 28 64 62 3a 73 74 65 .res ....(db:ste
10f40 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
10f50 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 20 20 20 tep) ....;;
10f60 20 20 20 73 74 65 70 6e 61 6d 65 20 20 20 20 20 stepname
10f70 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 start
10f80 20 65 6e 64 20 73 74 61 74 75 73 20 20 20 20 0a end status .
10f90 09 09 09 28 76 65 63 74 6f 72 20 28 64 62 3a 73 ...(vector (db:s
10fa0 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
10fb0 20 73 74 65 70 29 20 22 22 20 20 20 22 22 20 22 step) "" "" "
10fc0 22 20 20 20 20 20 22 22 20 22 22 29 29 29 29 0a " "" "")))).
10fd0 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
10fe0 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 6f 72 6 "record(befor
10ff0 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 e) = " record ..
11000 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 .."\nid: "
11010 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
11020 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 step)...."\nste
11030 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 pname: " (db:ste
11040 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
11050 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 tep)...."\nstate
11060 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d : " (db:step-
11070 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
11080 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 ..."\nstatus:
11090 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
110a0 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
110b0 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 \ntime: " (d
110c0 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
110d0 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 _time step))..
110e0 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
110f0 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 70 2d symbol (db:step-
11100 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
11110 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
11120 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
11130 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 1 (db:step-ge
11140 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
11150 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11160 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 or-set! record 3
11170 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 (if (equal? (ve
11180 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 ctor-ref record
11190 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 62 3a 3) "")......(db:
111a0 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
111b0 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
111c0 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
111d0 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d 67 65 ngth (db:step-ge
111e0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
111f0 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 ... 0)... (
11200 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
11210 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 5 (db:step-ge
11220 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
11230 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 29 20 )).. ((end)
11240 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
11250 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 -set! record 2 (
11260 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
11270 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
11280 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 20 20 ime step)))..
11290 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
112a0 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
112b0 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
112c0 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
112d0 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
112e0 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 20 28 (let ((startt (
112f0 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 any->number (vec
11300 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
11310 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 64 74 )))...... (endt
11320 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 (any->number
11330 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
11340 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 20 20 rd 2)))).....
11350 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
11360 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 4 "record[1]=" (
11370 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
11380 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 20 22 d 1) ....... "
11390 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 72 74 , startt=" start
113a0 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 t ", endt=" endt
113b0 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 65 74 ....... ", get
113c0 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 73 -status: " (db:s
113d0 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
113e0 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 tep)).....
113f0 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 (if (and (number
11400 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 ? startt)(number
11410 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 ? endt))......
11420 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e (seconds->hr-min
11430 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 -sec (- endt sta
11440 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 rtt)) "-1")))..
11450 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
11460 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73 ing-length (db:s
11470 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
11480 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 step))... 0)
11490 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
114a0 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73 ! record 5 (db:s
114b0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
114c0 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 step)))).. (
114d0 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 65 63 else.. (vec
114e0 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
114f0 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 2 (db:step-get-s
11500 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 20 20 tate step))..
11510 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
11520 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
11530 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
11540 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11550 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
11560 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
11570 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
11580 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ).. (hash-tabl
11590 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 3a 73 e-set! res (db:s
115a0 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
115b0 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 0a 09 step) record)..
115c0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
115d0 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 72 29 6 "record(after)
115e0 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 09 = " record ...
115f0 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 20 ."\nid: "
11600 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 (db:step-get-id
11610 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 step)...."\nstep
11620 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 70 name: " (db:step
11630 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
11640 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a ep)...."\nstate:
11650 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 " (db:step-g
11660 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
11670 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
11680 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
11690 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c atus step)...."\
116a0 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 62 ntime: " (db
116b0 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
116c0 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 20 20 time step)))).
116d0 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 20 20 ;; (else
116e0 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
116f0 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 ord 1 (db:step-g
11700 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
11710 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 73 6f ep))). (so
11720 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 64 61 rt steps (lambda
11730 20 28 61 20 62 29 28 3c 20 28 64 62 3a 73 74 65 (a b)(< (db:ste
11740 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
11750 20 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 2d a)(db:step-get-
11760 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 29 29 event_time b))))
11770 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 0a 0a ). res)))..
11780 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
11790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
117a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
117b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
117c0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 49 20 ========.;; M I
117d0 53 20 43 20 20 20 4d 20 41 20 4e 20 41 20 47 20 S C M A N A G
117e0 45 20 4d 20 45 20 4e 20 54 20 20 20 49 20 54 20 E M E N T I T
117f0 45 20 4d 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d E M S .;;=======
11800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11830 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
11840 0a 3b 3b 20 74 68 65 20 6e 65 77 20 70 72 65 72 .;; the new prer
11850 65 71 73 20 63 61 6c 63 75 6c 61 74 69 6f 6e 2c eqs calculation,
11860 20 6c 6f 6f 6b 73 20 61 6c 73 6f 20 61 74 20 69 looks also at i
11870 74 65 6d 70 61 74 68 20 69 66 20 73 70 65 63 69 tempath if speci
11880 66 69 65 64 0a 3b 3b 20 61 6c 6c 20 70 72 65 72 fied.;; all prer
11890 65 71 73 20 6d 75 73 74 20 62 65 20 6d 65 74 3a eqs must be met:
118a0 0a 3b 3b 20 20 20 20 69 66 20 70 72 65 72 65 71 .;; if prereq
118b0 20 74 65 73 74 20 77 69 74 68 20 69 74 65 6d 70 test with itemp
118c0 61 74 68 3d 27 27 20 69 73 20 43 4f 4d 50 4c 45 ath='' is COMPLE
118d0 54 45 44 20 61 6e 64 20 50 41 53 53 2c 20 57 41 TED and PASS, WA
118e0 52 4e 2c 20 43 48 45 43 4b 2c 20 6f 72 20 57 41 RN, CHECK, or WA
118f0 49 56 45 44 20 74 68 65 6e 20 70 72 65 72 65 71 IVED then prereq
11900 20 69 73 20 6d 65 74 0a 3b 3b 20 20 20 20 69 66 is met.;; if
11910 20 70 72 65 72 65 71 20 74 65 73 74 20 77 69 74 prereq test wit
11920 68 20 69 74 65 6d 70 61 74 68 3d 72 65 66 2d 69 h itempath=ref-i
11930 74 65 6d 2d 70 61 74 68 20 61 6e 64 20 43 4f 4d tem-path and COM
11940 50 4c 45 54 45 44 20 77 69 74 68 20 50 41 53 53 PLETED with PASS
11950 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 6f , WARN, CHECK, o
11960 72 20 57 41 49 56 45 44 20 74 68 65 6e 20 70 72 r WAIVED then pr
11970 65 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b 0a 3b ereq is met.;;.;
11980 3b 20 4e 6f 74 65 3a 20 64 6f 20 6e 6f 74 20 63 ; Note: do not c
11990 6f 6e 76 65 72 74 20 74 6f 20 72 65 6d 6f 74 65 onvert to remote
119a0 20 61 73 20 69 74 20 63 61 6c 6c 73 20 72 65 6d as it calls rem
119b0 6f 74 65 20 75 6e 64 65 72 20 74 68 65 20 68 6f ote under the ho
119c0 6f 64 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f 64 65 od.;; Note: mode
119d0 20 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 20 74 'normal means t
119e0 68 61 74 20 74 65 73 74 73 20 6d 75 73 74 20 62 hat tests must b
119f0 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 e COMPLETED and
11a00 6f 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c 20 57 ok (i.e. PASS, W
11a10 41 52 4e 2c 20 43 48 45 43 4b 20 6f 72 20 57 41 ARN, CHECK or WA
11a20 49 56 45 44 29 0a 3b 3b 20 20 20 20 20 20 20 6d IVED).;; m
11a30 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 20 6d 65 ode 'toplevel me
11a40 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 6d ans that tests m
11a50 75 73 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 ust be COMPLETED
11a60 20 6f 6e 6c 79 0a 3b 3b 20 20 20 20 20 20 20 6d only.;; m
11a70 6f 64 65 20 27 69 74 65 6d 6d 61 74 63 68 20 6d ode 'itemmatch m
11a80 65 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 eans that tests
11a90 69 74 65 6d 73 20 6d 75 73 74 20 62 65 20 43 4f items must be CO
11aa0 4d 50 4c 45 54 45 44 20 61 6e 64 20 28 50 41 53 MPLETED and (PAS
11ab0 53 7c 57 41 52 4e 7c 57 41 49 56 45 44 7c 43 48 S|WARN|WAIVED|CH
11ac0 45 43 4b 29 20 5b 5b 20 4e 42 2f 2f 20 4e 4f 54 ECK) [[ NB// NOT
11ad0 20 49 4d 50 4c 45 4d 45 4e 54 45 44 20 59 45 54 IMPLEMENTED YET
11ae0 20 5d 5d 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ]].;; .(define
11af0 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d (db:get-prereqs-
11b00 6e 6f 74 2d 6d 65 74 20 64 62 20 72 75 6e 2d 69 not-met db run-i
11b10 64 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 69 74 d waitons ref-it
11b20 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 20 28 6d em-path #!key (m
11b30 6f 64 65 20 27 6e 6f 72 6d 61 6c 29 29 0a 20 20 ode 'normal)).
11b40 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 77 61 69 (if (or (not wai
11b50 74 6f 6e 73 29 0a 09 20 20 28 6e 75 6c 6c 3f 20 tons).. (null?
11b60 77 61 69 74 6f 6e 73 29 29 0a 20 20 20 20 20 20 waitons)).
11b70 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 '(). (let*
11b80 28 28 75 6e 6d 65 74 2d 70 72 65 2d 72 65 71 73 ((unmet-pre-reqs
11b90 20 27 28 29 29 0a 09 20 20 20 20 20 28 72 65 73 '()).. (res
11ba0 75 6c 74 20 20 20 20 20 20 20 20 20 27 28 29 29 ult '())
11bb0 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 )..(for-each ..
11bc0 28 6c 61 6d 62 64 61 20 28 77 61 69 74 6f 6e 74 (lambda (waitont
11bd0 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 3b 3b est-name).. ;;
11be0 20 62 79 20 67 65 74 74 69 6e 67 20 74 68 65 20 by getting the
11bf0 74 65 73 74 73 20 77 69 74 68 20 6d 61 74 63 68 tests with match
11c00 69 6e 67 20 6e 61 6d 65 20 77 65 20 61 72 65 20 ing name we are
11c10 6c 6f 6f 6b 69 6e 67 20 6f 6e 6c 79 20 61 74 20 looking only at
11c20 74 68 65 20 6d 61 74 63 68 69 6e 67 20 74 65 73 the matching tes
11c30 74 20 0a 09 20 20 20 3b 3b 20 61 6e 64 20 72 65 t .. ;; and re
11c40 6c 61 74 65 64 20 73 75 62 20 69 74 65 6d 73 0a lated sub items.
11c50 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 . (let ((tests
11c60 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 (db
11c70 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
11c80 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 77 61 69 un db run-id wai
11c90 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 27 28 29 tontest-name '()
11ca0 20 27 28 29 29 29 0a 09 09 20 28 65 76 65 72 2d '()))... (ever-
11cb0 73 65 65 6e 20 20 20 20 20 20 20 20 20 23 66 29 seen #f)
11cc0 0a 09 09 20 28 70 61 72 65 6e 74 2d 77 61 69 74 ... (parent-wait
11cd0 6f 6e 2d 6d 65 74 20 23 66 29 0a 09 09 20 28 69 on-met #f)... (i
11ce0 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 20 tem-waiton-met
11cf0 20 23 66 29 29 0a 09 20 20 20 20 20 28 66 6f 72 #f)).. (for
11d00 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 6c -each .. (l
11d10 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 3b ambda (test)...;
11d20 3b 20 28 69 66 20 28 65 71 75 61 6c 3f 20 77 61 ; (if (equal? wa
11d30 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 28 64 itontest-name (d
11d40 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
11d50 61 6d 65 20 74 65 73 74 29 29 20 3b 3b 20 62 79 ame test)) ;; by
11d60 20 64 65 66 69 6e 74 69 6f 6e 20 74 68 69 73 20 defintion this
11d70 68 61 64 20 62 65 74 74 65 72 20 62 65 20 74 72 had better be tr
11d80 75 65 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a 20 28 ue ......(let* (
11d90 28 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 (state
11da0 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
11db0 73 74 61 74 65 20 74 65 73 74 29 29 0a 09 09 20 state test))...
11dc0 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
11dd0 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 (db:tes
11de0 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
11df0 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 74 t))... (it
11e00 65 6d 2d 70 61 74 68 20 20 20 20 20 20 20 20 20 em-path
11e10 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
11e20 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 m-path test))...
11e30 20 20 20 20 20 20 20 28 69 73 2d 63 6f 6d 70 6c (is-compl
11e40 65 74 65 64 20 20 20 20 20 20 28 65 71 75 61 6c eted (equal
11e50 3f 20 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 ? state "COMPLET
11e60 45 44 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 ED"))... (
11e70 69 73 2d 6f 6b 20 20 20 20 20 20 20 20 20 20 20 is-ok
11e80 20 20 28 6d 65 6d 62 65 72 20 73 74 61 74 75 73 (member status
11e90 20 27 28 22 50 41 53 53 22 20 22 57 41 52 4e 22 '("PASS" "WARN"
11ea0 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 "CHECK" "WAIVED
11eb0 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 ")))... (s
11ec0 61 6d 65 2d 69 74 65 6d 70 61 74 68 20 20 20 20 ame-itempath
11ed0 20 28 65 71 75 61 6c 3f 20 72 65 66 2d 69 74 65 (equal? ref-ite
11ee0 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 68 m-path item-path
11ef0 29 29 29 0a 09 09 20 20 28 73 65 74 21 20 65 76 )))... (set! ev
11f00 65 72 2d 73 65 65 6e 20 23 74 29 0a 09 09 20 20 er-seen #t)...
11f10 28 63 6f 6e 64 0a 09 09 20 20 20 3b 3b 20 63 61 (cond... ;; ca
11f20 73 65 20 31 2c 20 6e 6f 6e 2d 69 74 65 6d 20 28 se 1, non-item (
11f30 70 61 72 65 6e 74 20 74 65 73 74 29 20 69 73 20 parent test) is
11f40 0a 09 09 20 20 20 28 28 61 6e 64 20 28 65 71 75 ... ((and (equ
11f50 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
11f60 29 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 ) ;; this is the
11f70 20 70 61 72 65 6e 74 20 74 65 73 74 0a 09 09 09 parent test....
11f80 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 09 is-completed...
11f90 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 71 3f . (or is-ok (eq?
11fa0 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 mode 'toplevel)
11fb0 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 70 ))... (set! p
11fc0 61 72 65 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 arent-waiton-met
11fd0 20 23 74 29 29 0a 09 09 20 20 20 28 28 61 6e 64 #t))... ((and
11fe0 20 73 61 6d 65 2d 69 74 65 6d 70 61 74 68 0a 09 same-itempath..
11ff0 09 09 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a .. is-completed.
12000 09 09 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 ... (or is-ok (e
12010 71 3f 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 q? mode 'topleve
12020 6c 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 l)))... (set!
12030 20 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 item-waiton-met
12040 20 23 74 29 29 29 29 29 0a 09 20 20 20 20 20 20 #t)))))..
12050 74 65 73 74 73 29 0a 09 20 20 20 20 20 28 69 66 tests).. (if
12060 20 28 6e 6f 74 20 28 6f 72 20 70 61 72 65 6e 74 (not (or parent
12070 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 69 74 65 6d -waiton-met item
12080 2d 77 61 69 74 6f 6e 2d 6d 65 74 29 29 0a 09 09 -waiton-met))...
12090 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 (set! result (a
120a0 70 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f ppend (if (null?
120b0 20 74 65 73 74 73 29 20 28 6c 69 73 74 20 77 61 tests) (list wa
120c0 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 itontest-name) t
120d0 65 73 74 73 29 20 72 65 73 75 6c 74 29 29 29 0a ests) result))).
120e0 09 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 . ;; if the
120f0 74 65 73 74 20 69 73 20 6e 6f 74 20 66 6f 75 6e test is not foun
12100 64 20 74 68 65 6e 20 63 6c 65 61 72 6c 79 20 74 d then clearly t
12110 68 65 20 77 61 69 74 6f 6e 20 69 73 20 6e 6f 74 he waiton is not
12120 20 6d 65 74 2e 2e 2e 0a 09 20 20 20 20 20 3b 3b met..... ;;
12130 20 28 69 66 20 28 6e 6f 74 20 65 76 65 72 2d 73 (if (not ever-s
12140 65 65 6e 29 28 73 65 74 21 20 72 65 73 75 6c 74 een)(set! result
12150 20 28 63 6f 6e 73 20 77 61 69 74 6f 6e 74 65 73 (cons waitontes
12160 74 2d 6e 61 6d 65 20 72 65 73 75 6c 74 29 29 29 t-name result)))
12170 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f )).. (if (no
12180 74 20 65 76 65 72 2d 73 65 65 6e 29 0a 09 09 20 t ever-seen)...
12190 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 (set! result (ap
121a0 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f 20 pend (if (null?
121b0 74 65 73 74 73 29 28 6c 69 73 74 20 77 61 69 74 tests)(list wait
121c0 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 65 73 ontest-name) tes
121d0 74 73 29 20 72 65 73 75 6c 74 29 29 29 29 29 0a ts) result))))).
121e0 09 20 77 61 69 74 6f 6e 73 29 0a 09 28 64 65 6c . waitons)..(del
121f0 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 72 ete-duplicates r
12200 65 73 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 69 esult))))..(defi
12210 6e 65 20 28 64 62 3a 74 65 73 74 73 74 65 70 2d ne (db:teststep-
12220 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
12230 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d est-id teststep-
12240 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 name state-in st
12250 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 6e 74 20 atus-in comment
12260 6c 6f 67 66 69 6c 65 29 0a 20 20 28 64 65 62 75 logfile). (debu
12270 67 3a 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d g:print 4 "test-
12280 69 64 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 id: " test-id "
12290 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 3a 20 22 teststep-name: "
122a0 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 29 0a teststep-name).
122b0 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 20 20 (let* ((tdb
122c0 20 20 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 (db:open-tes
122d0 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
122e0 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 db test-id)).. (
122f0 73 74 61 74 65 20 20 20 20 20 28 63 68 65 63 6b state (check
12300 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 -valid-items "st
12310 61 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a ate" state-in)).
12320 09 20 28 73 74 61 74 75 73 20 20 20 20 28 63 68 . (status (ch
12330 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
12340 22 73 74 61 74 75 73 22 20 73 74 61 74 75 73 2d "status" status-
12350 69 6e 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f in))). (if (o
12360 72 20 28 6e 6f 74 20 73 74 61 74 65 29 28 6e 6f r (not state)(no
12370 74 20 73 74 61 74 75 73 29 29 0a 09 28 64 65 62 t status))..(deb
12380 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
12390 49 4e 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 ING: Invalid " (
123a0 69 66 20 73 74 61 74 75 73 20 22 73 74 61 74 75 if status "statu
123b0 73 22 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 s" "state")...
123c0 20 20 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 " value \"" (
123d0 69 66 20 73 74 61 74 75 73 20 73 74 61 74 65 2d if status state-
123e0 69 6e 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c in status-in) "\
123f0 22 2c 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 ", update your v
12400 61 6c 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 alidvalues secti
12410 6f 6e 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 on in megatest.c
12420 6f 6e 66 69 67 22 29 29 0a 20 20 20 20 28 69 66 onfig")). (if
12430 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 tdb..(begin..
12440 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
12450 20 0a 09 20 20 20 74 64 62 0a 09 20 20 20 22 49 .. tdb.. "I
12460 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
12470 20 69 6e 74 6f 20 74 65 73 74 5f 73 74 65 70 73 into test_steps
12480 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 (test_id,stepna
12490 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c me,state,status,
124a0 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 event_time,comme
124b0 6e 74 2c 6c 6f 67 66 69 6c 65 29 20 56 41 4c 55 nt,logfile) VALU
124c0 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ES(?,?,?,?,?,?,?
124d0 29 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 );".. test-id
124e0 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
124f0 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
12500 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
12510 73 29 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 s) (if comment c
12520 6f 6d 6d 65 6e 74 20 22 22 29 20 28 69 66 20 6c omment "") (if l
12530 6f 67 66 69 6c 65 20 6c 6f 67 66 69 6c 65 20 22 ogfile logfile "
12540 22 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ")).. (sqlite3:
12550 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
12560 20 20 23 74 29 0a 09 23 66 29 29 29 0a 0a 3b 3b #t)..#f)))..;;
12570 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12580 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12590 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125b0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 ======.;; Extrac
125c0 74 20 6f 64 73 20 66 69 6c 65 20 66 72 6f 6d 20 t ods file from
125d0 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d the db.;;=======
125e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
125f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12600 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12620 0a 3b 3b 20 72 75 6e 73 70 61 74 74 20 69 73 20 .;; runspatt is
12630 61 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 a comma delimite
12640 64 20 6c 69 73 74 20 6f 66 20 72 75 6e 20 70 61 d list of run pa
12650 74 74 65 72 6e 73 0a 3b 3b 20 6b 65 79 70 61 74 tterns.;; keypat
12660 74 2d 61 6c 69 73 74 20 6d 75 73 74 20 63 6f 6e t-alist must con
12670 74 61 69 6e 20 2a 61 6c 6c 2a 20 6b 65 79 73 20 tain *all* keys
12680 77 69 74 68 20 61 6e 20 61 73 73 6f 63 69 61 74 with an associat
12690 65 64 20 70 61 74 74 65 72 6e 3a 20 27 28 20 28 ed pattern: '( (
126a0 22 4b 45 59 31 22 20 22 25 22 29 20 2e 2e 20 29 "KEY1" "%") .. )
126b0 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 65 78 74 .(define (db:ext
126c0 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 ract-ods-file db
126d0 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 70 outputfile keyp
126e0 61 74 74 2d 61 6c 69 73 74 20 72 75 6e 73 70 61 att-alist runspa
126f0 74 74 20 70 61 74 68 6d 6f 64 29 0a 20 20 28 6c tt pathmod). (l
12700 65 74 2a 20 28 28 6b 65 79 73 73 74 72 20 20 28 et* ((keysstr (
12710 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12720 73 65 20 28 6d 61 70 20 63 61 72 20 6b 65 79 70 se (map car keyp
12730 61 74 74 2d 61 6c 69 73 74 29 20 22 2c 22 29 29 att-alist) ","))
12740 0a 09 20 28 6b 65 79 71 72 79 20 20 20 28 73 74 .. (keyqry (st
12750 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
12760 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 (map (lambda (p
12770 29 28 63 6f 6e 63 20 28 63 61 72 20 70 29 20 22 )(conc (car p) "
12780 20 4c 49 4b 45 20 3f 20 22 29 29 20 6b 65 79 70 LIKE ? ")) keyp
12790 61 74 74 2d 61 6c 69 73 74 29 20 22 20 41 4e 44 att-alist) " AND
127a0 20 22 29 29 0a 09 20 28 6e 75 6d 6b 65 79 73 20 ")).. (numkeys
127b0 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 (length keypatt
127c0 2d 61 6c 69 73 74 29 29 0a 09 20 28 74 65 73 74 -alist)).. (test
127d0 2d 69 64 73 20 27 28 29 29 0a 09 20 28 77 69 6e -ids '()).. (win
127e0 64 6f 77 73 20 20 28 61 6e 64 20 70 61 74 68 6d dows (and pathm
127f0 6f 64 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e od (substring-in
12800 64 65 78 20 22 5c 5c 22 20 70 61 74 68 6d 6f 64 dex "\\" pathmod
12810 29 29 29 0a 09 20 28 74 65 6d 70 64 69 72 20 20 ))).. (tempdir
12820 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
12830 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
12840 29 20 22 2f 22 20 72 75 6e 73 70 61 74 74 20 22 ) "/" runspatt "
12850 5f 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 _" (random 10000
12860 29 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 ) "_" (current-p
12870 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 20 28 rocess-id))).. (
12880 72 75 6e 73 68 65 61 64 65 72 20 28 61 70 70 65 runsheader (appe
12890 6e 64 20 28 6c 69 73 74 20 22 52 75 6e 20 49 64 nd (list "Run Id
128a0 22 20 22 52 75 6e 6e 61 6d 65 22 29 20 3b 20 30 " "Runname") ; 0
128b0 20 31 0a 09 09 09 20 20 20 20 20 28 6d 61 70 20 1.... (map
128c0 63 61 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 car keypatt-alis
128d0 74 29 20 20 20 3b 20 2b 20 4e 20 3d 20 6c 65 6e t) ; + N = len
128e0 67 74 68 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 gth keypatt-alis
128f0 74 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 t.... (list
12900 22 54 65 73 74 6e 61 6d 65 22 20 20 20 20 20 20 "Testname"
12910 20 20 20 20 3b 20 32 0a 09 09 09 09 20 20 20 22 ; 2..... "
12920 49 74 65 6d 20 50 61 74 68 22 20 20 20 20 20 20 Item Path"
12930 20 20 20 3b 20 33 20 0a 09 09 09 09 20 20 20 22 ; 3 ..... "
12940 44 65 73 63 72 69 70 74 69 6f 6e 22 20 20 20 20 Description"
12950 20 20 20 3b 20 34 20 0a 09 09 09 09 20 20 20 22 ; 4 ..... "
12960 53 74 61 74 65 22 20 20 20 20 20 20 20 20 20 20 State"
12970 20 20 20 3b 20 35 20 0a 09 09 09 09 20 20 20 22 ; 5 ..... "
12980 53 74 61 74 75 73 22 20 20 20 20 20 20 20 20 20 Status"
12990 20 20 20 3b 20 36 20 20 0a 09 09 09 09 20 20 20 ; 6 .....
129a0 22 46 69 6e 61 6c 20 4c 6f 67 22 20 20 20 20 20 "Final Log"
129b0 20 20 20 20 3b 20 37 20 0a 09 09 09 09 20 20 20 ; 7 .....
129c0 22 52 75 6e 20 44 75 72 61 74 69 6f 6e 22 20 20 "Run Duration"
129d0 20 20 20 20 3b 20 38 20 0a 09 09 09 09 20 20 20 ; 8 .....
129e0 22 57 68 65 6e 20 52 75 6e 22 20 20 20 20 20 20 "When Run"
129f0 20 20 20 20 3b 20 39 20 0a 09 09 09 09 20 20 20 ; 9 .....
12a00 22 54 61 67 73 22 20 20 20 20 20 20 20 20 20 20 "Tags"
12a10 20 20 20 20 3b 20 31 30 0a 09 09 09 09 20 20 20 ; 10.....
12a20 22 52 75 6e 20 4f 77 6e 65 72 22 20 20 20 20 20 "Run Owner"
12a30 20 20 20 20 3b 20 31 31 0a 09 09 09 09 20 20 20 ; 11.....
12a40 22 43 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 20 "Comment"
12a50 20 20 20 20 3b 20 31 32 0a 09 09 09 09 20 20 20 ; 12.....
12a60 22 41 75 74 68 6f 72 22 20 20 20 20 20 20 20 20 "Author"
12a70 20 20 20 20 3b 20 31 33 0a 09 09 09 09 20 20 20 ; 13.....
12a80 22 54 65 73 74 20 4f 77 6e 65 72 22 20 20 20 20 "Test Owner"
12a90 20 20 20 20 3b 20 31 34 0a 09 09 09 09 20 20 20 ; 14.....
12aa0 22 52 65 76 69 65 77 65 64 22 20 20 20 20 20 20 "Reviewed"
12ab0 20 20 20 20 3b 20 31 35 0a 09 09 09 09 20 20 20 ; 15.....
12ac0 22 44 69 73 6b 66 72 65 65 22 20 20 20 20 20 20 "Diskfree"
12ad0 20 20 20 20 3b 20 31 36 0a 09 09 09 09 20 20 20 ; 16.....
12ae0 22 55 6e 61 6d 65 22 20 20 20 20 20 20 20 20 20 "Uname"
12af0 20 20 20 20 3b 20 31 37 0a 09 09 09 09 20 20 20 ; 17.....
12b00 22 52 75 6e 64 69 72 22 20 20 20 20 20 20 20 20 "Rundir"
12b10 20 20 20 20 3b 20 31 38 0a 09 09 09 09 20 20 20 ; 18.....
12b20 22 48 6f 73 74 22 20 20 20 20 20 20 20 20 20 20 "Host"
12b30 20 20 20 20 3b 20 31 39 0a 09 09 09 09 20 20 20 ; 19.....
12b40 22 43 70 75 20 4c 6f 61 64 22 20 20 20 20 20 20 "Cpu Load"
12b50 20 20 20 20 3b 20 32 30 0a 09 09 09 09 20 20 20 ; 20.....
12b60 29 29 29 0a 09 20 28 72 65 73 75 6c 74 73 20 28 ))).. (results (
12b70 6c 69 73 74 20 72 75 6e 73 68 65 61 64 65 72 29 list runsheader)
12b80 29 09 09 09 20 0a 09 20 28 74 65 73 74 64 61 74 )... .. (testdat
12b90 61 2d 68 65 61 64 65 72 20 28 6c 69 73 74 20 22 a-header (list "
12ba0 52 75 6e 20 49 64 22 20 22 54 65 73 74 6e 61 6d Run Id" "Testnam
12bb0 65 22 20 22 49 74 65 6d 20 50 61 74 68 22 20 22 e" "Item Path" "
12bc0 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 61 Category" "Varia
12bd0 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 78 ble" "Value" "Ex
12be0 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 55 pected" "Tol" "U
12bf0 6e 69 74 73 22 20 22 53 74 61 74 75 73 22 20 22 nits" "Status" "
12c00 43 6f 6d 6d 65 6e 74 22 29 29 0a 09 20 28 6d 61 Comment")).. (ma
12c10 69 6e 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c inqry (conc "SEL
12c20 45 43 54 0a 20 20 20 20 20 20 20 20 20 20 20 20 ECT.
12c30 20 20 74 2e 74 65 73 74 6e 61 6d 65 2c 72 2e 69 t.testname,r.i
12c40 64 2c 72 75 6e 6e 61 6d 65 2c 22 20 6b 65 79 73 d,runname," keys
12c50 73 74 72 20 22 2c 74 2e 74 65 73 74 6e 61 6d 65 str ",t.testname
12c60 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
12c70 74 2e 69 74 65 6d 5f 70 61 74 68 2c 74 6d 2e 64 t.item_path,tm.d
12c80 65 73 63 72 69 70 74 69 6f 6e 2c 74 2e 73 74 61 escription,t.sta
12c90 74 65 2c 74 2e 73 74 61 74 75 73 2c 0a 20 20 20 te,t.status,.
12ca0 20 20 20 20 20 20 20 20 20 20 20 66 69 6e 61 6c final
12cb0 5f 6c 6f 67 66 2c 72 75 6e 5f 64 75 72 61 74 69 _logf,run_durati
12cc0 6f 6e 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 on, .
12cd0 20 20 20 73 74 72 66 74 69 6d 65 28 27 25 6d 2f strftime('%m/
12ce0 25 64 2f 25 59 20 25 48 3a 25 4d 3a 25 53 27 2c %d/%Y %H:%M:%S',
12cf0 64 61 74 65 74 69 6d 65 28 74 2e 65 76 65 6e 74 datetime(t.event
12d00 5f 74 69 6d 65 2c 27 75 6e 69 78 65 70 6f 63 68 _time,'unixepoch
12d10 27 29 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 2c '),'localtime'),
12d20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 . t
12d30 6d 2e 74 61 67 73 2c 72 2e 6f 77 6e 65 72 2c 74 m.tags,r.owner,t
12d40 2e 63 6f 6d 6d 65 6e 74 2c 0a 20 20 20 20 20 20 .comment,.
12d50 20 20 20 20 20 20 20 20 61 75 74 68 6f 72 2c 0a author,.
12d60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6d tm
12d70 2e 6f 77 6e 65 72 2c 72 65 76 69 65 77 65 64 2c .owner,reviewed,
12d80 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 . d
12d90 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 iskfree,uname,ru
12da0 6e 64 69 72 2c 0a 20 20 20 20 20 20 20 20 20 20 ndir,.
12db0 20 20 20 20 68 6f 73 74 2c 63 70 75 6c 6f 61 64 host,cpuload
12dc0 0a 20 20 20 20 20 20 20 20 20 20 20 20 46 52 4f . FRO
12dd0 4d 20 74 65 73 74 73 20 41 53 20 74 20 4a 4f 49 M tests AS t JOI
12de0 4e 20 72 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 N runs AS r ON t
12df0 2e 72 75 6e 5f 69 64 3d 72 2e 69 64 20 4a 4f 49 .run_id=r.id JOI
12e00 4e 20 74 65 73 74 5f 6d 65 74 61 20 41 53 20 74 N test_meta AS t
12e10 6d 20 4f 4e 20 74 6d 2e 74 65 73 74 6e 61 6d 65 m ON tm.testname
12e20 3d 74 2e 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 =t.testname.
12e30 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 WHERE ru
12e40 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 41 4e 44 nname LIKE ? AND
12e50 20 22 20 6b 65 79 71 72 79 20 22 3b 22 29 29 29 " keyqry ";")))
12e60 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
12e70 74 20 32 20 22 55 73 69 6e 67 20 22 20 74 65 6d t 2 "Using " tem
12e80 70 64 69 72 20 22 20 66 6f 72 20 63 6f 6e 73 74 pdir " for const
12e90 72 75 63 74 69 6e 67 20 74 68 65 20 6f 64 73 20 ructing the ods
12ea0 66 69 6c 65 2e 20 6b 65 79 71 72 79 3a 20 22 20 file. keyqry: "
12eb0 6b 65 79 71 72 79 20 22 20 6b 65 79 73 74 72 3a keyqry " keystr:
12ec0 20 22 20 6b 65 79 73 73 74 72 20 22 20 77 69 74 " keysstr " wit
12ed0 68 20 6b 65 79 73 3a 20 22 20 28 6d 61 70 20 63 h keys: " (map c
12ee0 61 64 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 adr keypatt-alis
12ef0 74 29 0a 09 09 20 22 5c 6e 20 20 20 20 20 20 6d t)... "\n m
12f00 61 69 6e 71 72 79 3a 20 22 20 6d 61 69 6e 71 72 ainqry: " mainqr
12f10 79 29 0a 20 20 20 20 3b 3b 20 22 45 78 70 65 63 y). ;; "Expec
12f20 74 65 64 20 56 61 6c 75 65 22 0a 20 20 20 20 3b ted Value". ;
12f30 3b 20 22 56 61 6c 75 65 20 46 6f 75 6e 64 22 0a ; "Value Found".
12f40 20 20 20 20 3b 3b 20 22 54 6f 6c 65 72 61 6e 63 ;; "Toleranc
12f50 65 22 0a 20 20 20 20 28 61 70 70 6c 79 20 73 71 e". (apply sq
12f60 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
12f70 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 ow.. (lambda (
12f80 74 65 73 74 2d 69 64 20 2e 20 62 29 0a 09 20 20 test-id . b)..
12f90 20 20 20 28 73 65 74 21 20 74 65 73 74 2d 69 64 (set! test-id
12fa0 73 20 28 63 6f 6e 73 20 74 65 73 74 2d 69 64 20 s (cons test-id
12fb0 74 65 73 74 2d 69 64 73 29 29 20 20 20 3b 3b 20 test-ids)) ;;
12fc0 74 65 73 74 2d 69 64 20 69 73 20 6e 6f 77 20 74 test-id is now t
12fd0 65 73 74 6e 61 6d 65 0a 09 20 20 20 20 20 28 73 estname.. (s
12fe0 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 70 et! results (app
12ff0 65 6e 64 20 72 65 73 75 6c 74 73 20 3b 3b 20 6e end results ;; n
13000 6f 74 65 2c 20 64 72 6f 70 20 74 68 65 20 74 65 ote, drop the te
13010 73 74 2d 69 64 0a 09 09 09 09 20 20 20 28 6c 69 st-id..... (li
13020 73 74 0a 09 09 09 09 20 20 20 20 28 69 66 20 70 st..... (if p
13030 61 74 68 6d 6f 64 0a 09 09 09 09 09 28 6c 65 74 athmod......(let
13040 2a 20 28 28 76 62 20 20 20 20 20 20 20 20 28 61 * ((vb (a
13050 70 70 6c 79 20 76 65 63 74 6f 72 20 62 29 29 0a pply vector b)).
13060 09 09 09 09 09 20 20 20 20 20 20 20 28 6b 65 79 ..... (key
13070 76 61 6c 73 20 20 20 28 6c 65 74 20 6c 6f 6f 70 vals (let loop
13080 20 28 28 69 20 20 20 20 30 29 0a 09 09 09 09 09 ((i 0)......
13090 09 09 09 20 20 20 20 20 28 72 65 73 20 27 28 29 ... (res '()
130a0 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 ))........ (i
130b0 66 20 28 3e 3d 20 69 20 6e 75 6d 6b 65 79 73 29 f (>= i numkeys)
130c0 0a 09 09 09 09 09 09 09 09 72 65 73 0a 09 09 09 .........res....
130d0 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 20 .....(loop (+ i
130e0 31 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 1).........
130f0 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
13100 73 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 st (vector-ref v
13110 62 20 28 2b 20 69 20 32 29 29 29 29 29 29 29 29 b (+ i 2))))))))
13120 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 ...... (ru
13130 6e 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d nname (vector-
13140 72 65 66 20 76 62 20 31 29 29 0a 09 09 09 09 09 ref vb 1))......
13150 20 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 (testname
13160 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 (vector-ref vb
13170 20 28 2b 20 20 32 20 6e 75 6d 6b 65 79 73 29 29 (+ 2 numkeys))
13180 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 )...... (i
13190 74 65 6d 2d 70 61 74 68 20 28 76 65 63 74 6f 72 tem-path (vector
131a0 2d 72 65 66 20 76 62 20 28 2b 20 20 33 20 6e 75 -ref vb (+ 3 nu
131b0 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 mkeys)))......
131c0 20 20 20 20 20 28 66 69 6e 61 6c 2d 6c 6f 67 20 (final-log
131d0 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 (vector-ref vb (
131e0 2b 20 20 37 20 6e 75 6d 6b 65 79 73 29 29 29 0a + 7 numkeys))).
131f0 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ..... (run
13200 2d 64 69 72 20 20 20 28 76 65 63 74 6f 72 2d 72 -dir (vector-r
13210 65 66 20 76 62 20 28 2b 20 31 38 20 6e 75 6d 6b ef vb (+ 18 numk
13220 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 eys)))......
13230 20 20 20 28 6c 6f 67 2d 66 70 61 74 68 20 28 63 (log-fpath (c
13240 6f 6e 63 20 72 75 6e 2d 64 69 72 20 22 2f 22 20 onc run-dir "/"
13250 20 66 69 6e 61 6c 2d 6c 6f 67 29 29 29 20 3b 3b final-log))) ;;
13260 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
13270 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22 erse keyvals "/"
13280 29 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 20 22 ) "/" testname "
13290 2f 22 20 69 74 65 6d 2d 70 61 74 68 20 22 2f 22 /" item-path "/"
132a0 0a 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
132b0 72 69 6e 74 20 34 20 22 6c 6f 67 3a 20 22 20 6c rint 4 "log: " l
132c0 6f 67 2d 66 70 61 74 68 20 22 20 65 78 69 73 74 og-fpath " exist
132d0 73 3a 20 22 20 28 66 69 6c 65 2d 65 78 69 73 74 s: " (file-exist
132e0 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 29 0a 09 s? log-fpath))..
132f0 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 .... (vector-se
13300 74 21 20 76 62 20 28 2b 20 37 20 6e 75 6d 6b 65 t! vb (+ 7 numke
13310 79 73 29 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ys) (if (file-ex
13320 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 ists? log-fpath)
13330 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 6c .......... (l
13340 65 74 20 28 28 6e 65 77 70 61 74 68 20 28 63 6f et ((newpath (co
13350 6e 63 20 70 61 74 68 6d 6f 64 20 22 2f 22 0a 09 nc pathmod "/"..
13360 09 09 09 09 09 09 09 09 09 09 09 20 28 73 74 72 ........... (str
13370 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
13380 6b 65 79 76 61 6c 73 20 22 2f 22 29 0a 09 09 09 keyvals "/")....
13390 09 09 09 09 09 09 09 09 09 20 22 2f 22 20 72 75 ......... "/" ru
133a0 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
133b0 6d 65 20 22 2f 22 0a 09 09 09 09 09 09 09 09 09 me "/"..........
133c0 09 09 09 20 28 69 66 20 28 73 74 72 69 6e 67 3d ... (if (string=
133d0 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 20 ? item-path "")
133e0 22 22 20 28 63 6f 6e 63 20 22 2f 22 20 69 74 65 "" (conc "/" ite
133f0 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 m-path))........
13400 09 09 09 09 09 20 66 69 6e 61 6c 2d 6c 6f 67 29 ..... final-log)
13410 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
13420 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 74 68 72 ;; for now thr
13430 6f 77 20 61 77 61 79 20 6e 65 77 70 61 74 68 20 ow away newpath
13440 61 6e 64 20 75 73 65 20 74 68 65 20 6c 6f 67 2d and use the log-
13450 66 70 61 74 68 20 63 6f 6e 63 27 64 20 77 69 74 fpath conc'd wit
13460 68 20 70 61 74 68 6d 6f 64 0a 09 09 09 09 09 09 h pathmod.......
13470 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 6e ... (set! n
13480 65 77 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 ewpath (conc pat
13490 68 6d 6f 64 20 6c 6f 67 2d 66 70 61 74 68 29 29 hmod log-fpath))
134a0 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
134b0 28 69 66 20 77 69 6e 64 6f 77 73 20 28 73 74 72 (if windows (str
134c0 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 6e 65 ing-translate ne
134d0 77 70 61 74 68 20 22 2f 22 20 22 5c 5c 22 29 20 wpath "/" "\\")
134e0 6e 65 77 70 61 74 68 29 29 0a 09 09 09 09 09 09 newpath)).......
134f0 09 09 09 20 20 20 20 28 69 66 20 28 64 65 62 75 ... (if (debu
13500 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 0a g:debug-mode 1).
13510 09 09 09 09 09 09 09 09 09 09 28 63 6f 6e 63 20 ..........(conc
13520 66 69 6e 61 6c 2d 6c 6f 67 20 22 20 6e 6f 74 2d final-log " not-
13530 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 09 09 found").........
13540 09 09 22 22 29 29 29 0a 09 09 09 09 09 20 20 28 .."")))...... (
13550 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 62 29 vector->list vb)
13560 29 0a 09 09 09 09 09 62 29 29 29 29 29 0a 09 20 )......b)))))..
13570 20 20 64 62 0a 09 20 20 20 6d 61 69 6e 71 72 79 db.. mainqry
13580 0a 09 20 20 20 72 75 6e 73 70 61 74 74 20 28 6d .. runspatt (m
13590 61 70 20 63 61 64 72 20 6b 65 79 70 61 74 74 2d ap cadr keypatt-
135a0 61 6c 69 73 74 29 29 0a 20 20 20 20 28 64 65 62 alist)). (deb
135b0 75 67 3a 70 72 69 6e 74 20 32 20 22 46 6f 75 6e ug:print 2 "Foun
135c0 64 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 d " (length test
135d0 2d 69 64 73 29 20 22 20 72 65 63 6f 72 64 73 22 -ids) " records"
135e0 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 75 ). (set! resu
135f0 6c 74 73 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 lts (list (cons
13600 22 52 75 6e 73 22 20 72 65 73 75 6c 74 73 29 29 "Runs" results))
13610 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 2c 20 66 6f ). ;; now, fo
13620 72 20 65 61 63 68 20 74 65 73 74 2c 20 63 6f 6c r each test, col
13630 6c 65 63 74 20 74 68 65 20 74 65 73 74 5f 64 61 lect the test_da
13640 74 61 20 69 6e 66 6f 20 61 6e 64 20 61 64 64 20 ta info and add
13650 61 20 6e 65 77 20 73 68 65 65 74 0a 20 20 20 20 a new sheet.
13660 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 (for-each. (
13670 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 29 lambda (test-id)
13680 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
13690 65 73 74 2d 64 61 74 61 20 28 6c 69 73 74 20 74 est-data (list t
136a0 65 73 74 64 61 74 61 2d 68 65 61 64 65 72 29 29 estdata-header))
136b0 0a 09 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 .. (curr-tes
136c0 74 2d 6e 61 6d 65 20 23 66 29 29 0a 09 20 28 73 t-name #f)).. (s
136d0 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
136e0 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 row.. (lambda (
136f0 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
13700 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 6f item-path catego
13710 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
13720 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
13730 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d 6d nits status comm
13740 65 6e 74 29 0a 09 20 20 20 20 28 73 65 74 21 20 ent).. (set!
13750 63 75 72 72 2d 74 65 73 74 2d 6e 61 6d 65 20 74 curr-test-name t
13760 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 28 73 estname).. (s
13770 65 74 21 20 74 65 73 74 2d 64 61 74 61 20 28 61 et! test-data (a
13780 70 70 65 6e 64 20 74 65 73 74 2d 64 61 74 61 20 ppend test-data
13790 28 6c 69 73 74 20 28 6c 69 73 74 20 72 75 6e 2d (list (list run-
137a0 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
137b0 2d 70 61 74 68 20 63 61 74 65 67 6f 72 79 20 76 -path category v
137c0 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 78 ariable value ex
137d0 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 pected tol units
137e0 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 status comment)
137f0 29 29 29 29 0a 09 20 20 64 62 20 0a 09 20 20 3b )))).. db .. ;
13800 3b 20 22 53 45 4c 45 43 54 20 72 75 6e 5f 69 64 ; "SELECT run_id
13810 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
13820 61 74 68 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 ath,category,var
13830 69 61 62 6c 65 2c 74 64 2e 76 61 6c 75 65 20 41 iable,td.value A
13840 53 20 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 S value,expected
13850 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 64 2e 73 74 ,tol,units,td.st
13860 61 74 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 atus AS status,t
13870 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d d.comment AS com
13880 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 ment FROM test_d
13890 61 74 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 ata AS td INNER
138a0 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 JOIN tests ON te
138b0 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 sts.id=td.test_i
138c0 64 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d d WHERE test_id=
138d0 3f 3b 22 0a 09 20 20 22 53 45 4c 45 43 54 20 72 ?;".. "SELECT r
138e0 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 un_id,testname,i
138f0 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 tem_path,categor
13900 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 y,variable,td.va
13910 6c 75 65 20 41 53 20 76 61 6c 75 65 2c 74 64 2e lue AS value,td.
13920 65 78 70 65 63 74 65 64 2c 74 64 2e 74 6f 6c 2c expected,td.tol,
13930 74 64 2e 75 6e 69 74 73 2c 74 64 2e 73 74 61 74 td.units,td.stat
13940 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 64 2e us AS status,td.
13950 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d 6d 65 comment AS comme
13960 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 nt FROM test_dat
13970 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 4a 4f a AS td INNER JO
13980 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 73 74 IN tests ON test
13990 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 64 20 s.id=td.test_id
139a0 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f WHERE testname=?
139b0 3b 22 0a 09 20 20 74 65 73 74 2d 69 64 29 0a 09 ;".. test-id)..
139c0 20 28 69 66 20 63 75 72 72 2d 74 65 73 74 2d 6e (if curr-test-n
139d0 61 6d 65 0a 09 20 20 20 20 20 28 73 65 74 21 20 ame.. (set!
139e0 72 65 73 75 6c 74 73 20 28 61 70 70 65 6e 64 20 results (append
139f0 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 63 results (list (c
13a00 6f 6e 73 20 63 75 72 72 2d 74 65 73 74 2d 6e 61 ons curr-test-na
13a10 6d 65 20 74 65 73 74 2d 64 61 74 61 29 29 29 29 me test-data))))
13a20 29 0a 09 20 29 29 0a 20 20 20 20 20 28 73 6f 72 ).. )). (sor
13a30 74 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 t (delete-duplic
13a40 61 74 65 73 20 74 65 73 74 2d 69 64 73 29 20 73 ates test-ids) s
13a50 74 72 69 6e 67 3c 3d 29 29 0a 20 20 20 20 28 73 tring<=)). (s
13a60 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 ystem (conc "mkd
13a70 69 72 20 2d 70 20 22 20 74 65 6d 70 64 69 72 29 ir -p " tempdir)
13a80 29 0a 20 20 20 20 3b 3b 20 28 70 70 20 72 65 73 ). ;; (pp res
13a90 75 6c 74 73 29 0a 20 20 20 20 28 6f 64 73 3a 6c ults). (ods:l
13aa0 69 73 74 2d 3e 6f 64 73 20 0a 20 20 20 20 20 74 ist->ods . t
13ab0 65 6d 70 64 69 72 0a 20 20 20 20 20 28 69 66 20 empdir. (if
13ac0 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 (string-match (r
13ad0 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 egexp "^[/~]+.*"
13ae0 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b ) outputfile) ;;
13af0 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 20 6f 75 full path?.. ou
13b00 74 70 75 74 66 69 6c 65 0a 09 20 28 62 65 67 69 tputfile.. (begi
13b10 6e 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 n.. (debug:pri
13b20 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 70 nt 0 "WARNING: p
13b30 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f 75 74 ath given, " out
13b40 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 65 6c putfile " is rel
13b50 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 6e 67 ative, prefixing
13b60 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 64 69 with current di
13b70 72 65 63 74 6f 72 79 22 29 0a 09 20 20 20 28 63 rectory").. (c
13b80 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 onc (current-dir
13b90 65 63 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 ectory) "/" outp
13ba0 75 74 66 69 6c 65 29 29 29 0a 20 20 20 20 20 72 utfile))). r
13bb0 65 73 75 6c 74 73 29 0a 20 20 20 20 3b 3b 20 62 esults). ;; b
13bc0 72 75 74 61 6c 20 63 6c 65 61 6e 20 75 70 0a 20 rutal clean up.
13bd0 20 20 20 28 73 79 73 74 65 6d 20 22 72 6d 20 2d (system "rm -
13be0 72 66 20 74 65 6d 70 64 69 72 22 29 29 29 0a 0a rf tempdir")))..
13bf0 3b 3b 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f ;; (db:extract-o
13c00 64 73 2d 66 69 6c 65 20 64 62 20 22 6f 75 74 70 ds-file db "outp
13c10 75 74 66 69 6c 65 2e 6f 64 73 22 20 27 28 28 22 utfile.ods" '(("
13c20 73 79 73 6e 61 6d 65 22 20 22 25 22 29 28 22 66 sysname" "%")("f
13c30 73 6e 61 6d 65 22 20 22 25 22 29 28 22 64 61 74 sname" "%")("dat
13c40 61 70 61 74 68 22 20 22 25 22 29 29 20 22 25 22 apath" "%")) "%"
13c50 29 0a ).