0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 44 61 74 61 62 61 73 65 ====.;; Database
0230: 20 61 63 63 65 73 73 0a 3b 3b 3d 3d 3d 3d 3d 3d access.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e ..(require-exten
0290: 73 69 6f 6e 20 28 73 72 66 69 20 31 38 29 20 65 sion (srfi 18) e
02a0: 78 74 72 61 73 20 74 63 70 29 20 3b 3b 20 20 72 xtras tcp) ;; r
02b0: 70 63 29 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 28 pc).;; (import (
02c0: 70 72 65 66 69 78 20 72 70 63 20 72 70 63 3a 29 prefix rpc rpc:)
02d0: 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 20 )..(use sqlite3
02e0: 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 67 srfi-1 posix reg
02f0: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 72 ex regex-case sr
0300: 66 69 2d 36 39 20 63 73 76 2d 78 6d 6c 20 73 31 fi-69 csv-xml s1
0310: 31 6e 20 6d 64 35 20 6d 65 73 73 61 67 65 2d 64 1n md5 message-d
0320: 69 67 65 73 74 20 62 61 73 65 36 34 29 0a 28 69 igest base64).(i
0330: 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 mport (prefix sq
0340: 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 lite3 sqlite3:))
0350: 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 .(import (prefix
0360: 20 62 61 73 65 36 34 20 62 61 73 65 36 34 3a 29 base64 base64:)
0370: 29 0a 0a 3b 3b 20 4e 6f 74 65 2c 20 74 72 79 20 )..;; Note, try
0380: 74 6f 20 72 65 6d 6f 76 65 20 74 68 69 73 20 64 to remove this d
0390: 65 70 65 6e 64 65 6e 63 79 20 0a 3b 3b 20 28 75 ependency .;; (u
03a0: 73 65 20 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 se zmq)..(declar
03b0: 65 20 28 75 6e 69 74 20 64 62 29 29 0a 28 64 65 e (unit db)).(de
03c0: 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d clare (uses comm
03d0: 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 on)).(declare (u
03e0: 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 63 6c ses keys)).(decl
03f0: 61 72 65 20 28 75 73 65 73 20 6f 64 73 29 29 0a are (uses ods)).
0400: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 66 (declare (uses f
0410: 73 2d 74 72 61 6e 73 70 6f 72 74 29 29 0a 28 64 s-transport)).(d
0420: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6c 69 eclare (uses cli
0430: 65 6e 74 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 ent))..(include
0440: 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e "common_records.
0450: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
0460: 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 db_records.scm")
0470: 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 .(include "key_r
0480: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
0490: 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 clude "run_recor
04a0: 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 74 69 6d ds.scm")..;; tim
04b0: 65 73 74 61 6d 70 20 74 79 70 65 20 28 76 61 6c estamp type (val
04c0: 31 20 76 61 6c 32 20 2e 2e 2e 29 0a 3b 3b 20 74 1 val2 ...).;; t
04d0: 79 70 65 3a 20 6d 65 74 61 2d 69 6e 66 6f 2c 20 ype: meta-info,
04e0: 73 74 65 70 0a 28 64 65 66 69 6e 65 20 2a 69 6e step.(define *in
04f0: 63 6f 6d 69 6e 67 2d 77 72 69 74 65 73 2a 20 20 coming-writes*
0500: 20 20 20 20 27 28 29 29 0a 28 64 65 66 69 6e 65 '()).(define
0510: 20 2a 63 6f 6d 70 6c 65 74 65 64 2d 77 72 69 74 *completed-writ
0520: 65 73 2a 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 es* (make-hash
0530: 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 69 6e 65 -table)).(define
0540: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6c 61 73 74 2d *incoming-last-
0550: 74 69 6d 65 2a 20 28 63 75 72 72 65 6e 74 2d 73 time* (current-s
0560: 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 69 6e 65 econds)).(define
0570: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 *incoming-mutex
0580: 2a 20 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 * (make-mute
0590: 78 29 29 0a 28 64 65 66 69 6e 65 20 2a 63 6f 6d x)).(define *com
05a0: 70 6c 65 74 65 64 2d 6d 75 74 65 78 2a 20 20 20 pleted-mutex*
05b0: 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 28 (make-mutex)).(
05c0: 64 65 66 69 6e 65 20 2a 63 61 63 68 65 2d 6f 6e define *cache-on
05d0: 2a 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 * #f)..(define (
05e0: 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a db:set-sync db).
05f0: 20 20 28 6c 65 74 2a 20 28 28 73 79 6e 63 76 61 (let* ((syncva
0600: 6c 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 l (config-looku
0610: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
0620: 65 74 75 70 22 20 20 20 20 20 22 73 79 6e 63 68 etup" "synch
0630: 72 6f 6e 6f 75 73 22 29 29 0a 09 20 28 76 61 6c ronous")).. (val
0640: 20 20 20 20 20 20 28 63 6f 6e 64 20 20 20 3b 3b (cond ;;
0650: 20 30 20 7c 20 4f 46 46 20 7c 20 31 20 7c 20 4e 0 | OFF | 1 | N
0660: 4f 52 4d 41 4c 20 7c 20 32 20 7c 20 46 55 4c 4c ORMAL | 2 | FULL
0670: 3b 0a 09 09 20 20 20 20 28 28 6e 6f 74 20 73 79 ;... ((not sy
0680: 6e 63 76 61 6c 29 20 23 66 29 0a 09 09 20 20 20 ncval) #f)...
0690: 20 28 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 ((string->numbe
06a0: 72 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 r syncval)...
06b0: 20 20 28 6c 65 74 20 28 28 76 61 6c 20 28 73 74 (let ((val (st
06c0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 79 6e ring->number syn
06d0: 63 76 61 6c 29 29 29 0a 09 09 20 20 20 20 20 20 cval)))...
06e0: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 76 61 6c (if (member val
06f0: 20 27 28 30 20 31 20 32 29 29 20 76 61 6c 20 23 '(0 1 2)) val #
0700: 66 29 29 29 0a 09 09 20 20 20 20 28 28 73 74 72 f)))... ((str
0710: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 ing-match (regex
0720: 70 20 22 79 65 73 22 20 23 74 29 20 73 79 6e 63 p "yes" #t) sync
0730: 76 61 6c 29 20 31 29 0a 09 09 20 20 20 20 28 28 val) 1)... ((
0740: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 string-match (re
0750: 67 65 78 70 20 22 6e 6f 22 20 20 23 74 29 20 73 gexp "no" #t) s
0760: 79 6e 63 76 61 6c 29 20 30 29 0a 09 09 20 20 20 yncval) 0)...
0770: 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 ((string-match
0780: 28 72 65 67 65 78 70 20 22 28 6f 66 66 7c 6e 6f (regexp "(off|no
0790: 72 6d 61 6c 7c 66 75 6c 6c 29 22 20 23 74 29 20 rmal|full)" #t)
07a0: 73 79 6e 63 76 61 6c 29 20 73 79 6e 63 76 61 6c syncval) syncval
07b0: 29 0a 09 09 20 20 20 20 28 65 6c 73 65 20 0a 09 )... (else ..
07c0: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
07d0: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 73 79 6e nt 0 "ERROR: syn
07e0: 63 68 72 6f 6e 6f 75 73 20 6d 75 73 74 20 62 65 chronous must be
07f0: 20 30 2c 31 2c 32 2c 4f 46 46 2c 4e 4f 52 4d 41 0,1,2,OFF,NORMA
0800: 4c 20 6f 72 20 46 55 4c 4c 2c 20 79 6f 75 20 70 L or FULL, you p
0810: 72 6f 76 69 64 65 64 3a 20 22 20 73 79 6e 63 76 rovided: " syncv
0820: 61 6c 29 0a 09 09 20 20 20 20 20 23 66 29 29 29 al)... #f)))
0830: 29 0a 20 20 20 20 28 69 66 20 76 61 6c 0a 09 28 ). (if val..(
0840: 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
0850: 70 72 69 6e 74 2d 69 6e 66 6f 20 39 20 22 64 62 print-info 9 "db
0860: 3a 73 65 74 2d 73 79 6e 63 2c 20 73 65 74 74 69 :set-sync, setti
0870: 6e 67 20 70 72 61 67 6d 61 20 73 79 6e 63 68 72 ng pragma synchr
0880: 6f 6e 6f 75 73 20 74 6f 20 22 20 76 61 6c 29 0a onous to " val).
0890: 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
08a0: 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 50 52 ute db (conc "PR
08b0: 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 AGMA synchronous
08c0: 20 3d 20 27 22 20 76 61 6c 20 22 27 3b 22 29 29 = '" val "';"))
08d0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f ))))..(define (o
08e0: 70 65 6e 2d 64 62 29 20 3b 3b 20 20 28 63 6f 6e pen-db) ;; (con
08f0: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 c *toppath* "/me
0900: 67 61 74 65 73 74 2e 64 62 22 29 20 28 63 61 72 gatest.db") (car
0910: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 29 *configinfo*)))
0920: 0a 20 20 28 69 66 20 28 6e 6f 74 20 2a 74 6f 70 . (if (not *top
0930: 70 61 74 68 2a 29 0a 20 20 20 20 20 20 28 69 66 path*). (if
0940: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for
0950: 2d 72 75 6e 29 29 0a 09 20 20 28 62 65 67 69 6e -run)).. (begin
0960: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
0970: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 74 nt 0 "ERROR: Att
0980: 65 6d 70 74 65 64 20 74 6f 20 6f 70 65 6e 20 64 empted to open d
0990: 62 20 77 68 65 6e 20 6e 6f 74 20 69 6e 20 6d 65 b when not in me
09a0: 67 61 74 65 73 74 20 61 72 65 61 2e 20 45 78 69 gatest area. Exi
09b0: 74 69 6e 67 2e 22 29 0a 09 20 20 20 20 28 65 78 ting.").. (ex
09c0: 69 74 29 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 it)))). (let* (
09d0: 28 64 62 70 61 74 68 20 20 20 20 28 63 6f 6e 63 (dbpath (conc
09e0: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 *toppath* "/meg
09f0: 61 74 65 73 74 2e 64 62 22 29 29 20 3b 3b 20 66 atest.db")) ;; f
0a00: 6e 61 6d 65 29 0a 09 20 28 64 62 65 78 69 73 74 name).. (dbexist
0a10: 73 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f s (file-exists?
0a20: 20 64 62 70 61 74 68 29 29 0a 09 20 28 77 72 69 dbpath)).. (wri
0a30: 74 65 2d 61 63 63 65 73 73 20 28 66 69 6c 65 2d te-access (file-
0a40: 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 64 62 write-access? db
0a50: 70 61 74 68 29 29 0a 09 20 28 64 62 20 20 20 20 path)).. (db
0a60: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 (sqlite3:ope
0a70: 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 61 74 n-database dbpat
0a80: 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 h)) ;; (never-gi
0a90: 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 ve-up-open-db db
0aa0: 70 61 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 path)).. (handle
0ab0: 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 r (make-busy-t
0ac0: 69 6d 65 6f 75 74 20 28 69 66 20 28 61 72 67 73 imeout (if (args
0ad0: 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 :get-arg "-overr
0ae0: 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 0a 09 09 ide-timeout")...
0af0: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e ... (string->n
0b00: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
0b10: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 arg "-override-t
0b20: 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 09 09 20 imeout"))......
0b30: 20 20 31 33 36 30 30 30 29 29 29 29 20 3b 3b 20 136000)))) ;;
0b40: 31 33 36 30 30 30 29 29 29 20 3b 3b 20 31 33 36 136000))) ;; 136
0b50: 30 30 30 20 3d 20 32 2e 32 20 6d 69 6e 75 74 65 000 = 2.2 minute
0b60: 73 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 64 s. (if (and d
0b70: 62 65 78 69 73 74 73 0a 09 20 20 20 20 20 28 6e bexists.. (n
0b80: 6f 74 20 77 72 69 74 65 2d 61 63 63 65 73 73 29 ot write-access)
0b90: 29 0a 09 28 73 65 74 21 20 2a 64 62 2d 77 72 69 )..(set! *db-wri
0ba0: 74 65 2d 61 63 63 65 73 73 2a 20 77 72 69 74 65 te-access* write
0bb0: 2d 61 63 63 65 73 73 29 29 20 3b 3b 20 6f 6e 6c -access)) ;; onl
0bc0: 79 20 75 6e 73 65 74 20 73 6f 20 6f 74 68 65 72 y unset so other
0bd0: 20 64 62 27 73 20 61 6c 73 6f 20 63 61 6e 20 75 db's also can u
0be0: 73 65 20 74 68 69 73 20 63 6f 6e 74 72 6f 6c 0a se this control.
0bf0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0c00: 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 64 -info 11 "open-d
0c10: 62 2c 20 64 62 70 61 74 68 3d 22 20 64 62 70 61 b, dbpath=" dbpa
0c20: 74 68 20 22 20 61 72 67 76 3d 22 20 28 61 72 67 th " argv=" (arg
0c30: 76 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 v)). (sqlite3
0c40: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 :set-busy-handle
0c50: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 r! db handler).
0c60: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 (if (not dbex
0c70: 69 73 74 73 29 0a 09 28 64 62 3a 69 6e 69 74 69 ists)..(db:initi
0c80: 61 6c 69 7a 65 20 64 62 29 29 0a 20 20 20 20 28 alize db)). (
0c90: 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a db:set-sync db).
0ca0: 20 20 20 20 64 62 29 29 0a 0a 3b 3b 20 6b 65 65 db))..;; kee
0cb0: 70 69 6e 67 20 69 74 20 61 72 6f 75 6e 64 20 66 ping it around f
0cc0: 6f 72 20 64 65 62 75 67 67 69 6e 67 20 70 75 72 or debugging pur
0cd0: 70 6f 73 65 73 20 6f 6e 6c 79 0a 28 64 65 66 69 poses only.(defi
0ce0: 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ne (open-run-clo
0cf0: 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d se-no-exception-
0d00: 68 61 6e 64 6c 69 6e 67 20 20 70 72 6f 63 20 69 handling proc i
0d10: 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 db . params). (
0d20: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
0d30: 20 31 31 20 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 11 "open-run-cl
0d40: 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e ose-no-exception
0d50: 2d 68 61 6e 64 6c 69 6e 67 20 53 54 41 52 54 20 -handling START
0d60: 67 69 76 65 6e 20 61 20 64 62 3d 22 20 28 69 66 given a db=" (if
0d70: 20 69 64 62 20 22 79 65 73 20 22 20 22 6e 6f 20 idb "yes " "no
0d80: 22 29 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 ") ", params=" p
0d90: 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 arams). (let* (
0da0: 28 64 62 20 20 20 28 69 66 20 69 64 62 20 0a 09 (db (if idb ..
0db0: 09 20 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 . (if (procedu
0dc0: 72 65 3f 20 69 64 62 29 0a 09 09 20 20 20 20 20 re? idb)...
0dd0: 20 20 28 69 64 62 29 0a 09 09 20 20 20 20 20 20 (idb)...
0de0: 20 69 64 62 29 0a 09 09 20 20 20 28 6f 70 65 6e idb)... (open
0df0: 2d 64 62 29 29 29 0a 09 20 28 72 65 73 20 23 66 -db))).. (res #f
0e00: 29 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 )). (set! res
0e10: 20 28 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 (apply proc db
0e20: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 params)). (if
0e30: 20 28 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 (not idb)(sqlit
0e40: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
0e50: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
0e60: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e nt-info 11 "open
0e70: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 -run-close-no-ex
0e80: 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 ception-handling
0e90: 20 45 4e 44 22 20 29 0a 20 20 20 20 72 65 73 29 END" ). res)
0ea0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e )..(define (open
0eb0: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70 -run-close-excep
0ec0: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 tion-handling pr
0ed0: 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 oc idb . params)
0ee0: 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
0ef0: 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 tions. exn.
0f00: 28 62 65 67 69 6e 0a 20 20 20 20 20 28 64 65 62 (begin. (deb
0f10: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 58 43 45 ug:print 0 "EXCE
0f20: 50 54 49 4f 4e 3a 20 64 61 74 61 62 61 73 65 20 PTION: database
0f30: 70 72 6f 62 61 62 6c 79 20 6f 76 65 72 6c 6f 61 probably overloa
0f40: 64 65 64 3f 22 29 0a 20 20 20 20 20 28 64 65 62 ded?"). (deb
0f50: 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20 22 20 ug:print 0 " "
0f60: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
0f70: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
0f80: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
0f90: 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74 2d 63 )). (print-c
0fa0: 61 6c 6c 2d 63 68 61 69 6e 29 0a 20 20 20 20 20 all-chain).
0fb0: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 (thread-sleep! (
0fc0: 72 61 6e 64 6f 6d 20 31 32 30 29 29 0a 20 20 20 random 120)).
0fd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
0fe0: 6e 66 6f 20 30 20 22 74 72 79 69 6e 67 20 64 62 nfo 0 "trying db
0ff0: 20 63 61 6c 6c 20 6f 6e 65 20 6d 6f 72 65 20 74 call one more t
1000: 69 6d 65 2e 2e 2e 2e 22 29 0a 20 20 20 20 20 28 ime...."). (
1010: 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d 63 apply open-run-c
1020: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f lose-no-exceptio
1030: 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 20 n-handling proc
1040: 69 64 62 20 70 61 72 61 6d 73 29 29 0a 20 20 20 idb params)).
1050: 28 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d (apply open-run-
1060: 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 close-no-excepti
1070: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 on-handling proc
1080: 20 69 64 62 20 70 61 72 61 6d 73 29 29 29 0a 0a idb params)))..
1090: 3b 3b 20 28 64 65 66 69 6e 65 20 6f 70 65 6e 2d ;; (define open-
10a0: 72 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 run-close open-r
10b0: 75 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70 74 69 un-close-excepti
10c0: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 0a 28 64 65 on-handling).(de
10d0: 66 69 6e 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c fine open-run-cl
10e0: 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ose open-run-clo
10f0: 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d se-no-exception-
1100: 68 61 6e 64 6c 69 6e 67 29 0a 0a 28 64 65 66 69 handling)..(defi
1110: 6e 65 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 ne *global-delta
1120: 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 * 0).(define *la
1130: 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d st-global-delta-
1140: 70 72 69 6e 74 65 64 2a 20 30 29 0a 0a 28 64 65 printed* 0)..(de
1150: 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 fine (open-run-c
1160: 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 20 70 72 lose-measure pr
1170: 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 oc idb . params)
1180: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
1190: 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 75 info 11 "open-ru
11a0: 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 n-close-measure
11b0: 53 54 41 52 54 2c 20 69 64 62 3d 22 20 69 64 62 START, idb=" idb
11c0: 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 ", params=" par
11d0: 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 ams). (let* ((s
11e0: 74 61 72 74 2d 6d 73 20 28 63 75 72 72 65 6e 74 tart-ms (current
11f0: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a -milliseconds)).
1200: 09 20 28 64 62 20 20 20 20 20 20 20 28 69 66 20 . (db (if
1210: 69 64 62 20 69 64 62 20 28 6f 70 65 6e 2d 64 62 idb idb (open-db
1220: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 68 ))). (th
1230: 72 6f 74 74 6c 65 20 28 73 74 72 69 6e 67 2d 3e rottle (string->
1240: 6e 75 6d 62 65 72 20 28 63 6f 6e 66 69 67 2d 6c number (config-l
1250: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
1260: 2a 20 22 73 65 74 75 70 22 20 22 74 68 72 6f 74 * "setup" "throt
1270: 74 6c 65 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 tle")))). ;;
1280: 28 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 (db:set-sync db)
1290: 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 20 20 . (set! res
12a0: 20 20 20 20 28 61 70 70 6c 79 20 70 72 6f 63 20 (apply proc
12b0: 64 62 20 70 61 72 61 6d 73 29 29 0a 20 20 20 20 db params)).
12c0: 28 69 66 20 28 6e 6f 74 20 69 64 62 29 28 73 71 (if (not idb)(sq
12d0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
12e0: 64 62 29 29 0a 20 20 20 20 3b 3b 20 73 63 61 6c db)). ;; scal
12f0: 65 20 62 79 20 31 30 2c 20 61 76 65 72 61 67 65 e by 10, average
1300: 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 76 61 with current va
1310: 6c 75 65 2e 0a 20 20 20 20 28 73 65 74 21 20 2a lue.. (set! *
1320: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2f global-delta* (/
1330: 20 28 2b 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 (+ *global-delt
1340: 61 2a 20 28 2a 20 28 2d 20 28 63 75 72 72 65 6e a* (* (- (curren
1350: 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 t-milliseconds)
1360: 73 74 61 72 74 2d 6d 73 29 0a 09 09 09 09 09 09 start-ms).......
1370: 20 28 69 66 20 74 68 72 6f 74 74 6c 65 20 74 68 (if throttle th
1380: 72 6f 74 74 6c 65 20 30 2e 30 31 29 29 29 0a 09 rottle 0.01)))..
1390: 09 09 20 20 20 20 32 29 29 0a 20 20 20 20 28 69 .. 2)). (i
13a0: 66 20 28 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 f (> (abs (- *la
13b0: 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d st-global-delta-
13c0: 70 72 69 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c printed* *global
13d0: 2d 64 65 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 -delta*)) 0.08)
13e0: 3b 3b 20 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 ;; don't print a
13f0: 6c 6c 20 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c ll the time, onl
1400: 79 20 69 66 20 69 74 20 63 68 61 6e 67 65 73 20 y if it changes
1410: 61 20 62 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 a bit..(begin..
1420: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1430: 66 6f 20 31 20 22 6c 61 75 6e 63 68 20 74 68 72 fo 1 "launch thr
1440: 6f 74 74 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a ottle factor=" *
1450: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 global-delta*)..
1460: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c (set! *last-gl
1470: 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 obal-delta-print
1480: 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 ed* *global-delt
1490: 61 2a 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 a*))). (debug
14a0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
14b0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6d open-run-close-m
14c0: 65 61 73 75 72 65 20 45 4e 44 22 20 29 0a 20 20 easure END" ).
14d0: 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 res))..(define
14e0: 20 28 64 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 (db:initialize
14f0: 64 62 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 db). (debug:pri
1500: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 69 nt-info 11 "db:i
1510: 6e 69 74 69 61 6c 69 7a 65 20 53 54 41 52 54 22 nitialize START"
1520: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 ). (let* ((conf
1530: 69 67 64 61 74 20 28 63 61 72 20 2a 63 6f 6e 66 igdat (car *conf
1540: 69 67 69 6e 66 6f 2a 29 29 20 20 3b 3b 20 74 75 iginfo*)) ;; tu
1550: 74 20 74 75 74 2c 20 67 6c 6f 62 61 6c 20 77 61 t tut, global wa
1560: 72 6e 69 6e 67 2e 2e 2e 0a 09 20 28 6b 65 79 73 rning..... (keys
1570: 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 67 65 74 (config-get
1580: 2d 66 69 65 6c 64 73 20 63 6f 6e 66 69 67 64 61 -fields configda
1590: 74 29 29 0a 09 20 28 68 61 76 65 6b 65 79 73 20 t)).. (havekeys
15a0: 28 3e 20 28 6c 65 6e 67 74 68 20 6b 65 79 73 29 (> (length keys)
15b0: 20 30 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 0)).. (keystr
15c0: 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b (keys->keystr k
15d0: 65 79 73 29 29 0a 09 20 28 66 69 65 6c 64 73 74 eys)).. (fieldst
15e0: 72 20 28 6b 65 79 73 2d 3e 6b 65 79 2f 66 69 65 r (keys->key/fie
15f0: 6c 64 20 6b 65 79 73 29 29 29 0a 20 20 20 20 28 ld keys))). (
1600: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
1610: 20 28 6b 65 79 29 0a 09 09 28 6c 65 74 20 28 28 (key)...(let ((
1620: 6b 65 79 6e 20 28 76 65 63 74 6f 72 2d 72 65 66 keyn (vector-ref
1630: 20 6b 65 79 20 30 29 29 29 0a 09 09 20 20 28 69 key 0)))... (i
1640: 66 20 28 6d 65 6d 62 65 72 20 28 73 74 72 69 6e f (member (strin
1650: 67 2d 64 6f 77 6e 63 61 73 65 20 6b 65 79 6e 29 g-downcase keyn)
1660: 0a 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
1670: 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 "runname" "state
1680: 22 20 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 " "status" "owne
1690: 72 22 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 r" "event_time"
16a0: 22 63 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f "comment" "fail_
16b0: 63 6f 75 6e 74 22 0a 09 09 09 09 20 20 20 20 22 count"..... "
16c0: 70 61 73 73 5f 63 6f 75 6e 74 22 29 29 0a 09 09 pass_count"))...
16d0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
16e0: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 79 (print "ERROR: y
16f0: 6f 75 72 20 6b 65 79 20 63 61 6e 6e 6f 74 20 62 our key cannot b
1700: 65 20 6e 61 6d 65 64 20 22 20 6b 65 79 6e 20 22 e named " keyn "
1710: 20 61 73 20 74 68 69 73 20 63 6f 6e 66 6c 69 63 as this conflic
1720: 74 73 20 77 69 74 68 20 74 68 65 20 73 61 6d 65 ts with the same
1730: 20 6e 61 6d 65 64 20 66 69 65 6c 64 20 69 6e 20 named field in
1740: 74 68 65 20 72 75 6e 73 20 74 61 62 6c 65 22 29 the runs table")
1750: 0a 09 09 09 28 73 79 73 74 65 6d 20 28 63 6f 6e ....(system (con
1760: 63 20 22 72 6d 20 2d 66 20 22 20 64 62 70 61 74 c "rm -f " dbpat
1770: 68 29 29 0a 09 09 09 28 65 78 69 74 20 31 29 29 h))....(exit 1))
1780: 29 29 29 0a 09 20 20 20 20 20 20 6b 65 79 73 29 ))).. keys)
1790: 0a 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 . ;; (sqlite3
17a0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 50 52 41 :execute db "PRA
17b0: 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 GMA synchronous
17c0: 3d 20 4f 46 46 3b 22 29 0a 20 20 20 20 28 64 62 = OFF;"). (db
17d0: 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 :set-sync db).
17e0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
17f0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
1800: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
1810: 53 20 6b 65 79 73 20 28 69 64 20 49 4e 54 45 47 S keys (id INTEG
1820: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 ER PRIMARY KEY,
1830: 66 69 65 6c 64 6e 61 6d 65 20 54 45 58 54 2c 20 fieldname TEXT,
1840: 66 69 65 6c 64 74 79 70 65 20 54 45 58 54 2c 20 fieldtype TEXT,
1850: 43 4f 4e 53 54 52 41 49 4e 54 20 6b 65 79 63 6f CONSTRAINT keyco
1860: 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 nstraint UNIQUE
1870: 28 66 69 65 6c 64 6e 61 6d 65 29 29 3b 22 29 0a (fieldname));").
1880: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c (for-each (l
1890: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 28 73 ambda (key)...(s
18a0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
18b0: 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 6b b "INSERT INTO k
18c0: 65 79 73 20 28 66 69 65 6c 64 6e 61 6d 65 2c 66 eys (fieldname,f
18d0: 69 65 6c 64 74 79 70 65 29 20 56 41 4c 55 45 53 ieldtype) VALUES
18e0: 20 28 3f 2c 3f 29 3b 22 20 28 6b 65 79 3a 67 65 (?,?);" (key:ge
18f0: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 t-fieldname key)
1900: 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 74 79 (key:get-fieldty
1910: 70 65 20 6b 65 79 29 29 29 0a 09 20 20 20 20 20 pe key)))..
1920: 20 6b 65 79 73 29 0a 20 20 20 20 28 73 71 6c 69 keys). (sqli
1930: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 28 te3:execute db (
1940: 63 6f 6e 63 20 0a 09 09 09 20 22 43 52 45 41 54 conc .... "CREAT
1950: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
1960: 58 49 53 54 53 20 72 75 6e 73 20 28 69 64 20 49 XISTS runs (id I
1970: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
1980: 45 59 2c 20 22 20 0a 09 09 09 20 66 69 65 6c 64 EY, " .... field
1990: 73 74 72 20 28 69 66 20 68 61 76 65 6b 65 79 73 str (if havekeys
19a0: 20 22 2c 22 20 22 22 29 0a 09 09 09 20 22 72 75 "," "").... "ru
19b0: 6e 6e 61 6d 65 20 54 45 58 54 2c 22 0a 09 09 09 nname TEXT,"....
19c0: 20 22 73 74 61 74 65 20 54 45 58 54 20 44 45 46 "state TEXT DEF
19d0: 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 73 AULT '',".... "s
19e0: 74 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 tatus TEXT DEFAU
19f0: 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 6f 77 6e LT '',".... "own
1a00: 65 72 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 er TEXT DEFAULT
1a10: 27 27 2c 22 0a 09 09 09 20 22 65 76 65 6e 74 5f '',".... "event_
1a20: 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 22 time TIMESTAMP,"
1a30: 0a 09 09 09 20 22 63 6f 6d 6d 65 6e 74 20 54 45 .... "comment TE
1a40: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 22 0a XT DEFAULT '',".
1a50: 09 09 09 20 22 66 61 69 6c 5f 63 6f 75 6e 74 20 ... "fail_count
1a60: 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 INTEGER DEFAULT
1a70: 30 2c 22 0a 09 09 09 20 22 70 61 73 73 5f 63 6f 0,".... "pass_co
1a80: 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45 46 41 unt INTEGER DEFA
1a90: 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 43 4f 4e ULT 0,".... "CON
1aa0: 53 54 52 41 49 4e 54 20 72 75 6e 73 63 6f 6e 73 STRAINT runscons
1ab0: 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 72 traint UNIQUE (r
1ac0: 75 6e 6e 61 6d 65 22 20 28 69 66 20 68 61 76 65 unname" (if have
1ad0: 6b 65 79 73 20 22 2c 22 20 22 22 29 20 6b 65 79 keys "," "") key
1ae0: 73 74 72 20 22 29 29 3b 22 29 29 0a 20 20 20 20 str "));")).
1af0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1b00: 20 64 62 20 28 63 6f 6e 63 20 22 43 52 45 41 54 db (conc "CREAT
1b10: 45 20 49 4e 44 45 58 20 72 75 6e 73 5f 69 6e 64 E INDEX runs_ind
1b20: 65 78 20 4f 4e 20 72 75 6e 73 20 28 72 75 6e 6e ex ON runs (runn
1b30: 61 6d 65 22 20 28 69 66 20 68 61 76 65 6b 65 79 ame" (if havekey
1b40: 73 20 22 2c 22 20 22 22 29 20 6b 65 79 73 74 72 s "," "") keystr
1b50: 20 22 29 3b 22 29 29 0a 20 20 20 20 28 73 71 6c ");")). (sql
1b60: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
1b70: 0a 09 09 20 20 20 20 20 22 43 52 45 41 54 45 20 ... "CREATE
1b80: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
1b90: 53 54 53 20 74 65 73 74 73 20 0a 20 20 20 20 20 STS tests .
1ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1bb0: 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 id INTEGER PRIMA
1bc0: 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 RY KEY,.
1bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
1be0: 5f 69 64 20 20 20 20 20 49 4e 54 45 47 45 52 2c _id INTEGER,
1bf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c00: 20 20 20 20 20 20 74 65 73 74 6e 61 6d 65 20 20 testname
1c10: 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 TEXT,.
1c20: 20 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 host
1c30: 20 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 TEXT DEFA
1c40: 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 ULT 'n/a',.
1c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c60: 63 70 75 6c 6f 61 64 20 20 20 20 52 45 41 4c 20 cpuload REAL
1c70: 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 DEFAULT -1,.
1c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c90: 20 64 69 73 6b 66 72 65 65 20 20 20 49 4e 54 45 diskfree INTE
1ca0: 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a GER DEFAULT -1,.
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cc0: 20 20 20 20 20 75 6e 61 6d 65 20 20 20 20 20 20 uname
1cd0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f TEXT DEFAULT 'n/
1ce0: 61 27 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 a', .
1cf0: 20 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 rundir
1d00: 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c TEXT DEFAUL
1d10: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 68 sh
1d30: 6f 72 74 64 69 72 20 20 20 54 45 58 54 20 44 45 ortdir TEXT DE
1d40: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
1d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
1d60: 74 65 6d 5f 70 61 74 68 20 20 54 45 58 54 20 44 tem_path TEXT D
1d70: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d90: 73 74 61 74 65 20 20 20 20 20 20 54 45 58 54 20 state TEXT
1da0: 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 41 DEFAULT 'NOT_STA
1db0: 52 54 45 44 27 2c 0a 20 20 20 20 20 20 20 20 20 RTED',.
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 stat
1dd0: 75 73 20 20 20 20 20 54 45 58 54 20 44 45 46 41 us TEXT DEFA
1de0: 55 4c 54 20 27 46 41 49 4c 27 2c 0a 20 20 20 20 ULT 'FAIL',.
1df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e00: 20 61 74 74 65 6d 70 74 6e 75 6d 20 49 4e 54 45 attemptnum INTE
1e10: 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 GER DEFAULT 0,.
1e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e30: 20 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 54 final_logf T
1e40: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6c 6f 67 EXT DEFAULT 'log
1e50: 73 2f 66 69 6e 61 6c 2e 6c 6f 67 27 2c 0a 20 20 s/final.log',.
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 20 20 6c 6f 67 64 61 74 20 20 20 20 20 42 4c logdat BL
1e80: 4f 42 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 OB, .
1e90: 20 20 20 20 20 20 20 20 20 20 72 75 6e 5f 64 75 run_du
1ea0: 72 61 74 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 ration INTEGER D
1eb0: 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 EFAULT 0,.
1ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
1ed0: 6f 6d 6d 65 6e 74 20 20 20 20 54 45 58 54 20 44 omment TEXT D
1ee0: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
1ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f00: 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 event_time TIMES
1f10: 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 TAMP,.
1f20: 20 20 20 20 20 20 20 20 20 20 20 66 61 69 6c 5f fail_
1f30: 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45 count INTEGER DE
1f40: 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 FAULT 0,.
1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 pa
1f60: 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 ss_count INTEGER
1f70: 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 DEFAULT 0,.
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 61 72 63 68 69 76 65 64 20 20 20 49 4e 54 45 archived INTE
1fa0: 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c 20 2d GER DEFAULT 0, -
1fb0: 2d 20 30 3d 6e 6f 2c 20 31 3d 69 6e 20 70 72 6f - 0=no, 1=in pro
1fc0: 67 72 65 73 73 2c 20 32 3d 79 65 73 0a 20 20 20 gress, 2=yes.
1fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe0: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 CONSTRAINT tes
1ff0: 74 73 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 tsconstraint UNI
2000: 51 55 45 20 28 72 75 6e 5f 69 64 2c 20 74 65 73 QUE (run_id, tes
2010: 74 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 61 74 68 tname, item_path
2020: 29 0a 20 20 20 20 20 20 20 20 20 20 29 3b 22 29 ). );")
2030: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
2040: 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 ecute db "CREATE
2050: 20 49 4e 44 45 58 20 74 65 73 74 73 5f 69 6e 64 INDEX tests_ind
2060: 65 78 20 4f 4e 20 74 65 73 74 73 20 28 72 75 6e ex ON tests (run
2070: 5f 69 64 2c 20 74 65 73 74 6e 61 6d 65 2c 20 69 _id, testname, i
2080: 74 65 6d 5f 70 61 74 68 29 3b 22 29 0a 20 20 20 tem_path);").
2090: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
20a0: 65 20 64 62 20 22 43 52 45 41 54 45 20 56 49 45 e db "CREATE VIE
20b0: 57 20 72 75 6e 73 5f 74 65 73 74 73 20 41 53 20 W runs_tests AS
20c0: 53 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 72 75 SELECT * FROM ru
20d0: 6e 73 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 ns INNER JOIN te
20e0: 73 74 73 20 4f 4e 20 72 75 6e 73 2e 69 64 3d 74 sts ON runs.id=t
20f0: 65 73 74 73 2e 72 75 6e 5f 69 64 3b 22 29 0a 20 ests.run_id;").
2100: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
2110: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 ute db "CREATE T
2120: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
2130: 54 53 20 74 65 73 74 5f 73 74 65 70 73 20 0a 20 TS test_steps .
2140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 64 (id
2160: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
2170: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 74 65 73 74 5f 69 64 20 49 4e 54 test_id INT
21a0: 45 47 45 52 2c 20 0a 20 20 20 20 20 20 20 20 20 EGER, .
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21c0: 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 20 54 stepname T
21d0: 45 58 54 2c 20 0a 20 20 20 20 20 20 20 20 20 20 EXT, .
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 73 74 61 74 65 20 54 45 58 54 20 state TEXT
2200: 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 41 DEFAULT 'NOT_STA
2210: 52 54 45 44 27 2c 20 0a 20 20 20 20 20 20 20 20 RTED', .
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2230: 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 status TE
2240: 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 XT DEFAULT 'n/a'
2250: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 event_time TIME
2280: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 STAMP,.
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 comment TE
22b0: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f lo
22e0: 67 66 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 gfile TEXT DEFAU
22f0: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2310: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
2320: 20 74 65 73 74 5f 73 74 65 70 73 5f 63 6f 6e 73 test_steps_cons
2330: 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 traint UNIQUE (t
2340: 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c est_id,stepname,
2350: 73 74 61 74 65 29 29 3b 22 29 0a 20 20 20 20 28 state));"). (
2360: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
2370: 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 db "CREATE TABLE
2380: 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 65 IF NOT EXISTS e
2390: 78 74 72 61 64 61 74 20 28 69 64 20 49 4e 54 45 xtradat (id INTE
23a0: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
23b0: 20 72 75 6e 5f 69 64 20 49 4e 54 45 47 45 52 2c run_id INTEGER,
23c0: 20 6b 65 79 20 54 45 58 54 2c 20 76 61 6c 20 54 key TEXT, val T
23d0: 45 58 54 29 3b 22 29 0a 20 20 20 20 28 73 71 6c EXT);"). (sql
23e0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
23f0: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
2400: 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 NOT EXISTS meta
2410: 64 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 20 dat (id INTEGER
2420: 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 76 61 72 PRIMARY KEY, var
2430: 20 54 45 58 54 2c 20 76 61 6c 20 54 45 58 54 2c TEXT, val TEXT,
2440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2460: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 CONSTRAINT me
2470: 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 tadat_constraint
2480: 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 UNIQUE (var));"
2490: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
24a0: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
24b0: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
24c0: 58 49 53 54 53 20 61 63 63 65 73 73 5f 6c 6f 67 XISTS access_log
24d0: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
24e0: 4d 41 52 59 20 4b 45 59 2c 20 75 73 65 72 20 54 MARY KEY, user T
24f0: 45 58 54 2c 20 61 63 63 65 73 73 65 64 20 54 49 EXT, accessed TI
2500: 4d 45 53 54 41 4d 50 2c 20 61 72 67 73 20 54 45 MESTAMP, args TE
2510: 58 54 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 XT);"). (sqli
2520: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
2530: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
2540: 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f NOT EXISTS test_
2550: 6d 65 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 meta (id INTEGER
2560: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 PRIMARY KEY,.
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2590: 20 20 20 74 65 73 74 6e 61 6d 65 20 20 20 20 54 testname T
25a0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
25b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25d0: 20 20 20 20 20 61 75 74 68 6f 72 20 20 20 20 20 author
25e0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
25f0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
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 6f 77 6e 65 72 20 20 20 20 owner
2620: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
2630: 27 27 2c 0a 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 20 20
2650: 20 20 20 20 20 20 20 20 20 64 65 73 63 72 69 70 descrip
2660: 74 69 6f 6e 20 54 45 58 54 20 44 45 46 41 55 4c tion TEXT DEFAUL
2670: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
2680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2690: 20 20 20 20 20 20 20 20 20 20 20 72 65 76 69 65 revie
26a0: 77 65 64 20 20 20 20 54 49 4d 45 53 54 41 4d 50 wed TIMESTAMP
26b0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 20 20 20 69 74 65 72 61 74 65 64 20 iterated
26e0: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
26f0: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
2700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2710: 20 20 20 20 20 20 20 20 20 61 76 67 5f 72 75 6e avg_run
2720: 74 69 6d 65 20 52 45 41 4c 2c 0a 20 20 20 20 20 time REAL,.
2730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 61 76 67 5f 64 69 73 6b 20 20 20 20 52 45 41 4c avg_disk REAL
2760: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
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 74 61 67 73 20 20 20 20 20 tags
2790: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
27a0: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
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 20 20 6a 6f 62 67 72 6f 75 jobgrou
27d0: 70 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c p TEXT DEFAUL
27e0: 54 20 27 64 65 66 61 75 6c 74 27 2c 0a 20 20 20 T 'default',.
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
2810: 53 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 STRAINT test_met
2820: 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 a_constraint UNI
2830: 51 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b QUE (testname));
2840: 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a "). (sqlite3:
2850: 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 execute db "CREA
2860: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
2870: 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 EXISTS test_data
2880: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
2890: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b0: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
28c0: 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 d INTEGER,.
28d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28e0: 20 20 20 20 20 20 20 20 20 20 20 63 61 74 65 67 categ
28f0: 6f 72 79 20 54 45 58 54 20 44 45 46 41 55 4c 54 ory TEXT DEFAULT
2900: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
2910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2920: 20 20 20 20 20 76 61 72 69 61 62 6c 65 20 54 45 variable TE
2930: 58 54 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 XT,..
2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 6c val
2950: 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 ue REAL,..
2960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2970: 20 20 65 78 70 65 63 74 65 64 20 52 45 41 4c 2c expected REAL,
2980: 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
2990: 20 20 20 20 20 20 20 20 20 20 74 6f 6c 20 52 45 tol RE
29a0: 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 AL,.
29b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29c0: 20 20 20 20 75 6e 69 74 73 20 54 45 58 54 2c 0a units TEXT,.
29d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29f0: 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 comment TEXT DEF
2a00: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
2a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a20: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 status
2a30: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f TEXT DEFAULT 'n/
2a40: 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 a',.
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a60: 20 20 20 20 74 79 70 65 20 54 45 58 54 20 44 45 type TEXT DE
2a70: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
2a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a90: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 CONSTRAI
2aa0: 4e 54 20 74 65 73 74 5f 64 61 74 61 5f 63 6f 6e NT test_data_con
2ab0: 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 straint UNIQUE (
2ac0: 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 test_id,category
2ad0: 2c 76 61 72 69 61 62 6c 65 29 29 3b 22 29 0a 20 ,variable));").
2ae0: 20 20 20 3b 3b 20 4d 75 73 74 20 64 6f 20 74 68 ;; Must do th
2af0: 69 73 20 2a 61 66 74 65 72 2a 20 72 75 6e 6e 69 is *after* runni
2b00: 6e 67 20 70 61 74 63 68 20 64 62 20 21 21 20 4e ng patch db !! N
2b10: 6f 20 6d 6f 72 65 2e 20 0a 20 20 20 20 28 64 62 o more. . (db
2b20: 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 47 :set-var db "MEG
2b30: 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 6d ATEST_VERSION" m
2b40: 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 egatest-version)
2b50: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
2b60: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 69 6e t-info 11 "db:in
2b70: 69 74 69 61 6c 69 7a 65 20 45 4e 44 22 29 0a 20 itialize END").
2b80: 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ))..;;=======
2b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
2bd0: 3b 3b 20 54 20 45 20 53 20 54 20 20 20 53 20 50 ;; T E S T S P
2be0: 20 45 20 43 20 49 20 46 20 49 20 43 20 20 20 44 E C I F I C D
2bf0: 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d B .;;==========
2c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
2c40: 20 43 72 65 61 74 65 20 74 68 65 20 73 71 6c 69 Create the sqli
2c50: 74 65 20 64 62 20 66 6f 72 20 74 68 65 20 69 6e te db for the in
2c60: 64 69 76 69 64 75 61 6c 20 74 65 73 74 28 73 29 dividual test(s)
2c70: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 74 .(define (open-t
2c80: 65 73 74 2d 64 62 20 77 6f 72 6b 2d 61 72 65 61 est-db work-area
2c90: 29 20 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e ) . (debug:prin
2ca0: 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d t-info 11 "open-
2cb0: 74 65 73 74 2d 64 62 20 22 20 77 6f 72 6b 2d 61 test-db " work-a
2cc0: 72 65 61 29 0a 20 20 28 69 66 20 28 61 6e 64 20 rea). (if (and
2cd0: 77 6f 72 6b 2d 61 72 65 61 20 0a 09 20 20 20 28 work-area .. (
2ce0: 64 69 72 65 63 74 6f 72 79 3f 20 77 6f 72 6b 2d directory? work-
2cf0: 61 72 65 61 29 0a 09 20 20 20 28 66 69 6c 65 2d area).. (file-
2d00: 72 65 61 64 2d 61 63 63 65 73 73 3f 20 77 6f 72 read-access? wor
2d10: 6b 2d 61 72 65 61 29 29 0a 20 20 20 20 20 20 28 k-area)). (
2d20: 6c 65 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 let* ((dbpath
2d30: 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 (conc work-area
2d40: 20 22 2f 74 65 73 74 64 61 74 2e 64 62 22 29 29 "/testdat.db"))
2d50: 0a 09 20 20 20 20 20 28 64 62 65 78 69 73 74 73 .. (dbexists
2d60: 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 (file-exists?
2d70: 64 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 28 dbpath)).. (
2d80: 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d handler (make-
2d90: 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 28 69 66 busy-timeout (if
2da0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2db0: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
2dc0: 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 t")......
2dd0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
2de0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2df0: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2e00: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 "))......
2e10: 31 33 36 30 30 30 29 29 29 29 0a 09 28 68 61 6e 136000))))..(han
2e20: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
2e30: 20 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 exn.. (begin..
2e40: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
2e50: 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d "ERROR: problem
2e60: 20 61 63 63 65 73 73 69 6e 67 20 74 65 73 74 20 accessing test
2e70: 64 62 20 22 20 77 6f 72 6b 2d 61 72 65 61 20 22 db " work-area "
2e80: 2c 20 79 6f 75 20 70 72 6f 62 61 62 6c 79 20 73 , you probably s
2e90: 68 6f 75 6c 64 20 63 6c 65 61 6e 20 61 6e 64 20 hould clean and
2ea0: 72 65 2d 72 75 6e 20 74 68 69 73 20 74 65 73 74 re-run this test
2eb0: 22 0a 09 09 09 28 28 63 6f 6e 64 69 74 69 6f 6e "....((condition
2ec0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
2ed0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
2ee0: 29 20 65 78 6e 29 29 0a 09 20 20 20 23 66 29 0a ) exn)).. #f).
2ef0: 09 20 28 73 65 74 21 20 64 62 20 28 73 71 6c 69 . (set! db (sqli
2f00: 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 te3:open-databas
2f10: 65 20 64 62 70 61 74 68 29 29 29 0a 09 28 73 71 e dbpath)))..(sq
2f20: 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 lite3:set-busy-h
2f30: 61 6e 64 6c 65 72 21 20 64 62 20 68 61 6e 64 6c andler! db handl
2f40: 65 72 29 0a 09 28 69 66 20 28 6e 6f 74 20 64 62 er)..(if (not db
2f50: 65 78 69 73 74 73 29 0a 09 20 20 20 20 28 62 65 exists).. (be
2f60: 67 69 6e 0a 09 20 20 20 20 20 20 28 73 71 6c 69 gin.. (sqli
2f70: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
2f80: 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f PRAGMA synchrono
2f90: 75 73 20 3d 20 46 55 4c 4c 3b 22 29 0a 09 20 20 us = FULL;")..
2fa0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2fb0: 2d 69 6e 66 6f 20 31 31 20 22 49 6e 69 74 69 61 -info 11 "Initia
2fc0: 6c 69 7a 65 64 20 74 65 73 74 20 64 61 74 61 62 lized test datab
2fd0: 61 73 65 20 22 20 64 62 70 61 74 68 29 0a 09 20 ase " dbpath)..
2fe0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 64 62 2d (db:testdb-
2ff0: 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 29 29 initialize db)))
3000: 0a 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ..;; (sqlite3:ex
3010: 65 63 75 74 65 20 64 62 20 22 50 52 41 47 4d 41 ecute db "PRAGMA
3020: 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 30 synchronous = 0
3030: 3b 22 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e ;")..(debug:prin
3040: 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d t-info 11 "open-
3050: 74 65 73 74 2d 64 62 20 45 4e 44 20 28 73 75 63 test-db END (suc
3060: 65 73 73 66 75 6c 29 22 20 77 6f 72 6b 2d 61 72 essful)" work-ar
3070: 65 61 29 0a 09 3b 3b 20 6e 6f 77 20 6c 65 74 27 ea)..;; now let'
3080: 73 20 74 65 73 74 20 74 68 61 74 20 65 76 65 72 s test that ever
3090: 79 74 68 69 6e 67 20 69 73 20 63 6f 72 72 65 63 ything is correc
30a0: 74 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 t..(handle-excep
30b0: 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 tions.. exn.. (b
30c0: 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a egin.. (debug:
30d0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
30e0: 70 72 6f 62 6c 65 6d 20 61 63 63 65 73 73 69 6e problem accessin
30f0: 67 20 74 65 73 74 20 64 62 20 22 20 77 6f 72 6b g test db " work
3100: 2d 61 72 65 61 20 22 2c 20 79 6f 75 20 70 72 6f -area ", you pro
3110: 62 61 62 6c 79 20 73 68 6f 75 6c 64 20 63 6c 65 bably should cle
3120: 61 6e 20 61 6e 64 20 72 65 2d 72 75 6e 20 74 68 an and re-run th
3130: 69 73 20 74 65 73 74 22 0a 09 09 09 28 28 63 6f is test"....((co
3140: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
3150: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
3160: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
3170: 20 20 20 23 66 29 0a 09 20 3b 3b 20 49 73 20 74 #f).. ;; Is t
3180: 68 65 72 65 20 61 20 63 68 65 61 70 65 72 20 73 here a cheaper s
3190: 69 6e 67 6c 65 20 6c 69 6e 65 20 6f 70 65 72 61 ingle line opera
31a0: 74 69 6f 6e 20 74 68 61 74 20 77 69 6c 6c 20 63 tion that will c
31b0: 68 65 63 6b 20 66 6f 72 20 65 78 69 73 74 61 6e heck for existan
31c0: 63 65 20 6f 66 20 61 20 74 61 62 6c 65 0a 09 20 ce of a table..
31d0: 3b 3b 20 61 6e 64 20 72 61 69 73 65 20 61 6e 20 ;; and raise an
31e0: 65 78 63 65 70 74 69 6f 6e 20 3f 0a 09 20 28 73 exception ?.. (s
31f0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
3200: 62 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f b "SELECT id FRO
3210: 4d 20 74 65 73 74 5f 64 61 74 61 20 4c 49 4d 49 M test_data LIMI
3220: 54 20 31 3b 22 29 29 0a 09 64 62 29 0a 20 20 20 T 1;"))..db).
3230: 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 (begin..(debu
3240: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
3250: 22 6f 70 65 6e 2d 74 65 73 74 2d 64 62 20 45 4e "open-test-db EN
3260: 44 20 28 75 6e 73 75 63 65 73 73 66 75 6c 29 22 D (unsucessful)"
3270: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 23 66 29 work-area)..#f)
3280: 29 29 0a 0a 3b 3b 20 66 69 6e 64 20 61 6e 64 20 ))..;; find and
3290: 6f 70 65 6e 20 74 68 65 20 74 65 73 74 64 61 74 open the testdat
32a0: 2e 64 62 20 66 69 6c 65 20 66 6f 72 20 61 6e 20 .db file for an
32b0: 65 78 69 73 74 69 6e 67 20 74 65 73 74 0a 28 64 existing test.(d
32c0: 65 66 69 6e 65 20 28 64 62 3a 6f 70 65 6e 2d 74 efine (db:open-t
32d0: 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
32e0: 64 20 64 62 20 74 65 73 74 2d 69 64 20 23 21 6b d db test-id #!k
32f0: 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 ey (work-area #f
3300: 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 )). (let* ((tes
3310: 74 2d 70 61 74 68 20 28 69 66 20 77 6f 72 6b 2d t-path (if work-
3320: 61 72 65 61 0a 09 09 09 77 6f 72 6b 2d 61 72 65 area....work-are
3330: 61 0a 09 09 09 28 63 64 62 3a 72 65 6d 6f 74 65 a....(cdb:remote
3340: 2d 72 75 6e 20 64 62 3a 74 65 73 74 2d 67 65 74 -run db:test-get
3350: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
3360: 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 t-id db test-id)
3370: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
3380: 72 69 6e 74 20 33 20 22 54 45 53 54 20 50 41 54 rint 3 "TEST PAT
3390: 48 3a 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a H: " test-path).
33a0: 20 20 20 20 28 6f 70 65 6e 2d 74 65 73 74 2d 64 (open-test-d
33b0: 62 20 74 65 73 74 2d 70 61 74 68 29 29 29 0a 0a b test-path)))..
33c0: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
33d0: 64 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 db-initialize db
33e0: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
33f0: 20 31 31 20 22 64 62 3a 74 65 73 74 64 62 2d 69 11 "db:testdb-i
3400: 6e 69 74 69 61 6c 69 7a 65 20 53 54 41 52 54 22 nitialize START"
3410: 29 0a 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 ). (for-each.
3420: 20 28 6c 61 6d 62 64 61 20 28 73 71 6c 63 6d 64 (lambda (sqlcmd
3430: 29 0a 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a ). (sqlite3:
3440: 65 78 65 63 75 74 65 20 64 62 20 73 71 6c 63 6d execute db sqlcm
3450: 64 29 29 0a 20 20 20 28 6c 69 73 74 20 22 43 52 d)). (list "CR
3460: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
3470: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 72 75 T EXISTS test_ru
3480: 6e 64 61 74 20 28 0a 20 20 20 20 20 20 20 20 20 ndat (.
3490: 20 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 id INTEGER
34a0: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
34b0: 20 20 20 20 20 20 20 20 20 20 20 75 70 64 61 74 updat
34c0: 65 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 e_time TIMESTAMP
34d0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
34e0: 63 70 75 6c 6f 61 64 20 49 4e 54 45 47 45 52 20 cpuload INTEGER
34f0: 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 DEFAULT -1,.
3500: 20 20 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 diskfr
3510: 65 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 ee INTEGER DEFAU
3520: 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 LT -1,.
3530: 20 20 20 20 20 64 69 73 6b 75 73 61 67 65 20 49 diskusage I
3540: 4e 54 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31 NTGER DEFAULT -1
3550: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
3560: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 49 4e 54 run_duration INT
3570: 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 29 3b EGER DEFAULT 0);
3580: 22 0a 09 20 22 43 52 45 41 54 45 20 54 41 42 4c ".. "CREATE TABL
3590: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
35a0: 74 65 73 74 5f 64 61 74 61 20 28 0a 20 20 20 20 test_data (.
35b0: 20 20 20 20 20 20 20 20 20 20 69 64 20 49 4e 54 id INT
35c0: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 EGER PRIMARY KEY
35d0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
35e0: 74 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c test_id INTEGER,
35f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 . c
3600: 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 46 ategory TEXT DEF
3610: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
3620: 20 20 20 20 20 20 20 76 61 72 69 61 62 6c 65 20 variable
3630: 54 45 58 54 2c 0a 09 20 20 20 20 20 20 76 61 6c TEXT,.. val
3640: 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 ue REAL,..
3650: 65 78 70 65 63 74 65 64 20 52 45 41 4c 2c 0a 09 expected REAL,..
3660: 20 20 20 20 20 20 74 6f 6c 20 52 45 41 4c 2c 0a tol REAL,.
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 75 6e un
3680: 69 74 73 20 54 45 58 54 2c 0a 20 20 20 20 20 20 its TEXT,.
3690: 20 20 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 comment
36a0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
36b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 . s
36c0: 74 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 tatus TEXT DEFAU
36d0: 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 LT 'n/a',.
36e0: 20 20 20 20 20 20 20 20 74 79 70 65 20 54 45 58 type TEX
36f0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
3700: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
3710: 54 52 41 49 4e 54 20 74 65 73 74 5f 64 61 74 61 TRAINT test_data
3720: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
3730: 55 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 UE (test_id,cate
3740: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b gory,variable));
3750: 22 0a 09 20 22 43 52 45 41 54 45 20 54 41 42 4c ".. "CREATE TABL
3760: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
3770: 74 65 73 74 5f 73 74 65 70 73 20 28 0a 20 20 20 test_steps (.
3780: 20 20 20 20 20 20 20 20 20 20 20 69 64 20 49 4e id IN
3790: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
37a0: 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 Y,.
37b0: 20 74 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 test_id INTEGER
37c0: 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 , .
37d0: 20 73 74 65 70 6e 61 6d 65 20 54 45 58 54 2c 20 stepname TEXT,
37e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 . s
37f0: 74 61 74 65 20 54 45 58 54 20 44 45 46 41 55 4c tate TEXT DEFAUL
3800: 54 20 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c T 'NOT_STARTED',
3810: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3820: 73 74 61 74 75 73 20 54 45 58 54 20 44 45 46 41 status TEXT DEFA
3830: 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 ULT 'n/a',.
3840: 20 20 20 20 20 20 20 20 20 65 76 65 6e 74 5f 74 event_t
3850: 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 ime TIMESTAMP,.
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 6d com
3870: 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c ment TEXT DEFAUL
3880: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
3890: 20 20 20 20 6c 6f 67 66 69 6c 65 20 54 45 58 54 logfile TEXT
38a0: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
38b0: 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 CONST
38c0: 52 41 49 4e 54 20 74 65 73 74 5f 73 74 65 70 73 RAINT test_steps
38d0: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
38e0: 55 45 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 UE (test_id,step
38f0: 6e 61 6d 65 2c 73 74 61 74 65 29 29 3b 22 0a 09 name,state));"..
3900: 20 3b 3b 20 74 65 73 74 5f 6d 65 74 61 20 63 61 ;; test_meta ca
3910: 6e 20 62 65 20 75 73 65 64 20 66 6f 72 20 68 61 n be used for ha
3920: 6e 64 69 6e 67 20 63 6f 6d 6d 61 6e 64 73 20 74 nding commands t
3930: 6f 20 74 68 65 20 74 65 73 74 0a 09 20 3b 3b 20 o the test.. ;;
3940: 65 2e 67 2e 20 4b 49 4c 4c 52 45 51 0a 09 20 3b e.g. KILLREQ.. ;
3950: 3b 20 20 20 20 20 20 74 68 65 20 61 63 6b 73 74 ; the ackst
3960: 61 74 65 20 69 73 20 73 65 74 20 74 6f 20 31 20 ate is set to 1
3970: 6f 6e 63 65 20 74 68 65 20 63 6f 6d 6d 61 6e 64 once the command
3980: 20 68 61 73 20 62 65 65 6e 20 63 6f 6d 70 6c 65 has been comple
3990: 74 65 64 0a 09 20 22 43 52 45 41 54 45 20 54 41 ted.. "CREATE TA
39a0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
39b0: 53 20 74 65 73 74 5f 6d 65 74 61 20 28 0a 20 20 S test_meta (.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 69 64 20 49 id I
39d0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
39e0: 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 EY,.
39f0: 20 20 76 61 72 20 54 45 58 54 2c 0a 20 20 20 20 var TEXT,.
3a00: 20 20 20 20 20 20 20 20 20 20 76 61 6c 20 54 45 val TE
3a10: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 XT,.
3a20: 20 20 61 63 6b 73 74 61 74 65 20 49 4e 54 45 47 ackstate INTEG
3a30: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 ER DEFAULT 0,.
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
3a50: 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f 63 TRAINT metadat_c
3a60: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
3a70: 20 28 76 61 72 29 29 3b 22 29 29 0a 20 20 28 64 (var));")). (d
3a80: 65 62 75 67 3a 70 72 69 6e 74 20 31 31 20 22 64 ebug:print 11 "d
3a90: 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 69 61 6c b:testdb-initial
3aa0: 69 7a 65 20 45 4e 44 22 29 29 0a 0a 3b 3b 3d 3d ize END"))..;;==
3ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ae0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3af0: 3d 3d 3d 3d 0a 3b 3b 20 4c 20 4f 20 47 20 47 20 ====.;; L O G G
3b00: 49 20 4e 20 47 20 20 20 20 44 20 42 20 0a 3b 3b I N G D B .;;
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b50: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
3b60: 28 6f 70 65 6e 2d 6c 6f 67 67 69 6e 67 2d 64 62 (open-logging-db
3b70: 29 20 3b 3b 20 20 28 63 6f 6e 63 20 2a 74 6f 70 ) ;; (conc *top
3b80: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
3b90: 2e 64 62 22 29 20 28 63 61 72 20 2a 63 6f 6e 66 .db") (car *conf
3ba0: 69 67 69 6e 66 6f 2a 29 29 29 0a 20 20 28 6c 65 iginfo*))). (le
3bb0: 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 20 28 t* ((dbpath (
3bc0: 63 6f 6e 63 20 28 69 66 20 2a 74 6f 70 70 61 74 conc (if *toppat
3bd0: 68 2a 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 h* (conc *toppat
3be0: 68 2a 20 22 2f 22 29 20 22 22 29 20 22 6c 6f 67 h* "/") "") "log
3bf0: 67 69 6e 67 2e 64 62 22 29 29 20 3b 3b 20 66 6e ging.db")) ;; fn
3c00: 61 6d 65 29 0a 09 20 28 64 62 65 78 69 73 74 73 ame).. (dbexists
3c10: 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 (file-exists?
3c20: 64 62 70 61 74 68 29 29 0a 09 20 28 64 62 20 20 dbpath)).. (db
3c30: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f (sqlite3:o
3c40: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 pen-database dbp
3c50: 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d ath)) ;; (never-
3c60: 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 give-up-open-db
3c70: 64 62 70 61 74 68 29 29 0a 09 20 28 68 61 6e 64 dbpath)).. (hand
3c80: 6c 65 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 79 ler (make-busy
3c90: 2d 74 69 6d 65 6f 75 74 20 28 69 66 20 28 61 72 -timeout (if (ar
3ca0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 gs:get-arg "-ove
3cb0: 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 0a rride-timeout").
3cc0: 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d ..... (string-
3cd0: 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 >number (args:ge
3ce0: 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 t-arg "-override
3cf0: 2d 74 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 09 -timeout")).....
3d00: 09 20 20 20 31 33 36 30 30 30 29 29 29 29 20 3b . 136000)))) ;
3d10: 3b 20 31 33 36 30 30 30 29 29 29 0a 20 20 20 20 ; 136000))).
3d20: 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 (sqlite3:set-bus
3d30: 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 61 y-handler! db ha
3d40: 6e 64 6c 65 72 29 0a 20 20 20 20 28 69 66 20 28 ndler). (if (
3d50: 6e 6f 74 20 64 62 65 78 69 73 74 73 29 0a 09 28 not dbexists)..(
3d60: 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 begin.. (sqlite
3d70: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
3d80: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
3d90: 54 20 45 58 49 53 54 53 20 6c 6f 67 20 28 69 64 T EXISTS log (id
3da0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
3db0: 20 4b 45 59 2c 65 76 65 6e 74 5f 74 69 6d 65 20 KEY,event_time
3dc0: 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 55 4c TIMESTAMP DEFAUL
3dd0: 54 20 28 73 74 72 66 74 69 6d 65 28 27 25 73 27 T (strftime('%s'
3de0: 2c 27 6e 6f 77 27 29 29 2c 6c 6f 67 6c 69 6e 65 ,'now')),logline
3df0: 20 54 45 58 54 2c 70 77 64 20 54 45 58 54 2c 63 TEXT,pwd TEXT,c
3e00: 6d 64 6c 69 6e 65 20 54 45 58 54 2c 70 69 64 20 mdline TEXT,pid
3e10: 49 4e 54 45 47 45 52 29 3b 22 29 0a 09 20 20 28 INTEGER);").. (
3e20: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
3e30: 64 62 20 28 63 6f 6e 63 20 22 50 52 41 47 4d 41 db (conc "PRAGMA
3e40: 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 30 synchronous = 0
3e50: 3b 22 29 29 29 29 0a 20 20 20 20 64 62 29 29 0a ;")))). db)).
3e60: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 6c 6f 67 .(define (db:log
3e70: 2d 6c 6f 63 61 6c 2d 65 76 65 6e 74 20 2e 20 6c -local-event . l
3e80: 6f 67 6c 73 74 29 0a 20 20 28 6c 65 74 20 28 28 oglst). (let ((
3e90: 6c 6f 67 6c 69 6e 65 20 28 61 70 70 6c 79 20 63 logline (apply c
3ea0: 6f 6e 63 20 6c 6f 67 6c 73 74 29 29 0a 09 28 70 onc loglst))..(p
3eb0: 77 64 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d wd (current-
3ec0: 64 69 72 65 63 74 6f 72 79 29 29 0a 09 28 63 6d directory))..(cm
3ed0: 64 6c 69 6e 65 20 28 73 74 72 69 6e 67 2d 69 6e dline (string-in
3ee0: 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 tersperse (argv)
3ef0: 20 22 20 22 29 29 0a 09 28 70 69 64 20 20 20 20 " "))..(pid
3f00: 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 (current-proces
3f10: 73 2d 69 64 29 29 29 0a 20 20 20 20 28 64 62 3a s-id))). (db:
3f20: 6c 6f 67 2d 65 76 65 6e 74 20 6c 6f 67 6c 69 6e log-event loglin
3f30: 65 20 70 77 64 20 63 6d 64 6c 69 6e 65 20 70 69 e pwd cmdline pi
3f40: 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 d)))..(define (d
3f50: 62 3a 6c 6f 67 2d 65 76 65 6e 74 20 6c 6f 67 6c b:log-event logl
3f60: 69 6e 65 20 70 77 64 20 63 6d 64 6c 69 6e 65 20 ine pwd cmdline
3f70: 70 69 64 29 0a 20 20 28 6c 65 74 20 28 28 64 62 pid). (let ((db
3f80: 20 28 6f 70 65 6e 2d 6c 6f 67 67 69 6e 67 2d 64 (open-logging-d
3f90: 62 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 b))). (sqlite
3fa0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 4e 3:execute db "IN
3fb0: 53 45 52 54 20 49 4e 54 4f 20 6c 6f 67 20 28 6c SERT INTO log (l
3fc0: 6f 67 6c 69 6e 65 2c 70 77 64 2c 63 6d 64 6c 69 ogline,pwd,cmdli
3fd0: 6e 65 2c 70 69 64 29 20 56 41 4c 55 45 53 20 28 ne,pid) VALUES (
3fe0: 3f 2c 3f 2c 3f 2c 3f 29 3b 22 20 6c 6f 67 6c 69 ?,?,?,?);" logli
3ff0: 6e 65 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 ne (current-dire
4000: 63 74 6f 72 79 29 28 73 74 72 69 6e 67 2d 69 6e ctory)(string-in
4010: 74 65 72 73 70 65 72 73 65 20 28 61 72 67 76 29 tersperse (argv)
4020: 20 22 20 22 29 28 63 75 72 72 65 6e 74 2d 70 72 " ")(current-pr
4030: 6f 63 65 73 73 2d 69 64 29 29 0a 20 20 20 20 28 ocess-id)). (
4040: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
4050: 21 20 64 62 29 0a 20 20 20 20 6c 6f 67 6c 69 6e ! db). loglin
4060: 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d e))..;;=========
4070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
40a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
40b0: 20 54 4f 44 4f 3a 0a 3b 3b 20 20 20 70 75 74 20 TODO:.;; put
40c0: 64 65 6c 74 61 73 20 69 6e 74 6f 20 61 6e 20 61 deltas into an a
40d0: 73 73 6f 63 20 6c 69 73 74 20 77 69 74 68 20 76 ssoc list with v
40e0: 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 73 0a 3b ersion numbers.;
40f0: 3b 20 20 20 61 70 70 6c 79 20 61 6c 6c 20 66 72 ; apply all fr
4100: 6f 6d 20 6c 61 73 74 20 74 6f 20 63 75 72 72 65 om last to curre
4110: 6e 74 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d nt.;;===========
4120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 28 64 65 66 ===========.(def
4160: 69 6e 65 20 28 70 61 74 63 68 2d 64 62 20 64 62 ine (patch-db db
4170: 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 ). (handle-exce
4180: 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 ptions. exn.
4190: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 28 70 72 (begin. (pr
41a0: 69 6e 74 20 22 45 78 63 65 70 74 69 6f 6e 3a 20 int "Exception:
41b0: 22 20 65 78 6e 29 0a 20 20 20 20 20 28 70 72 69 " exn). (pri
41c0: 6e 74 20 22 45 52 52 4f 52 3a 20 50 6f 73 73 69 nt "ERROR: Possi
41d0: 62 6c 65 20 6f 75 74 20 6f 66 20 64 61 74 65 20 ble out of date
41e0: 73 63 68 65 6d 61 2c 20 61 74 74 65 6d 70 74 69 schema, attempti
41f0: 6e 67 20 74 6f 20 61 64 64 20 74 61 62 6c 65 20 ng to add table
4200: 6d 65 74 61 64 61 74 61 2e 2e 2e 22 29 0a 20 20 metadata...").
4210: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
4220: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 ute db "CREATE T
4230: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
4240: 54 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 TS metadat (id I
4250: 4e 54 45 47 45 52 2c 20 76 61 72 20 54 45 58 54 NTEGER, var TEXT
4260: 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 , val TEXT,.
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
4290: 53 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f STRAINT metadat_
42a0: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
42b0: 45 20 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 E (var));").
42c0: 20 28 69 66 20 28 6e 6f 74 20 28 64 62 3a 67 65 (if (not (db:ge
42d0: 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 t-var db "MEGATE
42e0: 53 54 5f 56 45 52 53 49 4f 4e 22 29 29 0a 09 20 ST_VERSION"))..
42f0: 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 (db:set-var db "
4300: 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e MEGATEST_VERSION
4310: 22 20 31 2e 31 37 29 29 29 0a 20 20 20 28 6c 65 " 1.17))). (le
4320: 74 20 28 28 6d 76 65 72 20 28 64 62 3a 67 65 74 t ((mver (db:get
4330: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
4340: 54 5f 56 45 52 53 49 4f 4e 22 29 29 0a 09 20 28 T_VERSION")).. (
4350: 74 65 73 74 2d 6d 65 74 61 2d 64 65 66 20 22 43 test-meta-def "C
4360: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
4370: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 6d OT EXISTS test_m
4380: 65 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 20 eta (id INTEGER
4390: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43c0: 20 20 74 65 73 74 6e 61 6d 65 20 20 20 20 54 45 testname TE
43d0: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 20 20 20 61 75 74 68 6f 72 20 20 20 20 20 20 author
4410: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
4420: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 6f 77 6e 65 72 20 20 20 20 20 owner
4450: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
4460: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4480: 20 20 20 20 20 20 20 20 64 65 73 63 72 69 70 74 descript
4490: 69 6f 6e 20 54 45 58 54 20 44 45 46 41 55 4c 54 ion TEXT DEFAULT
44a0: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44c0: 20 20 20 20 20 20 20 20 20 20 72 65 76 69 65 77 review
44d0: 65 64 20 20 20 20 54 49 4d 45 53 54 41 4d 50 2c ed TIMESTAMP,
44e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 20 20 20 20 69 74 65 72 61 74 65 64 20 20 iterated
4510: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
4520: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4540: 20 20 20 20 20 20 20 20 61 76 67 5f 72 75 6e 74 avg_runt
4550: 69 6d 65 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 ime REAL,.
4560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
4580: 76 67 5f 64 69 73 6b 20 20 20 20 52 45 41 4c 2c vg_disk REAL,
4590: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
45a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45b0: 20 20 20 20 20 20 74 61 67 73 20 20 20 20 20 20 tags
45c0: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
45d0: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45f0: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 CONSTRAINT te
4600: 73 74 5f 6d 65 74 61 5f 63 6f 6e 73 74 72 61 69 st_meta_constrai
4610: 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 6e nt UNIQUE (testn
4620: 61 6d 65 29 29 3b 22 29 29 0a 20 20 20 20 20 28 ame));")). (
4630: 70 72 69 6e 74 20 22 43 75 72 72 65 6e 74 20 73 print "Current s
4640: 63 68 65 6d 61 20 76 65 72 73 69 6f 6e 3a 20 22 chema version: "
4650: 20 6d 76 65 72 20 22 20 63 75 72 72 65 6e 74 20 mver " current
4660: 6d 65 67 61 74 65 73 74 20 76 65 72 73 69 6f 6e megatest version
4670: 3a 20 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 : " megatest-ver
4680: 73 69 6f 6e 29 0a 20 20 20 20 20 28 63 6f 6e 64 sion). (cond
4690: 0a 20 20 20 20 20 20 28 28 6e 6f 74 20 6d 76 65 . ((not mve
46a0: 72 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 r). (print
46b0: 20 22 41 64 64 69 6e 67 20 6d 65 67 61 74 65 73 "Adding megates
46c0: 74 2d 76 65 72 73 69 6f 6e 20 74 6f 20 6d 65 74 t-version to met
46d0: 61 64 61 74 61 22 29 20 3b 3b 20 4e 65 65 64 20 adata") ;; Need
46e0: 74 6f 20 72 65 63 72 65 61 74 65 20 74 68 65 20 to recreate the
46f0: 74 61 62 6c 65 0a 20 20 20 20 20 20 20 28 73 71 table. (sq
4700: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4710: 20 22 44 52 4f 50 20 54 41 42 4c 45 20 49 46 20 "DROP TABLE IF
4720: 45 58 49 53 54 53 20 6d 65 74 61 64 61 74 3b 22 EXISTS metadat;"
4730: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
4740: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
4750: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
4760: 54 20 45 58 49 53 54 53 20 6d 65 74 61 64 61 74 T EXISTS metadat
4770: 20 28 69 64 20 49 4e 54 45 47 45 52 2c 20 76 61 (id INTEGER, va
4780: 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45 58 54 r TEXT, val TEXT
4790: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47b0: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d CONSTRAINT m
47c0: 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e etadat_constrain
47d0: 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b t UNIQUE (var));
47e0: 22 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 "). (db:se
47f0: 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 t-var db "MEGATE
4800: 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 ST_VERSION" 1.17
4810: 29 0a 20 20 20 20 20 20 20 28 70 61 74 63 68 2d ). (patch-
4820: 64 62 29 29 0a 20 20 20 20 20 20 28 28 3c 20 6d db)). ((< m
4830: 76 65 72 20 31 2e 32 31 29 0a 20 20 20 20 20 20 ver 1.21).
4840: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4850: 65 20 64 62 20 22 44 52 4f 50 20 54 41 42 4c 45 e db "DROP TABLE
4860: 20 49 46 20 45 58 49 53 54 53 20 6d 65 74 61 64 IF EXISTS metad
4870: 61 74 3b 22 29 0a 20 20 20 20 20 20 20 28 73 71 at;"). (sq
4880: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4890: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 "CREATE TABLE I
48a0: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 F NOT EXISTS met
48b0: 61 64 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 adat (id INTEGER
48c0: 2c 20 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 , var TEXT, val
48d0: 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 TEXT,.
48e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48f0: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 CONSTRAI
4900: 4e 54 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 NT metadat_const
4910: 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 raint UNIQUE (va
4920: 72 29 29 3b 22 29 0a 20 20 20 20 20 20 20 28 64 r));"). (d
4930: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
4940: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
4950: 31 2e 32 31 29 20 3b 3b 20 73 65 74 20 62 65 66 1.21) ;; set bef
4960: 6f 72 65 2c 20 6a 75 73 74 20 69 6e 20 63 61 73 ore, just in cas
4970: 65 20 74 68 65 20 63 68 61 6e 67 65 73 20 61 72 e the changes ar
4980: 65 20 61 6c 72 65 61 64 79 20 61 70 70 6c 69 65 e already applie
4990: 64 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 d. (sqlite
49a0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 74 65 73 3:execute db tes
49b0: 74 2d 6d 65 74 61 2d 64 65 66 29 0a 09 09 09 09 t-meta-def).....
49c0: 09 3b 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 .;(for-each ....
49d0: 09 09 3b 20 28 6c 61 6d 62 64 61 20 28 73 74 6d ..; (lambda (stm
49e0: 74 29 0a 09 09 09 09 09 3b 20 20 20 28 73 71 6c t)......; (sql
49f0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
4a00: 73 74 6d 74 29 29 0a 09 09 09 09 09 3b 20 28 6c stmt))......; (l
4a10: 69 73 74 20 0a 09 09 09 09 09 3b 20 20 22 41 4c ist ......; "AL
4a20: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 TER TABLE tests
4a30: 41 44 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 ADD COLUMN first
4a40: 5f 65 72 72 20 54 45 58 54 3b 22 0a 09 09 09 09 _err TEXT;".....
4a50: 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 4c 45 .; "ALTER TABLE
4a60: 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c 55 4d tests ADD COLUM
4a70: 4e 20 66 69 72 73 74 5f 77 61 72 6e 20 54 45 58 N first_warn TEX
4a80: 54 3b 22 0a 09 09 09 09 09 3b 20 20 29 29 0a 20 T;"......; )).
4a90: 20 20 20 20 20 20 28 70 61 74 63 68 2d 64 62 29 (patch-db)
4aa0: 29 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 ). ((< mver
4ab0: 20 31 2e 32 34 29 0a 20 20 20 20 20 20 20 28 64 1.24). (d
4ac0: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
4ad0: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
4ae0: 31 2e 32 34 29 0a 20 20 20 20 20 20 20 28 73 71 1.24). (sq
4af0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4b00: 20 22 44 52 4f 50 20 54 41 42 4c 45 20 49 46 20 "DROP TABLE IF
4b10: 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 EXISTS test_data
4b20: 3b 22 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 ;"). (sqli
4b30: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
4b40: 44 52 4f 50 20 54 41 42 4c 45 20 49 46 20 45 58 DROP TABLE IF EX
4b50: 49 53 54 53 20 74 65 73 74 5f 6d 65 74 61 3b 22 ISTS test_meta;"
4b60: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
4b70: 33 3a 65 78 65 63 75 74 65 20 64 62 20 74 65 73 3:execute db tes
4b80: 74 2d 6d 65 74 61 2d 64 65 66 29 0a 20 20 20 20 t-meta-def).
4b90: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
4ba0: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 ute db "CREATE T
4bb0: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
4bc0: 54 53 20 74 65 73 74 5f 64 61 74 61 20 28 69 64 TS test_data (id
4bd0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
4be0: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c00: 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 49 4e test_id IN
4c10: 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 20 TEGER,.
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c30: 20 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 20 category
4c40: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
4c50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c70: 20 76 61 72 69 61 62 6c 65 20 54 45 58 54 2c 0a variable TEXT,.
4c80: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4c90: 20 20 20 20 20 20 20 20 20 76 61 6c 75 65 20 52 value R
4ca0: 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 20 EAL,..
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 65 78 ex
4cc0: 70 65 63 74 65 64 20 52 45 41 4c 2c 0a 09 20 20 pected REAL,..
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 20 20 20 20 74 6f 6c 20 52 45 41 4c 2c 0a tol REAL,.
4cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d10: 75 6e 69 74 73 20 54 45 58 54 2c 0a 20 20 20 20 units TEXT,.
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d30: 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 6d 6d comm
4d40: 65 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c 54 ent TEXT DEFAULT
4d50: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d70: 20 20 20 20 20 73 74 61 74 75 73 20 54 45 58 54 status TEXT
4d80: 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a DEFAULT 'n/a',.
4d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f CO
4db0: 4e 53 54 52 41 49 4e 54 20 74 65 73 74 5f 64 61 NSTRAINT test_da
4dc0: 74 61 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f ta UNIQUE (test_
4dd0: 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 id,category,vari
4de0: 61 62 6c 65 29 29 3b 22 29 0a 20 20 20 20 20 20 able));").
4df0: 20 28 70 72 69 6e 74 20 22 57 41 52 4e 49 4e 47 (print "WARNING
4e00: 3a 20 54 61 62 6c 65 20 74 65 73 74 5f 64 61 74 : Table test_dat
4e10: 61 20 61 6e 64 20 74 65 73 74 5f 6d 65 74 61 20 a and test_meta
4e20: 77 65 72 65 20 72 65 63 72 65 61 74 65 64 2e 20 were recreated.
4e30: 50 6c 65 61 73 65 20 64 6f 20 6d 65 67 61 74 65 Please do megate
4e40: 73 74 20 2d 75 70 64 61 74 65 2d 6d 65 74 61 22 st -update-meta"
4e50: 29 0a 20 20 20 20 20 20 20 28 70 61 74 63 68 2d ). (patch-
4e60: 64 62 29 29 0a 20 20 20 20 20 20 28 28 3c 20 6d db)). ((< m
4e70: 76 65 72 20 31 2e 32 37 29 0a 20 20 20 20 20 20 ver 1.27).
4e80: 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 (db:set-var db
4e90: 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f "MEGATEST_VERSIO
4ea0: 4e 22 20 31 2e 32 37 29 0a 20 20 20 20 20 20 20 N" 1.27).
4eb0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
4ec0: 20 64 62 20 22 41 4c 54 45 52 20 54 41 42 4c 45 db "ALTER TABLE
4ed0: 20 74 65 73 74 5f 64 61 74 61 20 41 44 44 20 43 test_data ADD C
4ee0: 4f 4c 55 4d 4e 20 74 79 70 65 20 54 45 58 54 20 OLUMN type TEXT
4ef0: 44 45 46 41 55 4c 54 20 27 27 3b 22 29 0a 20 20 DEFAULT '';").
4f00: 20 20 20 20 20 28 70 61 74 63 68 2d 64 62 29 29 (patch-db))
4f10: 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20 . ((< mver
4f20: 31 2e 32 39 29 0a 20 20 20 20 20 20 20 28 64 62 1.29). (db
4f30: 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 47 :set-var db "MEG
4f40: 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 ATEST_VERSION" 1
4f50: 2e 32 39 29 0a 20 20 20 20 20 20 20 28 73 71 6c .29). (sql
4f60: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
4f70: 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 73 "ALTER TABLE tes
4f80: 74 5f 73 74 65 70 73 20 41 44 44 20 43 4f 4c 55 t_steps ADD COLU
4f90: 4d 4e 20 6c 6f 67 66 69 6c 65 20 54 45 58 54 20 MN logfile TEXT
4fa0: 44 45 46 41 55 4c 54 20 27 27 3b 22 29 0a 20 20 DEFAULT '';").
4fb0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
4fc0: 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 ecute db "ALTER
4fd0: 54 41 42 4c 45 20 74 65 73 74 73 20 41 44 44 20 TABLE tests ADD
4fe0: 43 4f 4c 55 4d 4e 20 73 68 6f 72 74 64 69 72 20 COLUMN shortdir
4ff0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 3b TEXT DEFAULT '';
5000: 22 29 29 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 ")). ((< mv
5010: 65 72 20 31 2e 33 36 29 0a 20 20 20 20 20 20 20 er 1.36).
5020: 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 (db:set-var db "
5030: 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e MEGATEST_VERSION
5040: 22 20 31 2e 33 36 29 0a 20 20 20 20 20 20 20 28 " 1.36). (
5050: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
5060: 64 62 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 db "ALTER TABLE
5070: 74 65 73 74 5f 6d 65 74 61 20 41 44 44 20 43 4f test_meta ADD CO
5080: 4c 55 4d 4e 20 6a 6f 62 67 72 6f 75 70 20 54 45 LUMN jobgroup TE
5090: 58 54 20 44 45 46 41 55 4c 54 20 27 64 65 66 61 XT DEFAULT 'defa
50a0: 75 6c 74 27 3b 22 29 29 0a 20 20 20 20 20 20 28 ult';")). (
50b0: 28 3c 20 6d 76 65 72 20 31 2e 33 37 29 0a 20 20 (< mver 1.37).
50c0: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 (db:set-var
50d0: 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 db "MEGATEST_VE
50e0: 52 53 49 4f 4e 22 20 31 2e 33 37 29 0a 20 20 20 RSION" 1.37).
50f0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
5100: 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 54 cute db "ALTER T
5110: 41 42 4c 45 20 74 65 73 74 73 20 41 44 44 20 43 ABLE tests ADD C
5120: 4f 4c 55 4d 4e 20 61 72 63 68 69 76 65 64 20 49 OLUMN archived I
5130: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 NTEGER DEFAULT 0
5140: 3b 22 29 29 20 0a 20 20 20 20 20 20 28 28 3c 20 ;")) . ((<
5150: 6d 76 65 72 20 6d 65 67 61 74 65 73 74 2d 76 65 mver megatest-ve
5160: 72 73 69 6f 6e 29 0a 20 20 20 20 20 20 20 28 64 rsion). (d
5170: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
5180: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
5190: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
51a0: 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ))))))..;;======
51b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
51f0: 0a 3b 3b 20 6d 65 74 61 20 67 65 74 20 61 6e 64 .;; meta get and
5200: 20 73 65 74 20 76 61 72 73 0a 3b 3b 3d 3d 3d 3d set vars.;;====
5210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5250: 3d 3d 0a 0a 3b 3b 20 72 65 74 75 72 6e 73 20 6e ==..;; returns n
5260: 75 6d 62 65 72 20 69 66 20 73 74 72 69 6e 67 2d umber if string-
5270: 3e 6e 75 6d 62 65 72 20 69 73 20 73 75 63 63 65 >number is succe
5280: 73 73 66 75 6c 2c 20 73 74 72 69 6e 67 20 6f 74 ssful, string ot
5290: 68 65 72 77 69 73 65 0a 3b 3b 20 61 6c 73 6f 20 herwise.;; also
52a0: 75 70 64 61 74 65 73 20 2a 67 6c 6f 62 61 6c 2d updates *global-
52b0: 64 65 6c 74 61 2a 0a 28 64 65 66 69 6e 65 20 28 delta*.(define (
52c0: 64 62 3a 67 65 74 2d 76 61 72 20 64 62 20 76 61 db:get-var db va
52d0: 72 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e r). (debug:prin
52e0: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
52f0: 74 2d 76 61 72 20 53 54 41 52 54 20 22 20 76 61 t-var START " va
5300: 72 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 r). (let* ((sta
5310: 72 74 2d 6d 73 20 28 63 75 72 72 65 6e 74 2d 6d rt-ms (current-m
5320: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 20 20 illiseconds)).
5330: 20 20 20 20 20 20 20 28 74 68 72 6f 74 74 6c 65 (throttle
5340: 20 28 6c 65 74 20 28 28 74 20 20 28 63 6f 6e 66 (let ((t (conf
5350: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
5360: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 74 gdat* "setup" "t
5370: 68 72 6f 74 74 6c 65 22 29 29 29 0a 09 09 20 20 hrottle")))...
5380: 20 20 20 28 69 66 20 74 20 28 73 74 72 69 6e 67 (if t (string
5390: 2d 3e 6e 75 6d 62 65 72 20 74 29 20 74 29 29 29 ->number t) t)))
53a0: 0a 09 20 28 72 65 73 20 20 20 20 20 20 23 66 29 .. (res #f)
53b0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
53c0: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
53d0: 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 20 (lambda (val).
53e0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
53f0: 76 61 6c 29 29 0a 20 20 20 20 20 64 62 20 22 53 val)). db "S
5400: 45 4c 45 43 54 20 76 61 6c 20 46 52 4f 4d 20 6d ELECT val FROM m
5410: 65 74 61 64 61 74 20 57 48 45 52 45 20 76 61 72 etadat WHERE var
5420: 3d 3f 3b 22 20 76 61 72 29 0a 20 20 20 20 3b 3b =?;" var). ;;
5430: 20 63 6f 6e 76 65 72 74 20 74 6f 20 6e 75 6d 62 convert to numb
5440: 65 72 20 69 66 20 63 61 6e 0a 20 20 20 20 28 69 er if can. (i
5450: 66 20 28 73 74 72 69 6e 67 3f 20 72 65 73 29 0a f (string? res).
5460: 09 28 6c 65 74 20 28 28 76 61 6c 6e 75 6d 20 28 .(let ((valnum (
5470: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 72 string->number r
5480: 65 73 29 29 29 0a 09 20 20 28 69 66 20 76 61 6c es))).. (if val
5490: 6e 75 6d 20 28 73 65 74 21 20 72 65 73 20 76 61 num (set! res va
54a0: 6c 6e 75 6d 29 29 29 29 0a 20 20 20 20 3b 3b 20 lnum)))). ;;
54b0: 73 63 61 6c 65 20 62 79 20 31 30 2c 20 61 76 65 scale by 10, ave
54c0: 72 61 67 65 20 77 69 74 68 20 63 75 72 72 65 6e rage with curren
54d0: 74 20 76 61 6c 75 65 2e 0a 20 20 20 20 28 73 65 t value.. (se
54e0: 74 21 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 t! *global-delta
54f0: 2a 20 28 2f 20 28 2b 20 2a 67 6c 6f 62 61 6c 2d * (/ (+ *global-
5500: 64 65 6c 74 61 2a 20 28 2a 20 28 2d 20 28 63 75 delta* (* (- (cu
5510: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
5520: 64 73 29 20 73 74 61 72 74 2d 6d 73 29 0a 09 09 ds) start-ms)...
5530: 09 09 09 09 20 28 69 66 20 74 68 72 6f 74 74 6c .... (if throttl
5540: 65 20 74 68 72 6f 74 74 6c 65 20 30 2e 30 31 29 e throttle 0.01)
5550: 29 29 0a 09 09 09 20 20 20 20 32 29 29 0a 20 20 )).... 2)).
5560: 20 20 28 69 66 20 28 3e 20 28 61 62 73 20 28 2d (if (> (abs (-
5570: 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 *last-global-de
5580: 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 2a 67 6c lta-printed* *gl
5590: 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 20 30 2e obal-delta*)) 0.
55a0: 30 38 29 20 3b 3b 20 64 6f 6e 27 74 20 70 72 69 08) ;; don't pri
55b0: 6e 74 20 61 6c 6c 20 74 68 65 20 74 69 6d 65 2c nt all the time,
55c0: 20 6f 6e 6c 79 20 69 66 20 69 74 20 63 68 61 6e only if it chan
55d0: 67 65 73 20 61 20 62 69 74 0a 09 28 62 65 67 69 ges a bit..(begi
55e0: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
55f0: 74 2d 69 6e 66 6f 20 34 20 22 6c 61 75 6e 63 68 t-info 4 "launch
5600: 20 74 68 72 6f 74 74 6c 65 20 66 61 63 74 6f 72 throttle factor
5610: 3d 22 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 =" *global-delta
5620: 2a 29 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 73 *).. (set! *las
5630: 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 t-global-delta-p
5640: 72 69 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d rinted* *global-
5650: 64 65 6c 74 61 2a 29 29 29 0a 20 20 20 20 28 64 delta*))). (d
5660: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
5670: 31 31 20 22 64 62 3a 67 65 74 2d 76 61 72 20 45 11 "db:get-var E
5680: 4e 44 20 22 20 76 61 72 20 22 20 76 61 6c 3d 22 ND " var " val="
5690: 20 72 65 73 29 0a 20 20 20 20 72 65 73 29 29 0a res). res)).
56a0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 .(define (db:set
56b0: 2d 76 61 72 20 64 62 20 76 61 72 20 76 61 6c 29 -var db var val)
56c0: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
56d0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d info 11 "db:set-
56e0: 76 61 72 20 53 54 41 52 54 20 22 20 76 61 72 20 var START " var
56f0: 22 20 22 20 76 61 6c 29 0a 20 20 28 73 71 6c 69 " " val). (sqli
5700: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
5710: 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 INSERT OR REPLAC
5720: 45 20 49 4e 54 4f 20 6d 65 74 61 64 61 74 20 28 E INTO metadat (
5730: 76 61 72 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 var,val) VALUES
5740: 28 3f 2c 3f 29 3b 22 20 76 61 72 20 76 61 6c 29 (?,?);" var val)
5750: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
5760: 69 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d info 11 "db:set-
5770: 76 61 72 20 45 4e 44 20 22 20 76 61 72 20 22 20 var END " var "
5780: 22 20 76 61 6c 29 29 0a 0a 28 64 65 66 69 6e 65 " val))..(define
5790: 20 28 64 62 3a 64 65 6c 2d 76 61 72 20 64 62 20 (db:del-var db
57a0: 76 61 72 29 0a 20 20 28 64 65 62 75 67 3a 70 72 var). (debug:pr
57b0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
57c0: 64 65 6c 2d 76 61 72 20 53 54 41 52 54 20 22 20 del-var START "
57d0: 76 61 72 29 0a 20 20 28 73 71 6c 69 74 65 33 3a var). (sqlite3:
57e0: 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 execute db "DELE
57f0: 54 45 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 TE FROM metadat
5800: 57 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 WHERE var=?;" va
5810: 72 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e r). (debug:prin
5820: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 64 65 t-info 11 "db:de
5830: 6c 2d 76 61 72 20 45 4e 44 20 22 20 76 61 72 29 l-var END " var)
5840: 29 0a 0a 3b 3b 20 75 73 65 20 61 20 67 6c 6f 62 )..;; use a glob
5850: 61 6c 20 66 6f 72 20 73 6f 6d 65 20 70 72 69 6d al for some prim
5860: 69 74 69 76 65 20 63 61 63 68 69 6e 67 2c 20 69 itive caching, i
5870: 74 20 69 73 20 6a 75 73 74 20 73 69 6c 6c 79 20 t is just silly
5880: 74 6f 20 72 65 2d 72 65 61 64 20 74 68 65 20 64 to re-read the d
5890: 62 20 0a 3b 3b 20 6f 76 65 72 20 61 6e 64 20 6f b .;; over and o
58a0: 76 65 72 20 61 67 61 69 6e 20 66 6f 72 20 74 68 ver again for th
58b0: 65 20 6b 65 79 73 20 73 69 6e 63 65 20 74 68 65 e keys since the
58c0: 79 20 6e 65 76 65 72 20 63 68 61 6e 67 65 0a 0a y never change..
58d0: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
58e0: 6b 65 79 73 20 64 62 29 0a 20 20 28 69 66 20 2a keys db). (if *
58f0: 64 62 2d 6b 65 79 73 2a 20 2a 64 62 2d 6b 65 79 db-keys* *db-key
5900: 73 2a 20 0a 20 20 20 20 20 20 28 6c 65 74 20 28 s* . (let (
5910: 28 72 65 73 20 27 28 29 29 29 0a 09 28 64 65 62 (res '()))..(deb
5920: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
5930: 20 22 64 62 3a 67 65 74 2d 6b 65 79 73 20 53 54 "db:get-keys ST
5940: 41 52 54 20 28 63 61 63 68 65 20 6d 69 73 73 29 ART (cache miss)
5950: 22 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 ")..(sqlite3:for
5960: 2d 65 61 63 68 2d 72 6f 77 20 0a 09 20 28 6c 61 -each-row .. (la
5970: 6d 62 64 61 20 28 6b 65 79 20 6b 65 79 74 79 70 mbda (key keytyp
5980: 65 29 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 e).. (set! res
5990: 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 6b (cons (vector k
59a0: 65 79 20 6b 65 79 74 79 70 65 29 20 72 65 73 29 ey keytype) res)
59b0: 29 29 0a 09 20 64 62 0a 09 20 22 53 45 4c 45 43 )).. db.. "SELEC
59c0: 54 20 66 69 65 6c 64 6e 61 6d 65 2c 66 69 65 6c T fieldname,fiel
59d0: 64 74 79 70 65 20 46 52 4f 4d 20 6b 65 79 73 20 dtype FROM keys
59e0: 4f 52 44 45 52 20 42 59 20 69 64 20 44 45 53 43 ORDER BY id DESC
59f0: 3b 22 29 0a 09 28 73 65 74 21 20 2a 64 62 2d 6b ;")..(set! *db-k
5a00: 65 79 73 2a 20 72 65 73 29 0a 09 28 64 65 62 75 eys* res)..(debu
5a10: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
5a20: 22 64 62 3a 67 65 74 2d 6b 65 79 73 20 45 4e 44 "db:get-keys END
5a30: 20 28 63 61 63 68 65 20 6d 69 73 73 29 22 29 0a (cache miss)").
5a40: 09 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 .res)))..(define
5a50: 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 (db:get-value-b
5a60: 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 65 61 y-header row hea
5a70: 64 65 72 20 66 69 65 6c 64 29 0a 20 20 28 64 65 der field). (de
5a80: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
5a90: 20 22 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 "db:get-value-b
5aa0: 79 2d 68 65 61 64 65 72 20 72 6f 77 3a 20 22 20 y-header row: "
5ab0: 72 6f 77 20 22 20 68 65 61 64 65 72 3a 20 22 20 row " header: "
5ac0: 68 65 61 64 65 72 20 22 20 66 69 65 6c 64 3a 20 header " field:
5ad0: 22 20 66 69 65 6c 64 29 0a 20 20 28 69 66 20 28 " field). (if (
5ae0: 6e 75 6c 6c 3f 20 68 65 61 64 65 72 29 20 23 66 null? header) #f
5af0: 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 . (let loop
5b00: 20 28 28 68 65 64 20 28 63 61 72 20 68 65 61 64 ((hed (car head
5b10: 65 72 29 29 0a 09 09 20 28 74 61 6c 20 28 63 64 er))... (tal (cd
5b20: 72 20 68 65 61 64 65 72 29 29 0a 09 09 20 28 6e r header))... (n
5b30: 20 20 20 30 29 29 0a 09 28 69 66 20 28 65 71 75 0))..(if (equ
5b40: 61 6c 3f 20 68 65 64 20 66 69 65 6c 64 29 0a 09 al? hed field)..
5b50: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
5b60: 72 6f 77 20 6e 29 0a 09 20 20 20 20 28 69 66 20 row n).. (if
5b70: 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 23 66 20 28 (null? tal) #f (
5b80: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
5b90: 64 72 20 74 61 6c 29 28 2b 20 6e 20 31 29 29 29 dr tal)(+ n 1)))
5ba0: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
5bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
5bf0: 3b 20 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d ; R U N S.;;===
5c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5c40: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 ===..(define (db
5c50: 3a 67 65 74 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 :get-run-name-fr
5c60: 6f 6d 2d 69 64 20 64 62 20 72 75 6e 2d 69 64 29 om-id db run-id)
5c70: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 . (let ((res #f
5c80: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
5c90: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
5ca0: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 6e 61 (lambda (runna
5cb0: 6d 65 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 me). (set!
5cc0: 20 72 65 73 20 72 75 6e 6e 61 6d 65 29 29 0a 20 res runname)).
5cd0: 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c db. "SEL
5ce0: 45 43 54 20 72 75 6e 6e 61 6d 65 20 46 52 4f 4d ECT runname FROM
5cf0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
5d00: 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 29 0a ;". run-id).
5d10: 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 res))..(defi
5d20: 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d 6b ne (db:get-run-k
5d30: 65 79 2d 76 61 6c 20 64 62 20 72 75 6e 2d 69 64 ey-val db run-id
5d40: 20 6b 65 79 29 0a 20 20 28 6c 65 74 20 28 28 72 key). (let ((r
5d50: 65 73 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c es #f)). (sql
5d60: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
5d70: 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 w. (lambda (
5d80: 76 61 6c 29 0a 20 20 20 20 20 20 20 28 73 65 74 val). (set
5d90: 21 20 72 65 73 20 76 61 6c 29 29 0a 20 20 20 20 ! res val)).
5da0: 20 64 62 20 0a 20 20 20 20 20 28 63 6f 6e 63 20 db . (conc
5db0: 22 53 45 4c 45 43 54 20 22 20 28 6b 65 79 3a 67 "SELECT " (key:g
5dc0: 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 et-fieldname key
5dd0: 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 ) " FROM runs WH
5de0: 45 52 45 20 69 64 3d 3f 3b 22 29 0a 20 20 20 20 ERE id=?;").
5df0: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 65 73 run-id). res
5e00: 29 29 0a 0a 3b 3b 20 6b 65 79 73 20 6c 69 73 74 ))..;; keys list
5e10: 20 74 6f 20 6b 65 79 31 2c 6b 65 79 32 2c 6b 65 to key1,key2,ke
5e20: 79 33 20 2e 2e 2e 0a 28 64 65 66 69 6e 65 20 28 y3 ....(define (
5e30: 72 75 6e 73 3a 67 65 74 2d 73 74 64 2d 72 75 6e runs:get-std-run
5e40: 2d 66 69 65 6c 64 73 20 6b 65 79 73 20 72 65 6d -fields keys rem
5e50: 66 69 65 6c 64 73 29 0a 20 20 28 6c 65 74 2a 20 fields). (let*
5e60: 28 28 68 65 61 64 65 72 20 20 20 20 28 61 70 70 ((header (app
5e70: 65 6e 64 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 end (map key:get
5e80: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 -fieldname keys)
5e90: 0a 09 09 09 20 20 20 20 72 65 6d 66 69 65 6c 64 .... remfield
5ea0: 73 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 20 s)).. (keystr
5eb0: 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 (conc (keys->ke
5ec0: 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 ystr keys) ","..
5ed0: 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 .. (string-inte
5ee0: 72 73 70 65 72 73 65 20 72 65 6d 66 69 65 6c 64 rsperse remfield
5ef0: 73 20 22 2c 22 29 29 29 29 0a 20 20 20 20 28 6c s ",")))). (l
5f00: 69 73 74 20 6b 65 79 73 74 72 20 68 65 61 64 65 ist keystr heade
5f10: 72 29 29 29 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 r)))..;; make a
5f20: 71 75 65 72 79 20 28 66 69 65 6c 64 6e 61 6d 65 query (fieldname
5f30: 20 6c 69 6b 65 20 27 70 61 74 74 31 27 20 4f 52 like 'patt1' OR
5f40: 20 66 69 65 6c 64 6e 61 6d 65 20 0a 28 64 65 66 fieldname .(def
5f50: 69 6e 65 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 ine (db:patt->li
5f60: 6b 65 20 66 69 65 6c 64 6e 61 6d 65 20 70 61 74 ke fieldname pat
5f70: 74 73 74 72 20 23 21 6b 65 79 20 28 63 6f 6d 70 tstr #!key (comp
5f80: 61 72 61 74 6f 72 20 22 20 4f 52 20 22 29 29 0a arator " OR ")).
5f90: 20 20 28 6c 65 74 20 28 28 70 61 74 74 73 20 28 (let ((patts (
5fa0: 69 66 20 28 73 74 72 69 6e 67 3f 20 70 61 74 74 if (string? patt
5fb0: 73 74 72 29 0a 09 09 20 20 20 28 73 74 72 69 6e str)... (strin
5fc0: 67 2d 73 70 6c 69 74 20 70 61 74 74 73 74 72 20 g-split pattstr
5fd0: 22 2c 22 29 0a 09 09 20 20 20 27 28 22 25 22 29 ",")... '("%")
5fe0: 29 29 29 0a 20 20 20 20 28 73 74 72 69 6e 67 2d ))). (string-
5ff0: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
6000: 20 28 6c 61 6d 62 64 61 20 28 70 61 74 74 29 0a (lambda (patt).
6010: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
6020: 28 77 69 6c 64 74 79 70 65 20 28 69 66 20 28 73 (wildtype (if (s
6030: 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 ubstring-index "
6040: 25 22 20 70 61 74 74 29 20 22 4c 49 4b 45 22 20 %" patt) "LIKE"
6050: 22 47 4c 4f 42 22 29 29 29 0a 09 09 09 09 20 28 "GLOB")))..... (
6060: 63 6f 6e 63 20 66 69 65 6c 64 6e 61 6d 65 20 22 conc fieldname "
6070: 20 22 20 77 69 6c 64 74 79 70 65 20 22 20 27 22 " wildtype " '"
6080: 20 70 61 74 74 20 22 27 22 29 29 29 0a 09 09 09 patt "'")))....
6090: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
60a0: 70 61 74 74 73 29 0a 09 09 09 09 20 27 28 22 22 patts)..... '(""
60b0: 29 0a 09 09 09 09 20 70 61 74 74 73 29 29 0a 09 )..... patts))..
60c0: 09 09 63 6f 6d 70 61 72 61 74 6f 72 29 29 29 0a ..comparator))).
60d0: 0a 0a 3b 3b 20 72 65 67 69 73 74 65 72 20 61 20 ..;; register a
60e0: 74 65 73 74 20 72 75 6e 20 77 69 74 68 20 74 68 test run with th
60f0: 65 20 64 62 0a 28 64 65 66 69 6e 65 20 28 64 62 e db.(define (db
6100: 3a 72 65 67 69 73 74 65 72 2d 72 75 6e 20 64 62 :register-run db
6110: 20 6b 65 79 73 20 6b 65 79 76 61 6c 6c 73 74 20 keys keyvallst
6120: 72 75 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 runname state st
6130: 61 74 75 73 20 75 73 65 72 29 0a 20 20 28 64 65 atus user). (de
6140: 62 75 67 3a 70 72 69 6e 74 20 33 20 22 72 75 6e bug:print 3 "run
6150: 73 3a 72 65 67 69 73 74 65 72 2d 72 75 6e 2c 20 s:register-run,
6160: 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 6b keys: " keys " k
6170: 65 79 76 61 6c 6c 73 74 3a 20 22 20 6b 65 79 76 eyvallst: " keyv
6180: 61 6c 6c 73 74 20 22 20 72 75 6e 6e 61 6d 65 3a allst " runname:
6190: 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 73 74 61 " runname " sta
61a0: 74 65 3a 20 22 20 73 74 61 74 65 20 22 20 73 74 te: " state " st
61b0: 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 atus: " status "
61c0: 20 75 73 65 72 3a 20 22 20 75 73 65 72 29 0a 20 user: " user).
61d0: 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 74 72 20 (let* ((keystr
61e0: 20 20 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 (keys->keystr
61f0: 20 6b 65 79 73 29 29 0a 09 20 28 63 6f 6d 6d 61 keys)).. (comma
6200: 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e (if (> (len
6210: 67 74 68 20 6b 65 79 73 29 20 30 29 20 22 2c 22 gth keys) 0) ","
6220: 20 22 22 29 29 0a 09 20 28 61 6e 64 73 74 72 20 "")).. (andstr
6230: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
6240: 68 20 6b 65 79 73 29 20 30 29 20 22 20 41 4e 44 h keys) 0) " AND
6250: 20 22 20 22 22 29 29 0a 09 20 28 76 61 6c 73 6c " "")).. (valsl
6260: 6f 74 73 20 20 28 6b 65 79 73 2d 3e 76 61 6c 73 ots (keys->vals
6270: 6c 6f 74 73 20 6b 65 79 73 29 29 20 3b 3b 20 3f lots keys)) ;; ?
6280: 2c 3f 2c 3f 20 2e 2e 2e 0a 09 20 28 6b 65 79 76 ,?,? ..... (keyv
6290: 61 6c 73 20 20 20 28 6d 61 70 20 63 61 64 72 20 als (map cadr
62a0: 6b 65 79 76 61 6c 6c 73 74 29 29 0a 09 20 28 61 keyvallst)).. (a
62b0: 6c 6c 76 61 6c 73 20 20 20 28 61 70 70 65 6e 64 llvals (append
62c0: 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 20 73 (list runname s
62d0: 74 61 74 65 20 73 74 61 74 75 73 20 75 73 65 72 tate status user
62e0: 29 20 6b 65 79 76 61 6c 73 29 29 0a 09 20 28 71 ) keyvals)).. (q
62f0: 72 79 76 61 6c 73 20 20 20 28 61 70 70 65 6e 64 ryvals (append
6300: 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 29 20 (list runname)
6310: 6b 65 79 76 61 6c 73 29 29 0a 09 20 28 6b 65 79 keyvals)).. (key
6320: 3d 3f 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 =?str (string-i
6330: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
6340: 28 6c 61 6d 62 64 61 20 28 6b 29 28 63 6f 6e 63 (lambda (k)(conc
6350: 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e (key:get-fieldn
6360: 61 6d 65 20 6b 29 20 22 3d 3f 22 29 29 20 6b 65 ame k) "=?")) ke
6370: 79 73 29 20 22 20 41 4e 44 20 22 29 29 29 0a 20 ys) " AND "))).
6380: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6390: 33 20 22 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 3 "keys: " keys
63a0: 22 20 61 6c 6c 76 61 6c 73 3a 20 22 20 61 6c 6c " allvals: " all
63b0: 76 61 6c 73 20 22 20 6b 65 79 76 61 6c 73 3a 20 vals " keyvals:
63c0: 22 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 28 " keyvals). (
63d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4e debug:print 2 "N
63e0: 4f 54 45 3a 20 75 73 69 6e 67 20 74 61 72 67 65 OTE: using targe
63f0: 74 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 t " (string-inte
6400: 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c 73 20 rsperse keyvals
6410: 22 2f 22 29 20 22 20 66 6f 72 20 74 68 69 73 20 "/") " for this
6420: 72 75 6e 22 29 0a 20 20 20 20 28 69 66 20 28 61 run"). (if (a
6430: 6e 64 20 72 75 6e 6e 61 6d 65 20 28 6e 75 6c 6c nd runname (null
6440: 3f 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 ? (filter (lambd
6450: 61 20 28 78 29 28 6e 6f 74 20 78 29 29 20 6b 65 a (x)(not x)) ke
6460: 79 76 61 6c 73 29 29 29 20 3b 3b 20 74 68 65 72 yvals))) ;; ther
6470: 65 20 6d 75 73 74 20 62 65 20 61 20 62 65 74 74 e must be a bett
6480: 65 72 20 77 61 79 20 74 6f 20 22 61 70 70 6c 79 er way to "apply
6490: 20 61 6e 64 22 0a 09 28 6c 65 74 20 28 28 72 65 and"..(let ((re
64a0: 73 20 23 66 29 29 0a 09 20 20 28 61 70 70 6c 79 s #f)).. (apply
64b0: 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 sqlite3:execute
64c0: 20 64 62 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 db (conc "INSER
64d0: 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f T OR IGNORE INTO
64e0: 20 72 75 6e 73 20 28 72 75 6e 6e 61 6d 65 2c 73 runs (runname,s
64f0: 74 61 74 65 2c 73 74 61 74 75 73 2c 6f 77 6e 65 tate,status,owne
6500: 72 2c 65 76 65 6e 74 5f 74 69 6d 65 22 20 63 6f r,event_time" co
6510: 6d 6d 61 20 6b 65 79 73 74 72 20 22 29 20 56 41 mma keystr ") VA
6520: 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 73 74 LUES (?,?,?,?,st
6530: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
6540: 27 29 22 20 63 6f 6d 6d 61 20 76 61 6c 73 6c 6f ')" comma valslo
6550: 74 73 20 22 29 3b 22 29 0a 09 09 20 61 6c 6c 76 ts ");")... allv
6560: 61 6c 73 29 0a 09 20 20 28 61 70 70 6c 79 20 73 als).. (apply s
6570: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
6580: 72 6f 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 row .. (lambda
6590: 20 28 69 64 29 0a 09 20 20 20 20 20 28 73 65 74 (id).. (set
65a0: 21 20 72 65 73 20 69 64 29 29 0a 09 20 20 20 64 ! res id)).. d
65b0: 62 0a 09 20 20 20 28 6c 65 74 20 28 28 71 72 79 b.. (let ((qry
65c0: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 (conc "SELECT i
65d0: 64 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 d FROM runs WHER
65e0: 45 20 28 72 75 6e 6e 61 6d 65 3d 3f 20 22 20 61 E (runname=? " a
65f0: 6e 64 73 74 72 20 6b 65 79 3d 3f 73 74 72 20 22 ndstr key=?str "
6600: 29 3b 22 29 29 29 0a 09 20 20 20 20 20 3b 28 64 );"))).. ;(d
6610: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 71 72 ebug:print 4 "qr
6620: 79 3a 20 22 20 71 72 79 29 20 0a 09 20 20 20 20 y: " qry) ..
6630: 20 71 72 79 29 0a 09 20 20 20 71 72 79 76 61 6c qry).. qryval
6640: 73 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 s).. (sqlite3:e
6650: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
6660: 45 20 72 75 6e 73 20 53 45 54 20 73 74 61 74 65 E runs SET state
6670: 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 45 52 =?,status=? WHER
6680: 45 20 69 64 3d 3f 3b 22 20 73 74 61 74 65 20 73 E id=?;" state s
6690: 74 61 74 75 73 20 72 65 73 29 0a 09 20 20 72 65 tatus res).. re
66a0: 73 29 20 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 s) ..(begin.. (
66b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
66c0: 52 52 4f 52 3a 20 43 61 6c 6c 65 64 20 77 69 74 RROR: Called wit
66d0: 68 6f 75 74 20 61 6c 6c 20 6e 65 63 65 73 73 61 hout all necessa
66e0: 72 79 20 6b 65 79 73 22 29 0a 09 20 20 23 66 29 ry keys").. #f)
66f0: 29 29 29 0a 0a 0a 3b 3b 20 72 65 70 6c 61 63 65 )))...;; replace
6700: 20 68 65 61 64 65 72 20 61 6e 64 20 6b 65 79 73 header and keys
6710: 74 72 20 77 69 74 68 20 61 20 63 61 6c 6c 20 74 tr with a call t
6720: 6f 20 72 75 6e 73 3a 67 65 74 2d 73 74 64 2d 72 o runs:get-std-r
6730: 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b 0a 3b 3b 20 un-fields.;;.;;
6740: 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b 45 59 keypatts: ( (KEY
6750: 31 20 22 61 62 63 25 64 65 66 22 29 28 4b 45 59 1 "abc%def")(KEY
6760: 32 20 22 25 22 29 20 29 0a 3b 3b 20 72 75 6e 70 2 "%") ).;; runp
6770: 61 74 74 73 3a 20 70 61 74 74 31 2c 70 61 74 74 atts: patt1,patt
6780: 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 2 ....;;.(define
6790: 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 62 (db:get-runs db
67a0: 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 6f runpatt count o
67b0: 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 29 0a ffset keypatts).
67c0: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 (let* ((res
67d0: 20 20 20 20 27 28 29 29 0a 09 20 28 6b 65 79 73 '()).. (keys
67e0: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b (db:get-k
67f0: 65 79 73 20 64 62 29 29 0a 09 20 28 72 75 6e 70 eys db)).. (runp
6800: 61 74 74 73 74 72 20 28 64 62 3a 70 61 74 74 2d attstr (db:patt-
6810: 3e 6c 69 6b 65 20 22 72 75 6e 6e 61 6d 65 22 20 >like "runname"
6820: 72 75 6e 70 61 74 74 29 29 0a 09 20 28 72 65 6d runpatt)).. (rem
6830: 66 69 65 6c 64 73 20 20 28 6c 69 73 74 20 22 69 fields (list "i
6840: 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 d" "runname" "st
6850: 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f ate" "status" "o
6860: 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d wner" "event_tim
6870: 65 22 29 29 0a 09 20 28 68 65 61 64 65 72 20 20 e")).. (header
6880: 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 (append (map
6890: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
68a0: 65 20 6b 65 79 73 29 0a 09 09 20 20 20 20 20 20 e keys)...
68b0: 20 20 20 20 20 20 20 72 65 6d 66 69 65 6c 64 73 remfields
68c0: 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 20 20 )).. (keystr
68d0: 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 (conc (keys->ke
68e0: 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 ystr keys) ","..
68f0: 09 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 . (str
6900: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
6910: 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 remfields ",")))
6920: 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 20 28 .. (qrystr (
6930: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b conc "SELECT " k
6940: 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e eystr " FROM run
6950: 73 20 57 48 45 52 45 20 28 22 20 72 75 6e 70 61 s WHERE (" runpa
6960: 74 74 73 74 72 20 22 29 20 22 20 3b 3b 20 72 75 ttstr ") " ;; ru
6970: 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 22 0a 09 nname LIKE ? "..
6980: 09 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 47 . ;; G
6990: 65 6e 65 72 61 74 65 3a 20 22 20 41 4e 44 20 78 enerate: " AND x
69a0: 20 4c 49 4b 45 20 27 6b 65 79 70 61 74 74 27 20 LIKE 'keypatt'
69b0: 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 20 20 20 ..."...
69c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6b 65 79 (if (null? key
69d0: 70 61 74 74 73 29 20 22 22 0a 09 09 20 20 20 20 patts) ""...
69e0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
69f0: 20 22 20 41 4e 44 20 22 0a 09 09 09 09 20 20 20 " AND ".....
6a00: 20 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 0a (string-join .
6a10: 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 .... (map (
6a20: 6c 61 6d 62 64 61 20 28 6b 65 79 70 61 74 74 29 lambda (keypatt)
6a30: 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let
6a40: 28 28 6b 65 79 20 20 28 63 61 72 20 6b 65 79 70 ((key (car keyp
6a50: 61 74 74 29 29 0a 09 09 09 09 09 09 20 20 20 28 att))....... (
6a60: 70 61 74 74 20 28 63 61 64 72 20 6b 65 79 70 61 patt (cadr keypa
6a70: 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 tt)))......
6a80: 20 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 6b 65 (db:patt->like
6a90: 20 6b 65 79 20 70 61 74 74 29 29 29 0a 09 09 09 key patt)))....
6aa0: 09 09 20 20 20 6b 65 79 70 61 74 74 73 29 0a 09 .. keypatts)..
6ab0: 09 09 09 20 20 20 20 20 20 22 20 41 4e 44 20 22 ... " AND "
6ac0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 )))...
6ad0: 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e " ORDER BY even
6ae0: 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a 09 09 t_time DESC "...
6af0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
6b00: 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 0a 09 number? count)..
6b10: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6b20: 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 22 20 (conc " LIMIT "
6b30: 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 20 20 count)...
6b40: 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 20 20 "")...
6b50: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
6b60: 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a 09 09 mber? offset)...
6b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6b80: 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 22 20 conc " OFFSET "
6b90: 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 20 20 offset)...
6ba0: 20 20 20 20 20 20 20 20 20 22 22 29 29 29 29 0a "")))).
6bb0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6bc0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6bd0: 2d 72 75 6e 73 20 53 54 41 52 54 20 71 72 79 73 -runs START qrys
6be0: 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 20 6b tr: " qrystr " k
6bf0: 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 70 61 eypatts: " keypa
6c00: 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 22 20 tts " offset: "
6c10: 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 3a 20 offset " limit:
6c20: 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 73 71 " count). (sq
6c30: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
6c40: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
6c50: 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 20 28 (a . x). (
6c60: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 set! res (cons (
6c70: 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 78 apply vector a x
6c80: 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 ) res))). db
6c90: 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 20 20 . qrystr.
6ca0: 20 20 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
6cb0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 rint-info 11 "db
6cc0: 3a 67 65 74 2d 72 75 6e 73 20 45 4e 44 20 71 72 :get-runs END qr
6cd0: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
6ce0: 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 keypatts: " key
6cf0: 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 patts " offset:
6d00: 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 " offset " limit
6d10: 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 : " count). (
6d20: 76 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 65 vector header re
6d30: 73 29 29 29 0a 0a 3b 3b 20 6a 75 73 74 20 67 65 s)))..;; just ge
6d40: 74 20 63 6f 75 6e 74 20 6f 66 20 72 75 6e 73 0a t count of runs.
6d50: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
6d60: 6e 75 6d 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 num-runs db runp
6d70: 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 6e 75 att). (let ((nu
6d80: 6d 72 75 6e 73 20 30 29 29 0a 20 20 20 20 28 64 mruns 0)). (d
6d90: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
6da0: 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 11 "db:get-num-r
6db0: 75 6e 73 20 53 54 41 52 54 20 22 20 72 75 6e 70 uns START " runp
6dc0: 61 74 74 29 0a 20 20 20 20 28 73 71 6c 69 74 65 att). (sqlite
6dd0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
6de0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f (lambda (co
6df0: 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 unt). (set
6e00: 21 20 6e 75 6d 72 75 6e 73 20 63 6f 75 6e 74 29 ! numruns count)
6e10: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 ). db. "
6e20: 53 45 4c 45 43 54 20 43 4f 55 4e 54 28 69 64 29 SELECT COUNT(id)
6e30: 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 FROM runs WHERE
6e40: 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 3b runname LIKE ?;
6e50: 22 20 72 75 6e 70 61 74 74 29 0a 20 20 20 20 28 " runpatt). (
6e60: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
6e70: 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d 2d 11 "db:get-num-
6e80: 72 75 6e 73 20 45 4e 44 20 22 20 72 75 6e 70 61 runs END " runpa
6e90: 74 74 29 0a 20 20 20 20 6e 75 6d 72 75 6e 73 29 tt). numruns)
6ea0: 29 0a 0a 3b 3b 20 75 73 65 20 28 67 65 74 2d 76 )..;; use (get-v
6eb0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 alue-by-header (
6ec0: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
6ed0: 6e 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d 72 6f ninfo)(db:get-ro
6ee0: 77 20 72 75 6e 69 6e 66 6f 29 29 0a 28 64 65 66 w runinfo)).(def
6ef0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d ine (db:get-run-
6f00: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 29 0a info db run-id).
6f10: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 (let* ((res
6f20: 20 20 20 23 66 29 0a 09 20 28 6b 65 79 73 20 20 #f).. (keys
6f30: 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 (db:get-keys
6f40: 20 64 62 29 29 0a 09 20 28 72 65 6d 66 69 65 6c db)).. (remfiel
6f50: 64 73 20 28 6c 69 73 74 20 22 69 64 22 20 22 72 ds (list "id" "r
6f60: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
6f70: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
6f80: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 0a "event_time")).
6f90: 09 20 28 68 65 61 64 65 72 20 20 20 20 28 61 70 . (header (ap
6fa0: 70 65 6e 64 20 28 6d 61 70 20 6b 65 79 3a 67 65 pend (map key:ge
6fb0: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 t-fieldname keys
6fc0: 29 0a 09 09 09 20 20 20 20 72 65 6d 66 69 65 6c ).... remfiel
6fd0: 64 73 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 ds)).. (keystr
6fe0: 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b (conc (keys->k
6ff0: 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 0a eystr keys) ",".
7000: 09 09 09 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ... (string-int
7010: 65 72 73 70 65 72 73 65 20 72 65 6d 66 69 65 6c ersperse remfiel
7020: 64 73 20 22 2c 22 29 29 29 29 0a 20 20 20 20 28 ds ",")))). (
7030: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7040: 20 31 31 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d 11 "db:get-run-
7050: 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72 info run-id: " r
7060: 75 6e 2d 69 64 20 22 20 68 65 61 64 65 72 3a 20 un-id " header:
7070: 22 20 68 65 61 64 65 72 20 22 20 6b 65 79 73 74 " header " keyst
7080: 72 3a 20 22 20 6b 65 79 73 74 72 29 0a 20 20 20 r: " keystr).
7090: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
70a0: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d ch-row. (lam
70b0: 62 64 61 20 28 61 20 2e 20 78 29 0a 20 20 20 20 bda (a . x).
70c0: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 61 70 (set! res (ap
70d0: 70 6c 79 20 76 65 63 74 6f 72 20 61 20 78 29 29 ply vector a x))
70e0: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 28 ). db. (
70f0: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b conc "SELECT " k
7100: 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e eystr " FROM run
7110: 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a s WHERE id=?;").
7120: 20 20 20 20 20 72 75 6e 2d 69 64 29 0a 20 20 20 run-id).
7130: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
7140: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 72 75 fo 11 "db:get-ru
7150: 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20 22 n-info run-id: "
7160: 20 72 75 6e 2d 69 64 20 22 20 68 65 61 64 65 72 run-id " header
7170: 3a 20 22 20 68 65 61 64 65 72 20 22 20 6b 65 79 : " header " key
7180: 73 74 72 3a 20 22 20 6b 65 79 73 74 72 29 0a 20 str: " keystr).
7190: 20 20 20 28 6c 65 74 20 28 28 66 69 6e 61 6c 72 (let ((finalr
71a0: 65 73 20 28 76 65 63 74 6f 72 20 68 65 61 64 65 es (vector heade
71b0: 72 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 66 r res))). f
71c0: 69 6e 61 6c 72 65 73 29 29 29 0a 0a 28 64 65 66 inalres)))..(def
71d0: 69 6e 65 20 28 64 62 3a 73 65 74 2d 63 6f 6d 6d ine (db:set-comm
71e0: 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 ent-for-run db r
71f0: 75 6e 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a 20 un-id comment).
7200: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
7210: 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d 63 6f fo 11 "db:set-co
7220: 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 53 54 mment-for-run ST
7230: 41 52 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 ART run-id: " ru
7240: 6e 2d 69 64 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 n-id " comment:
7250: 22 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73 71 " comment). (sq
7260: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
7270: 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 "UPDATE runs SE
7280: 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 T comment=? WHER
7290: 45 20 69 64 3d 3f 3b 22 20 63 6f 6d 6d 65 6e 74 E id=?;" comment
72a0: 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65 62 75 run-id). (debu
72b0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
72c0: 22 64 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d "db:set-comment-
72d0: 66 6f 72 2d 72 75 6e 20 45 4e 44 20 72 75 6e 2d for-run END run-
72e0: 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 63 id: " run-id " c
72f0: 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e omment: " commen
7300: 74 29 29 0a 0a 3b 3b 20 64 6f 65 73 20 6e 6f 74 t))..;; does not
7310: 20 28 6f 62 76 69 6f 75 73 6c 79 21 29 20 72 65 (obviously!) re
7320: 6d 6f 76 65 64 20 64 65 70 65 6e 64 65 6e 74 20 moved dependent
7330: 64 61 74 61 2e 20 42 75 74 20 77 68 79 20 6e 6f data. But why no
7340: 74 21 21 3f 0a 28 64 65 66 69 6e 65 20 28 64 62 t!!?.(define (db
7350: 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 20 72 :delete-run db r
7360: 75 6e 2d 69 64 29 0a 20 20 28 63 6f 6d 6d 6f 6e un-id). (common
7370: 3a 63 6c 65 61 72 2d 63 61 63 68 65 73 29 20 3b :clear-caches) ;
7380: 3b 20 64 6f 6e 27 74 20 74 72 75 73 74 20 63 61 ; don't trust ca
7390: 63 68 65 73 20 61 66 74 65 72 20 64 6f 69 6e 67 ches after doing
73a0: 20 61 6e 79 20 64 65 6c 65 74 69 6f 6e 0a 20 20 any deletion.
73b0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
73c0: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
73d0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
73e0: 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64 65 ;" run-id))..(de
73f0: 66 69 6e 65 20 28 64 62 3a 75 70 64 61 74 65 2d fine (db:update-
7400: 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 64 run-event_time d
7410: 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65 62 b run-id). (deb
7420: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
7430: 20 22 64 62 3a 75 70 64 61 74 65 2d 72 75 6e 2d "db:update-run-
7440: 65 76 65 6e 74 5f 74 69 6d 65 20 53 54 41 52 54 event_time START
7450: 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 run-id: " run-i
7460: 64 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 d). (sqlite3:ex
7470: 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
7480: 20 72 75 6e 73 20 53 45 54 20 65 76 65 6e 74 5f runs SET event_
7490: 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 27 25 time=strftime('%
74a0: 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 20 s','now') WHERE
74b0: 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 0a 20 id=?;" run-id).
74c0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
74d0: 66 6f 20 31 31 20 22 64 62 3a 75 70 64 61 74 65 fo 11 "db:update
74e0: 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -run-event_time
74f0: 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 END run-id: " ru
7500: 6e 2d 69 64 29 29 20 0a 0a 28 64 65 66 69 6e 65 n-id)) ..(define
7510: 20 28 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b (db:lock/unlock
7520: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 6c -run db run-id l
7530: 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 ock unlock user)
7540: 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 6c 6f 63 . (let ((newloc
7550: 6b 76 61 6c 20 28 69 66 20 6c 6f 63 6b 20 22 6c kval (if lock "l
7560: 6f 63 6b 65 64 22 0a 09 09 09 28 69 66 20 75 6e ocked"....(if un
7570: 6c 6f 63 6b 0a 09 09 09 20 20 20 20 22 75 6e 6c lock.... "unl
7580: 6f 63 6b 65 64 22 0a 09 09 09 20 20 20 20 22 6c ocked".... "l
7590: 6f 63 6b 65 64 22 29 29 29 29 20 3b 3b 20 73 65 ocked")))) ;; se
75a0: 6d 69 2d 66 61 69 6c 73 61 66 65 0a 20 20 20 20 mi-failsafe.
75b0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
75c0: 20 64 62 20 22 55 50 44 41 54 45 20 72 75 6e 73 db "UPDATE runs
75d0: 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 45 SET state=? WHE
75e0: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c 6f 63 RE id=?;" newloc
75f0: 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20 20 kval run-id).
7600: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
7610: 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 e db "INSERT INT
7620: 4f 20 61 63 63 65 73 73 5f 6c 6f 67 20 28 75 73 O access_log (us
7630: 65 72 2c 61 63 63 65 73 73 65 64 2c 61 72 67 73 er,accessed,args
7640: 29 20 56 41 4c 55 45 53 28 3f 2c 73 74 72 66 74 ) VALUES(?,strft
7650: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c ime('%s','now'),
7660: 3f 29 3b 22 0a 09 09 20 20 20 20 20 75 73 65 72 ?);"... user
7670: 20 28 63 6f 6e 63 20 6e 65 77 6c 6f 63 6b 76 61 (conc newlockva
7680: 6c 20 22 20 22 20 72 75 6e 2d 69 64 29 29 0a 20 l " " run-id)).
7690: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
76a0: 69 6e 66 6f 20 31 20 22 22 20 6e 65 77 6c 6f 63 info 1 "" newloc
76b0: 6b 76 61 6c 20 22 20 72 75 6e 20 6e 75 6d 62 65 kval " run numbe
76c0: 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b r " run-id)))..;
76d0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
76e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7710: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 20 59 =======.;; K E Y
7720: 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;===========
7730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
7770: 67 65 74 20 6b 65 79 20 76 61 6c 20 70 61 69 72 get key val pair
7780: 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 72 75 s for a given ru
7790: 6e 2d 69 64 0a 3b 3b 20 28 20 28 46 49 45 4c 44 n-id.;; ( (FIELD
77a0: 4e 41 4d 45 31 20 6b 65 79 76 61 6c 31 29 20 28 NAME1 keyval1) (
77b0: 46 49 45 4c 44 4e 41 4d 45 32 20 6b 65 79 76 61 FIELDNAME2 keyva
77c0: 6c 32 29 20 2e 2e 2e 20 29 0a 28 64 65 66 69 6e l2) ... ).(defin
77d0: 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 e (db:get-key-va
77e0: 6c 2d 70 61 69 72 73 20 64 62 20 72 75 6e 2d 69 l-pairs db run-i
77f0: 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 d). (let* ((key
7800: 73 20 28 67 65 74 2d 6b 65 79 73 20 64 62 29 29 s (get-keys db))
7810: 0a 09 20 28 72 65 73 20 20 27 28 29 29 29 0a 20 .. (res '())).
7820: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
7830: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
7840: 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 53 54 key-val-pairs ST
7850: 41 52 54 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 ART keys: " keys
7860: 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e " run-id: " run
7870: 2d 69 64 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 -id). (for-ea
7880: 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ch . (lambda
7890: 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 28 6c (key). (l
78a0: 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 et ((qry (conc "
78b0: 53 45 4c 45 43 54 20 22 20 28 6b 65 79 3a 67 65 SELECT " (key:ge
78c0: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 t-fieldname key)
78d0: 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 " FROM runs WHE
78e0: 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a 09 20 3b RE id=?;"))).. ;
78f0: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ; (debug:print 0
7900: 20 22 71 72 79 3a 20 22 20 71 72 79 29 0a 09 20 "qry: " qry)..
7910: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
7920: 68 2d 72 6f 77 20 0a 09 20 20 28 6c 61 6d 62 64 h-row .. (lambd
7930: 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09 20 20 20 a (key-val)..
7940: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
7950: 20 28 6c 69 73 74 20 28 6b 65 79 3a 67 65 74 2d (list (key:get-
7960: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 20 6b fieldname key) k
7970: 65 79 2d 76 61 6c 29 20 72 65 73 29 29 29 0a 09 ey-val) res)))..
7980: 20 20 64 62 20 71 72 79 20 72 75 6e 2d 69 64 29 db qry run-id)
7990: 29 29 0a 20 20 20 20 20 6b 65 79 73 29 0a 20 20 )). keys).
79a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
79b0: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6b nfo 11 "db:get-k
79c0: 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 45 4e 44 ey-val-pairs END
79d0: 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 keys: " keys "
79e0: 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 run-id: " run-id
79f0: 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20 72 ). (reverse r
7a00: 65 73 29 29 29 0a 0a 3b 3b 20 67 65 74 20 6b 65 es)))..;; get ke
7a10: 79 20 76 61 6c 73 20 66 6f 72 20 61 20 67 69 76 y vals for a giv
7a20: 65 6e 20 72 75 6e 2d 69 64 0a 28 64 65 66 69 6e en run-id.(defin
7a30: 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 e (db:get-key-va
7a40: 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 ls db run-id).
7a50: 28 6c 65 74 20 28 28 6d 79 6b 65 79 76 61 6c 73 (let ((mykeyvals
7a60: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
7a70: 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 61 6c /default *keyval
7a80: 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 29 0a s* run-id #f))).
7a90: 20 20 20 20 28 69 66 20 6d 79 6b 65 79 76 61 6c (if mykeyval
7aa0: 73 20 0a 09 6d 79 6b 65 79 76 61 6c 73 0a 09 28 s ..mykeyvals..(
7ab0: 6c 65 74 2a 20 28 28 6b 65 79 73 20 28 67 65 74 let* ((keys (get
7ac0: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20 20 -keys db))..
7ad0: 20 20 20 28 72 65 73 20 20 27 28 29 29 29 0a 09 (res '()))..
7ae0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
7af0: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6b nfo 11 "db:get-k
7b00: 65 79 2d 76 61 6c 73 20 53 54 41 52 54 20 6b 65 ey-vals START ke
7b10: 79 73 3a 20 22 20 6b 65 79 73 20 22 20 72 75 6e ys: " keys " run
7b20: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 -id: " run-id)..
7b30: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 (for-each ..
7b40: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 (lambda (key)..
7b50: 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 (let ((qry
7b60: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 (conc "SELECT "
7b70: 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 (key:get-fieldna
7b80: 6d 65 20 6b 65 79 29 20 22 20 46 52 4f 4d 20 72 me key) " FROM r
7b90: 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 uns WHERE id=?;"
7ba0: 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 ))).. ;; (
7bb0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 71 debug:print 0 "q
7bc0: 72 79 3a 20 22 20 71 72 79 29 0a 09 20 20 20 20 ry: " qry)..
7bd0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
7be0: 65 61 63 68 2d 72 6f 77 20 0a 09 09 28 6c 61 6d each-row ...(lam
7bf0: 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09 09 bda (key-val)...
7c00: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
7c10: 73 20 6b 65 79 2d 76 61 6c 20 72 65 73 29 29 29 s key-val res)))
7c20: 0a 09 09 64 62 20 71 72 79 20 72 75 6e 2d 69 64 ...db qry run-id
7c30: 29 29 29 0a 09 20 20 20 6b 65 79 73 29 0a 09 20 ))).. keys)..
7c40: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
7c50: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6b 65 fo 11 "db:get-ke
7c60: 79 2d 76 61 6c 73 20 45 4e 44 20 6b 65 79 73 3a y-vals END keys:
7c70: 20 22 20 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 " keys " run-id
7c80: 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 : " run-id).. (
7c90: 6c 65 74 20 28 28 66 69 6e 61 6c 2d 72 65 73 20 let ((final-res
7ca0: 28 72 65 76 65 72 73 65 20 72 65 73 29 29 29 0a (reverse res))).
7cb0: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
7cc0: 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 2a 20 -set! *keyvals*
7cd0: 72 75 6e 2d 69 64 20 66 69 6e 61 6c 2d 72 65 73 run-id final-res
7ce0: 29 0a 09 20 20 20 20 66 69 6e 61 6c 2d 72 65 73 ).. final-res
7cf0: 29 29 29 29 29 0a 0a 3b 3b 20 54 68 65 20 74 61 )))))..;; The ta
7d00: 72 67 65 74 20 69 73 20 6b 65 79 76 61 6c 31 2f rget is keyval1/
7d10: 6b 65 79 76 61 6c 32 2e 2e 2e 2c 20 63 61 63 68 keyval2..., cach
7d20: 65 64 20 69 6e 20 2a 74 61 72 67 65 74 2a 20 61 ed in *target* a
7d30: 73 20 69 74 20 69 73 20 75 73 65 64 20 6f 66 74 s it is used oft
7d40: 65 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 en.(define (db:g
7d50: 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 75 6e et-target db run
7d60: 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 6d 79 -id). (let ((my
7d70: 74 61 72 67 20 28 68 61 73 68 2d 74 61 62 6c 65 targ (hash-table
7d80: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 61 -ref/default *ta
7d90: 72 67 65 74 2a 20 72 75 6e 2d 69 64 20 23 66 29 rget* run-id #f)
7da0: 29 29 0a 20 20 20 20 28 69 66 20 6d 79 74 61 72 )). (if mytar
7db0: 67 0a 09 6d 79 74 61 72 67 0a 09 28 6c 65 74 2a g..mytarg..(let*
7dc0: 20 28 28 6b 65 79 76 61 6c 73 20 28 64 62 3a 67 ((keyvals (db:g
7dd0: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 et-key-vals db r
7de0: 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 20 20 un-id))..
7df0: 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 6e 67 (thekey (string
7e00: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
7e10: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69 66 p (lambda (x)(if
7e20: 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b 65 x x "-na-")) ke
7e30: 79 76 61 6c 73 29 20 22 2f 22 29 29 29 0a 09 20 yvals) "/")))..
7e40: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
7e50: 21 20 2a 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 ! *target* run-i
7e60: 64 20 74 68 65 6b 65 79 29 0a 09 20 20 74 68 65 d thekey).. the
7e70: 6b 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d key))))..;;=====
7e80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ec0: 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53 0a =.;; T E S T S.
7ed0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
7ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f10: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 74 61 ========..;; sta
7f20: 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 tes and statuses
7f30: 20 61 72 65 20 6c 69 73 74 73 2c 20 74 75 72 6e are lists, turn
7f40: 20 74 68 65 6d 20 69 6e 74 6f 20 28 22 50 41 53 them into ("PAS
7f50: 53 22 2c 22 46 41 49 4c 22 2e 2e 2e 29 20 61 6e S","FAIL"...) an
7f60: 64 20 75 73 65 20 4e 4f 54 20 49 4e 0a 3b 3b 20 d use NOT IN.;;
7f70: 69 2e 65 2e 20 74 68 65 73 65 20 6c 69 73 74 73 i.e. these lists
7f80: 20 64 65 66 69 6e 65 20 77 68 61 74 20 74 6f 20 define what to
7f90: 4e 4f 54 20 73 68 6f 77 2e 0a 3b 3b 20 73 74 61 NOT show..;; sta
7fa0: 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 tes and statuses
7fb0: 20 61 72 65 20 72 65 71 75 69 72 65 64 20 74 6f are required to
7fc0: 20 62 65 20 6c 69 73 74 73 2c 20 65 6d 70 74 79 be lists, empty
7fd0: 20 69 73 20 6f 6b 0a 3b 3b 20 6e 6f 74 2d 69 6e is ok.;; not-in
7fe0: 20 23 74 20 3d 20 61 62 6f 76 65 20 62 65 68 61 #t = above beha
7ff0: 76 69 6f 75 72 2c 20 23 66 20 3d 20 6d 75 73 74 viour, #f = must
8000: 20 6d 61 74 63 68 0a 28 64 65 66 69 6e 65 20 28 match.(define (
8010: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
8020: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 74 -run db run-id t
8030: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
8040: 74 61 74 75 73 65 73 20 0a 09 09 09 20 20 20 20 tatuses ....
8050: 20 20 23 21 6b 65 79 20 28 6e 6f 74 2d 69 6e 20 #!key (not-in
8060: 23 74 29 0a 09 09 09 20 20 20 20 20 20 28 73 6f #t).... (so
8070: 72 74 2d 62 79 20 23 66 29 20 3b 3b 20 27 72 75 rt-by #f) ;; 'ru
8080: 6e 64 69 72 20 27 65 76 65 6e 74 5f 74 69 6d 65 ndir 'event_time
8090: 0a 09 09 09 20 20 20 20 20 20 28 71 72 79 76 61 .... (qryva
80a0: 6c 73 20 22 69 64 2c 72 75 6e 5f 69 64 2c 74 65 ls "id,run_id,te
80b0: 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 stname,state,sta
80c0: 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 tus,event_time,h
80d0: 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b ost,cpuload,disk
80e0: 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 free,uname,rundi
80f0: 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f r,item_path,run_
8100: 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c duration,final_l
8110: 6f 67 66 2c 63 6f 6d 6d 65 6e 74 22 29 0a 09 09 ogf,comment")...
8120: 09 20 20 20 20 20 20 29 0a 20 20 28 64 65 62 75 . ). (debu
8130: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
8140: 22 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f "db:get-tests-fo
8150: 72 2d 72 75 6e 20 53 54 41 52 54 20 72 75 6e 2d r-run START run-
8160: 69 64 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 id=" run-id ", t
8170: 65 73 74 70 61 74 74 3d 22 20 74 65 73 74 70 61 estpatt=" testpa
8180: 74 74 20 22 2c 20 73 74 61 74 65 73 3d 22 20 73 tt ", states=" s
8190: 74 61 74 65 73 20 22 2c 20 73 74 61 74 75 73 65 tates ", statuse
81a0: 73 3d 22 20 73 74 61 74 75 73 65 73 20 22 2c 20 s=" statuses ",
81b0: 6e 6f 74 2d 69 6e 3d 22 20 6e 6f 74 2d 69 6e 20 not-in=" not-in
81c0: 22 2c 20 73 6f 72 74 2d 62 79 3d 22 20 73 6f 72 ", sort-by=" sor
81d0: 74 2d 62 79 29 0a 20 20 28 6c 65 74 2a 20 28 28 t-by). (let* ((
81e0: 72 65 73 20 27 28 29 29 0a 09 20 3b 3b 20 69 66 res '()).. ;; if
81f0: 20 73 74 61 74 65 73 20 6f 72 20 73 74 61 74 75 states or statu
8200: 73 65 73 20 61 72 65 20 6e 75 6c 6c 20 74 68 65 ses are null the
8210: 6e 20 61 73 73 75 6d 65 20 6d 61 74 63 68 20 61 n assume match a
8220: 6c 6c 20 77 68 65 6e 20 6e 6f 74 2d 69 6e 20 69 ll when not-in i
8230: 73 20 66 61 6c 73 65 0a 09 20 28 73 74 61 74 65 s false.. (state
8240: 73 2d 71 72 79 20 20 20 20 20 20 28 69 66 20 28 s-qry (if (
8250: 6e 75 6c 6c 3f 20 73 74 61 74 65 73 29 20 0a 09 null? states) ..
8260: 09 09 20 20 20 20 20 20 23 66 0a 09 09 09 20 20 .. #f....
8270: 20 20 20 20 28 63 6f 6e 63 20 22 20 73 74 61 74 (conc " stat
8280: 65 20 22 20 20 0a 09 09 09 09 20 20 20 20 28 69 e " ..... (i
8290: 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54 22 20 22 f not-in "NOT" "
82a0: 22 29 20 0a 09 09 09 09 20 20 20 20 22 20 49 4e ") ..... " IN
82b0: 20 28 27 22 20 0a 09 09 09 09 20 20 20 20 28 73 ('" ..... (s
82c0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
82d0: 65 20 73 74 61 74 65 73 20 20 20 22 27 2c 27 22 e states "','"
82e0: 29 0a 09 09 09 09 20 20 20 20 22 27 29 22 29 29 )..... "')"))
82f0: 29 0a 09 20 28 73 74 61 74 75 73 65 73 2d 71 72 ).. (statuses-qr
8300: 79 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 y (if (null?
8310: 73 74 61 74 75 73 65 73 29 0a 09 09 09 20 20 20 statuses)....
8320: 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 20 28 #f.... (
8330: 63 6f 6e 63 20 22 20 73 74 61 74 75 73 20 22 0a conc " status ".
8340: 09 09 09 09 20 20 20 20 28 69 66 20 6e 6f 74 2d .... (if not-
8350: 69 6e 20 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 in "NOT" "") ...
8360: 09 09 20 20 20 20 22 20 49 4e 20 28 27 22 20 0a .. " IN ('" .
8370: 09 09 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d .... (string-
8380: 69 6e 74 65 72 73 70 65 72 73 65 20 73 74 61 74 intersperse stat
8390: 75 73 65 73 20 22 27 2c 27 22 29 0a 09 09 09 09 uses "','").....
83a0: 20 20 20 20 22 27 29 22 29 29 29 0a 09 20 28 74 "')"))).. (t
83b0: 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 28 ests-match-qry (
83c0: 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 71 6c tests:match->sql
83d0: 71 72 79 20 74 65 73 74 70 61 74 74 29 29 0a 09 qry testpatt))..
83e0: 20 28 71 72 79 20 20 20 20 20 20 20 20 20 20 20 (qry
83f0: 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 (conc "SELECT
8400: 22 20 71 72 79 76 61 6c 73 0a 09 09 09 09 22 20 " qryvals....."
8410: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
8420: 20 72 75 6e 5f 69 64 3d 3f 20 22 0a 09 09 09 09 run_id=? ".....
8430: 28 69 66 20 73 74 61 74 65 73 2d 71 72 79 20 20 (if states-qry
8440: 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 (conc " AND " s
8450: 74 61 74 65 73 2d 71 72 79 29 20 20 20 22 22 29 tates-qry) "")
8460: 0a 09 09 09 09 28 69 66 20 73 74 61 74 75 73 65 .....(if statuse
8470: 73 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 41 4e s-qry (conc " AN
8480: 44 20 22 20 73 74 61 74 75 73 65 73 2d 71 72 79 D " statuses-qry
8490: 29 20 22 22 29 0a 09 09 09 09 28 69 66 20 74 65 ) "").....(if te
84a0: 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 28 63 sts-match-qry (c
84b0: 6f 6e 63 20 22 20 41 4e 44 20 28 22 20 74 65 73 onc " AND (" tes
84c0: 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 22 29 20 ts-match-qry ")
84d0: 22 29 20 22 22 29 0a 09 09 09 09 28 63 61 73 65 ") "").....(case
84e0: 20 73 6f 72 74 2d 62 79 0a 09 09 09 09 20 20 28 sort-by..... (
84f0: 28 72 75 6e 64 69 72 29 20 20 20 20 20 22 20 4f (rundir) " O
8500: 52 44 45 52 20 42 59 20 6c 65 6e 67 74 68 28 72 RDER BY length(r
8510: 75 6e 64 69 72 29 20 44 45 53 43 3b 22 29 0a 09 undir) DESC;")..
8520: 09 09 09 20 20 28 28 65 76 65 6e 74 5f 74 69 6d ... ((event_tim
8530: 65 29 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 e) " ORDER BY ev
8540: 65 6e 74 5f 74 69 6d 65 20 41 53 43 3b 22 29 0a ent_time ASC;").
8550: 09 09 09 09 20 20 28 65 6c 73 65 20 20 20 20 20 .... (else
8560: 20 20 20 20 22 3b 22 29 29 0a 09 09 09 20 29 29 ";")).... ))
8570: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
8580: 6e 74 2d 69 6e 66 6f 20 38 20 22 64 62 3a 67 65 nt-info 8 "db:ge
8590: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
85a0: 71 72 79 3d 22 20 71 72 79 29 0a 20 20 20 20 28 qry=" qry). (
85b0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
85c0: 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 -row . (lamb
85d0: 64 61 20 28 61 20 2e 20 62 29 20 3b 3b 20 69 64 da (a . b) ;; id
85e0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
85f0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
8600: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
8610: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
8620: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d name rundir item
8630: 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 74 69 -path run-durati
8640: 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f on final-logf co
8650: 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20 20 28 73 mment). (s
8660: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 61 et! res (cons (a
8670: 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 62 29 pply vector a b)
8680: 20 72 65 73 29 29 29 20 3b 3b 20 69 64 20 72 75 res))) ;; id ru
8690: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 n-id testname st
86a0: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
86b0: 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f -time host cpulo
86c0: 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d ad diskfree unam
86d0: 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 e rundir item-pa
86e0: 74 68 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 th run-duration
86f0: 66 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 final-logf comme
8700: 6e 74 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 nt) res))).
8710: 64 62 20 0a 20 20 20 20 20 71 72 79 0a 20 20 20 db . qry.
8720: 20 20 72 75 6e 2d 69 64 0a 20 20 20 20 20 29 0a run-id. ).
8730: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
8740: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
8750: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 -tests-for-run S
8760: 54 41 52 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 TART run-id=" ru
8770: 6e 2d 69 64 20 22 2c 20 74 65 73 74 70 61 74 74 n-id ", testpatt
8780: 3d 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 =" testpatt ", s
8790: 74 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 tates=" states "
87a0: 2c 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 , statuses=" sta
87b0: 74 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d tuses ", not-in=
87c0: 22 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 " not-in ", sort
87d0: 2d 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 -by=" sort-by).
87e0: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 67 65 74 res))..;; get
87f0: 20 61 20 75 73 65 66 75 6c 20 73 75 62 73 65 74 a useful subset
8800: 20 6f 66 20 74 68 65 20 74 65 73 74 73 20 64 61 of the tests da
8810: 74 61 20 28 75 73 65 64 20 69 6e 20 64 61 73 68 ta (used in dash
8820: 62 6f 61 72 64 0a 3b 3b 20 75 73 65 20 64 62 3a board.;; use db:
8830: 6d 69 6e 74 65 73 74 73 2d 67 65 74 2d 7b 69 64 mintests-get-{id
8840: 20 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d ,run_id,testnam
8850: 65 20 2e 2e 2e 7d 0a 28 64 65 66 69 6e 65 20 28 e ...}.(define (
8860: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
8870: 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 20 64 62 -runs-mindata db
8880: 20 72 75 6e 2d 69 64 73 20 74 65 73 74 70 61 74 run-ids testpat
8890: 74 20 73 74 61 74 65 73 20 73 74 61 74 75 73 29 t states status)
88a0: 0a 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 . (db:get-tests
88b0: 2d 66 6f 72 2d 72 75 6e 73 20 64 62 20 72 75 6e -for-runs db run
88c0: 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 74 -ids testpatt st
88d0: 61 74 65 73 20 73 74 61 74 75 73 20 71 72 79 76 ates status qryv
88e0: 61 6c 73 3a 20 22 69 64 2c 72 75 6e 5f 69 64 2c als: "id,run_id,
88f0: 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 testname,state,s
8900: 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 tatus,event_time
8910: 2c 69 74 65 6d 5f 70 61 74 68 22 29 29 0a 0a 3b ,item_path"))..;
8920: 3b 20 4e 42 20 2f 2f 20 54 68 69 73 20 69 73 20 ; NB // This is
8930: 67 65 74 20 74 65 73 74 73 20 66 6f 72 20 22 72 get tests for "r
8940: 75 6e 73 22 20 28 6e 6f 74 65 20 74 68 65 20 70 uns" (note the p
8950: 6c 75 72 61 6c 21 21 29 0a 3b 3b 0a 3b 3b 20 73 lural!!).;;.;; s
8960: 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 tates and status
8970: 65 73 20 61 72 65 20 6c 69 73 74 73 2c 20 74 75 es are lists, tu
8980: 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20 28 22 50 rn them into ("P
8990: 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e 2e 29 20 ASS","FAIL"...)
89a0: 61 6e 64 20 75 73 65 20 4e 4f 54 20 49 4e 0a 3b and use NOT IN.;
89b0: 3b 20 69 2e 65 2e 20 74 68 65 73 65 20 6c 69 73 ; i.e. these lis
89c0: 74 73 20 64 65 66 69 6e 65 20 77 68 61 74 20 74 ts define what t
89d0: 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b 3b 20 73 o NOT show..;; s
89e0: 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 tates and status
89f0: 65 73 20 61 72 65 20 72 65 71 75 69 72 65 64 20 es are required
8a00: 74 6f 20 62 65 20 6c 69 73 74 73 2c 20 65 6d 70 to be lists, emp
8a10: 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e 6f 74 2d ty is ok.;; not-
8a20: 69 6e 20 23 74 20 3d 20 61 62 6f 76 65 20 62 65 in #t = above be
8a30: 68 61 76 69 6f 75 72 2c 20 23 66 20 3d 20 6d 75 haviour, #f = mu
8a40: 73 74 20 6d 61 74 63 68 0a 3b 3b 20 72 75 6e 2d st match.;; run-
8a50: 69 64 73 20 69 73 20 61 20 6c 69 73 74 20 6f 66 ids is a list of
8a60: 20 72 75 6e 2d 69 64 73 20 6f 72 20 61 20 73 69 run-ids or a si
8a70: 6e 67 6c 65 20 6e 75 6d 62 65 72 0a 28 64 65 66 ngle number.(def
8a80: 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ine (db:get-test
8a90: 73 2d 66 6f 72 2d 72 75 6e 73 20 64 62 20 72 75 s-for-runs db ru
8aa0: 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 n-ids testpatt s
8ab0: 74 61 74 65 73 20 73 74 61 74 75 73 65 73 20 0a tates statuses .
8ac0: 09 09 09 20 20 20 20 20 20 23 21 6b 65 79 20 28 ... #!key (
8ad0: 6e 6f 74 2d 69 6e 20 23 74 29 0a 09 09 09 20 20 not-in #t)....
8ae0: 20 20 20 20 28 73 6f 72 74 2d 62 79 20 23 66 29 (sort-by #f)
8af0: 0a 09 09 09 20 20 20 20 20 20 28 71 72 79 76 61 .... (qryva
8b00: 6c 73 20 22 69 64 2c 72 75 6e 5f 69 64 2c 74 65 ls "id,run_id,te
8b10: 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 stname,state,sta
8b20: 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 tus,event_time,h
8b30: 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b ost,cpuload,disk
8b40: 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 free,uname,rundi
8b50: 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f r,item_path,run_
8b60: 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c duration,final_l
8b70: 6f 67 66 2c 63 6f 6d 6d 65 6e 74 22 29 29 20 3b ogf,comment")) ;
8b80: 3b 20 27 72 75 6e 64 69 72 20 27 65 76 65 6e 74 ; 'rundir 'event
8b90: 5f 74 69 6d 65 0a 20 20 28 64 65 62 75 67 3a 70 _time. (debug:p
8ba0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 rint-info 11 "db
8bb0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
8bc0: 75 6e 20 53 54 41 52 54 20 72 75 6e 2d 69 64 73 un START run-ids
8bd0: 3d 22 20 72 75 6e 2d 69 64 73 20 22 2c 20 74 65 =" run-ids ", te
8be0: 73 74 70 61 74 74 3d 22 20 74 65 73 74 70 61 74 stpatt=" testpat
8bf0: 74 20 22 2c 20 73 74 61 74 65 73 3d 22 20 73 74 t ", states=" st
8c00: 61 74 65 73 20 22 2c 20 73 74 61 74 75 73 65 73 ates ", statuses
8c10: 3d 22 20 73 74 61 74 75 73 65 73 20 22 2c 20 6e =" statuses ", n
8c20: 6f 74 2d 69 6e 3d 22 20 6e 6f 74 2d 69 6e 20 22 ot-in=" not-in "
8c30: 2c 20 73 6f 72 74 2d 62 79 3d 22 20 73 6f 72 74 , sort-by=" sort
8c40: 2d 62 79 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 -by). (let* ((r
8c50: 65 73 20 27 28 29 29 0a 09 20 3b 3b 20 69 66 20 es '()).. ;; if
8c60: 73 74 61 74 65 73 20 6f 72 20 73 74 61 74 75 73 states or status
8c70: 65 73 20 61 72 65 20 6e 75 6c 6c 20 74 68 65 6e es are null then
8c80: 20 61 73 73 75 6d 65 20 6d 61 74 63 68 20 61 6c assume match al
8c90: 6c 20 77 68 65 6e 20 6e 6f 74 2d 69 6e 20 69 73 l when not-in is
8ca0: 20 66 61 6c 73 65 0a 09 20 28 73 74 61 74 65 73 false.. (states
8cb0: 2d 71 72 79 20 20 20 20 20 20 28 69 66 20 28 6e -qry (if (n
8cc0: 75 6c 6c 3f 20 73 74 61 74 65 73 29 20 0a 09 09 ull? states) ...
8cd0: 09 20 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 . #f....
8ce0: 20 20 20 28 63 6f 6e 63 20 22 20 73 74 61 74 65 (conc " state
8cf0: 20 22 20 20 0a 09 09 09 09 20 20 20 20 28 69 66 " ..... (if
8d00: 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54 22 20 22 22 not-in "NOT" ""
8d10: 29 20 0a 09 09 09 09 20 20 20 20 22 20 49 4e 20 ) ..... " IN
8d20: 28 27 22 20 0a 09 09 09 09 20 20 20 20 28 73 74 ('" ..... (st
8d30: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
8d40: 20 73 74 61 74 65 73 20 20 20 22 27 2c 27 22 29 states "','")
8d50: 0a 09 09 09 09 20 20 20 20 22 27 29 22 29 29 29 ..... "')")))
8d60: 0a 09 20 28 73 74 61 74 75 73 65 73 2d 71 72 79 .. (statuses-qry
8d70: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 (if (null? s
8d80: 74 61 74 75 73 65 73 29 0a 09 09 09 20 20 20 20 tatuses)....
8d90: 20 20 23 66 0a 09 09 09 20 20 20 20 20 20 28 63 #f.... (c
8da0: 6f 6e 63 20 22 20 73 74 61 74 75 73 20 22 0a 09 onc " status "..
8db0: 09 09 09 20 20 20 20 28 69 66 20 6e 6f 74 2d 69 ... (if not-i
8dc0: 6e 20 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 09 n "NOT" "") ....
8dd0: 09 20 20 20 20 22 20 49 4e 20 28 27 22 20 0a 09 . " IN ('" ..
8de0: 09 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 69 ... (string-i
8df0: 6e 74 65 72 73 70 65 72 73 65 20 73 74 61 74 75 ntersperse statu
8e00: 73 65 73 20 22 27 2c 27 22 29 0a 09 09 09 09 20 ses "','").....
8e10: 20 20 20 22 27 29 22 29 29 29 0a 09 20 28 74 65 "')"))).. (te
8e20: 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 28 74 sts-match-qry (t
8e30: 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 71 6c 71 ests:match->sqlq
8e40: 72 79 20 74 65 73 74 70 61 74 74 29 29 0a 09 20 ry testpatt))..
8e50: 28 71 72 79 20 20 20 20 20 20 20 20 20 20 20 20 (qry
8e60: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 (conc "SELECT "
8e70: 20 71 72 79 76 61 6c 73 20 0a 09 09 09 09 22 20 qryvals ....."
8e80: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
8e90: 20 22 20 0a 09 09 09 09 28 69 66 20 72 75 6e 2d " .....(if run-
8ea0: 69 64 73 0a 09 09 09 09 20 20 20 20 28 69 66 20 ids..... (if
8eb0: 28 6c 69 73 74 3f 20 72 75 6e 2d 69 64 73 29 0a (list? run-ids).
8ec0: 09 09 09 09 09 28 63 6f 6e 63 20 22 20 72 75 6e .....(conc " run
8ed0: 5f 69 64 20 69 6e 20 28 22 20 28 73 74 72 69 6e _id in (" (strin
8ee0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
8ef0: 61 70 20 63 6f 6e 63 20 72 75 6e 2d 69 64 73 29 ap conc run-ids)
8f00: 20 22 2c 22 29 20 22 29 20 22 29 0a 09 09 09 09 ",") ") ").....
8f10: 09 28 63 6f 6e 63 20 22 72 75 6e 5f 69 64 3d 22 .(conc "run_id="
8f20: 20 72 75 6e 2d 69 64 73 20 22 20 22 29 29 0a 09 run-ids " "))..
8f30: 09 09 09 20 20 20 20 22 20 22 29 20 3b 3b 20 23 ... " ") ;; #
8f40: 66 20 3d 3e 20 72 75 6e 2d 69 64 73 20 64 6f 6e f => run-ids don
8f50: 27 74 20 66 69 6c 74 65 72 20 6f 6e 20 72 75 6e 't filter on run
8f60: 2d 69 64 73 0a 09 09 09 09 28 69 66 20 73 74 61 -ids.....(if sta
8f70: 74 65 73 2d 71 72 79 20 20 20 28 63 6f 6e 63 20 tes-qry (conc
8f80: 22 20 41 4e 44 20 22 20 73 74 61 74 65 73 2d 71 " AND " states-q
8f90: 72 79 29 20 20 20 22 22 29 0a 09 09 09 09 28 69 ry) "").....(i
8fa0: 66 20 73 74 61 74 75 73 65 73 2d 71 72 79 20 28 f statuses-qry (
8fb0: 63 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 conc " AND " sta
8fc0: 74 75 73 65 73 2d 71 72 79 29 20 22 22 29 0a 09 tuses-qry) "")..
8fd0: 09 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 74 ...(if tests-mat
8fe0: 63 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 41 ch-qry (conc " A
8ff0: 4e 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 63 ND (" tests-matc
9000: 68 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 0a h-qry ") ") "").
9010: 09 09 09 09 28 63 61 73 65 20 73 6f 72 74 2d 62 ....(case sort-b
9020: 79 0a 09 09 09 09 20 20 28 28 72 75 6e 64 69 72 y..... ((rundir
9030: 29 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 59 ) " ORDER BY
9040: 20 6c 65 6e 67 74 68 28 72 75 6e 64 69 72 29 20 length(rundir)
9050: 44 45 53 43 3b 22 29 0a 09 09 09 09 20 20 28 28 DESC;")..... ((
9060: 65 76 65 6e 74 5f 74 69 6d 65 29 20 22 20 4f 52 event_time) " OR
9070: 44 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d DER BY event_tim
9080: 65 20 41 53 43 3b 22 29 0a 09 09 09 09 20 20 28 e ASC;")..... (
9090: 65 6c 73 65 20 20 20 20 20 20 20 20 20 22 3b 22 else ";"
90a0: 29 29 0a 09 09 09 20 29 29 29 0a 20 20 20 20 28 )).... ))). (
90b0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
90c0: 20 38 20 22 64 62 3a 67 65 74 2d 74 65 73 74 73 8 "db:get-tests
90d0: 2d 66 6f 72 2d 72 75 6e 20 71 72 79 3d 22 20 71 -for-run qry=" q
90e0: 72 79 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ry). (sqlite3
90f0: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 :for-each-row .
9100: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 2e (lambda (a .
9110: 20 62 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 b) ;; id run-id
9120: 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 testname state
9130: 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d status event-tim
9140: 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 e host cpuload d
9150: 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 iskfree uname ru
9160: 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 ndir item-path r
9170: 75 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 un-duration fina
9180: 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a l-logf comment).
9190: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
91a0: 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 (cons (apply ve
91b0: 63 74 6f 72 20 61 20 62 29 20 72 65 73 29 29 29 ctor a b) res)))
91c0: 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 ;; id run-id te
91d0: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 stname state sta
91e0: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 tus event-time h
91f0: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
9200: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 free uname rundi
9210: 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d r item-path run-
9220: 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c duration final-l
9230: 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 ogf comment) res
9240: 29 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 ))). db .
9250: 20 20 71 72 79 0a 20 20 20 20 20 29 0a 20 20 20 qry. ).
9260: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
9270: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 74 65 fo 11 "db:get-te
9280: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 41 52 sts-for-run STAR
9290: 54 20 72 75 6e 2d 69 64 73 3d 22 20 72 75 6e 2d T run-ids=" run-
92a0: 69 64 73 20 22 2c 20 74 65 73 74 70 61 74 74 3d ids ", testpatt=
92b0: 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 " testpatt ", st
92c0: 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c ates=" states ",
92d0: 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 statuses=" stat
92e0: 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 uses ", not-in="
92f0: 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d not-in ", sort-
9300: 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 by=" sort-by).
9310: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 74 68 69 73 res))..;; this
9320: 20 6f 6e 65 20 69 73 20 61 20 62 69 74 20 62 72 one is a bit br
9330: 6f 6b 65 6e 20 42 55 47 20 46 49 58 4d 45 0a 28 oken BUG FIXME.(
9340: 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 define (db:delet
9350: 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f e-test-step-reco
9360: 72 64 73 20 64 62 20 74 65 73 74 2d 69 64 20 23 rds db test-id #
9370: 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 !key (work-area
9380: 23 66 29 29 0a 20 20 3b 3b 20 42 72 65 61 6b 69 #f)). ;; Breaki
9390: 6e 67 20 69 74 20 69 6e 74 6f 20 74 77 6f 20 71 ng it into two q
93a0: 75 65 72 69 65 73 20 66 6f 72 20 62 65 74 74 65 ueries for bette
93b0: 72 20 66 69 6c 65 20 61 63 63 65 73 73 20 69 6e r file access in
93c0: 74 65 72 6c 65 61 76 69 6e 67 0a 20 20 28 6c 65 terleaving. (le
93d0: 74 2a 20 28 28 74 64 62 20 28 64 62 3a 6f 70 65 t* ((tdb (db:ope
93e0: 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
93f0: 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 20 t-id db test-id
9400: 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d work-area: work-
9410: 61 72 65 61 29 29 29 0a 20 20 20 20 3b 3b 20 74 area))). ;; t
9420: 65 73 74 20 64 62 27 73 20 63 61 6e 20 67 6f 20 est db's can go
9430: 61 77 61 79 20 2d 20 6d 75 73 74 20 63 68 65 63 away - must chec
9440: 6b 20 65 76 65 72 79 20 74 69 6d 65 0a 20 20 20 k every time.
9450: 20 28 69 66 20 74 64 62 0a 09 28 62 65 67 69 6e (if tdb..(begin
9460: 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
9470: 63 75 74 65 20 74 64 62 20 22 44 45 4c 45 54 45 cute tdb "DELETE
9480: 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 FROM test_steps
9490: 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ;").. (sqlite3:
94a0: 65 78 65 63 75 74 65 20 74 64 62 20 22 44 45 4c execute tdb "DEL
94b0: 45 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 ETE FROM test_da
94c0: 74 61 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 ta;").. (sqlite
94d0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 3:finalize! tdb)
94e0: 29 29 29 29 0a 0a 3b 3b 20 0a 28 64 65 66 69 6e ))))..;; .(defin
94f0: 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 e (db:delete-tes
9500: 74 2d 72 65 63 6f 72 64 73 20 64 62 20 74 64 62 t-records db tdb
9510: 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 28 test-id #!key (
9520: 66 6f 72 63 65 20 23 66 29 29 0a 20 20 28 63 6f force #f)). (co
9530: 6d 6d 6f 6e 3a 63 6c 65 61 72 2d 63 61 63 68 65 mmon:clear-cache
9540: 73 29 0a 20 20 28 69 66 20 74 64 62 20 0a 20 20 s). (if tdb .
9550: 20 20 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c (begin..(sql
9560: 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 ite3:execute tdb
9570: 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 "DELETE FROM te
9580: 73 74 5f 73 74 65 70 73 3b 22 29 0a 09 28 73 71 st_steps;")..(sq
9590: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 lite3:execute td
95a0: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
95b0: 65 73 74 5f 64 61 74 61 3b 22 29 29 29 0a 20 20 est_data;"))).
95c0: 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ;; (sqlite3:exec
95d0: 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 ute db "DELETE F
95e0: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
95f0: 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 29 id=?;" test-id))
9600: 0a 20 20 28 69 66 20 64 62 20 0a 20 20 20 20 20 . (if db .
9610: 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 65 (begin..(sqlite
9620: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 45 3:execute db "DE
9630: 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 LETE FROM test_s
9640: 74 65 70 73 20 57 48 45 52 45 20 74 65 73 74 5f teps WHERE test_
9650: 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 0a id=?;" test-id).
9660: 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 .(sqlite3:execut
9670: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f e db "DELETE FRO
9680: 4d 20 74 65 73 74 5f 64 61 74 61 20 20 57 48 45 M test_data WHE
9690: 52 45 20 74 65 73 74 5f 69 64 3d 3f 3b 22 20 74 RE test_id=?;" t
96a0: 65 73 74 2d 69 64 29 0a 09 28 69 66 20 66 6f 72 est-id)..(if for
96b0: 63 65 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 ce.. (sqlite3
96c0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c :execute db "DEL
96d0: 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 ETE FROM tests W
96e0: 48 45 52 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 HERE id=?;" test
96f0: 2d 69 64 29 0a 09 20 20 20 20 28 73 71 6c 69 74 -id).. (sqlit
9700: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
9710: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
9720: 73 74 61 74 65 3d 27 44 45 4c 45 54 45 44 27 2c state='DELETED',
9730: 73 74 61 74 75 73 3d 27 6e 2f 61 27 20 57 48 45 status='n/a' WHE
9740: 52 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 RE id=?;" test-i
9750: 64 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 d)))))..(define
9760: 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 73 (db:delete-tests
9770: 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d -for-run db run-
9780: 69 64 29 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c id). (common:cl
9790: 65 61 72 2d 63 61 63 68 65 73 29 0a 20 20 28 73 ear-caches). (s
97a0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
97b0: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
97c0: 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 ests WHERE run_i
97d0: 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a d=?;" run-id))..
97e0: 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 (define (db:dele
97f0: 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 te-old-deleted-t
9800: 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 29 0a est-records db).
9810: 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 72 2d (common:clear-
9820: 63 61 63 68 65 73 29 0a 20 20 28 6c 65 74 20 28 caches). (let (
9830: 28 74 61 72 67 74 69 6d 65 20 28 2d 20 28 63 75 (targtime (- (cu
9840: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2a rrent-seconds)(*
9850: 20 33 30 20 32 34 20 36 30 20 36 30 29 29 29 29 30 24 60 60))))
9860: 20 3b 3b 20 6f 6e 65 20 6d 6f 6e 74 68 20 69 6e ;; one month in
9870: 20 74 68 65 20 70 61 73 74 0a 20 20 20 20 28 73 the past. (s
9880: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
9890: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
98a0: 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 ests WHERE state
98b0: 3d 27 44 45 4c 45 54 45 44 27 20 41 4e 44 20 65 ='DELETED' AND e
98c0: 76 65 6e 74 5f 74 69 6d 65 3c 3f 3b 22 20 74 61 vent_time<?;" ta
98d0: 72 67 74 69 6d 65 29 29 29 0a 0a 3b 3b 20 73 65 rgtime)))..;; se
98e0: 74 20 74 65 73 74 73 20 77 69 74 68 20 73 74 61 t tests with sta
98f0: 74 65 20 63 75 72 72 73 74 61 74 65 20 61 6e 64 te currstate and
9900: 20 73 74 61 74 75 73 20 63 75 72 72 73 74 61 74 status currstat
9910: 75 73 20 74 6f 20 6e 65 77 73 74 61 74 65 20 61 us to newstate a
9920: 6e 64 20 6e 65 77 73 74 61 74 75 73 0a 3b 3b 20 nd newstatus.;;
9930: 75 73 65 20 63 75 72 72 73 74 61 74 65 20 3d 20 use currstate =
9940: 23 66 20 61 6e 64 20 6f 72 20 63 75 72 72 73 74 #f and or currst
9950: 61 74 75 73 20 3d 20 23 66 20 74 6f 20 61 70 70 atus = #f to app
9960: 6c 79 20 74 6f 20 61 6e 79 20 73 74 61 74 65 20 ly to any state
9970: 6f 72 20 73 74 61 74 75 73 20 72 65 73 70 65 63 or status respec
9980: 74 69 76 65 6c 79 0a 3b 3b 20 57 41 52 4e 49 4e tively.;; WARNIN
9990: 47 3a 20 53 51 4c 20 69 6e 6a 65 63 74 69 6f 6e G: SQL injection
99a0: 20 72 69 73 6b 2e 20 4e 42 2f 2f 20 53 65 65 20 risk. NB// See
99b0: 6e 65 77 20 62 75 74 20 6e 6f 74 20 79 65 74 20 new but not yet
99c0: 75 73 65 64 20 22 66 61 73 74 65 72 22 20 76 65 used "faster" ve
99d0: 72 73 69 6f 6e 20 62 65 6c 6f 77 0a 3b 3b 0a 28 rsion below.;;.(
99e0: 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 74 define (db:set-t
99f0: 65 73 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 ests-state-statu
9a00: 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 s db run-id test
9a10: 6e 61 6d 65 73 20 63 75 72 72 73 74 61 74 65 20 names currstate
9a20: 63 75 72 72 73 74 61 74 75 73 20 6e 65 77 73 74 currstatus newst
9a30: 61 74 65 20 6e 65 77 73 74 61 74 75 73 29 0a 20 ate newstatus).
9a40: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
9a50: 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 20 da (testname)..
9a60: 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 (let ((qry
9a70: 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 (conc "UPDATE te
9a80: 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c sts SET state=?,
9a90: 73 74 61 74 75 73 3d 3f 20 57 48 45 52 45 20 22 status=? WHERE "
9aa0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 63 .... (if c
9ab0: 75 72 72 73 74 61 74 65 20 20 28 63 6f 6e 63 20 urrstate (conc
9ac0: 22 73 74 61 74 65 3d 27 22 20 63 75 72 72 73 74 "state='" currst
9ad0: 61 74 65 20 22 27 20 41 4e 44 20 22 29 20 22 22 ate "' AND ") ""
9ae0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ).... (if
9af0: 63 75 72 72 73 74 61 74 75 73 20 28 63 6f 6e 63 currstatus (conc
9b00: 20 22 73 74 61 74 75 73 3d 27 22 20 63 75 72 72 "status='" curr
9b10: 73 74 61 74 75 73 20 22 27 20 41 4e 44 20 22 29 status "' AND ")
9b20: 20 22 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 "").... "
9b30: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
9b40: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 4e 4f 54 stname=? AND NOT
9b50: 20 28 69 74 65 6d 5f 70 61 74 68 3d 27 27 20 41 (item_path='' A
9b60: 4e 44 20 74 65 73 74 6e 61 6d 65 20 69 6e 20 28 ND testname in (
9b70: 53 45 4c 45 43 54 20 44 49 53 54 49 4e 43 54 20 SELECT DISTINCT
9b80: 74 65 73 74 6e 61 6d 65 20 46 52 4f 4d 20 74 65 testname FROM te
9b90: 73 74 73 20 57 48 45 52 45 20 74 65 73 74 6e 61 sts WHERE testna
9ba0: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
9bb0: 74 68 20 21 3d 20 27 27 29 29 3b 22 29 29 29 0a th != ''));"))).
9bc0: 09 09 3b 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 ..;;(debug:print
9bd0: 20 30 20 22 51 52 59 3a 20 22 20 71 72 79 29 0a 0 "QRY: " qry).
9be0: 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ..(sqlite3:execu
9bf0: 74 65 20 64 62 20 71 72 79 20 72 75 6e 2d 69 64 te db qry run-id
9c00: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
9c10: 74 75 73 20 74 65 73 74 6e 61 6d 65 20 74 65 73 tus testname tes
9c20: 74 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 74 65 tname))).. te
9c30: 73 74 6e 61 6d 65 73 29 29 0a 0a 0a 28 64 65 66 stnames))...(def
9c40: 69 6e 65 20 28 63 64 62 3a 73 65 74 2d 74 65 73 ine (cdb:set-tes
9c50: 74 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d ts-state-status-
9c60: 66 61 73 74 65 72 20 73 65 72 76 65 72 64 61 74 faster serverdat
9c70: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
9c80: 73 20 63 75 72 72 73 74 61 74 65 20 63 75 72 72 s currstate curr
9c90: 73 74 61 74 75 73 20 6e 65 77 73 74 61 74 65 20 status newstate
9ca0: 6e 65 77 73 74 61 74 75 73 29 0a 20 20 3b 3b 20 newstatus). ;;
9cb0: 43 6f 6e 76 65 72 74 20 23 66 20 74 6f 20 77 69 Convert #f to wi
9cc0: 6c 64 63 61 72 64 20 25 0a 20 20 28 69 66 20 28 ldcard %. (if (
9cd0: 6e 75 6c 6c 3f 20 74 65 73 74 6e 61 6d 65 73 29 null? testnames)
9ce0: 0a 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 . #t.
9cf0: 28 6c 65 74 20 28 28 63 75 72 72 73 74 61 74 65 (let ((currstate
9d00: 20 20 28 69 66 20 63 75 72 72 73 74 61 74 65 20 (if currstate
9d10: 63 75 72 72 73 74 61 74 65 20 22 25 22 29 29 0a currstate "%")).
9d20: 09 20 20 20 20 28 63 75 72 72 73 74 61 74 75 73 . (currstatus
9d30: 20 28 69 66 20 63 75 72 72 73 74 61 74 75 73 20 (if currstatus
9d40: 63 75 72 72 73 74 61 74 75 73 20 22 25 22 29 29 currstatus "%"))
9d50: 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 )..(let loop ((h
9d60: 65 64 20 28 63 61 72 20 74 65 73 74 6e 61 6d 65 ed (car testname
9d70: 73 29 29 0a 09 09 20 20 20 28 74 61 6c 20 28 63 s))... (tal (c
9d80: 64 72 20 74 65 73 74 6e 61 6d 65 73 29 29 0a 09 dr testnames))..
9d90: 09 20 20 20 28 74 68 72 20 27 28 29 29 29 0a 09 . (thr '()))..
9da0: 20 20 28 6c 65 74 20 28 28 74 68 31 20 28 69 66 (let ((th1 (if
9db0: 20 6e 65 77 73 74 61 74 65 20 20 28 63 72 65 61 newstate (crea
9dc0: 74 65 2d 74 68 72 65 61 64 20 28 63 62 64 3a 63 te-thread (cbd:c
9dd0: 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 lient-call serve
9de0: 72 64 61 74 20 27 75 70 64 61 74 65 2d 74 65 73 rdat 'update-tes
9df0: 74 2d 73 74 61 74 65 20 20 23 74 20 2a 64 65 66 t-state #t *def
9e00: 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6e ault-numtries* n
9e10: 65 77 73 74 61 74 65 20 20 63 75 72 72 73 74 61 ewstate currsta
9e20: 74 65 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e te run-id testn
9e30: 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 29 20 23 ame testname)) #
9e40: 66 29 29 0a 09 09 28 74 68 32 20 28 69 66 20 6e f))...(th2 (if n
9e50: 65 77 73 74 61 74 75 73 20 28 63 72 65 61 74 65 ewstatus (create
9e60: 2d 74 68 72 65 61 64 20 28 63 62 64 3a 63 6c 69 -thread (cbd:cli
9e70: 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 ent-call serverd
9e80: 61 74 20 27 75 70 64 61 74 65 2d 74 65 73 74 2d at 'update-test-
9e90: 73 74 61 74 75 73 20 23 74 20 2a 64 65 66 61 75 status #t *defau
9ea0: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6e 65 77 lt-numtries* new
9eb0: 73 74 61 74 75 73 20 63 75 72 72 73 74 61 74 75 status currstatu
9ec0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d s run-id testnam
9ed0: 65 20 74 65 73 74 6e 61 6d 65 29 29 20 23 66 29 e testname)) #f)
9ee0: 29 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d )).. (thread-
9ef0: 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 start! th1)..
9f00: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
9f10: 74 68 32 29 0a 09 20 20 20 20 28 69 66 20 28 6e th2).. (if (n
9f20: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 28 6c 6f 6f ull? tal)...(loo
9f30: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
9f40: 74 61 6c 29 28 63 6f 6e 73 20 74 68 31 20 28 63 tal)(cons th1 (c
9f50: 6f 6e 73 20 74 68 32 20 74 68 72 29 29 29 0a 09 ons th2 thr)))..
9f60: 09 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 28 6c .(for-each... (l
9f70: 61 6d 62 64 61 20 28 74 68 29 0a 09 09 20 20 20 ambda (th)...
9f80: 28 69 66 20 74 68 20 28 74 68 72 65 61 64 2d 6a (if th (thread-j
9f90: 6f 69 6e 21 20 74 68 29 29 29 0a 09 09 20 74 68 oin! th)))... th
9fa0: 72 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e r)))))))..(defin
9fb0: 65 20 28 63 64 62 3a 64 65 6c 65 74 65 2d 74 65 e (cdb:delete-te
9fc0: 73 74 73 2d 69 6e 2d 73 74 61 74 65 20 73 65 72 sts-in-state ser
9fd0: 76 65 72 64 61 74 20 72 75 6e 2d 69 64 20 73 74 verdat run-id st
9fe0: 61 74 65 29 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 63 ate). (common:c
9ff0: 6c 65 61 72 2d 63 61 63 68 65 73 29 0a 20 20 28 lear-caches). (
a000: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
a010: 73 65 72 76 65 72 64 61 74 20 27 64 65 6c 65 74 serverdat 'delet
a020: 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 65 e-tests-in-state
a030: 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d #t *default-num
a040: 74 72 69 65 73 2a 20 72 75 6e 2d 69 64 20 73 74 tries* run-id st
a050: 61 74 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ate))..(define (
a060: 63 64 62 3a 74 65 73 74 73 2d 75 70 64 61 74 65 cdb:tests-update
a070: 2d 63 70 75 6c 6f 61 64 2d 64 69 73 6b 66 72 65 -cpuload-diskfre
a080: 65 20 73 65 72 76 65 72 64 61 74 20 74 65 73 74 e serverdat test
a090: 2d 69 64 20 63 70 75 6c 6f 61 64 20 64 69 73 6b -id cpuload disk
a0a0: 66 72 65 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 free). (cdb:cli
a0b0: 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 ent-call serverd
a0c0: 61 74 20 27 75 70 64 61 74 65 2d 63 70 75 6c 6f at 'update-cpulo
a0d0: 61 64 2d 64 69 73 6b 66 72 65 65 20 23 74 20 2a ad-diskfree #t *
a0e0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
a0f0: 2a 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 * cpuload diskfr
a100: 65 65 20 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 ee test-id))..(d
a110: 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 73 efine (cdb:tests
a120: 2d 75 70 64 61 74 65 2d 72 75 6e 2d 64 75 72 61 -update-run-dura
a130: 74 69 6f 6e 20 73 65 72 76 65 72 64 61 74 20 74 tion serverdat t
a140: 65 73 74 2d 69 64 20 6d 69 6e 75 74 65 73 29 0a est-id minutes).
a150: 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 (cdb:client-ca
a160: 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 75 70 ll serverdat 'up
a170: 64 61 74 65 2d 72 75 6e 2d 64 75 72 61 74 69 6f date-run-duratio
a180: 6e 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 n #t *default-nu
a190: 6d 74 72 69 65 73 2a 20 6d 69 6e 75 74 65 73 20 mtries* minutes
a1a0: 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 test-id))..(defi
a1b0: 6e 65 20 28 63 64 62 3a 74 65 73 74 73 2d 75 70 ne (cdb:tests-up
a1c0: 64 61 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 date-uname-host
a1d0: 73 65 72 76 65 72 64 61 74 20 74 65 73 74 2d 69 serverdat test-i
a1e0: 64 20 75 6e 61 6d 65 20 68 6f 73 74 6e 61 6d 65 d uname hostname
a1f0: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d ). (cdb:client-
a200: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 call serverdat '
a210: 75 70 64 61 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 update-uname-hos
a220: 74 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 t #t *default-nu
a230: 6d 74 72 69 65 73 2a 20 74 65 73 74 2d 69 64 20 mtries* test-id
a240: 75 6e 61 6d 65 20 68 6f 73 74 6e 61 6d 65 29 29 uname hostname))
a250: 0a 0a 3b 3b 20 73 70 65 65 64 20 75 70 20 66 6f ..;; speed up fo
a260: 72 20 63 6f 6d 6d 6f 6e 20 63 61 73 65 73 20 77 r common cases w
a270: 69 74 68 20 61 20 6c 69 74 74 6c 65 20 6c 6f 67 ith a little log
a280: 69 63 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 ic.(define (db:t
a290: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
a2a0: 61 74 75 73 2d 62 79 2d 69 64 20 64 62 20 74 65 atus-by-id db te
a2b0: 73 74 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e st-id newstate n
a2c0: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
a2d0: 65 6e 74 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 ent). (cond.
a2e0: 28 28 61 6e 64 20 6e 65 77 73 74 61 74 65 20 6e ((and newstate n
a2f0: 65 77 73 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d ewstatus newcomm
a300: 65 6e 74 29 0a 20 20 20 20 28 73 71 6c 69 74 65 ent). (sqlite
a310: 33 3a 65 78 65 63 74 75 74 65 20 64 62 20 22 55 3:exectute db "U
a320: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
a330: 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f state=?,status=?
a340: 2c 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 ,comment=? WHERE
a350: 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 id=?;" newstate
a360: 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 74 2d newstatus test-
a370: 69 64 29 29 0a 20 20 20 28 28 61 6e 64 20 6e 65 id)). ((and ne
a380: 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 wstate newstatus
a390: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
a3a0: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
a3b0: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
a3c0: 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 45 e=?,status=? WHE
a3d0: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 RE id=?;" newsta
a3e0: 74 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 te newstatus tes
a3f0: 74 2d 69 64 29 29 0a 20 20 20 28 65 6c 73 65 0a t-id)). (else.
a400: 20 20 20 20 28 69 66 20 6e 65 77 73 74 61 74 65 (if newstate
a410: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
a420: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
a430: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f ests SET state=?
a440: 20 20 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 WHERE id=?;"
a450: 6e 65 77 73 74 61 74 65 20 20 20 74 65 73 74 2d newstate test-
a460: 69 64 29 29 0a 20 20 20 20 28 69 66 20 6e 65 77 id)). (if new
a470: 73 74 61 74 75 73 20 20 28 73 71 6c 69 74 65 33 status (sqlite3
a480: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
a490: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
a4a0: 61 74 75 73 3d 3f 20 20 57 48 45 52 45 20 69 64 atus=? WHERE id
a4b0: 3d 3f 3b 22 20 6e 65 77 73 74 61 74 75 73 20 20 =?;" newstatus
a4c0: 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 28 69 test-id)). (i
a4d0: 66 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 28 73 71 f newcomment (sq
a4e0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
a4f0: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
a500: 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 ET comment=? WHE
a510: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 63 6f 6d RE id=?;" newcom
a520: 6d 65 6e 74 20 74 65 73 74 2d 69 64 29 29 29 29 ment test-id))))
a530: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 )..(define (db:t
a540: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
a550: 61 74 75 73 2d 62 79 2d 72 75 6e 2d 69 64 2d 74 atus-by-run-id-t
a560: 65 73 74 6e 61 6d 65 20 64 62 20 72 75 6e 2d 69 estname db run-i
a570: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
a580: 2d 70 61 74 68 20 73 74 61 74 75 73 20 73 74 61 -path status sta
a590: 74 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 te). (sqlite3:e
a5a0: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
a5b0: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
a5c0: 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 65 76 65 e=?,status=?,eve
a5d0: 6e 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 nt_time=strftime
a5e0: 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 ('%s','now') WHE
a5f0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
a600: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
a610: 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 0a 09 09 tem_path=?;" ...
a620: 20 20 20 73 74 61 74 65 20 73 74 61 74 75 73 20 state status
a630: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
a640: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 item-path))..(d
a650: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 63 6f efine (db:get-co
a660: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
a670: 67 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 72 g db). (let ((r
a680: 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 6c 69 es 0)). (sqli
a690: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
a6a0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 . (lambda (c
a6b0: 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 ount). (se
a6c0: 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 t! res count)).
a6d0: 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c db. "SEL
a6e0: 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 ECT count(id) FR
a6f0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 73 OM tests WHERE s
a700: 74 61 74 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e tate in ('RUNNIN
a710: 47 27 2c 27 4c 41 55 4e 43 48 45 44 27 2c 27 52 G','LAUNCHED','R
a720: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 29 EMOTEHOSTSTART')
a730: 3b 22 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 ;"). res))..(
a740: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 define (db:get-r
a750: 75 6e 6e 69 6e 67 2d 73 74 61 74 73 20 64 62 29 unning-stats db)
a760: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 . (let ((res '(
a770: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ))). (sqlite3
a780: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
a790: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 (lambda (stat
a7a0: 65 20 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 e count).
a7b0: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
a7c0: 28 6c 69 73 74 20 73 74 61 74 65 20 63 6f 75 6e (list state coun
a7d0: 74 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 t) res))). d
a7e0: 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 73 b. "SELECT s
a7f0: 74 61 74 65 2c 63 6f 75 6e 74 28 69 64 29 20 46 tate,count(id) F
a800: 52 4f 4d 20 74 65 73 74 73 20 47 52 4f 55 50 20 ROM tests GROUP
a810: 42 59 20 73 74 61 74 65 20 4f 52 44 45 52 20 42 BY state ORDER B
a820: 59 20 69 64 20 44 45 53 43 3b 22 29 0a 20 20 20 Y id DESC;").
a830: 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
a840: 28 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 (db:get-count-te
a850: 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a sts-running-in-j
a860: 6f 62 67 72 6f 75 70 20 64 62 20 6a 6f 62 67 72 obgroup db jobgr
a870: 6f 75 70 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 oup). (if (not
a880: 6a 6f 62 67 72 6f 75 70 29 0a 20 20 20 20 20 20 jobgroup).
a890: 30 20 3b 3b 20 0a 20 20 20 20 20 20 28 6c 65 74 0 ;; . (let
a8a0: 20 28 28 72 65 73 20 30 29 29 0a 09 28 73 71 6c ((res 0))..(sql
a8b0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
a8c0: 77 0a 09 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 w.. (lambda (cou
a8d0: 6e 74 29 0a 09 20 20 20 28 73 65 74 21 20 72 65 nt).. (set! re
a8e0: 73 20 63 6f 75 6e 74 29 29 0a 09 20 64 62 0a 09 s count)).. db..
a8f0: 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 "SELECT count(i
a900: 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 d) FROM tests WH
a910: 45 52 45 20 73 74 61 74 65 20 3d 20 27 52 55 4e ERE state = 'RUN
a920: 4e 49 4e 47 27 20 4f 52 20 73 74 61 74 65 20 3d NING' OR state =
a930: 20 27 4c 41 55 4e 43 48 45 44 27 20 4f 52 20 73 'LAUNCHED' OR s
a940: 74 61 74 65 20 3d 20 27 52 45 4d 4f 54 45 48 4f tate = 'REMOTEHO
a950: 53 54 53 54 41 52 54 27 0a 20 20 20 20 20 20 20 STSTART'.
a960: 20 20 20 20 20 20 41 4e 44 20 74 65 73 74 6e 61 AND testna
a970: 6d 65 20 69 6e 20 28 53 45 4c 45 43 54 20 74 65 me in (SELECT te
a980: 73 74 6e 61 6d 65 20 46 52 4f 4d 20 74 65 73 74 stname FROM test
a990: 5f 6d 65 74 61 20 57 48 45 52 45 20 6a 6f 62 67 _meta WHERE jobg
a9a0: 72 6f 75 70 3d 3f 3b 22 0a 09 20 6a 6f 62 67 72 roup=?;".. jobgr
a9b0: 6f 75 70 29 0a 09 72 65 73 29 29 29 0a 0a 3b 3b oup)..res)))..;;
a9c0: 20 64 6f 6e 65 20 77 69 74 68 20 72 75 6e 20 77 done with run w
a9d0: 68 65 6e 3a 0a 3b 3b 20 20 20 30 20 74 65 73 74 hen:.;; 0 test
a9e0: 73 20 69 6e 20 4c 41 55 4e 43 48 45 44 2c 20 4e s in LAUNCHED, N
a9f0: 4f 54 5f 53 54 41 52 54 45 44 2c 20 52 45 4d 4f OT_STARTED, REMO
aa00: 54 45 48 4f 53 54 53 54 41 52 54 2c 20 52 55 4e TEHOSTSTART, RUN
aa10: 4e 49 4e 47 0a 28 64 65 66 69 6e 65 20 28 64 62 NING.(define (db
aa20: 3a 65 73 74 69 6d 61 74 65 64 2d 74 65 73 74 73 :estimated-tests
aa30: 2d 72 65 6d 61 69 6e 69 6e 67 20 64 62 20 72 75 -remaining db ru
aa40: 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72 n-id). (let ((r
aa50: 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 6c 69 es 0)). (sqli
aa60: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
aa70: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 . (lambda (c
aa80: 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 ount). (se
aa90: 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 t! res count)).
aaa0: 20 20 20 20 64 62 20 3b 3b 20 4e 42 2f 2f 20 4b db ;; NB// K
aab0: 49 4c 4c 52 45 51 20 6d 65 61 6e 73 20 74 68 65 ILLREQ means the
aac0: 20 6a 6f 62 73 20 69 73 20 73 74 69 6c 6c 20 70 jobs is still p
aad0: 72 6f 62 61 62 6c 79 20 72 75 6e 6e 69 6e 67 0a robably running.
aae0: 20 20 20 20 20 22 53 45 4c 45 43 54 20 63 6f 75 "SELECT cou
aaf0: 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 nt(id) FROM test
ab00: 73 20 57 48 45 52 45 20 73 74 61 74 65 20 69 6e s WHERE state in
ab10: 20 28 27 4c 41 55 4e 43 48 45 44 27 2c 27 4e 4f ('LAUNCHED','NO
ab20: 54 5f 53 54 41 52 54 45 44 27 2c 27 52 45 4d 4f T_STARTED','REMO
ab30: 54 45 48 4f 53 54 53 54 41 52 54 27 2c 27 52 55 TEHOSTSTART','RU
ab40: 4e 4e 49 4e 47 27 2c 27 4b 49 4c 4c 52 45 51 27 NNING','KILLREQ'
ab50: 29 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f 3b 22 ) AND run_id=?;"
ab60: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 65 73 run-id). res
ab70: 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 75 6e 2d 69 ))..;; map run-i
ab80: 64 2c 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d d, testname item
ab90: 2d 70 61 74 68 20 74 6f 20 74 65 73 74 2d 69 64 -path to test-id
aba0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
abb0: 2d 74 65 73 74 2d 69 64 2d 63 61 63 68 65 64 20 -test-id-cached
abc0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
abd0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 me item-path).
abe0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6b 65 79 (let* ((test-key
abf0: 20 28 63 6f 6e 63 20 72 75 6e 2d 69 64 20 22 2d (conc run-id "-
ac00: 22 20 74 65 73 74 6e 61 6d 65 20 22 2d 22 20 69 " testname "-" i
ac10: 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 72 65 tem-path)).. (re
ac20: 73 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 s (hash-tab
ac30: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
ac40: 74 65 73 74 2d 69 64 73 2a 20 74 65 73 74 2d 6b test-ids* test-k
ac50: 65 79 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 ey #f))). (if
ac60: 20 72 65 73 20 0a 09 72 65 73 0a 09 28 62 65 67 res ..res..(beg
ac70: 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 in.. (sqlite3:f
ac80: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 20 or-each-row..
ac90: 28 6c 61 6d 62 64 61 20 28 69 64 29 20 3b 3b 20 (lambda (id) ;;
aca0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
acb0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
acc0: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
acd0: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
ace0: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d name rundir item
acf0: 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 -path run_durati
ad00: 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f on final_logf co
ad10: 6d 6d 65 6e 74 20 29 0a 09 20 20 20 20 20 28 73 mment ).. (s
ad20: 65 74 21 20 72 65 73 20 69 64 29 29 20 3b 3b 20 et! res id)) ;;
ad30: 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 (vector id run-i
ad40: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
ad50: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
ad60: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
ad70: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
ad80: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
ad90: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
ada0: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 al_logf comment
adb0: 29 29 29 0a 09 20 20 20 64 62 20 0a 09 20 20 20 ))).. db ..
adc0: 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 "SELECT id FROM
add0: 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f tests WHERE run_
ade0: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
adf0: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
ae00: 68 3d 3f 3b 22 0a 09 20 20 20 72 75 6e 2d 69 64 h=?;".. run-id
ae10: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
ae20: 61 74 68 29 0a 09 20 20 28 68 61 73 68 2d 74 61 ath).. (hash-ta
ae30: 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 74 2d 69 ble-set! *test-i
ae40: 64 73 2a 20 74 65 73 74 2d 6b 65 79 20 72 65 73 ds* test-key res
ae50: 29 0a 09 20 20 72 65 73 29 29 29 29 0a 0a 3b 3b ).. res))))..;;
ae60: 20 6d 61 70 20 72 75 6e 2d 69 64 2c 20 74 65 73 map run-id, tes
ae70: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 tname item-path
ae80: 74 6f 20 74 65 73 74 2d 69 64 0a 28 64 65 66 69 to test-id.(defi
ae90: 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d ne (db:get-test-
aea0: 69 64 2d 6e 6f 74 2d 63 61 63 68 65 64 20 64 62 id-not-cached db
aeb0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
aec0: 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c item-path). (l
aed0: 65 74 2a 20 28 28 72 65 73 20 23 66 29 29 0a 20 et* ((res #f)).
aee0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
aef0: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c each-row. (l
af00: 61 6d 62 64 61 20 28 69 64 29 20 3b 3b 20 20 72 ambda (id) ;; r
af10: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 un-id testname s
af20: 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e tate status even
af30: 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c t-time host cpul
af40: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 oad diskfree una
af50: 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 me rundir item-p
af60: 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e ath run_duration
af70: 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d final_logf comm
af80: 65 6e 74 20 29 0a 20 20 20 20 20 20 20 28 73 65 ent ). (se
af90: 74 21 20 72 65 73 20 69 64 29 29 20 3b 3b 20 28 t! res id)) ;; (
afa0: 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 vector id run-id
afb0: 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 testname state
afc0: 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d status event-tim
afd0: 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 e host cpuload d
afe0: 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 iskfree uname ru
aff0: 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 ndir item-path r
b000: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 un_duration fina
b010: 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 29 l_logf comment )
b020: 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 )). db .
b030: 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d "SELECT id FROM
b040: 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e tests WHERE run
b050: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
b060: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
b070: 74 68 3d 3f 3b 22 0a 20 20 20 20 20 72 75 6e 2d th=?;". run-
b080: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
b090: 2d 70 61 74 68 29 0a 20 20 20 20 72 65 73 29 29 -path). res))
b0a0: 0a 0a 28 64 65 66 69 6e 65 20 64 62 3a 67 65 74 ..(define db:get
b0b0: 2d 74 65 73 74 2d 69 64 20 64 62 3a 67 65 74 2d -test-id db:get-
b0c0: 74 65 73 74 2d 69 64 2d 6e 6f 74 2d 63 61 63 68 test-id-not-cach
b0d0: 65 64 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 ed)..;; given a
b0e0: 74 65 73 74 2d 69 6e 66 6f 20 72 65 63 6f 72 64 test-info record
b0f0: 2c 20 70 61 74 63 68 20 69 6e 20 74 68 65 20 6c , patch in the l
b100: 61 74 65 73 74 20 64 61 74 61 20 66 72 6f 6d 20 atest data from
b110: 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 66 the testdat.db f
b120: 69 6c 65 0a 3b 3b 20 66 6f 75 6e 64 20 69 6e 20 ile.;; found in
b130: 74 68 65 20 74 65 73 74 20 72 75 6e 20 64 69 72 the test run dir
b140: 65 63 74 6f 72 79 0a 3b 3b 0a 3b 3b 20 4e 4f 54 ectory.;;.;; NOT
b150: 20 55 53 45 44 0a 3b 3b 0a 28 64 65 66 69 6e 65 USED.;;.(define
b160: 20 28 64 62 3a 70 61 74 63 68 2d 74 64 62 2d 64 (db:patch-tdb-d
b170: 61 74 61 2d 69 6e 74 6f 2d 74 65 73 74 2d 69 6e ata-into-test-in
b180: 66 6f 20 64 62 20 74 65 73 74 2d 69 64 20 72 65 fo db test-id re
b190: 73 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 s #!key (work-ar
b1a0: 65 61 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 ea #f)). (let (
b1b0: 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 (tdb (db:open-te
b1c0: 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 st-db-by-test-id
b1d0: 20 64 62 20 74 65 73 74 2d 69 64 20 77 6f 72 6b db test-id work
b1e0: 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 -area: work-area
b1f0: 29 29 29 0a 20 20 20 20 3b 3b 20 67 65 74 20 73 ))). ;; get s
b200: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 tate and status
b210: 66 72 6f 6d 20 6d 65 67 61 74 65 73 74 2e 64 62 from megatest.db
b220: 20 69 6e 20 72 65 61 6c 20 74 69 6d 65 0a 20 20 in real time.
b230: 20 20 3b 3b 20 6f 74 68 65 72 20 66 69 65 6c 64 ;; other field
b240: 73 20 74 68 61 74 20 70 65 72 68 61 70 73 20 73 s that perhaps s
b250: 68 6f 75 6c 64 20 62 65 20 75 70 64 61 74 65 64 hould be updated
b260: 3a 0a 20 20 20 20 3b 3b 20 20 20 66 61 69 6c 5f :. ;; fail_
b270: 63 6f 75 6e 74 0a 20 20 20 20 3b 3b 20 20 20 70 count. ;; p
b280: 61 73 73 5f 63 6f 75 6e 74 0a 20 20 20 20 3b 3b ass_count. ;;
b290: 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 0a 20 20 final_logf.
b2a0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
b2b0: 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
b2c0: 6d 62 64 61 20 28 73 74 61 74 65 20 73 74 61 74 mbda (state stat
b2d0: 75 73 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 us final_logf).
b2e0: 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 (db:test-s
b2f0: 65 74 2d 73 74 61 74 65 21 20 20 20 20 20 20 20 et-state!
b300: 20 72 65 73 20 73 74 61 74 65 29 0a 20 20 20 20 res state).
b310: 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d (db:test-set-
b320: 73 74 61 74 75 73 21 20 20 20 20 20 20 20 72 65 status! re
b330: 73 20 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 s status).
b340: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 66 69 (db:test-set-fi
b350: 6e 61 6c 5f 6c 6f 67 66 21 20 20 20 72 65 73 20 nal_logf! res
b360: 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a 20 20 20 final_logf)).
b370: 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 db. "SELEC
b380: 54 20 73 74 61 74 65 2c 73 74 61 74 75 73 2c 66 T state,status,f
b390: 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20 74 inal_logf FROM t
b3a0: 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b ests WHERE id=?;
b3b0: 22 0a 20 20 20 20 20 74 65 73 74 2d 69 64 29 0a ". test-id).
b3c0: 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 (if tdb..(be
b3d0: 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a gin.. (sqlite3:
b3e0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 for-each-row..
b3f0: 20 28 6c 61 6d 62 64 61 20 28 75 70 64 61 74 65 (lambda (update
b400: 5f 74 69 6d 65 20 63 70 75 6c 6f 61 64 20 64 69 _time cpuload di
b410: 73 6b 5f 66 72 65 65 20 72 75 6e 5f 64 75 72 61 sk_free run_dura
b420: 74 69 6f 6e 29 0a 09 20 20 20 20 20 28 64 62 3a tion).. (db:
b430: 74 65 73 74 2d 73 65 74 2d 63 70 75 6c 6f 61 64 test-set-cpuload
b440: 21 20 20 20 20 20 20 72 65 73 20 63 70 75 6c 6f ! res cpulo
b450: 61 64 29 0a 09 20 20 20 20 20 28 64 62 3a 74 65 ad).. (db:te
b460: 73 74 2d 73 65 74 2d 64 69 73 6b 66 72 65 65 21 st-set-diskfree!
b470: 20 20 20 20 20 72 65 73 20 64 69 73 6b 5f 66 72 res disk_fr
b480: 65 65 29 0a 09 20 20 20 20 20 28 64 62 3a 74 65 ee).. (db:te
b490: 73 74 2d 73 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-set-run_durat
b4a0: 69 6f 6e 21 20 72 65 73 20 72 75 6e 5f 64 75 72 ion! res run_dur
b4b0: 61 74 69 6f 6e 29 29 0a 09 20 20 20 74 64 62 0a ation)).. tdb.
b4c0: 09 20 20 20 22 53 45 4c 45 43 54 20 75 70 64 61 . "SELECT upda
b4d0: 74 65 5f 74 69 6d 65 2c 63 70 75 6c 6f 61 64 2c te_time,cpuload,
b4e0: 64 69 73 6b 66 72 65 65 2c 72 75 6e 5f 64 75 72 diskfree,run_dur
b4f0: 61 74 69 6f 6e 20 46 52 4f 4d 20 74 65 73 74 5f ation FROM test_
b500: 72 75 6e 64 61 74 20 4f 52 44 45 52 20 42 59 20 rundat ORDER BY
b510: 69 64 20 44 45 53 43 20 4c 49 4d 49 54 20 31 3b id DESC LIMIT 1;
b520: 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 ").. (sqlite3:f
b530: 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 29 0a 09 inalize! tdb))..
b540: 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 64 ;; if the test d
b550: 62 20 69 73 20 6e 6f 74 20 66 6f 75 6e 64 20 77 b is not found w
b560: 68 61 74 20 74 6f 20 64 6f 3f 0a 09 3b 3b 20 31 hat to do?..;; 1
b570: 2e 20 73 65 74 20 73 74 61 74 65 20 74 6f 20 44 . set state to D
b580: 45 4c 45 54 45 44 0a 09 3b 3b 20 32 2e 20 73 65 ELETED..;; 2. se
b590: 74 20 73 74 61 74 75 73 20 74 6f 20 6e 2f 61 0a t status to n/a.
b5a0: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 62 3a 74 .(begin.. (db:t
b5b0: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 20 20 est-set-state!
b5c0: 72 65 73 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 res "NOT_STARTED
b5d0: 22 29 0a 09 20 20 28 64 62 3a 74 65 73 74 2d 73 ").. (db:test-s
b5e0: 65 74 2d 73 74 61 74 75 73 21 20 72 65 73 20 22 et-status! res "
b5f0: 6e 2f 61 22 29 29 29 29 29 0a 0a 28 64 65 66 69 n/a")))))..(defi
b600: 6e 65 20 2a 6c 61 73 74 2d 74 65 73 74 2d 63 61 ne *last-test-ca
b610: 63 68 65 2d 64 65 6c 65 74 65 2a 20 28 63 75 72 che-delete* (cur
b620: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 0a rent-seconds))..
b630: 28 64 65 66 69 6e 65 20 28 64 62 3a 63 6c 65 61 (define (db:clea
b640: 6e 2d 61 6c 6c 2d 63 61 63 68 65 73 29 0a 20 20 n-all-caches).
b650: 28 73 65 74 21 20 2a 74 65 73 74 2d 69 6e 66 6f (set! *test-info
b660: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
b670: 6c 65 29 29 0a 20 20 28 73 65 74 21 20 2a 74 65 le)). (set! *te
b680: 73 74 2d 69 64 2d 63 61 63 68 65 2a 20 28 6d 61 st-id-cache* (ma
b690: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
b6a0: 0a 0a 3b 3b 20 55 73 65 20 64 62 3a 74 65 73 74 ..;; Use db:test
b6b0: 2d 67 65 74 2a 20 74 6f 20 61 63 63 65 73 73 0a -get* to access.
b6c0: 3b 3b 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 64 ;;.;; Get test d
b6d0: 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f 69 ata using test_i
b6e0: 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 d.(define (db:ge
b6f0: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
b700: 64 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 d db test-id).
b710: 28 69 66 20 28 6e 6f 74 20 74 65 73 74 2d 69 64 (if (not test-id
b720: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ). (begin..
b730: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
b740: 6f 20 34 20 22 64 62 3a 67 65 74 2d 74 65 73 74 o 4 "db:get-test
b750: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 63 61 6c 6c -info-by-id call
b760: 65 64 20 77 69 74 68 20 74 65 73 74 2d 69 64 3d ed with test-id=
b770: 22 20 74 65 73 74 2d 69 64 29 0a 09 23 66 29 0a " test-id)..#f).
b780: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
b790: 20 23 66 29 29 0a 09 28 73 71 6c 69 74 65 33 3a #f))..(sqlite3:
b7a0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 for-each-row.. (
b7b0: 6c 61 6d 62 64 61 20 28 69 64 20 72 75 6e 2d 69 lambda (id run-i
b7c0: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
b7d0: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
b7e0: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
b7f0: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
b800: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
b810: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
b820: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 al_logf comment)
b830: 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 .. ;;
b840: 20 20 20 20 20 20 20 20 30 20 20 20 20 31 20 20 0 1
b850: 20 20 20 20 20 32 20 20 20 20 20 20 33 20 20 20 2 3
b860: 20 20 20 34 20 20 20 20 20 20 20 20 35 20 20 20 4 5
b870: 20 20 20 20 36 20 20 20 20 20 20 37 20 20 20 20 6 7
b880: 20 20 20 20 38 20 20 20 20 20 39 20 20 20 20 20 8 9
b890: 31 30 20 20 20 20 20 20 31 31 20 20 20 20 20 20 10 11
b8a0: 20 20 20 20 31 32 20 20 20 20 20 20 20 20 20 20 12
b8b0: 31 33 20 20 20 20 20 20 20 31 34 0a 09 20 20 20 13 14..
b8c0: 28 73 65 74 21 20 72 65 73 20 28 76 65 63 74 6f (set! res (vecto
b8d0: 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 r id run-id test
b8e0: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
b8f0: 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 s event-time hos
b900: 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 t cpuload diskfr
b910: 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 ee uname rundir
b920: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 item-path run_du
b930: 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 ration final_log
b940: 66 20 63 6f 6d 6d 65 6e 74 29 29 29 0a 09 20 64 f comment))).. d
b950: 62 20 0a 09 20 22 53 45 4c 45 43 54 20 69 64 2c b .. "SELECT id,
b960: 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c run_id,testname,
b970: 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 state,status,eve
b980: 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 nt_time,host,cpu
b990: 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e load,diskfree,un
b9a0: 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d 5f ame,rundir,item_
b9b0: 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 69 6f path,run_duratio
b9c0: 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d n,final_logf,com
b9d0: 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 ment FROM tests
b9e0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 09 20 74 WHERE id=?;".. t
b9f0: 65 73 74 2d 69 64 29 0a 09 72 65 73 29 29 29 0a est-id)..res))).
ba00: 0a 3b 3b 20 55 73 65 20 64 62 3a 74 65 73 74 2d .;; Use db:test-
ba10: 67 65 74 2a 20 74 6f 20 61 63 63 65 73 73 0a 3b get* to access.;
ba20: 3b 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 64 61 ;.;; Get test da
ba30: 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f 69 64 ta using test_id
ba40: 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 s.(define (db:ge
ba50: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
ba60: 64 73 20 64 62 20 74 65 73 74 2d 69 64 73 29 0a ds db test-ids).
ba70: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 (if (null? tes
ba80: 74 2d 69 64 73 29 0a 20 20 20 20 20 20 28 62 65 t-ids). (be
ba90: 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e gin..(debug:prin
baa0: 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 74 t-info 4 "db:get
bab0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
bac0: 73 20 63 61 6c 6c 65 64 20 77 69 74 68 20 74 65 s called with te
bad0: 73 74 2d 69 64 73 3d 22 20 74 65 73 74 2d 69 64 st-ids=" test-id
bae0: 73 29 0a 09 27 28 29 29 0a 20 20 20 20 20 20 28 s)..'()). (
baf0: 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a let ((res '())).
bb00: 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 .(sqlite3:for-ea
bb10: 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 61 ch-row.. (lambda
bb20: 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 (id run-id test
bb30: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
bb40: 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 s event-time hos
bb50: 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 t cpuload diskfr
bb60: 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 ee uname rundir
bb70: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 item-path run_du
bb80: 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 ration final_log
bb90: 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 3b f comment).. ;
bba0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
bbb0: 20 20 30 20 20 20 20 31 20 20 20 20 20 20 20 32 0 1 2
bbc0: 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20 20 3 4
bbd0: 20 20 20 20 20 20 35 20 20 20 20 20 20 20 36 20 5 6
bbe0: 20 20 20 20 20 37 20 20 20 20 20 20 20 20 38 20 7 8
bbf0: 20 20 20 20 39 20 20 20 20 20 31 30 20 20 20 20 9 10
bc00: 20 20 31 31 20 20 20 20 20 20 20 20 20 20 31 32 11 12
bc10: 20 20 20 20 20 20 20 20 20 20 31 33 20 20 20 20 13
bc20: 20 20 20 31 34 0a 09 20 20 20 28 73 65 74 21 20 14.. (set!
bc30: 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f res (cons (vecto
bc40: 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 r id run-id test
bc50: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
bc60: 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 s event-time hos
bc70: 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 t cpuload diskfr
bc80: 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 ee uname rundir
bc90: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 item-path run_du
bca0: 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 ration final_log
bcb0: 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 20 20 f comment)....
bcc0: 20 72 65 73 29 29 29 0a 09 20 64 62 20 0a 09 20 res))).. db ..
bcd0: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 (conc "SELECT id
bce0: 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 ,run_id,testname
bcf0: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
bd00: 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 ent_time,host,cp
bd10: 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 uload,diskfree,u
bd20: 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d name,rundir,item
bd30: 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 69 _path,run_durati
bd40: 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f on,final_logf,co
bd50: 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 mment FROM tests
bd60: 20 57 48 45 52 45 20 69 64 20 69 6e 20 28 22 0a WHERE id in (".
bd70: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
bd80: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
bd90: 20 63 6f 6e 63 20 74 65 73 74 2d 69 64 73 29 20 conc test-ids)
bda0: 22 2c 22 29 20 22 29 3b 22 29 29 0a 09 72 65 73 ",") ");"))..res
bdb0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
bdc0: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 :get-test-info d
bdd0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d b run-id testnam
bde0: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
bdf0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
be00: 2d 62 79 2d 69 64 20 64 62 20 28 64 62 3a 67 65 -by-id db (db:ge
be10: 74 2d 74 65 73 74 2d 69 64 20 64 62 20 72 75 6e t-test-id db run
be20: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 -id testname ite
be30: 6d 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 m-path)))..(defi
be40: 6e 65 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d ne (db:test-set-
be50: 63 6f 6d 6d 65 6e 74 20 64 62 20 74 65 73 74 2d comment db test-
be60: 69 64 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73 id comment). (s
be70: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a qlite3:execute .
be80: 20 20 20 64 62 20 0a 20 20 20 22 55 50 44 41 54 db . "UPDAT
be90: 45 20 74 65 73 74 73 20 53 45 54 20 63 6f 6d 6d E tests SET comm
bea0: 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f ent=? WHERE id=?
beb0: 3b 22 0a 20 20 20 63 6f 6d 6d 65 6e 74 20 74 65 ;". comment te
bec0: 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 st-id))..(define
bed0: 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 (cdb:test-set-r
bee0: 75 6e 64 69 72 21 20 73 65 72 76 65 72 64 61 74 undir! serverdat
bef0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
bf00: 65 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 64 e item-path rund
bf10: 69 72 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e ir). (cdb:clien
bf20: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
bf30: 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 'test-set-rundi
bf40: 72 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 r #t *default-nu
bf50: 6d 74 72 69 65 73 2a 20 72 75 6e 64 69 72 20 72 mtries* rundir r
bf60: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
bf70: 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 item-path))..(de
bf80: 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 73 fine (cdb:test-s
bf90: 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 et-rundir-by-tes
bfa0: 74 2d 69 64 20 73 65 72 76 65 72 64 61 74 20 74 t-id serverdat t
bfb0: 65 73 74 2d 69 64 20 72 75 6e 64 69 72 29 0a 20 est-id rundir).
bfc0: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
bfd0: 6c 20 73 65 72 76 65 72 64 61 74 20 27 74 65 73 l serverdat 'tes
bfe0: 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d t-set-rundir-by-
bff0: 74 65 73 74 2d 69 64 20 23 74 20 2a 64 65 66 61 test-id #t *defa
c000: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 72 75 ult-numtries* ru
c010: 6e 64 69 72 20 74 65 73 74 2d 69 64 29 29 0a 0a ndir test-id))..
c020: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
c030: 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d -get-rundir-from
c040: 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 -test-id db test
c050: 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72 65 -id). (let ((re
c060: 73 20 23 66 29 29 20 3b 3b 20 28 68 61 73 68 2d s #f)) ;; (hash-
c070: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
c080: 74 20 2a 74 65 73 74 2d 70 61 74 68 73 2a 20 74 t *test-paths* t
c090: 65 73 74 2d 69 64 20 23 66 29 29 29 0a 20 20 20 est-id #f))).
c0a0: 20 3b 3b 20 28 69 66 20 72 65 73 0a 20 20 20 20 ;; (if res.
c0b0: 3b 3b 20 20 20 20 20 72 65 73 0a 20 20 20 20 3b ;; res. ;
c0c0: 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 ; (begin.
c0d0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
c0e0: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d ch-row. (lam
c0f0: 62 64 61 20 28 74 70 61 74 68 29 0a 20 20 20 20 bda (tpath).
c100: 20 20 20 28 73 65 74 21 20 72 65 73 20 74 70 61 (set! res tpa
c110: 74 68 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 th)). db .
c120: 20 20 20 22 53 45 4c 45 43 54 20 72 75 6e 64 69 "SELECT rundi
c130: 72 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 r FROM tests WHE
c140: 52 45 20 69 64 3d 3f 3b 22 0a 20 20 20 20 20 74 RE id=?;". t
c150: 65 73 74 2d 69 64 29 0a 20 20 20 20 3b 3b 20 28 est-id). ;; (
c160: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
c170: 2a 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 *test-paths* tes
c180: 74 2d 69 64 20 72 65 73 29 0a 20 20 20 20 72 65 t-id res). re
c190: 73 29 29 20 3b 3b 20 29 29 0a 0a 28 64 65 66 69 s)) ;; ))..(defi
c1a0: 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 ne (cdb:test-set
c1b0: 2d 6c 6f 67 21 20 73 65 72 76 65 72 64 61 74 20 -log! serverdat
c1c0: 74 65 73 74 2d 69 64 20 6c 6f 67 66 29 0a 20 20 test-id logf).
c1d0: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 (if (string? log
c1e0: 66 29 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 f)(cdb:client-ca
c1f0: 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 74 65 ll serverdat 'te
c200: 73 74 2d 73 65 74 2d 6c 6f 67 20 23 66 20 2a 64 st-set-log #f *d
c210: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a efault-numtries*
c220: 20 6c 6f 67 66 20 74 65 73 74 2d 69 64 29 29 29 logf test-id)))
c230: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
c240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 ==========.;; Mi
c280: 73 63 2e 20 74 65 73 74 20 72 65 6c 61 74 65 64 sc. test related
c290: 20 71 75 65 72 69 65 73 0a 3b 3b 3d 3d 3d 3d 3d queries.;;=====
c2a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c2e0: 3d 0a 0a 3b 3b 20 4d 55 53 54 20 42 45 20 43 41 =..;; MUST BE CA
c2f0: 4c 4c 45 44 20 6c 6f 63 61 6c 21 0a 28 64 65 66 LLED local!.(def
c300: 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ine (db:test-get
c310: 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 -paths-matching
c320: 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 db keynames targ
c330: 65 74 20 66 6e 61 6d 65 70 61 74 74 20 23 21 6b et fnamepatt #!k
c340: 65 79 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 ey (res '())).
c350: 3b 3b 20 42 55 47 3a 20 4d 6f 76 65 20 74 68 65 ;; BUG: Move the
c360: 20 76 61 6c 75 65 73 20 64 65 72 69 76 65 64 20 values derived
c370: 66 72 6f 6d 20 61 72 67 73 20 74 6f 20 70 61 72 from args to par
c380: 61 6d 65 74 65 72 73 20 61 6e 64 20 70 75 73 68 ameters and push
c390: 20 74 6f 20 6d 65 67 61 74 65 73 74 2e 73 63 6d to megatest.scm
c3a0: 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 70 . (let* ((testp
c3b0: 61 74 74 20 20 20 28 69 66 20 28 61 72 67 73 3a att (if (args:
c3c0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
c3d0: 74 74 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 tt")(args:get-ar
c3e0: 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 g "-testpatt") "
c3f0: 25 22 29 29 0a 09 20 28 73 74 61 74 65 70 61 74 %")).. (statepat
c400: 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 t (if (args:get
c410: 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 -arg ":state")
c420: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
c430: 3a 73 74 61 74 65 22 29 20 20 20 20 22 25 22 29 :state") "%")
c440: 29 0a 09 20 28 73 74 61 74 75 73 70 61 74 74 20 ).. (statuspatt
c450: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
c460: 67 20 22 3a 73 74 61 74 75 73 22 29 20 20 28 61 g ":status") (a
c470: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
c480: 61 74 75 73 22 29 20 20 20 22 25 22 29 29 0a 09 atus") "%"))..
c490: 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 28 69 66 (runname (if
c4a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
c4b0: 3a 72 75 6e 6e 61 6d 65 22 29 20 28 61 72 67 73 :runname") (args
c4c0: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
c4d0: 6d 65 22 29 20 20 22 25 22 29 29 0a 09 20 28 70 me") "%")).. (p
c4e0: 61 74 68 73 2d 66 72 6f 6d 2d 64 62 20 28 63 64 aths-from-db (cd
c4f0: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
c500: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
c510: 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 atching-keynames
c520: 2d 74 61 72 67 65 74 20 64 62 20 6b 65 79 6e 61 -target db keyna
c530: 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 0a 09 mes target res..
c540: 09 09 09 09 74 65 73 74 70 61 74 74 3a 20 20 20 ....testpatt:
c550: 74 65 73 74 70 61 74 74 0a 09 09 09 09 09 73 74 testpatt......st
c560: 61 74 65 70 61 74 74 3a 20 20 73 74 61 74 65 70 atepatt: statep
c570: 61 74 74 0a 09 09 09 09 09 73 74 61 74 75 73 70 att......statusp
c580: 61 74 74 3a 20 73 74 61 74 75 73 70 61 74 74 0a att: statuspatt.
c590: 09 09 09 09 09 72 75 6e 6e 61 6d 65 3a 20 20 20 .....runname:
c5a0: 20 72 75 6e 6e 61 6d 65 29 29 29 0a 20 20 20 20 runname))).
c5b0: 28 69 66 20 66 6e 61 6d 65 70 61 74 74 0a 09 28 (if fnamepatt..(
c5c0: 61 70 70 6c 79 20 61 70 70 65 6e 64 20 0a 09 20 apply append ..
c5d0: 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 (map (lamb
c5e0: 64 61 20 28 70 29 0a 09 09 20 20 20 20 20 20 28 da (p)... (
c5f0: 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 if (directory-ex
c600: 69 73 74 73 3f 20 70 29 0a 09 09 09 20 20 28 67 ists? p).... (g
c610: 6c 6f 62 20 28 63 6f 6e 63 20 70 20 22 2f 22 20 lob (conc p "/"
c620: 66 6e 61 6d 65 70 61 74 74 29 29 0a 09 09 09 20 fnamepatt))....
c630: 20 27 28 29 29 29 0a 09 09 20 20 20 20 70 61 74 '()))... pat
c640: 68 73 2d 66 72 6f 6d 2d 64 62 29 29 0a 09 70 61 hs-from-db))..pa
c650: 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 29 0a 0a ths-from-db)))..
c660: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
c670: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
c680: 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 61 72 ing-keynames-tar
c690: 67 65 74 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 get db keynames
c6a0: 74 61 72 67 65 74 20 72 65 73 20 0a 09 09 09 09 target res .....
c6b0: 09 09 20 20 20 20 23 21 6b 65 79 0a 09 09 09 09 .. #!key.....
c6c0: 09 09 20 20 20 20 28 74 65 73 74 70 61 74 74 20 .. (testpatt
c6d0: 20 20 22 25 22 29 0a 09 09 09 09 09 09 20 20 20 "%").......
c6e0: 20 28 73 74 61 74 65 70 61 74 74 20 20 22 25 22 (statepatt "%"
c6f0: 29 0a 09 09 09 09 09 09 20 20 20 20 28 73 74 61 )....... (sta
c700: 74 75 73 70 61 74 74 20 22 25 22 29 0a 09 09 09 tuspatt "%")....
c710: 09 09 09 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 ... (runname
c720: 20 20 20 22 25 22 29 29 0a 20 20 28 6c 65 74 2a "%")). (let*
c730: 20 28 28 6b 65 79 73 74 72 20 28 73 74 72 69 6e ((keystr (strin
c740: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a 09 g-intersperse ..
c750: 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 . (map (lambda
c760: 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 28 63 (key val).... (c
c770: 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 20 6c onc "r." key " l
c780: 69 6b 65 20 27 22 20 76 61 6c 20 22 27 22 29 29 ike '" val "'"))
c790: 0a 09 09 20 20 20 20 20 20 20 6b 65 79 6e 61 6d ... keynam
c7a0: 65 73 20 0a 09 09 20 20 20 20 20 20 20 28 73 74 es ... (st
c7b0: 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 67 65 ring-split targe
c7c0: 74 20 22 2f 22 29 29 0a 09 09 20 20 22 20 41 4e t "/"))... " AN
c7d0: 44 20 22 29 29 0a 09 20 28 74 65 73 74 71 72 79 D ")).. (testqry
c7e0: 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 (tests:match->s
c7f0: 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 29 29 qlqry testpatt))
c800: 0a 09 20 28 71 72 79 73 74 72 20 28 63 6f 6e 63 .. (qrystr (conc
c810: 20 22 53 45 4c 45 43 54 20 74 2e 72 75 6e 64 69 "SELECT t.rundi
c820: 72 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53 20 r FROM tests AS
c830: 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 72 75 6e t INNER JOIN run
c840: 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 75 6e 5f s AS r ON t.run_
c850: 69 64 3d 72 2e 69 64 20 57 48 45 52 45 20 22 0a id=r.id WHERE ".
c860: 09 09 20 20 20 20 20 20 20 6b 65 79 73 74 72 20 .. keystr
c870: 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 6d 65 20 " AND r.runname
c880: 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d 65 20 LIKE '" runname
c890: 22 27 20 41 4e 44 20 22 20 74 65 73 74 71 72 79 "' AND " testqry
c8a0: 0a 09 09 20 20 20 20 20 20 20 22 20 41 4e 44 20 ... " AND
c8b0: 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 22 20 t.state LIKE '"
c8c0: 73 74 61 74 65 70 61 74 74 20 22 27 20 41 4e 44 statepatt "' AND
c8d0: 20 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 20 27 t.status LIKE '
c8e0: 22 20 73 74 61 74 75 73 70 61 74 74 20 0a 09 09 " statuspatt ...
c8f0: 20 20 20 20 20 20 20 22 27 20 4f 52 44 45 52 20 "' ORDER
c900: 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 6d 65 20 BY t.event_time
c910: 41 53 43 3b 22 29 29 29 0a 20 20 20 20 28 64 65 ASC;"))). (de
c920: 62 75 67 3a 70 72 69 6e 74 20 33 20 22 71 72 79 bug:print 3 "qry
c930: 73 74 72 3a 20 22 20 71 72 79 73 74 72 29 0a 20 str: " qrystr).
c940: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
c950: 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 each-row . (
c960: 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 20 20 20 lambda (p).
c970: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
c980: 73 20 70 20 72 65 73 29 29 29 0a 20 20 20 20 20 s p res))).
c990: 64 62 20 0a 20 20 20 20 20 71 72 79 73 74 72 29 db . qrystr)
c9a0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 6c . res))..;; l
c9b0: 6f 6f 6b 20 74 68 72 6f 75 67 68 20 74 65 73 74 ook through test
c9c0: 73 20 66 72 6f 6d 20 6d 61 74 63 68 69 6e 67 20 s from matching
c9d0: 72 75 6e 73 20 66 6f 72 20 61 20 66 69 6c 65 0a runs for a file.
c9e0: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
c9f0: 2d 67 65 74 2d 66 69 72 73 74 2d 70 61 74 68 2d -get-first-path-
ca00: 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e matching db keyn
ca10: 61 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 6d ames target fnam
ca20: 65 29 0a 20 20 3b 3b 20 5b 72 65 66 70 61 74 68 e). ;; [refpath
ca30: 73 5d 20 69 73 20 74 68 65 20 73 65 63 74 69 6f s] is the sectio
ca40: 6e 20 77 68 65 72 65 20 72 65 66 65 72 65 6e 63 n where referenc
ca50: 65 73 20 74 6f 20 6f 74 68 65 72 20 6d 65 67 61 es to other mega
ca60: 74 65 73 74 20 64 61 74 61 62 61 73 65 73 20 61 test databases a
ca70: 72 65 20 73 74 6f 72 65 64 0a 20 20 28 6c 65 74 re stored. (let
ca80: 20 28 28 6d 74 2d 70 61 74 68 73 20 28 63 6f 6e ((mt-paths (con
ca90: 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e figf:get-section
caa0: 20 22 72 65 66 70 61 74 68 73 22 29 29 0a 09 28 "refpaths"))..(
cab0: 72 65 73 20 20 20 20 20 20 20 28 64 62 3a 74 65 res (db:te
cac0: 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
cad0: 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 ching db keyname
cae0: 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 29 29 s target fname))
caf0: 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ). (let loop
cb00: 28 28 70 61 74 68 64 61 74 20 28 69 66 20 28 6e ((pathdat (if (n
cb10: 75 6c 6c 3f 20 70 61 74 68 73 29 20 23 66 20 28 ull? paths) #f (
cb20: 63 61 72 20 6d 74 2d 70 61 74 68 73 29 29 29 0a car mt-paths))).
cb30: 09 20 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 . (tal
cb40: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 74 68 (if (null? path
cb50: 73 29 20 27 28 29 28 63 64 72 20 6d 74 2d 70 61 s) '()(cdr mt-pa
cb60: 74 68 73 29 29 29 29 0a 20 20 20 20 20 20 28 69 ths)))). (i
cb70: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 f (not (null? re
cb80: 73 29 29 0a 09 20 20 28 63 61 72 20 72 65 73 29 s)).. (car res)
cb90: 20 3b 3b 20 72 65 74 75 72 6e 20 66 69 72 73 74 ;; return first
cba0: 20 66 6f 75 6e 64 0a 09 20 20 28 69 66 20 70 61 found.. (if pa
cbb0: 74 68 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 th.. (let*
cbc0: 28 28 64 62 20 20 20 20 20 28 6f 70 65 6e 2d 64 ((db (open-d
cbd0: 62 20 70 61 74 68 3a 20 28 63 61 64 72 20 70 61 b path: (cadr pa
cbe0: 74 68 64 61 74 29 29 29 0a 09 09 20 20 20 20 20 thdat)))...
cbf0: 28 6e 65 77 72 65 73 20 28 64 62 3a 74 65 73 74 (newres (db:test
cc00: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
cc10: 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 ing db keynames
cc20: 74 61 72 67 65 74 20 66 6e 61 6d 65 29 29 29 0a target fname))).
cc30: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
cc40: 6e 66 6f 20 34 20 22 54 72 79 69 6e 67 20 22 20 nfo 4 "Trying "
cc50: 28 63 61 72 20 70 61 74 68 64 61 74 29 20 22 20 (car pathdat) "
cc60: 61 74 20 22 20 28 63 61 64 72 20 70 61 74 68 64 at " (cadr pathd
cc70: 61 74 29 29 0a 09 09 28 73 71 6c 69 74 65 33 3a at))...(sqlite3:
cc80: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 finalize! db)...
cc90: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
cca0: 6e 65 77 72 65 73 29 29 0a 09 09 20 20 20 20 28 newres))... (
ccb0: 63 61 72 20 6e 65 77 72 65 73 29 0a 09 09 20 20 car newres)...
ccc0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
ccd0: 29 0a 09 09 09 23 66 0a 09 09 09 28 6c 6f 6f 70 )....#f....(loop
cce0: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
ccf0: 61 6c 29 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b al))))))))))..;;
cd00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd40: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 55 45 55 45 20 ======.;; QUEUE
cd50: 55 50 20 4d 45 54 41 2c 20 54 45 53 54 20 53 54 UP META, TEST ST
cd60: 41 54 55 53 20 41 4e 44 20 53 54 45 50 53 20 52 ATUS AND STEPS R
cd70: 45 4d 4f 54 45 20 41 43 43 45 53 53 0a 3b 3b 3d EMOTE ACCESS.;;=
cd80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cd90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cdb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cdc0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 =====..;; NOTE:
cdd0: 43 61 6e 20 72 65 6d 6f 76 65 20 74 68 65 20 72 Can remove the r
cde0: 65 67 65 78 20 61 6e 64 20 62 61 73 65 36 34 20 egex and base64
cdf0: 65 6e 63 6f 64 69 6e 67 20 66 6f 72 20 7a 6d 71 encoding for zmq
ce00: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 6f 62 6a .(define (db:obj
ce10: 2d 3e 73 74 72 69 6e 67 20 6f 62 6a 29 0a 20 20 ->string obj).
ce20: 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 (case *transport
ce30: 2d 74 79 70 65 2a 0a 20 20 20 20 28 28 66 73 29 -type*. ((fs)
ce40: 20 6f 62 6a 29 0a 20 20 20 20 28 28 68 74 74 70 obj). ((http
ce50: 29 0a 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 ). (string-s
ce60: 75 62 73 74 69 74 75 74 65 0a 20 20 20 20 20 20 ubstitute.
ce70: 28 72 65 67 65 78 70 20 22 3d 22 29 20 22 5f 22 (regexp "=") "_"
ce80: 0a 20 20 20 20 20 20 28 62 61 73 65 36 34 3a 62 . (base64:b
ce90: 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 28 77 69 ase64-encode (wi
cea0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 th-output-to-str
ceb0: 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 28 73 ing (lambda ()(s
cec0: 65 72 69 61 6c 69 7a 65 20 6f 62 6a 29 29 29 29 erialize obj))))
ced0: 0a 20 20 20 20 20 20 23 74 29 29 0a 20 20 20 20 . #t)).
cee0: 28 28 7a 6d 71 29 28 77 69 74 68 2d 6f 75 74 70 ((zmq)(with-outp
cef0: 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 ut-to-string (la
cf00: 6d 62 64 61 20 28 29 28 73 65 72 69 61 6c 69 7a mbda ()(serializ
cf10: 65 20 6f 62 6a 29 29 29 29 0a 20 20 20 20 28 65 e obj)))). (e
cf20: 6c 73 65 20 6f 62 6a 29 29 29 0a 0a 28 64 65 66 lse obj)))..(def
cf30: 69 6e 65 20 28 64 62 3a 73 74 72 69 6e 67 2d 3e ine (db:string->
cf40: 6f 62 6a 20 6d 73 67 29 0a 20 20 28 63 61 73 65 obj msg). (case
cf50: 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 *transport-type
cf60: 2a 0a 20 20 20 28 28 66 73 29 20 6d 73 67 29 0a *. ((fs) msg).
cf70: 20 20 20 28 28 68 74 74 70 29 0a 20 20 20 20 28 ((http). (
cf80: 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d with-input-from-
cf90: 73 74 72 69 6e 67 20 0a 20 20 20 20 20 20 20 28 string . (
cfa0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
cfb0: 63 6f 64 65 0a 20 20 20 20 20 20 20 20 20 28 73 code. (s
cfc0: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
cfd0: 20 0a 09 20 20 20 28 72 65 67 65 78 70 20 22 5f .. (regexp "_
cfe0: 22 29 20 22 3d 22 20 6d 73 67 20 23 74 29 29 0a ") "=" msg #t)).
cff0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
d000: 29 28 64 65 73 65 72 69 61 6c 69 7a 65 29 29 29 )(deserialize)))
d010: 29 0a 20 20 20 28 28 7a 6d 71 29 28 77 69 74 68 ). ((zmq)(with
d020: 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 -input-from-stri
d030: 6e 67 20 6d 73 67 20 28 6c 61 6d 62 64 61 20 28 ng msg (lambda (
d040: 29 28 64 65 73 65 72 69 61 6c 69 7a 65 29 29 29 )(deserialize)))
d050: 29 0a 20 20 20 28 65 6c 73 65 20 6d 73 67 29 29 ). (else msg))
d060: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
d070: 75 73 65 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 use-non-blocking
d080: 2d 6d 6f 64 65 20 70 72 6f 63 29 0a 20 20 28 73 -mode proc). (s
d090: 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d et! *client-non-
d0a0: 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 blocking-mode* #
d0b0: 74 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 t). (let ((res
d0c0: 28 70 72 6f 63 29 29 29 0a 20 20 20 20 28 73 65 (proc))). (se
d0d0: 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d 62 t! *client-non-b
d0e0: 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 66 locking-mode* #f
d0f0: 29 0a 20 20 20 20 72 65 73 29 29 0a 20 20 0a 3b ). res)). .;
d100: 3b 20 70 61 72 61 6d 73 20 3d 20 27 74 61 72 67 ; params = 'targ
d110: 65 74 20 63 61 63 68 65 64 20 72 65 6d 70 61 72 et cached rempar
d120: 61 6d 73 0a 3b 3b 0a 3b 3b 20 6d 61 6b 65 2d 76 ams.;;.;; make-v
d130: 65 63 74 6f 72 2d 72 65 63 6f 72 64 20 63 64 62 ector-record cdb
d140: 20 70 61 63 6b 65 74 20 63 6c 69 65 6e 74 2d 73 packet client-s
d150: 69 67 20 71 74 79 70 65 20 69 6d 6d 65 64 69 61 ig qtype immedia
d160: 74 65 20 71 75 65 72 79 2d 73 69 67 20 70 61 72 te query-sig par
d170: 61 6d 73 20 71 74 69 6d 65 0a 3b 3b 0a 3b 3b 20 ams qtime.;;.;;
d180: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
d190: 69 73 20 74 68 65 20 75 6e 69 66 69 65 64 20 69 is the unified i
d1a0: 6e 74 65 72 66 61 63 65 20 74 6f 20 61 6c 6c 20 nterface to all
d1b0: 74 68 65 20 74 72 61 6e 73 70 6f 72 74 73 2e 20 the transports.
d1c0: 49 74 20 64 69 73 70 61 74 63 68 65 73 20 74 68 It dispatches th
d1d0: 65 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 e.;;
d1e0: 20 20 20 20 20 71 75 65 72 79 20 74 6f 20 61 20 query to a
d1f0: 73 65 72 76 65 72 20 72 6f 75 74 69 6e 65 20 28 server routine (
d200: 65 2e 67 2e 20 73 65 72 76 65 72 3a 63 6c 69 65 e.g. server:clie
d210: 6e 74 2d 73 65 6e 64 2d 72 65 63 69 65 76 65 29 nt-send-recieve)
d220: 20 74 68 61 74 20 0a 3b 3b 20 20 20 20 20 20 20 that .;;
d230: 20 20 20 20 20 20 20 20 20 20 74 72 61 6e 73 70 transp
d240: 6f 72 74 73 20 74 68 65 20 64 61 74 61 20 74 6f orts the data to
d250: 20 74 68 65 20 73 65 72 76 65 72 20 77 68 65 72 the server wher
d260: 65 20 69 74 20 69 73 20 70 61 73 73 65 64 20 74 e it is passed t
d270: 6f 20 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 o db:process-que
d280: 75 65 2d 69 74 65 6d 0a 3b 3b 20 20 20 20 20 20 ue-item.;;
d290: 20 20 20 20 20 20 20 20 20 20 20 77 68 69 63 68 which
d2a0: 20 65 69 74 68 65 72 20 72 65 74 75 72 6e 73 20 either returns
d2b0: 74 68 65 20 64 61 74 61 20 74 6f 20 74 68 65 20 the data to the
d2c0: 63 61 6c 6c 69 6e 67 20 73 65 72 76 65 72 20 72 calling server r
d2d0: 6f 75 74 69 6e 65 20 6f 72 20 0a 3b 3b 20 20 20 outine or .;;
d2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 di
d2f0: 72 65 63 74 6c 79 20 63 61 6c 6c 73 20 74 68 65 rectly calls the
d300: 20 72 65 74 75 72 6e 69 6e 67 20 70 72 6f 63 65 returning proce
d310: 64 75 72 65 20 28 65 2e 67 2e 20 7a 6d 71 29 2e dure (e.g. zmq).
d320: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 64 62 .;;.(define (cdb
d330: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 :client-call ser
d340: 76 65 72 64 61 74 20 71 74 79 70 65 20 69 6d 6d verdat qtype imm
d350: 65 64 69 61 74 65 20 6e 75 6d 72 65 74 72 69 65 ediate numretrie
d360: 73 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 64 s . params). (d
d370: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
d380: 31 31 20 22 63 64 62 3a 63 6c 69 65 6e 74 2d 63 11 "cdb:client-c
d390: 61 6c 6c 20 73 65 72 76 65 72 64 61 74 3d 22 20 all serverdat="
d3a0: 73 65 72 76 65 72 64 61 74 20 22 2c 20 71 74 79 serverdat ", qty
d3b0: 70 65 3d 22 20 71 74 79 70 65 20 22 2c 20 69 6d pe=" qtype ", im
d3c0: 6d 65 64 69 61 74 65 3d 22 20 69 6d 6d 65 64 69 mediate=" immedi
d3d0: 61 74 65 20 22 2c 20 6e 75 6d 72 65 74 72 69 65 ate ", numretrie
d3e0: 73 3d 22 20 6e 75 6d 72 65 74 72 69 65 73 20 22 s=" numretries "
d3f0: 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 61 6d , params=" param
d400: 73 29 0a 20 20 28 63 61 73 65 20 2a 74 72 61 6e s). (case *tran
d410: 73 70 6f 72 74 2d 74 79 70 65 2a 20 0a 20 20 20 sport-type* .
d420: 20 28 28 66 73 29 0a 20 20 20 20 20 28 6c 65 74 ((fs). (let
d430: 20 28 28 70 61 63 6b 65 74 20 28 76 65 63 74 6f ((packet (vecto
d440: 72 20 22 6e 61 22 20 71 74 79 70 65 20 69 6d 6d r "na" qtype imm
d450: 65 64 69 61 74 65 20 22 6e 61 22 20 70 61 72 61 ediate "na" para
d460: 6d 73 20 30 29 29 29 0a 20 20 20 20 20 20 20 28 ms 0))). (
d470: 66 73 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 fs:process-queue
d480: 2d 69 74 65 6d 20 70 61 63 6b 65 74 29 29 29 0a -item packet))).
d490: 20 20 20 20 28 28 68 74 74 70 29 0a 20 20 20 20 ((http).
d4a0: 20 28 6c 65 74 2a 20 28 28 63 6c 69 65 6e 74 2d (let* ((client-
d4b0: 73 69 67 20 20 28 63 6c 69 65 6e 74 3a 67 65 74 sig (client:get
d4c0: 2d 73 69 67 6e 61 74 75 72 65 29 29 0a 09 20 20 -signature))..
d4d0: 20 20 28 71 75 65 72 79 2d 73 69 67 20 20 20 28 (query-sig (
d4e0: 6d 65 73 73 61 67 65 2d 64 69 67 65 73 74 2d 73 message-digest-s
d4f0: 74 72 69 6e 67 20 28 6d 64 35 2d 70 72 69 6d 69 tring (md5-primi
d500: 74 69 76 65 29 20 28 63 6f 6e 63 20 71 74 79 70 tive) (conc qtyp
d510: 65 20 69 6d 6d 65 64 69 61 74 65 20 70 61 72 61 e immediate para
d520: 6d 73 29 29 29 0a 09 20 20 20 20 28 7a 64 61 74 ms))).. (zdat
d530: 20 20 20 20 20 20 20 20 28 64 62 3a 6f 62 6a 2d (db:obj-
d540: 3e 73 74 72 69 6e 67 20 28 76 65 63 74 6f 72 20 >string (vector
d550: 63 6c 69 65 6e 74 2d 73 69 67 20 71 74 79 70 65 client-sig qtype
d560: 20 69 6d 6d 65 64 69 61 74 65 20 71 75 65 72 79 immediate query
d570: 2d 73 69 67 20 70 61 72 61 6d 73 20 28 63 75 72 -sig params (cur
d580: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 rent-seconds))))
d590: 29 20 3b 3b 20 28 77 69 74 68 2d 6f 75 74 70 75 ) ;; (with-outpu
d5a0: 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d t-to-string (lam
d5b0: 62 64 61 20 28 29 28 73 65 72 69 61 6c 69 7a 65 bda ()(serialize
d5c0: 20 70 61 72 61 6d 73 29 29 29 29 0a 20 20 20 20 params)))).
d5d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
d5e0: 69 6e 66 6f 20 31 31 20 22 7a 64 61 74 3d 22 20 info 11 "zdat="
d5f0: 7a 64 61 74 29 0a 20 20 20 20 20 20 20 28 6c 65 zdat). (le
d600: 74 2a 20 28 28 72 65 73 20 20 23 66 29 0a 09 20 t* ((res #f)..
d610: 20 20 20 20 20 28 72 61 77 64 61 74 20 20 20 20 (rawdat
d620: 20 20 28 68 74 74 70 2d 74 72 61 6e 73 70 6f 72 (http-transpor
d630: 74 3a 63 6c 69 65 6e 74 2d 73 65 6e 64 2d 72 65 t:client-send-re
d640: 63 65 69 76 65 20 73 65 72 76 65 72 64 61 74 20 ceive serverdat
d650: 7a 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 74 zdat)).. (t
d660: 6d 70 20 20 20 20 20 20 20 20 20 23 66 29 29 0a mp #f)).
d670: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 . (debug:print-i
d680: 6e 66 6f 20 31 31 20 22 53 65 6e 74 20 22 20 7a nfo 11 "Sent " z
d690: 64 61 74 20 22 2c 20 72 65 63 65 69 76 65 64 20 dat ", received
d6a0: 22 20 72 61 77 64 61 74 29 0a 09 20 28 69 66 20 " rawdat).. (if
d6b0: 72 61 77 64 61 74 0a 09 20 20 20 20 20 28 62 65 rawdat.. (be
d6c0: 67 69 6e 0a 09 20 20 20 20 20 20 20 28 73 65 74 gin.. (set
d6d0: 21 20 74 6d 70 20 28 64 62 3a 73 74 72 69 6e 67 ! tmp (db:string
d6e0: 2d 3e 6f 62 6a 20 72 61 77 64 61 74 29 29 0a 09 ->obj rawdat))..
d6f0: 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
d700: 65 66 20 74 6d 70 20 32 29 29 0a 09 20 20 20 20 ef tmp 2))..
d710: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 (begin..
d720: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
d730: 45 52 52 4f 52 3a 20 43 6f 6d 6d 75 6e 69 63 61 ERROR: Communica
d740: 74 69 6f 6e 20 77 69 74 68 20 74 68 65 20 73 65 tion with the se
d750: 72 76 65 72 20 66 61 69 6c 65 64 2e 20 45 78 69 rver failed. Exi
d760: 74 69 6e 67 20 69 66 20 70 6f 73 73 69 62 6c 65 ting if possible
d770: 22 29 0a 09 20 20 20 20 20 20 20 28 65 78 69 74 ").. (exit
d780: 20 31 29 29 29 29 29 29 0a 20 20 20 20 28 28 7a 1)))))). ((z
d790: 6d 71 29 0a 20 20 20 20 20 28 68 61 6e 64 6c 65 mq). (handle
d7a0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 -exceptions.
d7b0: 20 20 65 78 6e 0a 20 20 20 20 20 20 28 62 65 67 exn. (beg
d7c0: 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 in..(debug:print
d7d0: 2d 69 6e 66 6f 20 30 20 22 63 64 62 3a 63 6c 69 -info 0 "cdb:cli
d7e0: 65 6e 74 2d 63 61 6c 6c 20 74 69 6d 65 6f 75 74 ent-call timeout
d7f0: 20 6f 72 20 65 72 72 6f 72 2e 20 54 72 79 69 6e or error. Tryin
d800: 67 20 61 67 61 69 6e 20 69 6e 20 35 20 73 65 63 g again in 5 sec
d810: 6f 6e 64 73 22 29 0a 09 28 74 68 72 65 61 64 2d onds")..(thread-
d820: 73 6c 65 65 70 21 20 35 29 20 0a 09 28 69 66 20 sleep! 5) ..(if
d830: 28 3e 20 6e 75 6d 72 65 74 72 69 65 73 20 30 29 (> numretries 0)
d840: 28 61 70 70 6c 79 20 63 64 62 3a 63 6c 69 65 6e (apply cdb:clien
d850: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
d860: 20 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 qtype immediate
d870: 20 28 2d 20 6e 75 6d 72 65 74 72 69 65 73 20 31 (- numretries 1
d880: 29 20 70 61 72 61 6d 73 29 29 29 0a 20 20 20 20 ) params))).
d890: 20 20 28 6c 65 74 2a 20 28 28 70 75 73 68 2d 73 (let* ((push-s
d8a0: 6f 63 6b 65 74 20 28 76 65 63 74 6f 72 2d 72 65 ocket (vector-re
d8b0: 66 20 73 65 72 76 65 72 64 61 74 20 30 29 29 0a f serverdat 0)).
d8c0: 09 20 20 20 20 20 28 73 75 62 2d 73 6f 63 6b 65 . (sub-socke
d8d0: 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 73 t (vector-ref s
d8e0: 65 72 76 65 72 64 61 74 20 31 29 29 0a 09 20 20 erverdat 1))..
d8f0: 20 20 20 28 63 6c 69 65 6e 74 2d 73 69 67 20 20 (client-sig
d900: 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 6e (client:get-sign
d910: 61 74 75 72 65 29 29 0a 09 20 20 20 20 20 28 71 ature)).. (q
d920: 75 65 72 79 2d 73 69 67 20 20 20 28 6d 65 73 73 uery-sig (mess
d930: 61 67 65 2d 64 69 67 65 73 74 2d 73 74 72 69 6e age-digest-strin
d940: 67 20 28 6d 64 35 2d 70 72 69 6d 69 74 69 76 65 g (md5-primitive
d950: 29 20 28 63 6f 6e 63 20 71 74 79 70 65 20 69 6d ) (conc qtype im
d960: 6d 65 64 69 61 74 65 20 70 61 72 61 6d 73 29 29 mediate params))
d970: 29 0a 09 20 20 20 20 20 28 7a 64 61 74 20 20 20 ).. (zdat
d980: 20 20 20 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 (db:obj->st
d990: 72 69 6e 67 20 28 76 65 63 74 6f 72 20 63 6c 69 ring (vector cli
d9a0: 65 6e 74 2d 73 69 67 20 71 74 79 70 65 20 69 6d ent-sig qtype im
d9b0: 6d 65 64 69 61 74 65 20 71 75 65 72 79 2d 73 69 mediate query-si
d9c0: 67 20 70 61 72 61 6d 73 20 28 63 75 72 72 65 6e g params (curren
d9d0: 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 20 3b 3b t-seconds)))) ;;
d9e0: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to
d9f0: 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 -string (lambda
da00: 28 29 28 73 65 72 69 61 6c 69 7a 65 20 70 61 72 ()(serialize par
da10: 61 6d 73 29 29 29 29 0a 09 20 20 20 20 20 28 72 ams)))).. (r
da20: 65 73 20 20 23 66 29 0a 09 20 20 20 20 20 28 73 es #f).. (s
da30: 65 6e 64 2d 72 65 63 65 69 76 65 20 28 6c 61 6d end-receive (lam
da40: 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 20 28 bda ().... (
da50: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
da60: 20 31 31 20 22 73 65 6e 64 69 6e 67 20 6d 65 73 11 "sending mes
da70: 73 61 67 65 22 29 0a 09 09 09 20 20 20 20 20 28 sage").... (
da80: 73 65 6e 64 2d 6d 65 73 73 61 67 65 20 70 75 73 send-message pus
da90: 68 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 0a 09 h-socket zdat)..
daa0: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
dab0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6d 65 73 int-info 11 "mes
dac0: 73 61 67 65 20 73 65 6e 74 22 29 0a 09 09 09 20 sage sent")....
dad0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 (let loop ()
dae0: 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 67 65 .... ;; ge
daf0: 74 20 74 68 65 20 73 65 6e 64 65 72 20 69 6e 66 t the sender inf
db00: 6f 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 74 o.... ;; t
db10: 68 69 73 20 73 68 6f 75 6c 64 20 6d 61 74 63 68 his should match
db20: 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 67 (client:get-sig
db30: 6e 61 74 75 72 65 29 0a 09 09 09 20 20 20 20 20 nature)....
db40: 20 20 3b 3b 20 77 65 20 77 69 6c 6c 20 6e 65 65 ;; we will nee
db50: 64 20 74 6f 20 70 72 6f 63 65 73 73 20 22 61 6c d to process "al
db60: 6c 22 20 6d 65 73 73 61 67 65 73 20 68 65 72 65 l" messages here
db70: 20 73 6f 6d 65 20 64 61 79 0a 09 09 09 20 20 20 some day....
db80: 20 20 20 20 28 72 65 63 65 69 76 65 2d 6d 65 73 (receive-mes
db90: 73 61 67 65 2a 20 73 75 62 2d 73 6f 63 6b 65 74 sage* sub-socket
dba0: 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 6e ).... ;; n
dbb0: 6f 77 20 67 65 74 20 74 68 65 20 61 63 74 75 61 ow get the actua
dbc0: 6c 20 6d 65 73 73 61 67 65 0a 09 09 09 20 20 20 l message....
dbd0: 20 20 20 20 28 6c 65 74 20 28 28 6d 79 72 65 73 (let ((myres
dbe0: 20 28 64 62 3a 73 74 72 69 6e 67 2d 3e 6f 62 6a (db:string->obj
dbf0: 20 28 72 65 63 65 69 76 65 2d 6d 65 73 73 61 67 (receive-messag
dc00: 65 2a 20 73 75 62 2d 73 6f 63 6b 65 74 29 29 29 e* sub-socket)))
dc10: 29 0a 09 09 09 09 20 28 69 66 20 28 65 71 75 61 )..... (if (equa
dc20: 6c 3f 20 71 75 65 72 79 2d 73 69 67 20 28 76 65 l? query-sig (ve
dc30: 63 74 6f 72 2d 72 65 66 20 6d 79 72 65 73 20 31 ctor-ref myres 1
dc40: 29 29 0a 09 09 09 09 20 20 20 20 20 28 73 65 74 ))..... (set
dc50: 21 20 72 65 73 20 28 76 65 63 74 6f 72 2d 72 65 ! res (vector-re
dc60: 66 20 6d 79 72 65 73 20 32 29 29 0a 09 09 09 09 f myres 2)).....
dc70: 20 20 20 20 20 28 6c 6f 6f 70 29 29 29 29 29 29 (loop))))))
dc80: 29 0a 09 20 20 20 20 3b 3b 20 28 74 69 6d 65 6f ).. ;; (timeo
dc90: 75 74 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 ut (lambda ()..
dca0: 20 20 20 3b 3b 20 20 20 20 20 09 28 6c 65 74 20 ;; .(let
dcb0: 6c 6f 6f 70 20 28 28 6e 20 6e 75 6d 72 65 74 72 loop ((n numretr
dcc0: 69 65 73 29 29 0a 09 20 20 20 20 3b 3b 20 20 20 ies)).. ;;
dcd0: 20 20 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 . (thread-sle
dce0: 65 70 21 20 31 35 29 0a 09 20 20 20 20 3b 3b 20 ep! 15).. ;;
dcf0: 20 20 20 20 09 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
dd00: 72 65 73 29 0a 09 20 20 20 20 3b 3b 20 20 20 20 res).. ;;
dd10: 20 09 20 20 20 20 20 20 28 69 66 20 28 3e 20 6e . (if (> n
dd20: 75 6d 72 65 74 72 69 65 73 20 30 29 0a 09 20 20 umretries 0)..
dd30: 20 20 3b 3b 20 20 20 20 20 09 09 20 20 28 62 65 ;; .. (be
dd40: 67 69 6e 0a 09 20 20 20 20 3b 3b 20 20 20 20 20 gin.. ;;
dd50: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
dd60: 6e 74 20 32 20 22 57 41 52 4e 49 4e 47 3a 20 6e nt 2 "WARNING: n
dd70: 6f 20 72 65 70 6c 79 20 74 6f 20 71 75 65 72 79 o reply to query
dd80: 20 22 20 70 61 72 61 6d 73 20 22 2c 20 74 72 79 " params ", try
dd90: 69 6e 67 20 72 65 73 65 6e 64 22 29 0a 09 20 20 ing resend")..
dda0: 20 20 3b 3b 20 20 20 20 20 09 09 20 20 20 20 28 ;; .. (
ddb0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
ddc0: 20 31 31 20 22 72 65 2d 73 65 6e 64 69 6e 67 20 11 "re-sending
ddd0: 6d 65 73 73 61 67 65 22 29 0a 09 20 20 20 20 3b message").. ;
dde0: 3b 20 20 20 20 20 09 09 20 20 20 20 28 73 65 6e ; .. (sen
ddf0: 64 2d 6d 65 73 73 61 67 65 20 70 75 73 68 2d 73 d-message push-s
de00: 6f 63 6b 65 74 20 7a 64 61 74 29 0a 09 20 20 20 ocket zdat)..
de10: 20 3b 3b 20 20 20 20 20 09 09 20 20 20 20 28 64 ;; .. (d
de20: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
de30: 31 31 20 22 6d 65 73 73 61 67 65 20 72 65 2d 73 11 "message re-s
de40: 65 6e 74 22 29 0a 09 20 20 20 20 3b 3b 20 20 20 ent").. ;;
de50: 20 20 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 2d .. (loop (-
de60: 20 6e 20 31 29 29 29 0a 09 20 20 20 20 3b 3b 20 n 1))).. ;;
de70: 20 20 20 20 09 09 20 20 3b 3b 20 28 61 70 70 6c .. ;; (appl
de80: 79 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c y cdb:client-cal
de90: 6c 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 71 74 l *runremote* qt
dea0: 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 28 2d ype immediate (-
deb0: 20 6e 75 6d 72 65 74 72 69 65 73 20 31 29 20 70 numretries 1) p
dec0: 61 72 61 6d 73 29 29 0a 09 20 20 20 20 3b 3b 20 arams)).. ;;
ded0: 20 20 20 20 09 09 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
dee0: 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 20 ;; ..
def0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
df00: 22 45 52 52 4f 52 3a 20 63 64 62 3a 63 6c 69 65 "ERROR: cdb:clie
df10: 6e 74 2d 63 61 6c 6c 20 74 69 6d 65 64 20 6f 75 nt-call timed ou
df20: 74 20 22 20 70 61 72 61 6d 73 20 22 2c 20 65 78 t " params ", ex
df30: 69 74 69 6e 67 2e 22 29 0a 09 20 20 20 20 3b 3b iting.").. ;;
df40: 20 20 20 20 20 09 09 20 20 20 20 28 65 78 69 74 .. (exit
df50: 20 35 29 29 29 29 29 29 29 29 0a 09 28 64 65 62 5))))))))..(deb
df60: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
df70: 20 22 53 74 61 72 74 69 6e 67 20 74 68 72 65 61 "Starting threa
df80: 64 73 22 29 0a 09 28 6c 65 74 20 28 28 74 68 31 ds")..(let ((th1
df90: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 73 65 (make-thread se
dfa0: 6e 64 2d 72 65 63 65 69 76 65 20 22 73 65 6e 64 nd-receive "send
dfb0: 20 72 65 63 65 69 76 65 22 29 29 0a 09 20 20 20 receive"))..
dfc0: 20 20 20 3b 3b 20 28 74 68 32 20 28 6d 61 6b 65 ;; (th2 (make
dfd0: 2d 74 68 72 65 61 64 20 74 69 6d 65 6f 75 74 20 -thread timeout
dfe0: 20 20 20 20 20 22 74 69 6d 65 6f 75 74 22 29 29 "timeout"))
dff0: 0a 09 20 20 20 20 20 20 29 0a 09 20 20 28 74 68 .. ).. (th
e000: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
e010: 0a 09 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 .. ;; (thread-s
e020: 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 28 74 tart! th2).. (t
e030: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 20 74 68 31 hread-join! th1
e040: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
e050: 74 2d 69 6e 66 6f 20 31 31 20 22 63 64 62 3a 63 t-info 11 "cdb:c
e060: 6c 69 65 6e 74 2d 63 61 6c 6c 20 72 65 74 75 72 lient-call retur
e070: 6e 69 6e 67 20 72 65 73 3d 22 20 72 65 73 29 0a ning res=" res).
e080: 09 20 20 72 65 73 29 29 29 29 29 29 0a 20 20 0a . res)))))). .
e090: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65 74 (define (cdb:set
e0a0: 2d 76 65 72 62 6f 73 69 74 79 20 73 65 72 76 65 -verbosity serve
e0b0: 72 64 61 74 20 76 61 6c 29 0a 20 20 28 63 64 62 rdat val). (cdb
e0c0: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 :client-call ser
e0d0: 76 65 72 64 61 74 20 27 73 65 74 2d 76 65 72 62 verdat 'set-verb
e0e0: 6f 73 69 74 79 20 23 66 20 2a 64 65 66 61 75 6c osity #f *defaul
e0f0: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 76 61 6c 29 t-numtries* val)
e100: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
e110: 6c 6f 67 69 6e 20 73 65 72 76 65 72 64 61 74 20 login serverdat
e120: 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72 65 keyval signature
e130: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d ). (cdb:client-
e140: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 call serverdat '
e150: 6c 6f 67 69 6e 20 23 74 20 2a 64 65 66 61 75 6c login #t *defaul
e160: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 79 76 t-numtries* keyv
e170: 61 6c 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 al megatest-vers
e180: 69 6f 6e 20 73 69 67 6e 61 74 75 72 65 29 29 0a ion signature)).
e190: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6c 6f .(define (cdb:lo
e1a0: 67 6f 75 74 20 73 65 72 76 65 72 64 61 74 20 6b gout serverdat k
e1b0: 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72 65 29 eyval signature)
e1c0: 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 . (cdb:client-c
e1d0: 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 6c all serverdat 'l
e1e0: 6f 67 6f 75 74 20 23 74 20 2a 64 65 66 61 75 6c ogout #t *defaul
e1f0: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 79 76 t-numtries* keyv
e200: 61 6c 20 73 69 67 6e 61 74 75 72 65 29 29 0a 0a al signature))..
e210: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6e 75 6d (define (cdb:num
e220: 2d 63 6c 69 65 6e 74 73 20 73 65 72 76 65 72 64 -clients serverd
e230: 61 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e at). (cdb:clien
e240: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
e250: 20 27 6e 75 6d 63 6c 69 65 6e 74 73 20 23 74 20 'numclients #t
e260: 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 *default-numtrie
e270: 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 s*))..(define (c
e280: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
e290: 75 73 2d 73 74 61 74 65 20 73 65 72 76 65 72 64 us-state serverd
e2a0: 61 74 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 at test-id statu
e2b0: 73 20 73 74 61 74 65 20 6d 73 67 29 0a 20 20 28 s state msg). (
e2c0: 69 66 20 6d 73 67 0a 20 20 20 20 20 20 28 63 64 if msg. (cd
e2d0: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 b:client-call se
e2e0: 72 76 65 72 64 61 74 20 27 73 74 61 74 65 2d 73 rverdat 'state-s
e2f0: 74 61 74 75 73 2d 6d 73 67 20 23 74 20 2a 64 65 tatus-msg #t *de
e300: 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 fault-numtries*
e310: 73 74 61 74 65 20 73 74 61 74 75 73 20 6d 73 67 state status msg
e320: 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20 20 test-id).
e330: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c (cdb:client-call
e340: 20 73 65 72 76 65 72 64 61 74 20 27 73 74 61 74 serverdat 'stat
e350: 65 2d 73 74 61 74 75 73 20 23 74 20 2a 64 65 66 e-status #t *def
e360: 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 73 ault-numtries* s
e370: 74 61 74 65 20 73 74 61 74 75 73 20 74 65 73 74 tate status test
e380: 2d 69 64 29 29 29 20 3b 3b 20 72 75 6e 2d 69 64 -id))) ;; run-id
e390: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
e3a0: 70 61 74 68 20 6d 69 6e 75 74 65 73 20 63 70 75 path minutes cpu
e3b0: 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74 6d load diskfree tm
e3c0: 70 66 72 65 65 29 20 0a 0a 28 64 65 66 69 6e 65 pfree) ..(define
e3d0: 20 28 63 64 62 3a 74 65 73 74 2d 72 6f 6c 6c 75 (cdb:test-rollu
e3e0: 70 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 73 73 p-test_data-pass
e3f0: 2d 66 61 69 6c 20 73 65 72 76 65 72 64 61 74 20 -fail serverdat
e400: 74 65 73 74 2d 69 64 29 0a 20 20 28 63 64 62 3a test-id). (cdb:
e410: 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 client-call serv
e420: 65 72 64 61 74 20 27 74 65 73 74 5f 64 61 74 61 erdat 'test_data
e430: 2d 70 66 2d 72 6f 6c 6c 75 70 20 23 74 20 2a 64 -pf-rollup #t *d
e440: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a efault-numtries*
e450: 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 test-id test-id
e460: 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 test-id test-id
e470: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
e480: 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 :pass-fail-count
e490: 73 20 73 65 72 76 65 72 64 61 74 20 74 65 73 74 s serverdat test
e4a0: 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 -id fail-count p
e4b0: 61 73 73 2d 63 6f 75 6e 74 29 0a 20 20 28 63 64 ass-count). (cd
e4c0: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 b:client-call se
e4d0: 72 76 65 72 64 61 74 20 27 70 61 73 73 2d 66 61 rverdat 'pass-fa
e4e0: 69 6c 2d 63 6f 75 6e 74 73 20 23 74 20 2a 64 65 il-counts #t *de
e4f0: 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 fault-numtries*
e500: 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d fail-count pass-
e510: 63 6f 75 6e 74 20 74 65 73 74 2d 69 64 29 29 0a count test-id)).
e520: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 .(define (cdb:te
e530: 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 65 73 sts-register-tes
e540: 74 20 73 65 72 76 65 72 64 61 74 20 72 75 6e 2d t serverdat run-
e550: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
e560: 6d 2d 70 61 74 68 29 0a 20 20 28 63 64 62 3a 63 m-path). (cdb:c
e570: 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 lient-call serve
e580: 72 64 61 74 20 27 72 65 67 69 73 74 65 72 2d 74 rdat 'register-t
e590: 65 73 74 20 23 74 20 2a 64 65 66 61 75 6c 74 2d est #t *default-
e5a0: 6e 75 6d 74 72 69 65 73 2a 20 72 75 6e 2d 69 64 numtries* run-id
e5b0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
e5c0: 70 61 74 68 29 29 0a 0a 28 64 65 66 69 6e 65 20 path))..(define
e5d0: 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 (cdb:flush-queue
e5e0: 20 73 65 72 76 65 72 64 61 74 29 0a 20 20 28 63 serverdat). (c
e5f0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 db:client-call s
e600: 65 72 76 65 72 64 61 74 20 27 66 6c 75 73 68 20 erverdat 'flush
e610: 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 #f *default-numt
e620: 72 69 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 ries*))..(define
e630: 20 28 63 64 62 3a 6b 69 6c 6c 2d 73 65 72 76 65 (cdb:kill-serve
e640: 72 20 73 65 72 76 65 72 64 61 74 29 0a 20 20 28 r serverdat). (
e650: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
e660: 73 65 72 76 65 72 64 61 74 20 27 6b 69 6c 6c 73 serverdat 'kills
e670: 65 72 76 65 72 20 23 74 20 2a 64 65 66 61 75 6c erver #t *defaul
e680: 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a 0a 28 t-numtries*))..(
e690: 64 65 66 69 6e 65 20 28 63 64 62 3a 72 6f 6c 6c define (cdb:roll
e6a0: 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f -up-pass-fail-co
e6b0: 75 6e 74 73 20 73 65 72 76 65 72 64 61 74 20 72 unts serverdat r
e6c0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
e6d0: 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73 item-path status
e6e0: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d ). (cdb:client-
e6f0: 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 call serverdat '
e700: 69 6d 6d 65 64 69 61 74 65 20 23 66 20 2a 64 65 immediate #f *de
e710: 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 fault-numtries*
e720: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
e730: 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 b:roll-up-pass-f
e740: 61 69 6c 2d 63 6f 75 6e 74 73 20 23 66 20 72 75 ail-counts #f ru
e750: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
e760: 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73 29 tem-path status)
e770: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
e780: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 73 65 get-test-info se
e790: 72 76 65 72 64 61 74 20 72 75 6e 2d 69 64 20 74 rverdat run-id t
e7a0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
e7b0: 74 68 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e th). (cdb:clien
e7c0: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
e7d0: 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 20 2a 'immediate #f *
e7e0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
e7f0: 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 * open-run-close
e800: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 db:get-test-inf
e810: 6f 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 o #f run-id test
e820: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
e830: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
e840: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
e850: 2d 69 64 20 73 65 72 76 65 72 64 61 74 20 74 65 -id serverdat te
e860: 73 74 2d 69 64 29 0a 20 20 28 63 64 62 3a 63 6c st-id). (cdb:cl
e870: 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 ient-call server
e880: 64 61 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23 dat 'immediate #
e890: 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 f *default-numtr
e8a0: 69 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c ies* open-run-cl
e8b0: 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d ose db:get-test-
e8c0: 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 74 65 info-by-id #f te
e8d0: 73 74 2d 69 64 29 29 0a 0a 3b 3b 20 64 62 20 73 st-id))..;; db s
e8e0: 68 6f 75 6c 64 20 62 65 20 64 62 20 6f 70 65 6e hould be db open
e8f0: 20 70 72 6f 63 20 6f 72 20 23 66 0a 28 64 65 66 proc or #f.(def
e900: 69 6e 65 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d ine (cdb:remote-
e910: 72 75 6e 20 70 72 6f 63 20 64 62 20 2e 20 70 61 run proc db . pa
e920: 72 61 6d 73 29 0a 20 20 28 61 70 70 6c 79 20 63 rams). (apply c
e930: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 2a db:client-call *
e940: 72 75 6e 72 65 6d 6f 74 65 2a 20 27 69 6d 6d 65 runremote* 'imme
e950: 64 69 61 74 65 20 23 66 20 2a 64 65 66 61 75 6c diate #f *defaul
e960: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 65 6e t-numtries* open
e970: 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 72 6f 63 20 -run-close proc
e980: 23 66 20 70 61 72 61 6d 73 29 29 0a 0a 28 64 65 #f params))..(de
e990: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 fine (db:test-ge
e9a0: 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 64 t-logfile-info d
e9b0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
e9c0: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 me). (let ((res
e9d0: 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 #f)). (sqlit
e9e0: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
e9f0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 . (lambda (p
ea00: 61 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a ath final_logf).
ea10: 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 6f 67 (set! log
ea20: 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 f final_logf).
ea30: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
ea40: 6c 69 73 74 20 70 61 74 68 20 66 69 6e 61 6c 5f list path final_
ea50: 6c 6f 67 66 29 29 0a 20 20 20 20 20 20 20 28 69 logf)). (i
ea60: 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 70 61 f (directory? pa
ea70: 74 68 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 th).. (debug:p
ea80: 72 69 6e 74 20 32 20 22 46 6f 75 6e 64 20 70 61 rint 2 "Found pa
ea90: 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20 th: " path)..
eaa0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
eab0: 4e 6f 20 73 75 63 68 20 70 61 74 68 3a 20 22 20 No such path: "
eac0: 70 61 74 68 29 29 29 0a 20 20 20 20 20 64 62 0a path))). db.
ead0: 20 20 20 20 20 22 53 45 4c 45 43 54 20 72 75 6e "SELECT run
eae0: 64 69 72 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 dir,final_logf F
eaf0: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
eb00: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
eb10: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
eb20: 5f 70 61 74 68 3d 27 27 3b 22 0a 20 20 20 20 20 _path='';".
eb30: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
eb40: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 3d ). res))..;;=
eb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb90: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 47 20 52 20 45 =====.;; A G R E
eba0: 20 47 20 41 20 54 20 45 20 44 20 20 20 54 20 52 G A T E D T R
ebb0: 20 41 20 4e 20 53 20 41 20 43 20 54 20 49 20 4f A N S A C T I O
ebc0: 20 4e 20 20 20 44 20 42 20 20 20 57 20 52 20 49 N D B W R I
ebd0: 20 54 20 45 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d T E S .;;======
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 28 64 65 66 69 6e 65 20 64 62 3a 71 75 65 ..(define db:que
ec30: 72 69 65 73 20 0a 20 20 28 6c 69 73 74 20 27 28 ries . (list '(
ec40: 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 20 20 register-test
ec50: 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 20 4f "INSERT O
ec60: 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 74 65 R IGNORE INTO te
ec70: 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 73 74 sts (run_id,test
ec80: 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 69 6d 65 2c name,event_time,
ec90: 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c item_path,state,
eca0: 73 74 61 74 75 73 29 20 56 41 4c 55 45 53 20 28 status) VALUES (
ecb0: 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 27 25 73 ?,?,strftime('%s
ecc0: 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 4e 4f 54 5f ','now'),?,'NOT_
ecd0: 53 54 41 52 54 45 44 27 2c 27 6e 2f 61 27 29 3b STARTED','n/a');
ece0: 22 29 0a 09 27 28 73 74 61 74 65 2d 73 74 61 74 ")..'(state-stat
ecf0: 75 73 20 20 20 20 20 20 20 20 20 20 20 22 55 50 us "UP
ed00: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 DATE tests SET s
ed10: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 tate=?,status=?
ed20: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 WHERE id=?;")..'
ed30: 28 73 74 61 74 65 2d 73 74 61 74 75 73 2d 6d 73 (state-status-ms
ed40: 67 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20 g "UPDATE
ed50: 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d tests SET state=
ed60: 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 6f 6d 6d 65 ?,status=?,comme
ed70: 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b nt=? WHERE id=?;
ed80: 22 29 0a 09 27 28 70 61 73 73 2d 66 61 69 6c 2d ")..'(pass-fail-
ed90: 63 6f 75 6e 74 73 20 20 20 20 20 20 20 22 55 50 counts "UP
eda0: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 66 DATE tests SET f
edb0: 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 ail_count=?,pass
edc0: 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 52 45 20 69 _count=? WHERE i
edd0: 64 3d 3f 3b 22 29 0a 09 3b 3b 20 74 65 73 74 5f d=?;")..;; test_
ede0: 64 61 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 20 69 data-pf-rollup i
edf0: 73 20 75 73 65 64 20 74 6f 20 73 65 74 20 61 20 s used to set a
ee00: 74 65 73 74 73 20 50 41 53 53 2f 46 41 49 4c 20 tests PASS/FAIL
ee10: 62 61 73 65 64 20 6f 6e 20 74 68 65 20 70 61 73 based on the pas
ee20: 73 2f 66 61 69 6c 20 69 6e 66 6f 20 66 72 6f 6d s/fail info from
ee30: 20 74 68 65 20 73 74 65 70 73 0a 09 27 28 74 65 the steps..'(te
ee40: 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c 75 st_data-pf-rollu
ee50: 70 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 p "UPDATE tes
ee60: 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ts.
ee70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee80: 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 75 SET statu
ee90: 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 4c s=CASE WHEN (SEL
eea0: 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 20 46 ECT fail_count F
eeb0: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
eec0: 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 20 20 id=?) > 0 .
eed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eef0: 20 54 48 45 4e 20 27 46 41 49 4c 27 0a 20 20 20 THEN 'FAIL'.
ef00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef20: 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 70 61 WHEN (SELECT pa
ef30: 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 ss_count FROM te
ef40: 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 sts WHERE id=?)
ef50: 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 20 20 20 > 0 AND .
ef60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ef80: 53 45 4c 45 43 54 20 73 74 61 74 75 73 20 46 52 SELECT status FR
ef90: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 OM tests WHERE i
efa0: 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 28 27 57 41 d=?) NOT IN ('WA
efb0: 52 4e 27 2c 27 46 41 49 4c 27 29 0a 20 20 20 20 RN','FAIL').
efc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
efd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
efe0: 54 48 45 4e 20 27 50 41 53 53 27 0a 20 20 20 20 THEN 'PASS'.
eff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f010: 45 4c 53 45 20 73 74 61 74 75 73 0a 20 20 20 20 ELSE status.
f020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f040: 45 4e 44 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 END WHERE id=?;"
f050: 29 0a 09 27 28 74 65 73 74 2d 73 65 74 2d 6c 6f )..'(test-set-lo
f060: 67 20 20 20 20 20 20 20 20 20 20 20 20 22 55 50 g "UP
f070: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 66 DATE tests SET f
f080: 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 45 52 inal_logf=? WHER
f090: 45 20 69 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 E id=?;")..'(tes
f0a0: 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d t-set-rundir-by-
f0b0: 74 65 73 74 2d 69 64 20 22 55 50 44 41 54 45 20 test-id "UPDATE
f0c0: 74 65 73 74 73 20 53 45 54 20 72 75 6e 64 69 72 tests SET rundir
f0d0: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 22 29 0a =? WHERE id=?").
f0e0: 09 27 28 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 .'(test-set-rund
f0f0: 69 72 20 20 20 20 20 20 20 20 20 22 55 50 44 41 ir "UPDA
f100: 54 45 20 74 65 73 74 73 20 53 45 54 20 72 75 6e TE tests SET run
f110: 64 69 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f dir=? WHERE run_
f120: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
f130: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
f140: 68 3d 3f 3b 22 29 0a 09 27 28 64 65 6c 65 74 65 h=?;")..'(delete
f150: 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 65 20 -tests-in-state
f160: 20 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 "DELETE FROM t
f170: 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 ests WHERE state
f180: 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f 3b =? AND run_id=?;
f190: 22 29 0a 09 27 28 74 65 73 74 73 3a 74 65 73 74 ")..'(tests:test
f1a0: 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 20 20 22 55 -set-toplog "U
f1b0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
f1c0: 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 45 final_logf=? WHE
f1d0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
f1e0: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
f1f0: 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 29 0a 09 tem_path='';")..
f200: 27 28 75 70 64 61 74 65 2d 63 70 75 6c 6f 61 64 '(update-cpuload
f210: 2d 64 69 73 6b 66 72 65 65 20 22 55 50 44 41 54 -diskfree "UPDAT
f220: 45 20 74 65 73 74 73 20 53 45 54 20 63 70 75 6c E tests SET cpul
f230: 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 65 65 3d 3f oad=?,diskfree=?
f240: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 WHERE id=?;")..
f250: 27 28 75 70 64 61 74 65 2d 72 75 6e 2d 64 75 72 '(update-run-dur
f260: 61 74 69 6f 6e 20 20 20 20 20 22 55 50 44 41 54 ation "UPDAT
f270: 45 20 74 65 73 74 73 20 53 45 54 20 72 75 6e 5f E tests SET run_
f280: 64 75 72 61 74 69 6f 6e 3d 3f 20 57 48 45 52 45 duration=? WHERE
f290: 20 69 64 3d 3f 3b 22 29 0a 09 27 28 75 70 64 61 id=?;")..'(upda
f2a0: 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 20 20 te-uname-host
f2b0: 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 "UPDATE test
f2c0: 73 20 53 45 54 20 75 6e 61 6d 65 3d 3f 2c 68 6f s SET uname=?,ho
f2d0: 73 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b st=? WHERE id=?;
f2e0: 22 29 0a 09 27 28 75 70 64 61 74 65 2d 74 65 73 ")..'(update-tes
f2f0: 74 2d 73 74 61 74 65 20 20 20 20 20 20 20 22 55 t-state "U
f300: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
f310: 73 74 61 74 65 3d 3f 20 57 48 45 52 45 20 73 74 state=? WHERE st
f320: 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 64 ate=? AND run_id
f330: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
f340: 3f 20 41 4e 44 20 4e 4f 54 20 28 69 74 65 6d 5f ? AND NOT (item_
f350: 70 61 74 68 3d 27 27 20 41 4e 44 20 74 65 73 74 path='' AND test
f360: 6e 61 6d 65 20 49 4e 20 28 53 45 4c 45 43 54 20 name IN (SELECT
f370: 44 49 53 54 49 4e 43 54 20 74 65 73 74 6e 61 6d DISTINCT testnam
f380: 65 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 e FROM tests WHE
f390: 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e RE testname=? AN
f3a0: 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
f3b0: 27 29 29 3b 22 29 0a 09 27 28 75 70 64 61 74 65 '));")..'(update
f3c0: 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
f3d0: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
f3e0: 53 45 54 20 73 74 61 74 75 73 3d 3f 20 57 48 45 SET status=? WHE
f3f0: 52 45 20 73 74 61 74 75 73 20 6c 69 6b 65 20 3f RE status like ?
f400: 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f 20 41 4e AND run_id=? AN
f410: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
f420: 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 68 3d NOT (item_path=
f430: 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 20 '' AND testname
f440: 49 4e 20 28 53 45 4c 45 43 54 20 44 49 53 54 49 IN (SELECT DISTI
f450: 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 4f NCT testname FRO
f460: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 74 65 M tests WHERE te
f470: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
f480: 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 3b 22 m_path != ''));"
f490: 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 64 6f 20 ). ))..;; do
f4a0: 6e 6f 74 20 72 75 6e 20 74 68 65 73 65 20 61 73 not run these as
f4b0: 20 70 61 72 74 20 6f 66 20 74 68 65 20 74 72 61 part of the tra
f4c0: 6e 73 61 63 74 69 6f 6e 0a 28 64 65 66 69 6e 65 nsaction.(define
f4d0: 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 75 65 72 db:special-quer
f4e0: 69 65 73 20 20 20 27 28 72 6f 6c 6c 75 70 2d 74 ies '(rollup-t
f4f0: 65 73 74 73 2d 70 61 73 73 2d 66 61 69 6c 0a 09 ests-pass-fail..
f500: 09 09 20 20 20 20 20 20 20 64 62 3a 72 6f 6c 6c .. db:roll
f510: 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f -up-pass-fail-co
f520: 75 6e 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 unts.
f530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f540: 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 20 20 login.
f550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f560: 20 20 20 20 20 20 20 20 20 69 6d 6d 65 64 69 61 immedia
f570: 74 65 0a 09 09 09 20 20 20 20 20 20 20 66 6c 75 te.... flu
f580: 73 68 0a 09 09 09 20 20 20 20 20 20 20 73 79 6e sh.... syn
f590: 63 0a 09 09 09 20 20 20 20 20 20 20 73 65 74 2d c.... set-
f5a0: 76 65 72 62 6f 73 69 74 79 0a 09 09 09 20 20 20 verbosity....
f5b0: 20 20 20 20 6b 69 6c 6c 73 65 72 76 65 72 0a 09 killserver..
f5c0: 09 09 20 20 20 20 20 20 20 29 29 0a 0a 3b 3b 20 .. ))..;;
f5d0: 6e 6f 74 20 75 73 65 64 2c 20 69 6e 74 65 6e 64 not used, intend
f5e0: 65 64 20 74 6f 20 69 6e 64 69 63 61 74 65 20 74 ed to indicate t
f5f0: 6f 20 72 75 6e 20 69 6e 20 63 61 6c 6c 69 6e 67 o run in calling
f600: 20 70 72 6f 63 65 73 73 0a 28 64 65 66 69 6e 65 process.(define
f610: 20 64 62 3a 72 75 6e 2d 6c 6f 63 61 6c 2d 71 75 db:run-local-qu
f620: 65 72 69 65 73 20 27 28 29 29 20 3b 3b 20 72 6f eries '()) ;; ro
f630: 6c 6c 75 70 2d 74 65 73 74 73 2d 70 61 73 73 2d llup-tests-pass-
f640: 66 61 69 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 fail))..(define
f650: 28 64 62 3a 70 72 6f 63 65 73 73 2d 63 61 63 68 (db:process-cach
f660: 65 64 2d 77 72 69 74 65 73 20 64 62 29 0a 20 20 ed-writes db).
f670: 28 6c 65 74 20 28 28 71 75 65 72 69 65 73 20 20 (let ((queries
f680: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
f690: 6c 65 29 29 0a 09 28 64 61 74 61 20 20 20 20 20 le))..(data
f6a0: 20 20 23 66 29 29 0a 20 20 20 20 28 6d 75 74 65 #f)). (mute
f6b0: 78 2d 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e x-lock! *incomin
f6c0: 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 3b 3b g-mutex*). ;;
f6d0: 20 64 61 74 61 20 69 73 20 61 20 6c 69 73 74 20 data is a list
f6e0: 6f 66 20 71 75 65 72 79 20 70 61 63 6b 65 74 73 of query packets
f6f0: 20 3c 76 65 63 74 6f 72 20 71 72 79 2d 73 69 67 <vector qry-sig
f700: 20 71 75 65 72 79 20 70 61 72 61 6d 73 0a 20 20 query params.
f710: 20 20 28 73 65 74 21 20 64 61 74 61 20 28 72 65 (set! data (re
f720: 76 65 72 73 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d verse *incoming-
f730: 77 72 69 74 65 73 2a 29 29 20 3b 3b 20 20 28 73 writes*)) ;; (s
f740: 6f 72 74 20 2e 2e 2e 20 28 6c 61 6d 62 64 61 20 ort ... (lambda
f750: 28 61 20 62 29 28 3c 20 28 76 65 63 74 6f 72 2d (a b)(< (vector-
f760: 72 65 66 20 61 20 31 29 28 76 65 63 74 6f 72 2d ref a 1)(vector-
f770: 72 65 66 20 62 20 31 29 29 29 29 29 0a 20 20 20 ref b 1))))).
f780: 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 3a 6c (set! *server:l
f790: 61 73 74 2d 77 72 69 74 65 2d 66 6c 75 73 68 2a ast-write-flush*
f7a0: 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 (current-millis
f7b0: 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 28 73 65 econds)). (se
f7c0: 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 t! *incoming-wri
f7d0: 74 65 73 2a 20 27 28 29 29 0a 20 20 20 20 28 6d tes* '()). (m
f7e0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 69 6e utex-unlock! *in
f7f0: 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 coming-mutex*).
f800: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
f810: 68 20 64 61 74 61 29 20 30 29 0a 09 3b 3b 20 50 h data) 0)..;; P
f820: 72 6f 63 65 73 73 20 69 66 20 77 65 20 68 61 76 rocess if we hav
f830: 65 20 64 61 74 61 0a 09 28 62 65 67 69 6e 0a 09 e data..(begin..
f840: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
f850: 6e 66 6f 20 37 20 22 57 72 69 74 69 6e 67 20 63 nfo 7 "Writing c
f860: 61 63 68 65 64 20 64 61 74 61 20 22 20 64 61 74 ached data " dat
f870: 61 29 0a 20 20 20 20 0a 09 20 20 3b 3b 20 50 72 a). .. ;; Pr
f880: 65 70 61 72 65 20 74 68 65 20 6e 65 65 64 65 64 epare the needed
f890: 20 73 71 6c 20 73 74 61 74 65 6d 65 6e 74 73 0a sql statements.
f8a0: 09 20 20 3b 3b 0a 09 20 20 28 66 6f 72 2d 65 61 . ;;.. (for-ea
f8b0: 63 68 20 28 6c 61 6d 62 64 61 20 28 72 65 71 75 ch (lambda (requ
f8c0: 65 73 74 2d 69 74 65 6d 29 0a 09 09 20 20 20 20 est-item)...
f8d0: 20 20 28 6c 65 74 20 28 28 73 74 6d 74 2d 6b 65 (let ((stmt-ke
f8e0: 79 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 y (vector-ref re
f8f0: 71 75 65 73 74 2d 69 74 65 6d 20 30 29 29 0a 09 quest-item 0))..
f900: 09 09 20 20 20 20 28 71 75 65 72 79 20 20 20 20 .. (query
f910: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 71 75 (vector-ref requ
f920: 65 73 74 2d 69 74 65 6d 20 31 29 29 29 0a 09 09 est-item 1)))...
f930: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set
f940: 21 20 71 75 65 72 69 65 73 20 73 74 6d 74 2d 6b ! queries stmt-k
f950: 65 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 ey (sqlite3:prep
f960: 61 72 65 20 64 62 20 71 75 65 72 79 29 29 29 29 are db query))))
f970: 0a 09 09 20 20 20 20 64 61 74 61 29 0a 09 20 20 ... data)..
f980: 0a 09 20 20 3b 3b 20 4e 6f 20 6f 75 74 65 72 20 .. ;; No outer
f990: 6c 6f 6f 70 20 6e 65 65 64 65 64 2e 20 53 69 6e loop needed. Sin
f9a0: 67 6c 65 20 6c 6f 6f 70 20 66 6f 72 20 77 72 69 gle loop for wri
f9b0: 74 65 20 69 74 65 6d 73 20 6f 6e 6c 79 2e 20 52 te items only. R
f9c0: 65 61 64 73 20 74 72 69 67 67 65 72 20 66 6c 75 eads trigger flu
f9d0: 73 68 20 6f 66 20 71 75 65 75 65 0a 09 20 20 3b sh of queue.. ;
f9e0: 3b 20 61 6e 64 20 74 68 65 6e 20 61 72 65 20 65 ; and then are e
f9f0: 78 65 63 75 74 65 64 2e 0a 09 20 20 28 73 71 6c xecuted... (sql
fa00: 69 74 65 33 3a 77 69 74 68 2d 74 72 61 6e 73 61 ite3:with-transa
fa10: 63 74 69 6f 6e 20 0a 09 20 20 20 64 62 0a 09 20 ction .. db..
fa20: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 (lambda ()..
fa30: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 (for-each..
fa40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 68 65 64 (lambda (hed
fa50: 29 0a 09 09 28 6c 65 74 2a 20 28 28 70 61 72 61 )...(let* ((para
fa60: 6d 73 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ms (vector-ref
fa70: 20 68 65 64 20 32 29 29 0a 09 09 20 20 20 20 20 hed 2))...
fa80: 20 20 28 73 74 6d 74 2d 6b 65 79 20 28 76 65 63 (stmt-key (vec
fa90: 74 6f 72 2d 72 65 66 20 68 65 64 20 30 29 29 0a tor-ref hed 0)).
faa0: 09 09 20 20 20 20 20 20 20 28 73 74 6d 74 20 20 .. (stmt
fab0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
fac0: 65 66 2f 64 65 66 61 75 6c 74 20 71 75 65 72 69 ef/default queri
fad0: 65 73 20 73 74 6d 74 2d 6b 65 79 20 23 66 29 29 es stmt-key #f))
fae0: 29 0a 09 09 20 20 28 69 66 20 73 74 6d 74 0a 09 )... (if stmt..
faf0: 09 20 20 20 20 20 20 28 61 70 70 6c 79 20 73 71 . (apply sq
fb00: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 73 74 lite3:execute st
fb10: 6d 74 20 70 61 72 61 6d 73 29 0a 09 09 20 20 20 mt params)...
fb20: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
fb30: 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 6c 65 0 "ERROR: Proble
fb40: 6d 20 45 78 65 63 75 74 69 6e 67 20 22 20 73 74 m Executing " st
fb50: 6d 74 2d 6b 65 79 20 22 20 66 6f 72 20 22 20 70 mt-key " for " p
fb60: 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 20 arams))))..
fb70: 20 64 61 74 61 29 29 29 0a 09 20 20 0a 09 20 20 data))).. ..
fb80: 3b 3b 20 6c 65 74 20 61 6c 6c 20 74 68 65 20 77 ;; let all the w
fb90: 61 69 74 69 6e 67 20 63 61 6c 6c 73 20 6b 6e 6f aiting calls kno
fba0: 77 20 61 6c 6c 20 69 73 20 64 6f 6e 65 0a 09 20 w all is done..
fbb0: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 63 (mutex-lock! *c
fbc0: 6f 6d 70 6c 65 74 65 64 2d 6d 75 74 65 78 2a 29 ompleted-mutex*)
fbd0: 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c .. (for-each (l
fbe0: 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 09 20 ambda (item)...
fbf0: 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 79 2d (let ((qry-
fc00: 73 69 67 20 28 63 64 62 3a 70 61 63 6b 65 74 2d sig (cdb:packet-
fc10: 67 65 74 2d 63 6c 69 65 6e 74 2d 73 69 67 20 69 get-client-sig i
fc20: 74 65 6d 29 29 29 0a 09 09 09 28 64 65 62 75 67 tem)))....(debug
fc30: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 37 20 22 52 :print-info 7 "R
fc40: 65 67 69 73 74 65 72 69 6e 67 20 71 75 65 72 79 egistering query
fc50: 20 22 20 71 72 79 2d 73 69 67 20 22 20 61 73 20 " qry-sig " as
fc60: 64 6f 6e 65 22 29 0a 09 09 09 28 68 61 73 68 2d done")....(hash-
fc70: 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 6f 6d 70 table-set! *comp
fc80: 6c 65 74 65 64 2d 77 72 69 74 65 73 2a 20 71 72 leted-writes* qr
fc90: 79 2d 73 69 67 20 23 74 29 29 29 0a 09 09 20 20 y-sig #t)))...
fca0: 20 20 64 61 74 61 29 0a 09 20 20 28 6d 75 74 65 data).. (mute
fcb0: 78 2d 75 6e 6c 6f 63 6b 21 20 2a 63 6f 6d 70 6c x-unlock! *compl
fcc0: 65 74 65 64 2d 6d 75 74 65 78 2a 29 0a 09 20 20 eted-mutex*)..
fcd0: 0a 09 20 20 3b 3b 20 46 69 6e 61 6c 69 7a 65 20 .. ;; Finalize
fce0: 74 68 65 20 73 74 61 74 65 6d 65 6e 74 73 2e 20 the statements.
fcf0: 53 68 6f 75 6c 64 20 74 68 69 73 20 62 65 20 64 Should this be d
fd00: 6f 6e 65 20 69 6e 73 69 64 65 20 74 68 65 20 6d one inside the m
fd10: 75 74 65 78 20 61 62 6f 76 65 3f 0a 09 20 20 3b utex above?.. ;
fd20: 3b 20 49 20 74 68 69 6e 6b 20 73 71 6c 69 74 65 ; I think sqlite
fd30: 33 20 6d 75 74 65 78 65 73 20 77 69 6c 6c 20 6b 3 mutexes will k
fd40: 65 65 70 20 74 68 65 20 64 61 74 61 20 73 61 66 eep the data saf
fd50: 65 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 28 e.. (for-each (
fd60: 6c 61 6d 62 64 61 20 28 73 74 6d 74 2d 6b 65 79 lambda (stmt-key
fd70: 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 )... (sqlit
fd80: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 28 68 61 e3:finalize! (ha
fd90: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 71 75 65 sh-table-ref que
fda0: 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 29 29 29 ries stmt-key)))
fdb0: 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
fdc0: 6c 65 2d 6b 65 79 73 20 71 75 65 72 69 65 73 29 le-keys queries)
fdd0: 29 0a 09 20 20 0a 09 20 20 3b 3b 20 44 6f 20 61 ).. .. ;; Do a
fde0: 20 6c 69 74 74 6c 65 20 72 65 63 6f 72 64 20 6b little record k
fdf0: 65 65 70 69 6e 67 0a 09 20 20 28 6c 65 74 20 28 eeping.. (let (
fe00: 28 63 61 63 68 65 2d 73 69 7a 65 20 28 6c 65 6e (cache-size (len
fe10: 67 74 68 20 64 61 74 61 29 29 29 0a 09 20 20 20 gth data)))..
fe20: 20 28 69 66 20 28 3e 20 63 61 63 68 65 2d 73 69 (if (> cache-si
fe30: 7a 65 20 2a 6d 61 78 2d 63 61 63 68 65 2d 73 69 ze *max-cache-si
fe40: 7a 65 2a 29 0a 09 09 28 73 65 74 21 20 2a 6d 61 ze*)...(set! *ma
fe50: 78 2d 63 61 63 68 65 2d 73 69 7a 65 2a 20 63 61 x-cache-size* ca
fe60: 63 68 65 2d 73 69 7a 65 29 29 29 0a 09 20 20 23 che-size))).. #
fe70: 74 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 t)..#f)))..(defi
fe80: 6e 65 20 2a 64 62 3a 70 72 6f 63 65 73 73 2d 71 ne *db:process-q
fe90: 75 65 75 65 2d 6d 75 74 65 78 2a 20 28 6d 61 6b ueue-mutex* (mak
fea0: 65 2d 6d 75 74 65 78 29 29 0a 0a 28 64 65 66 69 e-mutex))..(defi
feb0: 6e 65 20 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77 72 ne *number-of-wr
fec0: 69 74 65 73 2a 20 20 20 20 20 20 20 20 20 30 29 ites* 0)
fed0: 0a 28 64 65 66 69 6e 65 20 2a 77 72 69 74 65 73 .(define *writes
fee0: 2d 74 6f 74 61 6c 2d 64 65 6c 61 79 2a 20 20 20 -total-delay*
fef0: 20 20 20 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 0).(define *
ff00: 74 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 69 74 65 2d total-non-write-
ff10: 64 65 6c 61 79 2a 20 20 20 20 30 29 0a 28 64 65 delay* 0).(de
ff20: 66 69 6e 65 20 2a 6e 75 6d 62 65 72 2d 6e 6f 6e fine *number-non
ff30: 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 2a 20 -write-queries*
ff40: 30 29 0a 0a 3b 3b 20 54 68 65 20 71 75 65 75 65 0)..;; The queue
ff50: 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 76 65 is a list of ve
ff60: 63 74 6f 72 73 20 77 68 65 72 65 20 74 68 65 20 ctors where the
ff70: 7a 65 72 6f 74 68 20 73 6c 6f 74 20 69 6e 64 69 zeroth slot indi
ff80: 63 61 74 65 73 20 74 68 65 20 74 79 70 65 20 6f cates the type o
ff90: 66 20 71 75 65 72 79 20 74 6f 0a 3b 3b 20 61 70 f query to.;; ap
ffa0: 70 6c 79 20 61 6e 64 20 74 68 65 20 73 65 63 6f ply and the seco
ffb0: 6e 64 20 73 6c 6f 74 20 69 73 20 74 68 65 20 74 nd slot is the t
ffc0: 69 6d 65 20 6f 66 20 74 68 65 20 71 75 65 72 79 ime of the query
ffd0: 20 61 6e 64 20 74 68 65 20 74 68 69 72 64 20 65 and the third e
ffe0: 6e 74 72 79 20 69 73 20 61 20 6c 69 73 74 20 6f ntry is a list o
fff0: 66 20 0a 3b 3b 20 76 61 6c 75 65 73 20 74 6f 20 f .;; values to
10000 62 65 20 61 70 70 6c 69 65 64 0a 3b 3b 0a 28 64 be applied.;;.(d
10010 65 66 69 6e 65 20 28 64 62 3a 71 75 65 75 65 2d efine (db:queue-
10020 77 72 69 74 65 2d 61 6e 64 2d 77 61 69 74 20 64 write-and-wait d
10030 62 20 71 72 79 2d 73 69 67 20 71 75 65 72 79 20 b qry-sig query
10040 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 20 28 params). (let (
10050 28 71 75 65 75 65 2d 6c 65 6e 20 20 30 29 0a 09 (queue-len 0)..
10060 28 72 65 73 20 20 20 20 20 20 20 20 23 66 29 0a (res #f).
10070 09 28 67 6f 74 2d 69 74 20 20 20 20 20 23 66 29 .(got-it #f)
10080 0a 09 28 71 72 79 2d 70 6b 74 20 20 20 20 28 76 ..(qry-pkt (v
10090 65 63 74 6f 72 20 71 72 79 2d 73 69 67 20 71 75 ector qry-sig qu
100a0 65 72 79 20 70 61 72 61 6d 73 29 29 0a 09 28 73 ery params))..(s
100b0 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 72 65 tart-time (curre
100c0 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 nt-milliseconds)
100d0 29 0a 09 28 74 69 6d 65 6f 75 74 20 20 20 20 28 )..(timeout (
100e0 2b 20 31 30 20 28 63 75 72 72 65 6e 74 2d 73 65 + 10 (current-se
100f0 63 6f 6e 64 73 29 29 29 29 20 3b 3b 20 73 65 74 conds)))) ;; set
10100 20 74 68 65 20 74 69 6d 65 20 6f 75 74 20 74 6f the time out to
10110 20 31 30 20 73 65 63 73 20 69 6e 20 66 75 74 75 10 secs in futu
10120 72 65 0a 0a 20 20 20 20 3b 3b 20 50 75 74 20 74 re.. ;; Put t
10130 68 65 20 69 74 65 6d 20 69 6e 20 74 68 65 20 71 he item in the q
10140 75 65 75 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 ueue *incoming-w
10150 72 69 74 65 73 2a 20 0a 20 20 20 20 28 6d 75 74 rites* . (mut
10160 65 78 2d 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 ex-lock! *incomi
10170 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 28 ng-mutex*). (
10180 73 65 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 set! *incoming-w
10190 72 69 74 65 73 2a 20 28 63 6f 6e 73 20 71 72 79 rites* (cons qry
101a0 2d 70 6b 74 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 -pkt *incoming-w
101b0 72 69 74 65 73 2a 29 29 0a 20 20 20 20 28 73 65 rites*)). (se
101c0 74 21 20 71 75 65 75 65 2d 6c 65 6e 20 28 6c 65 t! queue-len (le
101d0 6e 67 74 68 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 ngth *incoming-w
101e0 72 69 74 65 73 2a 29 29 0a 20 20 20 20 28 6d 75 rites*)). (mu
101f0 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 69 6e 63 tex-unlock! *inc
10200 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 0a 20 oming-mutex*)..
10210 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
10220 69 6e 66 6f 20 37 20 22 43 75 72 72 65 6e 74 20 info 7 "Current
10230 77 72 69 74 65 20 71 75 65 75 65 20 6c 65 6e 67 write queue leng
10240 74 68 20 69 73 20 22 20 71 75 65 75 65 2d 6c 65 th is " queue-le
10250 6e 29 0a 0a 20 20 20 20 3b 3b 20 70 6f 6c 6c 20 n).. ;; poll
10260 66 6f 72 20 74 68 65 20 77 72 69 74 65 20 74 6f for the write to
10270 20 63 6f 6d 70 6c 65 74 65 2c 20 74 69 6d 65 6f complete, timeo
10280 75 74 20 61 66 74 65 72 20 31 30 20 73 65 63 6f ut after 10 seco
10290 6e 64 73 0a 20 20 20 20 3b 3b 20 70 65 72 69 6f nds. ;; perio
102a0 64 69 63 20 66 6c 75 73 68 69 6e 67 20 6f 66 20 dic flushing of
102b0 74 68 65 20 71 75 65 75 65 20 69 73 20 74 61 6b the queue is tak
102c0 65 6e 20 63 61 72 65 20 6f 66 20 62 79 20 0a 20 en care of by .
102d0 20 20 20 3b 3b 20 64 62 3a 66 6c 75 73 68 2d 71 ;; db:flush-q
102e0 75 65 75 65 0a 20 20 20 20 28 6c 65 74 20 6c 6f ueue. (let lo
102f0 6f 70 20 28 29 0a 20 20 20 20 20 20 28 74 68 72 op (). (thr
10300 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 30 31 ead-sleep! 0.001
10310 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c ). (mutex-l
10320 6f 63 6b 21 20 2a 63 6f 6d 70 6c 65 74 65 64 2d ock! *completed-
10330 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 28 69 mutex*). (i
10340 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 f (hash-table-re
10350 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6d 70 6c f/default *compl
10360 65 74 65 64 2d 77 72 69 74 65 73 2a 20 71 72 79 eted-writes* qry
10370 2d 73 69 67 20 23 66 29 0a 09 20 20 28 62 65 67 -sig #f).. (beg
10380 69 6e 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 in.. (hash-ta
10390 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a 63 6f 6d ble-delete! *com
103a0 70 6c 65 74 65 64 2d 77 72 69 74 65 73 2a 20 71 pleted-writes* q
103b0 72 79 2d 73 69 67 29 0a 09 20 20 20 20 28 73 65 ry-sig).. (se
103c0 74 21 20 67 6f 74 2d 69 74 20 23 74 29 29 29 0a t! got-it #t))).
103d0 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c (mutex-unl
103e0 6f 63 6b 21 20 2a 63 6f 6d 70 6c 65 74 65 64 2d ock! *completed-
103f0 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 28 69 mutex*). (i
10400 66 20 28 61 6e 64 20 28 6e 6f 74 20 67 6f 74 2d f (and (not got-
10410 69 74 29 0a 09 20 20 20 20 20 20 20 28 3c 20 28 it).. (< (
10420 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
10430 20 74 69 6d 65 6f 75 74 29 29 0a 09 20 20 28 62 timeout)).. (b
10440 65 67 69 6e 0a 09 20 20 20 20 28 74 68 72 65 61 egin.. (threa
10450 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 29 0a 09 d-sleep! 0.01)..
10460 20 20 20 20 28 6c 6f 6f 70 29 29 29 29 0a 20 20 (loop)))).
10470 20 20 28 73 65 74 21 20 2a 6e 75 6d 62 65 72 2d (set! *number-
10480 6f 66 2d 77 72 69 74 65 73 2a 20 20 20 28 2b 20 of-writes* (+
10490 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77 72 69 74 65 *number-of-write
104a0 73 2a 20 20 20 31 29 29 0a 20 20 20 20 28 73 65 s* 1)). (se
104b0 74 21 20 2a 77 72 69 74 65 73 2d 74 6f 74 61 6c t! *writes-total
104c0 2d 64 65 6c 61 79 2a 20 28 2b 20 2a 77 72 69 74 -delay* (+ *writ
104d0 65 73 2d 74 6f 74 61 6c 2d 64 65 6c 61 79 2a 20 es-total-delay*
104e0 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c (- (current-mill
104f0 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d iseconds) start-
10500 74 69 6d 65 29 29 29 0a 20 20 20 20 67 6f 74 2d time))). got-
10510 69 74 29 29 0a 09 20 20 0a 28 64 65 66 69 6e 65 it)).. .(define
10520 20 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 (db:process-que
10530 75 65 2d 69 74 65 6d 20 64 62 20 69 74 65 6d 29 ue-item db item)
10540 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 6d 74 2d . (let* ((stmt-
10550 6b 65 79 20 20 20 20 20 20 20 28 63 64 62 3a 70 key (cdb:p
10560 61 63 6b 65 74 2d 67 65 74 2d 71 74 79 70 65 20 acket-get-qtype
10570 69 74 65 6d 29 29 0a 09 20 28 71 72 79 2d 73 69 item)).. (qry-si
10580 67 20 20 20 20 20 20 20 20 28 63 64 62 3a 70 61 g (cdb:pa
10590 63 6b 65 74 2d 67 65 74 2d 71 75 65 72 79 2d 73 cket-get-query-s
105a0 69 67 20 69 74 65 6d 29 29 0a 09 20 28 72 65 74 ig item)).. (ret
105b0 75 72 6e 2d 61 64 64 72 65 73 73 20 28 63 64 62 urn-address (cdb
105c0 3a 70 61 63 6b 65 74 2d 67 65 74 2d 63 6c 69 65 :packet-get-clie
105d0 6e 74 2d 73 69 67 20 69 74 65 6d 29 29 0a 09 20 nt-sig item))..
105e0 28 70 61 72 61 6d 73 20 20 20 20 20 20 20 20 20 (params
105f0 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d (cdb:packet-get-
10600 70 61 72 61 6d 73 20 69 74 65 6d 29 29 0a 09 20 params item))..
10610 28 71 75 65 72 79 20 20 20 20 20 20 20 20 20 20 (query
10620 28 6c 65 74 20 28 28 71 20 28 61 6c 69 73 74 2d (let ((q (alist-
10630 72 65 66 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a ref stmt-key db:
10640 71 75 65 72 69 65 73 29 29 29 0a 09 09 09 20 20 queries)))....
10650 20 28 69 66 20 71 20 28 63 61 72 20 71 29 20 23 (if q (car q) #
10660 66 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 f)))). (debug
10670 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
10680 53 70 65 63 69 61 6c 20 71 75 65 72 69 65 73 2f Special queries/
10690 72 65 71 75 65 73 74 73 20 73 74 6d 74 2d 6b 65 requests stmt-ke
106a0 79 3d 22 20 73 74 6d 74 2d 6b 65 79 20 22 2c 20 y=" stmt-key ",
106b0 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 3d 22 return-address="
106c0 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
106d0 22 2c 20 71 75 65 72 79 3d 22 20 71 75 65 72 79 ", query=" query
106e0 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 ", params=" par
106f0 61 6d 73 29 0a 20 20 20 20 28 69 66 20 71 75 65 ams). (if que
10700 72 79 0a 09 3b 3b 20 68 61 6e 64 20 71 75 65 72 ry..;; hand quer
10710 69 65 73 20 6f 66 66 20 74 6f 20 74 68 65 20 77 ies off to the w
10720 72 69 74 65 20 71 75 65 75 65 0a 09 28 6c 65 74 rite queue..(let
10730 20 28 28 72 65 73 70 6f 6e 73 65 20 28 63 61 73 ((response (cas
10740 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 e *transport-typ
10750 65 2a 0a 09 09 09 20 20 28 28 68 74 74 70 29 0a e*.... ((http).
10760 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
10770 6e 74 2d 69 6e 66 6f 20 37 20 22 51 75 65 75 69 nt-info 7 "Queui
10780 6e 67 20 69 74 65 6d 20 22 20 69 74 65 6d 20 22 ng item " item "
10790 20 66 6f 72 20 77 72 61 70 70 65 64 20 77 72 69 for wrapped wri
107a0 74 65 22 29 0a 09 09 09 20 20 20 28 64 62 3a 71 te").... (db:q
107b0 75 65 75 65 2d 77 72 69 74 65 2d 61 6e 64 2d 77 ueue-write-and-w
107c0 61 69 74 20 64 62 20 71 72 79 2d 73 69 67 20 71 ait db qry-sig q
107d0 75 65 72 79 20 70 61 72 61 6d 73 29 29 0a 09 09 uery params))...
107e0 09 20 20 28 65 6c 73 65 20 20 0a 09 09 09 20 20 . (else ....
107f0 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
10800 65 78 65 63 75 74 65 20 64 62 20 71 75 65 72 79 execute db query
10810 20 70 61 72 61 6d 73 29 0a 09 09 09 20 20 20 23 params).... #
10820 74 29 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a t)))).. (debug:
10830 70 72 69 6e 74 2d 69 6e 66 6f 20 37 20 22 52 65 print-info 7 "Re
10840 63 65 69 76 65 64 20 22 20 72 65 73 70 6f 6e 73 ceived " respons
10850 65 20 22 20 66 72 6f 6d 20 77 72 61 70 70 65 64 e " from wrapped
10860 20 77 72 69 74 65 22 29 0a 09 20 20 28 73 65 72 write").. (ser
10870 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 72 6e ver:reply return
10880 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 -address qry-sig
10890 20 72 65 73 70 6f 6e 73 65 20 72 65 73 70 6f 6e response respon
108a0 73 65 29 29 0a 09 3b 3b 20 6f 74 68 65 72 77 69 se))..;; otherwi
108b0 73 65 20 69 66 20 61 70 70 72 6f 70 72 69 61 74 se if appropriat
108c0 65 20 66 6c 75 73 68 20 74 68 65 20 71 75 65 75 e flush the queu
108d0 65 20 28 74 68 69 73 20 69 73 20 61 20 72 65 61 e (this is a rea
108e0 64 20 6f 72 20 63 6f 6d 70 6c 65 78 20 71 75 65 d or complex que
108f0 72 79 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 ry)..(begin.. (
10900 63 6f 6e 64 0a 09 20 20 20 28 28 6d 65 6d 62 65 cond.. ((membe
10910 72 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a 73 70 r stmt-key db:sp
10920 65 63 69 61 6c 2d 71 75 65 72 69 65 73 29 0a 09 ecial-queries)..
10930 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 (let ((start
10940 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 6d 69 time (current-mi
10950 6c 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a 09 20 lliseconds)))..
10960 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
10970 74 2d 69 6e 66 6f 20 39 20 22 48 61 6e 64 6c 69 t-info 9 "Handli
10980 6e 67 20 73 70 65 63 69 61 6c 20 73 74 61 74 65 ng special state
10990 6d 65 6e 74 20 22 20 73 74 6d 74 2d 6b 65 79 29 ment " stmt-key)
109a0 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 73 74 .. (case st
109b0 6d 74 2d 6b 65 79 0a 09 09 28 28 69 6d 6d 65 64 mt-key...((immed
109c0 69 61 74 65 29 0a 09 09 20 3b 3b 20 54 68 69 73 iate)... ;; This
109d0 20 69 73 20 61 20 72 65 61 64 20 6f 72 20 6d 69 is a read or mi
109e0 78 65 64 20 72 65 61 64 2d 77 72 69 74 65 20 71 xed read-write q
109f0 75 65 72 79 2c 20 6d 75 73 74 20 63 6c 65 61 72 uery, must clear
10a00 20 74 68 65 20 63 61 63 68 65 0a 09 09 20 28 63 the cache... (c
10a10 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 ase *transport-t
10a20 79 70 65 2a 0a 09 09 20 20 20 28 28 68 74 74 70 ype*... ((http
10a30 29 0a 09 09 20 20 20 20 28 6d 75 74 65 78 2d 6c )... (mutex-l
10a40 6f 63 6b 21 20 2a 64 62 3a 70 72 6f 63 65 73 73 ock! *db:process
10a50 2d 71 75 65 75 65 2d 6d 75 74 65 78 2a 29 0a 09 -queue-mutex*)..
10a60 09 20 20 20 20 28 64 62 3a 70 72 6f 63 65 73 73 . (db:process
10a70 2d 63 61 63 68 65 64 2d 77 72 69 74 65 73 20 64 -cached-writes d
10a80 62 29 0a 09 09 20 20 20 20 28 6d 75 74 65 78 2d b)... (mutex-
10a90 75 6e 6c 6f 63 6b 21 20 2a 64 62 3a 70 72 6f 63 unlock! *db:proc
10aa0 65 73 73 2d 71 75 65 75 65 2d 6d 75 74 65 78 2a ess-queue-mutex*
10ab0 29 29 29 0a 09 09 20 28 6c 65 74 2a 20 28 28 70 )))... (let* ((p
10ac0 72 6f 63 20 20 20 20 20 20 28 63 61 72 20 70 61 roc (car pa
10ad0 72 61 6d 73 29 29 0a 09 09 09 28 72 65 6d 70 61 rams))....(rempa
10ae0 72 61 6d 73 20 28 63 64 72 20 70 61 72 61 6d 73 rams (cdr params
10af0 29 29 0a 09 09 09 3b 3b 20 77 65 20 61 72 65 20 ))....;; we are
10b00 62 65 69 6e 67 20 68 61 6e 64 65 64 20 61 20 70 being handed a p
10b10 72 6f 63 65 64 75 72 65 20 73 6f 20 63 61 6c 6c rocedure so call
10b20 20 69 74 0a 09 09 09 3b 3b 20 28 64 65 62 75 67 it....;; (debug
10b30 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
10b40 52 75 6e 6e 69 6e 67 20 28 61 70 70 6c 79 20 22 Running (apply "
10b50 20 70 72 6f 63 20 22 20 22 20 72 65 6d 70 61 72 proc " " rempar
10b60 61 6d 73 20 22 29 22 29 0a 09 09 09 28 72 65 73 ams ")")....(res
10b70 75 6c 74 20 28 73 65 72 76 65 72 3a 72 65 70 6c ult (server:repl
10b80 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 y return-address
10b90 20 71 72 79 2d 73 69 67 20 23 74 20 28 61 70 70 qry-sig #t (app
10ba0 6c 79 20 70 72 6f 63 20 72 65 6d 70 61 72 61 6d ly proc remparam
10bb0 73 29 29 29 29 0a 09 09 20 20 20 28 73 65 74 21 s))))... (set!
10bc0 20 2a 74 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 69 74 *total-non-writ
10bd0 65 2d 64 65 6c 61 79 2a 20 28 2b 20 2a 74 6f 74 e-delay* (+ *tot
10be0 61 6c 2d 6e 6f 6e 2d 77 72 69 74 65 2d 64 65 6c al-non-write-del
10bf0 61 79 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d ay* (- (current-
10c00 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 milliseconds) st
10c10 61 72 74 74 69 6d 65 29 29 29 20 0a 09 09 20 20 arttime))) ...
10c20 20 28 73 65 74 21 20 2a 6e 75 6d 62 65 72 2d 6e (set! *number-n
10c30 6f 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 on-write-queries
10c40 2a 20 28 2b 20 2a 6e 75 6d 62 65 72 2d 6e 6f 6e * (+ *number-non
10c50 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 2a 20 -write-queries*
10c60 31 29 29 0a 09 09 20 20 20 72 65 73 75 6c 74 29 1))... result)
10c70 29 0a 09 09 28 28 6c 6f 67 69 6e 29 0a 09 09 20 )...((login)...
10c80 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 20 70 (if (< (length p
10c90 61 72 61 6d 73 29 20 33 29 20 3b 3b 20 73 68 6f arams) 3) ;; sho
10ca0 75 6c 64 20 67 65 74 20 74 6f 70 70 61 74 68 2c uld get toppath,
10cb0 20 76 65 72 73 69 6f 6e 20 61 6e 64 20 73 69 67 version and sig
10cc0 6e 61 74 75 72 65 0a 09 09 20 20 20 20 20 28 73 nature... (s
10cd0 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 erver:reply retu
10ce0 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 rn-address qry-s
10cf0 69 67 20 27 28 23 66 20 22 6c 6f 67 69 6e 20 66 ig '(#f "login f
10d00 61 69 6c 65 64 20 64 75 65 20 74 6f 20 6d 69 73 ailed due to mis
10d10 73 69 6e 67 20 70 61 72 61 6d 73 22 29 29 20 3b sing params")) ;
10d20 3b 20 6d 69 73 73 69 6e 67 20 70 61 72 61 6d 73 ; missing params
10d30 0a 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 63 ... (let ((c
10d40 61 6c 6c 69 6e 67 2d 70 61 74 68 20 28 63 61 72 alling-path (car
10d50 20 20 20 70 61 72 61 6d 73 29 29 0a 09 09 09 20 params))....
10d60 20 20 28 63 61 6c 6c 69 6e 67 2d 76 65 72 73 20 (calling-vers
10d70 28 63 61 64 72 20 20 70 61 72 61 6d 73 29 29 0a (cadr params)).
10d80 09 09 09 20 20 20 28 63 6c 69 65 6e 74 2d 6b 65 ... (client-ke
10d90 79 20 20 20 28 63 61 64 64 72 20 70 61 72 61 6d y (caddr param
10da0 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 s)))... (i
10db0 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 63 f (and (equal? c
10dc0 61 6c 6c 69 6e 67 2d 70 61 74 68 20 2a 74 6f 70 alling-path *top
10dd0 70 61 74 68 2a 29 0a 09 09 09 09 28 65 71 75 61 path*).....(equa
10de0 6c 3f 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 l? megatest-vers
10df0 69 6f 6e 20 63 61 6c 6c 69 6e 67 2d 76 65 72 73 ion calling-vers
10e00 29 29 0a 09 09 09 20 20 20 28 62 65 67 69 6e 0a )).... (begin.
10e10 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ... (hash-ta
10e20 62 6c 65 2d 73 65 74 21 20 2a 6c 6f 67 67 65 64 ble-set! *logged
10e30 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 63 6c 69 -in-clients* cli
10e40 65 6e 74 2d 6b 65 79 20 28 63 75 72 72 65 6e 74 ent-key (current
10e50 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 20 20 -seconds))....
10e60 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 (server:reply
10e70 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
10e80 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74 20 qry-sig #t '(#t
10e90 22 73 75 63 63 65 73 73 66 75 6c 20 6c 6f 67 69 "successful logi
10ea0 6e 22 29 29 29 20 20 20 20 20 20 3b 3b 20 70 61 n"))) ;; pa
10eb0 74 68 20 6d 61 74 63 68 65 73 20 2d 20 70 61 73 th matches - pas
10ec0 73 21 20 53 68 6f 75 6c 64 20 76 65 74 20 74 68 s! Should vet th
10ed0 65 20 63 61 6c 6c 65 72 20 61 74 20 74 68 69 73 e caller at this
10ee0 20 74 69 6d 65 20 2e 2e 2e 0a 09 09 09 20 20 20 time .......
10ef0 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 (server:reply re
10f00 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 turn-address qry
10f10 2d 73 69 67 20 23 66 20 28 6c 69 73 74 20 23 66 -sig #f (list #f
10f20 20 28 63 6f 6e 63 20 22 4c 6f 67 69 6e 20 66 61 (conc "Login fa
10f30 69 6c 65 64 20 64 75 65 20 74 6f 20 6d 69 73 6d iled due to mism
10f40 61 74 63 68 20 70 61 74 68 73 3a 20 22 20 63 61 atch paths: " ca
10f50 6c 6c 69 6e 67 2d 70 61 74 68 20 22 2c 20 22 20 lling-path ", "
10f60 2a 74 6f 70 70 61 74 68 2a 29 29 29 29 29 29 29 *toppath*)))))))
10f70 0a 09 09 28 28 66 6c 75 73 68 20 73 79 6e 63 29 ...((flush sync)
10f80 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 70 6c ... (server:repl
10f90 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 y return-address
10fa0 20 71 72 79 2d 73 69 67 20 23 74 20 31 29 29 20 qry-sig #t 1))
10fb0 3b 3b 20 28 6c 65 6e 67 74 68 20 64 61 74 61 29 ;; (length data)
10fc0 29 29 0a 09 09 28 28 73 65 74 2d 76 65 72 62 6f ))...((set-verbo
10fd0 73 69 74 79 29 0a 09 09 20 28 73 65 74 21 20 2a sity)... (set! *
10fe0 76 65 72 62 6f 73 69 74 79 2a 20 28 63 61 72 20 verbosity* (car
10ff0 70 61 72 61 6d 73 29 29 0a 09 09 20 28 73 65 72 params))... (ser
11000 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 72 6e ver:reply return
11010 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 -address qry-sig
11020 20 23 74 20 27 28 23 74 20 2a 76 65 72 62 6f 73 #t '(#t *verbos
11030 69 74 79 2a 29 29 29 0a 09 09 28 28 6b 69 6c 6c ity*)))...((kill
11040 73 65 72 76 65 72 29 0a 09 09 20 28 64 65 62 75 server)... (debu
11050 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
11060 4e 47 3a 20 53 65 72 76 65 72 20 67 6f 69 6e 67 NG: Server going
11070 20 64 6f 77 6e 20 69 6e 20 31 35 20 73 65 63 6f down in 15 seco
11080 6e 64 73 20 62 79 20 75 73 65 72 20 72 65 71 75 nds by user requ
11090 65 73 74 21 22 29 0a 09 09 20 28 6f 70 65 6e 2d est!")... (open-
110a0 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
110b0 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
110c0 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 r tasks:open-db
110d0 0a 09 09 09 09 20 28 63 61 72 20 2a 72 75 6e 72 ..... (car *runr
110e0 65 6d 6f 74 65 2a 29 0a 09 09 09 09 20 70 75 6c emote*)..... pul
110f0 6c 70 6f 72 74 3a 20 28 63 61 64 72 20 2a 72 75 lport: (cadr *ru
11100 6e 72 65 6d 6f 74 65 2a 29 29 0a 09 09 20 28 74 nremote*))... (t
11110 68 72 65 61 64 2d 73 74 61 72 74 21 20 28 6d 61 hread-start! (ma
11120 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 ke-thread (lambd
11130 61 20 28 29 28 74 68 72 65 61 64 2d 73 6c 65 65 a ()(thread-slee
11140 70 21 20 31 35 29 28 65 78 69 74 29 29 29 29 0a p! 15)(exit)))).
11150 09 09 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 .. (server:reply
11160 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
11170 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74 20 qry-sig #t '(#t
11180 22 65 78 69 74 20 70 72 6f 63 65 73 73 20 73 74 "exit process st
11190 61 72 74 65 64 22 29 29 29 0a 09 09 28 65 6c 73 arted")))...(els
111a0 65 20 3b 3b 20 6e 6f 74 20 61 20 63 6f 6d 6d 61 e ;; not a comma
111b0 6e 64 2c 20 69 2e 65 2e 20 69 73 20 61 20 71 75 nd, i.e. is a qu
111c0 65 72 79 0a 09 09 20 28 64 65 62 75 67 3a 70 72 ery... (debug:pr
111d0 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 55 6e int 0 "ERROR: Un
111e0 72 65 63 6f 67 6e 69 73 65 64 20 71 75 65 72 79 recognised query
111f0 2f 63 6f 6d 6d 61 6e 64 20 22 20 73 74 6d 74 2d /command " stmt-
11200 6b 65 79 29 0a 09 09 20 28 73 65 72 76 65 72 3a key)... (server:
11210 72 65 70 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 reply return-add
11220 72 65 73 73 20 71 72 79 2d 73 69 67 20 23 66 20 ress qry-sig #f
11230 27 66 61 69 6c 65 64 29 29 29 29 29 0a 09 20 20 'failed)))))..
11240 20 28 65 6c 73 65 0a 09 20 20 20 20 28 64 65 62 (else.. (deb
11250 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
11260 20 22 45 78 65 63 75 74 69 6e 67 20 22 20 73 74 "Executing " st
11270 6d 74 2d 6b 65 79 20 22 20 66 6f 72 20 22 20 70 mt-key " for " p
11280 61 72 61 6d 73 29 0a 09 20 20 20 20 28 61 70 70 arams).. (app
11290 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ly sqlite3:execu
112a0 74 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 te (hash-table-r
112b0 65 66 20 71 75 65 72 69 65 73 20 73 74 6d 74 2d ef queries stmt-
112c0 6b 65 79 29 20 70 61 72 61 6d 73 29 0a 09 20 20 key) params)..
112d0 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 (server:reply
112e0 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 return-address q
112f0 72 79 2d 73 69 67 20 23 74 20 23 74 29 29 29 29 ry-sig #t #t))))
11300 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
11310 3a 74 65 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 :test-get-record
11320 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 s-for-index-file
11330 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
11340 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 72 name). (let ((r
11350 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 73 71 es '())). (sq
11360 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
11370 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ow . (lambda
11380 20 28 69 64 20 69 74 65 6d 70 61 74 68 20 73 74 (id itempath st
11390 61 74 65 20 73 74 61 74 75 73 20 72 75 6e 5f 64 ate status run_d
113a0 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d uration logf com
113b0 6d 65 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 ment). (se
113c0 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 t! res (cons (ve
113d0 63 74 6f 72 20 69 64 20 69 74 65 6d 70 61 74 68 ctor id itempath
113e0 20 73 74 61 74 65 20 73 74 61 74 75 73 20 72 75 state status ru
113f0 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 n_duration logf
11400 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 29 29 0a comment) res))).
11410 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 db. "SE
11420 4c 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 LECT id,item_pat
11430 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 72 h,state,status,r
11440 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 un_duration,fina
11450 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 l_logf,comment F
11460 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
11470 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
11480 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
11490 5f 70 61 74 68 20 21 3d 20 27 27 3b 22 0a 20 20 _path != '';".
114a0 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e run-id test-n
114b0 61 6d 65 29 0a 20 20 20 20 72 65 73 29 29 0a 0a ame). res))..
114c0 3b 3b 20 52 6f 6c 6c 75 70 20 74 68 65 20 70 61 ;; Rollup the pa
114d0 73 73 2f 66 61 69 6c 20 63 6f 75 6e 74 73 20 66 ss/fail counts f
114e0 72 6f 6d 20 69 74 65 6d 69 7a 65 64 20 74 65 73 rom itemized tes
114f0 74 73 20 69 6e 74 6f 20 66 61 69 6c 5f 63 6f 75 ts into fail_cou
11500 6e 74 20 61 6e 64 20 70 61 73 73 5f 63 6f 75 6e nt and pass_coun
11510 74 0a 3b 3b 20 4e 4f 54 45 3a 20 49 73 20 74 68 t.;; NOTE: Is th
11520 69 73 20 64 75 70 6c 69 63 61 74 69 6e 67 20 28 is duplicating (
11530 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c db:test-data-rol
11540 6c 75 70 20 64 62 20 74 65 73 74 2d 69 64 20 73 lup db test-id s
11550 74 61 74 75 73 29 20 3f 3f 3f 3f 0a 28 64 65 66 tatus) ????.(def
11560 69 6e 65 20 28 64 62 3a 72 6f 6c 6c 2d 75 70 2d ine (db:roll-up-
11570 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
11580 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
11590 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
115a0 74 61 74 75 73 29 0a 20 20 3b 3b 20 28 63 64 62 tatus). ;; (cdb
115b0 3a 66 6c 75 73 68 2d 71 75 65 75 65 20 2a 72 75 :flush-queue *ru
115c0 6e 72 65 6d 6f 74 65 2a 29 0a 20 20 28 69 66 20 nremote*). (if
115d0 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c (and (not (equal
115e0 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 ? item-path ""))
115f0 0a 09 20 20 20 28 6d 65 6d 62 65 72 20 73 74 61 .. (member sta
11600 74 75 73 20 27 28 22 50 41 53 53 22 20 22 57 41 tus '("PASS" "WA
11610 52 4e 22 20 22 46 41 49 4c 22 20 22 57 41 49 56 RN" "FAIL" "WAIV
11620 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 43 ED" "RUNNING" "C
11630 48 45 43 4b 22 20 22 53 4b 49 50 22 29 29 29 0a HECK" "SKIP"))).
11640 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 73 (begin..(s
11650 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a qlite3:execute .
11660 09 20 64 62 0a 09 20 22 55 50 44 41 54 45 20 74 . db.. "UPDATE t
11670 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 20 20 ests .
11680 20 20 20 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e SET fail_coun
11690 74 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 t=(SELECT count(
116a0 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 id) FROM tests W
116b0 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
116c0 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
116d0 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 item_path != ''
116e0 20 41 4e 44 20 73 74 61 74 75 73 20 49 4e 20 28 AND status IN (
116f0 27 46 41 49 4c 27 2c 27 43 48 45 43 4b 27 29 29 'FAIL','CHECK'))
11700 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
11710 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d 28 53 pass_count=(S
11720 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 ELECT count(id)
11730 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
11740 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
11750 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
11760 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 m_path != '' AND
11770 20 73 74 61 74 75 73 20 49 4e 20 28 27 50 41 53 status IN ('PAS
11780 53 27 2c 27 57 41 52 4e 27 2c 27 57 41 49 56 45 S','WARN','WAIVE
11790 44 27 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 D')).
117a0 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f WHERE run_id=?
117b0 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
117c0 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
117d0 3b 22 0a 09 20 72 75 6e 2d 69 64 20 74 65 73 74 ;".. run-id test
117e0 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 -name run-id tes
117f0 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 t-name run-id te
11800 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 st-name).
11810 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
11820 70 21 20 30 2e 31 29 20 3b 3b 20 67 69 76 65 20 p! 0.1) ;; give
11830 6f 74 68 65 72 20 70 72 6f 63 65 73 73 65 73 20 other processes
11840 61 20 63 68 61 6e 63 65 20 68 65 72 65 2c 20 6e a chance here, n
11850 6f 2c 20 62 65 74 74 65 72 20 74 6f 20 62 65 20 o, better to be
11860 64 6f 6e 65 20 41 53 41 50 3f 0a 09 28 69 66 20 done ASAP?..(if
11870 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
11880 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 72 75 6e RUNNING") ;; run
11890 6e 69 6e 67 20 74 61 6b 65 73 20 70 72 69 6f 72 ning takes prior
118a0 69 74 79 20 6f 76 65 72 20 61 6c 6c 20 6f 74 68 ity over all oth
118b0 65 72 20 73 74 61 74 65 73 2c 20 66 6f 72 63 65 er states, force
118c0 20 74 68 65 20 74 65 73 74 20 73 74 61 74 65 20 the test state
118d0 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 20 20 20 20 to RUNNING..
118e0 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
118f0 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
11900 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 s SET state=? WH
11910 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
11920 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
11930 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 22 item_path='';" "
11940 52 55 4e 4e 49 4e 47 22 20 72 75 6e 2d 69 64 20 RUNNING" run-id
11950 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 test-name)..
11960 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
11970 0a 09 20 20 20 20 20 64 62 0a 09 20 20 20 20 20 .. db..
11980 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 20 "UPDATE tests.
11990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119a0 20 20 20 20 20 53 45 54 20 73 74 61 74 65 3d 43 SET state=C
119b0 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 20 20 ASE .
119c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119d0 20 20 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 WHEN (SE
119e0 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
119f0 52 4f 4d 20 74 65 73 74 73 20 0a 20 20 20 20 20 ROM tests .
11a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
11a30 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
11a40 73 74 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 20 20 stname=?.
11a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 41 4e AN
11a80 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
11a90 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ' .
11aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ac0 20 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 74 AND stat
11ad0 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e 47 27 2c e in ('RUNNING',
11ae0 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 29 29 20 'NOT_STARTED'))
11af0 3e 20 30 20 54 48 45 4e 20 27 52 55 4e 4e 49 4e > 0 THEN 'RUNNIN
11b00 47 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 G'.
11b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b20 20 20 20 20 20 20 45 4c 53 45 20 27 43 4f 4d 50 ELSE 'COMP
11b30 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 20 20 20 LETED' END,.
11b40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b50 20 20 20 20 20 20 20 20 73 74 61 74 75 73 3d 43 status=C
11b60 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 20 20 ASE .
11b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b80 20 20 20 20 20 20 20 57 48 45 4e 20 66 61 69 6c WHEN fail
11b90 5f 63 6f 75 6e 74 20 3e 20 30 20 54 48 45 4e 20 _count > 0 THEN
11ba0 27 46 41 49 4c 27 20 0a 20 20 20 20 20 20 20 20 'FAIL' .
11bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11bc0 20 20 20 20 20 20 20 20 20 20 57 48 45 4e 20 70 WHEN p
11bd0 61 73 73 5f 63 6f 75 6e 74 20 3e 20 30 20 41 4e ass_count > 0 AN
11be0 44 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 20 54 D fail_count=0 T
11bf0 48 45 4e 20 27 50 41 53 53 27 20 0a 20 20 20 20 HEN 'PASS' .
11c00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 WH
11c20 45 4e 20 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 EN (SELECT count
11c30 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 0a (id) FROM tests.
11c40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c60 20 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 WHERE r
11c70 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
11c80 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 20 20 20 20 name=?.
11c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11cb0 20 20 20 20 20 41 4e 44 20 69 74 65 6d 5f 70 61 AND item_pa
11cc0 74 68 20 21 3d 20 27 27 0a 20 20 20 20 20 20 20 th != ''.
11cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ce0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11cf0 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 74 75 AND statu
11d00 73 20 3d 20 27 53 4b 49 50 27 29 20 3e 20 30 20 s = 'SKIP') > 0
11d10 54 48 45 4e 20 27 53 4b 49 50 27 0a 20 20 20 20 THEN 'SKIP'.
11d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11d30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c EL
11d40 53 45 20 27 55 4e 4b 4e 4f 57 4e 27 20 45 4e 44 SE 'UNKNOWN' END
11d50 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11d60 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 WHERE ru
11d70 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
11d80 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
11d90 61 74 68 3d 27 27 3b 22 0a 09 20 20 20 20 20 72 ath='';".. r
11da0 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
11db0 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
11dc0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
11dd0 65 29 29 0a 09 23 66 29 0a 20 20 20 20 20 20 23 e))..#f). #
11de0 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d f))..;;=========
11df0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
11e30 20 54 65 73 74 73 20 6d 65 74 61 20 64 61 74 61 Tests meta data
11e40 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
11e50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 =========..;; re
11e90 61 64 20 74 68 65 20 72 65 63 6f 72 64 20 67 69 ad the record gi
11ea0 76 65 6e 20 61 20 74 65 73 74 6e 61 6d 65 0a 28 ven a testname.(
11eb0 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d define (db:testm
11ec0 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 eta-get-record d
11ed0 62 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 6c b testname). (l
11ee0 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 20 et ((res #f)).
11ef0 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
11f00 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
11f10 6d 62 64 61 20 28 69 64 20 74 65 73 74 6e 61 6d mbda (id testnam
11f20 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 20 64 e author owner d
11f30 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 69 65 escription revie
11f40 77 65 64 20 69 74 65 72 61 74 65 64 20 61 76 67 wed iterated avg
11f50 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 69 73 _runtime avg_dis
11f60 6b 20 74 61 67 73 29 0a 20 20 20 20 20 20 20 28 k tags). (
11f70 73 65 74 21 20 72 65 73 20 28 76 65 63 74 6f 72 set! res (vector
11f80 20 69 64 20 74 65 73 74 6e 61 6d 65 20 61 75 74 id testname aut
11f90 68 6f 72 20 6f 77 6e 65 72 20 64 65 73 63 72 69 hor owner descri
11fa0 70 74 69 6f 6e 20 72 65 76 69 65 77 65 64 20 69 ption reviewed i
11fb0 74 65 72 61 74 65 64 20 61 76 67 5f 72 75 6e 74 terated avg_runt
11fc0 69 6d 65 20 61 76 67 5f 64 69 73 6b 20 74 61 67 ime avg_disk tag
11fd0 73 29 29 29 0a 20 20 20 20 20 64 62 20 22 53 45 s))). db "SE
11fe0 4c 45 43 54 20 69 64 2c 74 65 73 74 6e 61 6d 65 LECT id,testname
11ff0 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c 64 65 ,author,owner,de
12000 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 65 77 scription,review
12010 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 67 5f ed,iterated,avg_
12020 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 73 6b runtime,avg_disk
12030 2c 74 61 67 73 20 46 52 4f 4d 20 74 65 73 74 5f ,tags FROM test_
12040 6d 65 74 61 20 57 48 45 52 45 20 74 65 73 74 6e meta WHERE testn
12050 61 6d 65 3d 3f 3b 22 0a 20 20 20 20 20 74 65 73 ame=?;". tes
12060 74 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 29 29 tname). res))
12070 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 6e 65 ..;; create a ne
12080 77 20 72 65 63 6f 72 64 20 66 6f 72 20 61 20 67 w record for a g
12090 69 76 65 6e 20 74 65 73 74 6e 61 6d 65 0a 28 64 iven testname.(d
120a0 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d 65 efine (db:testme
120b0 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 64 62 ta-add-record db
120c0 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 73 71 testname). (sq
120d0 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
120e0 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f "INSERT OR IGNO
120f0 52 45 20 49 4e 54 4f 20 74 65 73 74 5f 6d 65 74 RE INTO test_met
12100 61 20 28 74 65 73 74 6e 61 6d 65 2c 61 75 74 68 a (testname,auth
12110 6f 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 69 70 or,owner,descrip
12120 74 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c 69 74 tion,reviewed,it
12130 65 72 61 74 65 64 2c 61 76 67 5f 72 75 6e 74 69 erated,avg_runti
12140 6d 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 67 73 me,avg_disk,tags
12150 29 20 56 41 4c 55 45 53 20 28 3f 2c 27 27 2c 27 ) VALUES (?,'','
12160 27 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 27 ','','','','',''
12170 2c 27 27 29 3b 22 20 74 65 73 74 6e 61 6d 65 29 ,'');" testname)
12180 29 0a 0a 3b 3b 20 75 70 64 61 74 65 20 6f 6e 65 )..;; update one
12190 20 6f 66 20 74 68 65 20 74 65 73 74 6d 65 74 61 of the testmeta
121a0 20 66 69 65 6c 64 73 0a 28 64 65 66 69 6e 65 20 fields.(define
121b0 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 (db:testmeta-upd
121c0 61 74 65 2d 66 69 65 6c 64 20 64 62 20 74 65 73 ate-field db tes
121d0 74 6e 61 6d 65 20 66 69 65 6c 64 20 76 61 6c 75 tname field valu
121e0 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 e). (sqlite3:ex
121f0 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 ecute db (conc "
12200 55 50 44 41 54 45 20 74 65 73 74 5f 6d 65 74 61 UPDATE test_meta
12210 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 3d 3f SET " field "=?
12220 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d WHERE testname=
12230 3f 3b 22 29 20 76 61 6c 75 65 20 74 65 73 74 6e ?;") value testn
12240 61 6d 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d ame))..;;=======
12250 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12260 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12270 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12280 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12290 3b 3b 20 54 20 45 20 53 20 54 20 20 20 44 20 41 ;; T E S T D A
122a0 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d T A .;;========
122b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
122e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
122f0 28 64 65 66 69 6e 65 20 28 64 62 3a 63 73 76 2d (define (db:csv-
12300 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 >test-data db te
12310 73 74 2d 69 64 20 63 73 76 64 61 74 61 20 23 21 st-id csvdata #!
12320 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 key (work-area #
12330 66 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 f)). (debug:pri
12340 6e 74 20 34 20 22 74 65 73 74 2d 69 64 20 22 20 nt 4 "test-id "
12350 74 65 73 74 2d 69 64 20 22 2c 20 63 73 76 64 61 test-id ", csvda
12360 74 61 3a 20 22 20 63 73 76 64 61 74 61 29 0a 20 ta: " csvdata).
12370 20 28 6c 65 74 20 28 28 74 64 62 20 20 20 20 20 (let ((tdb
12380 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 (db:open-test-db
12390 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74 -by-test-id db t
123a0 65 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 est-id work-area
123b0 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 20 : work-area))).
123c0 20 20 20 28 69 66 20 74 64 62 0a 09 28 6c 65 74 (if tdb..(let
123d0 20 28 28 63 73 76 6c 69 73 74 20 28 63 73 76 2d ((csvlist (csv-
123e0 3e 6c 69 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d >list (make-csv-
123f0 72 65 61 64 65 72 0a 09 09 09 09 20 20 20 28 6f reader..... (o
12400 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 pen-input-string
12410 20 63 73 76 64 61 74 61 29 0a 09 09 09 09 20 20 csvdata).....
12420 20 27 28 28 73 74 72 69 70 2d 6c 65 61 64 69 6e '((strip-leadin
12430 67 2d 77 68 69 74 65 73 70 61 63 65 3f 20 23 74 g-whitespace? #t
12440 29 0a 09 09 09 09 20 20 20 20 20 28 73 74 72 69 )..... (stri
12450 70 2d 74 72 61 69 6c 69 6e 67 2d 77 68 69 74 65 p-trailing-white
12460 73 70 61 63 65 3f 20 23 74 29 29 20 29 29 29 29 space? #t)) ))))
12470 20 3b 3b 20 28 63 73 76 2d 3e 6c 69 73 74 20 63 ;; (csv->list c
12480 73 76 64 61 74 61 29 29 29 0a 09 20 20 28 66 6f svdata))).. (fo
12490 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d r-each .. (lam
124a0 62 64 61 20 28 63 73 76 72 6f 77 29 0a 09 20 20 bda (csvrow)..
124b0 20 20 20 28 6c 65 74 2a 20 28 28 70 61 64 64 65 (let* ((padde
124c0 64 2d 72 6f 77 20 20 28 74 61 6b 65 20 28 61 70 d-row (take (ap
124d0 70 65 6e 64 20 63 73 76 72 6f 77 20 28 6c 69 73 pend csvrow (lis
124e0 74 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 t #f #f #f #f #f
124f0 20 23 66 20 23 66 20 23 66 20 23 66 29 29 20 39 #f #f #f #f)) 9
12500 29 29 0a 09 09 20 20 20 20 28 63 61 74 65 67 6f ))... (catego
12510 72 79 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 ry (list-ref
12520 70 61 64 64 65 64 2d 72 6f 77 20 30 29 29 0a 09 padded-row 0))..
12530 09 20 20 20 20 28 76 61 72 69 61 62 6c 65 20 20 . (variable
12540 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 (list-ref padd
12550 65 64 2d 72 6f 77 20 31 29 29 0a 09 09 20 20 20 ed-row 1))...
12560 20 28 76 61 6c 75 65 20 20 20 20 20 20 20 28 61 (value (a
12570 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f ny->number-if-po
12580 73 73 69 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 ssible (list-ref
12590 20 70 61 64 64 65 64 2d 72 6f 77 20 32 29 29 29 padded-row 2)))
125a0 0a 09 09 20 20 20 20 28 65 78 70 65 63 74 65 64 ... (expected
125b0 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 (any->number
125c0 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 -if-possible (li
125d0 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f st-ref padded-ro
125e0 77 20 33 29 29 29 0a 09 09 20 20 20 20 28 74 6f w 3)))... (to
125f0 6c 20 20 20 20 20 20 20 20 20 28 61 6e 79 2d 3e l (any->
12600 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 number-if-possib
12610 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 le (list-ref pad
12620 64 65 64 2d 72 6f 77 20 34 29 29 29 20 3b 3b 20 ded-row 4))) ;;
12630 3e 2c 20 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 6f 72 >, <, >=, <=, or
12640 20 61 20 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 a number...
12650 28 75 6e 69 74 73 20 20 20 20 20 20 20 28 6c 69 (units (li
12660 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f st-ref padded-ro
12670 77 20 35 29 29 0a 09 09 20 20 20 20 28 63 6f 6d w 5))... (com
12680 6d 65 6e 74 20 20 20 20 20 28 6c 69 73 74 2d 72 ment (list-r
12690 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 36 29 ef padded-row 6)
126a0 29 0a 09 09 20 20 20 20 28 73 74 61 74 75 73 20 )... (status
126b0 20 20 20 20 20 28 6c 65 74 20 28 28 73 20 28 6c (let ((s (l
126c0 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 ist-ref padded-r
126d0 6f 77 20 37 29 29 29 0a 09 09 09 09 20 20 20 28 ow 7)))..... (
126e0 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f if (and (string?
126f0 20 73 29 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d s)(or (string-m
12700 61 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 5c atch (regexp "^\
12710 5c 73 2a 24 22 29 20 73 29 0a 09 09 09 09 09 09 \s*$") s).......
12720 09 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 . (string-matc
12730 68 20 28 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 h (regexp "^n/a$
12740 22 29 20 73 29 29 29 0a 09 09 09 09 20 20 20 20 ") s))).....
12750 20 20 20 23 66 0a 09 09 09 09 20 20 20 20 20 20 #f.....
12760 20 73 29 29 29 20 3b 3b 20 69 66 20 73 70 65 63 s))) ;; if spec
12770 69 66 69 65 64 20 6f 6e 20 74 68 65 20 69 6e 70 ified on the inp
12780 75 74 20 74 68 65 6e 20 75 73 65 2c 20 65 6c 73 ut then use, els
12790 65 20 63 61 6c 63 75 6c 61 74 65 0a 09 09 20 20 e calculate...
127a0 20 20 28 74 79 70 65 20 20 20 20 20 20 20 20 28 (type (
127b0 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
127c0 72 6f 77 20 38 29 29 29 0a 09 20 20 20 20 20 20 row 8)))..
127d0 20 3b 3b 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 ;; look up expe
127e0 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 cted,tol,units f
127f0 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 62 65 73 rom previous bes
12800 74 20 66 69 74 20 74 65 73 74 20 69 66 20 74 68 t fit test if th
12810 65 79 20 61 72 65 20 61 6c 6c 20 65 69 74 68 65 ey are all eithe
12820 72 20 23 66 20 6f 72 20 27 27 0a 09 20 20 20 20 r #f or ''..
12830 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12840 34 20 22 42 45 46 4f 52 45 3a 20 63 61 74 65 67 4 "BEFORE: categ
12850 6f 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 ory: " category
12860 22 20 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 " variable: " va
12870 72 69 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 riable " value:
12880 22 20 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 " value ....
12890 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 ", expected: " e
128a0 78 70 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 xpected " tol: "
128b0 20 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 tol " units: "
128c0 75 6e 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 units " status:
128d0 22 20 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 " status " comme
128e0 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 20 22 20 nt: " comment "
128f0 74 79 70 65 3a 20 22 20 74 79 70 65 29 0a 0a 09 type: " type)...
12900 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
12910 28 6f 72 20 28 6e 6f 74 20 65 78 70 65 63 74 65 (or (not expecte
12920 64 29 28 65 71 75 61 6c 3f 20 65 78 70 65 63 74 d)(equal? expect
12930 65 64 20 22 22 29 29 0a 09 09 09 28 6f 72 20 28 ed ""))....(or (
12940 6e 6f 74 20 74 6f 6c 29 20 20 20 20 20 28 65 71 not tol) (eq
12950 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 22 22 ual? expected ""
12960 29 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 20 75 ))....(or (not u
12970 6e 69 74 73 29 20 20 20 28 65 71 75 61 6c 3f 20 nits) (equal?
12980 65 78 70 65 63 74 65 64 20 22 22 29 29 29 0a 09 expected "")))..
12990 09 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 . (let-values
129a0 28 28 28 6e 65 77 2d 65 78 70 65 63 74 65 64 20 (((new-expected
129b0 6e 65 77 2d 74 6f 6c 20 6e 65 77 2d 75 6e 69 74 new-tol new-unit
129c0 73 29 28 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 s)(db:get-prev-t
129d0 6f 6c 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 ol-for-test db t
129e0 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 est-id category
129f0 76 61 72 69 61 62 6c 65 29 29 29 0a 09 09 09 20 variable)))....
12a00 20 20 20 20 20 20 28 73 65 74 21 20 65 78 70 65 (set! expe
12a10 63 74 65 64 20 6e 65 77 2d 65 78 70 65 63 74 65 cted new-expecte
12a20 64 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 d).... (se
12a30 74 21 20 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d t! tol new-
12a40 74 6f 6c 29 0a 09 09 09 20 20 20 20 20 20 20 28 tol).... (
12a50 73 65 74 21 20 75 6e 69 74 73 20 20 20 20 6e 65 set! units ne
12a60 77 2d 75 6e 69 74 73 29 29 29 0a 0a 09 20 20 20 w-units)))...
12a70 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
12a80 20 34 20 22 41 46 54 45 52 3a 20 20 63 61 74 65 4 "AFTER: cate
12a90 67 6f 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 gory: " category
12aa0 20 22 20 76 61 72 69 61 62 6c 65 3a 20 22 20 76 " variable: " v
12ab0 61 72 69 61 62 6c 65 20 22 20 76 61 6c 75 65 3a ariable " value:
12ac0 20 22 20 76 61 6c 75 65 20 0a 09 09 09 20 20 20 " value ....
12ad0 20 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 ", expected: "
12ae0 65 78 70 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 expected " tol:
12af0 22 20 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 " tol " units: "
12b00 20 75 6e 69 74 73 20 22 20 73 74 61 74 75 73 3a units " status:
12b10 20 22 20 73 74 61 74 75 73 20 22 20 63 6f 6d 6d " status " comm
12b20 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a ent: " comment).
12b30 09 20 20 20 20 20 20 20 3b 3b 20 63 61 6c 63 75 . ;; calcu
12b40 6c 61 74 65 20 73 74 61 74 75 73 20 69 66 20 4e late status if N
12b50 4f 54 20 73 70 65 63 69 66 69 65 64 0a 09 20 20 OT specified..
12b60 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e (if (and (n
12b70 6f 74 20 73 74 61 74 75 73 29 28 6e 75 6d 62 65 ot status)(numbe
12b80 72 3f 20 65 78 70 65 63 74 65 64 29 28 6e 75 6d r? expected)(num
12b90 62 65 72 3f 20 76 61 6c 75 65 29 29 20 3b 3b 20 ber? value)) ;;
12ba0 6e 65 65 64 20 65 78 70 65 63 74 65 64 20 61 6e need expected an
12bb0 64 20 76 61 6c 75 65 20 74 6f 20 62 65 20 6e 75 d value to be nu
12bc0 6d 62 65 72 73 0a 09 09 20 20 20 28 69 66 20 28 mbers... (if (
12bd0 6e 75 6d 62 65 72 3f 20 74 6f 6c 29 20 3b 3b 20 number? tol) ;;
12be0 69 66 20 74 6f 6c 20 69 73 20 61 20 6e 75 6d 62 if tol is a numb
12bf0 65 72 20 74 68 65 6e 20 77 65 20 64 6f 20 74 68 er then we do th
12c00 65 20 73 74 61 6e 64 61 72 64 20 63 6f 6d 70 61 e standard compa
12c10 72 69 73 6f 6e 0a 09 09 20 20 20 20 20 20 20 28 rison... (
12c20 6c 65 74 2a 20 28 28 6d 61 78 2d 76 61 6c 20 28 let* ((max-val (
12c30 2b 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 29 + expected tol))
12c40 0a 09 09 09 20 20 20 20 20 20 28 6d 69 6e 2d 76 .... (min-v
12c50 61 6c 20 28 2d 20 65 78 70 65 63 74 65 64 20 74 al (- expected t
12c60 6f 6c 29 29 0a 09 09 09 20 20 20 20 20 20 28 72 ol)).... (r
12c70 65 73 75 6c 74 20 20 28 61 6e 64 20 28 3e 3d 20 esult (and (>=
12c80 20 76 61 6c 75 65 20 6d 69 6e 2d 76 61 6c 29 28 value min-val)(
12c90 3c 3d 20 76 61 6c 75 65 20 6d 61 78 2d 76 61 6c <= value max-val
12ca0 29 29 29 29 0a 09 09 09 20 28 64 65 62 75 67 3a )))).... (debug:
12cb0 70 72 69 6e 74 20 34 20 22 6d 61 78 2d 76 61 6c print 4 "max-val
12cc0 3a 20 22 20 6d 61 78 2d 76 61 6c 20 22 20 6d 69 : " max-val " mi
12cd0 6e 2d 76 61 6c 3a 20 22 20 6d 69 6e 2d 76 61 6c n-val: " min-val
12ce0 20 22 20 72 65 73 75 6c 74 3a 20 22 20 72 65 73 " result: " res
12cf0 75 6c 74 29 0a 09 09 09 20 28 73 65 74 21 20 73 ult).... (set! s
12d00 74 61 74 75 73 20 28 69 66 20 72 65 73 75 6c 74 tatus (if result
12d10 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 29 "pass" "fail"))
12d20 29 0a 09 09 20 20 20 20 20 20 20 28 73 65 74 21 )... (set!
12d30 20 73 74 61 74 75 73 20 3b 3b 20 4e 42 2f 2f 20 status ;; NB//
12d40 6e 65 65 64 20 74 6f 20 61 73 73 65 73 73 20 65 need to assess e
12d50 61 63 68 20 6f 6e 65 20 28 69 2e 65 2e 20 6e 6f ach one (i.e. no
12d60 74 20 72 65 74 75 72 6e 20 6f 70 65 72 61 74 6f t return operato
12d70 72 20 73 69 6e 63 65 20 6e 65 65 64 20 74 6f 20 r since need to
12d80 61 63 74 20 69 66 20 6e 6f 74 20 76 61 6c 69 64 act if not valid
12d90 20 6f 70 2e 0a 09 09 09 20 20 20 20 20 28 63 61 op..... (ca
12da0 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
12db0 6f 6c 20 74 6f 6c 29 20 3b 3b 20 74 6f 6c 20 73 ol tol) ;; tol s
12dc0 68 6f 75 6c 64 20 62 65 20 3e 2c 20 3c 2c 20 3e hould be >, <, >
12dd0 3d 2c 20 3c 3d 0a 09 09 09 20 20 20 20 20 20 20 =, <=....
12de0 28 28 3e 29 20 20 28 69 66 20 28 3e 20 20 76 61 ((>) (if (> va
12df0 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 lue expected) "p
12e00 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 ass" "fail"))...
12e10 09 20 20 20 20 20 20 20 28 28 3c 29 20 20 28 69 . ((<) (i
12e20 66 20 28 3c 20 20 76 61 6c 75 65 20 65 78 70 65 f (< value expe
12e30 63 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 cted) "pass" "fa
12e40 69 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 il"))....
12e50 28 28 3e 3d 29 20 28 69 66 20 28 3e 3d 20 76 61 ((>=) (if (>= va
12e60 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 lue expected) "p
12e70 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 ass" "fail"))...
12e80 09 20 20 20 20 20 20 20 28 28 3c 3d 29 20 28 69 . ((<=) (i
12e90 66 20 28 3c 3d 20 76 61 6c 75 65 20 65 78 70 65 f (<= value expe
12ea0 63 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 cted) "pass" "fa
12eb0 69 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 il"))....
12ec0 28 65 6c 73 65 20 28 63 6f 6e 63 20 22 45 52 52 (else (conc "ERR
12ed0 4f 52 3a 20 62 61 64 20 74 6f 6c 20 63 6f 6d 70 OR: bad tol comp
12ee0 61 72 61 74 6f 72 20 22 20 74 6f 6c 29 29 29 29 arator " tol))))
12ef0 29 29 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 )).. (debu
12f00 67 3a 70 72 69 6e 74 20 34 20 22 41 46 54 45 52 g:print 4 "AFTER
12f10 32 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63 2: category: " c
12f20 61 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62 ategory " variab
12f30 6c 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 le: " variable "
12f40 20 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 value: " value
12f50 0a 09 09 09 20 20 20 20 22 2c 20 65 78 70 65 63 .... ", expec
12f60 74 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 20 ted: " expected
12f70 22 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 " tol: " tol " u
12f80 6e 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 20 nits: " units "
12f90 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 status: " status
12fa0 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f " comment: " co
12fb0 6d 6d 65 6e 74 29 0a 09 20 20 20 20 20 20 20 28 mment).. (
12fc0 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
12fd0 74 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 52 tdb "INSERT OR R
12fe0 45 50 4c 41 43 45 20 49 4e 54 4f 20 74 65 73 74 EPLACE INTO test
12ff0 5f 64 61 74 61 20 28 74 65 73 74 5f 69 64 2c 63 _data (test_id,c
13000 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 ategory,variable
13010 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 2c ,value,expected,
13020 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e tol,units,commen
13030 74 2c 73 74 61 74 75 73 2c 74 79 70 65 29 20 56 t,status,type) V
13040 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f ALUES (?,?,?,?,?
13050 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 ,?,?,?,?,?);"...
13060 09 09 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f ..test-id catego
13070 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
13080 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
13090 6e 69 74 73 20 28 69 66 20 63 6f 6d 6d 65 6e 74 nits (if comment
130a0 20 63 6f 6d 6d 65 6e 74 20 22 22 29 20 73 74 61 comment "") sta
130b0 74 75 73 20 74 79 70 65 29 29 29 0a 09 20 20 20 tus type)))..
130c0 63 73 76 6c 69 73 74 29 0a 09 20 20 28 73 71 6c csvlist).. (sql
130d0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
130e0 64 62 29 29 29 29 29 0a 0a 3b 3b 20 67 65 74 20 db)))))..;; get
130f0 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 5f 64 a list of test_d
13100 61 74 61 20 72 65 63 6f 72 64 73 20 6d 61 74 63 ata records matc
13110 68 69 6e 67 20 63 61 74 65 67 6f 72 79 70 61 74 hing categorypat
13120 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 72 65 t.(define (db:re
13130 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 62 20 ad-test-data db
13140 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 test-id category
13150 70 61 74 74 20 23 21 6b 65 79 20 28 77 6f 72 6b patt #!key (work
13160 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c 65 -area #f)). (le
13170 74 20 28 28 74 64 62 20 20 28 64 62 3a 6f 70 65 t ((tdb (db:ope
13180 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
13190 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 20 t-id db test-id
131a0 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d work-area: work-
131b0 61 72 65 61 29 29 29 0a 20 20 20 20 28 69 66 20 area))). (if
131c0 74 64 62 0a 09 28 6c 65 74 20 28 28 72 65 73 20 tdb..(let ((res
131d0 27 28 29 29 29 0a 09 20 20 28 73 71 6c 69 74 65 '())).. (sqlite
131e0 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
131f0 09 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 . (lambda (id
13200 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f 72 79 test_id category
13210 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 variable value
13220 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 expected tol uni
13230 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61 74 75 ts comment statu
13240 73 20 74 79 70 65 29 0a 09 20 20 20 20 20 28 73 s type).. (s
13250 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76 et! res (cons (v
13260 65 63 74 6f 72 20 69 64 20 74 65 73 74 5f 69 64 ector id test_id
13270 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 category variab
13280 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 le value expecte
13290 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f 6d 6d d tol units comm
132a0 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 65 29 ent status type)
132b0 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 62 0a res))).. tdb.
132c0 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 74 . "SELECT id,t
132d0 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c est_id,category,
132e0 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 variable,value,e
132f0 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 xpected,tol,unit
13300 73 2c 63 6f 6d 6d 65 6e 74 2c 73 74 61 74 75 73 s,comment,status
13310 2c 74 79 70 65 20 46 52 4f 4d 20 74 65 73 74 5f ,type FROM test_
13320 64 61 74 61 20 57 48 45 52 45 20 74 65 73 74 5f data WHERE test_
13330 69 64 3d 3f 20 41 4e 44 20 63 61 74 65 67 6f 72 id=? AND categor
13340 79 20 4c 49 4b 45 20 3f 20 4f 52 44 45 52 20 42 y LIKE ? ORDER B
13350 59 20 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 Y category,varia
13360 62 6c 65 3b 22 20 74 65 73 74 2d 69 64 20 63 61 ble;" test-id ca
13370 74 65 67 6f 72 79 70 61 74 74 29 0a 09 20 20 28 tegorypatt).. (
13380 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
13390 21 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 72 ! tdb).. (rever
133a0 73 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 29 se res))..'())))
133b0 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 52 75 6e 20 74 ..;; NOTE: Run t
133c0 68 69 73 20 6c 6f 63 61 6c 20 77 69 74 68 20 23 his local with #
133d0 66 20 66 6f 72 20 64 62 20 21 21 21 0a 28 64 65 f for db !!!.(de
133e0 66 69 6e 65 20 28 64 62 3a 6c 6f 61 64 2d 74 65 fine (db:load-te
133f0 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d st-data db test-
13400 69 64 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 id #!key (work-a
13410 72 65 61 20 23 66 29 29 0a 20 20 28 6c 65 74 20 rea #f)). (let
13420 6c 6f 6f 70 20 28 28 6c 69 6e 20 28 72 65 61 64 loop ((lin (read
13430 2d 6c 69 6e 65 29 29 29 0a 20 20 20 20 28 69 66 -line))). (if
13440 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 (not (eof-objec
13450 74 3f 20 6c 69 6e 29 29 0a 09 28 62 65 67 69 6e t? lin))..(begin
13460 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
13470 20 34 20 6c 69 6e 29 0a 09 20 20 28 64 62 3a 63 4 lin).. (db:c
13480 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 sv->test-data db
13490 20 74 65 73 74 2d 69 64 20 6c 69 6e 20 77 6f 72 test-id lin wor
134a0 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
134b0 61 29 0a 09 20 20 28 6c 6f 6f 70 20 28 72 65 61 a).. (loop (rea
134c0 64 2d 6c 69 6e 65 29 29 29 29 29 0a 20 20 3b 3b d-line))))). ;;
134d0 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 63 75 72 roll up the cur
134e0 72 65 6e 74 20 72 65 73 75 6c 74 73 2e 0a 20 20 rent results..
134f0 3b 3b 20 46 49 58 4d 45 3a 20 41 64 64 20 74 68 ;; FIXME: Add th
13500 65 20 73 74 61 74 75 73 20 74 6f 20 0a 20 20 28 e status to . (
13510 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c db:test-data-rol
13520 6c 75 70 20 64 62 20 74 65 73 74 2d 69 64 20 23 lup db test-id #
13530 66 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 f work-area: wor
13540 6b 2d 61 72 65 61 29 29 0a 0a 3b 3b 20 57 41 52 k-area))..;; WAR
13550 4e 49 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 61 6c NING: Do NOT cal
13560 6c 20 74 68 69 73 20 66 6f 72 20 74 68 65 20 70 l this for the p
13570 61 72 65 6e 74 20 74 65 73 74 20 6f 6e 20 61 6e arent test on an
13580 20 69 74 65 72 61 74 65 64 20 74 65 73 74 0a 3b iterated test.;
13590 3b 20 52 6f 6c 6c 20 75 70 20 74 65 73 74 5f 64 ; Roll up test_d
135a0 61 74 61 20 70 61 73 73 2f 66 61 69 6c 20 72 65 ata pass/fail re
135b0 73 75 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 61 74 sults.;; look at
135c0 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 73 the test_data s
135d0 74 61 74 75 73 20 66 69 65 6c 64 2c 20 0a 3b 3b tatus field, .;;
135e0 20 20 20 20 69 66 20 61 6c 6c 20 61 72 65 20 70 if all are p
135f0 61 73 73 20 28 61 6e 79 20 63 61 73 65 29 20 61 ass (any case) a
13600 6e 64 20 74 68 65 20 74 65 73 74 20 73 74 61 74 nd the test stat
13610 75 73 20 69 73 20 50 41 53 53 20 6f 72 20 4e 55 us is PASS or NU
13620 4c 4c 20 6f 72 20 27 27 20 74 68 65 6e 20 73 65 LL or '' then se
13630 74 20 74 65 73 74 20 73 74 61 74 75 73 20 74 6f t test status to
13640 20 50 41 53 53 2e 0a 3b 3b 20 20 20 20 69 66 20 PASS..;; if
13650 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 61 72 65 20 one or more are
13660 66 61 69 6c 20 28 61 6e 79 20 63 61 73 65 29 20 fail (any case)
13670 74 68 65 6e 20 73 65 74 20 74 65 73 74 20 73 74 then set test st
13680 61 74 75 73 20 74 6f 20 50 41 53 53 2c 20 6e 6f atus to PASS, no
13690 6e 20 22 70 61 73 73 22 20 6f 72 20 22 66 61 69 n "pass" or "fai
136a0 6c 22 20 61 72 65 20 69 67 6e 6f 72 65 64 0a 28 l" are ignored.(
136b0 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
136c0 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 data-rollup db t
136d0 65 73 74 2d 69 64 20 73 74 61 74 75 73 20 23 21 est-id status #!
136e0 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 key (work-area #
136f0 66 29 29 0a 20 20 28 6c 65 74 20 28 28 74 64 62 f)). (let ((tdb
13700 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 (db:open-test-d
13710 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 b-by-test-id db
13720 74 65 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 test-id work-are
13730 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 a: work-area))..
13740 28 66 61 69 6c 2d 63 6f 75 6e 74 20 30 29 0a 09 (fail-count 0)..
13750 28 70 61 73 73 2d 63 6f 75 6e 74 20 30 29 29 0a (pass-count 0)).
13760 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 (if tdb..(be
13770 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a gin.. (sqlite3:
13780 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 for-each-row..
13790 20 28 6c 61 6d 62 64 61 20 28 66 63 6f 75 6e 74 (lambda (fcount
137a0 20 70 63 6f 75 6e 74 29 0a 09 20 20 20 20 20 28 pcount).. (
137b0 73 65 74 21 20 66 61 69 6c 2d 63 6f 75 6e 74 20 set! fail-count
137c0 66 63 6f 75 6e 74 29 0a 09 20 20 20 20 20 28 73 fcount).. (s
137d0 65 74 21 20 70 61 73 73 2d 63 6f 75 6e 74 20 70 et! pass-count p
137e0 63 6f 75 6e 74 29 29 0a 09 20 20 20 74 64 62 20 count)).. tdb
137f0 0a 09 20 20 20 22 53 45 4c 45 43 54 20 28 53 45 .. "SELECT (SE
13800 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
13810 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 ROM test_data WH
13820 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e ERE test_id=? AN
13830 44 20 73 74 61 74 75 73 20 6c 69 6b 65 20 27 66 D status like 'f
13840 61 69 6c 27 29 20 41 53 20 66 61 69 6c 5f 63 6f ail') AS fail_co
13850 75 6e 74 2c 0a 20 20 20 20 20 20 20 20 20 20 20 unt,.
13860 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 54 20 (SELECT
13870 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 count(id) FROM t
13880 65 73 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 est_data WHERE t
13890 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 73 74 61 est_id=? AND sta
138a0 74 75 73 20 6c 69 6b 65 20 27 70 61 73 73 27 29 tus like 'pass')
138b0 20 41 53 20 70 61 73 73 5f 63 6f 75 6e 74 3b 22 AS pass_count;"
138c0 0a 09 20 20 20 74 65 73 74 2d 69 64 20 74 65 73 .. test-id tes
138d0 74 2d 69 64 29 0a 09 20 20 28 73 71 6c 69 74 65 t-id).. (sqlite
138e0 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 3:finalize! tdb)
138f0 0a 0a 09 20 20 3b 3b 20 4e 6f 77 20 72 6f 6c 6c ... ;; Now roll
13900 75 70 20 74 68 65 20 63 6f 75 6e 74 73 20 74 6f up the counts to
13910 20 74 68 65 20 63 65 6e 74 72 61 6c 20 6d 65 67 the central meg
13920 61 74 65 73 74 2e 64 62 0a 09 20 20 28 63 64 62 atest.db.. (cdb
13930 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 :pass-fail-count
13940 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 s *runremote* te
13950 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 st-id fail-count
13960 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a 09 20 20 pass-count)..
13970 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ;; (sqlite3:exec
13980 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
13990 65 73 74 73 20 53 45 54 20 66 61 69 6c 5f 63 6f ests SET fail_co
139a0 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f 75 6e 74 unt=?,pass_count
139b0 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 =? WHERE id=?;"
139c0 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 .. ;;
139d0 20 20 20 20 20 20 20 20 20 20 20 66 61 69 6c 2d fail-
139e0 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 count pass-count
139f0 20 74 65 73 74 2d 69 64 29 0a 0a 09 20 20 3b 3b test-id)... ;;
13a00 20 54 68 65 20 66 6c 75 73 68 20 69 73 20 6e 6f The flush is no
13a10 74 20 6e 65 65 64 65 64 20 77 69 74 68 20 74 68 t needed with th
13a20 65 20 74 72 61 6e 73 61 63 74 69 6f 6e 20 62 61 e transaction ba
13a30 73 65 64 20 77 72 69 74 65 20 61 67 72 65 67 61 sed write agrega
13a40 74 69 6f 6e 20 65 6e 61 62 6c 65 64 2e 20 52 65 tion enabled. Re
13a50 6d 6f 76 65 20 74 68 65 73 65 20 63 6f 6d 6d 65 move these comme
13a60 6e 74 65 64 20 6c 69 6e 65 73 0a 09 20 20 3b 3b nted lines.. ;;
13a70 20 6e 65 78 74 20 74 69 6d 65 20 79 6f 75 20 72 next time you r
13a80 65 61 64 20 74 68 69 73 21 0a 09 20 20 3b 3b 0a ead this!.. ;;.
13a90 09 20 20 3b 3b 20 28 63 64 62 3a 66 6c 75 73 68 . ;; (cdb:flush
13aa0 2d 71 75 65 75 65 20 2a 72 75 6e 72 65 6d 6f 74 -queue *runremot
13ab0 65 2a 29 0a 09 20 20 3b 3b 20 28 74 68 72 65 61 e*).. ;; (threa
13ac0 64 2d 73 6c 65 65 70 21 20 31 29 20 3b 3b 20 70 d-sleep! 1) ;; p
13ad0 6c 61 79 20 6e 69 63 65 20 77 69 74 68 20 74 68 lay nice with th
13ae0 65 20 71 75 65 75 65 20 62 79 20 65 6e 73 75 72 e queue by ensur
13af0 69 6e 67 20 74 68 65 20 72 6f 6c 6c 75 70 20 69 ing the rollup i
13b00 73 20 61 74 20 6c 65 61 73 74 20 31 30 6d 73 20 s at least 10ms
13b10 6c 61 74 65 72 20 74 68 61 6e 20 74 68 65 20 73 later than the s
13b20 65 74 0a 09 20 20 0a 09 20 20 3b 3b 20 69 66 20 et.. .. ;; if
13b30 74 68 65 20 74 65 73 74 20 69 73 20 6e 6f 74 20 the test is not
13b40 46 41 49 4c 20 74 68 65 6e 20 73 65 74 20 73 74 FAIL then set st
13b50 61 74 75 73 20 62 61 73 65 64 20 6f 6e 20 74 68 atus based on th
13b60 65 20 66 61 69 6c 20 61 6e 64 20 70 61 73 73 20 e fail and pass
13b70 63 6f 75 6e 74 73 2e 0a 09 20 20 28 63 64 62 3a counts... (cdb:
13b80 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 test-rollup-test
13b90 5f 64 61 74 61 2d 70 61 73 73 2d 66 61 69 6c 20 _data-pass-fail
13ba0 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 *runremote* test
13bb0 2d 69 64 29 0a 09 20 20 3b 3b 20 28 73 71 6c 69 -id).. ;; (sqli
13bc0 74 65 33 3a 65 78 65 63 75 74 65 0a 09 20 20 3b te3:execute.. ;
13bd0 3b 20 20 64 62 20 20 20 3b 3b 3b 20 4e 4f 54 45 ; db ;;; NOTE
13be0 3a 20 53 68 6f 75 6c 64 20 74 68 69 73 20 62 65 : Should this be
13bf0 20 57 41 52 4e 2c 46 41 49 4c 3f 20 41 20 57 41 WARN,FAIL? A WA
13c00 52 4e 20 69 73 20 6e 6f 74 20 61 20 46 41 49 4c RN is not a FAIL
13c10 3f 3f 3f 3f 3f 20 42 55 47 20 46 49 58 4d 45 0a ????? BUG FIXME.
13c20 09 20 20 3b 3b 20 20 22 55 50 44 41 54 45 20 74 . ;; "UPDATE t
13c30 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 3b ests. ;
13c40 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 53 45 ; SE
13c50 54 20 73 74 61 74 75 73 3d 43 41 53 45 20 57 48 T status=CASE WH
13c60 45 4e 20 28 53 45 4c 45 43 54 20 66 61 69 6c 5f EN (SELECT fail_
13c70 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 count FROM tests
13c80 20 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 WHERE id=?) > 0
13c90 20 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 . ;;
13ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54 48 TH
13cb0 45 4e 20 27 46 41 49 4c 27 0a 20 20 20 20 20 20 EN 'FAIL'.
13cc0 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
13cd0 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 WHEN (SELECT
13ce0 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 pass_count FROM
13cf0 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f tests WHERE id=?
13d00 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 20 ) > 0 AND .
13d10 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
13d20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 54 (SELECT
13d30 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65 73 status FROM tes
13d40 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 4e ts WHERE id=?) N
13d50 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c 27 46 OT IN ('WARN','F
13d60 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 20 20 AIL').
13d70 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 54 ;; T
13d80 48 45 4e 20 27 50 41 53 53 27 0a 20 20 20 20 20 HEN 'PASS'.
13d90 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
13da0 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 0a ELSE status.
13db0 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
13dc0 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 69 END WHERE i
13dd0 64 3d 3f 3b 22 0a 09 20 20 3b 3b 20 20 74 65 73 d=?;".. ;; tes
13de0 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 t-id test-id tes
13df0 74 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 20 t-id test-id)..
13e00 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))))..(define (
13e10 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c 2d db:get-prev-tol-
13e20 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 for-test db test
13e30 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 -id category var
13e40 69 61 62 6c 65 29 0a 20 20 3b 3b 20 46 69 6e 69 iable). ;; Fini
13e50 73 68 20 6d 65 3f 0a 20 20 28 76 61 6c 75 65 73 sh me?. (values
13e60 20 23 66 20 23 66 20 23 66 29 29 0a 0a 3b 3b 3d #f #f #f))..;;=
13e70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13e80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13e90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ea0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13eb0 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 54 20 45 20 50 =====.;; S T E P
13ec0 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S .;;==========
13ed0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ee0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ef0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13f00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
13f10 65 66 69 6e 65 20 28 64 62 3a 73 74 65 70 2d 67 efine (db:step-g
13f20 65 74 2d 74 69 6d 65 2d 61 73 2d 73 74 72 69 6e et-time-as-strin
13f30 67 20 76 65 63 29 0a 20 20 28 73 65 63 6f 6e 64 g vec). (second
13f40 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 20 28 s->time-string (
13f50 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
13f60 74 5f 74 69 6d 65 20 76 65 63 29 29 29 0a 0a 3b t_time vec)))..;
13f70 3b 20 64 62 2d 67 65 74 2d 74 65 73 74 2d 73 74 ; db-get-test-st
13f80 65 70 73 2d 66 6f 72 2d 72 75 6e 0a 28 64 65 66 eps-for-run.(def
13f90 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 70 ine (db:get-step
13fa0 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 s-for-test db te
13fb0 73 74 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 st-id #!key (wor
13fc0 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c k-area #f)). (l
13fd0 65 74 2a 20 28 28 74 64 62 20 28 64 62 3a 6f 70 et* ((tdb (db:op
13fe0 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 en-test-db-by-te
13ff0 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 st-id db test-id
14000 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b work-area: work
14010 2d 61 72 65 61 29 29 0a 09 20 28 72 65 73 20 27 -area)).. (res '
14020 28 29 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 ())). (if tdb
14030 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c ..(begin.. (sql
14040 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
14050 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 w .. (lambda (
14060 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e id test-id stepn
14070 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
14080 20 65 76 65 6e 74 2d 74 69 6d 65 20 6c 6f 67 66 event-time logf
14090 69 6c 65 29 0a 09 20 20 20 20 20 28 73 65 74 21 ile).. (set!
140a0 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 res (cons (vect
140b0 6f 72 20 69 64 20 74 65 73 74 2d 69 64 20 73 74 or id test-id st
140c0 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 epname state sta
140d0 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 tus event-time (
140e0 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 if (string? logf
140f0 69 6c 65 29 20 6c 6f 67 66 69 6c 65 20 22 22 29 ile) logfile "")
14100 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 62 ) res))).. tdb
14110 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c .. "SELECT id,
14120 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 test_id,stepname
14130 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
14140 65 6e 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 ent_time,logfile
14150 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 FROM test_steps
14160 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
14170 20 4f 52 44 45 52 20 42 59 20 69 64 20 41 53 43 ORDER BY id ASC
14180 3b 22 20 3b 3b 20 65 76 65 6e 74 5f 74 69 6d 65 ;" ;; event_time
14190 20 44 45 53 43 2c 69 64 20 41 53 43 3b 0a 09 20 DESC,id ASC;..
141a0 20 20 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 test-id).. (s
141b0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
141c0 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 72 73 tdb).. (revers
141d0 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 29 0a e res))..'()))).
141e0 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 79 .;; get a pretty
141f0 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 72 table to summar
14200 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 64 65 ize steps.;;.(de
14210 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 fine (db:get-ste
14220 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 73 74 ps-table db test
14230 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d -id #!key (work-
14240 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c 65 74 area #f)). (let
14250 20 28 28 73 74 65 70 73 20 20 20 28 64 62 3a 67 ((steps (db:g
14260 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 et-steps-for-tes
14270 74 20 64 62 20 74 65 73 74 2d 69 64 20 77 6f 72 t db test-id wor
14280 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
14290 61 29 29 29 0a 20 20 20 20 3b 3b 20 6f 72 67 61 a))). ;; orga
142a0 6e 69 73 65 20 74 68 65 20 73 74 65 70 73 20 66 nise the steps f
142b0 6f 72 20 62 65 74 74 65 72 20 72 65 61 64 61 62 or better readab
142c0 69 6c 69 74 79 0a 20 20 20 20 28 6c 65 74 20 28 ility. (let (
142d0 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d (res (make-hash-
142e0 74 61 62 6c 65 29 29 29 0a 20 20 20 20 20 20 28 table))). (
142f0 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 20 for-each .
14300 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 29 0a (lambda (step).
14310 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 . (debug:print 6
14320 20 22 73 74 65 70 3d 22 20 73 74 65 70 29 0a 09 "step=" step)..
14330 20 28 6c 65 74 20 28 28 72 65 63 6f 72 64 20 28 (let ((record (
14340 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
14350 65 66 61 75 6c 74 20 0a 09 09 09 72 65 73 20 0a efault ....res .
14360 09 09 09 28 64 62 3a 73 74 65 70 2d 67 65 74 2d ...(db:step-get-
14370 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 20 0a stepname step) .
14380 09 09 09 3b 3b 20 20 20 20 20 20 20 20 73 74 65 ...;; ste
14390 70 6e 61 6d 65 20 20 20 20 20 20 20 20 20 20 20 pname
143a0 20 20 20 20 20 73 74 61 72 74 20 65 6e 64 20 73 start end s
143b0 74 61 74 75 73 20 44 75 72 61 74 69 6f 6e 20 20 tatus Duration
143c0 4c 6f 67 66 69 6c 65 20 0a 09 09 09 28 76 65 63 Logfile ....(vec
143d0 74 6f 72 20 28 64 62 3a 73 74 65 70 2d 67 65 74 tor (db:step-get
143e0 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 20 -stepname step)
143f0 22 22 20 20 20 22 22 20 22 22 20 20 20 20 20 22 "" "" "" "
14400 22 20 20 20 20 20 20 20 20 22 22 29 29 29 29 0a " "")))).
14410 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
14420 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 6f 72 6 "record(befor
14430 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 e) = " record ..
14440 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 .."\nid: "
14450 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
14460 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 step)...."\nste
14470 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 pname: " (db:ste
14480 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
14490 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 tep)...."\nstate
144a0 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d : " (db:step-
144b0 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
144c0 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 ..."\nstatus:
144d0 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
144e0 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
144f0 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 \ntime: " (d
14500 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
14510 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 _time step))..
14520 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
14530 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 70 2d symbol (db:step-
14540 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
14550 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
14560 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
14570 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 1 (db:step-ge
14580 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
14590 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
145a0 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 or-set! record 3
145b0 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 (if (equal? (ve
145c0 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 ctor-ref record
145d0 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 62 3a 3) "")......(db:
145e0 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
145f0 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
14600 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
14610 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d 67 65 ngth (db:step-ge
14620 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
14630 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 ... 0)... (
14640 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
14650 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 5 (db:step-ge
14660 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
14670 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 29 20 )).. ((end)
14680 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
14690 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 -set! record 2 (
146a0 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
146b0 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
146c0 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 20 20 ime step)))..
146d0 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
146e0 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
146f0 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
14700 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
14710 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
14720 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 20 28 (let ((startt (
14730 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 any->number (vec
14740 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
14750 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 64 74 )))...... (endt
14760 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 (any->number
14770 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
14780 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 20 20 rd 2)))).....
14790 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
147a0 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 4 "record[1]=" (
147b0 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
147c0 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 20 22 d 1) ....... "
147d0 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 72 74 , startt=" start
147e0 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 t ", endt=" endt
147f0 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 65 74 ....... ", get
14800 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 73 -status: " (db:s
14810 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
14820 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 tep)).....
14830 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 (if (and (number
14840 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 ? startt)(number
14850 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 ? endt))......
14860 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e (seconds->hr-min
14870 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 -sec (- endt sta
14880 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 rtt)) "-1")))..
14890 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
148a0 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73 ing-length (db:s
148b0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
148c0 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 step))... 0)
148d0 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
148e0 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73 ! record 5 (db:s
148f0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
14900 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 step)))).. (
14910 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 65 63 else.. (vec
14920 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
14930 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 2 (db:step-get-s
14940 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 20 20 tate step))..
14950 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
14960 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
14970 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
14980 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
14990 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
149a0 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
149b0 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
149c0 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ).. (hash-tabl
149d0 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 3a 73 e-set! res (db:s
149e0 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
149f0 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 0a 09 step) record)..
14a00 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
14a10 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 72 29 6 "record(after)
14a20 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 09 = " record ...
14a30 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 20 ."\nid: "
14a40 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 (db:step-get-id
14a50 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 step)...."\nstep
14a60 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 70 name: " (db:step
14a70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
14a80 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a ep)...."\nstate:
14a90 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 " (db:step-g
14aa0 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
14ab0 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
14ac0 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
14ad0 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c atus step)...."\
14ae0 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 62 ntime: " (db
14af0 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
14b00 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 20 20 time step)))).
14b10 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 20 20 ;; (else
14b20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
14b30 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 ord 1 (db:step-g
14b40 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
14b50 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 73 6f ep))). (so
14b60 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 64 61 rt steps (lambda
14b70 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 28 63 (a b)... (c
14b80 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 28 3c 20 ond... ((<
14b90 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 (db:step-get-e
14ba0 76 65 6e 74 5f 74 69 6d 65 20 61 29 28 64 62 3a vent_time a)(db:
14bb0 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
14bc0 69 6d 65 20 62 29 29 20 23 74 29 0a 09 09 20 20 ime b)) #t)...
14bd0 20 20 20 20 28 28 65 71 3f 20 28 64 62 3a 73 74 ((eq? (db:st
14be0 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d ep-get-event_tim
14bf0 65 20 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 e a)(db:step-get
14c00 2d 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 20 -event_time b))
14c10 0a 09 09 20 20 20 20 20 20 20 28 3c 20 20 20 28 ... (< (
14c20 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 61 db:step-get-id a
14c30 29 20 20 20 20 20 20 20 20 28 64 62 3a 73 74 65 ) (db:ste
14c40 70 2d 67 65 74 2d 69 64 20 62 29 29 29 0a 09 09 p-get-id b)))...
14c50 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 (else #f))
14c60 29 29 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 ))). res)))
14c70 0a 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 ..;; get a prett
14c80 79 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 y table to summa
14c90 72 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 64 rize steps.;;.(d
14ca0 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 efine (db:get-st
14cb0 65 70 73 2d 74 61 62 6c 65 2d 6c 69 73 74 20 64 eps-table-list d
14cc0 62 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 b test-id #!key
14cd0 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 0a (work-area #f)).
14ce0 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 20 20 (let ((steps
14cf0 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 (db:get-steps-f
14d00 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 2d or-test db test-
14d10 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f id work-area: wo
14d20 72 6b 2d 61 72 65 61 29 29 29 0a 20 20 20 20 3b rk-area))). ;
14d30 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 20 73 ; organise the s
14d40 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 72 20 teps for better
14d50 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 20 20 readability.
14d60 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
14d70 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 -hash-table))).
14d80 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
14d90 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
14da0 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 3a 70 step).. (debug:p
14db0 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 20 73 rint 6 "step=" s
14dc0 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 72 65 tep).. (let ((re
14dd0 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cord (hash-table
14de0 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 09 09 -ref/default ...
14df0 09 72 65 73 20 0a 09 09 09 28 64 62 3a 73 74 65 .res ....(db:ste
14e00 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
14e10 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 20 20 20 tep) ....;;
14e20 20 20 20 73 74 65 70 6e 61 6d 65 20 20 20 20 20 stepname
14e30 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 start
14e40 20 65 6e 64 20 73 74 61 74 75 73 20 20 20 20 0a end status .
14e50 09 09 09 28 76 65 63 74 6f 72 20 28 64 62 3a 73 ...(vector (db:s
14e60 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
14e70 20 73 74 65 70 29 20 22 22 20 20 20 22 22 20 22 step) "" "" "
14e80 22 20 20 20 20 20 22 22 20 22 22 29 29 29 29 0a " "" "")))).
14e90 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
14ea0 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 6f 72 6 "record(befor
14eb0 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 e) = " record ..
14ec0 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 .."\nid: "
14ed0 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
14ee0 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 step)...."\nste
14ef0 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 pname: " (db:ste
14f00 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
14f10 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 tep)...."\nstate
14f20 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d : " (db:step-
14f30 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
14f40 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 ..."\nstatus:
14f50 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
14f60 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
14f70 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 \ntime: " (d
14f80 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
14f90 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 _time step))..
14fa0 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
14fb0 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 70 2d symbol (db:step-
14fc0 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
14fd0 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
14fe0 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
14ff0 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 1 (db:step-ge
15000 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
15010 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
15020 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 or-set! record 3
15030 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 (if (equal? (ve
15040 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 ctor-ref record
15050 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 62 3a 3) "")......(db:
15060 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
15070 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
15080 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
15090 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d 67 65 ngth (db:step-ge
150a0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
150b0 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 ... 0)... (
150c0 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
150d0 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 5 (db:step-ge
150e0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
150f0 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 29 20 )).. ((end)
15100 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
15110 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 -set! record 2 (
15120 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
15130 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
15140 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 20 20 ime step)))..
15150 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
15160 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
15170 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
15180 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
15190 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
151a0 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 20 28 (let ((startt (
151b0 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 any->number (vec
151c0 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
151d0 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 64 74 )))...... (endt
151e0 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 (any->number
151f0 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
15200 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 20 20 rd 2)))).....
15210 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
15220 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 4 "record[1]=" (
15230 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
15240 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 20 22 d 1) ....... "
15250 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 72 74 , startt=" start
15260 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 t ", endt=" endt
15270 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 65 74 ....... ", get
15280 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 73 -status: " (db:s
15290 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
152a0 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 tep)).....
152b0 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 (if (and (number
152c0 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 ? startt)(number
152d0 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 ? endt))......
152e0 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e (seconds->hr-min
152f0 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 -sec (- endt sta
15300 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 rtt)) "-1")))..
15310 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
15320 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73 ing-length (db:s
15330 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
15340 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 step))... 0)
15350 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
15360 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73 ! record 5 (db:s
15370 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
15380 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 step)))).. (
15390 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 65 63 else.. (vec
153a0 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
153b0 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 2 (db:step-get-s
153c0 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 20 20 tate step))..
153d0 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
153e0 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
153f0 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
15400 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
15410 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
15420 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
15430 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
15440 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ).. (hash-tabl
15450 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 3a 73 e-set! res (db:s
15460 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
15470 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 0a 09 step) record)..
15480 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
15490 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 72 29 6 "record(after)
154a0 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 09 = " record ...
154b0 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 20 ."\nid: "
154c0 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 (db:step-get-id
154d0 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 step)...."\nstep
154e0 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 70 name: " (db:step
154f0 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
15500 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a ep)...."\nstate:
15510 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 " (db:step-g
15520 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
15530 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
15540 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
15550 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c atus step)...."\
15560 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 62 ntime: " (db
15570 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
15580 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 20 20 time step)))).
15590 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 20 20 ;; (else
155a0 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
155b0 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 ord 1 (db:step-g
155c0 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
155d0 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 73 6f ep))). (so
155e0 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 64 61 rt steps (lambda
155f0 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 28 63 (a b)... (c
15600 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 28 3c 20 ond... ((<
15610 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 (db:step-get-e
15620 76 65 6e 74 5f 74 69 6d 65 20 61 29 28 64 62 3a vent_time a)(db:
15630 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
15640 69 6d 65 20 62 29 29 20 23 74 29 0a 09 09 20 20 ime b)) #t)...
15650 20 20 20 20 28 28 65 71 3f 20 28 64 62 3a 73 74 ((eq? (db:st
15660 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d ep-get-event_tim
15670 65 20 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 e a)(db:step-get
15680 2d 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 20 -event_time b))
15690 0a 09 09 20 20 20 20 20 20 20 28 3c 20 20 20 28 ... (< (
156a0 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 61 db:step-get-id a
156b0 29 20 20 20 20 20 20 20 20 28 64 62 3a 73 74 65 ) (db:ste
156c0 70 2d 67 65 74 2d 69 64 20 62 29 29 29 0a 09 09 p-get-id b)))...
156d0 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 (else #f))
156e0 29 29 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 ))). res)))
156f0 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 ..(define (db:ge
15700 74 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 74 65 t-compressed-ste
15710 70 73 20 74 65 73 74 2d 69 64 20 23 21 6b 65 79 ps test-id #!key
15720 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 (work-area #f))
15730 0a 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 . (if (or (not
15740 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 66 work-area).. (f
15750 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e ile-exists? (con
15760 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f 74 65 c work-area "/te
15770 73 74 64 61 74 2e 64 62 22 29 29 29 0a 20 20 20 stdat.db"))).
15780 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 70 72 (let* ((compr
15790 73 74 65 70 73 20 28 6f 70 65 6e 2d 72 75 6e 2d steps (open-run-
157a0 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 73 74 65 close db:get-ste
157b0 70 73 2d 74 61 62 6c 65 20 23 66 20 74 65 73 74 ps-table #f test
157c0 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 -id work-area: w
157d0 6f 72 6b 2d 61 72 65 61 29 29 29 0a 09 28 6d 61 ork-area)))..(ma
157e0 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 20 p (lambda (x)..
157f0 20 20 20 20 20 20 3b 3b 20 74 61 6b 65 20 61 64 ;; take ad
15800 76 61 6e 74 61 67 65 20 6f 66 20 74 68 65 20 5c vantage of the \
15810 6e 20 6f 6e 20 74 69 6d 65 2d 3e 73 74 72 69 6e n on time->strin
15820 67 0a 09 20 20 20 20 20 20 20 28 76 65 63 74 6f g.. (vecto
15830 72 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 66 20 r...(vector-ref
15840 78 20 30 29 0a 09 09 28 6c 65 74 20 28 28 73 20 x 0)...(let ((s
15850 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 (vector-ref x 1)
15860 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6d 62 ))... (if (numb
15870 65 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e er? s)(seconds->
15880 74 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 time-string s) s
15890 29 29 0a 09 09 28 6c 65 74 20 28 28 73 20 28 76 ))...(let ((s (v
158a0 65 63 74 6f 72 2d 72 65 66 20 78 20 32 29 29 29 ector-ref x 2)))
158b0 0a 09 09 20 20 28 69 66 20 28 6e 75 6d 62 65 72 ... (if (number
158c0 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e 74 69 ? s)(seconds->ti
158d0 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 29 29 me-string s) s))
158e0 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 66 20 78 ...(vector-ref x
158f0 20 33 29 20 20 20 20 3b 3b 20 73 74 61 74 75 73 3) ;; status
15900 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 66 20 78 ...(vector-ref x
15910 20 34 29 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 4)...(vector-re
15920 66 20 78 20 35 29 29 29 20 20 3b 3b 20 74 69 6d f x 5))) ;; tim
15930 65 20 64 65 6c 74 61 0a 09 20 20 20 20 20 28 73 e delta.. (s
15940 6f 72 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ort (hash-table-
15950 76 61 6c 75 65 73 20 63 6f 6d 70 72 73 74 65 70 values comprstep
15960 73 29 0a 09 09 20 20 20 28 6c 61 6d 62 64 61 20 s)... (lambda
15970 28 61 20 62 29 0a 09 09 20 20 20 20 20 28 6c 65 (a b)... (le
15980 74 20 28 28 74 69 6d 65 2d 61 20 28 76 65 63 74 t ((time-a (vect
15990 6f 72 2d 72 65 66 20 61 20 31 29 29 0a 09 09 09 or-ref a 1))....
159a0 20 20 20 28 74 69 6d 65 2d 62 20 28 76 65 63 74 (time-b (vect
159b0 6f 72 2d 72 65 66 20 62 20 31 29 29 29 0a 09 09 or-ref b 1)))...
159c0 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
159d0 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d 61 29 (number? time-a)
159e0 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d 62 29 (number? time-b)
159f0 29 0a 09 09 09 20 20 20 28 69 66 20 28 3c 20 74 ).... (if (< t
15a00 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 0a 09 09 ime-a time-b)...
15a10 09 20 20 20 20 20 20 20 23 74 0a 09 09 09 20 20 . #t....
15a20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 74 69 (if (eq? ti
15a30 6d 65 2d 61 20 74 69 6d 65 2d 62 29 0a 09 09 09 me-a time-b)....
15a40 09 20 20 20 28 73 74 72 69 6e 67 3c 3f 20 28 63 . (string<? (c
15a50 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 onc (vector-ref
15a60 61 20 32 29 29 0a 09 09 09 09 09 20 20 20 20 20 a 2))......
15a70 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 (conc (vector-re
15a80 66 20 62 20 32 29 29 29 0a 09 09 09 09 20 20 20 f b 2))).....
15a90 23 66 29 29 0a 09 09 09 20 20 20 28 73 74 72 69 #f)).... (stri
15aa0 6e 67 3c 3f 20 28 63 6f 6e 63 20 74 69 6d 65 2d ng<? (conc time-
15ab0 61 29 28 63 6f 6e 63 20 74 69 6d 65 2d 62 29 29 a)(conc time-b))
15ac0 29 29 29 29 29 29 0a 20 20 20 20 20 20 27 28 29 )))))). '()
15ad0 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
15ae0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
15b20 4d 20 49 20 53 20 43 20 20 20 4d 20 41 20 4e 20 M I S C M A N
15b30 41 20 47 20 45 20 4d 20 45 20 4e 20 54 20 20 20 A G E M E N T
15b40 49 20 54 20 45 20 4d 20 53 20 0a 3b 3b 3d 3d 3d I T E M S .;;===
15b50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15b90 3d 3d 3d 0a 0a 3b 3b 20 74 68 65 20 6e 65 77 20 ===..;; the new
15ba0 70 72 65 72 65 71 73 20 63 61 6c 63 75 6c 61 74 prereqs calculat
15bb0 69 6f 6e 2c 20 6c 6f 6f 6b 73 20 61 6c 73 6f 20 ion, looks also
15bc0 61 74 20 69 74 65 6d 70 61 74 68 20 69 66 20 73 at itempath if s
15bd0 70 65 63 69 66 69 65 64 0a 3b 3b 20 61 6c 6c 20 pecified.;; all
15be0 70 72 65 72 65 71 73 20 6d 75 73 74 20 62 65 20 prereqs must be
15bf0 6d 65 74 3a 0a 3b 3b 20 20 20 20 69 66 20 70 72 met:.;; if pr
15c00 65 72 65 71 20 74 65 73 74 20 77 69 74 68 20 69 ereq test with i
15c10 74 65 6d 70 61 74 68 3d 27 27 20 69 73 20 43 4f tempath='' is CO
15c20 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 53 MPLETED and PASS
15c30 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 6f , WARN, CHECK, o
15c40 72 20 57 41 49 56 45 44 20 74 68 65 6e 20 70 72 r WAIVED then pr
15c50 65 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b 20 20 ereq is met.;;
15c60 20 20 69 66 20 70 72 65 72 65 71 20 74 65 73 74 if prereq test
15c70 20 77 69 74 68 20 69 74 65 6d 70 61 74 68 3d 72 with itempath=r
15c80 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 61 6e 64 ef-item-path and
15c90 20 43 4f 4d 50 4c 45 54 45 44 20 77 69 74 68 20 COMPLETED with
15ca0 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43 PASS, WARN, CHEC
15cb0 4b 2c 20 6f 72 20 57 41 49 56 45 44 20 74 68 65 K, or WAIVED the
15cc0 6e 20 70 72 65 72 65 71 20 69 73 20 6d 65 74 0a n prereq is met.
15cd0 3b 3b 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f 64 65 ;;.;; Note: mode
15ce0 20 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 20 74 'normal means t
15cf0 68 61 74 20 74 65 73 74 73 20 6d 75 73 74 20 62 hat tests must b
15d00 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 e COMPLETED and
15d10 6f 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c 20 57 ok (i.e. PASS, W
15d20 41 52 4e 2c 20 43 48 45 43 4b 2c 20 53 4b 49 50 ARN, CHECK, SKIP
15d30 20 6f 72 20 57 41 49 56 45 44 29 0a 3b 3b 20 20 or WAIVED).;;
15d40 20 20 20 20 20 6d 6f 64 65 20 27 74 6f 70 6c 65 mode 'tople
15d50 76 65 6c 20 6d 65 61 6e 73 20 74 68 61 74 20 74 vel means that t
15d60 65 73 74 73 20 6d 75 73 74 20 62 65 20 43 4f 4d ests must be COM
15d70 50 4c 45 54 45 44 20 6f 6e 6c 79 0a 3b 3b 20 20 PLETED only.;;
15d80 20 20 20 20 20 6d 6f 64 65 20 27 69 74 65 6d 6d mode 'itemm
15d90 61 74 63 68 20 6d 65 61 6e 73 20 74 68 61 74 20 atch means that
15da0 74 65 73 74 73 20 69 74 65 6d 73 20 6d 75 73 74 tests items must
15db0 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e be COMPLETED an
15dc0 64 20 28 50 41 53 53 7c 57 41 52 4e 7c 57 41 49 d (PASS|WARN|WAI
15dd0 56 45 44 7c 43 48 45 43 4b 29 20 5b 5b 20 4e 42 VED|CHECK) [[ NB
15de0 2f 2f 20 4e 4f 54 20 49 4d 50 4c 45 4d 45 4e 54 // NOT IMPLEMENT
15df0 45 44 20 59 45 54 20 5d 5d 0a 3b 3b 20 0a 28 64 ED YET ]].;; .(d
15e00 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 70 72 efine (db:get-pr
15e10 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 72 75 ereqs-not-met ru
15e20 6e 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 65 66 n-id waitons ref
15e30 2d 69 74 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 -item-path #!key
15e40 20 28 6d 6f 64 65 20 27 6e 6f 72 6d 61 6c 29 29 (mode 'normal))
15e50 0a 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 . (if (or (not
15e60 77 61 69 74 6f 6e 73 29 0a 09 20 20 28 6e 75 6c waitons).. (nul
15e70 6c 3f 20 77 61 69 74 6f 6e 73 29 29 0a 20 20 20 l? waitons)).
15e80 20 20 20 27 28 29 0a 20 20 20 20 20 20 28 6c 65 '(). (le
15e90 74 2a 20 28 28 75 6e 6d 65 74 2d 70 72 65 2d 72 t* ((unmet-pre-r
15ea0 65 71 73 20 27 28 29 29 0a 09 20 20 20 20 20 28 eqs '()).. (
15eb0 72 65 73 75 6c 74 20 20 20 20 20 20 20 20 20 27 result '
15ec0 28 29 29 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 ()))..(for-each
15ed0 0a 09 20 28 6c 61 6d 62 64 61 20 28 77 61 69 74 .. (lambda (wait
15ee0 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 ontest-name)..
15ef0 20 3b 3b 20 62 79 20 67 65 74 74 69 6e 67 20 74 ;; by getting t
15f00 68 65 20 74 65 73 74 73 20 77 69 74 68 20 6d 61 he tests with ma
15f10 74 63 68 69 6e 67 20 6e 61 6d 65 20 77 65 20 61 tching name we a
15f20 72 65 20 6c 6f 6f 6b 69 6e 67 20 6f 6e 6c 79 20 re looking only
15f30 61 74 20 74 68 65 20 6d 61 74 63 68 69 6e 67 20 at the matching
15f40 74 65 73 74 20 0a 09 20 20 20 3b 3b 20 61 6e 64 test .. ;; and
15f50 20 72 65 6c 61 74 65 64 20 73 75 62 20 69 74 65 related sub ite
15f60 6d 73 0a 09 20 20 20 28 6c 65 74 20 28 28 74 65 ms.. (let ((te
15f70 73 74 73 20 20 20 20 20 20 20 20 20 20 20 20 20 sts
15f80 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
15f90 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
15fa0 2d 72 75 6e 20 23 66 20 72 75 6e 2d 69 64 20 77 -run #f run-id w
15fb0 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 27 aitontest-name '
15fc0 28 29 20 27 28 29 29 29 0a 09 09 20 28 65 76 65 () '()))... (eve
15fd0 72 2d 73 65 65 6e 20 20 20 20 20 20 20 20 20 23 r-seen #
15fe0 66 29 0a 09 09 20 28 70 61 72 65 6e 74 2d 77 61 f)... (parent-wa
15ff0 69 74 6f 6e 2d 6d 65 74 20 23 66 29 0a 09 09 20 iton-met #f)...
16000 28 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 (item-waiton-met
16010 20 20 20 23 66 29 29 0a 09 20 20 20 20 20 28 66 #f)).. (f
16020 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 or-each ..
16030 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 (lambda (test)..
16040 09 3b 3b 20 28 69 66 20 28 65 71 75 61 6c 3f 20 .;; (if (equal?
16050 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 waitontest-name
16060 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
16070 74 6e 61 6d 65 20 74 65 73 74 29 29 20 3b 3b 20 tname test)) ;;
16080 62 79 20 64 65 66 69 6e 74 69 6f 6e 20 74 68 69 by defintion thi
16090 73 20 68 61 64 20 62 65 74 74 65 72 20 62 65 20 s had better be
160a0 74 72 75 65 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a true ......(let*
160b0 20 28 28 73 74 61 74 65 20 20 20 20 20 20 20 20 ((state
160c0 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge
160d0 74 2d 73 74 61 74 65 20 74 65 73 74 29 29 0a 09 t-state test))..
160e0 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
160f0 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 (db:t
16100 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
16110 65 73 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 est))... (
16120 69 74 65 6d 2d 70 61 74 68 20 20 20 20 20 20 20 item-path
16130 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
16140 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a tem-path test)).
16150 09 09 20 20 20 20 20 20 20 28 69 73 2d 63 6f 6d .. (is-com
16160 70 6c 65 74 65 64 20 20 20 20 20 20 28 65 71 75 pleted (equ
16170 61 6c 3f 20 73 74 61 74 65 20 22 43 4f 4d 50 4c al? state "COMPL
16180 45 54 45 44 22 29 29 0a 09 09 20 20 20 20 20 20 ETED"))...
16190 20 28 69 73 2d 6f 6b 20 20 20 20 20 20 20 20 20 (is-ok
161a0 20 20 20 20 28 6d 65 6d 62 65 72 20 73 74 61 74 (member stat
161b0 75 73 20 27 28 22 50 41 53 53 22 20 22 57 41 52 us '("PASS" "WAR
161c0 4e 22 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 N" "CHECK" "WAIV
161d0 45 44 22 20 22 53 4b 49 50 22 29 29 29 0a 09 09 ED" "SKIP")))...
161e0 20 20 20 20 20 20 20 28 73 61 6d 65 2d 69 74 65 (same-ite
161f0 6d 70 61 74 68 20 20 20 20 20 28 65 71 75 61 6c mpath (equal
16200 3f 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 ? ref-item-path
16210 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 09 20 item-path)))...
16220 20 28 73 65 74 21 20 65 76 65 72 2d 73 65 65 6e (set! ever-seen
16230 20 23 74 29 0a 09 09 20 20 28 63 6f 6e 64 0a 09 #t)... (cond..
16240 09 20 20 20 3b 3b 20 63 61 73 65 20 31 2c 20 6e . ;; case 1, n
16250 6f 6e 2d 69 74 65 6d 20 28 70 61 72 65 6e 74 20 on-item (parent
16260 74 65 73 74 29 20 69 73 20 0a 09 09 20 20 20 28 test) is ... (
16270 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 69 74 65 (and (equal? ite
16280 6d 2d 70 61 74 68 20 22 22 29 20 3b 3b 20 74 68 m-path "") ;; th
16290 69 73 20 69 73 20 74 68 65 20 70 61 72 65 6e 74 is is the parent
162a0 20 74 65 73 74 0a 09 09 09 20 69 73 2d 63 6f 6d test.... is-com
162b0 70 6c 65 74 65 64 0a 09 09 09 20 28 6f 72 20 69 pleted.... (or i
162c0 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 20 27 s-ok (eq? mode '
162d0 74 6f 70 6c 65 76 65 6c 29 29 29 0a 09 09 20 20 toplevel)))...
162e0 20 20 28 73 65 74 21 20 70 61 72 65 6e 74 2d 77 (set! parent-w
162f0 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 0a 09 aiton-met #t))..
16300 09 20 20 20 28 28 61 6e 64 20 73 61 6d 65 2d 69 . ((and same-i
16310 74 65 6d 70 61 74 68 0a 09 09 09 20 69 73 2d 63 tempath.... is-c
16320 6f 6d 70 6c 65 74 65 64 0a 09 09 09 20 28 6f 72 ompleted.... (or
16330 20 69 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 is-ok (eq? mode
16340 20 27 74 6f 70 6c 65 76 65 6c 29 29 29 0a 09 09 'toplevel)))...
16350 20 20 20 20 28 73 65 74 21 20 69 74 65 6d 2d 77 (set! item-w
16360 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 29 29 aiton-met #t))))
16370 29 0a 09 20 20 20 20 20 20 74 65 73 74 73 29 0a ).. tests).
16380 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 . (if (not (
16390 6f 72 20 70 61 72 65 6e 74 2d 77 61 69 74 6f 6e or parent-waiton
163a0 2d 6d 65 74 20 69 74 65 6d 2d 77 61 69 74 6f 6e -met item-waiton
163b0 2d 6d 65 74 29 29 0a 09 09 20 28 73 65 74 21 20 -met))... (set!
163c0 72 65 73 75 6c 74 20 28 61 70 70 65 6e 64 20 28 result (append (
163d0 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 if (null? tests)
163e0 20 28 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 73 (list waitontes
163f0 74 2d 6e 61 6d 65 29 20 74 65 73 74 73 29 20 72 t-name) tests) r
16400 65 73 75 6c 74 29 29 29 0a 09 20 20 20 20 20 3b esult))).. ;
16410 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 69 73 ; if the test is
16420 20 6e 6f 74 20 66 6f 75 6e 64 20 74 68 65 6e 20 not found then
16430 63 6c 65 61 72 6c 79 20 74 68 65 20 77 61 69 74 clearly the wait
16440 6f 6e 20 69 73 20 6e 6f 74 20 6d 65 74 2e 2e 2e on is not met...
16450 0a 09 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6e .. ;; (if (n
16460 6f 74 20 65 76 65 72 2d 73 65 65 6e 29 28 73 65 ot ever-seen)(se
16470 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 20 t! result (cons
16480 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 waitontest-name
16490 72 65 73 75 6c 74 29 29 29 29 29 0a 09 20 20 20 result)))))..
164a0 20 20 28 69 66 20 28 6e 6f 74 20 65 76 65 72 2d (if (not ever-
164b0 73 65 65 6e 29 0a 09 09 20 28 73 65 74 21 20 72 seen)... (set! r
164c0 65 73 75 6c 74 20 28 61 70 70 65 6e 64 20 28 69 esult (append (i
164d0 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 28 f (null? tests)(
164e0 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 73 74 2d list waitontest-
164f0 6e 61 6d 65 29 20 74 65 73 74 73 29 20 72 65 73 name) tests) res
16500 75 6c 74 29 29 29 29 29 0a 09 20 77 61 69 74 6f ult))))).. waito
16510 6e 73 29 0a 09 28 64 65 6c 65 74 65 2d 64 75 70 ns)..(delete-dup
16520 6c 69 63 61 74 65 73 20 72 65 73 75 6c 74 29 29 licates result))
16530 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
16540 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
16550 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 tus! db test-id
16560 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
16570 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
16580 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 comment logfile
16590 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 #!key (work-are
165a0 61 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 3a a #f)). (debug:
165b0 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 64 print 4 "test-id
165c0 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 74 65 : " test-id " te
165d0 73 74 73 74 65 70 2d 6e 61 6d 65 3a 20 22 20 74 ststep-name: " t
165e0 65 73 74 73 74 65 70 2d 6e 61 6d 65 29 0a 20 20 eststep-name).
165f0 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
16600 20 20 20 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d db:open-test-
16610 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 6f db-by-test-id do
16620 65 73 20 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 es cdb:remote-ru
16630 6e 0a 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 n. (let* ((tdb
16640 20 20 20 20 20 20 28 64 62 3a 6f 70 65 6e 2d 74 (db:open-t
16650 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
16660 64 20 64 62 20 74 65 73 74 2d 69 64 20 77 6f 72 d db test-id wor
16670 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
16680 61 29 29 0a 09 20 28 73 74 61 74 65 20 20 20 20 a)).. (state
16690 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d 76 61 (items:check-va
166a0 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61 74 65 lid-items "state
166b0 22 20 73 74 61 74 65 2d 69 6e 29 29 0a 09 20 28 " state-in)).. (
166c0 73 74 61 74 75 73 20 20 20 20 28 69 74 65 6d 73 status (items
166d0 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 :check-valid-ite
166e0 6d 73 20 22 73 74 61 74 75 73 22 20 73 74 61 74 ms "status" stat
166f0 75 73 2d 69 6e 29 29 29 0a 20 20 20 20 28 69 66 us-in))). (if
16700 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 65 29 (or (not state)
16710 28 6e 6f 74 20 73 74 61 74 75 73 29 29 0a 09 28 (not status))..(
16720 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 57 debug:print 3 "W
16730 41 52 4e 49 4e 47 3a 20 49 6e 76 61 6c 69 64 20 ARNING: Invalid
16740 22 20 28 69 66 20 73 74 61 74 75 73 20 22 73 74 " (if status "st
16750 61 74 75 73 22 20 22 73 74 61 74 65 22 29 0a 09 atus" "state")..
16760 09 20 20 20 20 20 22 20 76 61 6c 75 65 20 5c 22 . " value \"
16770 22 20 28 69 66 20 73 74 61 74 75 73 20 73 74 61 " (if status sta
16780 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 29 te-in status-in)
16790 20 22 5c 22 2c 20 75 70 64 61 74 65 20 79 6f 75 "\", update you
167a0 72 20 76 61 6c 69 64 76 61 6c 75 65 73 20 73 65 r validvalues se
167b0 63 74 69 6f 6e 20 69 6e 20 6d 65 67 61 74 65 73 ction in megates
167c0 74 2e 63 6f 6e 66 69 67 22 29 29 0a 20 20 20 20 t.config")).
167d0 28 69 66 20 74 64 62 0a 09 28 62 65 67 69 6e 0a (if tdb..(begin.
167e0 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
167f0 75 74 65 20 0a 09 20 20 20 74 64 62 0a 09 20 20 ute .. tdb..
16800 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
16810 41 43 45 20 69 6e 74 6f 20 74 65 73 74 5f 73 74 ACE into test_st
16820 65 70 73 20 28 74 65 73 74 5f 69 64 2c 73 74 65 eps (test_id,ste
16830 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 pname,state,stat
16840 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f us,event_time,co
16850 6d 6d 65 6e 74 2c 6c 6f 67 66 69 6c 65 29 20 56 mment,logfile) V
16860 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ALUES(?,?,?,?,?,
16870 3f 2c 3f 29 3b 22 0a 09 20 20 20 74 65 73 74 2d ?,?);".. test-
16880 69 64 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 id teststep-name
16890 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 state-in status
168a0 2d 69 6e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 -in (current-sec
168b0 6f 6e 64 73 29 20 28 69 66 20 63 6f 6d 6d 65 6e onds) (if commen
168c0 74 20 63 6f 6d 6d 65 6e 74 20 22 22 29 20 28 69 t comment "") (i
168d0 66 20 6c 6f 67 66 69 6c 65 20 6c 6f 67 66 69 6c f logfile logfil
168e0 65 20 22 22 29 29 0a 09 20 20 28 73 71 6c 69 74 e "")).. (sqlit
168f0 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
16900 29 0a 09 20 20 23 74 29 0a 09 23 66 29 29 29 0a ).. #t)..#f))).
16910 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
16920 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16930 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16940 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16950 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 =========.;; Ext
16960 72 61 63 74 20 6f 64 73 20 66 69 6c 65 20 66 72 ract ods file fr
16970 6f 6d 20 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d om the db.;;====
16980 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16990 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
169c0 3d 3d 0a 0a 3b 3b 20 72 75 6e 73 70 61 74 74 20 ==..;; runspatt
169d0 69 73 20 61 20 63 6f 6d 6d 61 20 64 65 6c 69 6d is a comma delim
169e0 69 74 65 64 20 6c 69 73 74 20 6f 66 20 72 75 6e ited list of run
169f0 20 70 61 74 74 65 72 6e 73 0a 3b 3b 20 6b 65 79 patterns.;; key
16a00 70 61 74 74 2d 61 6c 69 73 74 20 6d 75 73 74 20 patt-alist must
16a10 63 6f 6e 74 61 69 6e 20 2a 61 6c 6c 2a 20 6b 65 contain *all* ke
16a20 79 73 20 77 69 74 68 20 61 6e 20 61 73 73 6f 63 ys with an assoc
16a30 69 61 74 65 64 20 70 61 74 74 65 72 6e 3a 20 27 iated pattern: '
16a40 28 20 28 22 4b 45 59 31 22 20 22 25 22 29 20 2e ( ("KEY1" "%") .
16a50 2e 20 29 0a 28 64 65 66 69 6e 65 20 28 64 62 3a . ).(define (db:
16a60 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 extract-ods-file
16a70 20 64 62 20 6f 75 74 70 75 74 66 69 6c 65 20 6b db outputfile k
16a80 65 79 70 61 74 74 2d 61 6c 69 73 74 20 72 75 6e eypatt-alist run
16a90 73 70 61 74 74 20 70 61 74 68 6d 6f 64 29 0a 20 spatt pathmod).
16aa0 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 73 74 72 (let* ((keysstr
16ab0 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
16ac0 70 65 72 73 65 20 28 6d 61 70 20 63 61 72 20 6b perse (map car k
16ad0 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20 22 2c eypatt-alist) ",
16ae0 22 29 29 0a 09 20 28 6b 65 79 71 72 79 20 20 20 ")).. (keyqry
16af0 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
16b00 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 rse (map (lambda
16b10 20 28 70 29 28 63 6f 6e 63 20 28 63 61 72 20 70 (p)(conc (car p
16b20 29 20 22 20 4c 49 4b 45 20 3f 20 22 29 29 20 6b ) " LIKE ? ")) k
16b30 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20 22 20 eypatt-alist) "
16b40 41 4e 44 20 22 29 29 0a 09 20 28 6e 75 6d 6b 65 AND ")).. (numke
16b50 79 73 20 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 ys (length keyp
16b60 61 74 74 2d 61 6c 69 73 74 29 29 0a 09 20 28 74 att-alist)).. (t
16b70 65 73 74 2d 69 64 73 20 27 28 29 29 0a 09 20 28 est-ids '()).. (
16b80 77 69 6e 64 6f 77 73 20 20 28 61 6e 64 20 70 61 windows (and pa
16b90 74 68 6d 6f 64 20 28 73 75 62 73 74 72 69 6e 67 thmod (substring
16ba0 2d 69 6e 64 65 78 20 22 5c 5c 22 20 70 61 74 68 -index "\\" path
16bb0 6d 6f 64 29 29 29 0a 09 20 28 74 65 6d 70 64 69 mod))).. (tempdi
16bc0 72 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 r (conc "/tmp/"
16bd0 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e (current-user-n
16be0 61 6d 65 29 20 22 2f 22 20 72 75 6e 73 70 61 74 ame) "/" runspat
16bf0 74 20 22 5f 22 20 28 72 61 6e 64 6f 6d 20 31 30 t "_" (random 10
16c00 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 65 6e 000) "_" (curren
16c10 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a t-process-id))).
16c20 09 20 28 72 75 6e 73 68 65 61 64 65 72 20 28 61 . (runsheader (a
16c30 70 70 65 6e 64 20 28 6c 69 73 74 20 22 52 75 6e ppend (list "Run
16c40 20 49 64 22 20 22 52 75 6e 6e 61 6d 65 22 29 20 Id" "Runname")
16c50 3b 20 30 20 31 0a 09 09 09 20 20 20 20 20 28 6d ; 0 1.... (m
16c60 61 70 20 63 61 72 20 6b 65 79 70 61 74 74 2d 61 ap car keypatt-a
16c70 6c 69 73 74 29 20 20 20 3b 20 2b 20 4e 20 3d 20 list) ; + N =
16c80 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 2d 61 length keypatt-a
16c90 6c 69 73 74 0a 09 09 09 20 20 20 20 20 28 6c 69 list.... (li
16ca0 73 74 20 22 54 65 73 74 6e 61 6d 65 22 20 20 20 st "Testname"
16cb0 20 20 20 20 20 20 20 3b 20 32 0a 09 09 09 09 20 ; 2.....
16cc0 20 20 22 49 74 65 6d 20 50 61 74 68 22 20 20 20 "Item Path"
16cd0 20 20 20 20 20 20 3b 20 33 20 0a 09 09 09 09 20 ; 3 .....
16ce0 20 20 22 44 65 73 63 72 69 70 74 69 6f 6e 22 20 "Description"
16cf0 20 20 20 20 20 20 3b 20 34 20 0a 09 09 09 09 20 ; 4 .....
16d00 20 20 22 53 74 61 74 65 22 20 20 20 20 20 20 20 "State"
16d10 20 20 20 20 20 20 3b 20 35 20 0a 09 09 09 09 20 ; 5 .....
16d20 20 20 22 53 74 61 74 75 73 22 20 20 20 20 20 20 "Status"
16d30 20 20 20 20 20 20 3b 20 36 20 20 0a 09 09 09 09 ; 6 .....
16d40 20 20 20 22 46 69 6e 61 6c 20 4c 6f 67 22 20 20 "Final Log"
16d50 20 20 20 20 20 20 20 3b 20 37 20 0a 09 09 09 09 ; 7 .....
16d60 20 20 20 22 52 75 6e 20 44 75 72 61 74 69 6f 6e "Run Duration
16d70 22 20 20 20 20 20 20 3b 20 38 20 0a 09 09 09 09 " ; 8 .....
16d80 20 20 20 22 57 68 65 6e 20 52 75 6e 22 20 20 20 "When Run"
16d90 20 20 20 20 20 20 20 3b 20 39 20 0a 09 09 09 09 ; 9 .....
16da0 20 20 20 22 54 61 67 73 22 20 20 20 20 20 20 20 "Tags"
16db0 20 20 20 20 20 20 20 3b 20 31 30 0a 09 09 09 09 ; 10.....
16dc0 20 20 20 22 52 75 6e 20 4f 77 6e 65 72 22 20 20 "Run Owner"
16dd0 20 20 20 20 20 20 20 3b 20 31 31 0a 09 09 09 09 ; 11.....
16de0 20 20 20 22 43 6f 6d 6d 65 6e 74 22 20 20 20 20 "Comment"
16df0 20 20 20 20 20 20 20 3b 20 31 32 0a 09 09 09 09 ; 12.....
16e00 20 20 20 22 41 75 74 68 6f 72 22 20 20 20 20 20 "Author"
16e10 20 20 20 20 20 20 20 3b 20 31 33 0a 09 09 09 09 ; 13.....
16e20 20 20 20 22 54 65 73 74 20 4f 77 6e 65 72 22 20 "Test Owner"
16e30 20 20 20 20 20 20 20 3b 20 31 34 0a 09 09 09 09 ; 14.....
16e40 20 20 20 22 52 65 76 69 65 77 65 64 22 20 20 20 "Reviewed"
16e50 20 20 20 20 20 20 20 3b 20 31 35 0a 09 09 09 09 ; 15.....
16e60 20 20 20 22 44 69 73 6b 66 72 65 65 22 20 20 20 "Diskfree"
16e70 20 20 20 20 20 20 20 3b 20 31 36 0a 09 09 09 09 ; 16.....
16e80 20 20 20 22 55 6e 61 6d 65 22 20 20 20 20 20 20 "Uname"
16e90 20 20 20 20 20 20 20 3b 20 31 37 0a 09 09 09 09 ; 17.....
16ea0 20 20 20 22 52 75 6e 64 69 72 22 20 20 20 20 20 "Rundir"
16eb0 20 20 20 20 20 20 20 3b 20 31 38 0a 09 09 09 09 ; 18.....
16ec0 20 20 20 22 48 6f 73 74 22 20 20 20 20 20 20 20 "Host"
16ed0 20 20 20 20 20 20 20 3b 20 31 39 0a 09 09 09 09 ; 19.....
16ee0 20 20 20 22 43 70 75 20 4c 6f 61 64 22 20 20 20 "Cpu Load"
16ef0 20 20 20 20 20 20 20 3b 20 32 30 0a 09 09 09 09 ; 20.....
16f00 20 20 20 29 29 29 0a 09 20 28 72 65 73 75 6c 74 ))).. (result
16f10 73 20 28 6c 69 73 74 20 72 75 6e 73 68 65 61 64 s (list runshead
16f20 65 72 29 29 09 09 09 20 0a 09 20 28 74 65 73 74 er))... .. (test
16f30 64 61 74 61 2d 68 65 61 64 65 72 20 28 6c 69 73 data-header (lis
16f40 74 20 22 52 75 6e 20 49 64 22 20 22 54 65 73 74 t "Run Id" "Test
16f50 6e 61 6d 65 22 20 22 49 74 65 6d 20 50 61 74 68 name" "Item Path
16f60 22 20 22 43 61 74 65 67 6f 72 79 22 20 22 56 61 " "Category" "Va
16f70 72 69 61 62 6c 65 22 20 22 56 61 6c 75 65 22 20 riable" "Value"
16f80 22 45 78 70 65 63 74 65 64 22 20 22 54 6f 6c 22 "Expected" "Tol"
16f90 20 22 55 6e 69 74 73 22 20 22 53 74 61 74 75 73 "Units" "Status
16fa0 22 20 22 43 6f 6d 6d 65 6e 74 22 29 29 0a 09 20 " "Comment"))..
16fb0 28 6d 61 69 6e 71 72 79 20 28 63 6f 6e 63 20 22 (mainqry (conc "
16fc0 53 45 4c 45 43 54 0a 20 20 20 20 20 20 20 20 20 SELECT.
16fd0 20 20 20 20 20 74 2e 74 65 73 74 6e 61 6d 65 2c t.testname,
16fe0 72 2e 69 64 2c 72 75 6e 6e 61 6d 65 2c 22 20 6b r.id,runname," k
16ff0 65 79 73 73 74 72 20 22 2c 74 2e 74 65 73 74 6e eysstr ",t.testn
17000 61 6d 65 2c 0a 20 20 20 20 20 20 20 20 20 20 20 ame,.
17010 20 20 20 74 2e 69 74 65 6d 5f 70 61 74 68 2c 74 t.item_path,t
17020 6d 2e 64 65 73 63 72 69 70 74 69 6f 6e 2c 74 2e m.description,t.
17030 73 74 61 74 65 2c 74 2e 73 74 61 74 75 73 2c 0a state,t.status,.
17040 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 69 fi
17050 6e 61 6c 5f 6c 6f 67 66 2c 72 75 6e 5f 64 75 72 nal_logf,run_dur
17060 61 74 69 6f 6e 2c 20 0a 20 20 20 20 20 20 20 20 ation, .
17070 20 20 20 20 20 20 73 74 72 66 74 69 6d 65 28 27 strftime('
17080 25 6d 2f 25 64 2f 25 59 20 25 48 3a 25 4d 3a 25 %m/%d/%Y %H:%M:%
17090 53 27 2c 64 61 74 65 74 69 6d 65 28 74 2e 65 76 S',datetime(t.ev
170a0 65 6e 74 5f 74 69 6d 65 2c 27 75 6e 69 78 65 70 ent_time,'unixep
170b0 6f 63 68 27 29 2c 27 6c 6f 63 61 6c 74 69 6d 65 och'),'localtime
170c0 27 29 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '),.
170d0 20 20 74 6d 2e 74 61 67 73 2c 72 2e 6f 77 6e 65 tm.tags,r.owne
170e0 72 2c 74 2e 63 6f 6d 6d 65 6e 74 2c 0a 20 20 20 r,t.comment,.
170f0 20 20 20 20 20 20 20 20 20 20 20 61 75 74 68 6f autho
17100 72 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r,.
17110 20 74 6d 2e 6f 77 6e 65 72 2c 72 65 76 69 65 77 tm.owner,review
17120 65 64 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 ed,.
17130 20 20 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 diskfree,uname
17140 2c 72 75 6e 64 69 72 2c 0a 20 20 20 20 20 20 20 ,rundir,.
17150 20 20 20 20 20 20 20 68 6f 73 74 2c 63 70 75 6c host,cpul
17160 6f 61 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 oad.
17170 46 52 4f 4d 20 74 65 73 74 73 20 41 53 20 74 20 FROM tests AS t
17180 4a 4f 49 4e 20 72 75 6e 73 20 41 53 20 72 20 4f JOIN runs AS r O
17190 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 2e 69 64 20 N t.run_id=r.id
171a0 4a 4f 49 4e 20 74 65 73 74 5f 6d 65 74 61 20 41 JOIN test_meta A
171b0 53 20 74 6d 20 4f 4e 20 74 6d 2e 74 65 73 74 6e S tm ON tm.testn
171c0 61 6d 65 3d 74 2e 74 65 73 74 6e 61 6d 65 0a 20 ame=t.testname.
171d0 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
171e0 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 runname LIKE ?
171f0 41 4e 44 20 22 20 6b 65 79 71 72 79 20 22 3b 22 AND " keyqry ";"
17200 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
17210 72 69 6e 74 20 32 20 22 55 73 69 6e 67 20 22 20 rint 2 "Using "
17220 74 65 6d 70 64 69 72 20 22 20 66 6f 72 20 63 6f tempdir " for co
17230 6e 73 74 72 75 63 74 69 6e 67 20 74 68 65 20 6f nstructing the o
17240 64 73 20 66 69 6c 65 2e 20 6b 65 79 71 72 79 3a ds file. keyqry:
17250 20 22 20 6b 65 79 71 72 79 20 22 20 6b 65 79 73 " keyqry " keys
17260 74 72 3a 20 22 20 6b 65 79 73 73 74 72 20 22 20 tr: " keysstr "
17270 77 69 74 68 20 6b 65 79 73 3a 20 22 20 28 6d 61 with keys: " (ma
17280 70 20 63 61 64 72 20 6b 65 79 70 61 74 74 2d 61 p cadr keypatt-a
17290 6c 69 73 74 29 0a 09 09 20 22 5c 6e 20 20 20 20 list)... "\n
172a0 20 20 6d 61 69 6e 71 72 79 3a 20 22 20 6d 61 69 mainqry: " mai
172b0 6e 71 72 79 29 0a 20 20 20 20 3b 3b 20 22 45 78 nqry). ;; "Ex
172c0 70 65 63 74 65 64 20 56 61 6c 75 65 22 0a 20 20 pected Value".
172d0 20 20 3b 3b 20 22 56 61 6c 75 65 20 46 6f 75 6e ;; "Value Foun
172e0 64 22 0a 20 20 20 20 3b 3b 20 22 54 6f 6c 65 72 d". ;; "Toler
172f0 61 6e 63 65 22 0a 20 20 20 20 28 61 70 70 6c 79 ance". (apply
17300 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 sqlite3:for-eac
17310 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 h-row.. (lambd
17320 61 20 28 74 65 73 74 2d 69 64 20 2e 20 62 29 0a a (test-id . b).
17330 09 20 20 20 20 20 28 73 65 74 21 20 74 65 73 74 . (set! test
17340 2d 69 64 73 20 28 63 6f 6e 73 20 74 65 73 74 2d -ids (cons test-
17350 69 64 20 74 65 73 74 2d 69 64 73 29 29 20 20 20 id test-ids))
17360 3b 3b 20 74 65 73 74 2d 69 64 20 69 73 20 6e 6f ;; test-id is no
17370 77 20 74 65 73 74 6e 61 6d 65 0a 09 20 20 20 20 w testname..
17380 20 28 73 65 74 21 20 72 65 73 75 6c 74 73 20 28 (set! results (
17390 61 70 70 65 6e 64 20 72 65 73 75 6c 74 73 20 3b append results ;
173a0 3b 20 6e 6f 74 65 2c 20 64 72 6f 70 20 74 68 65 ; note, drop the
173b0 20 74 65 73 74 2d 69 64 0a 09 09 09 09 20 20 20 test-id.....
173c0 28 6c 69 73 74 0a 09 09 09 09 20 20 20 20 28 69 (list..... (i
173d0 66 20 70 61 74 68 6d 6f 64 0a 09 09 09 09 09 28 f pathmod......(
173e0 6c 65 74 2a 20 28 28 76 62 20 20 20 20 20 20 20 let* ((vb
173f0 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 62 (apply vector b
17400 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
17410 6b 65 79 76 61 6c 73 20 20 20 28 6c 65 74 20 6c keyvals (let l
17420 6f 6f 70 20 28 28 69 20 20 20 20 30 29 0a 09 09 oop ((i 0)...
17430 09 09 09 09 09 09 20 20 20 20 20 28 72 65 73 20 ...... (res
17440 27 28 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 '()))........
17450 20 28 69 66 20 28 3e 3d 20 69 20 6e 75 6d 6b 65 (if (>= i numke
17460 79 73 29 0a 09 09 09 09 09 09 09 09 72 65 73 0a ys).........res.
17470 09 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b ........(loop (+
17480 20 69 20 31 29 0a 09 09 09 09 09 09 09 09 20 20 i 1).........
17490 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 (append res
174a0 28 6c 69 73 74 20 28 76 65 63 74 6f 72 2d 72 65 (list (vector-re
174b0 66 20 76 62 20 28 2b 20 69 20 32 29 29 29 29 29 f vb (+ i 2)))))
174c0 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 )))......
174d0 28 72 75 6e 6e 61 6d 65 20 20 20 28 76 65 63 74 (runname (vect
174e0 6f 72 2d 72 65 66 20 76 62 20 31 29 29 0a 09 09 or-ref vb 1))...
174f0 09 09 09 20 20 20 20 20 20 20 28 74 65 73 74 6e ... (testn
17500 61 6d 65 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ame (vector-ref
17510 20 76 62 20 28 2b 20 20 32 20 6e 75 6d 6b 65 79 vb (+ 2 numkey
17520 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 s)))......
17530 20 28 69 74 65 6d 2d 70 61 74 68 20 28 76 65 63 (item-path (vec
17540 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 20 33 tor-ref vb (+ 3
17550 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 numkeys))).....
17560 09 20 20 20 20 20 20 20 28 66 69 6e 61 6c 2d 6c . (final-l
17570 6f 67 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 og (vector-ref v
17580 62 20 28 2b 20 20 37 20 6e 75 6d 6b 65 79 73 29 b (+ 7 numkeys)
17590 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
175a0 72 75 6e 2d 64 69 72 20 20 20 28 76 65 63 74 6f run-dir (vecto
175b0 72 2d 72 65 66 20 76 62 20 28 2b 20 31 38 20 6e r-ref vb (+ 18 n
175c0 75 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 umkeys)))......
175d0 20 20 20 20 20 20 28 6c 6f 67 2d 66 70 61 74 68 (log-fpath
175e0 20 28 63 6f 6e 63 20 72 75 6e 2d 64 69 72 20 22 (conc run-dir "
175f0 2f 22 20 20 66 69 6e 61 6c 2d 6c 6f 67 29 29 29 /" final-log)))
17600 20 3b 3b 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 ;; (string-inte
17610 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c 73 20 rsperse keyvals
17620 22 2f 22 29 20 22 2f 22 20 74 65 73 74 6e 61 6d "/") "/" testnam
17630 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 20 e "/" item-path
17640 22 2f 22 0a 09 09 09 09 09 20 20 28 64 65 62 75 "/"...... (debu
17650 67 3a 70 72 69 6e 74 20 34 20 22 6c 6f 67 3a 20 g:print 4 "log:
17660 22 20 6c 6f 67 2d 66 70 61 74 68 20 22 20 65 78 " log-fpath " ex
17670 69 73 74 73 3a 20 22 20 28 66 69 6c 65 2d 65 78 ists: " (file-ex
17680 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 ists? log-fpath)
17690 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 )...... (vector
176a0 2d 73 65 74 21 20 76 62 20 28 2b 20 37 20 6e 75 -set! vb (+ 7 nu
176b0 6d 6b 65 79 73 29 20 28 69 66 20 28 66 69 6c 65 mkeys) (if (file
176c0 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 -exists? log-fpa
176d0 74 68 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 th)..........
176e0 20 28 6c 65 74 20 28 28 6e 65 77 70 61 74 68 20 (let ((newpath
176f0 28 63 6f 6e 63 20 70 61 74 68 6d 6f 64 20 22 2f (conc pathmod "/
17700 22 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 28 "............. (
17710 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
17720 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22 29 0a se keyvals "/").
17730 09 09 09 09 09 09 09 09 09 09 09 09 20 22 2f 22 ............ "/"
17740 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 runname "/" tes
17750 74 6e 61 6d 65 20 22 2f 22 0a 09 09 09 09 09 09 tname "/".......
17760 09 09 09 09 09 09 20 28 69 66 20 28 73 74 72 69 ...... (if (stri
17770 6e 67 3d 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ng=? item-path "
17780 22 29 20 22 22 20 28 63 6f 6e 63 20 22 2f 22 20 ") "" (conc "/"
17790 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 item-path)).....
177a0 09 09 09 09 09 09 09 09 20 66 69 6e 61 6c 2d 6c ........ final-l
177b0 6f 67 29 29 29 0a 09 09 09 09 09 09 09 09 09 20 og)))..........
177c0 20 20 20 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 ;; for now
177d0 74 68 72 6f 77 20 61 77 61 79 20 6e 65 77 70 61 throw away newpa
177e0 74 68 20 61 6e 64 20 75 73 65 20 74 68 65 20 6c th and use the l
177f0 6f 67 2d 66 70 61 74 68 20 63 6f 6e 63 27 64 20 og-fpath conc'd
17800 77 69 74 68 20 70 61 74 68 6d 6f 64 0a 09 09 09 with pathmod....
17810 09 09 09 09 09 09 20 20 20 20 20 20 28 73 65 74 ...... (set
17820 21 20 6e 65 77 70 61 74 68 20 28 63 6f 6e 63 20 ! newpath (conc
17830 70 61 74 68 6d 6f 64 20 6c 6f 67 2d 66 70 61 74 pathmod log-fpat
17840 68 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 h))..........
17850 20 20 20 28 69 66 20 77 69 6e 64 6f 77 73 20 28 (if windows (
17860 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 string-translate
17870 20 6e 65 77 70 61 74 68 20 22 2f 22 20 22 5c 5c newpath "/" "\\
17880 22 29 20 6e 65 77 70 61 74 68 29 29 0a 09 09 09 ") newpath))....
17890 09 09 09 09 09 09 20 20 20 20 28 69 66 20 28 64 ...... (if (d
178a0 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 ebug:debug-mode
178b0 31 29 0a 09 09 09 09 09 09 09 09 09 09 28 63 6f 1)...........(co
178c0 6e 63 20 66 69 6e 61 6c 2d 6c 6f 67 20 22 20 6e nc final-log " n
178d0 6f 74 2d 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 ot-found")......
178e0 09 09 09 09 09 22 22 29 29 29 0a 09 09 09 09 09 ....."")))......
178f0 20 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 (vector->list
17900 76 62 29 29 0a 09 09 09 09 09 62 29 29 29 29 29 vb))......b)))))
17910 0a 09 20 20 20 64 62 0a 09 20 20 20 6d 61 69 6e .. db.. main
17920 71 72 79 0a 09 20 20 20 72 75 6e 73 70 61 74 74 qry.. runspatt
17930 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 70 61 (map cadr keypa
17940 74 74 2d 61 6c 69 73 74 29 29 0a 20 20 20 20 28 tt-alist)). (
17950 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 46 debug:print 2 "F
17960 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 74 ound " (length t
17970 65 73 74 2d 69 64 73 29 20 22 20 72 65 63 6f 72 est-ids) " recor
17980 64 73 22 29 0a 20 20 20 20 28 73 65 74 21 20 72 ds"). (set! r
17990 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 63 6f esults (list (co
179a0 6e 73 20 22 52 75 6e 73 22 20 72 65 73 75 6c 74 ns "Runs" result
179b0 73 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 2c s))). ;; now,
179c0 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 2c 20 for each test,
179d0 63 6f 6c 6c 65 63 74 20 74 68 65 20 74 65 73 74 collect the test
179e0 5f 64 61 74 61 20 69 6e 66 6f 20 61 6e 64 20 61 _data info and a
179f0 64 64 20 61 20 6e 65 77 20 73 68 65 65 74 0a 20 dd a new sheet.
17a00 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
17a10 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d (lambda (test-
17a20 69 64 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 id). (let
17a30 28 28 74 65 73 74 2d 64 61 74 61 20 28 6c 69 73 ((test-data (lis
17a40 74 20 74 65 73 74 64 61 74 61 2d 68 65 61 64 65 t testdata-heade
17a50 72 29 29 0a 09 20 20 20 20 20 28 63 75 72 72 2d r)).. (curr-
17a60 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 0a 09 test-name #f))..
17a70 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
17a80 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 ch-row.. (lambd
17a90 61 20 28 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 a (run-id testna
17aa0 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 63 61 74 me item-path cat
17ab0 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 20 76 egory variable v
17ac0 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 74 6f alue expected to
17ad0 6c 20 75 6e 69 74 73 20 73 74 61 74 75 73 20 63 l units status c
17ae0 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 20 28 73 65 omment).. (se
17af0 74 21 20 63 75 72 72 2d 74 65 73 74 2d 6e 61 6d t! curr-test-nam
17b00 65 20 74 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 e testname)..
17b10 20 28 73 65 74 21 20 74 65 73 74 2d 64 61 74 61 (set! test-data
17b20 20 28 61 70 70 65 6e 64 20 74 65 73 74 2d 64 61 (append test-da
17b30 74 61 20 28 6c 69 73 74 20 28 6c 69 73 74 20 72 ta (list (list r
17b40 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
17b50 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 6f 72 tem-path categor
17b60 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
17b70 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e expected tol un
17b80 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 its status comme
17b90 6e 74 29 29 29 29 29 0a 09 20 20 64 62 20 0a 09 nt))))).. db ..
17ba0 20 20 3b 3b 20 22 53 45 4c 45 43 54 20 72 75 6e ;; "SELECT run
17bb0 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 _id,testname,ite
17bc0 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 79 2c m_path,category,
17bd0 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 6c 75 variable,td.valu
17be0 65 20 41 53 20 76 61 6c 75 65 2c 65 78 70 65 63 e AS value,expec
17bf0 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 64 ted,tol,units,td
17c00 2e 73 74 61 74 75 73 20 41 53 20 73 74 61 74 75 .status AS statu
17c10 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 s,td.comment AS
17c20 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 comment FROM tes
17c30 74 5f 64 61 74 61 20 41 53 20 74 64 20 49 4e 4e t_data AS td INN
17c40 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e ER JOIN tests ON
17c50 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 tests.id=td.tes
17c60 74 5f 69 64 20 57 48 45 52 45 20 74 65 73 74 5f t_id WHERE test_
17c70 69 64 3d 3f 3b 22 0a 09 20 20 22 53 45 4c 45 43 id=?;".. "SELEC
17c80 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d T run_id,testnam
17c90 65 2c 69 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 e,item_path,cate
17ca0 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 gory,variable,td
17cb0 2e 76 61 6c 75 65 20 41 53 20 76 61 6c 75 65 2c .value AS value,
17cc0 74 64 2e 65 78 70 65 63 74 65 64 2c 74 64 2e 74 td.expected,td.t
17cd0 6f 6c 2c 74 64 2e 75 6e 69 74 73 2c 74 64 2e 73 ol,td.units,td.s
17ce0 74 61 74 75 73 20 41 53 20 73 74 61 74 75 73 2c tatus AS status,
17cf0 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f td.comment AS co
17d00 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f mment FROM test_
17d10 64 61 74 61 20 41 53 20 74 64 20 49 4e 4e 45 52 data AS td INNER
17d20 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 JOIN tests ON t
17d30 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f ests.id=td.test_
17d40 69 64 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d id WHERE testnam
17d50 65 3d 3f 3b 22 0a 09 20 20 74 65 73 74 2d 69 64 e=?;".. test-id
17d60 29 0a 09 20 28 69 66 20 63 75 72 72 2d 74 65 73 ).. (if curr-tes
17d70 74 2d 6e 61 6d 65 0a 09 20 20 20 20 20 28 73 65 t-name.. (se
17d80 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 70 65 t! results (appe
17d90 6e 64 20 72 65 73 75 6c 74 73 20 28 6c 69 73 74 nd results (list
17da0 20 28 63 6f 6e 73 20 63 75 72 72 2d 74 65 73 74 (cons curr-test
17db0 2d 6e 61 6d 65 20 74 65 73 74 2d 64 61 74 61 29 -name test-data)
17dc0 29 29 29 29 0a 09 20 29 29 0a 20 20 20 20 20 28 )))).. )). (
17dd0 73 6f 72 74 20 28 64 65 6c 65 74 65 2d 64 75 70 sort (delete-dup
17de0 6c 69 63 61 74 65 73 20 74 65 73 74 2d 69 64 73 licates test-ids
17df0 29 20 73 74 72 69 6e 67 3c 3d 29 29 0a 20 20 20 ) string<=)).
17e00 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
17e10 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 6d 70 64 mkdir -p " tempd
17e20 69 72 29 29 0a 20 20 20 20 3b 3b 20 28 70 70 20 ir)). ;; (pp
17e30 72 65 73 75 6c 74 73 29 0a 20 20 20 20 28 6f 64 results). (od
17e40 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 0a 20 20 20 s:list->ods .
17e50 20 20 74 65 6d 70 64 69 72 0a 20 20 20 20 20 28 tempdir. (
17e60 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 if (string-match
17e70 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b (regexp "^[/~]+
17e80 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 29 .*") outputfile)
17e90 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 ;; full path?..
17ea0 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 20 28 62 outputfile.. (b
17eb0 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a egin.. (debug:
17ec0 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
17ed0 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20 22 20 : path given, "
17ee0 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69 73 20 outputfile " is
17ef0 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66 69 78 relative, prefix
17f00 69 6e 67 20 77 69 74 68 20 63 75 72 72 65 6e 74 ing with current
17f10 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09 20 20 directory")..
17f20 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d (conc (current-
17f30 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 6f directory) "/" o
17f40 75 74 70 75 74 66 69 6c 65 29 29 29 0a 20 20 20 utputfile))).
17f50 20 20 72 65 73 75 6c 74 73 29 0a 20 20 20 20 3b results). ;
17f60 3b 20 62 72 75 74 61 6c 20 63 6c 65 61 6e 20 75 ; brutal clean u
17f70 70 0a 20 20 20 20 28 73 79 73 74 65 6d 20 22 72 p. (system "r
17f80 6d 20 2d 72 66 20 74 65 6d 70 64 69 72 22 29 29 m -rf tempdir"))
17f90 29 0a 0a 3b 3b 20 28 64 62 3a 65 78 74 72 61 63 )..;; (db:extrac
17fa0 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 22 6f t-ods-file db "o
17fb0 75 74 70 75 74 66 69 6c 65 2e 6f 64 73 22 20 27 utputfile.ods" '
17fc0 28 28 22 73 79 73 6e 61 6d 65 22 20 22 25 22 29 (("sysname" "%")
17fd0 28 22 66 73 6e 61 6d 65 22 20 22 25 22 29 28 22 ("fsname" "%")("
17fe0 64 61 74 61 70 61 74 68 22 20 22 25 22 29 29 20 datapath" "%"))
17ff0 22 25 22 29 0a "%").