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 64 62 20 dbpath)).. (db
0a30: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
0a40: 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 open-database db
0a50: 70 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 path)) ;; (never
0a60: 2d 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 -give-up-open-db
0a70: 20 64 62 70 61 74 68 29 29 0a 09 20 28 68 61 6e dbpath)).. (han
0a80: 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 dler (make-bus
0a90: 79 2d 74 69 6d 65 6f 75 74 20 28 69 66 20 28 61 y-timeout (if (a
0aa0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 rgs:get-arg "-ov
0ab0: 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 erride-timeout")
0ac0: 0a 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 ...... (string
0ad0: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
0ae0: 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 et-arg "-overrid
0af0: 65 2d 74 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 e-timeout"))....
0b00: 09 09 20 20 20 31 33 36 30 30 30 29 29 29 29 20 .. 136000))))
0b10: 3b 3b 20 31 33 36 30 30 30 29 29 29 20 3b 3b 20 ;; 136000))) ;;
0b20: 31 33 36 30 30 30 20 3d 20 32 2e 32 20 6d 69 6e 136000 = 2.2 min
0b30: 75 74 65 73 0a 20 20 20 20 28 64 65 62 75 67 3a utes. (debug:
0b40: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f print-info 11 "o
0b50: 70 65 6e 2d 64 62 2c 20 64 62 70 61 74 68 3d 22 pen-db, dbpath="
0b60: 20 64 62 70 61 74 68 20 22 20 61 72 67 76 3d 22 dbpath " argv="
0b70: 20 28 61 72 67 76 29 29 0a 20 20 20 20 28 73 71 (argv)). (sq
0b80: 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 lite3:set-busy-h
0b90: 61 6e 64 6c 65 72 21 20 64 62 20 68 61 6e 64 6c andler! db handl
0ba0: 65 72 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 er). (if (not
0bb0: 20 64 62 65 78 69 73 74 73 29 0a 09 28 64 62 3a dbexists)..(db:
0bc0: 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 29 0a initialize db)).
0bd0: 20 20 20 20 28 64 62 3a 73 65 74 2d 73 79 6e 63 (db:set-sync
0be0: 20 64 62 29 0a 20 20 20 20 64 62 29 29 0a 0a 3b db). db))..;
0bf0: 3b 20 6b 65 65 70 69 6e 67 20 69 74 20 61 72 6f ; keeping it aro
0c00: 75 6e 64 20 66 6f 72 20 64 65 62 75 67 67 69 6e und for debuggin
0c10: 67 20 70 75 72 70 6f 73 65 73 20 6f 6e 6c 79 0a g purposes only.
0c20: 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 (define (open-ru
0c30: 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 n-close-no-excep
0c40: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 20 70 tion-handling p
0c50: 72 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d 73 roc idb . params
0c60: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
0c70: 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 -info 11 "open-r
0c80: 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 un-close-no-exce
0c90: 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 53 ption-handling S
0ca0: 54 41 52 54 20 67 69 76 65 6e 20 61 20 64 62 3d TART given a db=
0cb0: 22 20 28 69 66 20 69 64 62 20 22 79 65 73 20 22 " (if idb "yes "
0cc0: 20 22 6e 6f 20 22 29 20 22 2c 20 70 61 72 61 6d "no ") ", param
0cd0: 73 3d 22 20 70 61 72 61 6d 73 29 0a 20 20 28 6c s=" params). (l
0ce0: 65 74 2a 20 28 28 64 62 20 20 20 28 69 66 20 69 et* ((db (if i
0cf0: 64 62 20 0a 09 09 20 20 20 28 69 66 20 28 70 72 db ... (if (pr
0d00: 6f 63 65 64 75 72 65 3f 20 69 64 62 29 0a 09 09 ocedure? idb)...
0d10: 20 20 20 20 20 20 20 28 69 64 62 29 0a 09 09 20 (idb)...
0d20: 20 20 20 20 20 20 69 64 62 29 0a 09 09 20 20 20 idb)...
0d30: 28 6f 70 65 6e 2d 64 62 29 29 29 0a 09 20 28 72 (open-db))).. (r
0d40: 65 73 20 23 66 29 29 0a 20 20 20 20 28 73 65 74 es #f)). (set
0d50: 21 20 72 65 73 20 28 61 70 70 6c 79 20 70 72 6f ! res (apply pro
0d60: 63 20 64 62 20 70 61 72 61 6d 73 29 29 0a 20 20 c db params)).
0d70: 20 20 28 69 66 20 28 6e 6f 74 20 69 64 62 29 28 (if (not idb)(
0d80: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
0d90: 21 20 64 62 29 29 0a 20 20 20 20 28 64 65 62 75 ! db)). (debu
0da0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
0db0: 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d "open-run-close-
0dc0: 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e no-exception-han
0dd0: 64 6c 69 6e 67 20 45 4e 44 22 20 29 0a 20 20 20 dling END" ).
0de0: 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
0df0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d (open-run-close-
0e00: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 exception-handli
0e10: 6e 67 20 70 72 6f 63 20 69 64 62 20 2e 20 70 61 ng proc idb . pa
0e20: 72 61 6d 73 29 0a 20 20 28 68 61 6e 64 6c 65 2d rams). (handle-
0e30: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 exceptions. ex
0e40: 6e 0a 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 n. (begin.
0e50: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
0e60: 22 45 58 43 45 50 54 49 4f 4e 3a 20 64 61 74 61 "EXCEPTION: data
0e70: 62 61 73 65 20 70 72 6f 62 61 62 6c 79 20 6f 76 base probably ov
0e80: 65 72 6c 6f 61 64 65 64 3f 22 29 0a 20 20 20 20 erloaded?").
0e90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
0ea0: 22 20 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e " " ((condition
0eb0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
0ec0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
0ed0: 29 20 65 78 6e 29 29 0a 20 20 20 20 20 28 70 72 ) exn)). (pr
0ee0: 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 0a int-call-chain).
0ef0: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 (thread-sle
0f00: 65 70 21 20 28 72 61 6e 64 6f 6d 20 31 32 30 29 ep! (random 120)
0f10: 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 ). (debug:pr
0f20: 69 6e 74 2d 69 6e 66 6f 20 30 20 22 74 72 79 69 int-info 0 "tryi
0f30: 6e 67 20 64 62 20 63 61 6c 6c 20 6f 6e 65 20 6d ng db call one m
0f40: 6f 72 65 20 74 69 6d 65 2e 2e 2e 2e 22 29 0a 20 ore time....").
0f50: 20 20 20 20 28 61 70 70 6c 79 20 6f 70 65 6e 2d (apply open-
0f60: 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 run-close-no-exc
0f70: 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 eption-handling
0f80: 70 72 6f 63 20 69 64 62 20 70 61 72 61 6d 73 29 proc idb params)
0f90: 29 0a 20 20 20 28 61 70 70 6c 79 20 6f 70 65 6e ). (apply open
0fa0: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 -run-close-no-ex
0fb0: 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 ception-handling
0fc0: 20 70 72 6f 63 20 69 64 62 20 70 61 72 61 6d 73 proc idb params
0fd0: 29 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 )))..;; (define
0fe0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6f open-run-close o
0ff0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 65 78 pen-run-close-ex
1000: 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 ception-handling
1010: 29 0a 28 64 65 66 69 6e 65 20 6f 70 65 6e 2d 72 ).(define open-r
1020: 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 un-close open-ru
1030: 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 n-close-no-excep
1040: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 29 0a 0a tion-handling)..
1050: 28 64 65 66 69 6e 65 20 2a 67 6c 6f 62 61 6c 2d (define *global-
1060: 64 65 6c 74 61 2a 20 30 29 0a 28 64 65 66 69 6e delta* 0).(defin
1070: 65 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 e *last-global-d
1080: 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 30 29 elta-printed* 0)
1090: 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d ..(define (open-
10a0: 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 run-close-measur
10b0: 65 20 20 70 72 6f 63 20 69 64 62 20 2e 20 70 61 e proc idb . pa
10c0: 72 61 6d 73 29 0a 20 20 28 64 65 62 75 67 3a 70 rams). (debug:p
10d0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 rint-info 11 "op
10e0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 en-run-close-mea
10f0: 73 75 72 65 20 53 54 41 52 54 2c 20 69 64 62 3d sure START, idb=
1100: 22 20 69 64 62 20 22 2c 20 70 61 72 61 6d 73 3d " idb ", params=
1110: 22 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 " params). (let
1120: 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 63 75 * ((start-ms (cu
1130: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
1140: 64 73 29 29 0a 09 20 28 64 62 20 20 20 20 20 20 ds)).. (db
1150: 20 28 69 66 20 69 64 62 20 69 64 62 20 28 6f 70 (if idb idb (op
1160: 65 6e 2d 64 62 29 29 29 0a 20 20 20 20 20 20 20 en-db))).
1170: 20 20 28 74 68 72 6f 74 74 6c 65 20 28 73 74 72 (throttle (str
1180: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 6f 6e ing->number (con
1190: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
11a0: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
11b0: 74 68 72 6f 74 74 6c 65 22 29 29 29 29 0a 20 20 throttle")))).
11c0: 20 20 3b 3b 20 28 64 62 3a 73 65 74 2d 73 79 6e ;; (db:set-syn
11d0: 63 20 64 62 29 0a 20 20 20 20 28 73 65 74 21 20 c db). (set!
11e0: 72 65 73 20 20 20 20 20 20 28 61 70 70 6c 79 20 res (apply
11f0: 70 72 6f 63 20 64 62 20 70 61 72 61 6d 73 29 29 proc db params))
1200: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 69 64 . (if (not id
1210: 62 29 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c b)(sqlite3:final
1220: 69 7a 65 21 20 64 62 29 29 0a 20 20 20 20 3b 3b ize! db)). ;;
1230: 20 73 63 61 6c 65 20 62 79 20 31 30 2c 20 61 76 scale by 10, av
1240: 65 72 61 67 65 20 77 69 74 68 20 63 75 72 72 65 erage with curre
1250: 6e 74 20 76 61 6c 75 65 2e 0a 20 20 20 20 28 73 nt value.. (s
1260: 65 74 21 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 et! *global-delt
1270: 61 2a 20 28 2f 20 28 2b 20 2a 67 6c 6f 62 61 6c a* (/ (+ *global
1280: 2d 64 65 6c 74 61 2a 20 28 2a 20 28 2d 20 28 63 -delta* (* (- (c
1290: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f urrent-milliseco
12a0: 6e 64 73 29 20 73 74 61 72 74 2d 6d 73 29 0a 09 nds) start-ms)..
12b0: 09 09 09 09 09 20 28 69 66 20 74 68 72 6f 74 74 ..... (if thrott
12c0: 6c 65 20 74 68 72 6f 74 74 6c 65 20 30 2e 30 31 le throttle 0.01
12d0: 29 29 29 0a 09 09 09 20 20 20 20 32 29 29 0a 20 ))).... 2)).
12e0: 20 20 20 28 69 66 20 28 3e 20 28 61 62 73 20 28 (if (> (abs (
12f0: 2d 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 - *last-global-d
1300: 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 2a 67 elta-printed* *g
1310: 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 20 30 lobal-delta*)) 0
1320: 2e 30 38 29 20 3b 3b 20 64 6f 6e 27 74 20 70 72 .08) ;; don't pr
1330: 69 6e 74 20 61 6c 6c 20 74 68 65 20 74 69 6d 65 int all the time
1340: 2c 20 6f 6e 6c 79 20 69 66 20 69 74 20 63 68 61 , only if it cha
1350: 6e 67 65 73 20 61 20 62 69 74 0a 09 28 62 65 67 nges a bit..(beg
1360: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
1370: 6e 74 2d 69 6e 66 6f 20 31 20 22 6c 61 75 6e 63 nt-info 1 "launc
1380: 68 20 74 68 72 6f 74 74 6c 65 20 66 61 63 74 6f h throttle facto
1390: 72 3d 22 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 r=" *global-delt
13a0: 61 2a 29 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 a*).. (set! *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 29 0a 20 20 20 20 28 -delta*))). (
13e0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
13f0: 20 31 31 20 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 11 "open-run-cl
1400: 6f 73 65 2d 6d 65 61 73 75 72 65 20 45 4e 44 22 ose-measure END"
1410: 20 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 ). res))..(d
1420: 65 66 69 6e 65 20 28 64 62 3a 69 6e 69 74 69 61 efine (db:initia
1430: 6c 69 7a 65 20 64 62 29 0a 20 20 28 64 65 62 75 lize db). (debu
1440: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
1450: 22 64 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 53 "db:initialize S
1460: 54 41 52 54 22 29 0a 20 20 28 6c 65 74 2a 20 28 TART"). (let* (
1470: 28 63 6f 6e 66 69 67 64 61 74 20 28 63 61 72 20 (configdat (car
1480: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 20 20 *configinfo*))
1490: 3b 3b 20 74 75 74 20 74 75 74 2c 20 67 6c 6f 62 ;; tut tut, glob
14a0: 61 6c 20 77 61 72 6e 69 6e 67 2e 2e 2e 0a 09 20 al warning.....
14b0: 28 6b 65 79 73 20 20 20 20 20 28 6b 65 79 73 3a (keys (keys:
14c0: 63 6f 6e 66 69 67 2d 67 65 74 2d 66 69 65 6c 64 config-get-field
14d0: 73 20 63 6f 6e 66 69 67 64 61 74 29 29 0a 09 20 s configdat))..
14e0: 28 68 61 76 65 6b 65 79 73 20 28 3e 20 28 6c 65 (havekeys (> (le
14f0: 6e 67 74 68 20 6b 65 79 73 29 20 30 29 29 0a 09 ngth keys) 0))..
1500: 20 28 6b 65 79 73 74 72 20 20 20 28 6b 65 79 73 (keystr (keys
1510: 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 29 0a ->keystr keys)).
1520: 09 20 28 66 69 65 6c 64 73 74 72 20 28 6b 65 79 . (fieldstr (key
1530: 73 2d 3e 6b 65 79 2f 66 69 65 6c 64 20 6b 65 79 s->key/field key
1540: 73 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 s))). (for-ea
1550: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
1560: 0a 09 09 28 6c 65 74 20 28 28 6b 65 79 6e 20 6b ...(let ((keyn k
1570: 65 79 29 29 0a 09 09 20 20 28 69 66 20 28 6d 65 ey))... (if (me
1580: 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 64 6f 77 mber (string-dow
1590: 6e 63 61 73 65 20 6b 65 79 6e 29 0a 09 09 09 20 ncase keyn)....
15a0: 20 20 20 20 20 28 6c 69 73 74 20 22 72 75 6e 6e (list "runn
15b0: 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 ame" "state" "st
15c0: 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 atus" "owner" "e
15d0: 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f 6d 6d vent_time" "comm
15e0: 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 6e 74 ent" "fail_count
15f0: 22 0a 09 09 09 09 20 20 20 20 22 70 61 73 73 5f "..... "pass_
1600: 63 6f 75 6e 74 22 29 29 0a 09 09 20 20 20 20 20 count"))...
1610: 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 69 6e (begin....(prin
1620: 74 20 22 45 52 52 4f 52 3a 20 79 6f 75 72 20 6b t "ERROR: your k
1630: 65 79 20 63 61 6e 6e 6f 74 20 62 65 20 6e 61 6d ey cannot be nam
1640: 65 64 20 22 20 6b 65 79 6e 20 22 20 61 73 20 74 ed " keyn " as t
1650: 68 69 73 20 63 6f 6e 66 6c 69 63 74 73 20 77 69 his conflicts wi
1660: 74 68 20 74 68 65 20 73 61 6d 65 20 6e 61 6d 65 th the same name
1670: 64 20 66 69 65 6c 64 20 69 6e 20 74 68 65 20 72 d field in the r
1680: 75 6e 73 20 74 61 62 6c 65 22 29 0a 09 09 09 28 uns table")....(
1690: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d system (conc "rm
16a0: 20 2d 66 20 22 20 64 62 70 61 74 68 29 29 0a 09 -f " dbpath))..
16b0: 09 09 28 65 78 69 74 20 31 29 29 29 29 29 0a 09 ..(exit 1)))))..
16c0: 20 20 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 keys).
16d0: 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ;; (sqlite3:exec
16e0: 75 74 65 20 64 62 20 22 50 52 41 47 4d 41 20 73 ute db "PRAGMA s
16f0: 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 4f 46 46 ynchronous = OFF
1700: 3b 22 29 0a 20 20 20 20 28 64 62 3a 73 65 74 2d ;"). (db:set-
1710: 73 79 6e 63 20 64 62 29 0a 20 20 20 20 28 73 71 sync db). (sq
1720: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
1730: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 "CREATE TABLE I
1740: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 6b 65 79 F NOT EXISTS key
1750: 73 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 s (id INTEGER PR
1760: 49 4d 41 52 59 20 4b 45 59 2c 20 66 69 65 6c 64 IMARY KEY, field
1770: 6e 61 6d 65 20 54 45 58 54 2c 20 66 69 65 6c 64 name TEXT, field
1780: 74 79 70 65 20 54 45 58 54 2c 20 43 4f 4e 53 54 type TEXT, CONST
1790: 52 41 49 4e 54 20 6b 65 79 63 6f 6e 73 74 72 61 RAINT keyconstra
17a0: 69 6e 74 20 55 4e 49 51 55 45 20 28 66 69 65 6c int UNIQUE (fiel
17b0: 64 6e 61 6d 65 29 29 3b 22 29 0a 20 20 20 20 28 dname));"). (
17c0: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
17d0: 20 28 6b 65 79 29 0a 09 09 28 73 71 6c 69 74 65 (key)...(sqlite
17e0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 4e 3:execute db "IN
17f0: 53 45 52 54 20 49 4e 54 4f 20 6b 65 79 73 20 28 SERT INTO keys (
1800: 66 69 65 6c 64 6e 61 6d 65 2c 66 69 65 6c 64 74 fieldname,fieldt
1810: 79 70 65 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f ype) VALUES (?,?
1820: 29 3b 22 20 6b 65 79 20 22 54 45 58 54 22 29 29 );" key "TEXT"))
1830: 0a 09 20 20 20 20 20 20 6b 65 79 73 29 0a 20 20 .. keys).
1840: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
1850: 74 65 20 64 62 20 28 63 6f 6e 63 20 0a 09 09 09 te db (conc ....
1860: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 "CREATE TABLE I
1870: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 72 75 6e F NOT EXISTS run
1880: 73 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 s (id INTEGER PR
1890: 49 4d 41 52 59 20 4b 45 59 2c 20 22 20 0a 09 09 IMARY KEY, " ...
18a0: 09 20 66 69 65 6c 64 73 74 72 20 28 69 66 20 68 . fieldstr (if h
18b0: 61 76 65 6b 65 79 73 20 22 2c 22 20 22 22 29 0a avekeys "," "").
18c0: 09 09 09 20 22 72 75 6e 6e 61 6d 65 20 54 45 58 ... "runname TEX
18d0: 54 2c 22 0a 09 09 09 20 22 73 74 61 74 65 20 54 T,".... "state T
18e0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 22 EXT DEFAULT '',"
18f0: 0a 09 09 09 20 22 73 74 61 74 75 73 20 54 45 58 .... "status TEX
1900: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 T DEFAULT '',"..
1910: 09 09 20 22 6f 77 6e 65 72 20 54 45 58 54 20 44 .. "owner TEXT D
1920: 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 EFAULT '',"....
1930: 22 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 "event_time TIME
1940: 53 54 41 4d 50 2c 22 0a 09 09 09 20 22 63 6f 6d STAMP,".... "com
1950: 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c ment TEXT DEFAUL
1960: 54 20 27 27 2c 22 0a 09 09 09 20 22 66 61 69 6c T '',".... "fail
1970: 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 _count INTEGER D
1980: 45 46 41 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 EFAULT 0,".... "
1990: 70 61 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47 pass_count INTEG
19a0: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 22 0a 09 ER DEFAULT 0,"..
19b0: 09 09 20 22 43 4f 4e 53 54 52 41 49 4e 54 20 72 .. "CONSTRAINT r
19c0: 75 6e 73 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e unsconstraint UN
19d0: 49 51 55 45 20 28 72 75 6e 6e 61 6d 65 22 20 28 IQUE (runname" (
19e0: 69 66 20 68 61 76 65 6b 65 79 73 20 22 2c 22 20 if havekeys ","
19f0: 22 22 29 20 6b 65 79 73 74 72 20 22 29 29 3b 22 "") keystr "));"
1a00: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
1a10: 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 execute db (conc
1a20: 20 22 43 52 45 41 54 45 20 49 4e 44 45 58 20 72 "CREATE INDEX r
1a30: 75 6e 73 5f 69 6e 64 65 78 20 4f 4e 20 72 75 6e uns_index ON run
1a40: 73 20 28 72 75 6e 6e 61 6d 65 22 20 28 69 66 20 s (runname" (if
1a50: 68 61 76 65 6b 65 79 73 20 22 2c 22 20 22 22 29 havekeys "," "")
1a60: 20 6b 65 79 73 74 72 20 22 29 3b 22 29 29 0a 20 keystr ");")).
1a70: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
1a80: 75 74 65 20 64 62 20 0a 09 09 20 20 20 20 20 22 ute db ... "
1a90: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
1aa0: 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 73 NOT EXISTS tests
1ab0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ac0: 20 20 20 20 20 20 28 69 64 20 49 4e 54 45 47 45 (id INTEGE
1ad0: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af0: 20 20 20 20 72 75 6e 5f 69 64 20 20 20 20 20 49 run_id I
1b00: 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 NTEGER,.
1b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 tes
1b20: 74 6e 61 6d 65 20 20 20 54 45 58 54 2c 0a 20 20 tname TEXT,.
1b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b40: 20 20 20 68 6f 73 74 20 20 20 20 20 20 20 54 45 host TE
1b50: 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 XT DEFAULT 'n/a'
1b60: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
1b70: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 20 20 cpuload
1b80: 20 20 52 45 41 4c 20 44 45 46 41 55 4c 54 20 2d REAL DEFAULT -
1b90: 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1,.
1ba0: 20 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 diskfree
1bb0: 20 20 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 INTEGER DEFAU
1bc0: 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 LT -1,.
1bd0: 20 20 20 20 20 20 20 20 20 20 20 20 75 6e 61 6d unam
1be0: 65 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 e TEXT DEFA
1bf0: 55 4c 54 20 27 6e 2f 61 27 2c 20 0a 20 20 20 20 ULT 'n/a', .
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 72 75 6e 64 69 72 20 20 20 20 20 54 45 58 54 rundir TEXT
1c20: 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a DEFAULT 'n/a',.
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c40: 20 20 20 20 20 73 68 6f 72 74 64 69 72 20 20 20 shortdir
1c50: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
1c60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c70: 20 20 20 20 20 20 69 74 65 6d 5f 70 61 74 68 20 item_path
1c80: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
1c90: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
1ca0: 20 20 20 20 20 20 20 73 74 61 74 65 20 20 20 20 state
1cb0: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
1cc0: 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 0a 20 20 NOT_STARTED',.
1cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ce0: 20 20 20 73 74 61 74 75 73 20 20 20 20 20 54 45 status TE
1cf0: 58 54 20 44 45 46 41 55 4c 54 20 27 46 41 49 4c XT DEFAULT 'FAIL
1d00: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
1d10: 20 20 20 20 20 20 20 20 61 74 74 65 6d 70 74 6e attemptn
1d20: 75 6d 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 um INTEGER DEFAU
1d30: 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20 LT 0,.
1d40: 20 20 20 20 20 20 20 20 20 20 20 66 69 6e 61 6c final
1d50: 5f 6c 6f 67 66 20 54 45 58 54 20 44 45 46 41 55 _logf TEXT DEFAU
1d60: 4c 54 20 27 6c 6f 67 73 2f 66 69 6e 61 6c 2e 6c LT 'logs/final.l
1d70: 6f 67 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 og',.
1d80: 20 20 20 20 20 20 20 20 20 20 6c 6f 67 64 61 74 logdat
1d90: 20 20 20 20 20 42 4c 4f 42 2c 20 0a 20 20 20 20 BLOB, .
1da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1db0: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 49 4e run_duration IN
1dc0: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c TEGER DEFAULT 0,
1dd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1de0: 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 20 20 comment
1df0: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
1e00: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
1e10: 20 20 20 20 20 20 20 65 76 65 6e 74 5f 74 69 6d event_tim
1e20: 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 e TIMESTAMP,.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 66 61 69 6c 5f 63 6f 75 6e 74 20 49 4e 54 fail_count INT
1e50: 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a EGER DEFAULT 0,.
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 20 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 20 pass_count
1e80: 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 INTEGER DEFAULT
1e90: 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0,.
1ea0: 20 20 20 20 20 20 20 20 61 72 63 68 69 76 65 64 archived
1eb0: 20 20 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 INTEGER DEFAU
1ec0: 4c 54 20 30 2c 20 2d 2d 20 30 3d 6e 6f 2c 20 31 LT 0, -- 0=no, 1
1ed0: 3d 69 6e 20 70 72 6f 67 72 65 73 73 2c 20 32 3d =in progress, 2=
1ee0: 79 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 yes.
1ef0: 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 CONSTRA
1f00: 49 4e 54 20 74 65 73 74 73 63 6f 6e 73 74 72 61 INT testsconstra
1f10: 69 6e 74 20 55 4e 49 51 55 45 20 28 72 75 6e 5f int UNIQUE (run_
1f20: 69 64 2c 20 74 65 73 74 6e 61 6d 65 2c 20 69 74 id, testname, it
1f30: 65 6d 5f 70 61 74 68 29 0a 20 20 20 20 20 20 20 em_path).
1f40: 20 20 20 29 3b 22 29 0a 20 20 20 20 28 73 71 6c );"). (sql
1f50: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
1f60: 22 43 52 45 41 54 45 20 49 4e 44 45 58 20 74 65 "CREATE INDEX te
1f70: 73 74 73 5f 69 6e 64 65 78 20 4f 4e 20 74 65 73 sts_index ON tes
1f80: 74 73 20 28 72 75 6e 5f 69 64 2c 20 74 65 73 74 ts (run_id, test
1f90: 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 61 74 68 29 name, item_path)
1fa0: 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ;"). (sqlite3
1fb0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 :execute db "CRE
1fc0: 41 54 45 20 56 49 45 57 20 72 75 6e 73 5f 74 65 ATE VIEW runs_te
1fd0: 73 74 73 20 41 53 20 53 45 4c 45 43 54 20 2a 20 sts AS SELECT *
1fe0: 46 52 4f 4d 20 72 75 6e 73 20 49 4e 4e 45 52 20 FROM runs INNER
1ff0: 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 72 75 JOIN tests ON ru
2000: 6e 73 2e 69 64 3d 74 65 73 74 73 2e 72 75 6e 5f ns.id=tests.run_
2010: 69 64 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 id;"). (sqlit
2020: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
2030: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
2040: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 73 OT EXISTS test_s
2050: 74 65 70 73 20 0a 20 20 20 20 20 20 20 20 20 20 teps .
2060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2070: 20 20 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 (id INTEGER
2080: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 test
20b0: 5f 69 64 20 49 4e 54 45 47 45 52 2c 20 0a 20 20 _id INTEGER, .
20c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 65 ste
20e0: 70 6e 61 6d 65 20 54 45 58 54 2c 20 0a 20 20 20 pname TEXT, .
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2100: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 stat
2110: 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 e TEXT DEFAULT '
2120: 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 20 0a 20 NOT_STARTED', .
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
2150: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
2160: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2180: 20 20 20 20 20 20 20 20 65 76 65 6e 74 5f 74 69 event_ti
2190: 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 me TIMESTAMP,.
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f 6d com
21c0: 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c ment TEXT DEFAUL
21d0: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 6c 6f 67 66 69 6c 65 20 54 45 58 logfile TEX
2200: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
2210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
2230: 53 54 52 41 49 4e 54 20 74 65 73 74 5f 73 74 65 STRAINT test_ste
2240: 70 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e ps_constraint UN
2250: 49 51 55 45 20 28 74 65 73 74 5f 69 64 2c 73 74 IQUE (test_id,st
2260: 65 70 6e 61 6d 65 2c 73 74 61 74 65 29 29 3b 22 epname,state));"
2270: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
2280: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
2290: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
22a0: 58 49 53 54 53 20 65 78 74 72 61 64 61 74 20 28 XISTS extradat (
22b0: 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 id INTEGER PRIMA
22c0: 52 59 20 4b 45 59 2c 20 72 75 6e 5f 69 64 20 49 RY KEY, run_id I
22d0: 4e 54 45 47 45 52 2c 20 6b 65 79 20 54 45 58 54 NTEGER, key TEXT
22e0: 2c 20 76 61 6c 20 54 45 58 54 29 3b 22 29 0a 20 , val TEXT);").
22f0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
2300: 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 ute db "CREATE T
2310: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
2320: 54 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 TS metadat (id I
2330: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
2340: 45 59 2c 20 76 61 72 20 54 45 58 54 2c 20 76 61 EY, var TEXT, va
2350: 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 l TEXT,.
2360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2370: 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 CONSTR
2380: 41 49 4e 54 20 6d 65 74 61 64 61 74 5f 63 6f 6e AINT metadat_con
2390: 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 straint UNIQUE (
23a0: 76 61 72 29 29 3b 22 29 0a 20 20 20 20 28 73 71 var));"). (sq
23b0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
23c0: 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 "CREATE TABLE I
23d0: 46 20 4e 4f 54 20 45 58 49 53 54 53 20 61 63 63 F NOT EXISTS acc
23e0: 65 73 73 5f 6c 6f 67 20 28 69 64 20 49 4e 54 45 ess_log (id INTE
23f0: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
2400: 20 75 73 65 72 20 54 45 58 54 2c 20 61 63 63 65 user TEXT, acce
2410: 73 73 65 64 20 54 49 4d 45 53 54 41 4d 50 2c 20 ssed TIMESTAMP,
2420: 61 72 67 73 20 54 45 58 54 29 3b 22 29 0a 20 20 args TEXT);").
2430: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
2440: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
2450: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
2460: 53 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 20 S test_meta (id
2470: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
2480: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 KEY,.
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e 61 testna
24b0: 6d 65 20 20 20 20 54 45 58 54 20 44 45 46 41 55 me TEXT DEFAU
24c0: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 68 auth
24f0: 6f 72 20 20 20 20 20 20 54 45 58 54 20 44 45 46 or TEXT DEF
2500: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 77 ow
2530: 6e 65 72 20 20 20 20 20 20 20 54 45 58 54 20 44 ner TEXT D
2540: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 64 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 54 description TEXT
2580: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 20 20 72 65 76 69 65 77 65 64 20 20 20 20 54 49 reviewed TI
25c0: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74 it
25f0: 65 72 61 74 65 64 20 20 20 20 54 45 58 54 20 44 erated TEXT D
2600: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 4c avg_runtime REAL
2640: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
2650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2660: 20 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b 20 avg_disk
2670: 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 REAL,.
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 20 20 20 74 61 ta
26a0: 67 73 20 20 20 20 20 20 20 20 54 45 58 54 20 44 gs TEXT D
26b0: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
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 20 20 20 20 20 20 20 20 20
26e0: 6a 6f 62 67 72 6f 75 70 20 20 20 20 54 45 58 54 jobgroup TEXT
26f0: 20 44 45 46 41 55 4c 54 20 27 64 65 66 61 75 6c DEFAULT 'defaul
2700: 74 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 t',.
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 CONSTRAINT t
2730: 65 73 74 5f 6d 65 74 61 5f 63 6f 6e 73 74 72 61 est_meta_constra
2740: 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 int UNIQUE (test
2750: 6e 61 6d 65 29 29 3b 22 29 0a 20 20 20 20 28 73 name));"). (s
2760: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
2770: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
2780: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 IF NOT EXISTS te
2790: 73 74 5f 64 61 74 61 20 28 69 64 20 49 4e 54 45 st_data (id INTE
27a0: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
27b0: 0a 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 20 20 20 20 20 20 20
27d0: 20 74 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 test_id INTEGER
27e0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 63 61 74 65 67 6f 72 79 20 54 45 58 54 20 category TEXT
2810: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2830: 20 20 20 20 20 20 20 20 20 20 20 20 76 61 72 69 vari
2840: 61 62 6c 65 20 54 45 58 54 2c 0a 09 20 20 20 20 able TEXT,..
2850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2860: 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a value REAL,.
2870: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2880: 20 20 20 20 20 20 20 20 20 65 78 70 65 63 74 65 expecte
2890: 64 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 d REAL,..
28a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b0: 20 74 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 tol REAL,.
28c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28d0: 20 20 20 20 20 20 20 20 20 20 20 75 6e 69 74 73 units
28e0: 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 TEXT,.
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 20 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 comment T
2910: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
2920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2940: 73 74 61 74 75 73 20 54 45 58 54 20 44 45 46 41 status TEXT DEFA
2950: 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 ULT 'n/a',.
2960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2970: 20 20 20 20 20 20 20 20 20 20 20 74 79 70 65 20 type
2980: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
2990: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
29b0: 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 74 5f 64 ONSTRAINT test_d
29c0: 61 74 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 ata_constraint U
29d0: 4e 49 51 55 45 20 28 74 65 73 74 5f 69 64 2c 63 NIQUE (test_id,c
29e0: 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 ategory,variable
29f0: 29 29 3b 22 29 0a 20 20 20 20 3b 3b 20 4d 75 73 ));"). ;; Mus
2a00: 74 20 64 6f 20 74 68 69 73 20 2a 61 66 74 65 72 t do this *after
2a10: 2a 20 72 75 6e 6e 69 6e 67 20 70 61 74 63 68 20 * running patch
2a20: 64 62 20 21 21 20 4e 6f 20 6d 6f 72 65 2e 20 0a db !! No more. .
2a30: 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 (db:set-var
2a40: 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 db "MEGATEST_VER
2a50: 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 74 2d 76 SION" megatest-v
2a60: 65 72 73 69 6f 6e 29 0a 20 20 20 20 28 64 65 62 ersion). (deb
2a70: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
2a80: 20 22 64 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 "db:initialize
2a90: 45 4e 44 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b END"). ))..;;
2aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2ae0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 ======.;; T E S
2af0: 54 20 20 20 53 20 50 20 45 20 43 20 49 20 46 20 T S P E C I F
2b00: 49 20 43 20 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d I C D B .;;===
2b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2b50: 3d 3d 3d 0a 0a 3b 3b 20 43 72 65 61 74 65 20 74 ===..;; Create t
2b60: 68 65 20 73 71 6c 69 74 65 20 64 62 20 66 6f 72 he sqlite db for
2b70: 20 74 68 65 20 69 6e 64 69 76 69 64 75 61 6c 20 the individual
2b80: 74 65 73 74 28 73 29 0a 28 64 65 66 69 6e 65 20 test(s).(define
2b90: 28 6f 70 65 6e 2d 74 65 73 74 2d 64 62 20 77 6f (open-test-db wo
2ba0: 72 6b 2d 61 72 65 61 29 20 0a 20 20 28 64 65 62 rk-area) . (deb
2bb0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
2bc0: 20 22 6f 70 65 6e 2d 74 65 73 74 2d 64 62 20 22 "open-test-db "
2bd0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 28 69 work-area). (i
2be0: 66 20 28 61 6e 64 20 77 6f 72 6b 2d 61 72 65 61 f (and work-area
2bf0: 20 0a 09 20 20 20 28 64 69 72 65 63 74 6f 72 79 .. (directory
2c00: 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 ? work-area)..
2c10: 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 (file-read-acce
2c20: 73 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a ss? work-area)).
2c30: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 62 (let* ((db
2c40: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 77 6f path (conc wo
2c50: 72 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 64 61 rk-area "/testda
2c60: 74 2e 64 62 22 29 29 0a 09 20 20 20 20 20 28 64 t.db")).. (d
2c70: 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 2d 65 bexists (file-e
2c80: 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 29 0a xists? dbpath)).
2c90: 09 20 20 20 20 20 28 68 61 6e 64 6c 65 72 20 20 . (handler
2ca0: 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 (make-busy-time
2cb0: 6f 75 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 out (if (args:ge
2cc0: 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 t-arg "-override
2cd0: 2d 74 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 -timeout")......
2ce0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e (string->
2cf0: 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 number (args:get
2d00: 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d -arg "-override-
2d10: 74 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 09 09 timeout"))......
2d20: 20 20 20 20 20 20 20 31 33 36 30 30 30 29 29 29 136000)))
2d30: 29 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 )..(handle-excep
2d40: 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 tions.. exn.. (b
2d50: 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a egin.. (debug:
2d60: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
2d70: 70 72 6f 62 6c 65 6d 20 61 63 63 65 73 73 69 6e problem accessin
2d80: 67 20 74 65 73 74 20 64 62 20 22 20 77 6f 72 6b g test db " work
2d90: 2d 61 72 65 61 20 22 2c 20 79 6f 75 20 70 72 6f -area ", you pro
2da0: 62 61 62 6c 79 20 73 68 6f 75 6c 64 20 63 6c 65 bably should cle
2db0: 61 6e 20 61 6e 64 20 72 65 2d 72 75 6e 20 74 68 an and re-run th
2dc0: 69 73 20 74 65 73 74 22 0a 09 09 09 28 28 63 6f is test"....((co
2dd0: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
2de0: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
2df0: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
2e00: 20 20 20 23 66 29 0a 09 20 28 73 65 74 21 20 64 #f).. (set! d
2e10: 62 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d b (sqlite3:open-
2e20: 64 61 74 61 62 61 73 65 20 64 62 70 61 74 68 29 database dbpath)
2e30: 29 29 0a 09 28 73 71 6c 69 74 65 33 3a 73 65 74 ))..(sqlite3:set
2e40: 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 -busy-handler! d
2e50: 62 20 68 61 6e 64 6c 65 72 29 0a 09 28 69 66 20 b handler)..(if
2e60: 28 6e 6f 74 20 64 62 65 78 69 73 74 73 29 0a 09 (not dbexists)..
2e70: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
2e80: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
2e90: 74 65 20 64 62 20 22 50 52 41 47 4d 41 20 73 79 te db "PRAGMA sy
2ea0: 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 46 55 4c 4c nchronous = FULL
2eb0: 3b 22 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 ;").. (debu
2ec0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
2ed0: 22 49 6e 69 74 69 61 6c 69 7a 65 64 20 74 65 73 "Initialized tes
2ee0: 74 20 64 61 74 61 62 61 73 65 20 22 20 64 62 70 t database " dbp
2ef0: 61 74 68 29 0a 09 20 20 20 20 20 20 28 64 62 3a ath).. (db:
2f00: 74 65 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 7a testdb-initializ
2f10: 65 20 64 62 29 29 29 0a 09 3b 3b 20 28 73 71 6c e db)))..;; (sql
2f20: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
2f30: 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e "PRAGMA synchron
2f40: 6f 75 73 20 3d 20 30 3b 22 29 0a 09 28 64 65 62 ous = 0;")..(deb
2f50: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
2f60: 20 22 6f 70 65 6e 2d 74 65 73 74 2d 64 62 20 45 "open-test-db E
2f70: 4e 44 20 28 73 75 63 65 73 73 66 75 6c 29 22 20 ND (sucessful)"
2f80: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 3b 3b 20 6e work-area)..;; n
2f90: 6f 77 20 6c 65 74 27 73 20 74 65 73 74 20 74 68 ow let's test th
2fa0: 61 74 20 65 76 65 72 79 74 68 69 6e 67 20 69 73 at everything is
2fb0: 20 63 6f 72 72 65 63 74 0a 09 28 68 61 6e 64 6c correct..(handl
2fc0: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 e-exceptions.. e
2fd0: 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 xn.. (begin..
2fe0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2ff0: 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 61 ERROR: problem a
3000: 63 63 65 73 73 69 6e 67 20 74 65 73 74 20 64 62 ccessing test db
3010: 20 22 20 77 6f 72 6b 2d 61 72 65 61 20 22 2c 20 " work-area ",
3020: 79 6f 75 20 70 72 6f 62 61 62 6c 79 20 73 68 6f you probably sho
3030: 75 6c 64 20 63 6c 65 61 6e 20 61 6e 64 20 72 65 uld clean and re
3040: 2d 72 75 6e 20 74 68 69 73 20 74 65 73 74 22 0a -run this test".
3050: 09 09 09 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 ...((condition-p
3060: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
3070: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
3080: 65 78 6e 29 29 0a 09 20 20 20 23 66 29 0a 09 20 exn)).. #f)..
3090: 3b 3b 20 49 73 20 74 68 65 72 65 20 61 20 63 68 ;; Is there a ch
30a0: 65 61 70 65 72 20 73 69 6e 67 6c 65 20 6c 69 6e eaper single lin
30b0: 65 20 6f 70 65 72 61 74 69 6f 6e 20 74 68 61 74 e operation that
30c0: 20 77 69 6c 6c 20 63 68 65 63 6b 20 66 6f 72 20 will check for
30d0: 65 78 69 73 74 61 6e 63 65 20 6f 66 20 61 20 74 existance of a t
30e0: 61 62 6c 65 0a 09 20 3b 3b 20 61 6e 64 20 72 61 able.. ;; and ra
30f0: 69 73 65 20 61 6e 20 65 78 63 65 70 74 69 6f 6e ise an exception
3100: 20 3f 0a 09 20 28 73 71 6c 69 74 65 33 3a 65 78 ?.. (sqlite3:ex
3110: 65 63 75 74 65 20 64 62 20 22 53 45 4c 45 43 54 ecute db "SELECT
3120: 20 69 64 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 id FROM test_da
3130: 74 61 20 4c 49 4d 49 54 20 31 3b 22 29 29 0a 09 ta LIMIT 1;"))..
3140: 64 62 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e db). (begin
3150: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
3160: 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 74 65 73 nfo 11 "open-tes
3170: 74 2d 64 62 20 45 4e 44 20 28 75 6e 73 75 63 65 t-db END (unsuce
3180: 73 73 66 75 6c 29 22 20 77 6f 72 6b 2d 61 72 65 ssful)" work-are
3190: 61 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 20 66 69 a)..#f)))..;; fi
31a0: 6e 64 20 61 6e 64 20 6f 70 65 6e 20 74 68 65 20 nd and open the
31b0: 74 65 73 74 64 61 74 2e 64 62 20 66 69 6c 65 20 testdat.db file
31c0: 66 6f 72 20 61 6e 20 65 78 69 73 74 69 6e 67 20 for an existing
31d0: 74 65 73 74 0a 28 64 65 66 69 6e 65 20 28 64 62 test.(define (db
31e0: 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 :open-test-db-by
31f0: 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 -test-id db test
3200: 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d -id #!key (work-
3210: 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c 65 74 area #f)). (let
3220: 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 28 69 * ((test-path (i
3230: 66 20 77 6f 72 6b 2d 61 72 65 61 0a 09 09 09 77 f work-area....w
3240: 6f 72 6b 2d 61 72 65 61 0a 09 09 09 28 63 64 62 ork-area....(cdb
3250: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 74 :remote-run db:t
3260: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 est-get-rundir-f
3270: 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 20 74 rom-test-id db t
3280: 65 73 74 2d 69 64 29 29 29 29 0a 20 20 20 20 28 est-id)))). (
3290: 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 54 debug:print 3 "T
32a0: 45 53 54 20 50 41 54 48 3a 20 22 20 74 65 73 74 EST PATH: " test
32b0: 2d 70 61 74 68 29 0a 20 20 20 20 28 6f 70 65 6e -path). (open
32c0: 2d 74 65 73 74 2d 64 62 20 74 65 73 74 2d 70 61 -test-db test-pa
32d0: 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 th)))..(define (
32e0: 64 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 69 61 db:testdb-initia
32f0: 6c 69 7a 65 20 64 62 29 0a 20 20 28 64 65 62 75 lize db). (debu
3300: 67 3a 70 72 69 6e 74 20 31 31 20 22 64 62 3a 74 g:print 11 "db:t
3310: 65 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 7a 65 estdb-initialize
3320: 20 53 54 41 52 54 22 29 0a 20 20 28 66 6f 72 2d START"). (for-
3330: 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 each. (lambda
3340: 28 73 71 6c 63 6d 64 29 0a 20 20 20 20 20 28 73 (sqlcmd). (s
3350: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
3360: 62 20 73 71 6c 63 6d 64 29 29 0a 20 20 20 28 6c b sqlcmd)). (l
3370: 69 73 74 20 22 43 52 45 41 54 45 20 54 41 42 4c ist "CREATE TABL
3380: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
3390: 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a 20 20 test_rundat (.
33a0: 20 20 20 20 20 20 20 20 20 20 20 20 69 64 20 49 id I
33b0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
33c0: 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 EY,.
33d0: 20 20 75 70 64 61 74 65 5f 74 69 6d 65 20 54 49 update_time TI
33e0: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
33f0: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 20 49 cpuload I
3400: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 2d NTEGER DEFAULT -
3410: 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1,.
3420: 20 64 69 73 6b 66 72 65 65 20 49 4e 54 45 47 45 diskfree INTEGE
3430: 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 R DEFAULT -1,.
3440: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 73 6b disk
3450: 75 73 61 67 65 20 49 4e 54 47 45 52 20 44 45 46 usage INTGER DEF
3460: 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 AULT -1,.
3470: 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 61 74 run_durat
3480: 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 46 41 ion INTEGER DEFA
3490: 55 4c 54 20 30 29 3b 22 0a 09 20 22 43 52 45 41 ULT 0);".. "CREA
34a0: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
34b0: 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 EXISTS test_data
34c0: 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 (.
34d0: 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d id INTEGER PRIM
34e0: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY KEY,.
34f0: 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 49 test_id I
3500: 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 NTEGER,.
3510: 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 20 54 category T
3520: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
3530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
3540: 72 69 61 62 6c 65 20 54 45 58 54 2c 0a 09 20 20 riable TEXT,..
3550: 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a value REAL,.
3560: 09 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 . expected
3570: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 74 6f 6c REAL,.. tol
3580: 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 REAL,.
3590: 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 54 2c units TEXT,
35a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 . c
35b0: 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 omment TEXT DEFA
35c0: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
35d0: 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 58 status TEX
35e0: 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c T DEFAULT 'n/a',
35f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 . t
3600: 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ype TEXT DEFAULT
3610: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
3620: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 CONSTRAINT te
3630: 73 74 5f 64 61 74 61 5f 63 6f 6e 73 74 72 61 69 st_data_constrai
3640: 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f nt UNIQUE (test_
3650: 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 id,category,vari
3660: 61 62 6c 65 29 29 3b 22 0a 09 20 22 43 52 45 41 able));".. "CREA
3670: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
3680: 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 65 70 EXISTS test_step
3690: 73 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 s (.
36a0: 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 id INTEGER PRI
36b0: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
36c0: 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 test_id
36d0: 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 20 20 INTEGER, .
36e0: 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 stepname
36f0: 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 20 20 TEXT, .
3700: 20 20 20 20 20 20 73 74 61 74 65 20 54 45 58 54 state TEXT
3710: 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 DEFAULT 'NOT_ST
3720: 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 20 20 ARTED', .
3730: 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 status TE
3740: 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 XT DEFAULT 'n/a'
3750: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
3760: 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 event_time TIMES
3770: 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 TAMP,.
3780: 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 comment TEXT
3790: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
37a0: 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 66 69 logfi
37b0: 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 le TEXT DEFAULT
37c0: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
37d0: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 CONSTRAINT tes
37e0: 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 72 61 69 t_steps_constrai
37f0: 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f nt UNIQUE (test_
3800: 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 id,stepname,stat
3810: 65 29 29 3b 22 0a 09 20 3b 3b 20 74 65 73 74 5f e));".. ;; test_
3820: 6d 65 74 61 20 63 61 6e 20 62 65 20 75 73 65 64 meta can be used
3830: 20 66 6f 72 20 68 61 6e 64 69 6e 67 20 63 6f 6d for handing com
3840: 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 74 65 73 mands to the tes
3850: 74 0a 09 20 3b 3b 20 65 2e 67 2e 20 4b 49 4c 4c t.. ;; e.g. KILL
3860: 52 45 51 0a 09 20 3b 3b 20 20 20 20 20 20 74 68 REQ.. ;; th
3870: 65 20 61 63 6b 73 74 61 74 65 20 69 73 20 73 65 e ackstate is se
3880: 74 20 74 6f 20 31 20 6f 6e 63 65 20 74 68 65 20 t to 1 once the
3890: 63 6f 6d 6d 61 6e 64 20 68 61 73 20 62 65 65 6e command has been
38a0: 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 22 43 52 completed.. "CR
38b0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
38c0: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 6d 65 T EXISTS test_me
38d0: 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 ta (.
38e0: 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 id INTEGER PR
38f0: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
3900: 20 20 20 20 20 20 20 20 20 76 61 72 20 54 45 58 var TEX
3910: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
3920: 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 val TEXT,.
3930: 20 20 20 20 20 20 20 20 20 61 63 6b 73 74 61 74 ackstat
3940: 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c e INTEGER DEFAUL
3950: 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 T 0,.
3960: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 CONSTRAINT me
3970: 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 tadat_constraint
3980: 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 UNIQUE (var));"
3990: 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e )). (debug:prin
39a0: 74 20 31 31 20 22 64 62 3a 74 65 73 74 64 62 2d t 11 "db:testdb-
39b0: 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 22 29 initialize END")
39c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
39d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
39f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c ===========.;; L
3a10: 20 4f 20 47 20 47 20 49 20 4e 20 47 20 20 20 20 O G G I N G
3a20: 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d D B .;;=========
3a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
3a70: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c 6f 67 define (open-log
3a80: 67 69 6e 67 2d 64 62 29 20 3b 3b 20 20 28 63 6f ging-db) ;; (co
3a90: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6d nc *toppath* "/m
3aa0: 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 63 61 egatest.db") (ca
3ab0: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 r *configinfo*))
3ac0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 70 61 ). (let* ((dbpa
3ad0: 74 68 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 th (conc (if
3ae0: 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e 63 20 *toppath* (conc
3af0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 22 29 20 22 *toppath* "/") "
3b00: 22 29 20 22 6c 6f 67 67 69 6e 67 2e 64 62 22 29 ") "logging.db")
3b10: 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 20 28 64 ) ;; fname).. (d
3b20: 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 2d 65 bexists (file-e
3b30: 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 29 0a xists? dbpath)).
3b40: 09 20 28 64 62 20 20 20 20 20 20 20 20 28 73 71 . (db (sq
3b50: 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 lite3:open-datab
3b60: 61 73 65 20 64 62 70 61 74 68 29 29 20 3b 3b 20 ase dbpath)) ;;
3b70: 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 2d 6f (never-give-up-o
3b80: 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 29 0a pen-db dbpath)).
3b90: 09 20 28 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 . (handler (ma
3ba0: 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 ke-busy-timeout
3bb0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
3bc0: 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d g "-override-tim
3bd0: 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 20 28 eout")...... (
3be0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
3bf0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f args:get-arg "-o
3c00: 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 verride-timeout"
3c10: 29 29 0a 09 09 09 09 09 20 20 20 31 33 36 30 30 ))...... 13600
3c20: 30 29 29 29 29 20 3b 3b 20 31 33 36 30 30 30 29 0)))) ;; 136000)
3c30: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
3c40: 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 set-busy-handler
3c50: 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 20 ! db handler).
3c60: 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 (if (not dbexi
3c70: 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 sts)..(begin..
3c80: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
3c90: 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c db "CREATE TABL
3ca0: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
3cb0: 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52 20 log (id INTEGER
3cc0: 50 52 49 4d 41 52 59 20 4b 45 59 2c 65 76 65 6e PRIMARY KEY,even
3cd0: 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 t_time TIMESTAMP
3ce0: 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 74 69 DEFAULT (strfti
3cf0: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 29 2c me('%s','now')),
3d00: 6c 6f 67 6c 69 6e 65 20 54 45 58 54 2c 70 77 64 logline TEXT,pwd
3d10: 20 54 45 58 54 2c 63 6d 64 6c 69 6e 65 20 54 45 TEXT,cmdline TE
3d20: 58 54 2c 70 69 64 20 49 4e 54 45 47 45 52 29 3b XT,pid INTEGER);
3d30: 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 ").. (sqlite3:e
3d40: 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 xecute db (conc
3d50: 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e "PRAGMA synchron
3d60: 6f 75 73 20 3d 20 30 3b 22 29 29 29 29 0a 20 20 ous = 0;")))).
3d70: 20 20 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 db))..(define
3d80: 28 64 62 3a 6c 6f 67 2d 6c 6f 63 61 6c 2d 65 76 (db:log-local-ev
3d90: 65 6e 74 20 2e 20 6c 6f 67 6c 73 74 29 0a 20 20 ent . loglst).
3da0: 28 6c 65 74 20 28 28 6c 6f 67 6c 69 6e 65 20 28 (let ((logline (
3db0: 61 70 70 6c 79 20 63 6f 6e 63 20 6c 6f 67 6c 73 apply conc logls
3dc0: 74 29 29 0a 09 28 70 77 64 20 20 20 20 20 28 63 t))..(pwd (c
3dd0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
3de0: 29 29 0a 09 28 63 6d 64 6c 69 6e 65 20 28 73 74 ))..(cmdline (st
3df0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
3e00: 20 28 61 72 67 76 29 20 22 20 22 29 29 0a 09 28 (argv) " "))..(
3e10: 70 69 64 20 20 20 20 20 28 63 75 72 72 65 6e 74 pid (current
3e20: 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 20 -process-id))).
3e30: 20 20 20 28 64 62 3a 6c 6f 67 2d 65 76 65 6e 74 (db:log-event
3e40: 20 6c 6f 67 6c 69 6e 65 20 70 77 64 20 63 6d 64 logline pwd cmd
3e50: 6c 69 6e 65 20 70 69 64 29 29 29 0a 0a 28 64 65 line pid)))..(de
3e60: 66 69 6e 65 20 28 64 62 3a 6c 6f 67 2d 65 76 65 fine (db:log-eve
3e70: 6e 74 20 6c 6f 67 6c 69 6e 65 20 70 77 64 20 63 nt logline pwd c
3e80: 6d 64 6c 69 6e 65 20 70 69 64 29 0a 20 20 28 6c mdline pid). (l
3e90: 65 74 20 28 28 64 62 20 28 6f 70 65 6e 2d 6c 6f et ((db (open-lo
3ea0: 67 67 69 6e 67 2d 64 62 29 29 29 0a 20 20 20 20 gging-db))).
3eb0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
3ec0: 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f db "INSERT INTO
3ed0: 20 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 2c 70 77 log (logline,pw
3ee0: 64 2c 63 6d 64 6c 69 6e 65 2c 70 69 64 29 20 56 d,cmdline,pid) V
3ef0: 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b ALUES (?,?,?,?);
3f00: 22 20 6c 6f 67 6c 69 6e 65 20 28 63 75 72 72 65 " logline (curre
3f10: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 28 73 74 nt-directory)(st
3f20: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
3f30: 20 28 61 72 67 76 29 20 22 20 22 29 28 63 75 72 (argv) " ")(cur
3f40: 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
3f50: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
3f60: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 inalize! db).
3f70: 20 6c 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b 3d 3d logline))..;;==
3f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3fc0: 3d 3d 3d 3d 0a 3b 3b 20 54 4f 44 4f 3a 0a 3b 3b ====.;; TODO:.;;
3fd0: 20 20 20 70 75 74 20 64 65 6c 74 61 73 20 69 6e put deltas in
3fe0: 74 6f 20 61 6e 20 61 73 73 6f 63 20 6c 69 73 74 to an assoc list
3ff0: 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 6e 75 with version nu
4000: 6d 62 65 72 73 0a 3b 3b 20 20 20 61 70 70 6c 79 mbers.;; apply
4010: 20 61 6c 6c 20 66 72 6f 6d 20 6c 61 73 74 20 74 all from last t
4020: 6f 20 63 75 72 72 65 6e 74 0a 3b 3b 3d 3d 3d 3d o current.;;====
4030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4070: 3d 3d 0a 28 64 65 66 69 6e 65 20 28 70 61 74 63 ==.(define (patc
4080: 68 2d 64 62 20 64 62 29 0a 20 20 28 68 61 6e 64 h-db db). (hand
4090: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
40a0: 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e 0a 20 exn. (begin.
40b0: 20 20 20 20 28 70 72 69 6e 74 20 22 45 78 63 65 (print "Exce
40c0: 70 74 69 6f 6e 3a 20 22 20 65 78 6e 29 0a 20 20 ption: " exn).
40d0: 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 (print "ERROR
40e0: 3a 20 50 6f 73 73 69 62 6c 65 20 6f 75 74 20 6f : Possible out o
40f0: 66 20 64 61 74 65 20 73 63 68 65 6d 61 2c 20 61 f date schema, a
4100: 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 61 64 64 ttempting to add
4110: 20 74 61 62 6c 65 20 6d 65 74 61 64 61 74 61 2e table metadata.
4120: 2e 2e 22 29 0a 20 20 20 20 20 28 73 71 6c 69 74 .."). (sqlit
4130: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
4140: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
4150: 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 64 61 OT EXISTS metada
4160: 74 20 28 69 64 20 49 4e 54 45 47 45 52 2c 20 76 t (id INTEGER, v
4170: 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45 58 ar TEXT, val TEX
4180: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
4190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41a0: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d CONSTRAINT m
41b0: 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e etadat_constrain
41c0: 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b t UNIQUE (var));
41d0: 22 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f 74 "). (if (not
41e0: 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 20 (db:get-var db
41f0: 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f "MEGATEST_VERSIO
4200: 4e 22 29 29 0a 09 20 28 64 62 3a 73 65 74 2d 76 N")).. (db:set-v
4210: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4220: 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 29 29 29 VERSION" 1.17)))
4230: 0a 20 20 20 28 6c 65 74 20 28 28 6d 76 65 72 20 . (let ((mver
4240: 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 20 22 (db:get-var db "
4250: 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e MEGATEST_VERSION
4260: 22 29 29 0a 09 20 28 74 65 73 74 2d 6d 65 74 61 ")).. (test-meta
4270: 2d 64 65 66 20 22 43 52 45 41 54 45 20 54 41 42 -def "CREATE TAB
4280: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
4290: 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 20 49 test_meta (id I
42a0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
42b0: 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 EY,.
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42d0: 20 20 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d testnam
42e0: 65 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c e TEXT DEFAUL
42f0: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
4300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4310: 20 20 20 20 20 20 20 20 20 20 20 61 75 74 68 6f autho
4320: 72 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 r TEXT DEFA
4330: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 6f 77 6e own
4360: 65 72 20 20 20 20 20 20 20 54 45 58 54 20 44 45 er TEXT DE
4370: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 d
43a0: 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 54 20 escription TEXT
43b0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43e0: 20 72 65 76 69 65 77 65 64 20 20 20 20 54 49 4d reviewed TIM
43f0: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 ESTAMP,.
4400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4410: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74 65 ite
4420: 72 61 74 65 64 20 20 20 20 54 45 58 54 20 44 45 rated TEXT DE
4430: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
4460: 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 4c 2c vg_runtime REAL,
4470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b 20 20 avg_disk
44a0: 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 REAL,.
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 20 20 20 74 61 67 tag
44d0: 73 20 20 20 20 20 20 20 20 54 45 58 54 20 44 45 s TEXT DE
44e0: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 CONSTR
4510: 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 5f 63 AINT test_meta_c
4520: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
4530: 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 29 29 (testname));"))
4540: 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 43 75 . (print "Cu
4550: 72 72 65 6e 74 20 73 63 68 65 6d 61 20 76 65 72 rrent schema ver
4560: 73 69 6f 6e 3a 20 22 20 6d 76 65 72 20 22 20 63 sion: " mver " c
4570: 75 72 72 65 6e 74 20 6d 65 67 61 74 65 73 74 20 urrent megatest
4580: 76 65 72 73 69 6f 6e 3a 20 22 20 6d 65 67 61 74 version: " megat
4590: 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 20 est-version).
45a0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 28 28 (cond. ((
45b0: 6e 6f 74 20 6d 76 65 72 29 0a 20 20 20 20 20 20 not mver).
45c0: 20 28 70 72 69 6e 74 20 22 41 64 64 69 6e 67 20 (print "Adding
45d0: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
45e0: 20 74 6f 20 6d 65 74 61 64 61 74 61 22 29 20 3b to metadata") ;
45f0: 3b 20 4e 65 65 64 20 74 6f 20 72 65 63 72 65 61 ; Need to recrea
4600: 74 65 20 74 68 65 20 74 61 62 6c 65 0a 20 20 20 te the table.
4610: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
4620: 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 cute db "DROP TA
4630: 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 6d 65 BLE IF EXISTS me
4640: 74 61 64 61 74 3b 22 29 0a 20 20 20 20 20 20 20 tadat;").
4650: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
4660: 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c db "CREATE TABL
4670: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
4680: 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e 54 45 metadat (id INTE
4690: 47 45 52 2c 20 76 61 72 20 54 45 58 54 2c 20 76 GER, var TEXT, v
46a0: 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 20 20 al TEXT,.
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46c0: 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 CONST
46d0: 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f 63 6f RAINT metadat_co
46e0: 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 nstraint UNIQUE
46f0: 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 20 20 (var));").
4700: 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 (db:set-var db
4710: 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 4f "MEGATEST_VERSIO
4720: 4e 22 20 31 2e 31 37 29 0a 20 20 20 20 20 20 20 N" 1.17).
4730: 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 (patch-db)).
4740: 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 31 29 ((< mver 1.21)
4750: 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 . (sqlite3
4760: 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 52 4f :execute db "DRO
4770: 50 20 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 P TABLE IF EXIST
4780: 53 20 6d 65 74 61 64 61 74 3b 22 29 0a 20 20 20 S metadat;").
4790: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
47a0: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 cute db "CREATE
47b0: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
47c0: 53 54 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 STS metadat (id
47d0: 49 4e 54 45 47 45 52 2c 20 76 61 72 20 54 45 58 INTEGER, var TEX
47e0: 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 T, val TEXT,.
47f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
4810: 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 61 64 61 ONSTRAINT metada
4820: 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 t_constraint UNI
4830: 51 55 45 20 28 76 61 72 29 29 3b 22 29 0a 20 20 QUE (var));").
4840: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 (db:set-var
4850: 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 db "MEGATEST_VE
4860: 52 53 49 4f 4e 22 20 31 2e 32 31 29 20 3b 3b 20 RSION" 1.21) ;;
4870: 73 65 74 20 62 65 66 6f 72 65 2c 20 6a 75 73 74 set before, just
4880: 20 69 6e 20 63 61 73 65 20 74 68 65 20 63 68 61 in case the cha
4890: 6e 67 65 73 20 61 72 65 20 61 6c 72 65 61 64 79 nges are already
48a0: 20 61 70 70 6c 69 65 64 0a 20 20 20 20 20 20 20 applied.
48b0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
48c0: 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d 64 65 db test-meta-de
48d0: 66 29 0a 09 09 09 09 09 3b 28 66 6f 72 2d 65 61 f)......;(for-ea
48e0: 63 68 20 0a 09 09 09 09 09 3b 20 28 6c 61 6d 62 ch ......; (lamb
48f0: 64 61 20 28 73 74 6d 74 29 0a 09 09 09 09 09 3b da (stmt)......;
4900: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
4910: 75 74 65 20 64 62 20 73 74 6d 74 29 29 0a 09 09 ute db stmt))...
4920: 09 09 09 3b 20 28 6c 69 73 74 20 0a 09 09 09 09 ...; (list .....
4930: 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 4c 45 .; "ALTER TABLE
4940: 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c 55 4d tests ADD COLUM
4950: 4e 20 66 69 72 73 74 5f 65 72 72 20 54 45 58 54 N first_err TEXT
4960: 3b 22 0a 09 09 09 09 09 3b 20 20 22 41 4c 54 45 ;"......; "ALTE
4970: 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 41 44 R TABLE tests AD
4980: 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 5f 77 D COLUMN first_w
4990: 61 72 6e 20 54 45 58 54 3b 22 0a 09 09 09 09 09 arn TEXT;"......
49a0: 3b 20 20 29 29 0a 20 20 20 20 20 20 20 28 70 61 ; )). (pa
49b0: 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 28 tch-db)). (
49c0: 28 3c 20 6d 76 65 72 20 31 2e 32 34 29 0a 20 20 (< mver 1.24).
49d0: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 (db:set-var
49e0: 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 db "MEGATEST_VE
49f0: 52 53 49 4f 4e 22 20 31 2e 32 34 29 0a 20 20 20 RSION" 1.24).
4a00: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
4a10: 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 cute db "DROP TA
4a20: 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 74 65 BLE IF EXISTS te
4a30: 73 74 5f 64 61 74 61 3b 22 29 0a 20 20 20 20 20 st_data;").
4a40: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4a50: 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 42 4c te db "DROP TABL
4a60: 45 20 49 46 20 45 58 49 53 54 53 20 74 65 73 74 E IF EXISTS test
4a70: 5f 6d 65 74 61 3b 22 29 0a 20 20 20 20 20 20 20 _meta;").
4a80: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
4a90: 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d 64 65 db test-meta-de
4aa0: 66 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 f). (sqlit
4ab0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
4ac0: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
4ad0: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 OT EXISTS test_d
4ae0: 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 20 ata (id INTEGER
4af0: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 tes
4b20: 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 t_id INTEGER,.
4b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 61 ca
4b50: 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 46 41 tegory TEXT DEFA
4b60: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
4b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b80: 20 20 20 20 20 20 20 20 76 61 72 69 61 62 6c 65 variable
4b90: 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 20 20 TEXT,..
4ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bb0: 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 value REAL,..
4bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bd0: 20 20 20 20 20 65 78 70 65 63 74 65 64 20 52 45 expected RE
4be0: 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 AL,..
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 6c tol
4c00: 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 REAL,.
4c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c20: 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 units TEX
4c30: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 comment TEXT
4c60: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c80: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 stat
4c90: 75 73 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 us TEXT DEFAULT
4ca0: 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 'n/a',.
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cc0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
4cd0: 74 65 73 74 5f 64 61 74 61 20 55 4e 49 51 55 45 test_data UNIQUE
4ce0: 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f (test_id,catego
4cf0: 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b 22 29 ry,variable));")
4d00: 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 . (print "
4d10: 57 41 52 4e 49 4e 47 3a 20 54 61 62 6c 65 20 74 WARNING: Table t
4d20: 65 73 74 5f 64 61 74 61 20 61 6e 64 20 74 65 73 est_data and tes
4d30: 74 5f 6d 65 74 61 20 77 65 72 65 20 72 65 63 72 t_meta were recr
4d40: 65 61 74 65 64 2e 20 50 6c 65 61 73 65 20 64 6f eated. Please do
4d50: 20 6d 65 67 61 74 65 73 74 20 2d 75 70 64 61 74 megatest -updat
4d60: 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 20 20 20 e-meta").
4d70: 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 (patch-db)).
4d80: 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 37 29 ((< mver 1.27)
4d90: 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d . (db:set-
4da0: 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 var db "MEGATEST
4db0: 5f 56 45 52 53 49 4f 4e 22 20 31 2e 32 37 29 0a _VERSION" 1.27).
4dc0: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
4dd0: 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 execute db "ALTE
4de0: 52 20 54 41 42 4c 45 20 74 65 73 74 5f 64 61 74 R TABLE test_dat
4df0: 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 74 79 70 a ADD COLUMN typ
4e00: 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 e TEXT DEFAULT '
4e10: 27 3b 22 29 0a 20 20 20 20 20 20 20 28 70 61 74 ';"). (pat
4e20: 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 28 28 ch-db)). ((
4e30: 3c 20 6d 76 65 72 20 31 2e 32 39 29 0a 20 20 20 < mver 1.29).
4e40: 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 (db:set-var
4e50: 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 db "MEGATEST_VER
4e60: 53 49 4f 4e 22 20 31 2e 32 39 29 0a 20 20 20 20 SION" 1.29).
4e70: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
4e80: 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 54 41 ute db "ALTER TA
4e90: 42 4c 45 20 74 65 73 74 5f 73 74 65 70 73 20 41 BLE test_steps A
4ea0: 44 44 20 43 4f 4c 55 4d 4e 20 6c 6f 67 66 69 6c DD COLUMN logfil
4eb0: 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 e TEXT DEFAULT '
4ec0: 27 3b 22 29 0a 20 20 20 20 20 20 20 28 73 71 6c ';"). (sql
4ed0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
4ee0: 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 73 "ALTER TABLE tes
4ef0: 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 73 68 ts ADD COLUMN sh
4f00: 6f 72 74 64 69 72 20 54 45 58 54 20 44 45 46 41 ortdir TEXT DEFA
4f10: 55 4c 54 20 27 27 3b 22 29 29 0a 20 20 20 20 20 ULT '';")).
4f20: 20 28 28 3c 20 6d 76 65 72 20 31 2e 33 36 29 0a ((< mver 1.36).
4f30: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4f40: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4f50: 56 45 52 53 49 4f 4e 22 20 31 2e 33 36 29 0a 20 VERSION" 1.36).
4f60: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4f70: 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 xecute db "ALTER
4f80: 20 54 41 42 4c 45 20 74 65 73 74 5f 6d 65 74 61 TABLE test_meta
4f90: 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6a 6f 62 67 ADD COLUMN jobg
4fa0: 72 6f 75 70 20 54 45 58 54 20 44 45 46 41 55 4c roup TEXT DEFAUL
4fb0: 54 20 27 64 65 66 61 75 6c 74 27 3b 22 29 29 0a T 'default';")).
4fc0: 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 ((< mver 1
4fd0: 2e 33 37 29 0a 20 20 20 20 20 20 20 28 64 62 3a .37). (db:
4fe0: 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 set-var db "MEGA
4ff0: 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e TEST_VERSION" 1.
5000: 33 37 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 37). (sqli
5010: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
5020: 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 ALTER TABLE test
5030: 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 61 72 63 s ADD COLUMN arc
5040: 68 69 76 65 64 20 49 4e 54 45 47 45 52 20 44 45 hived INTEGER DE
5050: 46 41 55 4c 54 20 30 3b 22 29 29 20 0a 20 20 20 FAULT 0;")) .
5060: 20 20 20 28 28 3c 20 6d 76 65 72 20 6d 65 67 61 ((< mver mega
5070: 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 test-version).
5080: 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 (db:set-var
5090: 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 db "MEGATEST_VE
50a0: 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 74 2d RSION" megatest-
50b0: 76 65 72 73 69 6f 6e 29 29 29 29 29 29 0a 0a 3b version))))))..;
50c0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
50d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
50f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5100: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 65 74 61 20 =======.;; meta
5110: 67 65 74 20 61 6e 64 20 73 65 74 20 76 61 72 73 get and set vars
5120: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
5130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 =========..;; re
5170: 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 66 20 turns number if
5180: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 69 string->number i
5190: 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 73 74 s successful, st
51a0: 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 0a 3b ring otherwise.;
51b0: 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 20 2a ; also updates *
51c0: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a 28 64 global-delta*.(d
51d0: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 76 61 efine (db:get-va
51e0: 72 20 64 62 20 76 61 72 29 0a 20 20 28 64 65 62 r db var). (deb
51f0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
5200: 20 22 64 62 3a 67 65 74 2d 76 61 72 20 53 54 41 "db:get-var STA
5210: 52 54 20 22 20 76 61 72 29 0a 20 20 28 6c 65 74 RT " var). (let
5220: 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 63 75 * ((start-ms (cu
5230: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
5240: 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 ds)). (t
5250: 68 72 6f 74 74 6c 65 20 28 6c 65 74 20 28 28 74 hrottle (let ((t
5260: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
5270: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
5280: 74 75 70 22 20 22 74 68 72 6f 74 74 6c 65 22 29 tup" "throttle")
5290: 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 74 20 ))... (if t
52a0: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
52b0: 74 29 20 74 29 29 29 0a 09 20 28 72 65 73 20 20 t) t))).. (res
52c0: 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 73 71 #f)). (sq
52d0: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
52e0: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
52f0: 28 76 61 6c 29 0a 20 20 20 20 20 20 20 28 73 65 (val). (se
5300: 74 21 20 72 65 73 20 76 61 6c 29 29 0a 20 20 20 t! res val)).
5310: 20 20 64 62 20 22 53 45 4c 45 43 54 20 76 61 6c db "SELECT val
5320: 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 57 48 FROM metadat WH
5330: 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 72 29 ERE var=?;" var)
5340: 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 74 20 . ;; convert
5350: 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 61 6e to number if can
5360: 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 . (if (string
5370: 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 28 76 ? res)..(let ((v
5380: 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e 6e alnum (string->n
5390: 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 20 20 umber res)))..
53a0: 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 74 21 (if valnum (set!
53b0: 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 29 0a res valnum)))).
53c0: 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 79 20 ;; scale by
53d0: 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 74 68 10, average with
53e0: 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 2e 0a current value..
53f0: 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 (set! *globa
5400: 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b 20 2a l-delta* (/ (+ *
5410: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2a global-delta* (*
5420: 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c (- (current-mil
5430: 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 liseconds) start
5440: 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 66 20 -ms)....... (if
5450: 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 74 6c throttle throttl
5460: 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 20 20 e 0.01)))....
5470: 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 3e 20 2)). (if (>
5480: 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d 67 6c (abs (- *last-gl
5490: 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 obal-delta-print
54a0: 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 ed* *global-delt
54b0: 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 64 6f a*)) 0.08) ;; do
54c0: 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 74 68 n't print all th
54d0: 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 66 20 e time, only if
54e0: 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 69 74 it changes a bit
54f0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
5500: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 ug:print-info 4
5510: 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 6c 65 "launch throttle
5520: 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f 62 61 factor=" *globa
5530: 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 73 65 l-delta*).. (se
5540: 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d t! *last-global-
5550: 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 2a delta-printed* *
5560: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 29 global-delta*)))
5570: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
5580: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
5590: 74 2d 76 61 72 20 45 4e 44 20 22 20 76 61 72 20 t-var END " var
55a0: 22 20 76 61 6c 3d 22 20 72 65 73 29 0a 20 20 20 " val=" res).
55b0: 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
55c0: 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 20 76 (db:set-var db v
55d0: 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 75 67 ar val). (debug
55e0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
55f0: 64 62 3a 73 65 74 2d 76 61 72 20 53 54 41 52 54 db:set-var START
5600: 20 22 20 76 61 72 20 22 20 22 20 76 61 6c 29 0a " var " " val).
5610: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
5620: 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 4f 52 te db "INSERT OR
5630: 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 6d 65 REPLACE INTO me
5640: 74 61 64 61 74 20 28 76 61 72 2c 76 61 6c 29 20 tadat (var,val)
5650: 56 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 20 76 VALUES (?,?);" v
5660: 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 75 67 ar val). (debug
5670: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
5680: 64 62 3a 73 65 74 2d 76 61 72 20 45 4e 44 20 22 db:set-var END "
5690: 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 0a 0a var " " val))..
56a0: 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 2d (define (db:del-
56b0: 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 28 64 var db var). (d
56c0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
56d0: 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 20 53 11 "db:del-var S
56e0: 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 28 73 TART " var). (s
56f0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
5700: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 6d b "DELETE FROM m
5710: 65 74 61 64 61 74 20 57 48 45 52 45 20 76 61 72 etadat WHERE var
5720: 3d 3f 3b 22 20 76 61 72 29 0a 20 20 28 64 65 62 =?;" var). (deb
5730: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
5740: 20 22 64 62 3a 64 65 6c 2d 76 61 72 20 45 4e 44 "db:del-var END
5750: 20 22 20 76 61 72 29 29 0a 0a 3b 3b 20 75 73 65 " var))..;; use
5760: 20 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 73 6f a global for so
5770: 6d 65 20 70 72 69 6d 69 74 69 76 65 20 63 61 63 me primitive cac
5780: 68 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 73 74 hing, it is just
5790: 20 73 69 6c 6c 79 20 74 6f 0a 3b 3b 20 72 65 2d silly to.;; re-
57a0: 72 65 61 64 20 74 68 65 20 64 62 20 6f 76 65 72 read the db over
57b0: 20 61 6e 64 20 6f 76 65 72 20 61 67 61 69 6e 20 and over again
57c0: 66 6f 72 20 74 68 65 20 6b 65 79 73 20 73 69 6e for the keys sin
57d0: 63 65 20 74 68 65 79 20 6e 65 76 65 72 0a 3b 3b ce they never.;;
57e0: 20 63 68 61 6e 67 65 0a 0a 3b 3b 20 77 68 79 20 change..;; why
57f0: 67 65 74 20 74 68 65 20 6b 65 79 73 20 66 72 6f get the keys fro
5800: 6d 20 74 68 65 20 64 62 3f 20 77 68 79 20 6e 6f m the db? why no
5810: 74 20 67 65 74 20 66 72 6f 6d 20 74 68 65 20 2a t get from the *
5820: 63 6f 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 75 73 configdat*.;; us
5830: 69 6e 67 20 6b 65 79 73 3a 63 6f 6e 66 69 67 2d ing keys:config-
5840: 67 65 74 2d 66 69 65 6c 64 73 3f 0a 0a 28 64 65 get-fields?..(de
5850: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 fine (db:get-key
5860: 73 20 64 62 29 0a 20 20 28 69 66 20 2a 64 62 2d s db). (if *db-
5870: 6b 65 79 73 2a 20 2a 64 62 2d 6b 65 79 73 2a 20 keys* *db-keys*
5880: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
5890: 73 20 27 28 29 29 29 0a 09 28 73 71 6c 69 74 65 s '()))..(sqlite
58a0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
58b0: 09 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a . (lambda (key).
58c0: 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 . (set! res (c
58d0: 6f 6e 73 20 6b 65 79 20 72 65 73 29 29 29 0a 09 ons key res)))..
58e0: 20 64 62 0a 09 20 22 53 45 4c 45 43 54 20 66 69 db.. "SELECT fi
58f0: 65 6c 64 6e 61 6d 65 20 46 52 4f 4d 20 6b 65 79 eldname FROM key
5900: 73 20 4f 52 44 45 52 20 42 59 20 69 64 20 44 45 s ORDER BY id DE
5910: 53 43 3b 22 29 0a 09 28 73 65 74 21 20 2a 64 62 SC;")..(set! *db
5920: 2d 6b 65 79 73 2a 20 72 65 73 29 0a 09 72 65 73 -keys* res)..res
5930: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
5940: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
5950: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
5960: 66 69 65 6c 64 29 0a 20 20 28 64 65 62 75 67 3a field). (debug:
5970: 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 print-info 4 "db
5980: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
5990: 61 64 65 72 20 72 6f 77 3a 20 22 20 72 6f 77 20 ader row: " row
59a0: 22 20 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 " header: " head
59b0: 65 72 20 22 20 66 69 65 6c 64 3a 20 22 20 66 69 er " field: " fi
59c0: 65 6c 64 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c eld). (if (null
59d0: 3f 20 68 65 61 64 65 72 29 20 23 66 0a 20 20 20 ? header) #f.
59e0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
59f0: 65 64 20 28 63 61 72 20 68 65 61 64 65 72 29 29 ed (car header))
5a00: 0a 09 09 20 28 74 61 6c 20 28 63 64 72 20 68 65 ... (tal (cdr he
5a10: 61 64 65 72 29 29 0a 09 09 20 28 6e 20 20 20 30 ader))... (n 0
5a20: 29 29 0a 09 28 69 66 20 28 65 71 75 61 6c 3f 20 ))..(if (equal?
5a30: 68 65 64 20 66 69 65 6c 64 29 0a 09 20 20 20 20 hed field)..
5a40: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 (vector-ref row
5a50: 6e 29 0a 09 20 20 20 20 28 69 66 20 28 6e 75 6c n).. (if (nul
5a60: 6c 3f 20 74 61 6c 29 20 23 66 20 28 6c 6f 6f 70 l? tal) #f (loop
5a70: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
5a80: 61 6c 29 28 2b 20 6e 20 31 29 29 29 29 29 29 29 al)(+ n 1)))))))
5a90: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
5aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 ==========.;; R
5ae0: 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d U N S.;;=======
5af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
5b30: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
5b40: 2d 72 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 -run-name-from-i
5b50: 64 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 d db run-id). (
5b60: 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 let ((res #f)).
5b70: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
5b80: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c each-row. (l
5b90: 61 6d 62 64 61 20 28 72 75 6e 6e 61 6d 65 29 0a ambda (runname).
5ba0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
5bb0: 20 72 75 6e 6e 61 6d 65 29 29 0a 20 20 20 20 20 runname)).
5bc0: 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 db. "SELECT
5bd0: 72 75 6e 6e 61 6d 65 20 46 52 4f 4d 20 72 75 6e runname FROM run
5be0: 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 20 s WHERE id=?;".
5bf0: 20 20 20 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 run-id).
5c00: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 res))..(define (
5c10: 64 62 3a 67 65 74 2d 72 75 6e 2d 6b 65 79 2d 76 db:get-run-key-v
5c20: 61 6c 20 64 62 20 72 75 6e 2d 69 64 20 6b 65 79 al db run-id key
5c30: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 ). (let ((res #
5c40: 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 f)). (sqlite3
5c50: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
5c60: 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 (lambda (val)
5c70: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
5c80: 73 20 76 61 6c 29 29 0a 20 20 20 20 20 64 62 20 s val)). db
5c90: 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c . (conc "SEL
5ca0: 45 43 54 20 22 20 6b 65 79 20 22 20 46 52 4f 4d ECT " key " FROM
5cb0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
5cc0: 3b 22 29 0a 20 20 20 20 20 72 75 6e 2d 69 64 29 ;"). run-id)
5cd0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 6b . res))..;; k
5ce0: 65 79 73 20 6c 69 73 74 20 74 6f 20 6b 65 79 31 eys list to key1
5cf0: 2c 6b 65 79 32 2c 6b 65 79 33 20 2e 2e 2e 0a 28 ,key2,key3 ....(
5d00: 64 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 define (runs:get
5d10: 2d 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 20 -std-run-fields
5d20: 6b 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29 0a keys remfields).
5d30: 20 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 (let* ((header
5d40: 20 20 20 20 28 61 70 70 65 6e 64 20 6b 65 79 73 (append keys
5d50: 20 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28 remfields)).. (
5d60: 6b 65 79 73 74 72 20 20 20 20 28 63 6f 6e 63 20 keystr (conc
5d70: 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 (keys->keystr ke
5d80: 79 73 29 20 22 2c 22 0a 09 09 09 20 20 28 73 74 ys) ",".... (st
5d90: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
5da0: 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 remfields ","))
5db0: 29 29 0a 20 20 20 20 28 6c 69 73 74 20 6b 65 79 )). (list key
5dc0: 73 74 72 20 68 65 61 64 65 72 29 29 29 0a 0a 3b str header)))..;
5dd0: 3b 20 6d 61 6b 65 20 61 20 71 75 65 72 79 20 28 ; make a query (
5de0: 66 69 65 6c 64 6e 61 6d 65 20 6c 69 6b 65 20 27 fieldname like '
5df0: 70 61 74 74 31 27 20 4f 52 20 66 69 65 6c 64 6e patt1' OR fieldn
5e00: 61 6d 65 20 0a 28 64 65 66 69 6e 65 20 28 64 62 ame .(define (db
5e10: 3a 70 61 74 74 2d 3e 6c 69 6b 65 20 66 69 65 6c :patt->like fiel
5e20: 64 6e 61 6d 65 20 70 61 74 74 73 74 72 20 23 21 dname pattstr #!
5e30: 6b 65 79 20 28 63 6f 6d 70 61 72 61 74 6f 72 20 key (comparator
5e40: 22 20 4f 52 20 22 29 29 0a 20 20 28 6c 65 74 20 " OR ")). (let
5e50: 28 28 70 61 74 74 73 20 28 69 66 20 28 73 74 72 ((patts (if (str
5e60: 69 6e 67 3f 20 70 61 74 74 73 74 72 29 0a 09 09 ing? pattstr)...
5e70: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
5e80: 20 70 61 74 74 73 74 72 20 22 2c 22 29 0a 09 09 pattstr ",")...
5e90: 20 20 20 27 28 22 25 22 29 29 29 29 0a 20 20 20 '("%")))).
5ea0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
5eb0: 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 erse (map (lambd
5ec0: 61 20 28 70 61 74 74 29 0a 09 09 09 20 20 20 20 a (patt)....
5ed0: 20 20 20 28 6c 65 74 20 28 28 77 69 6c 64 74 79 (let ((wildty
5ee0: 70 65 20 28 69 66 20 28 73 75 62 73 74 72 69 6e pe (if (substrin
5ef0: 67 2d 69 6e 64 65 78 20 22 25 22 20 70 61 74 74 g-index "%" patt
5f00: 29 20 22 4c 49 4b 45 22 20 22 47 4c 4f 42 22 29 ) "LIKE" "GLOB")
5f10: 29 29 0a 09 09 09 09 20 28 63 6f 6e 63 20 66 69 ))..... (conc fi
5f20: 65 6c 64 6e 61 6d 65 20 22 20 22 20 77 69 6c 64 eldname " " wild
5f30: 74 79 70 65 20 22 20 27 22 20 70 61 74 74 20 22 type " '" patt "
5f40: 27 22 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 '"))).... (i
5f50: 66 20 28 6e 75 6c 6c 3f 20 70 61 74 74 73 29 0a f (null? patts).
5f60: 09 09 09 09 20 27 28 22 22 29 0a 09 09 09 09 20 .... '("").....
5f70: 70 61 74 74 73 29 29 0a 09 09 09 63 6f 6d 70 61 patts))....compa
5f80: 72 61 74 6f 72 29 29 29 0a 0a 0a 3b 3b 20 72 65 rator)))...;; re
5f90: 67 69 73 74 65 72 20 61 20 74 65 73 74 20 72 75 gister a test ru
5fa0: 6e 20 77 69 74 68 20 74 68 65 20 64 62 0a 28 64 n with the db.(d
5fb0: 65 66 69 6e 65 20 28 64 62 3a 72 65 67 69 73 74 efine (db:regist
5fc0: 65 72 2d 72 75 6e 20 64 62 20 6b 65 79 73 20 6b er-run db keys k
5fd0: 65 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 73 eyvals runname s
5fe0: 74 61 74 65 20 73 74 61 74 75 73 20 75 73 65 72 tate status user
5ff0: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
6000: 20 33 20 22 72 75 6e 73 3a 72 65 67 69 73 74 65 3 "runs:registe
6010: 72 2d 72 75 6e 2c 20 6b 65 79 73 3a 20 22 20 6b r-run, keys: " k
6020: 65 79 73 20 22 2c 20 72 75 6e 6e 61 6d 65 3a 20 eys ", runname:
6030: 22 20 72 75 6e 6e 61 6d 65 20 22 20 73 74 61 74 " runname " stat
6040: 65 3a 20 22 20 73 74 61 74 65 20 22 20 73 74 61 e: " state " sta
6050: 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 tus: " status "
6060: 75 73 65 72 3a 20 22 20 75 73 65 72 29 0a 20 20 user: " user).
6070: 28 6c 65 74 2a 20 28 28 6b 65 79 73 74 72 20 20 (let* ((keystr
6080: 20 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 (keys->keystr
6090: 6b 65 79 73 29 29 0a 09 20 28 63 6f 6d 6d 61 20 keys)).. (comma
60a0: 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng
60b0: 74 68 20 6b 65 79 73 29 20 30 29 20 22 2c 22 20 th keys) 0) ","
60c0: 22 22 29 29 0a 09 20 28 61 6e 64 73 74 72 20 20 "")).. (andstr
60d0: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
60e0: 20 6b 65 79 73 29 20 30 29 20 22 20 41 4e 44 20 keys) 0) " AND
60f0: 22 20 22 22 29 29 0a 09 20 28 76 61 6c 73 6c 6f " "")).. (valslo
6100: 74 73 20 20 28 6b 65 79 73 2d 3e 76 61 6c 73 6c ts (keys->valsl
6110: 6f 74 73 20 6b 65 79 73 29 29 20 3b 3b 20 3f 2c ots keys)) ;; ?,
6120: 3f 2c 3f 20 2e 2e 2e 0a 09 20 28 61 6c 6c 76 61 ?,? ..... (allva
6130: 6c 73 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 ls (append (li
6140: 73 74 20 72 75 6e 6e 61 6d 65 20 73 74 61 74 65 st runname state
6150: 20 73 74 61 74 75 73 20 75 73 65 72 29 20 28 6d status user) (m
6160: 61 70 20 63 61 72 20 6b 65 79 76 61 6c 73 29 29 ap car keyvals))
6170: 29 0a 09 20 28 71 72 79 76 61 6c 73 20 20 20 28 ).. (qryvals (
6180: 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 75 6e append (list run
6190: 6e 61 6d 65 29 20 28 6d 61 70 20 63 61 72 20 6b name) (map car k
61a0: 65 79 76 61 6c 73 29 29 29 0a 09 20 28 6b 65 79 eyvals))).. (key
61b0: 3d 3f 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 =?str (string-i
61c0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
61d0: 28 6c 61 6d 62 64 61 20 28 6b 29 28 63 6f 6e 63 (lambda (k)(conc
61e0: 20 6b 20 22 3d 3f 22 29 29 20 6b 65 79 73 29 20 k "=?")) keys)
61f0: 22 20 41 4e 44 20 22 29 29 29 0a 20 20 20 20 28 " AND "))). (
6200: 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 6b debug:print 3 "k
6210: 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 61 6c eys: " keys " al
6220: 6c 76 61 6c 73 3a 20 22 20 61 6c 6c 76 61 6c 73 lvals: " allvals
6230: 20 22 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 " keyvals: " ke
6240: 79 76 61 6c 73 29 0a 20 20 20 20 28 64 65 62 75 yvals). (debu
6250: 67 3a 70 72 69 6e 74 20 32 20 22 4e 4f 54 45 3a g:print 2 "NOTE:
6260: 20 75 73 69 6e 67 20 74 61 72 67 65 74 20 22 20 using target "
6270: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
6280: 72 73 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 rse (map cadr ke
6290: 79 76 61 6c 73 29 20 22 2f 22 29 20 22 20 66 6f yvals) "/") " fo
62a0: 72 20 74 68 69 73 20 72 75 6e 22 29 0a 20 20 20 r this run").
62b0: 20 28 69 66 20 28 61 6e 64 20 72 75 6e 6e 61 6d (if (and runnam
62c0: 65 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 e (null? (filter
62d0: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 (lambda (x)(not
62e0: 20 78 29 29 20 6b 65 79 76 61 6c 73 29 29 29 20 x)) keyvals)))
62f0: 3b 3b 20 74 68 65 72 65 20 6d 75 73 74 20 62 65 ;; there must be
6300: 20 61 20 62 65 74 74 65 72 20 77 61 79 20 74 6f a better way to
6310: 20 22 61 70 70 6c 79 20 61 6e 64 22 0a 09 28 6c "apply and"..(l
6320: 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 09 20 et ((res #f))..
6330: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
6340: 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 execute db (conc
6350: 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f "INSERT OR IGNO
6360: 52 45 20 49 4e 54 4f 20 72 75 6e 73 20 28 72 75 RE INTO runs (ru
6370: 6e 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 nname,state,stat
6380: 75 73 2c 6f 77 6e 65 72 2c 65 76 65 6e 74 5f 74 us,owner,event_t
6390: 69 6d 65 22 20 63 6f 6d 6d 61 20 6b 65 79 73 74 ime" comma keyst
63a0: 72 20 22 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f r ") VALUES (?,?
63b0: 2c 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 27 25 ,?,?,strftime('%
63c0: 73 27 2c 27 6e 6f 77 27 29 22 20 63 6f 6d 6d 61 s','now')" comma
63d0: 20 76 61 6c 73 6c 6f 74 73 20 22 29 3b 22 29 0a valslots ");").
63e0: 09 09 20 61 6c 6c 76 61 6c 73 29 0a 09 20 20 28 .. allvals).. (
63f0: 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f apply sqlite3:fo
6400: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 20 r-each-row ..
6410: 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 20 20 (lambda (id)..
6420: 20 20 20 28 73 65 74 21 20 72 65 73 20 69 64 29 (set! res id)
6430: 29 0a 09 20 20 20 64 62 0a 09 20 20 20 28 6c 65 ).. db.. (le
6440: 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 53 t ((qry (conc "S
6450: 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 72 75 ELECT id FROM ru
6460: 6e 73 20 57 48 45 52 45 20 28 72 75 6e 6e 61 6d ns WHERE (runnam
6470: 65 3d 3f 20 22 20 61 6e 64 73 74 72 20 6b 65 79 e=? " andstr key
6480: 3d 3f 73 74 72 20 22 29 3b 22 29 29 29 0a 09 20 =?str ");")))..
6490: 20 20 20 20 3b 28 64 65 62 75 67 3a 70 72 69 6e ;(debug:prin
64a0: 74 20 34 20 22 71 72 79 3a 20 22 20 71 72 79 29 t 4 "qry: " qry)
64b0: 20 0a 09 20 20 20 20 20 71 72 79 29 0a 09 20 20 .. qry)..
64c0: 20 71 72 79 76 61 6c 73 29 0a 09 20 20 28 73 71 qryvals).. (sq
64d0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
64e0: 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 "UPDATE runs SE
64f0: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 T state=?,status
6500: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 =? WHERE id=?;"
6510: 73 74 61 74 65 20 73 74 61 74 75 73 20 72 65 73 state status res
6520: 29 0a 09 20 20 72 65 73 29 20 0a 09 28 62 65 67 ).. res) ..(beg
6530: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
6540: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 43 61 6c nt 0 "ERROR: Cal
6550: 6c 65 64 20 77 69 74 68 6f 75 74 20 61 6c 6c 20 led without all
6560: 6e 65 63 65 73 73 61 72 79 20 6b 65 79 73 22 29 necessary keys")
6570: 0a 09 20 20 23 66 29 29 29 29 0a 0a 0a 3b 3b 20 .. #f))))...;;
6580: 72 65 70 6c 61 63 65 20 68 65 61 64 65 72 20 61 replace header a
6590: 6e 64 20 6b 65 79 73 74 72 20 77 69 74 68 20 61 nd keystr with a
65a0: 20 63 61 6c 6c 20 74 6f 20 72 75 6e 73 3a 67 65 call to runs:ge
65b0: 74 2d 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 t-std-run-fields
65c0: 0a 3b 3b 0a 3b 3b 20 6b 65 79 70 61 74 74 73 3a .;;.;; keypatts:
65d0: 20 28 20 28 4b 45 59 31 20 22 61 62 63 25 64 65 ( (KEY1 "abc%de
65e0: 66 22 29 28 4b 45 59 32 20 22 25 22 29 20 29 0a f")(KEY2 "%") ).
65f0: 3b 3b 20 72 75 6e 70 61 74 74 73 3a 20 70 61 74 ;; runpatts: pat
6600: 74 31 2c 70 61 74 74 32 20 2e 2e 2e 0a 3b 3b 0a t1,patt2 ....;;.
6610: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
6620: 72 75 6e 73 20 64 62 20 72 75 6e 70 61 74 74 20 runs db runpatt
6630: 63 6f 75 6e 74 20 6f 66 66 73 65 74 20 6b 65 79 count offset key
6640: 70 61 74 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 patts). (let* (
6650: 28 72 65 73 20 20 20 20 20 20 20 27 28 29 29 0a (res '()).
6660: 09 20 28 6b 65 79 73 20 20 20 20 20 20 20 28 64 . (keys (d
6670: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a b:get-keys db)).
6680: 09 20 28 72 75 6e 70 61 74 74 73 74 72 20 28 64 . (runpattstr (d
6690: 62 3a 70 61 74 74 2d 3e 6c 69 6b 65 20 22 72 75 b:patt->like "ru
66a0: 6e 6e 61 6d 65 22 20 72 75 6e 70 61 74 74 29 29 nname" runpatt))
66b0: 0a 09 20 28 72 65 6d 66 69 65 6c 64 73 20 20 28 .. (remfields (
66c0: 6c 69 73 74 20 22 69 64 22 20 22 72 75 6e 6e 61 list "id" "runna
66d0: 6d 65 22 20 22 73 74 61 74 65 22 20 22 73 74 61 me" "state" "sta
66e0: 74 75 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 tus" "owner" "ev
66f0: 65 6e 74 5f 74 69 6d 65 22 29 29 0a 09 20 28 68 ent_time")).. (h
6700: 65 61 64 65 72 20 20 20 20 20 28 61 70 70 65 6e eader (appen
6710: 64 20 6b 65 79 73 20 72 65 6d 66 69 65 6c 64 73 d keys remfields
6720: 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 20 20 )).. (keystr
6730: 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 (conc (keys->ke
6740: 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 ystr keys) ","..
6750: 09 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 . (str
6760: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
6770: 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 remfields ",")))
6780: 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 20 28 .. (qrystr (
6790: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b conc "SELECT " k
67a0: 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e eystr " FROM run
67b0: 73 20 57 48 45 52 45 20 28 22 20 72 75 6e 70 61 s WHERE (" runpa
67c0: 74 74 73 74 72 20 22 29 20 22 20 3b 3b 20 72 75 ttstr ") " ;; ru
67d0: 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 22 0a 09 nname LIKE ? "..
67e0: 09 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 47 . ;; G
67f0: 65 6e 65 72 61 74 65 3a 20 22 20 41 4e 44 20 78 enerate: " AND x
6800: 20 4c 49 4b 45 20 27 6b 65 79 70 61 74 74 27 20 LIKE 'keypatt'
6810: 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 20 20 20 ..."...
6820: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6b 65 79 (if (null? key
6830: 70 61 74 74 73 29 20 22 22 0a 09 09 20 20 20 20 patts) ""...
6840: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
6850: 20 22 20 41 4e 44 20 22 0a 09 09 09 09 20 20 20 " AND ".....
6860: 20 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e 20 0a (string-join .
6870: 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 20 28 .... (map (
6880: 6c 61 6d 62 64 61 20 28 6b 65 79 70 61 74 74 29 lambda (keypatt)
6890: 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let
68a0: 28 28 6b 65 79 20 20 28 63 61 72 20 6b 65 79 70 ((key (car keyp
68b0: 61 74 74 29 29 0a 09 09 09 09 09 09 20 20 20 28 att))....... (
68c0: 70 61 74 74 20 28 63 61 64 72 20 6b 65 79 70 61 patt (cadr keypa
68d0: 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 tt)))......
68e0: 20 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 6b 65 (db:patt->like
68f0: 20 6b 65 79 20 70 61 74 74 29 29 29 0a 09 09 09 key patt)))....
6900: 09 09 20 20 20 6b 65 79 70 61 74 74 73 29 0a 09 .. keypatts)..
6910: 09 09 09 20 20 20 20 20 20 22 20 41 4e 44 20 22 ... " AND "
6920: 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 20 20 )))...
6930: 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e " ORDER BY even
6940: 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a 09 09 t_time DESC "...
6950: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
6960: 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 0a 09 number? count)..
6970: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6980: 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 22 20 (conc " LIMIT "
6990: 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 20 20 count)...
69a0: 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 20 20 "")...
69b0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
69c0: 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a 09 09 mber? offset)...
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
69e0: 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 22 20 conc " OFFSET "
69f0: 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 20 20 offset)...
6a00: 20 20 20 20 20 20 20 20 20 22 22 29 29 29 29 0a "")))).
6a10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6a20: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6a30: 2d 72 75 6e 73 20 53 54 41 52 54 20 71 72 79 73 -runs START qrys
6a40: 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 20 6b tr: " qrystr " k
6a50: 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 70 61 eypatts: " keypa
6a60: 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 22 20 tts " offset: "
6a70: 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 3a 20 offset " limit:
6a80: 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 73 71 " count). (sq
6a90: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
6aa0: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
6ab0: 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 20 28 (a . x). (
6ac0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 set! res (cons (
6ad0: 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 78 apply vector a x
6ae0: 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 ) res))). db
6af0: 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 20 20 . qrystr.
6b00: 20 20 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
6b10: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 rint-info 11 "db
6b20: 3a 67 65 74 2d 72 75 6e 73 20 45 4e 44 20 71 72 :get-runs END qr
6b30: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
6b40: 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 keypatts: " key
6b50: 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 patts " offset:
6b60: 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 " offset " limit
6b70: 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 : " count). (
6b80: 76 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 65 vector header re
6b90: 73 29 29 29 0a 0a 3b 3b 20 6a 75 73 74 20 67 65 s)))..;; just ge
6ba0: 74 20 63 6f 75 6e 74 20 6f 66 20 72 75 6e 73 0a t count of runs.
6bb0: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
6bc0: 6e 75 6d 2d 72 75 6e 73 20 64 62 20 72 75 6e 70 num-runs db runp
6bd0: 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 6e 75 att). (let ((nu
6be0: 6d 72 75 6e 73 20 30 29 29 0a 20 20 20 20 28 64 mruns 0)). (d
6bf0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
6c00: 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 11 "db:get-num-r
6c10: 75 6e 73 20 53 54 41 52 54 20 22 20 72 75 6e 70 uns START " runp
6c20: 61 74 74 29 0a 20 20 20 20 28 73 71 6c 69 74 65 att). (sqlite
6c30: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
6c40: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f (lambda (co
6c50: 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 unt). (set
6c60: 21 20 6e 75 6d 72 75 6e 73 20 63 6f 75 6e 74 29 ! numruns count)
6c70: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 ). db. "
6c80: 53 45 4c 45 43 54 20 43 4f 55 4e 54 28 69 64 29 SELECT COUNT(id)
6c90: 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 FROM runs WHERE
6ca0: 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 3b runname LIKE ?;
6cb0: 22 20 72 75 6e 70 61 74 74 29 0a 20 20 20 20 28 " runpatt). (
6cc0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
6cd0: 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d 2d 11 "db:get-num-
6ce0: 72 75 6e 73 20 45 4e 44 20 22 20 72 75 6e 70 61 runs END " runpa
6cf0: 74 74 29 0a 20 20 20 20 6e 75 6d 72 75 6e 73 29 tt). numruns)
6d00: 29 0a 0a 3b 3b 20 75 73 65 20 28 67 65 74 2d 76 )..;; use (get-v
6d10: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 alue-by-header (
6d20: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
6d30: 6e 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d 72 6f ninfo)(db:get-ro
6d40: 77 20 72 75 6e 69 6e 66 6f 29 29 0a 28 64 65 66 w runinfo)).(def
6d50: 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d ine (db:get-run-
6d60: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 29 0a info db run-id).
6d70: 20 20 3b 3b 28 69 66 20 28 68 61 73 68 2d 74 61 ;;(if (hash-ta
6d80: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
6d90: 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 65 2a *run-info-cache*
6da0: 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 20 3b 3b run-id #f). ;;
6db0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
6dc0: 72 65 66 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 ref *run-info-ca
6dd0: 63 68 65 2a 20 72 75 6e 2d 69 64 29 0a 20 20 20 che* run-id).
6de0: 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 (let* ((res
6df0: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 28 6b #f).. (k
6e00: 65 79 73 20 20 20 20 20 20 28 64 62 3a 67 65 74 eys (db:get
6e10: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20 20 -keys db))..
6e20: 20 28 72 65 6d 66 69 65 6c 64 73 20 28 6c 69 73 (remfields (lis
6e30: 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 t "id" "runname"
6e40: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
6e50: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
6e60: 5f 74 69 6d 65 22 29 29 0a 09 20 20 20 20 20 28 _time")).. (
6e70: 68 65 61 64 65 72 20 20 20 20 28 61 70 70 65 6e header (appen
6e80: 64 20 6b 65 79 73 20 72 65 6d 66 69 65 6c 64 73 d keys remfields
6e90: 29 29 0a 09 20 20 20 20 20 28 6b 65 79 73 74 72 )).. (keystr
6ea0: 20 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d (conc (keys-
6eb0: 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c >keystr keys) ",
6ec0: 22 0a 09 09 09 20 20 20 20 20 20 28 73 74 72 69 ".... (stri
6ed0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 ng-intersperse r
6ee0: 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 29 emfields ","))))
6ef0: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
6f00: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 72 nfo 11 "db:get-r
6f10: 75 6e 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20 un-info run-id:
6f20: 22 20 72 75 6e 2d 69 64 20 22 20 68 65 61 64 65 " run-id " heade
6f30: 72 3a 20 22 20 68 65 61 64 65 72 20 22 20 6b 65 r: " header " ke
6f40: 79 73 74 72 3a 20 22 20 6b 65 79 73 74 72 29 0a ystr: " keystr).
6f50: 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 .(sqlite3:for-ea
6f60: 63 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 61 ch-row.. (lambda
6f70: 20 28 61 20 2e 20 78 29 0a 09 20 20 20 28 73 65 (a . x).. (se
6f80: 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 76 65 t! res (apply ve
6f90: 63 74 6f 72 20 61 20 78 29 29 29 0a 09 20 64 62 ctor a x))).. db
6fa0: 0a 09 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 .. (conc "SELECT
6fb0: 20 22 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d " keystr " FROM
6fc0: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
6fd0: 3b 22 29 0a 09 20 72 75 6e 2d 69 64 29 0a 09 28 ;").. run-id)..(
6fe0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
6ff0: 20 31 31 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d 11 "db:get-run-
7000: 69 6e 66 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72 info run-id: " r
7010: 75 6e 2d 69 64 20 22 20 68 65 61 64 65 72 3a 20 un-id " header:
7020: 22 20 68 65 61 64 65 72 20 22 20 6b 65 79 73 74 " header " keyst
7030: 72 3a 20 22 20 6b 65 79 73 74 72 29 0a 09 28 6c r: " keystr)..(l
7040: 65 74 20 28 28 66 69 6e 61 6c 72 65 73 20 28 76 et ((finalres (v
7050: 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 65 73 ector header res
7060: 29 29 29 0a 09 20 20 3b 3b 20 28 68 61 73 68 2d ))).. ;; (hash-
7070: 74 61 62 6c 65 2d 73 65 74 21 20 2a 72 75 6e 2d table-set! *run-
7080: 69 6e 66 6f 2d 63 61 63 68 65 2a 20 72 75 6e 2d info-cache* run-
7090: 69 64 20 66 69 6e 61 6c 72 65 73 29 0a 09 20 20 id finalres)..
70a0: 66 69 6e 61 6c 72 65 73 29 29 29 0a 0a 28 64 65 finalres)))..(de
70b0: 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 63 6f 6d fine (db:set-com
70c0: 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 64 62 20 ment-for-run db
70d0: 72 75 6e 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a run-id comment).
70e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
70f0: 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d 63 nfo 11 "db:set-c
7100: 6f 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 53 omment-for-run S
7110: 54 41 52 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 TART run-id: " r
7120: 75 6e 2d 69 64 20 22 20 63 6f 6d 6d 65 6e 74 3a un-id " comment:
7130: 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73 " comment). (s
7140: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
7150: 62 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 b "UPDATE runs S
7160: 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 ET comment=? WHE
7170: 52 45 20 69 64 3d 3f 3b 22 20 63 6f 6d 6d 65 6e RE id=?;" commen
7180: 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65 62 t run-id). (deb
7190: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
71a0: 20 22 64 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 "db:set-comment
71b0: 2d 66 6f 72 2d 72 75 6e 20 45 4e 44 20 72 75 6e -for-run END run
71c0: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 -id: " run-id "
71d0: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
71e0: 6e 74 29 29 0a 0a 3b 3b 20 64 6f 65 73 20 6e 6f nt))..;; does no
71f0: 74 20 28 6f 62 76 69 6f 75 73 6c 79 21 29 20 72 t (obviously!) r
7200: 65 6d 6f 76 65 64 20 64 65 70 65 6e 64 65 6e 74 emoved dependent
7210: 20 64 61 74 61 2e 20 42 75 74 20 77 68 79 20 6e data. But why n
7220: 6f 74 21 21 3f 0a 28 64 65 66 69 6e 65 20 28 64 ot!!?.(define (d
7230: 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 64 62 20 b:delete-run db
7240: 72 75 6e 2d 69 64 29 0a 20 20 28 63 6f 6d 6d 6f run-id). (commo
7250: 6e 3a 63 6c 65 61 72 2d 63 61 63 68 65 73 29 20 n:clear-caches)
7260: 3b 3b 20 64 6f 6e 27 74 20 74 72 75 73 74 20 63 ;; don't trust c
7270: 61 63 68 65 73 20 61 66 74 65 72 20 64 6f 69 6e aches after doin
7280: 67 20 61 6e 79 20 64 65 6c 65 74 69 6f 6e 0a 20 g any deletion.
7290: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
72a0: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f e db "DELETE FRO
72b0: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d M runs WHERE id=
72c0: 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64 ?;" run-id))..(d
72d0: 65 66 69 6e 65 20 28 64 62 3a 75 70 64 61 74 65 efine (db:update
72e0: 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -run-event_time
72f0: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 65 db run-id). (de
7300: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
7310: 31 20 22 64 62 3a 75 70 64 61 74 65 2d 72 75 6e 1 "db:update-run
7320: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 53 54 41 52 -event_time STAR
7330: 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d T run-id: " run-
7340: 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 id). (sqlite3:e
7350: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
7360: 45 20 72 75 6e 73 20 53 45 54 20 65 76 65 6e 74 E runs SET event
7370: 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 27 _time=strftime('
7380: 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 %s','now') WHERE
7390: 20 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 0a id=?;" run-id).
73a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
73b0: 6e 66 6f 20 31 31 20 22 64 62 3a 75 70 64 61 74 nfo 11 "db:updat
73c0: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
73d0: 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 72 END run-id: " r
73e0: 75 6e 2d 69 64 29 29 20 0a 0a 28 64 65 66 69 6e un-id)) ..(defin
73f0: 65 20 28 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 e (db:lock/unloc
7400: 6b 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 k-run db run-id
7410: 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 lock unlock user
7420: 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 6c 6f ). (let ((newlo
7430: 63 6b 76 61 6c 20 28 69 66 20 6c 6f 63 6b 20 22 ckval (if lock "
7440: 6c 6f 63 6b 65 64 22 0a 09 09 09 28 69 66 20 75 locked"....(if u
7450: 6e 6c 6f 63 6b 0a 09 09 09 20 20 20 20 22 75 6e nlock.... "un
7460: 6c 6f 63 6b 65 64 22 0a 09 09 09 20 20 20 20 22 locked".... "
7470: 6c 6f 63 6b 65 64 22 29 29 29 29 20 3b 3b 20 73 locked")))) ;; s
7480: 65 6d 69 2d 66 61 69 6c 73 61 66 65 0a 20 20 20 emi-failsafe.
7490: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
74a0: 65 20 64 62 20 22 55 50 44 41 54 45 20 72 75 6e e db "UPDATE run
74b0: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 s SET state=? WH
74c0: 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c 6f ERE id=?;" newlo
74d0: 63 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20 ckval run-id).
74e0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
74f0: 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e te db "INSERT IN
7500: 54 4f 20 61 63 63 65 73 73 5f 6c 6f 67 20 28 75 TO access_log (u
7510: 73 65 72 2c 61 63 63 65 73 73 65 64 2c 61 72 67 ser,accessed,arg
7520: 73 29 20 56 41 4c 55 45 53 28 3f 2c 73 74 72 66 s) VALUES(?,strf
7530: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
7540: 2c 3f 29 3b 22 0a 09 09 20 20 20 20 20 75 73 65 ,?);"... use
7550: 72 20 28 63 6f 6e 63 20 6e 65 77 6c 6f 63 6b 76 r (conc newlockv
7560: 61 6c 20 22 20 22 20 72 75 6e 2d 69 64 29 29 0a al " " run-id)).
7570: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7580: 2d 69 6e 66 6f 20 31 20 22 22 20 6e 65 77 6c 6f -info 1 "" newlo
7590: 63 6b 76 61 6c 20 22 20 72 75 6e 20 6e 75 6d 62 ckval " run numb
75a0: 65 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a 0a er " run-id)))..
75b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
75c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
75f0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 20 ========.;; K E
7600: 59 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d Y S.;;==========
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
7650: 20 67 65 74 20 6b 65 79 20 76 61 6c 20 70 61 69 get key val pai
7660: 72 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 72 rs for a given r
7670: 75 6e 2d 69 64 0a 3b 3b 20 28 20 28 46 49 45 4c un-id.;; ( (FIEL
7680: 44 4e 41 4d 45 31 20 6b 65 79 76 61 6c 31 29 20 DNAME1 keyval1)
7690: 28 46 49 45 4c 44 4e 41 4d 45 32 20 6b 65 79 76 (FIELDNAME2 keyv
76a0: 61 6c 32 29 20 2e 2e 2e 20 29 0a 28 64 65 66 69 al2) ... ).(defi
76b0: 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 ne (db:get-key-v
76c0: 61 6c 2d 70 61 69 72 73 20 64 62 20 72 75 6e 2d al-pairs db run-
76d0: 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 id). (let* ((ke
76e0: 79 73 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 ys (db:get-keys
76f0: 64 62 29 29 0a 09 20 28 72 65 73 20 20 27 28 29 db)).. (res '()
7700: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
7710: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
7720: 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 get-key-val-pair
7730: 73 20 53 54 41 52 54 20 6b 65 79 73 3a 20 22 20 s START keys: "
7740: 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 keys " run-id: "
7750: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 66 6f run-id). (fo
7760: 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 r-each . (la
7770: 6d 62 64 61 20 28 6b 65 79 29 0a 20 20 20 20 20 mbda (key).
7780: 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f (let ((qry (co
7790: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 28 63 61 nc "SELECT " (ca
77a0: 72 20 6b 65 79 29 20 22 20 46 52 4f 4d 20 72 75 r key) " FROM ru
77b0: 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 ns WHERE id=?;")
77c0: 29 29 0a 09 20 3b 3b 20 28 64 65 62 75 67 3a 70 )).. ;; (debug:p
77d0: 72 69 6e 74 20 30 20 22 71 72 79 3a 20 22 20 71 rint 0 "qry: " q
77e0: 72 79 29 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 ry).. (sqlite3:f
77f0: 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 or-each-row ..
7800: 28 6c 61 6d 62 64 61 20 28 6b 65 79 2d 76 61 6c (lambda (key-val
7810: 29 0a 09 20 20 20 20 28 73 65 74 21 20 72 65 73 ).. (set! res
7820: 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 28 63 61 (cons (list (ca
7830: 72 20 6b 65 79 29 20 6b 65 79 2d 76 61 6c 29 20 r key) key-val)
7840: 72 65 73 29 29 29 0a 09 20 20 64 62 20 71 72 79 res))).. db qry
7850: 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 20 run-id))).
7860: 6b 65 79 73 29 0a 20 20 20 20 28 64 65 62 75 67 keys). (debug
7870: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
7880: 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d 70 db:get-key-val-p
7890: 61 69 72 73 20 45 4e 44 20 6b 65 79 73 3a 20 22 airs END keys: "
78a0: 20 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 keys " run-id:
78b0: 22 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 72 " run-id). (r
78c0: 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 0a 3b everse res)))..;
78d0: 3b 20 67 65 74 20 6b 65 79 20 76 61 6c 73 20 66 ; get key vals f
78e0: 6f 72 20 61 20 67 69 76 65 6e 20 72 75 6e 2d 69 or a given run-i
78f0: 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 d.(define (db:ge
7900: 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 75 t-key-vals db ru
7910: 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 6d n-id). (let ((m
7920: 79 6b 65 79 76 61 6c 73 20 28 68 61 73 68 2d 74 ykeyvals (hash-t
7930: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
7940: 20 2a 6b 65 79 76 61 6c 73 2a 20 72 75 6e 2d 69 *keyvals* run-i
7950: 64 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 d #f))). (if
7960: 6d 79 6b 65 79 76 61 6c 73 20 0a 09 6d 79 6b 65 mykeyvals ..myke
7970: 79 76 61 6c 73 0a 09 28 6c 65 74 2a 20 28 28 6b yvals..(let* ((k
7980: 65 79 73 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 eys (db:get-keys
7990: 20 64 62 29 29 0a 09 20 20 20 20 20 20 20 28 72 db)).. (r
79a0: 65 73 20 20 27 28 29 29 29 0a 09 20 20 28 64 65 es '())).. (de
79b0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
79c0: 31 20 22 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 1 "db:get-key-va
79d0: 6c 73 20 53 54 41 52 54 20 6b 65 79 73 3a 20 22 ls START keys: "
79e0: 20 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 keys " run-id:
79f0: 22 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 66 6f " run-id).. (fo
7a00: 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d r-each .. (lam
7a10: 62 64 61 20 28 6b 65 79 29 0a 09 20 20 20 20 20 bda (key)..
7a20: 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 (let ((qry (conc
7a30: 20 22 53 45 4c 45 43 54 20 22 20 28 63 61 72 20 "SELECT " (car
7a40: 6b 65 79 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 key) " FROM runs
7a50: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 WHERE id=?;")))
7a60: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 64 65 62 .. ;; (deb
7a70: 75 67 3a 70 72 69 6e 74 20 30 20 22 71 72 79 3a ug:print 0 "qry:
7a80: 20 22 20 71 72 79 29 0a 09 20 20 20 20 20 20 20 " qry)..
7a90: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
7aa0: 68 2d 72 6f 77 20 0a 09 09 28 6c 61 6d 62 64 61 h-row ...(lambda
7ab0: 20 28 6b 65 79 2d 76 61 6c 29 0a 09 09 20 20 28 (key-val)... (
7ac0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 6b set! res (cons k
7ad0: 65 79 2d 76 61 6c 20 72 65 73 29 29 29 0a 09 09 ey-val res)))...
7ae0: 64 62 20 71 72 79 20 72 75 6e 2d 69 64 29 29 29 db qry run-id)))
7af0: 0a 09 20 20 20 6b 65 79 73 29 0a 09 20 20 28 64 .. keys).. (d
7b00: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7b10: 31 31 20 22 64 62 3a 67 65 74 2d 6b 65 79 2d 76 11 "db:get-key-v
7b20: 61 6c 73 20 45 4e 44 20 6b 65 79 73 3a 20 22 20 als END keys: "
7b30: 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 keys " run-id: "
7b40: 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 6c 65 74 run-id).. (let
7b50: 20 28 28 66 69 6e 61 6c 2d 72 65 73 20 28 72 65 ((final-res (re
7b60: 76 65 72 73 65 20 72 65 73 29 29 29 0a 09 20 20 verse res)))..
7b70: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
7b80: 74 21 20 2a 6b 65 79 76 61 6c 73 2a 20 72 75 6e t! *keyvals* run
7b90: 2d 69 64 20 66 69 6e 61 6c 2d 72 65 73 29 0a 09 -id final-res)..
7ba0: 20 20 20 20 66 69 6e 61 6c 2d 72 65 73 29 29 29 final-res)))
7bb0: 29 29 0a 0a 3b 3b 20 54 68 65 20 74 61 72 67 65 ))..;; The targe
7bc0: 74 20 69 73 20 6b 65 79 76 61 6c 31 2f 6b 65 79 t is keyval1/key
7bd0: 76 61 6c 32 2e 2e 2e 2c 20 63 61 63 68 65 64 20 val2..., cached
7be0: 69 6e 20 2a 74 61 72 67 65 74 2a 20 61 73 20 69 in *target* as i
7bf0: 74 20 69 73 20 75 73 65 64 20 6f 66 74 65 6e 0a t is used often.
7c00: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
7c10: 74 61 72 67 65 74 20 64 62 20 72 75 6e 2d 69 64 target db run-id
7c20: 29 0a 20 20 28 6c 65 74 20 28 28 6d 79 74 61 72 ). (let ((mytar
7c30: 67 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 g (hash-table-re
7c40: 66 2f 64 65 66 61 75 6c 74 20 2a 74 61 72 67 65 f/default *targe
7c50: 74 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 29 0a t* run-id #f))).
7c60: 20 20 20 20 28 69 66 20 6d 79 74 61 72 67 0a 09 (if mytarg..
7c70: 6d 79 74 61 72 67 0a 09 28 6c 65 74 2a 20 28 28 mytarg..(let* ((
7c80: 6b 65 79 76 61 6c 73 20 28 64 62 3a 67 65 74 2d keyvals (db:get-
7c90: 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 75 6e 2d key-vals db run-
7ca0: 69 64 29 29 0a 09 20 20 20 20 20 20 20 28 74 68 id)).. (th
7cb0: 65 6b 65 79 20 20 28 73 74 72 69 6e 67 2d 69 6e ekey (string-in
7cc0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 tersperse (map (
7cd0: 6c 61 6d 62 64 61 20 28 78 29 28 69 66 20 78 20 lambda (x)(if x
7ce0: 78 20 22 2d 6e 61 2d 22 29 29 20 6b 65 79 76 61 x "-na-")) keyva
7cf0: 6c 73 29 20 22 2f 22 29 29 29 0a 09 20 20 28 68 ls) "/"))).. (h
7d00: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
7d10: 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 64 20 74 target* run-id t
7d20: 68 65 6b 65 79 29 0a 09 20 20 74 68 65 6b 65 79 hekey).. thekey
7d30: 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ))))..;;========
7d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
7d80: 3b 20 20 54 20 45 20 53 20 54 20 53 0a 3b 3b 3d ; T E S T S.;;=
7d90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7da0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7db0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7dc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7dd0: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 74 61 74 65 73 =====..;; states
7de0: 20 61 6e 64 20 73 74 61 74 75 73 65 73 20 61 72 and statuses ar
7df0: 65 20 6c 69 73 74 73 2c 20 74 75 72 6e 20 74 68 e lists, turn th
7e00: 65 6d 20 69 6e 74 6f 20 28 22 50 41 53 53 22 2c em into ("PASS",
7e10: 22 46 41 49 4c 22 2e 2e 2e 29 20 61 6e 64 20 75 "FAIL"...) and u
7e20: 73 65 20 4e 4f 54 20 49 4e 0a 3b 3b 20 69 2e 65 se NOT IN.;; i.e
7e30: 2e 20 74 68 65 73 65 20 6c 69 73 74 73 20 64 65 . these lists de
7e40: 66 69 6e 65 20 77 68 61 74 20 74 6f 20 4e 4f 54 fine what to NOT
7e50: 20 73 68 6f 77 2e 0a 3b 3b 20 73 74 61 74 65 73 show..;; states
7e60: 20 61 6e 64 20 73 74 61 74 75 73 65 73 20 61 72 and statuses ar
7e70: 65 20 72 65 71 75 69 72 65 64 20 74 6f 20 62 65 e required to be
7e80: 20 6c 69 73 74 73 2c 20 65 6d 70 74 79 20 69 73 lists, empty is
7e90: 20 6f 6b 0a 3b 3b 20 6e 6f 74 2d 69 6e 20 23 74 ok.;; not-in #t
7ea0: 20 3d 20 61 62 6f 76 65 20 62 65 68 61 76 69 6f = above behavio
7eb0: 75 72 2c 20 23 66 20 3d 20 6d 75 73 74 20 6d 61 ur, #f = must ma
7ec0: 74 63 68 0a 28 64 65 66 69 6e 65 20 28 64 62 3a tch.(define (db:
7ed0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
7ee0: 6e 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 n db run-id test
7ef0: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
7f00: 75 73 65 73 20 0a 09 09 09 20 20 20 20 20 20 23 uses .... #
7f10: 21 6b 65 79 20 28 6e 6f 74 2d 69 6e 20 23 74 29 !key (not-in #t)
7f20: 0a 09 09 09 20 20 20 20 20 20 28 73 6f 72 74 2d .... (sort-
7f30: 62 79 20 23 66 29 20 3b 3b 20 27 72 75 6e 64 69 by #f) ;; 'rundi
7f40: 72 20 27 65 76 65 6e 74 5f 74 69 6d 65 0a 09 09 r 'event_time...
7f50: 09 20 20 20 20 20 20 28 71 72 79 76 61 6c 73 20 . (qryvals
7f60: 22 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e "id,run_id,testn
7f70: 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 ame,state,status
7f80: 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 ,event_time,host
7f90: 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 ,cpuload,diskfre
7fa0: 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 e,uname,rundir,i
7fb0: 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 tem_path,run_dur
7fc0: 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 ation,final_logf
7fd0: 2c 63 6f 6d 6d 65 6e 74 22 29 0a 09 09 09 20 20 ,comment")....
7fe0: 20 20 20 20 29 0a 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7ff0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 rint-info 11 "db
8000: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
8010: 75 6e 20 53 54 41 52 54 20 72 75 6e 2d 69 64 3d un START run-id=
8020: 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 " run-id ", test
8030: 70 61 74 74 3d 22 20 74 65 73 74 70 61 74 74 20 patt=" testpatt
8040: 22 2c 20 73 74 61 74 65 73 3d 22 20 73 74 61 74 ", states=" stat
8050: 65 73 20 22 2c 20 73 74 61 74 75 73 65 73 3d 22 es ", statuses="
8060: 20 73 74 61 74 75 73 65 73 20 22 2c 20 6e 6f 74 statuses ", not
8070: 2d 69 6e 3d 22 20 6e 6f 74 2d 69 6e 20 22 2c 20 -in=" not-in ",
8080: 73 6f 72 74 2d 62 79 3d 22 20 73 6f 72 74 2d 62 sort-by=" sort-b
8090: 79 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 y). (let* ((res
80a0: 20 27 28 29 29 0a 09 20 3b 3b 20 69 66 20 73 74 '()).. ;; if st
80b0: 61 74 65 73 20 6f 72 20 73 74 61 74 75 73 65 73 ates or statuses
80c0: 20 61 72 65 20 6e 75 6c 6c 20 74 68 65 6e 20 61 are null then a
80d0: 73 73 75 6d 65 20 6d 61 74 63 68 20 61 6c 6c 20 ssume match all
80e0: 77 68 65 6e 20 6e 6f 74 2d 69 6e 20 69 73 20 66 when not-in is f
80f0: 61 6c 73 65 0a 09 20 28 73 74 61 74 65 73 2d 71 alse.. (states-q
8100: 72 79 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c ry (if (nul
8110: 6c 3f 20 73 74 61 74 65 73 29 20 0a 09 09 09 20 l? states) ....
8120: 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 #f....
8130: 20 28 63 6f 6e 63 20 22 20 73 74 61 74 65 20 22 (conc " state "
8140: 20 20 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e ..... (if n
8150: 6f 74 2d 69 6e 20 22 4e 4f 54 22 20 22 22 29 20 ot-in "NOT" "")
8160: 0a 09 09 09 09 20 20 20 20 22 20 49 4e 20 28 27 ..... " IN ('
8170: 22 20 0a 09 09 09 09 20 20 20 20 28 73 74 72 69 " ..... (stri
8180: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 ng-intersperse s
8190: 74 61 74 65 73 20 20 20 22 27 2c 27 22 29 0a 09 tates "','")..
81a0: 09 09 09 20 20 20 20 22 27 29 22 29 29 29 0a 09 ... "')")))..
81b0: 20 28 73 74 61 74 75 73 65 73 2d 71 72 79 20 20 (statuses-qry
81c0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 (if (null? sta
81d0: 74 75 73 65 73 29 0a 09 09 09 20 20 20 20 20 20 tuses)....
81e0: 23 66 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e #f.... (con
81f0: 63 20 22 20 73 74 61 74 75 73 20 22 0a 09 09 09 c " status "....
8200: 09 20 20 20 20 28 69 66 20 6e 6f 74 2d 69 6e 20 . (if not-in
8210: 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 09 09 20 "NOT" "") .....
8220: 20 20 20 22 20 49 4e 20 28 27 22 20 0a 09 09 09 " IN ('" ....
8230: 09 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 . (string-int
8240: 65 72 73 70 65 72 73 65 20 73 74 61 74 75 73 65 ersperse statuse
8250: 73 20 22 27 2c 27 22 29 0a 09 09 09 09 20 20 20 s "','").....
8260: 20 22 27 29 22 29 29 29 0a 09 20 28 74 65 73 74 "')"))).. (test
8270: 73 2d 6d 61 74 63 68 2d 71 72 79 20 28 74 65 73 s-match-qry (tes
8280: 74 73 3a 6d 61 74 63 68 2d 3e 73 71 6c 71 72 79 ts:match->sqlqry
8290: 20 74 65 73 74 70 61 74 74 29 29 0a 09 20 28 71 testpatt)).. (q
82a0: 72 79 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ry (
82b0: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 71 conc "SELECT " q
82c0: 72 79 76 61 6c 73 0a 09 09 09 09 22 20 46 52 4f ryvals....." FRO
82d0: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 M tests WHERE ru
82e0: 6e 5f 69 64 3d 3f 20 22 0a 09 09 09 09 28 69 66 n_id=? ".....(if
82f0: 20 73 74 61 74 65 73 2d 71 72 79 20 20 20 28 63 states-qry (c
8300: 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 onc " AND " stat
8310: 65 73 2d 71 72 79 29 20 20 20 22 22 29 0a 09 09 es-qry) "")...
8320: 09 09 28 69 66 20 73 74 61 74 75 73 65 73 2d 71 ..(if statuses-q
8330: 72 79 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 22 ry (conc " AND "
8340: 20 73 74 61 74 75 73 65 73 2d 71 72 79 29 20 22 statuses-qry) "
8350: 22 29 0a 09 09 09 09 28 69 66 20 74 65 73 74 73 ").....(if tests
8360: 2d 6d 61 74 63 68 2d 71 72 79 20 28 63 6f 6e 63 -match-qry (conc
8370: 20 22 20 41 4e 44 20 28 22 20 74 65 73 74 73 2d " AND (" tests-
8380: 6d 61 74 63 68 2d 71 72 79 20 22 29 20 22 29 20 match-qry ") ")
8390: 22 22 29 0a 09 09 09 09 28 63 61 73 65 20 73 6f "").....(case so
83a0: 72 74 2d 62 79 0a 09 09 09 09 20 20 28 28 72 75 rt-by..... ((ru
83b0: 6e 64 69 72 29 20 20 20 20 20 22 20 4f 52 44 45 ndir) " ORDE
83c0: 52 20 42 59 20 6c 65 6e 67 74 68 28 72 75 6e 64 R BY length(rund
83d0: 69 72 29 20 44 45 53 43 3b 22 29 0a 09 09 09 09 ir) DESC;").....
83e0: 20 20 28 28 65 76 65 6e 74 5f 74 69 6d 65 29 20 ((event_time)
83f0: 22 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e 74 " ORDER BY event
8400: 5f 74 69 6d 65 20 41 53 43 3b 22 29 0a 09 09 09 _time ASC;")....
8410: 09 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 20 . (else
8420: 20 22 3b 22 29 29 0a 09 09 09 20 29 29 29 0a 20 ";")).... ))).
8430: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
8440: 69 6e 66 6f 20 38 20 22 64 62 3a 67 65 74 2d 74 info 8 "db:get-t
8450: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 71 72 79 ests-for-run qry
8460: 3d 22 20 71 72 79 29 0a 20 20 20 20 28 73 71 6c =" qry). (sql
8470: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
8480: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
8490: 28 61 20 2e 20 62 29 20 3b 3b 20 69 64 20 72 75 (a . b) ;; id ru
84a0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 n-id testname st
84b0: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
84c0: 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f -time host cpulo
84d0: 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d ad diskfree unam
84e0: 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 e rundir item-pa
84f0: 74 68 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 th run-duration
8500: 66 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 final-logf comme
8510: 6e 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 nt). (set!
8520: 20 72 65 73 20 28 63 6f 6e 73 20 28 61 70 70 6c res (cons (appl
8530: 79 20 76 65 63 74 6f 72 20 61 20 62 29 20 72 65 y vector a b) re
8540: 73 29 29 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 s))) ;; id run-i
8550: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
8560: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
8570: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
8580: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
8590: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
85a0: 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e run-duration fin
85b0: 61 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 al-logf comment)
85c0: 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 res))). db
85d0: 0a 20 20 20 20 20 71 72 79 0a 20 20 20 20 20 72 . qry. r
85e0: 75 6e 2d 69 64 0a 20 20 20 20 20 29 0a 20 20 20 un-id. ).
85f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
8600: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 74 65 fo 11 "db:get-te
8610: 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 41 52 sts-for-run STAR
8620: 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 T run-id=" run-i
8630: 64 20 22 2c 20 74 65 73 74 70 61 74 74 3d 22 20 d ", testpatt="
8640: 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 61 74 testpatt ", stat
8650: 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c 20 73 es=" states ", s
8660: 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 75 73 tatuses=" status
8670: 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 20 6e es ", not-in=" n
8680: 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d 62 79 ot-in ", sort-by
8690: 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 20 20 =" sort-by).
86a0: 72 65 73 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 res))..;; get a
86b0: 75 73 65 66 75 6c 20 73 75 62 73 65 74 20 6f 66 useful subset of
86c0: 20 74 68 65 20 74 65 73 74 73 20 64 61 74 61 20 the tests data
86d0: 28 75 73 65 64 20 69 6e 20 64 61 73 68 62 6f 61 (used in dashboa
86e0: 72 64 0a 3b 3b 20 75 73 65 20 64 62 3a 6d 69 6e rd.;; use db:min
86f0: 74 65 73 74 73 2d 67 65 74 2d 7b 69 64 20 2c 72 tests-get-{id ,r
8700: 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 20 2e un_id,testname .
8710: 2e 2e 7d 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ..}.(define (db:
8720: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
8730: 6e 73 2d 6d 69 6e 64 61 74 61 20 64 62 20 72 75 ns-mindata db ru
8740: 6e 2d 69 64 73 20 74 65 73 74 70 61 74 74 20 73 n-ids testpatt s
8750: 74 61 74 65 73 20 73 74 61 74 75 73 29 0a 20 20 tates status).
8760: 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f (db:get-tests-fo
8770: 72 2d 72 75 6e 73 20 64 62 20 72 75 6e 2d 69 64 r-runs db run-id
8780: 73 20 74 65 73 74 70 61 74 74 20 73 74 61 74 65 s testpatt state
8790: 73 20 73 74 61 74 75 73 20 71 72 79 76 61 6c 73 s status qryvals
87a0: 3a 20 22 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 : "id,run_id,tes
87b0: 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 tname,state,stat
87c0: 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 69 74 us,event_time,it
87d0: 65 6d 5f 70 61 74 68 22 29 29 0a 0a 3b 3b 20 4e em_path"))..;; N
87e0: 42 20 2f 2f 20 54 68 69 73 20 69 73 20 67 65 74 B // This is get
87f0: 20 74 65 73 74 73 20 66 6f 72 20 22 72 75 6e 73 tests for "runs
8800: 22 20 28 6e 6f 74 65 20 74 68 65 20 70 6c 75 72 " (note the plur
8810: 61 6c 21 21 29 0a 3b 3b 0a 3b 3b 20 73 74 61 74 al!!).;;.;; stat
8820: 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 20 es and statuses
8830: 61 72 65 20 6c 69 73 74 73 2c 20 74 75 72 6e 20 are lists, turn
8840: 74 68 65 6d 20 69 6e 74 6f 20 28 22 50 41 53 53 them into ("PASS
8850: 22 2c 22 46 41 49 4c 22 2e 2e 2e 29 20 61 6e 64 ","FAIL"...) and
8860: 20 75 73 65 20 4e 4f 54 20 49 4e 0a 3b 3b 20 69 use NOT IN.;; i
8870: 2e 65 2e 20 74 68 65 73 65 20 6c 69 73 74 73 20 .e. these lists
8880: 64 65 66 69 6e 65 20 77 68 61 74 20 74 6f 20 4e define what to N
8890: 4f 54 20 73 68 6f 77 2e 0a 3b 3b 20 73 74 61 74 OT show..;; stat
88a0: 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 20 es and statuses
88b0: 61 72 65 20 72 65 71 75 69 72 65 64 20 74 6f 20 are required to
88c0: 62 65 20 6c 69 73 74 73 2c 20 65 6d 70 74 79 20 be lists, empty
88d0: 69 73 20 6f 6b 0a 3b 3b 20 6e 6f 74 2d 69 6e 20 is ok.;; not-in
88e0: 23 74 20 3d 20 61 62 6f 76 65 20 62 65 68 61 76 #t = above behav
88f0: 69 6f 75 72 2c 20 23 66 20 3d 20 6d 75 73 74 20 iour, #f = must
8900: 6d 61 74 63 68 0a 3b 3b 20 72 75 6e 2d 69 64 73 match.;; run-ids
8910: 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 72 75 is a list of ru
8920: 6e 2d 69 64 73 20 6f 72 20 61 20 73 69 6e 67 6c n-ids or a singl
8930: 65 20 6e 75 6d 62 65 72 0a 28 64 65 66 69 6e 65 e number.(define
8940: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 (db:get-tests-f
8950: 6f 72 2d 72 75 6e 73 20 64 62 20 72 75 6e 2d 69 or-runs db run-i
8960: 64 73 20 74 65 73 74 70 61 74 74 20 73 74 61 74 ds testpatt stat
8970: 65 73 20 73 74 61 74 75 73 65 73 20 0a 09 09 09 es statuses ....
8980: 20 20 20 20 20 20 23 21 6b 65 79 20 28 6e 6f 74 #!key (not
8990: 2d 69 6e 20 23 74 29 0a 09 09 09 20 20 20 20 20 -in #t)....
89a0: 20 28 73 6f 72 74 2d 62 79 20 23 66 29 0a 09 09 (sort-by #f)...
89b0: 09 20 20 20 20 20 20 28 71 72 79 76 61 6c 73 20 . (qryvals
89c0: 22 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e "id,run_id,testn
89d0: 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 ame,state,status
89e0: 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 ,event_time,host
89f0: 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 ,cpuload,diskfre
8a00: 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 e,uname,rundir,i
8a10: 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 tem_path,run_dur
8a20: 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 ation,final_logf
8a30: 2c 63 6f 6d 6d 65 6e 74 22 29 29 20 3b 3b 20 27 ,comment")) ;; '
8a40: 72 75 6e 64 69 72 20 27 65 76 65 6e 74 5f 74 69 rundir 'event_ti
8a50: 6d 65 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e me. (debug:prin
8a60: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
8a70: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
8a80: 53 54 41 52 54 20 72 75 6e 2d 69 64 73 3d 22 20 START run-ids="
8a90: 72 75 6e 2d 69 64 73 20 22 2c 20 74 65 73 74 70 run-ids ", testp
8aa0: 61 74 74 3d 22 20 74 65 73 74 70 61 74 74 20 22 att=" testpatt "
8ab0: 2c 20 73 74 61 74 65 73 3d 22 20 73 74 61 74 65 , states=" state
8ac0: 73 20 22 2c 20 73 74 61 74 75 73 65 73 3d 22 20 s ", statuses="
8ad0: 73 74 61 74 75 73 65 73 20 22 2c 20 6e 6f 74 2d statuses ", not-
8ae0: 69 6e 3d 22 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 in=" not-in ", s
8af0: 6f 72 74 2d 62 79 3d 22 20 73 6f 72 74 2d 62 79 ort-by=" sort-by
8b00: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 ). (let* ((res
8b10: 27 28 29 29 0a 09 20 3b 3b 20 69 66 20 73 74 61 '()).. ;; if sta
8b20: 74 65 73 20 6f 72 20 73 74 61 74 75 73 65 73 20 tes or statuses
8b30: 61 72 65 20 6e 75 6c 6c 20 74 68 65 6e 20 61 73 are null then as
8b40: 73 75 6d 65 20 6d 61 74 63 68 20 61 6c 6c 20 77 sume match all w
8b50: 68 65 6e 20 6e 6f 74 2d 69 6e 20 69 73 20 66 61 hen not-in is fa
8b60: 6c 73 65 0a 09 20 28 73 74 61 74 65 73 2d 71 72 lse.. (states-qr
8b70: 79 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c y (if (null
8b80: 3f 20 73 74 61 74 65 73 29 20 0a 09 09 09 20 20 ? states) ....
8b90: 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 20 #f....
8ba0: 28 63 6f 6e 63 20 22 20 73 74 61 74 65 20 22 20 (conc " state "
8bb0: 20 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e 6f ..... (if no
8bc0: 74 2d 69 6e 20 22 4e 4f 54 22 20 22 22 29 20 0a t-in "NOT" "") .
8bd0: 09 09 09 09 20 20 20 20 22 20 49 4e 20 28 27 22 .... " IN ('"
8be0: 20 0a 09 09 09 09 20 20 20 20 28 73 74 72 69 6e ..... (strin
8bf0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 73 74 g-intersperse st
8c00: 61 74 65 73 20 20 20 22 27 2c 27 22 29 0a 09 09 ates "','")...
8c10: 09 09 20 20 20 20 22 27 29 22 29 29 29 0a 09 20 .. "')")))..
8c20: 28 73 74 61 74 75 73 65 73 2d 71 72 79 20 20 20 (statuses-qry
8c30: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 74 (if (null? stat
8c40: 75 73 65 73 29 0a 09 09 09 20 20 20 20 20 20 23 uses).... #
8c50: 66 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e 63 f.... (conc
8c60: 20 22 20 73 74 61 74 75 73 20 22 0a 09 09 09 09 " status ".....
8c70: 20 20 20 20 28 69 66 20 6e 6f 74 2d 69 6e 20 22 (if not-in "
8c80: 4e 4f 54 22 20 22 22 29 20 0a 09 09 09 09 20 20 NOT" "") .....
8c90: 20 20 22 20 49 4e 20 28 27 22 20 0a 09 09 09 09 " IN ('" .....
8ca0: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
8cb0: 72 73 70 65 72 73 65 20 73 74 61 74 75 73 65 73 rsperse statuses
8cc0: 20 22 27 2c 27 22 29 0a 09 09 09 09 20 20 20 20 "','").....
8cd0: 22 27 29 22 29 29 29 0a 09 20 28 74 65 73 74 73 "')"))).. (tests
8ce0: 2d 6d 61 74 63 68 2d 71 72 79 20 28 74 65 73 74 -match-qry (test
8cf0: 73 3a 6d 61 74 63 68 2d 3e 73 71 6c 71 72 79 20 s:match->sqlqry
8d00: 74 65 73 74 70 61 74 74 29 29 0a 09 20 28 71 72 testpatt)).. (qr
8d10: 79 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 y (c
8d20: 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 71 72 onc "SELECT " qr
8d30: 79 76 61 6c 73 20 0a 09 09 09 09 22 20 46 52 4f yvals ....." FRO
8d40: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 22 20 M tests WHERE "
8d50: 0a 09 09 09 09 28 69 66 20 72 75 6e 2d 69 64 73 .....(if run-ids
8d60: 0a 09 09 09 09 20 20 20 20 28 69 66 20 28 6c 69 ..... (if (li
8d70: 73 74 3f 20 72 75 6e 2d 69 64 73 29 0a 09 09 09 st? run-ids)....
8d80: 09 09 28 63 6f 6e 63 20 22 20 72 75 6e 5f 69 64 ..(conc " run_id
8d90: 20 69 6e 20 28 22 20 28 73 74 72 69 6e 67 2d 69 in (" (string-i
8da0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
8db0: 63 6f 6e 63 20 72 75 6e 2d 69 64 73 29 20 22 2c conc run-ids) ",
8dc0: 22 29 20 22 29 20 22 29 0a 09 09 09 09 09 28 63 ") ") ")......(c
8dd0: 6f 6e 63 20 22 72 75 6e 5f 69 64 3d 22 20 72 75 onc "run_id=" ru
8de0: 6e 2d 69 64 73 20 22 20 22 29 29 0a 09 09 09 09 n-ids " ")).....
8df0: 20 20 20 20 22 20 22 29 20 3b 3b 20 23 66 20 3d " ") ;; #f =
8e00: 3e 20 72 75 6e 2d 69 64 73 20 64 6f 6e 27 74 20 > run-ids don't
8e10: 66 69 6c 74 65 72 20 6f 6e 20 72 75 6e 2d 69 64 filter on run-id
8e20: 73 0a 09 09 09 09 28 69 66 20 73 74 61 74 65 73 s.....(if states
8e30: 2d 71 72 79 20 20 20 28 63 6f 6e 63 20 22 20 41 -qry (conc " A
8e40: 4e 44 20 22 20 73 74 61 74 65 73 2d 71 72 79 29 ND " states-qry)
8e50: 20 20 20 22 22 29 0a 09 09 09 09 28 69 66 20 73 "").....(if s
8e60: 74 61 74 75 73 65 73 2d 71 72 79 20 28 63 6f 6e tatuses-qry (con
8e70: 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 75 73 c " AND " status
8e80: 65 73 2d 71 72 79 29 20 22 22 29 0a 09 09 09 09 es-qry) "").....
8e90: 28 69 66 20 74 65 73 74 73 2d 6d 61 74 63 68 2d (if tests-match-
8ea0: 71 72 79 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 qry (conc " AND
8eb0: 28 22 20 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 (" tests-match-q
8ec0: 72 79 20 22 29 20 22 29 20 22 22 29 0a 09 09 09 ry ") ") "")....
8ed0: 09 28 63 61 73 65 20 73 6f 72 74 2d 62 79 0a 09 .(case sort-by..
8ee0: 09 09 09 20 20 28 28 72 75 6e 64 69 72 29 20 20 ... ((rundir)
8ef0: 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 6c 65 " ORDER BY le
8f00: 6e 67 74 68 28 72 75 6e 64 69 72 29 20 44 45 53 ngth(rundir) DES
8f10: 43 3b 22 29 0a 09 09 09 09 20 20 28 28 65 76 65 C;")..... ((eve
8f20: 6e 74 5f 74 69 6d 65 29 20 22 20 4f 52 44 45 52 nt_time) " ORDER
8f30: 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 41 BY event_time A
8f40: 53 43 3b 22 29 0a 09 09 09 09 20 20 28 65 6c 73 SC;")..... (els
8f50: 65 20 20 20 20 20 20 20 20 20 22 3b 22 29 29 0a e ";")).
8f60: 09 09 09 20 29 29 29 0a 20 20 20 20 28 64 65 62 ... ))). (deb
8f70: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 38 20 ug:print-info 8
8f80: 22 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f "db:get-tests-fo
8f90: 72 2d 72 75 6e 20 71 72 79 3d 22 20 71 72 79 29 r-run qry=" qry)
8fa0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
8fb0: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
8fc0: 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 (lambda (a . b)
8fd0: 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 ;; id run-id te
8fe0: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 stname state sta
8ff0: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 tus event-time h
9000: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
9010: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 free uname rundi
9020: 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d r item-path run-
9030: 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c duration final-l
9040: 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 ogf comment).
9050: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
9060: 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 74 6f ons (apply vecto
9070: 72 20 61 20 62 29 20 72 65 73 29 29 29 20 3b 3b r a b) res))) ;;
9080: 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e id run-id testn
9090: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
90a0: 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 event-time host
90b0: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
90c0: 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 e uname rundir i
90d0: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 tem-path run-dur
90e0: 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66 ation final-logf
90f0: 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 29 29 comment) res)))
9100: 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 71 . db . q
9110: 72 79 0a 20 20 20 20 20 29 0a 20 20 20 20 28 64 ry. ). (d
9120: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
9130: 31 31 20 22 64 62 3a 67 65 74 2d 74 65 73 74 73 11 "db:get-tests
9140: 2d 66 6f 72 2d 72 75 6e 20 53 54 41 52 54 20 72 -for-run START r
9150: 75 6e 2d 69 64 73 3d 22 20 72 75 6e 2d 69 64 73 un-ids=" run-ids
9160: 20 22 2c 20 74 65 73 74 70 61 74 74 3d 22 20 74 ", testpatt=" t
9170: 65 73 74 70 61 74 74 20 22 2c 20 73 74 61 74 65 estpatt ", state
9180: 73 3d 22 20 73 74 61 74 65 73 20 22 2c 20 73 74 s=" states ", st
9190: 61 74 75 73 65 73 3d 22 20 73 74 61 74 75 73 65 atuses=" statuse
91a0: 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 20 6e 6f s ", not-in=" no
91b0: 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d 62 79 3d t-in ", sort-by=
91c0: 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 20 20 72 " sort-by). r
91d0: 65 73 29 29 0a 0a 3b 3b 20 74 68 69 73 20 6f 6e es))..;; this on
91e0: 65 20 69 73 20 61 20 62 69 74 20 62 72 6f 6b 65 e is a bit broke
91f0: 6e 20 42 55 47 20 46 49 58 4d 45 0a 28 64 65 66 n BUG FIXME.(def
9200: 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 ine (db:delete-t
9210: 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 est-step-records
9220: 20 64 62 20 74 65 73 74 2d 69 64 20 23 21 6b 65 db test-id #!ke
9230: 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 y (work-area #f)
9240: 29 0a 20 20 3b 3b 20 42 72 65 61 6b 69 6e 67 20 ). ;; Breaking
9250: 69 74 20 69 6e 74 6f 20 74 77 6f 20 71 75 65 72 it into two quer
9260: 69 65 73 20 66 6f 72 20 62 65 74 74 65 72 20 66 ies for better f
9270: 69 6c 65 20 61 63 63 65 73 73 20 69 6e 74 65 72 ile access inter
9280: 6c 65 61 76 69 6e 67 0a 20 20 28 6c 65 74 2a 20 leaving. (let*
9290: 28 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 ((tdb (db:open-t
92a0: 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
92b0: 64 20 64 62 20 74 65 73 74 2d 69 64 20 77 6f 72 d db test-id wor
92c0: 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
92d0: 61 29 29 29 0a 20 20 20 20 3b 3b 20 74 65 73 74 a))). ;; test
92e0: 20 64 62 27 73 20 63 61 6e 20 67 6f 20 61 77 61 db's can go awa
92f0: 79 20 2d 20 6d 75 73 74 20 63 68 65 63 6b 20 65 y - must check e
9300: 76 65 72 79 20 74 69 6d 65 0a 20 20 20 20 28 69 very time. (i
9310: 66 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 f tdb..(begin..
9320: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
9330: 65 20 74 64 62 20 22 44 45 4c 45 54 45 20 46 52 e tdb "DELETE FR
9340: 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 3b 22 29 OM test_steps;")
9350: 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 .. (sqlite3:exe
9360: 63 75 74 65 20 74 64 62 20 22 44 45 4c 45 54 45 cute tdb "DELETE
9370: 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 3b FROM test_data;
9380: 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 ").. (sqlite3:f
9390: 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 29 29 29 inalize! tdb))))
93a0: 29 0a 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 )..;; .(define (
93b0: 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 db:delete-test-r
93c0: 65 63 6f 72 64 73 20 64 62 20 74 64 62 20 74 65 ecords db tdb te
93d0: 73 74 2d 69 64 20 23 21 6b 65 79 20 28 66 6f 72 st-id #!key (for
93e0: 63 65 20 23 66 29 29 0a 20 20 28 63 6f 6d 6d 6f ce #f)). (commo
93f0: 6e 3a 63 6c 65 61 72 2d 63 61 63 68 65 73 29 0a n:clear-caches).
9400: 20 20 28 69 66 20 74 64 62 20 0a 20 20 20 20 20 (if tdb .
9410: 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 65 (begin..(sqlite
9420: 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 44 3:execute tdb "D
9430: 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 5f ELETE FROM test_
9440: 73 74 65 70 73 3b 22 29 0a 09 28 73 71 6c 69 74 steps;")..(sqlit
9450: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
9460: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
9470: 5f 64 61 74 61 3b 22 29 29 29 0a 20 20 3b 3b 20 _data;"))). ;;
9480: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
9490: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
94a0: 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d tests WHERE id=
94b0: 3f 3b 22 20 74 65 73 74 2d 69 64 29 29 0a 20 20 ?;" test-id)).
94c0: 28 69 66 20 64 62 20 0a 20 20 20 20 20 20 28 62 (if db . (b
94d0: 65 67 69 6e 0a 09 28 73 71 6c 69 74 65 33 3a 65 egin..(sqlite3:e
94e0: 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 xecute db "DELET
94f0: 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 E FROM test_step
9500: 73 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d s WHERE test_id=
9510: 3f 3b 22 20 74 65 73 74 2d 69 64 29 0a 09 28 73 ?;" test-id)..(s
9520: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
9530: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
9540: 65 73 74 5f 64 61 74 61 20 20 57 48 45 52 45 20 est_data WHERE
9550: 74 65 73 74 5f 69 64 3d 3f 3b 22 20 74 65 73 74 test_id=?;" test
9560: 2d 69 64 29 0a 09 28 69 66 20 66 6f 72 63 65 0a -id)..(if force.
9570: 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
9580: 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 ecute db "DELETE
9590: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
95a0: 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 E id=?;" test-id
95b0: 29 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a ).. (sqlite3:
95c0: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
95d0: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
95e0: 74 65 3d 27 44 45 4c 45 54 45 44 27 2c 73 74 61 te='DELETED',sta
95f0: 74 75 73 3d 27 6e 2f 61 27 20 57 48 45 52 45 20 tus='n/a' WHERE
9600: 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 29 id=?;" test-id))
9610: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
9620: 3a 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 66 6f :delete-tests-fo
9630: 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 29 r-run db run-id)
9640: 0a 20 20 28 63 6f 6d 6d 6f 6e 3a 63 6c 65 61 72 . (common:clear
9650: 2d 63 61 63 68 65 73 29 0a 20 20 28 73 71 6c 69 -caches). (sqli
9660: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
9670: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
9680: 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f s WHERE run_id=?
9690: 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64 65 ;" run-id))..(de
96a0: 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 2d fine (db:delete-
96b0: 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 old-deleted-test
96c0: 2d 72 65 63 6f 72 64 73 20 64 62 29 0a 20 20 28 -records db). (
96d0: 6c 65 74 20 28 28 74 61 72 67 74 69 6d 65 20 28 let ((targtime (
96e0: 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e - (current-secon
96f0: 64 73 29 28 2a 20 33 30 20 32 34 20 36 30 20 36 ds)(* 30 24 60 6
9700: 30 29 29 29 29 20 3b 3b 20 6f 6e 65 20 6d 6f 6e 0)))) ;; one mon
9710: 74 68 20 69 6e 20 74 68 65 20 70 61 73 74 0a 20 th in the past.
9720: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
9730: 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 ute db "DELETE F
9740: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
9750: 73 74 61 74 65 3d 27 44 45 4c 45 54 45 44 27 20 state='DELETED'
9760: 41 4e 44 20 65 76 65 6e 74 5f 74 69 6d 65 3c 3f AND event_time<?
9770: 3b 22 20 74 61 72 67 74 69 6d 65 29 29 29 0a 0a ;" targtime)))..
9780: 3b 3b 20 73 65 74 20 74 65 73 74 73 20 77 69 74 ;; set tests wit
9790: 68 20 73 74 61 74 65 20 63 75 72 72 73 74 61 74 h state currstat
97a0: 65 20 61 6e 64 20 73 74 61 74 75 73 20 63 75 72 e and status cur
97b0: 72 73 74 61 74 75 73 20 74 6f 20 6e 65 77 73 74 rstatus to newst
97c0: 61 74 65 20 61 6e 64 20 6e 65 77 73 74 61 74 75 ate and newstatu
97d0: 73 0a 3b 3b 20 75 73 65 20 63 75 72 72 73 74 61 s.;; use currsta
97e0: 74 65 20 3d 20 23 66 20 61 6e 64 20 6f 72 20 63 te = #f and or c
97f0: 75 72 72 73 74 61 74 75 73 20 3d 20 23 66 20 74 urrstatus = #f t
9800: 6f 20 61 70 70 6c 79 20 74 6f 20 61 6e 79 20 73 o apply to any s
9810: 74 61 74 65 20 6f 72 20 73 74 61 74 75 73 20 72 tate or status r
9820: 65 73 70 65 63 74 69 76 65 6c 79 0a 3b 3b 20 57 espectively.;; W
9830: 41 52 4e 49 4e 47 3a 20 53 51 4c 20 69 6e 6a 65 ARNING: SQL inje
9840: 63 74 69 6f 6e 20 72 69 73 6b 2e 20 4e 42 2f 2f ction risk. NB//
9850: 20 53 65 65 20 6e 65 77 20 62 75 74 20 6e 6f 74 See new but not
9860: 20 79 65 74 20 75 73 65 64 20 22 66 61 73 74 65 yet used "faste
9870: 72 22 20 76 65 72 73 69 6f 6e 20 62 65 6c 6f 77 r" version below
9880: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a .;;.(define (db:
9890: 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
98a0: 73 74 61 74 75 73 20 64 62 20 72 75 6e 2d 69 64 status db run-id
98b0: 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 72 73 testnames currs
98c0: 74 61 74 65 20 63 75 72 72 73 74 61 74 75 73 20 tate currstatus
98d0: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 newstate newstat
98e0: 75 73 29 0a 20 20 28 66 6f 72 2d 65 61 63 68 20 us). (for-each
98f0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d (lambda (testnam
9900: 65 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 e).. (let (
9910: 28 71 72 79 20 28 63 6f 6e 63 20 22 55 50 44 41 (qry (conc "UPDA
9920: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
9930: 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 te=?,status=? WH
9940: 45 52 45 20 22 0a 09 09 09 20 20 20 20 20 20 20 ERE "....
9950: 28 69 66 20 63 75 72 72 73 74 61 74 65 20 20 28 (if currstate (
9960: 63 6f 6e 63 20 22 73 74 61 74 65 3d 27 22 20 63 conc "state='" c
9970: 75 72 72 73 74 61 74 65 20 22 27 20 41 4e 44 20 urrstate "' AND
9980: 22 29 20 22 22 29 0a 09 09 09 20 20 20 20 20 20 ") "")....
9990: 20 28 69 66 20 63 75 72 72 73 74 61 74 75 73 20 (if currstatus
99a0: 28 63 6f 6e 63 20 22 73 74 61 74 75 73 3d 27 22 (conc "status='"
99b0: 20 63 75 72 72 73 74 61 74 75 73 20 22 27 20 41 currstatus "' A
99c0: 4e 44 20 22 29 20 22 22 29 0a 09 09 09 20 20 20 ND ") "")....
99d0: 20 20 20 20 22 20 72 75 6e 5f 69 64 3d 3f 20 41 " run_id=? A
99e0: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
99f0: 44 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 68 D NOT (item_path
9a00: 3d 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 ='' AND testname
9a10: 20 69 6e 20 28 53 45 4c 45 43 54 20 44 49 53 54 in (SELECT DIST
9a20: 49 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 INCT testname FR
9a30: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 74 OM tests WHERE t
9a40: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
9a50: 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 3b em_path != ''));
9a60: 22 29 29 29 0a 09 09 3b 3b 28 64 65 62 75 67 3a ")))...;;(debug:
9a70: 70 72 69 6e 74 20 30 20 22 51 52 59 3a 20 22 20 print 0 "QRY: "
9a80: 71 72 79 29 0a 09 09 28 73 71 6c 69 74 65 33 3a qry)...(sqlite3:
9a90: 65 78 65 63 75 74 65 20 64 62 20 71 72 79 20 72 execute db qry r
9aa0: 75 6e 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e un-id newstate n
9ab0: 65 77 73 74 61 74 75 73 20 74 65 73 74 6e 61 6d ewstatus testnam
9ac0: 65 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 20 e testname)))..
9ad0: 20 20 20 74 65 73 74 6e 61 6d 65 73 29 29 0a 0a testnames))..
9ae0: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65 .(define (cdb:se
9af0: 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d 73 74 t-tests-state-st
9b00: 61 74 75 73 2d 66 61 73 74 65 72 20 73 65 72 76 atus-faster serv
9b10: 65 72 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 erdat run-id tes
9b20: 74 6e 61 6d 65 73 20 63 75 72 72 73 74 61 74 65 tnames currstate
9b30: 20 63 75 72 72 73 74 61 74 75 73 20 6e 65 77 73 currstatus news
9b40: 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 29 0a tate newstatus).
9b50: 20 20 3b 3b 20 43 6f 6e 76 65 72 74 20 23 66 20 ;; Convert #f
9b60: 74 6f 20 77 69 6c 64 63 61 72 64 20 25 0a 20 20 to wildcard %.
9b70: 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 6e (if (null? testn
9b80: 61 6d 65 73 29 0a 20 20 20 20 20 20 23 74 0a 20 ames). #t.
9b90: 20 20 20 20 20 28 6c 65 74 20 28 28 63 75 72 72 (let ((curr
9ba0: 73 74 61 74 65 20 20 28 69 66 20 63 75 72 72 73 state (if currs
9bb0: 74 61 74 65 20 63 75 72 72 73 74 61 74 65 20 22 tate currstate "
9bc0: 25 22 29 29 0a 09 20 20 20 20 28 63 75 72 72 73 %")).. (currs
9bd0: 74 61 74 75 73 20 28 69 66 20 63 75 72 72 73 74 tatus (if currst
9be0: 61 74 75 73 20 63 75 72 72 73 74 61 74 75 73 20 atus currstatus
9bf0: 22 25 22 29 29 29 0a 09 28 6c 65 74 20 6c 6f 6f "%")))..(let loo
9c00: 70 20 28 28 68 65 64 20 28 63 61 72 20 74 65 73 p ((hed (car tes
9c10: 74 6e 61 6d 65 73 29 29 0a 09 09 20 20 20 28 74 tnames))... (t
9c20: 61 6c 20 28 63 64 72 20 74 65 73 74 6e 61 6d 65 al (cdr testname
9c30: 73 29 29 0a 09 09 20 20 20 28 74 68 72 20 27 28 s))... (thr '(
9c40: 29 29 29 0a 09 20 20 28 6c 65 74 20 28 28 74 68 ))).. (let ((th
9c50: 31 20 28 69 66 20 6e 65 77 73 74 61 74 65 20 20 1 (if newstate
9c60: 28 63 72 65 61 74 65 2d 74 68 72 65 61 64 20 28 (create-thread (
9c70: 63 62 64 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cbd:client-call
9c80: 73 65 72 76 65 72 64 61 74 20 27 75 70 64 61 74 serverdat 'updat
9c90: 65 2d 74 65 73 74 2d 73 74 61 74 65 20 20 23 74 e-test-state #t
9ca0: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
9cb0: 65 73 2a 20 6e 65 77 73 74 61 74 65 20 20 63 75 es* newstate cu
9cc0: 72 72 73 74 61 74 65 20 20 72 75 6e 2d 69 64 20 rrstate run-id
9cd0: 74 65 73 74 6e 61 6d 65 20 74 65 73 74 6e 61 6d testname testnam
9ce0: 65 29 29 20 23 66 29 29 0a 09 09 28 74 68 32 20 e)) #f))...(th2
9cf0: 28 69 66 20 6e 65 77 73 74 61 74 75 73 20 28 63 (if newstatus (c
9d00: 72 65 61 74 65 2d 74 68 72 65 61 64 20 28 63 62 reate-thread (cb
9d10: 64 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 d:client-call se
9d20: 72 76 65 72 64 61 74 20 27 75 70 64 61 74 65 2d rverdat 'update-
9d30: 74 65 73 74 2d 73 74 61 74 75 73 20 23 74 20 2a test-status #t *
9d40: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
9d50: 2a 20 6e 65 77 73 74 61 74 75 73 20 63 75 72 72 * newstatus curr
9d60: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
9d70: 73 74 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 stname testname)
9d80: 29 20 23 66 29 29 29 0a 09 20 20 20 20 28 74 68 ) #f))).. (th
9d90: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
9da0: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
9db0: 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 28 art! th2).. (
9dc0: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 if (null? tal)..
9dd0: 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 .(loop (car tal)
9de0: 28 63 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 74 (cdr tal)(cons t
9df0: 68 31 20 28 63 6f 6e 73 20 74 68 32 20 74 68 72 h1 (cons th2 thr
9e00: 29 29 29 0a 09 09 28 66 6f 72 2d 65 61 63 68 0a )))...(for-each.
9e10: 09 09 20 28 6c 61 6d 62 64 61 20 28 74 68 29 0a .. (lambda (th).
9e20: 09 09 20 20 20 28 69 66 20 74 68 20 28 74 68 72 .. (if th (thr
9e30: 65 61 64 2d 6a 6f 69 6e 21 20 74 68 29 29 29 0a ead-join! th))).
9e40: 09 09 20 74 68 72 29 29 29 29 29 29 29 0a 0a 28 .. thr)))))))..(
9e50: 64 65 66 69 6e 65 20 28 63 64 62 3a 64 65 6c 65 define (cdb:dele
9e60: 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 te-tests-in-stat
9e70: 65 20 73 65 72 76 65 72 64 61 74 20 72 75 6e 2d e serverdat run-
9e80: 69 64 20 73 74 61 74 65 29 0a 20 20 28 63 64 62 id state). (cdb
9e90: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 :client-call ser
9ea0: 76 65 72 64 61 74 20 27 64 65 6c 65 74 65 2d 74 verdat 'delete-t
9eb0: 65 73 74 73 2d 69 6e 2d 73 74 61 74 65 20 23 74 ests-in-state #t
9ec0: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
9ed0: 65 73 2a 20 72 75 6e 2d 69 64 20 73 74 61 74 65 es* run-id state
9ee0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
9ef0: 3a 74 65 73 74 73 2d 75 70 64 61 74 65 2d 63 70 :tests-update-cp
9f00: 75 6c 6f 61 64 2d 64 69 73 6b 66 72 65 65 20 73 uload-diskfree s
9f10: 65 72 76 65 72 64 61 74 20 74 65 73 74 2d 69 64 erverdat test-id
9f20: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
9f30: 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 e). (cdb:client
9f40: 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 -call serverdat
9f50: 27 75 70 64 61 74 65 2d 63 70 75 6c 6f 61 64 2d 'update-cpuload-
9f60: 64 69 73 6b 66 72 65 65 20 23 74 20 2a 64 65 66 diskfree #t *def
9f70: 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 63 ault-numtries* c
9f80: 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 puload diskfree
9f90: 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 test-id))..(defi
9fa0: 6e 65 20 28 63 64 62 3a 74 65 73 74 73 2d 75 70 ne (cdb:tests-up
9fb0: 64 61 74 65 2d 72 75 6e 2d 64 75 72 61 74 69 6f date-run-duratio
9fc0: 6e 20 73 65 72 76 65 72 64 61 74 20 74 65 73 74 n serverdat test
9fd0: 2d 69 64 20 6d 69 6e 75 74 65 73 29 0a 20 20 28 -id minutes). (
9fe0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
9ff0: 73 65 72 76 65 72 64 61 74 20 27 75 70 64 61 74 serverdat 'updat
a000: 65 2d 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 23 e-run-duration #
a010: 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 t *default-numtr
a020: 69 65 73 2a 20 6d 69 6e 75 74 65 73 20 74 65 73 ies* minutes tes
a030: 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 t-id))..(define
a040: 28 63 64 62 3a 74 65 73 74 73 2d 75 70 64 61 74 (cdb:tests-updat
a050: 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 73 65 72 e-uname-host ser
a060: 76 65 72 64 61 74 20 74 65 73 74 2d 69 64 20 75 verdat test-id u
a070: 6e 61 6d 65 20 68 6f 73 74 6e 61 6d 65 29 0a 20 name hostname).
a080: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
a090: 6c 20 73 65 72 76 65 72 64 61 74 20 27 75 70 64 l serverdat 'upd
a0a0: 61 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 23 ate-uname-host #
a0b0: 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 t *default-numtr
a0c0: 69 65 73 2a 20 74 65 73 74 2d 69 64 20 75 6e 61 ies* test-id una
a0d0: 6d 65 20 68 6f 73 74 6e 61 6d 65 29 29 0a 0a 3b me hostname))..;
a0e0: 3b 20 73 70 65 65 64 20 75 70 20 66 6f 72 20 63 ; speed up for c
a0f0: 6f 6d 6d 6f 6e 20 63 61 73 65 73 20 77 69 74 68 ommon cases with
a100: 20 61 20 6c 69 74 74 6c 65 20 6c 6f 67 69 63 0a a little logic.
a110: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
a120: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
a130: 73 2d 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d s-by-id db test-
a140: 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 id newstate news
a150: 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 tatus newcomment
a160: 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 61 ). (cond. ((a
a170: 6e 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 nd newstate news
a180: 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 tatus newcomment
a190: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
a1a0: 78 65 63 74 75 74 65 20 64 62 20 22 55 50 44 41 xectute db "UPDA
a1b0: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
a1c0: 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 6f te=?,status=?,co
a1d0: 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 mment=? WHERE id
a1e0: 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 20 6e 65 =?;" newstate ne
a1f0: 77 73 74 61 74 75 73 20 74 65 73 74 2d 69 64 29 wstatus test-id)
a200: 29 0a 20 20 20 28 28 61 6e 64 20 6e 65 77 73 74 ). ((and newst
a210: 61 74 65 20 6e 65 77 73 74 61 74 75 73 29 0a 20 ate newstatus).
a220: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
a230: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
a240: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f ests SET state=?
a250: 2c 73 74 61 74 75 73 3d 3f 20 57 48 45 52 45 20 ,status=? WHERE
a260: 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 20 id=?;" newstate
a270: 6e 65 77 73 74 61 74 75 73 20 74 65 73 74 2d 69 newstatus test-i
a280: 64 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 d)). (else.
a290: 20 28 69 66 20 6e 65 77 73 74 61 74 65 20 20 20 (if newstate
a2a0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
a2b0: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
a2c0: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 20 20 s SET state=?
a2d0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 WHERE id=?;" new
a2e0: 73 74 61 74 65 20 20 20 74 65 73 74 2d 69 64 29 state test-id)
a2f0: 29 0a 20 20 20 20 28 69 66 20 6e 65 77 73 74 61 ). (if newsta
a300: 74 75 73 20 20 28 73 71 6c 69 74 65 33 3a 65 78 tus (sqlite3:ex
a310: 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
a320: 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 75 tests SET statu
a330: 73 3d 3f 20 20 57 48 45 52 45 20 69 64 3d 3f 3b s=? WHERE id=?;
a340: 22 20 6e 65 77 73 74 61 74 75 73 20 20 74 65 73 " newstatus tes
a350: 74 2d 69 64 29 29 0a 20 20 20 20 28 69 66 20 6e t-id)). (if n
a360: 65 77 63 6f 6d 6d 65 6e 74 20 28 73 71 6c 69 74 ewcomment (sqlit
a370: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
a380: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
a390: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
a3a0: 69 64 3d 3f 3b 22 20 6e 65 77 63 6f 6d 6d 65 6e id=?;" newcommen
a3b0: 74 20 74 65 73 74 2d 69 64 29 29 29 29 29 0a 0a t test-id)))))..
a3c0: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
a3d0: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
a3e0: 73 2d 62 79 2d 72 75 6e 2d 69 64 2d 74 65 73 74 s-by-run-id-test
a3f0: 6e 61 6d 65 20 64 62 20 72 75 6e 2d 69 64 20 74 name db run-id t
a400: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
a410: 74 68 20 73 74 61 74 75 73 20 73 74 61 74 65 29 th status state)
a420: 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
a430: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
a440: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f ests SET state=?
a450: 2c 73 74 61 74 75 73 3d 3f 2c 65 76 65 6e 74 5f ,status=?,event_
a460: 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 27 25 time=strftime('%
a470: 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 20 s','now') WHERE
a480: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
a490: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
a4a0: 5f 70 61 74 68 3d 3f 3b 22 20 0a 09 09 20 20 20 _path=?;" ...
a4b0: 73 74 61 74 65 20 73 74 61 74 75 73 20 72 75 6e state status run
a4c0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
a4d0: 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 em-path))..(defi
a4e0: 6e 65 20 28 64 62 3a 67 65 74 2d 63 6f 75 6e 74 ne (db:get-count
a4f0: 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 64 -tests-running d
a500: 62 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 b). (let ((res
a510: 30 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 0)). (sqlite3
a520: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
a530: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e (lambda (coun
a540: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
a550: 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 res count)).
a560: 20 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 db. "SELECT
a570: 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 count(id) FROM
a580: 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 tests WHERE stat
a590: 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e 47 27 2c e in ('RUNNING',
a5a0: 27 4c 41 55 4e 43 48 45 44 27 2c 27 52 45 4d 4f 'LAUNCHED','REMO
a5b0: 54 45 48 4f 53 54 53 54 41 52 54 27 29 3b 22 29 TEHOSTSTART');")
a5c0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 . res))..(def
a5d0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 63 6f 75 6e ine (db:get-coun
a5e0: 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d t-tests-running-
a5f0: 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 64 62 20 6a in-jobgroup db j
a600: 6f 62 67 72 6f 75 70 29 0a 20 20 28 69 66 20 28 obgroup). (if (
a610: 6e 6f 74 20 6a 6f 62 67 72 6f 75 70 29 0a 20 20 not jobgroup).
a620: 20 20 20 20 30 20 3b 3b 20 0a 20 20 20 20 20 20 0 ;; .
a630: 28 6c 65 74 20 28 28 72 65 73 20 30 29 29 0a 09 (let ((res 0))..
a640: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
a650: 68 2d 72 6f 77 0a 09 20 28 6c 61 6d 62 64 61 20 h-row.. (lambda
a660: 28 63 6f 75 6e 74 29 0a 09 20 20 20 28 73 65 74 (count).. (set
a670: 21 20 72 65 73 20 63 6f 75 6e 74 29 29 0a 09 20 ! res count))..
a680: 64 62 0a 09 20 22 53 45 4c 45 43 54 20 63 6f 75 db.. "SELECT cou
a690: 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 nt(id) FROM test
a6a0: 73 20 57 48 45 52 45 20 73 74 61 74 65 20 3d 20 s WHERE state =
a6b0: 27 52 55 4e 4e 49 4e 47 27 20 4f 52 20 73 74 61 'RUNNING' OR sta
a6c0: 74 65 20 3d 20 27 4c 41 55 4e 43 48 45 44 27 20 te = 'LAUNCHED'
a6d0: 4f 52 20 73 74 61 74 65 20 3d 20 27 52 45 4d 4f OR state = 'REMO
a6e0: 54 45 48 4f 53 54 53 54 41 52 54 27 0a 20 20 20 TEHOSTSTART'.
a6f0: 20 20 20 20 20 20 20 20 20 20 41 4e 44 20 74 65 AND te
a700: 73 74 6e 61 6d 65 20 69 6e 20 28 53 45 4c 45 43 stname in (SELEC
a710: 54 20 74 65 73 74 6e 61 6d 65 20 46 52 4f 4d 20 T testname FROM
a720: 74 65 73 74 5f 6d 65 74 61 20 57 48 45 52 45 20 test_meta WHERE
a730: 6a 6f 62 67 72 6f 75 70 3d 3f 3b 22 0a 09 20 6a jobgroup=?;".. j
a740: 6f 62 67 72 6f 75 70 29 0a 09 72 65 73 29 29 29 obgroup)..res)))
a750: 0a 0a 3b 3b 20 64 6f 6e 65 20 77 69 74 68 20 72 ..;; done with r
a760: 75 6e 20 77 68 65 6e 3a 0a 3b 3b 20 20 20 30 20 un when:.;; 0
a770: 74 65 73 74 73 20 69 6e 20 4c 41 55 4e 43 48 45 tests in LAUNCHE
a780: 44 2c 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c 20 D, NOT_STARTED,
a790: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 2c REMOTEHOSTSTART,
a7a0: 20 52 55 4e 4e 49 4e 47 0a 28 64 65 66 69 6e 65 RUNNING.(define
a7b0: 20 28 64 62 3a 65 73 74 69 6d 61 74 65 64 2d 74 (db:estimated-t
a7c0: 65 73 74 73 2d 72 65 6d 61 69 6e 69 6e 67 20 64 ests-remaining d
a7d0: 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 b run-id). (let
a7e0: 20 28 28 72 65 73 20 30 29 29 0a 20 20 20 20 28 ((res 0)). (
a7f0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
a800: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
a810: 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 a (count).
a820: 20 28 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 (set! res count
a830: 29 29 0a 20 20 20 20 20 64 62 20 3b 3b 20 4e 42 )). db ;; NB
a840: 2f 2f 20 4b 49 4c 4c 52 45 51 20 6d 65 61 6e 73 // KILLREQ means
a850: 20 74 68 65 20 6a 6f 62 73 20 69 73 20 73 74 69 the jobs is sti
a860: 6c 6c 20 70 72 6f 62 61 62 6c 79 20 72 75 6e 6e ll probably runn
a870: 69 6e 67 0a 20 20 20 20 20 22 53 45 4c 45 43 54 ing. "SELECT
a880: 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 count(id) FROM
a890: 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 tests WHERE stat
a8a0: 65 20 69 6e 20 28 27 4c 41 55 4e 43 48 45 44 27 e in ('LAUNCHED'
a8b0: 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 ,'NOT_STARTED','
a8c0: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 REMOTEHOSTSTART'
a8d0: 2c 27 52 55 4e 4e 49 4e 47 27 2c 27 4b 49 4c 4c ,'RUNNING','KILL
a8e0: 52 45 51 27 29 20 41 4e 44 20 72 75 6e 5f 69 64 REQ') AND run_id
a8f0: 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 0a 20 20 20 =?;" run-id).
a900: 20 72 65 73 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 res))..;; map r
a910: 75 6e 2d 69 64 2c 20 74 65 73 74 6e 61 6d 65 20 un-id, testname
a920: 69 74 65 6d 2d 70 61 74 68 20 74 6f 20 74 65 73 item-path to tes
a930: 74 2d 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 t-id.(define (db
a940: 3a 67 65 74 2d 74 65 73 74 2d 69 64 2d 63 61 63 :get-test-id-cac
a950: 68 65 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 hed db run-id te
a960: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 stname item-path
a970: 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 ). (let* ((test
a980: 2d 6b 65 79 20 28 63 6f 6e 63 20 72 75 6e 2d 69 -key (conc run-i
a990: 64 20 22 2d 22 20 74 65 73 74 6e 61 6d 65 20 22 d "-" testname "
a9a0: 2d 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 -" item-path))..
a9b0: 20 28 72 65 73 20 20 20 20 20 20 28 68 61 73 68 (res (hash
a9c0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
a9d0: 6c 74 20 2a 74 65 73 74 2d 69 64 73 2a 20 74 65 lt *test-ids* te
a9e0: 73 74 2d 6b 65 79 20 23 66 29 29 29 0a 20 20 20 st-key #f))).
a9f0: 20 28 69 66 20 72 65 73 20 0a 09 72 65 73 0a 09 (if res ..res..
aa00: 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
aa10: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
aa20: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 . (lambda (id)
aa30: 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 ;; run-id test
aa40: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
aa50: 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 s event-time hos
aa60: 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 t cpuload diskfr
aa70: 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 ee uname rundir
aa80: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 item-path run_du
aa90: 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 ration final_log
aaa0: 66 20 63 6f 6d 6d 65 6e 74 20 29 0a 09 20 20 20 f comment )..
aab0: 20 20 28 73 65 74 21 20 72 65 73 20 69 64 29 29 (set! res id))
aac0: 20 3b 3b 20 28 76 65 63 74 6f 72 20 69 64 20 72 ;; (vector id r
aad0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 un-id testname s
aae0: 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e tate status even
aaf0: 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c t-time host cpul
ab00: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 oad diskfree una
ab10: 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 me rundir item-p
ab20: 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e ath run_duration
ab30: 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d final_logf comm
ab40: 65 6e 74 20 29 29 29 0a 09 20 20 20 64 62 20 0a ent ))).. db .
ab50: 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 20 46 . "SELECT id F
ab60: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
ab70: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
ab80: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
ab90: 5f 70 61 74 68 3d 3f 3b 22 0a 09 20 20 20 72 75 _path=?;".. ru
aba0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 n-id testname it
abb0: 65 6d 2d 70 61 74 68 29 0a 09 20 20 28 68 61 73 em-path).. (has
abc0: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 h-table-set! *te
abd0: 73 74 2d 69 64 73 2a 20 74 65 73 74 2d 6b 65 79 st-ids* test-key
abe0: 20 72 65 73 29 0a 09 20 20 72 65 73 29 29 29 29 res).. res))))
abf0: 0a 0a 3b 3b 20 6d 61 70 20 72 75 6e 2d 69 64 2c ..;; map run-id,
ac00: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
ac10: 61 74 68 20 74 6f 20 74 65 73 74 2d 69 64 0a 28 ath to test-id.(
ac20: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
ac30: 65 73 74 2d 69 64 2d 6e 6f 74 2d 63 61 63 68 65 est-id-not-cache
ac40: 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 d db run-id test
ac50: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a name item-path).
ac60: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 23 66 (let* ((res #f
ac70: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
ac80: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
ac90: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 20 3b (lambda (id) ;
aca0: 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 ; run-id testna
acb0: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
acc0: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host
acd0: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
ace0: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it
acf0: 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 em-path run_dura
ad00: 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 tion final_logf
ad10: 63 6f 6d 6d 65 6e 74 20 29 0a 20 20 20 20 20 20 comment ).
ad20: 20 28 73 65 74 21 20 72 65 73 20 69 64 29 29 20 (set! res id))
ad30: 3b 3b 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 ;; (vector id ru
ad40: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 n-id testname st
ad50: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
ad60: 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f -time host cpulo
ad70: 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d ad diskfree unam
ad80: 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 e rundir item-pa
ad90: 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 th run_duration
ada0: 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 final_logf comme
adb0: 6e 74 20 29 29 29 0a 20 20 20 20 20 64 62 20 0a nt ))). db .
adc0: 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 20 "SELECT id
add0: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
ade0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
adf0: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
ae00: 6d 5f 70 61 74 68 3d 3f 3b 22 0a 20 20 20 20 20 m_path=?;".
ae10: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
ae20: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 20 20 72 item-path). r
ae30: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 62 es))..(define db
ae40: 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 3a :get-test-id db:
ae50: 67 65 74 2d 74 65 73 74 2d 69 64 2d 6e 6f 74 2d get-test-id-not-
ae60: 63 61 63 68 65 64 29 0a 0a 3b 3b 20 67 69 76 65 cached)..;; give
ae70: 6e 20 61 20 74 65 73 74 2d 69 6e 66 6f 20 72 65 n a test-info re
ae80: 63 6f 72 64 2c 20 70 61 74 63 68 20 69 6e 20 74 cord, patch in t
ae90: 68 65 20 6c 61 74 65 73 74 20 64 61 74 61 20 66 he latest data f
aea0: 72 6f 6d 20 74 68 65 20 74 65 73 74 64 61 74 2e rom the testdat.
aeb0: 64 62 20 66 69 6c 65 0a 3b 3b 20 66 6f 75 6e 64 db file.;; found
aec0: 20 69 6e 20 74 68 65 20 74 65 73 74 20 72 75 6e in the test run
aed0: 20 64 69 72 65 63 74 6f 72 79 0a 3b 3b 0a 3b 3b directory.;;.;;
aee0: 20 4e 4f 54 20 55 53 45 44 0a 3b 3b 0a 28 64 65 NOT USED.;;.(de
aef0: 66 69 6e 65 20 28 64 62 3a 70 61 74 63 68 2d 74 fine (db:patch-t
af00: 64 62 2d 64 61 74 61 2d 69 6e 74 6f 2d 74 65 73 db-data-into-tes
af10: 74 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 t-info db test-i
af20: 64 20 72 65 73 20 23 21 6b 65 79 20 28 77 6f 72 d res #!key (wor
af30: 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c k-area #f)). (l
af40: 65 74 20 28 28 74 64 62 20 28 64 62 3a 6f 70 65 et ((tdb (db:ope
af50: 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
af60: 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 20 t-id db test-id
af70: 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d work-area: work-
af80: 61 72 65 61 29 29 29 0a 20 20 20 20 3b 3b 20 67 area))). ;; g
af90: 65 74 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 et state and sta
afa0: 74 75 73 20 66 72 6f 6d 20 6d 65 67 61 74 65 73 tus from megates
afb0: 74 2e 64 62 20 69 6e 20 72 65 61 6c 20 74 69 6d t.db in real tim
afc0: 65 0a 20 20 20 20 3b 3b 20 6f 74 68 65 72 20 66 e. ;; other f
afd0: 69 65 6c 64 73 20 74 68 61 74 20 70 65 72 68 61 ields that perha
afe0: 70 73 20 73 68 6f 75 6c 64 20 62 65 20 75 70 64 ps should be upd
aff0: 61 74 65 64 3a 0a 20 20 20 20 3b 3b 20 20 20 66 ated:. ;; f
b000: 61 69 6c 5f 63 6f 75 6e 74 0a 20 20 20 20 3b 3b ail_count. ;;
b010: 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 0a 20 20 pass_count.
b020: 20 20 3b 3b 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 ;; final_log
b030: 66 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 f. (sqlite3:f
b040: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
b050: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 20 (lambda (state
b060: 73 74 61 74 75 73 20 66 69 6e 61 6c 5f 6c 6f 67 status final_log
b070: 66 29 0a 20 20 20 20 20 20 20 28 64 62 3a 74 65 f). (db:te
b080: 73 74 2d 73 65 74 2d 73 74 61 74 65 21 20 20 20 st-set-state!
b090: 20 20 20 20 20 72 65 73 20 73 74 61 74 65 29 0a res state).
b0a0: 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d (db:test-
b0b0: 73 65 74 2d 73 74 61 74 75 73 21 20 20 20 20 20 set-status!
b0c0: 20 20 72 65 73 20 73 74 61 74 75 73 29 0a 20 20 res status).
b0d0: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 (db:test-se
b0e0: 74 2d 66 69 6e 61 6c 5f 6c 6f 67 66 21 20 20 20 t-final_logf!
b0f0: 72 65 73 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 res final_logf))
b100: 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 . db. "S
b110: 45 4c 45 43 54 20 73 74 61 74 65 2c 73 74 61 74 ELECT state,stat
b120: 75 73 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 us,final_logf FR
b130: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 OM tests WHERE i
b140: 64 3d 3f 3b 22 0a 20 20 20 20 20 74 65 73 74 2d d=?;". test-
b150: 69 64 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a id). (if tdb.
b160: 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 .(begin.. (sqli
b170: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
b180: 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 75 70 .. (lambda (up
b190: 64 61 74 65 5f 74 69 6d 65 20 63 70 75 6c 6f 61 date_time cpuloa
b1a0: 64 20 64 69 73 6b 5f 66 72 65 65 20 72 75 6e 5f d disk_free run_
b1b0: 64 75 72 61 74 69 6f 6e 29 0a 09 20 20 20 20 20 duration)..
b1c0: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 63 70 75 (db:test-set-cpu
b1d0: 6c 6f 61 64 21 20 20 20 20 20 20 72 65 73 20 63 load! res c
b1e0: 70 75 6c 6f 61 64 29 0a 09 20 20 20 20 20 28 64 puload).. (d
b1f0: 62 3a 74 65 73 74 2d 73 65 74 2d 64 69 73 6b 66 b:test-set-diskf
b200: 72 65 65 21 20 20 20 20 20 72 65 73 20 64 69 73 ree! res dis
b210: 6b 5f 66 72 65 65 29 0a 09 20 20 20 20 20 28 64 k_free).. (d
b220: 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 5f 64 b:test-set-run_d
b230: 75 72 61 74 69 6f 6e 21 20 72 65 73 20 72 75 6e uration! res run
b240: 5f 64 75 72 61 74 69 6f 6e 29 29 0a 09 20 20 20 _duration))..
b250: 74 64 62 0a 09 20 20 20 22 53 45 4c 45 43 54 20 tdb.. "SELECT
b260: 75 70 64 61 74 65 5f 74 69 6d 65 2c 63 70 75 6c update_time,cpul
b270: 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 72 75 6e oad,diskfree,run
b280: 5f 64 75 72 61 74 69 6f 6e 20 46 52 4f 4d 20 74 _duration FROM t
b290: 65 73 74 5f 72 75 6e 64 61 74 20 4f 52 44 45 52 est_rundat ORDER
b2a0: 20 42 59 20 69 64 20 44 45 53 43 20 4c 49 4d 49 BY id DESC LIMI
b2b0: 54 20 31 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 T 1;").. (sqlit
b2c0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
b2d0: 29 29 0a 09 3b 3b 20 69 66 20 74 68 65 20 74 65 ))..;; if the te
b2e0: 73 74 20 64 62 20 69 73 20 6e 6f 74 20 66 6f 75 st db is not fou
b2f0: 6e 64 20 77 68 61 74 20 74 6f 20 64 6f 3f 0a 09 nd what to do?..
b300: 3b 3b 20 31 2e 20 73 65 74 20 73 74 61 74 65 20 ;; 1. set state
b310: 74 6f 20 44 45 4c 45 54 45 44 0a 09 3b 3b 20 32 to DELETED..;; 2
b320: 2e 20 73 65 74 20 73 74 61 74 75 73 20 74 6f 20 . set status to
b330: 6e 2f 61 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 n/a..(begin.. (
b340: 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 db:test-set-stat
b350: 65 21 20 20 72 65 73 20 22 4e 4f 54 5f 53 54 41 e! res "NOT_STA
b360: 52 54 45 44 22 29 0a 09 20 20 28 64 62 3a 74 65 RTED").. (db:te
b370: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 st-set-status! r
b380: 65 73 20 22 6e 2f 61 22 29 29 29 29 29 0a 0a 28 es "n/a")))))..(
b390: 64 65 66 69 6e 65 20 2a 6c 61 73 74 2d 74 65 73 define *last-tes
b3a0: 74 2d 63 61 63 68 65 2d 64 65 6c 65 74 65 2a 20 t-cache-delete*
b3b0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
b3c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
b3d0: 63 6c 65 61 6e 2d 61 6c 6c 2d 63 61 63 68 65 73 clean-all-caches
b3e0: 29 0a 20 20 28 73 65 74 21 20 2a 74 65 73 74 2d ). (set! *test-
b3f0: 69 6e 66 6f 2a 20 28 6d 61 6b 65 2d 68 61 73 68 info* (make-hash
b400: 2d 74 61 62 6c 65 29 29 0a 20 20 28 73 65 74 21 -table)). (set!
b410: 20 2a 74 65 73 74 2d 69 64 2d 63 61 63 68 65 2a *test-id-cache*
b420: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
b430: 65 29 29 29 0a 0a 3b 3b 20 55 73 65 20 64 62 3a e)))..;; Use db:
b440: 74 65 73 74 2d 67 65 74 2a 20 74 6f 20 61 63 63 test-get* to acc
b450: 65 73 73 0a 3b 3b 0a 3b 3b 20 47 65 74 20 74 65 ess.;;.;; Get te
b460: 73 74 20 64 61 74 61 20 75 73 69 6e 67 20 74 65 st data using te
b470: 73 74 5f 69 64 0a 28 64 65 66 69 6e 65 20 28 64 st_id.(define (d
b480: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
b490: 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 by-id db test-id
b4a0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 ). (if (not tes
b4b0: 74 2d 69 64 29 0a 20 20 20 20 20 20 28 62 65 67 t-id). (beg
b4c0: 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 in..(debug:print
b4d0: 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 74 2d -info 4 "db:get-
b4e0: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 test-info-by-id
b4f0: 63 61 6c 6c 65 64 20 77 69 74 68 20 74 65 73 74 called with test
b500: 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 29 0a 09 -id=" test-id)..
b510: 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 #f). (let (
b520: 28 72 65 73 20 23 66 29 29 0a 09 28 73 71 6c 69 (res #f))..(sqli
b530: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
b540: 0a 09 20 28 6c 61 6d 62 64 61 20 28 69 64 20 72 .. (lambda (id r
b550: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 un-id testname s
b560: 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e tate status even
b570: 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c t-time host cpul
b580: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 oad diskfree una
b590: 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 me rundir item-p
b5a0: 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e ath run_duration
b5b0: 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d final_logf comm
b5c0: 65 6e 74 29 0a 09 20 20 20 3b 3b 20 20 20 20 20 ent).. ;;
b5d0: 20 20 20 20 20 20 20 20 20 20 20 20 30 20 20 20 0
b5e0: 20 31 20 20 20 20 20 20 20 32 20 20 20 20 20 20 1 2
b5f0: 33 20 20 20 20 20 20 34 20 20 20 20 20 20 20 20 3 4
b600: 35 20 20 20 20 20 20 20 36 20 20 20 20 20 20 37 5 6 7
b610: 20 20 20 20 20 20 20 20 38 20 20 20 20 20 39 20 8 9
b620: 20 20 20 20 31 30 20 20 20 20 20 20 31 31 20 20 10 11
b630: 20 20 20 20 20 20 20 20 31 32 20 20 20 20 20 20 12
b640: 20 20 20 20 31 33 20 20 20 20 20 20 20 31 34 0a 13 14.
b650: 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 76 . (set! res (v
b660: 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 ector id run-id
b670: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
b680: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
b690: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
b6a0: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
b6b0: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
b6c0: 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n_duration final
b6d0: 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 29 29 _logf comment)))
b6e0: 0a 09 20 64 62 20 0a 09 20 22 53 45 4c 45 43 54 .. db .. "SELECT
b6f0: 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e id,run_id,testn
b700: 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 ame,state,status
b710: 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 ,event_time,host
b720: 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 ,cpuload,diskfre
b730: 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 e,uname,rundir,i
b740: 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 tem_path,run_dur
b750: 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 ation,final_logf
b760: 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 ,comment FROM te
b770: 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 sts WHERE id=?;"
b780: 0a 09 20 74 65 73 74 2d 69 64 29 0a 09 72 65 73 .. test-id)..res
b790: 29 29 29 0a 0a 3b 3b 20 55 73 65 20 64 62 3a 74 )))..;; Use db:t
b7a0: 65 73 74 2d 67 65 74 2a 20 74 6f 20 61 63 63 65 est-get* to acce
b7b0: 73 73 0a 3b 3b 0a 3b 3b 20 47 65 74 20 74 65 73 ss.;;.;; Get tes
b7c0: 74 20 64 61 74 61 20 75 73 69 6e 67 20 74 65 73 t data using tes
b7d0: 74 5f 69 64 73 0a 28 64 65 66 69 6e 65 20 28 64 t_ids.(define (d
b7e0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
b7f0: 62 79 2d 69 64 73 20 64 62 20 74 65 73 74 2d 69 by-ids db test-i
b800: 64 73 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f ds). (if (null?
b810: 20 74 65 73 74 2d 69 64 73 29 0a 20 20 20 20 20 test-ids).
b820: 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a (begin..(debug:
b830: 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 print-info 4 "db
b840: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
b850: 79 2d 69 64 73 20 63 61 6c 6c 65 64 20 77 69 74 y-ids called wit
b860: 68 20 74 65 73 74 2d 69 64 73 3d 22 20 74 65 73 h test-ids=" tes
b870: 74 2d 69 64 73 29 0a 09 27 28 29 29 0a 20 20 20 t-ids)..'()).
b880: 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 (let ((res '(
b890: 29 29 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f )))..(sqlite3:fo
b8a0: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 r-each-row.. (la
b8b0: 6d 62 64 61 20 28 69 64 20 72 75 6e 2d 69 64 20 mbda (id run-id
b8c0: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
b8d0: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
b8e0: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
b8f0: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
b900: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
b910: 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n_duration final
b920: 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 _logf comment)..
b930: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
b940: 20 20 20 20 20 20 30 20 20 20 20 31 20 20 20 20 0 1
b950: 20 20 20 32 20 20 20 20 20 20 33 20 20 20 20 20 2 3
b960: 20 34 20 20 20 20 20 20 20 20 35 20 20 20 20 20 4 5
b970: 20 20 36 20 20 20 20 20 20 37 20 20 20 20 20 20 6 7
b980: 20 20 38 20 20 20 20 20 39 20 20 20 20 20 31 30 8 9 10
b990: 20 20 20 20 20 20 31 31 20 20 20 20 20 20 20 20 11
b9a0: 20 20 31 32 20 20 20 20 20 20 20 20 20 20 31 33 12 13
b9b0: 20 20 20 20 20 20 20 31 34 0a 09 20 20 20 28 73 14.. (s
b9c0: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76 et! res (cons (v
b9d0: 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 ector id run-id
b9e0: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
b9f0: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
ba00: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
ba10: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
ba20: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
ba30: 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n_duration final
ba40: 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 _logf comment)..
ba50: 09 09 20 20 20 72 65 73 29 29 29 0a 09 20 64 62 .. res))).. db
ba60: 20 0a 09 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 .. (conc "SELEC
ba70: 54 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 T id,run_id,test
ba80: 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 name,state,statu
ba90: 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 s,event_time,hos
baa0: 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 t,cpuload,diskfr
bab0: 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c ee,uname,rundir,
bac0: 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 item_path,run_du
bad0: 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 ration,final_log
bae0: 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 f,comment FROM t
baf0: 65 73 74 73 20 57 48 45 52 45 20 69 64 20 69 6e ests WHERE id in
bb00: 20 28 22 0a 09 20 20 20 20 20 20 20 28 73 74 72 (".. (str
bb10: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
bb20: 28 6d 61 70 20 63 6f 6e 63 20 74 65 73 74 2d 69 (map conc test-i
bb30: 64 73 29 20 22 2c 22 29 20 22 29 3b 22 29 29 0a ds) ",") ");")).
bb40: 09 72 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 .res)))..(define
bb50: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e (db:get-test-in
bb60: 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 fo db run-id tes
bb70: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 tname item-path)
bb80: 0a 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d . (db:get-test-
bb90: 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 20 28 64 info-by-id db (d
bba0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 b:get-test-id db
bbb0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
bbc0: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 item-path)))..(
bbd0: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
bbe0: 73 65 74 2d 63 6f 6d 6d 65 6e 74 20 64 62 20 74 set-comment db t
bbf0: 65 73 74 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a est-id comment).
bc00: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
bc10: 74 65 20 0a 20 20 20 64 62 20 0a 20 20 20 22 55 te . db . "U
bc20: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
bc30: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
bc40: 69 64 3d 3f 3b 22 0a 20 20 20 63 6f 6d 6d 65 6e id=?;". commen
bc50: 74 20 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 t test-id))..(de
bc60: 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 73 fine (cdb:test-s
bc70: 65 74 2d 72 75 6e 64 69 72 21 20 73 65 72 76 65 et-rundir! serve
bc80: 72 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 rdat run-id test
bc90: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
bca0: 72 75 6e 64 69 72 29 0a 20 20 28 63 64 62 3a 63 rundir). (cdb:c
bcb0: 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 lient-call serve
bcc0: 72 64 61 74 20 27 74 65 73 74 2d 73 65 74 2d 72 rdat 'test-set-r
bcd0: 75 6e 64 69 72 20 23 74 20 2a 64 65 66 61 75 6c undir #t *defaul
bce0: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 72 75 6e 64 t-numtries* rund
bcf0: 69 72 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ir run-id test-n
bd00: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a ame item-path)).
bd10: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 .(define (cdb:te
bd20: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 st-set-rundir-by
bd30: 2d 74 65 73 74 2d 69 64 20 73 65 72 76 65 72 64 -test-id serverd
bd40: 61 74 20 74 65 73 74 2d 69 64 20 72 75 6e 64 69 at test-id rundi
bd50: 72 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 r). (cdb:client
bd60: 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 -call serverdat
bd70: 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 'test-set-rundir
bd80: 2d 62 79 2d 74 65 73 74 2d 69 64 20 23 74 20 2a -by-test-id #t *
bd90: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
bda0: 2a 20 72 75 6e 64 69 72 20 74 65 73 74 2d 69 64 * rundir test-id
bdb0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
bdc0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 2d test-get-rundir-
bdd0: 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 62 20 from-test-id db
bde0: 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 20 test-id). (let
bdf0: 28 28 72 65 73 20 23 66 29 29 20 3b 3b 20 28 68 ((res #f)) ;; (h
be00: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
be10: 66 61 75 6c 74 20 2a 74 65 73 74 2d 70 61 74 68 fault *test-path
be20: 73 2a 20 74 65 73 74 2d 69 64 20 23 66 29 29 29 s* test-id #f)))
be30: 0a 20 20 20 20 3b 3b 20 28 69 66 20 72 65 73 0a . ;; (if res.
be40: 20 20 20 20 3b 3b 20 20 20 20 20 72 65 73 0a 20 ;; res.
be50: 20 20 20 3b 3b 20 20 20 20 20 28 62 65 67 69 6e ;; (begin
be60: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
be70: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
be80: 28 6c 61 6d 62 64 61 20 28 74 70 61 74 68 29 0a (lambda (tpath).
be90: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
bea0: 20 74 70 61 74 68 29 29 0a 20 20 20 20 20 64 62 tpath)). db
beb0: 20 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 72 . "SELECT r
bec0: 75 6e 64 69 72 20 46 52 4f 4d 20 74 65 73 74 73 undir FROM tests
bed0: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 WHERE id=?;".
bee0: 20 20 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 test-id).
bef0: 3b 3b 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ;; (hash-table-s
bf00: 65 74 21 20 2a 74 65 73 74 2d 70 61 74 68 73 2a et! *test-paths*
bf10: 20 74 65 73 74 2d 69 64 20 72 65 73 29 0a 20 20 test-id res).
bf20: 20 20 72 65 73 29 29 20 3b 3b 20 29 29 0a 0a 28 res)) ;; ))..(
bf30: 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 define (cdb:test
bf40: 2d 73 65 74 2d 6c 6f 67 21 20 73 65 72 76 65 72 -set-log! server
bf50: 64 61 74 20 74 65 73 74 2d 69 64 20 6c 6f 67 66 dat test-id logf
bf60: 29 0a 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f ). (if (string?
bf70: 20 6c 6f 67 66 29 28 63 64 62 3a 63 6c 69 65 6e logf)(cdb:clien
bf80: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
bf90: 20 27 74 65 73 74 2d 73 65 74 2d 6c 6f 67 20 23 'test-set-log #
bfa0: 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 f *default-numtr
bfb0: 69 65 73 2a 20 6c 6f 67 66 20 74 65 73 74 2d 69 ies* logf test-i
bfc0: 64 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d d)))..;;========
bfd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bfe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
bff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
c010: 3b 20 4d 69 73 63 2e 20 74 65 73 74 20 72 65 6c ; Misc. test rel
c020: 61 74 65 64 20 71 75 65 72 69 65 73 0a 3b 3b 3d ated queries.;;=
c030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
c070: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d 55 53 54 20 42 =====..;; MUST B
c080: 45 20 43 41 4c 4c 45 44 20 6c 6f 63 61 6c 21 0a E CALLED local!.
c090: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
c0a0: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
c0b0: 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 ing db keynames
c0c0: 74 61 72 67 65 74 20 66 6e 61 6d 65 70 61 74 74 target fnamepatt
c0d0: 20 23 21 6b 65 79 20 28 72 65 73 20 27 28 29 29 #!key (res '())
c0e0: 29 0a 20 20 3b 3b 20 42 55 47 3a 20 4d 6f 76 65 ). ;; BUG: Move
c0f0: 20 74 68 65 20 76 61 6c 75 65 73 20 64 65 72 69 the values deri
c100: 76 65 64 20 66 72 6f 6d 20 61 72 67 73 20 74 6f ved from args to
c110: 20 70 61 72 61 6d 65 74 65 72 73 20 61 6e 64 20 parameters and
c120: 70 75 73 68 20 74 6f 20 6d 65 67 61 74 65 73 74 push to megatest
c130: 2e 73 63 6d 0a 20 20 28 6c 65 74 2a 20 28 28 74 .scm. (let* ((t
c140: 65 73 74 70 61 74 74 20 20 20 28 69 66 20 28 61 estpatt (if (a
c150: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
c160: 73 74 70 61 74 74 22 29 28 61 72 67 73 3a 67 65 stpatt")(args:ge
c170: 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 t-arg "-testpatt
c180: 22 29 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 ") "%")).. (stat
c190: 65 70 61 74 74 20 20 28 69 66 20 28 61 72 67 73 epatt (if (args
c1a0: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 65 :get-arg ":state
c1b0: 22 29 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 ") (args:get-a
c1c0: 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 20 rg ":state")
c1d0: 22 25 22 29 29 0a 09 20 28 73 74 61 74 75 73 70 "%")).. (statusp
c1e0: 61 74 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 att (if (args:ge
c1f0: 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 22 29 t-arg ":status")
c200: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
c210: 22 3a 73 74 61 74 75 73 22 29 20 20 20 22 25 22 ":status") "%"
c220: 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 )).. (runname
c230: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
c240: 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 20 28 rg ":runname") (
c250: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
c260: 75 6e 6e 61 6d 65 22 29 20 20 22 25 22 29 29 0a unname") "%")).
c270: 09 20 28 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 . (paths-from-db
c280: 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e (cdb:remote-run
c290: 20 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 db:test-get-pat
c2a0: 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e hs-matching-keyn
c2b0: 61 6d 65 73 2d 74 61 72 67 65 74 20 64 62 20 6b ames-target db k
c2c0: 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 eynames target r
c2d0: 65 73 0a 09 09 09 09 09 74 65 73 74 70 61 74 74 es......testpatt
c2e0: 3a 20 20 20 74 65 73 74 70 61 74 74 0a 09 09 09 : testpatt....
c2f0: 09 09 73 74 61 74 65 70 61 74 74 3a 20 20 73 74 ..statepatt: st
c300: 61 74 65 70 61 74 74 0a 09 09 09 09 09 73 74 61 atepatt......sta
c310: 74 75 73 70 61 74 74 3a 20 73 74 61 74 75 73 70 tuspatt: statusp
c320: 61 74 74 0a 09 09 09 09 09 72 75 6e 6e 61 6d 65 att......runname
c330: 3a 20 20 20 20 72 75 6e 6e 61 6d 65 29 29 29 0a : runname))).
c340: 20 20 20 20 28 69 66 20 66 6e 61 6d 65 70 61 74 (if fnamepat
c350: 74 0a 09 28 61 70 70 6c 79 20 61 70 70 65 6e 64 t..(apply append
c360: 20 0a 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 .. (map (
c370: 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 20 20 20 lambda (p)...
c380: 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 (if (director
c390: 79 2d 65 78 69 73 74 73 3f 20 70 29 0a 09 09 09 y-exists? p)....
c3a0: 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 70 20 (glob (conc p
c3b0: 22 2f 22 20 66 6e 61 6d 65 70 61 74 74 29 29 0a "/" fnamepatt)).
c3c0: 09 09 09 20 20 27 28 29 29 29 0a 09 09 20 20 20 ... '()))...
c3d0: 20 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 paths-from-db))
c3e0: 0a 09 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 ..paths-from-db)
c3f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
c400: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
c410: 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 atching-keynames
c420: 2d 74 61 72 67 65 74 20 64 62 20 6b 65 79 6e 61 -target db keyna
c430: 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 20 0a mes target res .
c440: 09 09 09 09 09 09 20 20 20 20 23 21 6b 65 79 0a ...... #!key.
c450: 09 09 09 09 09 09 20 20 20 20 28 74 65 73 74 70 ...... (testp
c460: 61 74 74 20 20 20 22 25 22 29 0a 09 09 09 09 09 att "%")......
c470: 09 20 20 20 20 28 73 74 61 74 65 70 61 74 74 20 . (statepatt
c480: 20 22 25 22 29 0a 09 09 09 09 09 09 20 20 20 20 "%").......
c490: 28 73 74 61 74 75 73 70 61 74 74 20 22 25 22 29 (statuspatt "%")
c4a0: 0a 09 09 09 09 09 09 20 20 20 20 28 72 75 6e 6e ....... (runn
c4b0: 61 6d 65 20 20 20 20 22 25 22 29 29 0a 20 20 28 ame "%")). (
c4c0: 6c 65 74 2a 20 28 28 6b 65 79 73 74 72 20 28 73 let* ((keystr (s
c4d0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
c4e0: 65 20 0a 09 09 20 20 28 6d 61 70 20 28 6c 61 6d e ... (map (lam
c4f0: 62 64 61 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 bda (key val)...
c500: 09 20 28 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 . (conc "r." key
c510: 20 22 20 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 " like '" val "
c520: 27 22 29 29 0a 09 09 20 20 20 20 20 20 20 6b 65 '"))... ke
c530: 79 6e 61 6d 65 73 20 0a 09 09 20 20 20 20 20 20 ynames ...
c540: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 (string-split t
c550: 61 72 67 65 74 20 22 2f 22 29 29 0a 09 09 20 20 arget "/"))...
c560: 22 20 41 4e 44 20 22 29 29 0a 09 20 28 74 65 73 " AND ")).. (tes
c570: 74 71 72 79 20 28 74 65 73 74 73 3a 6d 61 74 63 tqry (tests:matc
c580: 68 2d 3e 73 71 6c 71 72 79 20 74 65 73 74 70 61 h->sqlqry testpa
c590: 74 74 29 29 0a 09 20 28 71 72 79 73 74 72 20 28 tt)).. (qrystr (
c5a0: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 74 2e 72 conc "SELECT t.r
c5b0: 75 6e 64 69 72 20 46 52 4f 4d 20 74 65 73 74 73 undir FROM tests
c5c0: 20 41 53 20 74 20 49 4e 4e 45 52 20 4a 4f 49 4e AS t INNER JOIN
c5d0: 20 72 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 2e runs AS r ON t.
c5e0: 72 75 6e 5f 69 64 3d 72 2e 69 64 20 57 48 45 52 run_id=r.id WHER
c5f0: 45 20 22 0a 09 09 20 20 20 20 20 20 20 6b 65 79 E "... key
c600: 73 74 72 20 22 20 41 4e 44 20 72 2e 72 75 6e 6e str " AND r.runn
c610: 61 6d 65 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e ame LIKE '" runn
c620: 61 6d 65 20 22 27 20 41 4e 44 20 22 20 74 65 73 ame "' AND " tes
c630: 74 71 72 79 0a 09 09 20 20 20 20 20 20 20 22 20 tqry... "
c640: 41 4e 44 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 AND t.state LIKE
c650: 20 27 22 20 73 74 61 74 65 70 61 74 74 20 22 27 '" statepatt "'
c660: 20 41 4e 44 20 74 2e 73 74 61 74 75 73 20 4c 49 AND t.status LI
c670: 4b 45 20 27 22 20 73 74 61 74 75 73 70 61 74 74 KE '" statuspatt
c680: 20 0a 09 09 20 20 20 20 20 20 20 22 27 20 4f 52 ... "' OR
c690: 44 45 52 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 DER BY t.event_t
c6a0: 69 6d 65 20 41 53 43 3b 22 29 29 29 0a 20 20 20 ime ASC;"))).
c6b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 (debug:print 3
c6c0: 22 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 "qrystr: " qryst
c6d0: 72 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a r). (sqlite3:
c6e0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 for-each-row .
c6f0: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 20 (lambda (p).
c700: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
c710: 28 63 6f 6e 73 20 70 20 72 65 73 29 29 29 0a 20 (cons p res))).
c720: 20 20 20 20 64 62 20 0a 20 20 20 20 20 71 72 79 db . qry
c730: 73 74 72 29 0a 20 20 20 20 72 65 73 29 29 0a 0a str). res))..
c740: 3b 3b 20 6c 6f 6f 6b 20 74 68 72 6f 75 67 68 20 ;; look through
c750: 74 65 73 74 73 20 66 72 6f 6d 20 6d 61 74 63 68 tests from match
c760: 69 6e 67 20 72 75 6e 73 20 66 6f 72 20 61 20 66 ing runs for a f
c770: 69 6c 65 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ile.(define (db:
c780: 74 65 73 74 2d 67 65 74 2d 66 69 72 73 74 2d 70 test-get-first-p
c790: 61 74 68 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 ath-matching db
c7a0: 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 keynames target
c7b0: 66 6e 61 6d 65 29 0a 20 20 3b 3b 20 5b 72 65 66 fname). ;; [ref
c7c0: 70 61 74 68 73 5d 20 69 73 20 74 68 65 20 73 65 paths] is the se
c7d0: 63 74 69 6f 6e 20 77 68 65 72 65 20 72 65 66 65 ction where refe
c7e0: 72 65 6e 63 65 73 20 74 6f 20 6f 74 68 65 72 20 rences to other
c7f0: 6d 65 67 61 74 65 73 74 20 64 61 74 61 62 61 73 megatest databas
c800: 65 73 20 61 72 65 20 73 74 6f 72 65 64 0a 20 20 es are stored.
c810: 28 6c 65 74 20 28 28 6d 74 2d 70 61 74 68 73 20 (let ((mt-paths
c820: 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 (configf:get-sec
c830: 74 69 6f 6e 20 22 72 65 66 70 61 74 68 73 22 29 tion "refpaths")
c840: 29 0a 09 28 72 65 73 20 20 20 20 20 20 20 28 64 )..(res (d
c850: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
c860: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
c870: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 names target fna
c880: 6d 65 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c me))). (let l
c890: 6f 6f 70 20 28 28 70 61 74 68 64 61 74 20 28 69 oop ((pathdat (i
c8a0: 66 20 28 6e 75 6c 6c 3f 20 70 61 74 68 73 29 20 f (null? paths)
c8b0: 23 66 20 28 63 61 72 20 6d 74 2d 70 61 74 68 73 #f (car mt-paths
c8c0: 29 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 6c ))).. (tal
c8d0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
c8e0: 70 61 74 68 73 29 20 27 28 29 28 63 64 72 20 6d paths) '()(cdr m
c8f0: 74 2d 70 61 74 68 73 29 29 29 29 0a 20 20 20 20 t-paths)))).
c900: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
c910: 3f 20 72 65 73 29 29 0a 09 20 20 28 63 61 72 20 ? res)).. (car
c920: 72 65 73 29 20 3b 3b 20 72 65 74 75 72 6e 20 66 res) ;; return f
c930: 69 72 73 74 20 66 6f 75 6e 64 0a 09 20 20 28 69 irst found.. (i
c940: 66 20 70 61 74 68 0a 09 20 20 20 20 20 20 28 6c f path.. (l
c950: 65 74 2a 20 28 28 64 62 20 20 20 20 20 28 6f 70 et* ((db (op
c960: 65 6e 2d 64 62 20 70 61 74 68 3a 20 28 63 61 64 en-db path: (cad
c970: 72 20 70 61 74 68 64 61 74 29 29 29 0a 09 09 20 r pathdat)))...
c980: 20 20 20 20 28 6e 65 77 72 65 73 20 28 64 62 3a (newres (db:
c990: 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d test-get-paths-m
c9a0: 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 atching db keyna
c9b0: 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 mes target fname
c9c0: 29 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 )))...(debug:pri
c9d0: 6e 74 2d 69 6e 66 6f 20 34 20 22 54 72 79 69 6e nt-info 4 "Tryin
c9e0: 67 20 22 20 28 63 61 72 20 70 61 74 68 64 61 74 g " (car pathdat
c9f0: 29 20 22 20 61 74 20 22 20 28 63 61 64 72 20 70 ) " at " (cadr p
ca00: 61 74 68 64 61 74 29 29 0a 09 09 28 73 71 6c 69 athdat))...(sqli
ca10: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
ca20: 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 )...(if (not (nu
ca30: 6c 6c 3f 20 6e 65 77 72 65 73 29 29 0a 09 09 20 ll? newres))...
ca40: 20 20 20 28 63 61 72 20 6e 65 77 72 65 73 29 0a (car newres).
ca50: 09 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f .. (if (null?
ca60: 20 74 61 6c 29 0a 09 09 09 23 66 0a 09 09 09 28 tal)....#f....(
ca70: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
ca80: 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 29 29 dr tal))))))))))
ca90: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
caa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 55 ==========.;; QU
cae0: 45 55 45 20 55 50 20 4d 45 54 41 2c 20 54 45 53 EUE UP META, TES
caf0: 54 20 53 54 41 54 55 53 20 41 4e 44 20 53 54 45 T STATUS AND STE
cb00: 50 53 20 52 45 4d 4f 54 45 20 41 43 43 45 53 53 PS REMOTE ACCESS
cb10: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
cb20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f =========..;; NO
cb60: 54 45 3a 20 43 61 6e 20 72 65 6d 6f 76 65 20 74 TE: Can remove t
cb70: 68 65 20 72 65 67 65 78 20 61 6e 64 20 62 61 73 he regex and bas
cb80: 65 36 34 20 65 6e 63 6f 64 69 6e 67 20 66 6f 72 e64 encoding for
cb90: 20 7a 6d 71 0a 28 64 65 66 69 6e 65 20 28 64 62 zmq.(define (db
cba0: 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 6f 62 6a :obj->string obj
cbb0: 29 0a 20 20 28 63 61 73 65 20 2a 74 72 61 6e 73 ). (case *trans
cbc0: 70 6f 72 74 2d 74 79 70 65 2a 0a 20 20 20 20 28 port-type*. (
cbd0: 28 66 73 29 20 6f 62 6a 29 0a 20 20 20 20 28 28 (fs) obj). ((
cbe0: 68 74 74 70 29 0a 20 20 20 20 20 28 73 74 72 69 http). (stri
cbf0: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 0a 20 20 ng-substitute.
cc00: 20 20 20 20 28 72 65 67 65 78 70 20 22 3d 22 29 (regexp "=")
cc10: 20 22 5f 22 0a 20 20 20 20 20 20 28 62 61 73 65 "_". (base
cc20: 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 64:base64-encode
cc30: 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f (with-output-to
cc40: 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 -string (lambda
cc50: 28 29 28 73 65 72 69 61 6c 69 7a 65 20 6f 62 6a ()(serialize obj
cc60: 29 29 29 29 0a 20 20 20 20 20 20 23 74 29 29 0a )))). #t)).
cc70: 20 20 20 20 28 28 7a 6d 71 29 28 77 69 74 68 2d ((zmq)(with-
cc80: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
cc90: 20 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69 (lambda ()(seri
cca0: 61 6c 69 7a 65 20 6f 62 6a 29 29 29 29 0a 20 20 alize obj)))).
ccb0: 20 20 28 65 6c 73 65 20 6f 62 6a 29 29 29 0a 0a (else obj)))..
ccc0: 28 64 65 66 69 6e 65 20 28 64 62 3a 73 74 72 69 (define (db:stri
ccd0: 6e 67 2d 3e 6f 62 6a 20 6d 73 67 29 0a 20 20 28 ng->obj msg). (
cce0: 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d case *transport-
ccf0: 74 79 70 65 2a 0a 20 20 20 28 28 66 73 29 20 6d type*. ((fs) m
cd00: 73 67 29 0a 20 20 20 28 28 68 74 74 70 29 0a 20 sg). ((http).
cd10: 20 20 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 (with-input-f
cd20: 72 6f 6d 2d 73 74 72 69 6e 67 20 0a 20 20 20 20 rom-string .
cd30: 20 20 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 (base64:base6
cd40: 34 2d 64 65 63 6f 64 65 0a 20 20 20 20 20 20 20 4-decode.
cd50: 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 (string-substi
cd60: 74 75 74 65 20 0a 09 20 20 20 28 72 65 67 65 78 tute .. (regex
cd70: 70 20 22 5f 22 29 20 22 3d 22 20 6d 73 67 20 23 p "_") "=" msg #
cd80: 74 29 29 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 t)). (lamb
cd90: 64 61 20 28 29 28 64 65 73 65 72 69 61 6c 69 7a da ()(deserializ
cda0: 65 29 29 29 29 0a 20 20 20 28 28 7a 6d 71 29 28 e)))). ((zmq)(
cdb0: 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d with-input-from-
cdc0: 73 74 72 69 6e 67 20 6d 73 67 20 28 6c 61 6d 62 string msg (lamb
cdd0: 64 61 20 28 29 28 64 65 73 65 72 69 61 6c 69 7a da ()(deserializ
cde0: 65 29 29 29 29 0a 20 20 20 28 65 6c 73 65 20 6d e)))). (else m
cdf0: 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sg)))..(define (
ce00: 63 64 62 3a 75 73 65 2d 6e 6f 6e 2d 62 6c 6f 63 cdb:use-non-bloc
ce10: 6b 69 6e 67 2d 6d 6f 64 65 20 70 72 6f 63 29 0a king-mode proc).
ce20: 20 20 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d (set! *client-
ce30: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 non-blocking-mod
ce40: 65 2a 20 23 74 29 0a 20 20 28 6c 65 74 20 28 28 e* #t). (let ((
ce50: 72 65 73 20 28 70 72 6f 63 29 29 29 0a 20 20 20 res (proc))).
ce60: 20 28 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e (set! *client-n
ce70: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 on-blocking-mode
ce80: 2a 20 23 66 29 0a 20 20 20 20 72 65 73 29 29 0a * #f). res)).
ce90: 20 20 0a 3b 3b 20 70 61 72 61 6d 73 20 3d 20 27 .;; params = '
cea0: 74 61 72 67 65 74 20 63 61 63 68 65 64 20 72 65 target cached re
ceb0: 6d 70 61 72 61 6d 73 0a 3b 3b 0a 3b 3b 20 6d 61 mparams.;;.;; ma
cec0: 6b 65 2d 76 65 63 74 6f 72 2d 72 65 63 6f 72 64 ke-vector-record
ced0: 20 63 64 62 20 70 61 63 6b 65 74 20 63 6c 69 65 cdb packet clie
cee0: 6e 74 2d 73 69 67 20 71 74 79 70 65 20 69 6d 6d nt-sig qtype imm
cef0: 65 64 69 61 74 65 20 71 75 65 72 79 2d 73 69 67 ediate query-sig
cf00: 20 70 61 72 61 6d 73 20 71 74 69 6d 65 0a 3b 3b params qtime.;;
cf10: 0a 3b 3b 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 .;; cdb:client-c
cf20: 61 6c 6c 20 69 73 20 74 68 65 20 75 6e 69 66 69 all is the unifi
cf30: 65 64 20 69 6e 74 65 72 66 61 63 65 20 74 6f 20 ed interface to
cf40: 61 6c 6c 20 74 68 65 20 74 72 61 6e 73 70 6f 72 all the transpor
cf50: 74 73 2e 20 49 74 20 64 69 73 70 61 74 63 68 65 ts. It dispatche
cf60: 73 20 74 68 65 0a 3b 3b 20 20 20 20 20 20 20 20 s the.;;
cf70: 20 20 20 20 20 20 20 20 20 71 75 65 72 79 20 74 query t
cf80: 6f 20 61 20 73 65 72 76 65 72 20 72 6f 75 74 69 o a server routi
cf90: 6e 65 20 28 65 2e 67 2e 20 73 65 72 76 65 72 3a ne (e.g. server:
cfa0: 63 6c 69 65 6e 74 2d 73 65 6e 64 2d 72 65 63 69 client-send-reci
cfb0: 65 76 65 29 20 74 68 61 74 20 0a 3b 3b 20 20 20 eve) that .;;
cfc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 72 tr
cfd0: 61 6e 73 70 6f 72 74 73 20 74 68 65 20 64 61 74 ansports the dat
cfe0: 61 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 20 a to the server
cff0: 77 68 65 72 65 20 69 74 20 69 73 20 70 61 73 73 where it is pass
d000: 65 64 20 74 6f 20 64 62 3a 70 72 6f 63 65 73 73 ed to db:process
d010: 2d 71 75 65 75 65 2d 69 74 65 6d 0a 3b 3b 20 20 -queue-item.;;
d020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 77 w
d030: 68 69 63 68 20 65 69 74 68 65 72 20 72 65 74 75 hich either retu
d040: 72 6e 73 20 74 68 65 20 64 61 74 61 20 74 6f 20 rns the data to
d050: 74 68 65 20 63 61 6c 6c 69 6e 67 20 73 65 72 76 the calling serv
d060: 65 72 20 72 6f 75 74 69 6e 65 20 6f 72 20 0a 3b er routine or .;
d070: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
d080: 20 20 64 69 72 65 63 74 6c 79 20 63 61 6c 6c 73 directly calls
d090: 20 74 68 65 20 72 65 74 75 72 6e 69 6e 67 20 70 the returning p
d0a0: 72 6f 63 65 64 75 72 65 20 28 65 2e 67 2e 20 7a rocedure (e.g. z
d0b0: 6d 71 29 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 mq)..;;.(define
d0c0: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c (cdb:client-call
d0d0: 20 73 65 72 76 65 72 64 61 74 20 71 74 79 70 65 serverdat qtype
d0e0: 20 69 6d 6d 65 64 69 61 74 65 20 6e 75 6d 72 65 immediate numre
d0f0: 74 72 69 65 73 20 2e 20 70 61 72 61 6d 73 29 0a tries . params).
d100: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
d110: 6e 66 6f 20 31 31 20 22 63 64 62 3a 63 6c 69 65 nfo 11 "cdb:clie
d120: 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 nt-call serverda
d130: 74 3d 22 20 73 65 72 76 65 72 64 61 74 20 22 2c t=" serverdat ",
d140: 20 71 74 79 70 65 3d 22 20 71 74 79 70 65 20 22 qtype=" qtype "
d150: 2c 20 69 6d 6d 65 64 69 61 74 65 3d 22 20 69 6d , immediate=" im
d160: 6d 65 64 69 61 74 65 20 22 2c 20 6e 75 6d 72 65 mediate ", numre
d170: 74 72 69 65 73 3d 22 20 6e 75 6d 72 65 74 72 69 tries=" numretri
d180: 65 73 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 es ", params=" p
d190: 61 72 61 6d 73 29 0a 20 20 28 63 61 73 65 20 2a arams). (case *
d1a0: 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 20 transport-type*
d1b0: 0a 20 20 20 20 28 28 66 73 29 0a 20 20 20 20 20 . ((fs).
d1c0: 28 6c 65 74 20 28 28 70 61 63 6b 65 74 20 28 76 (let ((packet (v
d1d0: 65 63 74 6f 72 20 22 6e 61 22 20 71 74 79 70 65 ector "na" qtype
d1e0: 20 69 6d 6d 65 64 69 61 74 65 20 22 6e 61 22 20 immediate "na"
d1f0: 70 61 72 61 6d 73 20 30 29 29 29 0a 20 20 20 20 params 0))).
d200: 20 20 20 28 66 73 3a 70 72 6f 63 65 73 73 2d 71 (fs:process-q
d210: 75 65 75 65 2d 69 74 65 6d 20 70 61 63 6b 65 74 ueue-item packet
d220: 29 29 29 0a 20 20 20 20 28 28 68 74 74 70 29 0a ))). ((http).
d230: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6c 69 (let* ((cli
d240: 65 6e 74 2d 73 69 67 20 20 28 63 6c 69 65 6e 74 ent-sig (client
d250: 3a 67 65 74 2d 73 69 67 6e 61 74 75 72 65 29 29 :get-signature))
d260: 0a 09 20 20 20 20 28 71 75 65 72 79 2d 73 69 67 .. (query-sig
d270: 20 20 20 28 6d 65 73 73 61 67 65 2d 64 69 67 65 (message-dige
d280: 73 74 2d 73 74 72 69 6e 67 20 28 6d 64 35 2d 70 st-string (md5-p
d290: 72 69 6d 69 74 69 76 65 29 20 28 63 6f 6e 63 20 rimitive) (conc
d2a0: 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 qtype immediate
d2b0: 70 61 72 61 6d 73 29 29 29 0a 09 20 20 20 20 28 params))).. (
d2c0: 7a 64 61 74 20 20 20 20 20 20 20 20 28 64 62 3a zdat (db:
d2d0: 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 28 76 65 63 obj->string (vec
d2e0: 74 6f 72 20 63 6c 69 65 6e 74 2d 73 69 67 20 71 tor client-sig q
d2f0: 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 71 type immediate q
d300: 75 65 72 79 2d 73 69 67 20 70 61 72 61 6d 73 20 uery-sig params
d310: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
d320: 29 29 29 29 29 20 3b 3b 20 28 77 69 74 68 2d 6f ))))) ;; (with-o
d330: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 utput-to-string
d340: 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69 61 (lambda ()(seria
d350: 6c 69 7a 65 20 70 61 72 61 6d 73 29 29 29 29 0a lize params)))).
d360: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
d370: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 7a 64 61 int-info 11 "zda
d380: 74 3d 22 20 7a 64 61 74 29 0a 20 20 20 20 20 20 t=" zdat).
d390: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 23 66 (let* ((res #f
d3a0: 29 0a 09 20 20 20 20 20 20 28 72 61 77 64 61 74 ).. (rawdat
d3b0: 20 20 20 20 20 20 28 68 74 74 70 2d 74 72 61 6e (http-tran
d3c0: 73 70 6f 72 74 3a 63 6c 69 65 6e 74 2d 73 65 6e sport:client-sen
d3d0: 64 2d 72 65 63 65 69 76 65 20 73 65 72 76 65 72 d-receive server
d3e0: 64 61 74 20 7a 64 61 74 29 29 0a 09 20 20 20 20 dat zdat))..
d3f0: 20 20 28 74 6d 70 20 20 20 20 20 20 20 20 20 23 (tmp #
d400: 66 29 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 f)).. (debug:pri
d410: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 53 65 6e 74 nt-info 11 "Sent
d420: 20 22 20 7a 64 61 74 20 22 2c 20 72 65 63 65 69 " zdat ", recei
d430: 76 65 64 20 22 20 72 61 77 64 61 74 29 0a 09 20 ved " rawdat)..
d440: 28 73 65 74 21 20 74 6d 70 20 28 64 62 3a 73 74 (set! tmp (db:st
d450: 72 69 6e 67 2d 3e 6f 62 6a 20 72 61 77 64 61 74 ring->obj rawdat
d460: 29 29 0a 09 20 28 76 65 63 74 6f 72 2d 72 65 66 )).. (vector-ref
d470: 20 74 6d 70 20 32 29 29 29 29 0a 20 20 20 20 28 tmp 2)))). (
d480: 28 7a 6d 71 29 0a 20 20 20 20 20 28 68 61 6e 64 (zmq). (hand
d490: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 le-exceptions.
d4a0: 20 20 20 20 65 78 6e 0a 20 20 20 20 20 20 28 62 exn. (b
d4b0: 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 egin..(debug:pri
d4c0: 6e 74 2d 69 6e 66 6f 20 30 20 22 63 64 62 3a 63 nt-info 0 "cdb:c
d4d0: 6c 69 65 6e 74 2d 63 61 6c 6c 20 74 69 6d 65 6f lient-call timeo
d4e0: 75 74 20 6f 72 20 65 72 72 6f 72 2e 20 54 72 79 ut or error. Try
d4f0: 69 6e 67 20 61 67 61 69 6e 20 69 6e 20 35 20 73 ing again in 5 s
d500: 65 63 6f 6e 64 73 22 29 0a 09 28 74 68 72 65 61 econds")..(threa
d510: 64 2d 73 6c 65 65 70 21 20 35 29 20 0a 09 28 69 d-sleep! 5) ..(i
d520: 66 20 28 3e 20 6e 75 6d 72 65 74 72 69 65 73 20 f (> numretries
d530: 30 29 28 61 70 70 6c 79 20 63 64 62 3a 63 6c 69 0)(apply cdb:cli
d540: 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 ent-call serverd
d550: 61 74 20 71 74 79 70 65 20 69 6d 6d 65 64 69 61 at qtype immedia
d560: 74 65 20 28 2d 20 6e 75 6d 72 65 74 72 69 65 73 te (- numretries
d570: 20 31 29 20 70 61 72 61 6d 73 29 29 29 0a 20 20 1) params))).
d580: 20 20 20 20 28 6c 65 74 2a 20 28 28 70 75 73 68 (let* ((push
d590: 2d 73 6f 63 6b 65 74 20 28 76 65 63 74 6f 72 2d -socket (vector-
d5a0: 72 65 66 20 73 65 72 76 65 72 64 61 74 20 30 29 ref serverdat 0)
d5b0: 29 0a 09 20 20 20 20 20 28 73 75 62 2d 73 6f 63 ).. (sub-soc
d5c0: 6b 65 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ket (vector-ref
d5d0: 20 73 65 72 76 65 72 64 61 74 20 31 29 29 0a 09 serverdat 1))..
d5e0: 20 20 20 20 20 28 63 6c 69 65 6e 74 2d 73 69 67 (client-sig
d5f0: 20 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 69 (client:get-si
d600: 67 6e 61 74 75 72 65 29 29 0a 09 20 20 20 20 20 gnature))..
d610: 28 71 75 65 72 79 2d 73 69 67 20 20 20 28 6d 65 (query-sig (me
d620: 73 73 61 67 65 2d 64 69 67 65 73 74 2d 73 74 72 ssage-digest-str
d630: 69 6e 67 20 28 6d 64 35 2d 70 72 69 6d 69 74 69 ing (md5-primiti
d640: 76 65 29 20 28 63 6f 6e 63 20 71 74 79 70 65 20 ve) (conc qtype
d650: 69 6d 6d 65 64 69 61 74 65 20 70 61 72 61 6d 73 immediate params
d660: 29 29 29 0a 09 20 20 20 20 20 28 7a 64 61 74 20 ))).. (zdat
d670: 20 20 20 20 20 20 20 28 64 62 3a 6f 62 6a 2d 3e (db:obj->
d680: 73 74 72 69 6e 67 20 28 76 65 63 74 6f 72 20 63 string (vector c
d690: 6c 69 65 6e 74 2d 73 69 67 20 71 74 79 70 65 20 lient-sig qtype
d6a0: 69 6d 6d 65 64 69 61 74 65 20 71 75 65 72 79 2d immediate query-
d6b0: 73 69 67 20 70 61 72 61 6d 73 20 28 63 75 72 72 sig params (curr
d6c0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 20 ent-seconds))))
d6d0: 3b 3b 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d ;; (with-output-
d6e0: 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 to-string (lambd
d6f0: 61 20 28 29 28 73 65 72 69 61 6c 69 7a 65 20 70 a ()(serialize p
d700: 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 20 arams))))..
d710: 28 72 65 73 20 20 23 66 29 0a 09 20 20 20 20 20 (res #f)..
d720: 28 73 65 6e 64 2d 72 65 63 65 69 76 65 20 28 6c (send-receive (l
d730: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 20 ambda ()....
d740: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
d750: 66 6f 20 31 31 20 22 73 65 6e 64 69 6e 67 20 6d fo 11 "sending m
d760: 65 73 73 61 67 65 22 29 0a 09 09 09 20 20 20 20 essage")....
d770: 20 28 73 65 6e 64 2d 6d 65 73 73 61 67 65 20 70 (send-message p
d780: 75 73 68 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 ush-socket zdat)
d790: 0a 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
d7a0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6d print-info 11 "m
d7b0: 65 73 73 61 67 65 20 73 65 6e 74 22 29 0a 09 09 essage sent")...
d7c0: 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 . (let loop
d7d0: 28 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b 20 ().... ;;
d7e0: 67 65 74 20 74 68 65 20 73 65 6e 64 65 72 20 69 get the sender i
d7f0: 6e 66 6f 0a 09 09 09 20 20 20 20 20 20 20 3b 3b nfo.... ;;
d800: 20 74 68 69 73 20 73 68 6f 75 6c 64 20 6d 61 74 this should mat
d810: 63 68 20 28 63 6c 69 65 6e 74 3a 67 65 74 2d 73 ch (client:get-s
d820: 69 67 6e 61 74 75 72 65 29 0a 09 09 09 20 20 20 ignature)....
d830: 20 20 20 20 3b 3b 20 77 65 20 77 69 6c 6c 20 6e ;; we will n
d840: 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 22 eed to process "
d850: 61 6c 6c 22 20 6d 65 73 73 61 67 65 73 20 68 65 all" messages he
d860: 72 65 20 73 6f 6d 65 20 64 61 79 0a 09 09 09 20 re some day....
d870: 20 20 20 20 20 20 28 72 65 63 65 69 76 65 2d 6d (receive-m
d880: 65 73 73 61 67 65 2a 20 73 75 62 2d 73 6f 63 6b essage* sub-sock
d890: 65 74 29 0a 09 09 09 20 20 20 20 20 20 20 3b 3b et).... ;;
d8a0: 20 6e 6f 77 20 67 65 74 20 74 68 65 20 61 63 74 now get the act
d8b0: 75 61 6c 20 6d 65 73 73 61 67 65 0a 09 09 09 20 ual message....
d8c0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6d 79 72 (let ((myr
d8d0: 65 73 20 28 64 62 3a 73 74 72 69 6e 67 2d 3e 6f es (db:string->o
d8e0: 62 6a 20 28 72 65 63 65 69 76 65 2d 6d 65 73 73 bj (receive-mess
d8f0: 61 67 65 2a 20 73 75 62 2d 73 6f 63 6b 65 74 29 age* sub-socket)
d900: 29 29 29 0a 09 09 09 09 20 28 69 66 20 28 65 71 )))..... (if (eq
d910: 75 61 6c 3f 20 71 75 65 72 79 2d 73 69 67 20 28 ual? query-sig (
d920: 76 65 63 74 6f 72 2d 72 65 66 20 6d 79 72 65 73 vector-ref myres
d930: 20 31 29 29 0a 09 09 09 09 20 20 20 20 20 28 73 1))..... (s
d940: 65 74 21 20 72 65 73 20 28 76 65 63 74 6f 72 2d et! res (vector-
d950: 72 65 66 20 6d 79 72 65 73 20 32 29 29 0a 09 09 ref myres 2))...
d960: 09 09 20 20 20 20 20 28 6c 6f 6f 70 29 29 29 29 .. (loop))))
d970: 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 74 69 6d ))).. ;; (tim
d980: 65 6f 75 74 20 28 6c 61 6d 62 64 61 20 28 29 0a eout (lambda ().
d990: 09 20 20 20 20 3b 3b 20 20 20 20 20 09 28 6c 65 . ;; .(le
d9a0: 74 20 6c 6f 6f 70 20 28 28 6e 20 6e 75 6d 72 65 t loop ((n numre
d9b0: 74 72 69 65 73 29 29 0a 09 20 20 20 20 3b 3b 20 tries)).. ;;
d9c0: 20 20 20 20 09 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
d9d0: 6c 65 65 70 21 20 31 35 29 0a 09 20 20 20 20 3b leep! 15).. ;
d9e0: 3b 20 20 20 20 20 09 20 20 28 69 66 20 28 6e 6f ; . (if (no
d9f0: 74 20 72 65 73 29 0a 09 20 20 20 20 3b 3b 20 20 t res).. ;;
da00: 20 20 20 09 20 20 20 20 20 20 28 69 66 20 28 3e . (if (>
da10: 20 6e 75 6d 72 65 74 72 69 65 73 20 30 29 0a 09 numretries 0)..
da20: 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 28 ;; .. (
da30: 62 65 67 69 6e 0a 09 20 20 20 20 3b 3b 20 20 20 begin.. ;;
da40: 20 20 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
da50: 72 69 6e 74 20 32 20 22 57 41 52 4e 49 4e 47 3a rint 2 "WARNING:
da60: 20 6e 6f 20 72 65 70 6c 79 20 74 6f 20 71 75 65 no reply to que
da70: 72 79 20 22 20 70 61 72 61 6d 73 20 22 2c 20 74 ry " params ", t
da80: 72 79 69 6e 67 20 72 65 73 65 6e 64 22 29 0a 09 rying resend")..
da90: 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 20 ;; ..
daa0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
dab0: 66 6f 20 31 31 20 22 72 65 2d 73 65 6e 64 69 6e fo 11 "re-sendin
dac0: 67 20 6d 65 73 73 61 67 65 22 29 0a 09 20 20 20 g message")..
dad0: 20 3b 3b 20 20 20 20 20 09 09 20 20 20 20 28 73 ;; .. (s
dae0: 65 6e 64 2d 6d 65 73 73 61 67 65 20 70 75 73 68 end-message push
daf0: 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 0a 09 20 -socket zdat)..
db00: 20 20 20 3b 3b 20 20 20 20 20 09 09 20 20 20 20 ;; ..
db10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
db20: 6f 20 31 31 20 22 6d 65 73 73 61 67 65 20 72 65 o 11 "message re
db30: 2d 73 65 6e 74 22 29 0a 09 20 20 20 20 3b 3b 20 -sent").. ;;
db40: 20 20 20 20 09 09 20 20 20 20 28 6c 6f 6f 70 20 .. (loop
db50: 28 2d 20 6e 20 31 29 29 29 0a 09 20 20 20 20 3b (- n 1))).. ;
db60: 3b 20 20 20 20 20 09 09 20 20 3b 3b 20 28 61 70 ; .. ;; (ap
db70: 70 6c 79 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 ply cdb:client-c
db80: 61 6c 6c 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 all *runremote*
db90: 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 qtype immediate
dba0: 28 2d 20 6e 75 6d 72 65 74 72 69 65 73 20 31 29 (- numretries 1)
dbb0: 20 70 61 72 61 6d 73 29 29 0a 09 20 20 20 20 3b params)).. ;
dbc0: 3b 20 20 20 20 20 09 09 20 20 28 62 65 67 69 6e ; .. (begin
dbd0: 0a 09 20 20 20 20 3b 3b 20 20 20 20 20 09 09 20 .. ;; ..
dbe0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
dbf0: 30 20 22 45 52 52 4f 52 3a 20 63 64 62 3a 63 6c 0 "ERROR: cdb:cl
dc00: 69 65 6e 74 2d 63 61 6c 6c 20 74 69 6d 65 64 20 ient-call timed
dc10: 6f 75 74 20 22 20 70 61 72 61 6d 73 20 22 2c 20 out " params ",
dc20: 65 78 69 74 69 6e 67 2e 22 29 0a 09 20 20 20 20 exiting.")..
dc30: 3b 3b 20 20 20 20 20 09 09 20 20 20 20 28 65 78 ;; .. (ex
dc40: 69 74 20 35 29 29 29 29 29 29 29 29 0a 09 28 64 it 5))))))))..(d
dc50: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
dc60: 31 31 20 22 53 74 61 72 74 69 6e 67 20 74 68 72 11 "Starting thr
dc70: 65 61 64 73 22 29 0a 09 28 6c 65 74 20 28 28 74 eads")..(let ((t
dc80: 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 h1 (make-thread
dc90: 73 65 6e 64 2d 72 65 63 65 69 76 65 20 22 73 65 send-receive "se
dca0: 6e 64 20 72 65 63 65 69 76 65 22 29 29 0a 09 20 nd receive"))..
dcb0: 20 20 20 20 20 3b 3b 20 28 74 68 32 20 28 6d 61 ;; (th2 (ma
dcc0: 6b 65 2d 74 68 72 65 61 64 20 74 69 6d 65 6f 75 ke-thread timeou
dcd0: 74 20 20 20 20 20 20 22 74 69 6d 65 6f 75 74 22 t "timeout"
dce0: 29 29 0a 09 20 20 20 20 20 20 29 0a 09 20 20 28 )).. ).. (
dcf0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
dd00: 31 29 0a 09 20 20 3b 3b 20 28 74 68 72 65 61 64 1).. ;; (thread
dd10: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 -start! th2)..
dd20: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 20 74 (thread-join! t
dd30: 68 31 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 h1).. (debug:pr
dd40: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 63 64 62 int-info 11 "cdb
dd50: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 72 65 74 :client-call ret
dd60: 75 72 6e 69 6e 67 20 72 65 73 3d 22 20 72 65 73 urning res=" res
dd70: 29 0a 09 20 20 72 65 73 29 29 29 29 29 29 0a 20 ).. res)))))).
dd80: 20 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 .(define (cdb:s
dd90: 65 74 2d 76 65 72 62 6f 73 69 74 79 20 73 65 72 et-verbosity ser
dda0: 76 65 72 64 61 74 20 76 61 6c 29 0a 20 20 28 63 verdat val). (c
ddb0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 db:client-call s
ddc0: 65 72 76 65 72 64 61 74 20 27 73 65 74 2d 76 65 erverdat 'set-ve
ddd0: 72 62 6f 73 69 74 79 20 23 66 20 2a 64 65 66 61 rbosity #f *defa
dde0: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 76 61 ult-numtries* va
ddf0: 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 l))..(define (cd
de00: 62 3a 6c 6f 67 69 6e 20 73 65 72 76 65 72 64 61 b:login serverda
de10: 74 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 t keyval signatu
de20: 72 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e re). (cdb:clien
de30: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
de40: 20 27 6c 6f 67 69 6e 20 23 74 20 2a 64 65 66 61 'login #t *defa
de50: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 ult-numtries* ke
de60: 79 76 61 6c 20 6d 65 67 61 74 65 73 74 2d 76 65 yval megatest-ve
de70: 72 73 69 6f 6e 20 73 69 67 6e 61 74 75 72 65 29 rsion signature)
de80: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
de90: 6c 6f 67 6f 75 74 20 73 65 72 76 65 72 64 61 74 logout serverdat
dea0: 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 75 72 keyval signatur
deb0: 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 e). (cdb:client
dec0: 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 20 -call serverdat
ded0: 27 6c 6f 67 6f 75 74 20 23 74 20 2a 64 65 66 61 'logout #t *defa
dee0: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6b 65 ult-numtries* ke
def0: 79 76 61 6c 20 73 69 67 6e 61 74 75 72 65 29 29 yval signature))
df00: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6e ..(define (cdb:n
df10: 75 6d 2d 63 6c 69 65 6e 74 73 20 73 65 72 76 65 um-clients serve
df20: 72 64 61 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 rdat). (cdb:cli
df30: 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 ent-call serverd
df40: 61 74 20 27 6e 75 6d 63 6c 69 65 6e 74 73 20 23 at 'numclients #
df50: 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 t *default-numtr
df60: 69 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 ies*))..(define
df70: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (cdb:test-set-st
df80: 61 74 75 73 2d 73 74 61 74 65 20 73 65 72 76 65 atus-state serve
df90: 72 64 61 74 20 74 65 73 74 2d 69 64 20 73 74 61 rdat test-id sta
dfa0: 74 75 73 20 73 74 61 74 65 20 6d 73 67 29 0a 20 tus state msg).
dfb0: 20 28 69 66 20 6d 73 67 0a 20 20 20 20 20 20 28 (if msg. (
dfc0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
dfd0: 73 65 72 76 65 72 64 61 74 20 27 73 74 61 74 65 serverdat 'state
dfe0: 2d 73 74 61 74 75 73 2d 6d 73 67 20 23 74 20 2a -status-msg #t *
dff0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
e000: 2a 20 73 74 61 74 65 20 73 74 61 74 75 73 20 6d * state status m
e010: 73 67 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 sg test-id).
e020: 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 (cdb:client-ca
e030: 6c 6c 20 73 65 72 76 65 72 64 61 74 20 27 73 74 ll serverdat 'st
e040: 61 74 65 2d 73 74 61 74 75 73 20 23 74 20 2a 64 ate-status #t *d
e050: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a efault-numtries*
e060: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 74 65 state status te
e070: 73 74 2d 69 64 29 29 29 20 3b 3b 20 72 75 6e 2d st-id))) ;; run-
e080: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
e090: 6d 2d 70 61 74 68 20 6d 69 6e 75 74 65 73 20 63 m-path minutes c
e0a0: 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 puload diskfree
e0b0: 74 6d 70 66 72 65 65 29 20 0a 0a 28 64 65 66 69 tmpfree) ..(defi
e0c0: 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 72 6f 6c ne (cdb:test-rol
e0d0: 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 lup-test_data-pa
e0e0: 73 73 2d 66 61 69 6c 20 73 65 72 76 65 72 64 61 ss-fail serverda
e0f0: 74 20 74 65 73 74 2d 69 64 29 0a 20 20 28 63 64 t test-id). (cd
e100: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 b:client-call se
e110: 72 76 65 72 64 61 74 20 27 74 65 73 74 5f 64 61 rverdat 'test_da
e120: 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 20 23 74 20 ta-pf-rollup #t
e130: 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 *default-numtrie
e140: 73 2a 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d s* test-id test-
e150: 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d id test-id test-
e160: 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 id))..(define (c
e170: 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 db:pass-fail-cou
e180: 6e 74 73 20 73 65 72 76 65 72 64 61 74 20 74 65 nts serverdat te
e190: 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 st-id fail-count
e1a0: 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a 20 20 28 pass-count). (
e1b0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
e1c0: 73 65 72 76 65 72 64 61 74 20 27 70 61 73 73 2d serverdat 'pass-
e1d0: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 23 74 20 2a fail-counts #t *
e1e0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
e1f0: 2a 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 * fail-count pas
e200: 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d 69 64 29 s-count test-id)
e210: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a )..(define (cdb:
e220: 74 65 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 tests-register-t
e230: 65 73 74 20 73 65 72 76 65 72 64 61 74 20 72 75 est serverdat ru
e240: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
e250: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 63 64 62 tem-path). (cdb
e260: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 :client-call ser
e270: 76 65 72 64 61 74 20 27 72 65 67 69 73 74 65 72 verdat 'register
e280: 2d 74 65 73 74 20 23 74 20 2a 64 65 66 61 75 6c -test #t *defaul
e290: 74 2d 6e 75 6d 74 72 69 65 73 2a 20 72 75 6e 2d t-numtries* run-
e2a0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
e2b0: 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 6e m-path))..(defin
e2c0: 65 20 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 e (cdb:flush-que
e2d0: 75 65 20 73 65 72 76 65 72 64 61 74 29 0a 20 20 ue serverdat).
e2e0: 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c (cdb:client-call
e2f0: 20 73 65 72 76 65 72 64 61 74 20 27 66 6c 75 73 serverdat 'flus
e300: 68 20 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 h #f *default-nu
e310: 6d 74 72 69 65 73 2a 29 29 0a 0a 28 64 65 66 69 mtries*))..(defi
e320: 6e 65 20 28 63 64 62 3a 6b 69 6c 6c 2d 73 65 72 ne (cdb:kill-ser
e330: 76 65 72 20 73 65 72 76 65 72 64 61 74 29 0a 20 ver serverdat).
e340: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
e350: 6c 20 73 65 72 76 65 72 64 61 74 20 27 6b 69 6c l serverdat 'kil
e360: 6c 73 65 72 76 65 72 20 23 74 20 2a 64 65 66 61 lserver #t *defa
e370: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a ult-numtries*)).
e380: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 72 6f .(define (cdb:ro
e390: 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d ll-up-pass-fail-
e3a0: 63 6f 75 6e 74 73 20 73 65 72 76 65 72 64 61 74 counts serverdat
e3b0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
e3c0: 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 e item-path stat
e3d0: 75 73 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e us). (cdb:clien
e3e0: 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 61 74 t-call serverdat
e3f0: 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 20 2a 'immediate #f *
e400: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
e410: 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 * open-run-close
e420: 20 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 db:roll-up-pass
e430: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 23 66 20 -fail-counts #f
e440: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
e450: 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 item-path statu
e460: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 s))..(define (cd
e470: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 b:get-test-info
e480: 73 65 72 76 65 72 64 61 74 20 72 75 6e 2d 69 64 serverdat run-id
e490: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
e4a0: 70 61 74 68 29 0a 20 20 28 63 64 62 3a 63 6c 69 path). (cdb:cli
e4b0: 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 65 72 64 ent-call serverd
e4c0: 61 74 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 at 'immediate #f
e4d0: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
e4e0: 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f es* open-run-clo
e4f0: 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 se db:get-test-i
e500: 6e 66 6f 20 23 66 20 72 75 6e 2d 69 64 20 74 65 nfo #f run-id te
e510: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
e520: 68 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 h))..(define (cd
e530: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
e540: 62 79 2d 69 64 20 73 65 72 76 65 72 64 61 74 20 by-id serverdat
e550: 74 65 73 74 2d 69 64 29 0a 20 20 28 63 64 62 3a test-id). (cdb:
e560: 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 73 65 72 76 client-call serv
e570: 65 72 64 61 74 20 27 69 6d 6d 65 64 69 61 74 65 erdat 'immediate
e580: 20 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d #f *default-num
e590: 74 72 69 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d tries* open-run-
e5a0: 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 close db:get-tes
e5b0: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 20 t-info-by-id #f
e5c0: 74 65 73 74 2d 69 64 29 29 0a 0a 3b 3b 20 64 62 test-id))..;; db
e5d0: 20 73 68 6f 75 6c 64 20 62 65 20 64 62 20 6f 70 should be db op
e5e0: 65 6e 20 70 72 6f 63 20 6f 72 20 23 66 0a 28 64 en proc or #f.(d
e5f0: 65 66 69 6e 65 20 28 63 64 62 3a 72 65 6d 6f 74 efine (cdb:remot
e600: 65 2d 72 75 6e 20 70 72 6f 63 20 64 62 20 2e 20 e-run proc db .
e610: 70 61 72 61 6d 73 29 0a 20 20 28 61 70 70 6c 79 params). (apply
e620: 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c cdb:client-call
e630: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 27 69 6d *runremote* 'im
e640: 6d 65 64 69 61 74 65 20 23 66 20 2a 64 65 66 61 mediate #f *defa
e650: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 ult-numtries* op
e660: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 70 72 6f en-run-close pro
e670: 63 20 23 66 20 70 61 72 61 6d 73 29 29 0a 0a 28 c #f params))..(
e680: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
e690: 67 65 74 2d 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f get-logfile-info
e6a0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
e6b0: 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 72 name). (let ((r
e6c0: 65 73 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c es #f)). (sql
e6d0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
e6e0: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
e6f0: 28 70 61 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 (path final_logf
e700: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6c ). (set! l
e710: 6f 67 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a ogf final_logf).
e720: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
e730: 20 28 6c 69 73 74 20 70 61 74 68 20 66 69 6e 61 (list path fina
e740: 6c 5f 6c 6f 67 66 29 29 0a 20 20 20 20 20 20 20 l_logf)).
e750: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 (if (directory?
e760: 70 61 74 68 29 0a 09 20 20 20 28 64 65 62 75 67 path).. (debug
e770: 3a 70 72 69 6e 74 20 32 20 22 46 6f 75 6e 64 20 :print 2 "Found
e780: 70 61 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 path: " path)..
e790: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
e7a0: 20 22 4e 6f 20 73 75 63 68 20 70 61 74 68 3a 20 "No such path:
e7b0: 22 20 70 61 74 68 29 29 29 0a 20 20 20 20 20 64 " path))). d
e7c0: 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 72 b. "SELECT r
e7d0: 75 6e 64 69 72 2c 66 69 6e 61 6c 5f 6c 6f 67 66 undir,final_logf
e7e0: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
e7f0: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
e800: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
e810: 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a 20 20 20 em_path='';".
e820: 20 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 run-id test-na
e830: 6d 65 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b me). res))..;
e840: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
e850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e880: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 47 20 52 =======.;; A G R
e890: 20 45 20 47 20 41 20 54 20 45 20 44 20 20 20 54 E G A T E D T
e8a0: 20 52 20 41 20 4e 20 53 20 41 20 43 20 54 20 49 R A N S A C T I
e8b0: 20 4f 20 4e 20 20 20 44 20 42 20 20 20 57 20 52 O N D B W R
e8c0: 20 49 20 54 20 45 20 53 20 0a 3b 3b 3d 3d 3d 3d I T E S .;;====
e8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e8e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e8f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e910: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 64 62 3a 71 ==..(define db:q
e920: 75 65 72 69 65 73 20 0a 20 20 28 6c 69 73 74 20 ueries . (list
e930: 27 28 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 '(register-test
e940: 20 20 20 20 20 20 20 20 20 22 49 4e 53 45 52 54 "INSERT
e950: 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 OR IGNORE INTO
e960: 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 tests (run_id,te
e970: 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 69 6d stname,event_tim
e980: 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 e,item_path,stat
e990: 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 45 53 e,status) VALUES
e9a0: 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 27 (?,?,strftime('
e9b0: 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 4e 4f %s','now'),?,'NO
e9c0: 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 2f 61 27 T_STARTED','n/a'
e9d0: 29 3b 22 29 0a 09 27 28 73 74 61 74 65 2d 73 74 );")..'(state-st
e9e0: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 22 atus "
e9f0: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
ea00: 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d state=?,status=
ea10: 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a ? WHERE id=?;").
ea20: 09 27 28 73 74 61 74 65 2d 73 74 61 74 75 73 2d .'(state-status-
ea30: 6d 73 67 20 20 20 20 20 20 20 22 55 50 44 41 54 msg "UPDAT
ea40: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
ea50: 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 6f 6d e=?,status=?,com
ea60: 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d ment=? WHERE id=
ea70: 3f 3b 22 29 0a 09 27 28 70 61 73 73 2d 66 61 69 ?;")..'(pass-fai
ea80: 6c 2d 63 6f 75 6e 74 73 20 20 20 20 20 20 20 22 l-counts "
ea90: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
eaa0: 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70 61 fail_count=?,pa
eab0: 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 52 45 ss_count=? WHERE
eac0: 20 69 64 3d 3f 3b 22 29 0a 09 3b 3b 20 74 65 73 id=?;")..;; tes
ead0: 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 t_data-pf-rollup
eae0: 20 69 73 20 75 73 65 64 20 74 6f 20 73 65 74 20 is used to set
eaf0: 61 20 74 65 73 74 73 20 50 41 53 53 2f 46 41 49 a tests PASS/FAI
eb00: 4c 20 62 61 73 65 64 20 6f 6e 20 74 68 65 20 70 L based on the p
eb10: 61 73 73 2f 66 61 69 6c 20 69 6e 66 6f 20 66 72 ass/fail info fr
eb20: 6f 6d 20 74 68 65 20 73 74 65 70 73 0a 09 27 28 om the steps..'(
eb30: 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c test_data-pf-rol
eb40: 6c 75 70 20 20 20 20 22 55 50 44 41 54 45 20 74 lup "UPDATE t
eb50: 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 ests.
eb60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eb70: 20 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 SET sta
eb80: 74 75 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 tus=CASE WHEN (S
eb90: 45 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 ELECT fail_count
eba0: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
ebb0: 45 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 E id=?) > 0 .
ebc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ebd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ebe0: 20 20 20 54 48 45 4e 20 27 46 41 49 4c 27 0a 20 THEN 'FAIL'.
ebf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec10: 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 WHEN (SELECT
ec20: 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 pass_count FROM
ec30: 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f tests WHERE id=?
ec40: 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 20 ) > 0 AND .
ec50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec70: 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 73 20 (SELECT status
ec80: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
ec90: 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 28 27 id=?) NOT IN ('
eca0: 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a 20 20 WARN','FAIL').
ecb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ecc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ecd0: 20 20 54 48 45 4e 20 27 50 41 53 53 27 0a 20 20 THEN 'PASS'.
ece0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ecf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ed00: 20 20 45 4c 53 45 20 73 74 61 74 75 73 0a 20 20 ELSE status.
ed10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ed20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ed30: 20 20 45 4e 44 20 57 48 45 52 45 20 69 64 3d 3f END WHERE id=?
ed40: 3b 22 29 0a 09 27 28 74 65 73 74 2d 73 65 74 2d ;")..'(test-set-
ed50: 6c 6f 67 20 20 20 20 20 20 20 20 20 20 20 20 22 log "
ed60: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
ed70: 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 final_logf=? WH
ed80: 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 28 74 ERE id=?;")..'(t
ed90: 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 est-set-rundir-b
eda0: 79 2d 74 65 73 74 2d 69 64 20 22 55 50 44 41 54 y-test-id "UPDAT
edb0: 45 20 74 65 73 74 73 20 53 45 54 20 72 75 6e 64 E tests SET rund
edc0: 69 72 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 22 ir=? WHERE id=?"
edd0: 29 0a 09 27 28 74 65 73 74 2d 73 65 74 2d 72 75 )..'(test-set-ru
ede0: 6e 64 69 72 20 20 20 20 20 20 20 20 20 22 55 50 ndir "UP
edf0: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 DATE tests SET r
ee00: 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 72 75 undir=? WHERE ru
ee10: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
ee20: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
ee30: 61 74 68 3d 3f 3b 22 29 0a 09 27 28 64 65 6c 65 ath=?;")..'(dele
ee40: 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 te-tests-in-stat
ee50: 65 20 20 20 22 44 45 4c 45 54 45 20 46 52 4f 4d e "DELETE FROM
ee60: 20 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 tests WHERE sta
ee70: 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 64 3d te=? AND run_id=
ee80: 3f 3b 22 29 0a 09 27 28 74 65 73 74 73 3a 74 65 ?;")..'(tests:te
ee90: 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 20 20 st-set-toplog
eea0: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
eeb0: 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 T final_logf=? W
eec0: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
eed0: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
eee0: 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 29 item_path='';")
eef0: 0a 09 27 28 75 70 64 61 74 65 2d 63 70 75 6c 6f ..'(update-cpulo
ef00: 61 64 2d 64 69 73 6b 66 72 65 65 20 22 55 50 44 ad-diskfree "UPD
ef10: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 63 70 ATE tests SET cp
ef20: 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 65 65 uload=?,diskfree
ef30: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 =? WHERE id=?;")
ef40: 0a 09 27 28 75 70 64 61 74 65 2d 72 75 6e 2d 64 ..'(update-run-d
ef50: 75 72 61 74 69 6f 6e 20 20 20 20 20 22 55 50 44 uration "UPD
ef60: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 75 ATE tests SET ru
ef70: 6e 5f 64 75 72 61 74 69 6f 6e 3d 3f 20 57 48 45 n_duration=? WHE
ef80: 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 28 75 70 RE id=?;")..'(up
ef90: 64 61 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 date-uname-host
efa0: 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 "UPDATE te
efb0: 73 74 73 20 53 45 54 20 75 6e 61 6d 65 3d 3f 2c sts SET uname=?,
efc0: 68 6f 73 74 3d 3f 20 57 48 45 52 45 20 69 64 3d host=? WHERE id=
efd0: 3f 3b 22 29 0a 09 27 28 75 70 64 61 74 65 2d 74 ?;")..'(update-t
efe0: 65 73 74 2d 73 74 61 74 65 20 20 20 20 20 20 20 est-state
eff0: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
f000: 54 20 73 74 61 74 65 3d 3f 20 57 48 45 52 45 20 T state=? WHERE
f010: 73 74 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f state=? AND run_
f020: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
f030: 65 3d 3f 20 41 4e 44 20 4e 4f 54 20 28 69 74 65 e=? AND NOT (ite
f040: 6d 5f 70 61 74 68 3d 27 27 20 41 4e 44 20 74 65 m_path='' AND te
f050: 73 74 6e 61 6d 65 20 49 4e 20 28 53 45 4c 45 43 stname IN (SELEC
f060: 54 20 44 49 53 54 49 4e 43 54 20 74 65 73 74 6e T DISTINCT testn
f070: 61 6d 65 20 46 52 4f 4d 20 74 65 73 74 73 20 57 ame FROM tests W
f080: 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 HERE testname=?
f090: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d AND item_path !=
f0a0: 20 27 27 29 29 3b 22 29 0a 09 27 28 75 70 64 61 ''));")..'(upda
f0b0: 74 65 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 te-test-status
f0c0: 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 "UPDATE test
f0d0: 73 20 53 45 54 20 73 74 61 74 75 73 3d 3f 20 57 s SET status=? W
f0e0: 48 45 52 45 20 73 74 61 74 75 73 20 6c 69 6b 65 HERE status like
f0f0: 20 3f 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f 20 ? AND run_id=?
f100: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
f110: 4e 44 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 ND NOT (item_pat
f120: 68 3d 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d h='' AND testnam
f130: 65 20 49 4e 20 28 53 45 4c 45 43 54 20 44 49 53 e IN (SELECT DIS
f140: 54 49 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 TINCT testname F
f150: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
f160: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
f170: 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 tem_path != ''))
f180: 3b 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 64 ;"). ))..;; d
f190: 6f 20 6e 6f 74 20 72 75 6e 20 74 68 65 73 65 20 o not run these
f1a0: 61 73 20 70 61 72 74 20 6f 66 20 74 68 65 20 74 as part of the t
f1b0: 72 61 6e 73 61 63 74 69 6f 6e 0a 28 64 65 66 69 ransaction.(defi
f1c0: 6e 65 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 75 ne db:special-qu
f1d0: 65 72 69 65 73 20 20 20 27 28 72 6f 6c 6c 75 70 eries '(rollup
f1e0: 2d 74 65 73 74 73 2d 70 61 73 73 2d 66 61 69 6c -tests-pass-fail
f1f0: 0a 09 09 09 20 20 20 20 20 20 20 64 62 3a 72 6f .... db:ro
f200: 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d ll-up-pass-fail-
f210: 63 6f 75 6e 74 73 0a 20 20 20 20 20 20 20 20 20 counts.
f220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f230: 20 20 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 login.
f240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f250: 20 20 20 20 20 20 20 20 20 20 20 69 6d 6d 65 64 immed
f260: 69 61 74 65 0a 09 09 09 20 20 20 20 20 20 20 66 iate.... f
f270: 6c 75 73 68 0a 09 09 09 20 20 20 20 20 20 20 73 lush.... s
f280: 79 6e 63 0a 09 09 09 20 20 20 20 20 20 20 73 65 ync.... se
f290: 74 2d 76 65 72 62 6f 73 69 74 79 0a 09 09 09 20 t-verbosity....
f2a0: 20 20 20 20 20 20 6b 69 6c 6c 73 65 72 76 65 72 killserver
f2b0: 0a 09 09 09 20 20 20 20 20 20 20 29 29 0a 0a 3b .... ))..;
f2c0: 3b 20 6e 6f 74 20 75 73 65 64 2c 20 69 6e 74 65 ; not used, inte
f2d0: 6e 64 65 64 20 74 6f 20 69 6e 64 69 63 61 74 65 nded to indicate
f2e0: 20 74 6f 20 72 75 6e 20 69 6e 20 63 61 6c 6c 69 to run in calli
f2f0: 6e 67 20 70 72 6f 63 65 73 73 0a 28 64 65 66 69 ng process.(defi
f300: 6e 65 20 64 62 3a 72 75 6e 2d 6c 6f 63 61 6c 2d ne db:run-local-
f310: 71 75 65 72 69 65 73 20 27 28 29 29 20 3b 3b 20 queries '()) ;;
f320: 72 6f 6c 6c 75 70 2d 74 65 73 74 73 2d 70 61 73 rollup-tests-pas
f330: 73 2d 66 61 69 6c 29 29 0a 0a 28 64 65 66 69 6e s-fail))..(defin
f340: 65 20 28 64 62 3a 70 72 6f 63 65 73 73 2d 63 61 e (db:process-ca
f350: 63 68 65 64 2d 77 72 69 74 65 73 20 64 62 29 0a ched-writes db).
f360: 20 20 28 6c 65 74 20 28 28 71 75 65 72 69 65 73 (let ((queries
f370: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
f380: 61 62 6c 65 29 29 0a 09 28 64 61 74 61 20 20 20 able))..(data
f390: 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 6d 75 #f)). (mu
f3a0: 74 65 78 2d 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d tex-lock! *incom
f3b0: 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 ing-mutex*).
f3c0: 3b 3b 20 64 61 74 61 20 69 73 20 61 20 6c 69 73 ;; data is a lis
f3d0: 74 20 6f 66 20 71 75 65 72 79 20 70 61 63 6b 65 t of query packe
f3e0: 74 73 20 3c 76 65 63 74 6f 72 20 71 72 79 2d 73 ts <vector qry-s
f3f0: 69 67 20 71 75 65 72 79 20 70 61 72 61 6d 73 0a ig query params.
f400: 20 20 20 20 28 73 65 74 21 20 64 61 74 61 20 28 (set! data (
f410: 72 65 76 65 72 73 65 20 2a 69 6e 63 6f 6d 69 6e reverse *incomin
f420: 67 2d 77 72 69 74 65 73 2a 29 29 20 3b 3b 20 20 g-writes*)) ;;
f430: 28 73 6f 72 74 20 2e 2e 2e 20 28 6c 61 6d 62 64 (sort ... (lambd
f440: 61 20 28 61 20 62 29 28 3c 20 28 76 65 63 74 6f a (a b)(< (vecto
f450: 72 2d 72 65 66 20 61 20 31 29 28 76 65 63 74 6f r-ref a 1)(vecto
f460: 72 2d 72 65 66 20 62 20 31 29 29 29 29 29 0a 20 r-ref b 1))))).
f470: 20 20 20 28 73 65 74 21 20 2a 73 65 72 76 65 72 (set! *server
f480: 3a 6c 61 73 74 2d 77 72 69 74 65 2d 66 6c 75 73 :last-write-flus
f490: 68 2a 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c h* (current-mill
f4a0: 69 73 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 28 iseconds)). (
f4b0: 73 65 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 77 set! *incoming-w
f4c0: 72 69 74 65 73 2a 20 27 28 29 29 0a 20 20 20 20 rites* '()).
f4d0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a (mutex-unlock! *
f4e0: 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 incoming-mutex*)
f4f0: 0a 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e . (if (> (len
f500: 67 74 68 20 64 61 74 61 29 20 30 29 0a 09 3b 3b gth data) 0)..;;
f510: 20 50 72 6f 63 65 73 73 20 69 66 20 77 65 20 68 Process if we h
f520: 61 76 65 20 64 61 74 61 0a 09 28 62 65 67 69 6e ave data..(begin
f530: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
f540: 2d 69 6e 66 6f 20 37 20 22 57 72 69 74 69 6e 67 -info 7 "Writing
f550: 20 63 61 63 68 65 64 20 64 61 74 61 20 22 20 64 cached data " d
f560: 61 74 61 29 0a 20 20 20 20 0a 09 20 20 3b 3b 20 ata). .. ;;
f570: 50 72 65 70 61 72 65 20 74 68 65 20 6e 65 65 64 Prepare the need
f580: 65 64 20 73 71 6c 20 73 74 61 74 65 6d 65 6e 74 ed sql statement
f590: 73 0a 09 20 20 3b 3b 0a 09 20 20 28 66 6f 72 2d s.. ;;.. (for-
f5a0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 72 65 each (lambda (re
f5b0: 71 75 65 73 74 2d 69 74 65 6d 29 0a 09 09 20 20 quest-item)...
f5c0: 20 20 20 20 28 6c 65 74 20 28 28 73 74 6d 74 2d (let ((stmt-
f5d0: 6b 65 79 20 28 76 65 63 74 6f 72 2d 72 65 66 20 key (vector-ref
f5e0: 72 65 71 75 65 73 74 2d 69 74 65 6d 20 30 29 29 request-item 0))
f5f0: 0a 09 09 09 20 20 20 20 28 71 75 65 72 79 20 20 .... (query
f600: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 (vector-ref re
f610: 71 75 65 73 74 2d 69 74 65 6d 20 31 29 29 29 0a quest-item 1))).
f620: 09 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ...(hash-table-s
f630: 65 74 21 20 71 75 65 72 69 65 73 20 73 74 6d 74 et! queries stmt
f640: 2d 6b 65 79 20 28 73 71 6c 69 74 65 33 3a 70 72 -key (sqlite3:pr
f650: 65 70 61 72 65 20 64 62 20 71 75 65 72 79 29 29 epare db query))
f660: 29 29 0a 09 09 20 20 20 20 64 61 74 61 29 0a 09 ))... data)..
f670: 20 20 0a 09 20 20 3b 3b 20 4e 6f 20 6f 75 74 65 .. ;; No oute
f680: 72 20 6c 6f 6f 70 20 6e 65 65 64 65 64 2e 20 53 r loop needed. S
f690: 69 6e 67 6c 65 20 6c 6f 6f 70 20 66 6f 72 20 77 ingle loop for w
f6a0: 72 69 74 65 20 69 74 65 6d 73 20 6f 6e 6c 79 2e rite items only.
f6b0: 20 52 65 61 64 73 20 74 72 69 67 67 65 72 20 66 Reads trigger f
f6c0: 6c 75 73 68 20 6f 66 20 71 75 65 75 65 0a 09 20 lush of queue..
f6d0: 20 3b 3b 20 61 6e 64 20 74 68 65 6e 20 61 72 65 ;; and then are
f6e0: 20 65 78 65 63 75 74 65 64 2e 0a 09 20 20 28 73 executed... (s
f6f0: 71 6c 69 74 65 33 3a 77 69 74 68 2d 74 72 61 6e qlite3:with-tran
f700: 73 61 63 74 69 6f 6e 20 0a 09 20 20 20 64 62 0a saction .. db.
f710: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 . (lambda ()..
f720: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
f730: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 68 (lambda (h
f740: 65 64 29 0a 09 09 28 6c 65 74 2a 20 28 28 70 61 ed)...(let* ((pa
f750: 72 61 6d 73 20 20 20 28 76 65 63 74 6f 72 2d 72 rams (vector-r
f760: 65 66 20 68 65 64 20 32 29 29 0a 09 09 20 20 20 ef hed 2))...
f770: 20 20 20 20 28 73 74 6d 74 2d 6b 65 79 20 28 76 (stmt-key (v
f780: 65 63 74 6f 72 2d 72 65 66 20 68 65 64 20 30 29 ector-ref hed 0)
f790: 29 0a 09 09 20 20 20 20 20 20 20 28 73 74 6d 74 )... (stmt
f7a0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
f7b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 71 75 65 -ref/default que
f7c0: 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 20 23 66 ries stmt-key #f
f7d0: 29 29 29 0a 09 09 20 20 28 69 66 20 73 74 6d 74 )))... (if stmt
f7e0: 0a 09 09 20 20 20 20 20 20 28 61 70 70 6c 79 20 ... (apply
f7f0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
f800: 73 74 6d 74 20 70 61 72 61 6d 73 29 0a 09 09 20 stmt params)...
f810: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
f820: 74 20 30 20 22 45 52 52 4f 52 3a 20 50 72 6f 62 t 0 "ERROR: Prob
f830: 6c 65 6d 20 45 78 65 63 75 74 69 6e 67 20 22 20 lem Executing "
f840: 73 74 6d 74 2d 6b 65 79 20 22 20 66 6f 72 20 22 stmt-key " for "
f850: 20 70 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 params))))..
f860: 20 20 20 64 61 74 61 29 29 29 0a 09 20 20 0a 09 data))).. ..
f870: 20 20 3b 3b 20 6c 65 74 20 61 6c 6c 20 74 68 65 ;; let all the
f880: 20 77 61 69 74 69 6e 67 20 63 61 6c 6c 73 20 6b waiting calls k
f890: 6e 6f 77 20 61 6c 6c 20 69 73 20 64 6f 6e 65 0a now all is done.
f8a0: 09 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 . (mutex-lock!
f8b0: 2a 63 6f 6d 70 6c 65 74 65 64 2d 6d 75 74 65 78 *completed-mutex
f8c0: 2a 29 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 *).. (for-each
f8d0: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 09 (lambda (item)..
f8e0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 . (let ((qr
f8f0: 79 2d 73 69 67 20 28 63 64 62 3a 70 61 63 6b 65 y-sig (cdb:packe
f900: 74 2d 67 65 74 2d 63 6c 69 65 6e 74 2d 73 69 67 t-get-client-sig
f910: 20 69 74 65 6d 29 29 29 0a 09 09 09 28 64 65 62 item)))....(deb
f920: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 37 20 ug:print-info 7
f930: 22 52 65 67 69 73 74 65 72 69 6e 67 20 71 75 65 "Registering que
f940: 72 79 20 22 20 71 72 79 2d 73 69 67 20 22 20 61 ry " qry-sig " a
f950: 73 20 64 6f 6e 65 22 29 0a 09 09 09 28 68 61 73 s done")....(has
f960: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 63 6f h-table-set! *co
f970: 6d 70 6c 65 74 65 64 2d 77 72 69 74 65 73 2a 20 mpleted-writes*
f980: 71 72 79 2d 73 69 67 20 23 74 29 29 29 0a 09 09 qry-sig #t)))...
f990: 20 20 20 20 64 61 74 61 29 0a 09 20 20 28 6d 75 data).. (mu
f9a0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 63 6f 6d tex-unlock! *com
f9b0: 70 6c 65 74 65 64 2d 6d 75 74 65 78 2a 29 0a 09 pleted-mutex*)..
f9c0: 20 20 0a 09 20 20 3b 3b 20 46 69 6e 61 6c 69 7a .. ;; Finaliz
f9d0: 65 20 74 68 65 20 73 74 61 74 65 6d 65 6e 74 73 e the statements
f9e0: 2e 20 53 68 6f 75 6c 64 20 74 68 69 73 20 62 65 . Should this be
f9f0: 20 64 6f 6e 65 20 69 6e 73 69 64 65 20 74 68 65 done inside the
fa00: 20 6d 75 74 65 78 20 61 62 6f 76 65 3f 0a 09 20 mutex above?..
fa10: 20 3b 3b 20 49 20 74 68 69 6e 6b 20 73 71 6c 69 ;; I think sqli
fa20: 74 65 33 20 6d 75 74 65 78 65 73 20 77 69 6c 6c te3 mutexes will
fa30: 20 6b 65 65 70 20 74 68 65 20 64 61 74 61 20 73 keep the data s
fa40: 61 66 65 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 afe.. (for-each
fa50: 20 28 6c 61 6d 62 64 61 20 28 73 74 6d 74 2d 6b (lambda (stmt-k
fa60: 65 79 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c ey)... (sql
fa70: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 28 ite3:finalize! (
fa80: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 71 hash-table-ref q
fa90: 75 65 72 69 65 73 20 73 74 6d 74 2d 6b 65 79 29 ueries stmt-key)
faa0: 29 29 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 ))... (hash-t
fab0: 61 62 6c 65 2d 6b 65 79 73 20 71 75 65 72 69 65 able-keys querie
fac0: 73 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 44 6f s)).. .. ;; Do
fad0: 20 61 20 6c 69 74 74 6c 65 20 72 65 63 6f 72 64 a little record
fae0: 20 6b 65 65 70 69 6e 67 0a 09 20 20 28 6c 65 74 keeping.. (let
faf0: 20 28 28 63 61 63 68 65 2d 73 69 7a 65 20 28 6c ((cache-size (l
fb00: 65 6e 67 74 68 20 64 61 74 61 29 29 29 0a 09 20 ength data)))..
fb10: 20 20 20 28 69 66 20 28 3e 20 63 61 63 68 65 2d (if (> cache-
fb20: 73 69 7a 65 20 2a 6d 61 78 2d 63 61 63 68 65 2d size *max-cache-
fb30: 73 69 7a 65 2a 29 0a 09 09 28 73 65 74 21 20 2a size*)...(set! *
fb40: 6d 61 78 2d 63 61 63 68 65 2d 73 69 7a 65 2a 20 max-cache-size*
fb50: 63 61 63 68 65 2d 73 69 7a 65 29 29 29 0a 09 20 cache-size)))..
fb60: 20 23 74 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 #t)..#f)))..(de
fb70: 66 69 6e 65 20 2a 64 62 3a 70 72 6f 63 65 73 73 fine *db:process
fb80: 2d 71 75 65 75 65 2d 6d 75 74 65 78 2a 20 28 6d -queue-mutex* (m
fb90: 61 6b 65 2d 6d 75 74 65 78 29 29 0a 0a 28 64 65 ake-mutex))..(de
fba0: 66 69 6e 65 20 2a 6e 75 6d 62 65 72 2d 6f 66 2d fine *number-of-
fbb0: 77 72 69 74 65 73 2a 20 20 20 20 20 20 20 20 20 writes*
fbc0: 30 29 0a 28 64 65 66 69 6e 65 20 2a 77 72 69 74 0).(define *writ
fbd0: 65 73 2d 74 6f 74 61 6c 2d 64 65 6c 61 79 2a 20 es-total-delay*
fbe0: 20 20 20 20 20 20 30 29 0a 28 64 65 66 69 6e 65 0).(define
fbf0: 20 2a 74 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 69 74 *total-non-writ
fc00: 65 2d 64 65 6c 61 79 2a 20 20 20 20 30 29 0a 28 e-delay* 0).(
fc10: 64 65 66 69 6e 65 20 2a 6e 75 6d 62 65 72 2d 6e define *number-n
fc20: 6f 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 on-write-queries
fc30: 2a 20 30 29 0a 0a 3b 3b 20 54 68 65 20 71 75 65 * 0)..;; The que
fc40: 75 65 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 ue is a list of
fc50: 76 65 63 74 6f 72 73 20 77 68 65 72 65 20 74 68 vectors where th
fc60: 65 20 7a 65 72 6f 74 68 20 73 6c 6f 74 20 69 6e e zeroth slot in
fc70: 64 69 63 61 74 65 73 20 74 68 65 20 74 79 70 65 dicates the type
fc80: 20 6f 66 20 71 75 65 72 79 20 74 6f 0a 3b 3b 20 of query to.;;
fc90: 61 70 70 6c 79 20 61 6e 64 20 74 68 65 20 73 65 apply and the se
fca0: 63 6f 6e 64 20 73 6c 6f 74 20 69 73 20 74 68 65 cond slot is the
fcb0: 20 74 69 6d 65 20 6f 66 20 74 68 65 20 71 75 65 time of the que
fcc0: 72 79 20 61 6e 64 20 74 68 65 20 74 68 69 72 64 ry and the third
fcd0: 20 65 6e 74 72 79 20 69 73 20 61 20 6c 69 73 74 entry is a list
fce0: 20 6f 66 20 0a 3b 3b 20 76 61 6c 75 65 73 20 74 of .;; values t
fcf0: 6f 20 62 65 20 61 70 70 6c 69 65 64 0a 3b 3b 0a o be applied.;;.
fd00: 28 64 65 66 69 6e 65 20 28 64 62 3a 71 75 65 75 (define (db:queu
fd10: 65 2d 77 72 69 74 65 2d 61 6e 64 2d 77 61 69 74 e-write-and-wait
fd20: 20 64 62 20 71 72 79 2d 73 69 67 20 71 75 65 72 db qry-sig quer
fd30: 79 20 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 y params). (let
fd40: 20 28 28 71 75 65 75 65 2d 6c 65 6e 20 20 30 29 ((queue-len 0)
fd50: 0a 09 28 72 65 73 20 20 20 20 20 20 20 20 23 66 ..(res #f
fd60: 29 0a 09 28 67 6f 74 2d 69 74 20 20 20 20 20 23 )..(got-it #
fd70: 66 29 0a 09 28 71 72 79 2d 70 6b 74 20 20 20 20 f)..(qry-pkt
fd80: 28 76 65 63 74 6f 72 20 71 72 79 2d 73 69 67 20 (vector qry-sig
fd90: 71 75 65 72 79 20 70 61 72 61 6d 73 29 29 0a 09 query params))..
fda0: 28 73 74 61 72 74 2d 74 69 6d 65 20 28 63 75 72 (start-time (cur
fdb0: 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 rent-millisecond
fdc0: 73 29 29 0a 09 28 74 69 6d 65 6f 75 74 20 20 20 s))..(timeout
fdd0: 20 28 2b 20 31 30 20 28 63 75 72 72 65 6e 74 2d (+ 10 (current-
fde0: 73 65 63 6f 6e 64 73 29 29 29 29 20 3b 3b 20 73 seconds)))) ;; s
fdf0: 65 74 20 74 68 65 20 74 69 6d 65 20 6f 75 74 20 et the time out
fe00: 74 6f 20 31 30 20 73 65 63 73 20 69 6e 20 66 75 to 10 secs in fu
fe10: 74 75 72 65 0a 0a 20 20 20 20 3b 3b 20 50 75 74 ture.. ;; Put
fe20: 20 74 68 65 20 69 74 65 6d 20 69 6e 20 74 68 65 the item in the
fe30: 20 71 75 65 75 65 20 2a 69 6e 63 6f 6d 69 6e 67 queue *incoming
fe40: 2d 77 72 69 74 65 73 2a 20 0a 20 20 20 20 28 6d -writes* . (m
fe50: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 69 6e 63 6f utex-lock! *inco
fe60: 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 20 20 ming-mutex*).
fe70: 20 28 73 65 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 (set! *incoming
fe80: 2d 77 72 69 74 65 73 2a 20 28 63 6f 6e 73 20 71 -writes* (cons q
fe90: 72 79 2d 70 6b 74 20 2a 69 6e 63 6f 6d 69 6e 67 ry-pkt *incoming
fea0: 2d 77 72 69 74 65 73 2a 29 29 0a 20 20 20 20 28 -writes*)). (
feb0: 73 65 74 21 20 71 75 65 75 65 2d 6c 65 6e 20 28 set! queue-len (
fec0: 6c 65 6e 67 74 68 20 2a 69 6e 63 6f 6d 69 6e 67 length *incoming
fed0: 2d 77 72 69 74 65 73 2a 29 29 0a 20 20 20 20 28 -writes*)). (
fee0: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 69 mutex-unlock! *i
fef0: 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a ncoming-mutex*).
ff00: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
ff10: 74 2d 69 6e 66 6f 20 37 20 22 43 75 72 72 65 6e t-info 7 "Curren
ff20: 74 20 77 72 69 74 65 20 71 75 65 75 65 20 6c 65 t write queue le
ff30: 6e 67 74 68 20 69 73 20 22 20 71 75 65 75 65 2d ngth is " queue-
ff40: 6c 65 6e 29 0a 0a 20 20 20 20 3b 3b 20 70 6f 6c len).. ;; pol
ff50: 6c 20 66 6f 72 20 74 68 65 20 77 72 69 74 65 20 l for the write
ff60: 74 6f 20 63 6f 6d 70 6c 65 74 65 2c 20 74 69 6d to complete, tim
ff70: 65 6f 75 74 20 61 66 74 65 72 20 31 30 20 73 65 eout after 10 se
ff80: 63 6f 6e 64 73 0a 20 20 20 20 3b 3b 20 70 65 72 conds. ;; per
ff90: 69 6f 64 69 63 20 66 6c 75 73 68 69 6e 67 20 6f iodic flushing o
ffa0: 66 20 74 68 65 20 71 75 65 75 65 20 69 73 20 74 f the queue is t
ffb0: 61 6b 65 6e 20 63 61 72 65 20 6f 66 20 62 79 20 aken care of by
ffc0: 0a 20 20 20 20 3b 3b 20 64 62 3a 66 6c 75 73 68 . ;; db:flush
ffd0: 2d 71 75 65 75 65 0a 20 20 20 20 28 6c 65 74 20 -queue. (let
ffe0: 6c 6f 6f 70 20 28 29 0a 20 20 20 20 20 20 28 74 loop (). (t
fff0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 hread-sleep! 0.0
10000 30 31 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 01). (mutex
10010 2d 6c 6f 63 6b 21 20 2a 63 6f 6d 70 6c 65 74 65 -lock! *complete
10020 64 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 d-mutex*).
10030 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (if (hash-table-
10040 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6d ref/default *com
10050 70 6c 65 74 65 64 2d 77 72 69 74 65 73 2a 20 71 pleted-writes* q
10060 72 79 2d 73 69 67 20 23 66 29 0a 09 20 20 28 62 ry-sig #f).. (b
10070 65 67 69 6e 0a 09 20 20 20 20 28 68 61 73 68 2d egin.. (hash-
10080 74 61 62 6c 65 2d 64 65 6c 65 74 65 21 20 2a 63 table-delete! *c
10090 6f 6d 70 6c 65 74 65 64 2d 77 72 69 74 65 73 2a ompleted-writes*
100a0 20 71 72 79 2d 73 69 67 29 0a 09 20 20 20 20 28 qry-sig).. (
100b0 73 65 74 21 20 67 6f 74 2d 69 74 20 23 74 29 29 set! got-it #t))
100c0 29 0a 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 ). (mutex-u
100d0 6e 6c 6f 63 6b 21 20 2a 63 6f 6d 70 6c 65 74 65 nlock! *complete
100e0 64 2d 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 d-mutex*).
100f0 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 67 6f (if (and (not go
10100 74 2d 69 74 29 0a 09 20 20 20 20 20 20 20 28 3c t-it).. (<
10110 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
10120 73 29 20 74 69 6d 65 6f 75 74 29 29 0a 09 20 20 s) timeout))..
10130 28 62 65 67 69 6e 0a 09 20 20 20 20 28 74 68 72 (begin.. (thr
10140 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 29 ead-sleep! 0.01)
10150 0a 09 20 20 20 20 28 6c 6f 6f 70 29 29 29 29 0a .. (loop)))).
10160 20 20 20 20 28 73 65 74 21 20 2a 6e 75 6d 62 65 (set! *numbe
10170 72 2d 6f 66 2d 77 72 69 74 65 73 2a 20 20 20 28 r-of-writes* (
10180 2b 20 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77 72 69 + *number-of-wri
10190 74 65 73 2a 20 20 20 31 29 29 0a 20 20 20 20 28 tes* 1)). (
101a0 73 65 74 21 20 2a 77 72 69 74 65 73 2d 74 6f 74 set! *writes-tot
101b0 61 6c 2d 64 65 6c 61 79 2a 20 28 2b 20 2a 77 72 al-delay* (+ *wr
101c0 69 74 65 73 2d 74 6f 74 61 6c 2d 64 65 6c 61 79 ites-total-delay
101d0 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 * (- (current-mi
101e0 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
101f0 74 2d 74 69 6d 65 29 29 29 0a 20 20 20 20 67 6f t-time))). go
10200 74 2d 69 74 29 29 0a 09 20 20 0a 28 64 65 66 69 t-it)).. .(defi
10210 6e 65 20 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 ne (db:process-q
10220 75 65 75 65 2d 69 74 65 6d 20 64 62 20 69 74 65 ueue-item db ite
10230 6d 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 6d m). (let* ((stm
10240 74 2d 6b 65 79 20 20 20 20 20 20 20 28 63 64 62 t-key (cdb
10250 3a 70 61 63 6b 65 74 2d 67 65 74 2d 71 74 79 70 :packet-get-qtyp
10260 65 20 69 74 65 6d 29 29 0a 09 20 28 71 72 79 2d e item)).. (qry-
10270 73 69 67 20 20 20 20 20 20 20 20 28 63 64 62 3a sig (cdb:
10280 70 61 63 6b 65 74 2d 67 65 74 2d 71 75 65 72 79 packet-get-query
10290 2d 73 69 67 20 69 74 65 6d 29 29 0a 09 20 28 72 -sig item)).. (r
102a0 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 28 63 eturn-address (c
102b0 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d 63 6c db:packet-get-cl
102c0 69 65 6e 74 2d 73 69 67 20 69 74 65 6d 29 29 0a ient-sig item)).
102d0 09 20 28 70 61 72 61 6d 73 20 20 20 20 20 20 20 . (params
102e0 20 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 (cdb:packet-ge
102f0 74 2d 70 61 72 61 6d 73 20 69 74 65 6d 29 29 0a t-params item)).
10300 09 20 28 71 75 65 72 79 20 20 20 20 20 20 20 20 . (query
10310 20 20 28 6c 65 74 20 28 28 71 20 28 61 6c 69 73 (let ((q (alis
10320 74 2d 72 65 66 20 73 74 6d 74 2d 6b 65 79 20 64 t-ref stmt-key d
10330 62 3a 71 75 65 72 69 65 73 29 29 29 0a 09 09 09 b:queries)))....
10340 20 20 20 28 69 66 20 71 20 28 63 61 72 20 71 29 (if q (car q)
10350 20 23 66 29 29 29 29 0a 20 20 20 20 28 64 65 62 #f)))). (deb
10360 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
10370 20 22 53 70 65 63 69 61 6c 20 71 75 65 72 69 65 "Special querie
10380 73 2f 72 65 71 75 65 73 74 73 20 73 74 6d 74 2d s/requests stmt-
10390 6b 65 79 3d 22 20 73 74 6d 74 2d 6b 65 79 20 22 key=" stmt-key "
103a0 2c 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 , return-address
103b0 3d 22 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 =" return-addres
103c0 73 20 22 2c 20 71 75 65 72 79 3d 22 20 71 75 65 s ", query=" que
103d0 72 79 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 ry ", params=" p
103e0 61 72 61 6d 73 29 0a 20 20 20 20 28 69 66 20 71 arams). (if q
103f0 75 65 72 79 0a 09 3b 3b 20 68 61 6e 64 20 71 75 uery..;; hand qu
10400 65 72 69 65 73 20 6f 66 66 20 74 6f 20 74 68 65 eries off to the
10410 20 77 72 69 74 65 20 71 75 65 75 65 0a 09 28 6c write queue..(l
10420 65 74 20 28 28 72 65 73 70 6f 6e 73 65 20 28 63 et ((response (c
10430 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 ase *transport-t
10440 79 70 65 2a 0a 09 09 09 20 20 28 28 68 74 74 70 ype*.... ((http
10450 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ).... (debug:p
10460 72 69 6e 74 2d 69 6e 66 6f 20 37 20 22 51 75 65 rint-info 7 "Que
10470 75 69 6e 67 20 69 74 65 6d 20 22 20 69 74 65 6d uing item " item
10480 20 22 20 66 6f 72 20 77 72 61 70 70 65 64 20 77 " for wrapped w
10490 72 69 74 65 22 29 0a 09 09 09 20 20 20 28 64 62 rite").... (db
104a0 3a 71 75 65 75 65 2d 77 72 69 74 65 2d 61 6e 64 :queue-write-and
104b0 2d 77 61 69 74 20 64 62 20 71 72 79 2d 73 69 67 -wait db qry-sig
104c0 20 71 75 65 72 79 20 70 61 72 61 6d 73 29 29 0a query params)).
104d0 09 09 09 20 20 28 65 6c 73 65 20 20 0a 09 09 09 ... (else ....
104e0 20 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 (apply sqlite
104f0 33 3a 65 78 65 63 75 74 65 20 64 62 20 71 75 65 3:execute db que
10500 72 79 20 70 61 72 61 6d 73 29 0a 09 09 09 20 20 ry params)....
10510 20 23 74 29 29 29 29 0a 09 20 20 28 64 65 62 75 #t)))).. (debu
10520 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 37 20 22 g:print-info 7 "
10530 52 65 63 65 69 76 65 64 20 22 20 72 65 73 70 6f Received " respo
10540 6e 73 65 20 22 20 66 72 6f 6d 20 77 72 61 70 70 nse " from wrapp
10550 65 64 20 77 72 69 74 65 22 29 0a 09 20 20 28 73 ed write").. (s
10560 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 erver:reply retu
10570 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 rn-address qry-s
10580 69 67 20 72 65 73 70 6f 6e 73 65 20 72 65 73 70 ig response resp
10590 6f 6e 73 65 29 29 0a 09 3b 3b 20 6f 74 68 65 72 onse))..;; other
105a0 77 69 73 65 20 69 66 20 61 70 70 72 6f 70 72 69 wise if appropri
105b0 61 74 65 20 66 6c 75 73 68 20 74 68 65 20 71 75 ate flush the qu
105c0 65 75 65 20 28 74 68 69 73 20 69 73 20 61 20 72 eue (this is a r
105d0 65 61 64 20 6f 72 20 63 6f 6d 70 6c 65 78 20 71 ead or complex q
105e0 75 65 72 79 29 0a 09 28 62 65 67 69 6e 0a 09 20 uery)..(begin..
105f0 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 6d 65 6d (cond.. ((mem
10600 62 65 72 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a ber stmt-key db:
10610 73 70 65 63 69 61 6c 2d 71 75 65 72 69 65 73 29 special-queries)
10620 0a 09 20 20 20 20 28 6c 65 74 20 28 28 73 74 61 .. (let ((sta
10630 72 74 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d rttime (current-
10640 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a milliseconds))).
10650 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
10660 69 6e 74 2d 69 6e 66 6f 20 39 20 22 48 61 6e 64 int-info 9 "Hand
10670 6c 69 6e 67 20 73 70 65 63 69 61 6c 20 73 74 61 ling special sta
10680 74 65 6d 65 6e 74 20 22 20 73 74 6d 74 2d 6b 65 tement " stmt-ke
10690 79 29 0a 09 20 20 20 20 20 20 28 63 61 73 65 20 y).. (case
106a0 73 74 6d 74 2d 6b 65 79 0a 09 09 28 28 69 6d 6d stmt-key...((imm
106b0 65 64 69 61 74 65 29 0a 09 09 20 3b 3b 20 54 68 ediate)... ;; Th
106c0 69 73 20 69 73 20 61 20 72 65 61 64 20 6f 72 20 is is a read or
106d0 6d 69 78 65 64 20 72 65 61 64 2d 77 72 69 74 65 mixed read-write
106e0 20 71 75 65 72 79 2c 20 6d 75 73 74 20 63 6c 65 query, must cle
106f0 61 72 20 74 68 65 20 63 61 63 68 65 0a 09 09 20 ar the cache...
10700 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f 72 74 (case *transport
10710 2d 74 79 70 65 2a 0a 09 09 20 20 20 28 28 68 74 -type*... ((ht
10720 74 70 29 0a 09 09 20 20 20 20 28 6d 75 74 65 78 tp)... (mutex
10730 2d 6c 6f 63 6b 21 20 2a 64 62 3a 70 72 6f 63 65 -lock! *db:proce
10740 73 73 2d 71 75 65 75 65 2d 6d 75 74 65 78 2a 29 ss-queue-mutex*)
10750 0a 09 09 20 20 20 20 28 64 62 3a 70 72 6f 63 65 ... (db:proce
10760 73 73 2d 63 61 63 68 65 64 2d 77 72 69 74 65 73 ss-cached-writes
10770 20 64 62 29 0a 09 09 20 20 20 20 28 6d 75 74 65 db)... (mute
10780 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 3a 70 72 x-unlock! *db:pr
10790 6f 63 65 73 73 2d 71 75 65 75 65 2d 6d 75 74 65 ocess-queue-mute
107a0 78 2a 29 29 29 0a 09 09 20 28 6c 65 74 2a 20 28 x*)))... (let* (
107b0 28 70 72 6f 63 20 20 20 20 20 20 28 63 61 72 20 (proc (car
107c0 70 61 72 61 6d 73 29 29 0a 09 09 09 28 72 65 6d params))....(rem
107d0 70 61 72 61 6d 73 20 28 63 64 72 20 70 61 72 61 params (cdr para
107e0 6d 73 29 29 0a 09 09 09 3b 3b 20 77 65 20 61 72 ms))....;; we ar
107f0 65 20 62 65 69 6e 67 20 68 61 6e 64 65 64 20 61 e being handed a
10800 20 70 72 6f 63 65 64 75 72 65 20 73 6f 20 63 61 procedure so ca
10810 6c 6c 20 69 74 0a 09 09 09 3b 3b 20 28 64 65 62 ll it....;; (deb
10820 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
10830 20 22 52 75 6e 6e 69 6e 67 20 28 61 70 70 6c 79 "Running (apply
10840 20 22 20 70 72 6f 63 20 22 20 22 20 72 65 6d 70 " proc " " remp
10850 61 72 61 6d 73 20 22 29 22 29 0a 09 09 09 28 72 arams ")")....(r
10860 65 73 75 6c 74 20 28 73 65 72 76 65 72 3a 72 65 esult (server:re
10870 70 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 ply return-addre
10880 73 73 20 71 72 79 2d 73 69 67 20 23 74 20 28 61 ss qry-sig #t (a
10890 70 70 6c 79 20 70 72 6f 63 20 72 65 6d 70 61 72 pply proc rempar
108a0 61 6d 73 29 29 29 29 0a 09 09 20 20 20 28 73 65 ams))))... (se
108b0 74 21 20 2a 74 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 t! *total-non-wr
108c0 69 74 65 2d 64 65 6c 61 79 2a 20 28 2b 20 2a 74 ite-delay* (+ *t
108d0 6f 74 61 6c 2d 6e 6f 6e 2d 77 72 69 74 65 2d 64 otal-non-write-d
108e0 65 6c 61 79 2a 20 28 2d 20 28 63 75 72 72 65 6e elay* (- (curren
108f0 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 t-milliseconds)
10900 73 74 61 72 74 74 69 6d 65 29 29 29 20 0a 09 09 starttime))) ...
10910 20 20 20 28 73 65 74 21 20 2a 6e 75 6d 62 65 72 (set! *number
10920 2d 6e 6f 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 -non-write-queri
10930 65 73 2a 20 28 2b 20 2a 6e 75 6d 62 65 72 2d 6e es* (+ *number-n
10940 6f 6e 2d 77 72 69 74 65 2d 71 75 65 72 69 65 73 on-write-queries
10950 2a 20 31 29 29 0a 09 09 20 20 20 72 65 73 75 6c * 1))... resul
10960 74 29 29 0a 09 09 28 28 6c 6f 67 69 6e 29 0a 09 t))...((login)..
10970 09 20 28 69 66 20 28 3c 20 28 6c 65 6e 67 74 68 . (if (< (length
10980 20 70 61 72 61 6d 73 29 20 33 29 20 3b 3b 20 73 params) 3) ;; s
10990 68 6f 75 6c 64 20 67 65 74 20 74 6f 70 70 61 74 hould get toppat
109a0 68 2c 20 76 65 72 73 69 6f 6e 20 61 6e 64 20 73 h, version and s
109b0 69 67 6e 61 74 75 72 65 0a 09 09 20 20 20 20 20 ignature...
109c0 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 (server:reply re
109d0 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 turn-address qry
109e0 2d 73 69 67 20 27 28 23 66 20 22 6c 6f 67 69 6e -sig '(#f "login
109f0 20 66 61 69 6c 65 64 20 64 75 65 20 74 6f 20 6d failed due to m
10a00 69 73 73 69 6e 67 20 70 61 72 61 6d 73 22 29 29 issing params"))
10a10 20 3b 3b 20 6d 69 73 73 69 6e 67 20 70 61 72 61 ;; missing para
10a20 6d 73 0a 09 09 20 20 20 20 20 28 6c 65 74 20 28 ms... (let (
10a30 28 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 28 63 (calling-path (c
10a40 61 72 20 20 20 70 61 72 61 6d 73 29 29 0a 09 09 ar params))...
10a50 09 20 20 20 28 63 61 6c 6c 69 6e 67 2d 76 65 72 . (calling-ver
10a60 73 20 28 63 61 64 72 20 20 70 61 72 61 6d 73 29 s (cadr params)
10a70 29 0a 09 09 09 20 20 20 28 63 6c 69 65 6e 74 2d ).... (client-
10a80 6b 65 79 20 20 20 28 63 61 64 64 72 20 70 61 72 key (caddr par
10a90 61 6d 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 ams)))...
10aa0 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f (if (and (equal?
10ab0 20 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 2a 74 calling-path *t
10ac0 6f 70 70 61 74 68 2a 29 0a 09 09 09 09 28 65 71 oppath*).....(eq
10ad0 75 61 6c 3f 20 6d 65 67 61 74 65 73 74 2d 76 65 ual? megatest-ve
10ae0 72 73 69 6f 6e 20 63 61 6c 6c 69 6e 67 2d 76 65 rsion calling-ve
10af0 72 73 29 29 0a 09 09 09 20 20 20 28 62 65 67 69 rs)).... (begi
10b00 6e 0a 09 09 09 20 20 20 20 20 28 68 61 73 68 2d n.... (hash-
10b10 74 61 62 6c 65 2d 73 65 74 21 20 2a 6c 6f 67 67 table-set! *logg
10b20 65 64 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 63 ed-in-clients* c
10b30 6c 69 65 6e 74 2d 6b 65 79 20 28 63 75 72 72 65 lient-key (curre
10b40 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 nt-seconds))....
10b50 20 20 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 (server:rep
10b60 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 ly return-addres
10b70 73 20 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 s qry-sig #t '(#
10b80 74 20 22 73 75 63 63 65 73 73 66 75 6c 20 6c 6f t "successful lo
10b90 67 69 6e 22 29 29 29 20 20 20 20 20 20 3b 3b 20 gin"))) ;;
10ba0 70 61 74 68 20 6d 61 74 63 68 65 73 20 2d 20 70 path matches - p
10bb0 61 73 73 21 20 53 68 6f 75 6c 64 20 76 65 74 20 ass! Should vet
10bc0 74 68 65 20 63 61 6c 6c 65 72 20 61 74 20 74 68 the caller at th
10bd0 69 73 20 74 69 6d 65 20 2e 2e 2e 0a 09 09 09 20 is time .......
10be0 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 (server:reply
10bf0 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 return-address q
10c00 72 79 2d 73 69 67 20 23 66 20 28 6c 69 73 74 20 ry-sig #f (list
10c10 23 66 20 28 63 6f 6e 63 20 22 4c 6f 67 69 6e 20 #f (conc "Login
10c20 66 61 69 6c 65 64 20 64 75 65 20 74 6f 20 6d 69 failed due to mi
10c30 73 6d 61 74 63 68 20 70 61 74 68 73 3a 20 22 20 smatch paths: "
10c40 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 22 2c 20 calling-path ",
10c50 22 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 29 29 " *toppath*)))))
10c60 29 29 0a 09 09 28 28 66 6c 75 73 68 20 73 79 6e ))...((flush syn
10c70 63 29 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 c)... (server:re
10c80 70 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 ply return-addre
10c90 73 73 20 71 72 79 2d 73 69 67 20 23 74 20 31 29 ss qry-sig #t 1)
10ca0 29 20 3b 3b 20 28 6c 65 6e 67 74 68 20 64 61 74 ) ;; (length dat
10cb0 61 29 29 29 0a 09 09 28 28 73 65 74 2d 76 65 72 a)))...((set-ver
10cc0 62 6f 73 69 74 79 29 0a 09 09 20 28 73 65 74 21 bosity)... (set!
10cd0 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63 61 *verbosity* (ca
10ce0 72 20 70 61 72 61 6d 73 29 29 0a 09 09 20 28 73 r params))... (s
10cf0 65 72 76 65 72 3a 72 65 70 6c 79 20 72 65 74 75 erver:reply retu
10d00 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 rn-address qry-s
10d10 69 67 20 23 74 20 27 28 23 74 20 2a 76 65 72 62 ig #t '(#t *verb
10d20 6f 73 69 74 79 2a 29 29 29 0a 09 09 28 28 6b 69 osity*)))...((ki
10d30 6c 6c 73 65 72 76 65 72 29 0a 09 09 20 28 64 65 llserver)... (de
10d40 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
10d50 4e 49 4e 47 3a 20 53 65 72 76 65 72 20 67 6f 69 NING: Server goi
10d60 6e 67 20 64 6f 77 6e 20 69 6e 20 31 35 20 73 65 ng down in 15 se
10d70 63 6f 6e 64 73 20 62 79 20 75 73 65 72 20 72 65 conds by user re
10d80 71 75 65 73 74 21 22 29 0a 09 09 20 28 6f 70 65 quest!")... (ope
10d90 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b n-run-close task
10da0 73 3a 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 s:server-deregis
10db0 74 65 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 ter tasks:open-d
10dc0 62 20 0a 09 09 09 09 20 28 63 61 72 20 2a 72 75 b ..... (car *ru
10dd0 6e 72 65 6d 6f 74 65 2a 29 0a 09 09 09 09 20 70 nremote*)..... p
10de0 75 6c 6c 70 6f 72 74 3a 20 28 63 61 64 72 20 2a ullport: (cadr *
10df0 72 75 6e 72 65 6d 6f 74 65 2a 29 29 0a 09 09 20 runremote*))...
10e00 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 28 (thread-start! (
10e10 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d make-thread (lam
10e20 62 64 61 20 28 29 28 74 68 72 65 61 64 2d 73 6c bda ()(thread-sl
10e30 65 65 70 21 20 31 35 29 28 65 78 69 74 29 29 29 eep! 15)(exit)))
10e40 29 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 70 )... (server:rep
10e50 6c 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 ly return-addres
10e60 73 20 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 s qry-sig #t '(#
10e70 74 20 22 65 78 69 74 20 70 72 6f 63 65 73 73 20 t "exit process
10e80 73 74 61 72 74 65 64 22 29 29 29 0a 09 09 28 65 started")))...(e
10e90 6c 73 65 20 3b 3b 20 6e 6f 74 20 61 20 63 6f 6d lse ;; not a com
10ea0 6d 61 6e 64 2c 20 69 2e 65 2e 20 69 73 20 61 20 mand, i.e. is a
10eb0 71 75 65 72 79 0a 09 09 20 28 64 65 62 75 67 3a query... (debug:
10ec0 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
10ed0 55 6e 72 65 63 6f 67 6e 69 73 65 64 20 71 75 65 Unrecognised que
10ee0 72 79 2f 63 6f 6d 6d 61 6e 64 20 22 20 73 74 6d ry/command " stm
10ef0 74 2d 6b 65 79 29 0a 09 09 20 28 73 65 72 76 65 t-key)... (serve
10f00 72 3a 72 65 70 6c 79 20 72 65 74 75 72 6e 2d 61 r:reply return-a
10f10 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 20 23 ddress qry-sig #
10f20 66 20 27 66 61 69 6c 65 64 29 29 29 29 29 0a 09 f 'failed)))))..
10f30 20 20 20 28 65 6c 73 65 0a 09 20 20 20 20 28 64 (else.. (d
10f40 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
10f50 31 31 20 22 45 78 65 63 75 74 69 6e 67 20 22 20 11 "Executing "
10f60 73 74 6d 74 2d 6b 65 79 20 22 20 66 6f 72 20 22 stmt-key " for "
10f70 20 70 61 72 61 6d 73 29 0a 09 20 20 20 20 28 61 params).. (a
10f80 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 pply sqlite3:exe
10f90 63 75 74 65 20 28 68 61 73 68 2d 74 61 62 6c 65 cute (hash-table
10fa0 2d 72 65 66 20 71 75 65 72 69 65 73 20 73 74 6d -ref queries stm
10fb0 74 2d 6b 65 79 29 20 70 61 72 61 6d 73 29 0a 09 t-key) params)..
10fc0 20 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 6c (server:repl
10fd0 79 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 y return-address
10fe0 20 71 72 79 2d 73 69 67 20 23 74 20 23 74 29 29 qry-sig #t #t))
10ff0 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
11000 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 65 63 6f db:test-get-reco
11010 72 64 73 2d 66 6f 72 2d 69 6e 64 65 78 2d 66 69 rds-for-index-fi
11020 6c 65 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 le db run-id tes
11030 74 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 t-name). (let (
11040 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 (res '())). (
11050 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
11060 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 -row . (lamb
11070 64 61 20 28 69 64 20 69 74 65 6d 70 61 74 68 20 da (id itempath
11080 73 74 61 74 65 20 73 74 61 74 75 73 20 72 75 6e state status run
11090 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 63 _duration logf c
110a0 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20 20 28 omment). (
110b0 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 set! res (cons (
110c0 76 65 63 74 6f 72 20 69 64 20 69 74 65 6d 70 61 vector id itempa
110d0 74 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 th state status
110e0 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 run_duration log
110f0 66 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 29 f comment) res))
11100 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 ). db. "
11110 53 45 4c 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 SELECT id,item_p
11120 61 74 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 ath,state,status
11130 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 ,run_duration,fi
11140 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 nal_logf,comment
11150 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
11160 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
11170 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
11180 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 3b 22 0a em_path != '';".
11190 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 run-id test
111a0 2d 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 29 29 -name). res))
111b0 0a 0a 3b 3b 20 52 6f 6c 6c 75 70 20 74 68 65 20 ..;; Rollup the
111c0 70 61 73 73 2f 66 61 69 6c 20 63 6f 75 6e 74 73 pass/fail counts
111d0 20 66 72 6f 6d 20 69 74 65 6d 69 7a 65 64 20 74 from itemized t
111e0 65 73 74 73 20 69 6e 74 6f 20 66 61 69 6c 5f 63 ests into fail_c
111f0 6f 75 6e 74 20 61 6e 64 20 70 61 73 73 5f 63 6f ount and pass_co
11200 75 6e 74 0a 3b 3b 20 4e 4f 54 45 3a 20 49 73 20 unt.;; NOTE: Is
11210 74 68 69 73 20 64 75 70 6c 69 63 61 74 69 6e 67 this duplicating
11220 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 (db:test-data-r
11230 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 64 ollup db test-id
11240 20 73 74 61 74 75 73 29 20 3f 3f 3f 3f 0a 28 64 status) ????.(d
11250 65 66 69 6e 65 20 28 64 62 3a 72 6f 6c 6c 2d 75 efine (db:roll-u
11260 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e p-pass-fail-coun
11270 74 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ts db run-id tes
11280 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
11290 20 73 74 61 74 75 73 29 0a 20 20 3b 3b 20 28 63 status). ;; (c
112a0 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 20 2a db:flush-queue *
112b0 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 20 20 28 69 runremote*). (i
112c0 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 75 f (and (not (equ
112d0 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
112e0 29 29 0a 09 20 20 20 28 6d 65 6d 62 65 72 20 73 )).. (member s
112f0 74 61 74 75 73 20 27 28 22 50 41 53 53 22 20 22 tatus '("PASS" "
11300 57 41 52 4e 22 20 22 46 41 49 4c 22 20 22 57 41 WARN" "FAIL" "WA
11310 49 56 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 IVED" "RUNNING"
11320 22 43 48 45 43 4b 22 20 22 53 4b 49 50 22 29 29 "CHECK" "SKIP"))
11330 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ). (begin..
11340 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
11350 20 0a 09 20 64 62 0a 09 20 22 55 50 44 41 54 45 .. db.. "UPDATE
11360 20 74 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 tests .
11370 20 20 20 20 20 53 45 54 20 66 61 69 6c 5f 63 6f SET fail_co
11380 75 6e 74 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e unt=(SELECT coun
11390 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 t(id) FROM tests
113a0 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
113b0 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
113c0 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
113d0 27 27 20 41 4e 44 20 73 74 61 74 75 73 20 49 4e '' AND status IN
113e0 20 28 27 46 41 49 4c 27 2c 27 43 48 45 43 4b 27 ('FAIL','CHECK'
113f0 29 29 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 )),.
11400 20 20 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d pass_count=
11410 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
11420 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 ) FROM tests WHE
11430 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
11440 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
11450 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 tem_path != '' A
11460 4e 44 20 73 74 61 74 75 73 20 49 4e 20 28 27 50 ND status IN ('P
11470 41 53 53 27 2c 27 57 41 52 4e 27 2c 27 57 41 49 ASS','WARN','WAI
11480 56 45 44 27 29 29 0a 20 20 20 20 20 20 20 20 20 VED')).
11490 20 20 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 WHERE run_id
114a0 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
114b0 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
114c0 27 27 3b 22 0a 09 20 72 75 6e 2d 69 64 20 74 65 '';".. run-id te
114d0 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 st-name run-id t
114e0 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 est-name run-id
114f0 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 test-name).
11500 20 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c ;; (thread-sl
11510 65 65 70 21 20 30 2e 31 29 20 3b 3b 20 67 69 76 eep! 0.1) ;; giv
11520 65 20 6f 74 68 65 72 20 70 72 6f 63 65 73 73 65 e other processe
11530 73 20 61 20 63 68 61 6e 63 65 20 68 65 72 65 2c s a chance here,
11540 20 6e 6f 2c 20 62 65 74 74 65 72 20 74 6f 20 62 no, better to b
11550 65 20 64 6f 6e 65 20 41 53 41 50 3f 0a 09 28 69 e done ASAP?..(i
11560 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 f (equal? status
11570 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 72 "RUNNING") ;; r
11580 75 6e 6e 69 6e 67 20 74 61 6b 65 73 20 70 72 69 unning takes pri
11590 6f 72 69 74 79 20 6f 76 65 72 20 61 6c 6c 20 6f ority over all o
115a0 74 68 65 72 20 73 74 61 74 65 73 2c 20 66 6f 72 ther states, for
115b0 63 65 20 74 68 65 20 74 65 73 74 20 73 74 61 74 ce the test stat
115c0 65 20 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 20 20 e to RUNNING..
115d0 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
115e0 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 te db "UPDATE te
115f0 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 sts SET state=?
11600 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
11610 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
11620 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 D item_path='';"
11630 20 22 52 55 4e 4e 49 4e 47 22 20 72 75 6e 2d 69 "RUNNING" run-i
11640 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 d test-name)..
11650 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
11660 74 65 0a 09 20 20 20 20 20 64 62 0a 09 20 20 20 te.. db..
11670 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 0a "UPDATE tests.
11680 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11690 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 65 SET state
116a0 3d 43 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 =CASE .
116b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
116c0 20 20 20 20 20 20 20 20 20 20 57 48 45 4e 20 28 WHEN (
116d0 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
116e0 20 46 52 4f 4d 20 74 65 73 74 73 20 0a 20 20 20 FROM tests .
116f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11710 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 WHE
11720 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
11730 74 65 73 74 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 testname=?.
11740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11770 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d AND item_path !=
11780 20 27 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 '' .
11790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
117a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
117b0 20 20 20 20 20 20 20 20 20 20 41 4e 44 20 73 74 AND st
117c0 61 74 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e 47 ate in ('RUNNING
117d0 27 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 29 ','NOT_STARTED')
117e0 29 20 3e 20 30 20 54 48 45 4e 20 27 52 55 4e 4e ) > 0 THEN 'RUNN
117f0 49 4e 47 27 0a 20 20 20 20 20 20 20 20 20 20 20 ING'.
11800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11810 20 20 20 20 20 20 20 20 45 4c 53 45 20 27 43 4f ELSE 'CO
11820 4d 50 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 20 MPLETED' END,.
11830 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11840 20 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 status
11850 3d 43 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 =CASE .
11860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11870 20 20 20 20 20 20 20 20 20 57 48 45 4e 20 66 61 WHEN fa
11880 69 6c 5f 63 6f 75 6e 74 20 3e 20 30 20 54 48 45 il_count > 0 THE
11890 4e 20 27 46 41 49 4c 27 20 0a 20 20 20 20 20 20 N 'FAIL' .
118a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
118b0 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 4e WHEN
118c0 20 70 61 73 73 5f 63 6f 75 6e 74 20 3e 20 30 20 pass_count > 0
118d0 41 4e 44 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 AND fail_count=0
118e0 20 54 48 45 4e 20 27 50 41 53 53 27 20 0a 20 20 THEN 'PASS' .
118f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11900 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11910 57 48 45 4e 20 28 53 45 4c 45 43 54 20 63 6f 75 WHEN (SELECT cou
11920 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 nt(id) FROM test
11930 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
11940 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11950 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
11960 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
11970 73 74 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 20 20 stname=?.
11980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119a0 20 20 20 20 20 20 20 41 4e 44 20 69 74 65 6d 5f AND item_
119b0 70 61 74 68 20 21 3d 20 27 27 0a 20 20 20 20 20 path != ''.
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 20 20 20 20 20 20 20 20
119e0 20 20 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 AND sta
119f0 74 75 73 20 3d 20 27 53 4b 49 50 27 29 20 3e 20 tus = 'SKIP') >
11a00 30 20 54 48 45 4e 20 27 53 4b 49 50 27 0a 20 20 0 THEN 'SKIP'.
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 20 20 20 20 20
11a30 45 4c 53 45 20 27 55 4e 4b 4e 4f 57 4e 27 20 45 ELSE 'UNKNOWN' E
11a40 4e 44 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ND.
11a50 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 20 WHERE
11a60 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
11a70 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
11a80 5f 70 61 74 68 3d 27 27 3b 22 0a 09 20 20 20 20 _path='';"..
11a90 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
11aa0 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 e run-id test-na
11ab0 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e me run-id test-n
11ac0 61 6d 65 29 29 0a 09 23 66 29 0a 20 20 20 20 20 ame))..#f).
11ad0 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #f))..;;=======
11ae0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11af0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11b00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11b10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
11b20 3b 3b 20 54 65 73 74 73 20 6d 65 74 61 20 64 61 ;; Tests meta da
11b30 74 61 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ta.;;===========
11b40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11b50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
11b80 72 65 61 64 20 74 68 65 20 72 65 63 6f 72 64 20 read the record
11b90 67 69 76 65 6e 20 61 20 74 65 73 74 6e 61 6d 65 given a testname
11ba0 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 .(define (db:tes
11bb0 74 6d 65 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 tmeta-get-record
11bc0 20 64 62 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 db testname).
11bd0 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a (let ((res #f)).
11be0 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
11bf0 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
11c00 6c 61 6d 62 64 61 20 28 69 64 20 74 65 73 74 6e lambda (id testn
11c10 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 ame author owner
11c20 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 description rev
11c30 69 65 77 65 64 20 69 74 65 72 61 74 65 64 20 61 iewed iterated a
11c40 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 vg_runtime avg_d
11c50 69 73 6b 20 74 61 67 73 29 0a 20 20 20 20 20 20 isk tags).
11c60 20 28 73 65 74 21 20 72 65 73 20 28 76 65 63 74 (set! res (vect
11c70 6f 72 20 69 64 20 74 65 73 74 6e 61 6d 65 20 61 or id testname a
11c80 75 74 68 6f 72 20 6f 77 6e 65 72 20 64 65 73 63 uthor owner desc
11c90 72 69 70 74 69 6f 6e 20 72 65 76 69 65 77 65 64 ription reviewed
11ca0 20 69 74 65 72 61 74 65 64 20 61 76 67 5f 72 75 iterated avg_ru
11cb0 6e 74 69 6d 65 20 61 76 67 5f 64 69 73 6b 20 74 ntime avg_disk t
11cc0 61 67 73 29 29 29 0a 20 20 20 20 20 64 62 20 22 ags))). db "
11cd0 53 45 4c 45 43 54 20 69 64 2c 74 65 73 74 6e 61 SELECT id,testna
11ce0 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c me,author,owner,
11cf0 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 description,revi
11d00 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 ewed,iterated,av
11d10 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 g_runtime,avg_di
11d20 73 6b 2c 74 61 67 73 20 46 52 4f 4d 20 74 65 73 sk,tags FROM tes
11d30 74 5f 6d 65 74 61 20 57 48 45 52 45 20 74 65 73 t_meta WHERE tes
11d40 74 6e 61 6d 65 3d 3f 3b 22 0a 20 20 20 20 20 74 tname=?;". t
11d50 65 73 74 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 estname). res
11d60 29 29 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 ))..;; create a
11d70 6e 65 77 20 72 65 63 6f 72 64 20 66 6f 72 20 61 new record for a
11d80 20 67 69 76 65 6e 20 74 65 73 74 6e 61 6d 65 0a given testname.
11d90 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
11da0 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 64 20 meta-add-record
11db0 64 62 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 28 db testname). (
11dc0 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
11dd0 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 db "INSERT OR IG
11de0 4e 4f 52 45 20 49 4e 54 4f 20 74 65 73 74 5f 6d NORE INTO test_m
11df0 65 74 61 20 28 74 65 73 74 6e 61 6d 65 2c 61 75 eta (testname,au
11e00 74 68 6f 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 thor,owner,descr
11e10 69 70 74 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c iption,reviewed,
11e20 69 74 65 72 61 74 65 64 2c 61 76 67 5f 72 75 6e iterated,avg_run
11e30 74 69 6d 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 time,avg_disk,ta
11e40 67 73 29 20 56 41 4c 55 45 53 20 28 3f 2c 27 27 gs) VALUES (?,''
11e50 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c ,'','','','','',
11e60 27 27 2c 27 27 29 3b 22 20 74 65 73 74 6e 61 6d '','');" testnam
11e70 65 29 29 0a 0a 3b 3b 20 75 70 64 61 74 65 20 6f e))..;; update o
11e80 6e 65 20 6f 66 20 74 68 65 20 74 65 73 74 6d 65 ne of the testme
11e90 74 61 20 66 69 65 6c 64 73 0a 28 64 65 66 69 6e ta fields.(defin
11ea0 65 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 75 e (db:testmeta-u
11eb0 70 64 61 74 65 2d 66 69 65 6c 64 20 64 62 20 74 pdate-field db t
11ec0 65 73 74 6e 61 6d 65 20 66 69 65 6c 64 20 76 61 estname field va
11ed0 6c 75 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a lue). (sqlite3:
11ee0 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 execute db (conc
11ef0 20 22 55 50 44 41 54 45 20 74 65 73 74 5f 6d 65 "UPDATE test_me
11f00 74 61 20 53 45 54 20 22 20 66 69 65 6c 64 20 22 ta SET " field "
11f10 3d 3f 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d =? WHERE testnam
11f20 65 3d 3f 3b 22 29 20 76 61 6c 75 65 20 74 65 73 e=?;") value tes
11f30 74 6e 61 6d 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d tname))..;;=====
11f40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11f80 3d 0a 3b 3b 20 54 20 45 20 53 20 54 20 20 20 44 =.;; T E S T D
11f90 20 41 20 54 20 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d A T A .;;======
11fa0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11fe0 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 63 73 ..(define (db:cs
11ff0 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 v->test-data db
12000 74 65 73 74 2d 69 64 20 63 73 76 64 61 74 61 20 test-id csvdata
12010 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 #!key (work-area
12020 20 23 66 29 29 0a 20 20 28 64 65 62 75 67 3a 70 #f)). (debug:p
12030 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 64 20 rint 4 "test-id
12040 22 20 74 65 73 74 2d 69 64 20 22 2c 20 63 73 76 " test-id ", csv
12050 64 61 74 61 3a 20 22 20 63 73 76 64 61 74 61 29 data: " csvdata)
12060 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 20 20 . (let ((tdb
12070 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d (db:open-test-
12080 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
12090 20 74 65 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 test-id work-ar
120a0 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 ea: work-area)))
120b0 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 6c . (if tdb..(l
120c0 65 74 20 28 28 63 73 76 6c 69 73 74 20 28 63 73 et ((csvlist (cs
120d0 76 2d 3e 6c 69 73 74 20 28 6d 61 6b 65 2d 63 73 v->list (make-cs
120e0 76 2d 72 65 61 64 65 72 0a 09 09 09 09 20 20 20 v-reader.....
120f0 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 (open-input-stri
12100 6e 67 20 63 73 76 64 61 74 61 29 0a 09 09 09 09 ng csvdata).....
12110 20 20 20 27 28 28 73 74 72 69 70 2d 6c 65 61 64 '((strip-lead
12120 69 6e 67 2d 77 68 69 74 65 73 70 61 63 65 3f 20 ing-whitespace?
12130 23 74 29 0a 09 09 09 09 20 20 20 20 20 28 73 74 #t)..... (st
12140 72 69 70 2d 74 72 61 69 6c 69 6e 67 2d 77 68 69 rip-trailing-whi
12150 74 65 73 70 61 63 65 3f 20 23 74 29 29 20 29 29 tespace? #t)) ))
12160 29 29 20 3b 3b 20 28 63 73 76 2d 3e 6c 69 73 74 )) ;; (csv->list
12170 20 63 73 76 64 61 74 61 29 29 29 0a 09 20 20 28 csvdata))).. (
12180 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c for-each .. (l
12190 61 6d 62 64 61 20 28 63 73 76 72 6f 77 29 0a 09 ambda (csvrow)..
121a0 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 64 (let* ((pad
121b0 64 65 64 2d 72 6f 77 20 20 28 74 61 6b 65 20 28 ded-row (take (
121c0 61 70 70 65 6e 64 20 63 73 76 72 6f 77 20 28 6c append csvrow (l
121d0 69 73 74 20 23 66 20 23 66 20 23 66 20 23 66 20 ist #f #f #f #f
121e0 23 66 20 23 66 20 23 66 20 23 66 20 23 66 29 29 #f #f #f #f #f))
121f0 20 39 29 29 0a 09 09 20 20 20 20 28 63 61 74 65 9))... (cate
12200 67 6f 72 79 20 20 20 20 28 6c 69 73 74 2d 72 65 gory (list-re
12210 66 20 70 61 64 64 65 64 2d 72 6f 77 20 30 29 29 f padded-row 0))
12220 0a 09 09 20 20 20 20 28 76 61 72 69 61 62 6c 65 ... (variable
12230 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 (list-ref pa
12240 64 64 65 64 2d 72 6f 77 20 31 29 29 0a 09 09 20 dded-row 1))...
12250 20 20 20 28 76 61 6c 75 65 20 20 20 20 20 20 20 (value
12260 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 2d (any->number-if-
12270 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 74 2d 72 possible (list-r
12280 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 32 29 ef padded-row 2)
12290 29 29 0a 09 09 20 20 20 20 28 65 78 70 65 63 74 ))... (expect
122a0 65 64 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 ed (any->numb
122b0 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 er-if-possible (
122c0 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
122d0 72 6f 77 20 33 29 29 29 0a 09 09 20 20 20 20 28 row 3)))... (
122e0 74 6f 6c 20 20 20 20 20 20 20 20 20 28 61 6e 79 tol (any
122f0 2d 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 ->number-if-poss
12300 69 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 ible (list-ref p
12310 61 64 64 65 64 2d 72 6f 77 20 34 29 29 29 20 3b added-row 4))) ;
12320 3b 20 3e 2c 20 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 ; >, <, >=, <=,
12330 6f 72 20 61 20 6e 75 6d 62 65 72 0a 09 09 20 20 or a number...
12340 20 20 28 75 6e 69 74 73 20 20 20 20 20 20 20 28 (units (
12350 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
12360 72 6f 77 20 35 29 29 0a 09 09 20 20 20 20 28 63 row 5))... (c
12370 6f 6d 6d 65 6e 74 20 20 20 20 20 28 6c 69 73 74 omment (list
12380 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 -ref padded-row
12390 36 29 29 0a 09 09 20 20 20 20 28 73 74 61 74 75 6))... (statu
123a0 73 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 20 s (let ((s
123b0 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 (list-ref padded
123c0 2d 72 6f 77 20 37 29 29 29 0a 09 09 09 09 20 20 -row 7))).....
123d0 20 28 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e (if (and (strin
123e0 67 3f 20 73 29 28 6f 72 20 28 73 74 72 69 6e 67 g? s)(or (string
123f0 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 -match (regexp "
12400 5e 5c 5c 73 2a 24 22 29 20 73 29 0a 09 09 09 09 ^\\s*$") s).....
12410 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 ... (string-ma
12420 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 6e 2f tch (regexp "^n/
12430 61 24 22 29 20 73 29 29 29 0a 09 09 09 09 20 20 a$") s))).....
12440 20 20 20 20 20 23 66 0a 09 09 09 09 20 20 20 20 #f.....
12450 20 20 20 73 29 29 29 20 3b 3b 20 69 66 20 73 70 s))) ;; if sp
12460 65 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 69 ecified on the i
12470 6e 70 75 74 20 74 68 65 6e 20 75 73 65 2c 20 65 nput then use, e
12480 6c 73 65 20 63 61 6c 63 75 6c 61 74 65 0a 09 09 lse calculate...
12490 20 20 20 20 28 74 79 70 65 20 20 20 20 20 20 20 (type
124a0 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 (list-ref padde
124b0 64 2d 72 6f 77 20 38 29 29 29 0a 09 20 20 20 20 d-row 8)))..
124c0 20 20 20 3b 3b 20 6c 6f 6f 6b 20 75 70 20 65 78 ;; look up ex
124d0 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 pected,tol,units
124e0 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 62 from previous b
124f0 65 73 74 20 66 69 74 20 74 65 73 74 20 69 66 20 est fit test if
12500 74 68 65 79 20 61 72 65 20 61 6c 6c 20 65 69 74 they are all eit
12510 68 65 72 20 23 66 20 6f 72 20 27 27 0a 09 20 20 her #f or ''..
12520 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
12530 74 20 34 20 22 42 45 46 4f 52 45 3a 20 63 61 74 t 4 "BEFORE: cat
12540 65 67 6f 72 79 3a 20 22 20 63 61 74 65 67 6f 72 egory: " categor
12550 79 20 22 20 76 61 72 69 61 62 6c 65 3a 20 22 20 y " variable: "
12560 76 61 72 69 61 62 6c 65 20 22 20 76 61 6c 75 65 variable " value
12570 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 09 20 20 : " value ....
12580 20 20 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 ", expected: "
12590 20 65 78 70 65 63 74 65 64 20 22 20 74 6f 6c 3a expected " tol:
125a0 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 " tol " units:
125b0 22 20 75 6e 69 74 73 20 22 20 73 74 61 74 75 73 " units " status
125c0 3a 20 22 20 73 74 61 74 75 73 20 22 20 63 6f 6d : " status " com
125d0 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 20 ment: " comment
125e0 22 20 74 79 70 65 3a 20 22 20 74 79 70 65 29 0a " type: " type).
125f0 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 61 6e .. (if (an
12600 64 20 28 6f 72 20 28 6e 6f 74 20 65 78 70 65 63 d (or (not expec
12610 74 65 64 29 28 65 71 75 61 6c 3f 20 65 78 70 65 ted)(equal? expe
12620 63 74 65 64 20 22 22 29 29 0a 09 09 09 28 6f 72 cted ""))....(or
12630 20 28 6e 6f 74 20 74 6f 6c 29 20 20 20 20 20 28 (not tol) (
12640 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 equal? expected
12650 22 22 29 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 ""))....(or (not
12660 20 75 6e 69 74 73 29 20 20 20 28 65 71 75 61 6c units) (equal
12670 3f 20 65 78 70 65 63 74 65 64 20 22 22 29 29 29 ? expected "")))
12680 0a 09 09 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 ... (let-value
12690 73 20 28 28 28 6e 65 77 2d 65 78 70 65 63 74 65 s (((new-expecte
126a0 64 20 6e 65 77 2d 74 6f 6c 20 6e 65 77 2d 75 6e d new-tol new-un
126b0 69 74 73 29 28 64 62 3a 67 65 74 2d 70 72 65 76 its)(db:get-prev
126c0 2d 74 6f 6c 2d 66 6f 72 2d 74 65 73 74 20 64 62 -tol-for-test db
126d0 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 test-id categor
126e0 79 20 76 61 72 69 61 62 6c 65 29 29 29 0a 09 09 y variable)))...
126f0 09 20 20 20 20 20 20 20 28 73 65 74 21 20 65 78 . (set! ex
12700 70 65 63 74 65 64 20 6e 65 77 2d 65 78 70 65 63 pected new-expec
12710 74 65 64 29 0a 09 09 09 20 20 20 20 20 20 20 28 ted).... (
12720 73 65 74 21 20 74 6f 6c 20 20 20 20 20 20 6e 65 set! tol ne
12730 77 2d 74 6f 6c 29 0a 09 09 09 20 20 20 20 20 20 w-tol)....
12740 20 28 73 65 74 21 20 75 6e 69 74 73 20 20 20 20 (set! units
12750 6e 65 77 2d 75 6e 69 74 73 29 29 29 0a 0a 09 20 new-units)))...
12760 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
12770 6e 74 20 34 20 22 41 46 54 45 52 3a 20 20 63 61 nt 4 "AFTER: ca
12780 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 67 6f tegory: " catego
12790 72 79 20 22 20 76 61 72 69 61 62 6c 65 3a 20 22 ry " variable: "
127a0 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 6c 75 variable " valu
127b0 65 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 09 20 e: " value ....
127c0 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 3a 20 ", expected:
127d0 22 20 65 78 70 65 63 74 65 64 20 22 20 74 6f 6c " expected " tol
127e0 3a 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 73 3a : " tol " units:
127f0 20 22 20 75 6e 69 74 73 20 22 20 73 74 61 74 75 " units " statu
12800 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 63 6f s: " status " co
12810 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 mment: " comment
12820 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 63 61 6c ).. ;; cal
12830 63 75 6c 61 74 65 20 73 74 61 74 75 73 20 69 66 culate status if
12840 20 4e 4f 54 20 73 70 65 63 69 66 69 65 64 0a 09 NOT specified..
12850 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
12860 28 6e 6f 74 20 73 74 61 74 75 73 29 28 6e 75 6d (not status)(num
12870 62 65 72 3f 20 65 78 70 65 63 74 65 64 29 28 6e ber? expected)(n
12880 75 6d 62 65 72 3f 20 76 61 6c 75 65 29 29 20 3b umber? value)) ;
12890 3b 20 6e 65 65 64 20 65 78 70 65 63 74 65 64 20 ; need expected
128a0 61 6e 64 20 76 61 6c 75 65 20 74 6f 20 62 65 20 and value to be
128b0 6e 75 6d 62 65 72 73 0a 09 09 20 20 20 28 69 66 numbers... (if
128c0 20 28 6e 75 6d 62 65 72 3f 20 74 6f 6c 29 20 3b (number? tol) ;
128d0 3b 20 69 66 20 74 6f 6c 20 69 73 20 61 20 6e 75 ; if tol is a nu
128e0 6d 62 65 72 20 74 68 65 6e 20 77 65 20 64 6f 20 mber then we do
128f0 74 68 65 20 73 74 61 6e 64 61 72 64 20 63 6f 6d the standard com
12900 70 61 72 69 73 6f 6e 0a 09 09 20 20 20 20 20 20 parison...
12910 20 28 6c 65 74 2a 20 28 28 6d 61 78 2d 76 61 6c (let* ((max-val
12920 20 28 2b 20 65 78 70 65 63 74 65 64 20 74 6f 6c (+ expected tol
12930 29 29 0a 09 09 09 20 20 20 20 20 20 28 6d 69 6e )).... (min
12940 2d 76 61 6c 20 28 2d 20 65 78 70 65 63 74 65 64 -val (- expected
12950 20 74 6f 6c 29 29 0a 09 09 09 20 20 20 20 20 20 tol))....
12960 28 72 65 73 75 6c 74 20 20 28 61 6e 64 20 28 3e (result (and (>
12970 3d 20 20 76 61 6c 75 65 20 6d 69 6e 2d 76 61 6c = value min-val
12980 29 28 3c 3d 20 76 61 6c 75 65 20 6d 61 78 2d 76 )(<= value max-v
12990 61 6c 29 29 29 29 0a 09 09 09 20 28 64 65 62 75 al)))).... (debu
129a0 67 3a 70 72 69 6e 74 20 34 20 22 6d 61 78 2d 76 g:print 4 "max-v
129b0 61 6c 3a 20 22 20 6d 61 78 2d 76 61 6c 20 22 20 al: " max-val "
129c0 6d 69 6e 2d 76 61 6c 3a 20 22 20 6d 69 6e 2d 76 min-val: " min-v
129d0 61 6c 20 22 20 72 65 73 75 6c 74 3a 20 22 20 72 al " result: " r
129e0 65 73 75 6c 74 29 0a 09 09 09 20 28 73 65 74 21 esult).... (set!
129f0 20 73 74 61 74 75 73 20 28 69 66 20 72 65 73 75 status (if resu
12a00 6c 74 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 lt "pass" "fail"
12a10 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 65 )))... (se
12a20 74 21 20 73 74 61 74 75 73 20 3b 3b 20 4e 42 2f t! status ;; NB/
12a30 2f 20 6e 65 65 64 20 74 6f 20 61 73 73 65 73 73 / need to assess
12a40 20 65 61 63 68 20 6f 6e 65 20 28 69 2e 65 2e 20 each one (i.e.
12a50 6e 6f 74 20 72 65 74 75 72 6e 20 6f 70 65 72 61 not return opera
12a60 74 6f 72 20 73 69 6e 63 65 20 6e 65 65 64 20 74 tor since need t
12a70 6f 20 61 63 74 20 69 66 20 6e 6f 74 20 76 61 6c o act if not val
12a80 69 64 20 6f 70 2e 0a 09 09 09 20 20 20 20 20 28 id op..... (
12a90 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
12aa0 6d 62 6f 6c 20 74 6f 6c 29 20 3b 3b 20 74 6f 6c mbol tol) ;; tol
12ab0 20 73 68 6f 75 6c 64 20 62 65 20 3e 2c 20 3c 2c should be >, <,
12ac0 20 3e 3d 2c 20 3c 3d 0a 09 09 09 20 20 20 20 20 >=, <=....
12ad0 20 20 28 28 3e 29 20 20 28 69 66 20 28 3e 20 20 ((>) (if (>
12ae0 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 value expected)
12af0 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a "pass" "fail")).
12b00 09 09 09 20 20 20 20 20 20 20 28 28 3c 29 20 20 ... ((<)
12b10 28 69 66 20 28 3c 20 20 76 61 6c 75 65 20 65 78 (if (< value ex
12b20 70 65 63 74 65 64 29 20 22 70 61 73 73 22 20 22 pected) "pass" "
12b30 66 61 69 6c 22 29 29 0a 09 09 09 20 20 20 20 20 fail"))....
12b40 20 20 28 28 3e 3d 29 20 28 69 66 20 28 3e 3d 20 ((>=) (if (>=
12b50 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 value expected)
12b60 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a "pass" "fail")).
12b70 09 09 09 20 20 20 20 20 20 20 28 28 3c 3d 29 20 ... ((<=)
12b80 28 69 66 20 28 3c 3d 20 76 61 6c 75 65 20 65 78 (if (<= value ex
12b90 70 65 63 74 65 64 29 20 22 70 61 73 73 22 20 22 pected) "pass" "
12ba0 66 61 69 6c 22 29 29 0a 09 09 09 20 20 20 20 20 fail"))....
12bb0 20 20 28 65 6c 73 65 20 28 63 6f 6e 63 20 22 45 (else (conc "E
12bc0 52 52 4f 52 3a 20 62 61 64 20 74 6f 6c 20 63 6f RROR: bad tol co
12bd0 6d 70 61 72 61 74 6f 72 20 22 20 74 6f 6c 29 29 mparator " tol))
12be0 29 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 65 )))).. (de
12bf0 62 75 67 3a 70 72 69 6e 74 20 34 20 22 41 46 54 bug:print 4 "AFT
12c00 45 52 32 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 ER2: category: "
12c10 20 63 61 74 65 67 6f 72 79 20 22 20 76 61 72 69 category " vari
12c20 61 62 6c 65 3a 20 22 20 76 61 72 69 61 62 6c 65 able: " variable
12c30 20 22 20 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 " value: " valu
12c40 65 20 0a 09 09 09 20 20 20 20 22 2c 20 65 78 70 e .... ", exp
12c50 65 63 74 65 64 3a 20 22 20 65 78 70 65 63 74 65 ected: " expecte
12c60 64 20 22 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 d " tol: " tol "
12c70 20 75 6e 69 74 73 3a 20 22 20 75 6e 69 74 73 20 units: " units
12c80 22 20 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 " status: " stat
12c90 75 73 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 us " comment: "
12ca0 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 20 20 20 comment)..
12cb0 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
12cc0 65 20 74 64 62 20 22 49 4e 53 45 52 54 20 4f 52 e tdb "INSERT OR
12cd0 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 74 65 REPLACE INTO te
12ce0 73 74 5f 64 61 74 61 20 28 74 65 73 74 5f 69 64 st_data (test_id
12cf0 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 ,category,variab
12d00 6c 65 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 le,value,expecte
12d10 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d d,tol,units,comm
12d20 65 6e 74 2c 73 74 61 74 75 73 2c 74 79 70 65 29 ent,status,type)
12d30 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f VALUES (?,?,?,?
12d40 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a ,?,?,?,?,?,?);".
12d50 09 09 09 09 74 65 73 74 2d 69 64 20 63 61 74 65 ....test-id cate
12d60 67 6f 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 gory variable va
12d70 6c 75 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c lue expected tol
12d80 20 75 6e 69 74 73 20 28 69 66 20 63 6f 6d 6d 65 units (if comme
12d90 6e 74 20 63 6f 6d 6d 65 6e 74 20 22 22 29 20 73 nt comment "") s
12da0 74 61 74 75 73 20 74 79 70 65 29 29 29 0a 09 20 tatus type)))..
12db0 20 20 63 73 76 6c 69 73 74 29 0a 09 20 20 28 73 csvlist).. (s
12dc0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
12dd0 20 74 64 62 29 29 29 29 29 0a 0a 3b 3b 20 67 65 tdb)))))..;; ge
12de0 74 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 t a list of test
12df0 5f 64 61 74 61 20 72 65 63 6f 72 64 73 20 6d 61 _data records ma
12e00 74 63 68 69 6e 67 20 63 61 74 65 67 6f 72 79 70 tching categoryp
12e10 61 74 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a att.(define (db:
12e20 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 read-test-data d
12e30 62 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f b test-id catego
12e40 72 79 70 61 74 74 20 23 21 6b 65 79 20 28 77 6f rypatt #!key (wo
12e50 72 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 rk-area #f)). (
12e60 6c 65 74 20 28 28 74 64 62 20 20 28 64 62 3a 6f let ((tdb (db:o
12e70 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 pen-test-db-by-t
12e80 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 est-id db test-i
12e90 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 d work-area: wor
12ea0 6b 2d 61 72 65 61 29 29 29 0a 20 20 20 20 28 69 k-area))). (i
12eb0 66 20 74 64 62 0a 09 28 6c 65 74 20 28 28 72 65 f tdb..(let ((re
12ec0 73 20 27 28 29 29 29 0a 09 20 20 28 73 71 6c 69 s '())).. (sqli
12ed0 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
12ee0 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 69 .. (lambda (i
12ef0 64 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f d test_id catego
12f00 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
12f10 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
12f20 6e 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61 nits comment sta
12f30 74 75 73 20 74 79 70 65 29 0a 09 20 20 20 20 20 tus type)..
12f40 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
12f50 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74 5f (vector id test_
12f60 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 id category vari
12f70 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 able value expec
12f80 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f ted tol units co
12f90 6d 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 mment status typ
12fa0 65 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 e) res))).. td
12fb0 62 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 b.. "SELECT id
12fc0 2c 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 ,test_id,categor
12fd0 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 y,variable,value
12fe0 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e ,expected,tol,un
12ff0 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 74 61 74 its,comment,stat
13000 75 73 2c 74 79 70 65 20 46 52 4f 4d 20 74 65 73 us,type FROM tes
13010 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 65 73 t_data WHERE tes
13020 74 5f 69 64 3d 3f 20 41 4e 44 20 63 61 74 65 67 t_id=? AND categ
13030 6f 72 79 20 4c 49 4b 45 20 3f 20 4f 52 44 45 52 ory LIKE ? ORDER
13040 20 42 59 20 63 61 74 65 67 6f 72 79 2c 76 61 72 BY category,var
13050 69 61 62 6c 65 3b 22 20 74 65 73 74 2d 69 64 20 iable;" test-id
13060 63 61 74 65 67 6f 72 79 70 61 74 74 29 0a 09 20 categorypatt)..
13070 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
13080 7a 65 21 20 74 64 62 29 0a 09 20 20 28 72 65 76 ze! tdb).. (rev
13090 65 72 73 65 20 72 65 73 29 29 0a 09 27 28 29 29 erse res))..'())
130a0 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 52 75 6e ))..;; NOTE: Run
130b0 20 74 68 69 73 20 6c 6f 63 61 6c 20 77 69 74 68 this local with
130c0 20 23 66 20 66 6f 72 20 64 62 20 21 21 21 0a 28 #f for db !!!.(
130d0 64 65 66 69 6e 65 20 28 64 62 3a 6c 6f 61 64 2d define (db:load-
130e0 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 test-data db tes
130f0 74 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 6b t-id #!key (work
13100 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c 65 -area #f)). (le
13110 74 20 6c 6f 6f 70 20 28 28 6c 69 6e 20 28 72 65 t loop ((lin (re
13120 61 64 2d 6c 69 6e 65 29 29 29 0a 20 20 20 20 28 ad-line))). (
13130 69 66 20 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a if (not (eof-obj
13140 65 63 74 3f 20 6c 69 6e 29 29 0a 09 28 62 65 67 ect? lin))..(beg
13150 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
13160 6e 74 20 34 20 6c 69 6e 29 0a 09 20 20 28 64 62 nt 4 lin).. (db
13170 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 61 20 :csv->test-data
13180 64 62 20 74 65 73 74 2d 69 64 20 6c 69 6e 20 77 db test-id lin w
13190 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 ork-area: work-a
131a0 72 65 61 29 0a 09 20 20 28 6c 6f 6f 70 20 28 72 rea).. (loop (r
131b0 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 0a 20 20 ead-line))))).
131c0 3b 3b 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 63 ;; roll up the c
131d0 75 72 72 65 6e 74 20 72 65 73 75 6c 74 73 2e 0a urrent results..
131e0 20 20 3b 3b 20 46 49 58 4d 45 3a 20 41 64 64 20 ;; FIXME: Add
131f0 74 68 65 20 73 74 61 74 75 73 20 74 6f 20 0a 20 the status to .
13200 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 (db:test-data-r
13210 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 64 ollup db test-id
13220 20 23 66 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 #f work-area: w
13230 6f 72 6b 2d 61 72 65 61 29 29 0a 0a 3b 3b 20 57 ork-area))..;; W
13240 41 52 4e 49 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 ARNING: Do NOT c
13250 61 6c 6c 20 74 68 69 73 20 66 6f 72 20 74 68 65 all this for the
13260 20 70 61 72 65 6e 74 20 74 65 73 74 20 6f 6e 20 parent test on
13270 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 an iterated test
13280 0a 3b 3b 20 52 6f 6c 6c 20 75 70 20 74 65 73 74 .;; Roll up test
13290 5f 64 61 74 61 20 70 61 73 73 2f 66 61 69 6c 20 _data pass/fail
132a0 72 65 73 75 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 results.;; look
132b0 61 74 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 at the test_data
132c0 20 73 74 61 74 75 73 20 66 69 65 6c 64 2c 20 0a status field, .
132d0 3b 3b 20 20 20 20 69 66 20 61 6c 6c 20 61 72 65 ;; if all are
132e0 20 70 61 73 73 20 28 61 6e 79 20 63 61 73 65 29 pass (any case)
132f0 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 73 74 and the test st
13300 61 74 75 73 20 69 73 20 50 41 53 53 20 6f 72 20 atus is PASS or
13310 4e 55 4c 4c 20 6f 72 20 27 27 20 74 68 65 6e 20 NULL or '' then
13320 73 65 74 20 74 65 73 74 20 73 74 61 74 75 73 20 set test status
13330 74 6f 20 50 41 53 53 2e 0a 3b 3b 20 20 20 20 69 to PASS..;; i
13340 66 20 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 61 72 f one or more ar
13350 65 20 66 61 69 6c 20 28 61 6e 79 20 63 61 73 65 e fail (any case
13360 29 20 74 68 65 6e 20 73 65 74 20 74 65 73 74 20 ) then set test
13370 73 74 61 74 75 73 20 74 6f 20 50 41 53 53 2c 20 status to PASS,
13380 6e 6f 6e 20 22 70 61 73 73 22 20 6f 72 20 22 66 non "pass" or "f
13390 61 69 6c 22 20 61 72 65 20 69 67 6e 6f 72 65 64 ail" are ignored
133a0 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 .(define (db:tes
133b0 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 t-data-rollup db
133c0 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 20 test-id status
133d0 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 #!key (work-area
133e0 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 74 #f)). (let ((t
133f0 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 db (db:open-test
13400 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 -db-by-test-id d
13410 62 20 74 65 73 74 2d 69 64 20 77 6f 72 6b 2d 61 b test-id work-a
13420 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 61 29 29 rea: work-area))
13430 0a 09 28 66 61 69 6c 2d 63 6f 75 6e 74 20 30 29 ..(fail-count 0)
13440 0a 09 28 70 61 73 73 2d 63 6f 75 6e 74 20 30 29 ..(pass-count 0)
13450 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 ). (if tdb..(
13460 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 begin.. (sqlite
13470 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 3:for-each-row..
13480 20 20 20 28 6c 61 6d 62 64 61 20 28 66 63 6f 75 (lambda (fcou
13490 6e 74 20 70 63 6f 75 6e 74 29 0a 09 20 20 20 20 nt pcount)..
134a0 20 28 73 65 74 21 20 66 61 69 6c 2d 63 6f 75 6e (set! fail-coun
134b0 74 20 66 63 6f 75 6e 74 29 0a 09 20 20 20 20 20 t fcount)..
134c0 28 73 65 74 21 20 70 61 73 73 2d 63 6f 75 6e 74 (set! pass-count
134d0 20 70 63 6f 75 6e 74 29 29 0a 09 20 20 20 74 64 pcount)).. td
134e0 62 20 0a 09 20 20 20 22 53 45 4c 45 43 54 20 28 b .. "SELECT (
134f0 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
13500 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 FROM test_data
13510 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 WHERE test_id=?
13520 41 4e 44 20 73 74 61 74 75 73 20 6c 69 6b 65 20 AND status like
13530 27 66 61 69 6c 27 29 20 41 53 20 66 61 69 6c 5f 'fail') AS fail_
13540 63 6f 75 6e 74 2c 0a 20 20 20 20 20 20 20 20 20 count,.
13550 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 (SELEC
13560 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d T count(id) FROM
13570 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 52 45 test_data WHERE
13580 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 73 test_id=? AND s
13590 74 61 74 75 73 20 6c 69 6b 65 20 27 70 61 73 73 tatus like 'pass
135a0 27 29 20 41 53 20 70 61 73 73 5f 63 6f 75 6e 74 ') AS pass_count
135b0 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 74 ;".. test-id t
135c0 65 73 74 2d 69 64 29 0a 09 20 20 28 73 71 6c 69 est-id).. (sqli
135d0 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 te3:finalize! td
135e0 62 29 0a 0a 09 20 20 3b 3b 20 4e 6f 77 20 72 6f b)... ;; Now ro
135f0 6c 6c 75 70 20 74 68 65 20 63 6f 75 6e 74 73 20 llup the counts
13600 74 6f 20 74 68 65 20 63 65 6e 74 72 61 6c 20 6d to the central m
13610 65 67 61 74 65 73 74 2e 64 62 0a 09 20 20 28 63 egatest.db.. (c
13620 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 db:pass-fail-cou
13630 6e 74 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 nts *runremote*
13640 74 65 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 test-id fail-cou
13650 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a 09 nt pass-count)..
13660 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ;; (sqlite3:ex
13670 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
13680 20 74 65 73 74 73 20 53 45 54 20 66 61 69 6c 5f tests SET fail_
13690 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f 75 count=?,pass_cou
136a0 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b nt=? WHERE id=?;
136b0 22 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 20 " .. ;;
136c0 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 69 fai
136d0 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 l-count pass-cou
136e0 6e 74 20 74 65 73 74 2d 69 64 29 0a 0a 09 20 20 nt test-id)...
136f0 3b 3b 20 54 68 65 20 66 6c 75 73 68 20 69 73 20 ;; The flush is
13700 6e 6f 74 20 6e 65 65 64 65 64 20 77 69 74 68 20 not needed with
13710 74 68 65 20 74 72 61 6e 73 61 63 74 69 6f 6e 20 the transaction
13720 62 61 73 65 64 20 77 72 69 74 65 20 61 67 72 65 based write agre
13730 67 61 74 69 6f 6e 20 65 6e 61 62 6c 65 64 2e 20 gation enabled.
13740 52 65 6d 6f 76 65 20 74 68 65 73 65 20 63 6f 6d Remove these com
13750 6d 65 6e 74 65 64 20 6c 69 6e 65 73 0a 09 20 20 mented lines..
13760 3b 3b 20 6e 65 78 74 20 74 69 6d 65 20 79 6f 75 ;; next time you
13770 20 72 65 61 64 20 74 68 69 73 21 0a 09 20 20 3b read this!.. ;
13780 3b 0a 09 20 20 3b 3b 20 28 63 64 62 3a 66 6c 75 ;.. ;; (cdb:flu
13790 73 68 2d 71 75 65 75 65 20 2a 72 75 6e 72 65 6d sh-queue *runrem
137a0 6f 74 65 2a 29 0a 09 20 20 3b 3b 20 28 74 68 72 ote*).. ;; (thr
137b0 65 61 64 2d 73 6c 65 65 70 21 20 31 29 20 3b 3b ead-sleep! 1) ;;
137c0 20 70 6c 61 79 20 6e 69 63 65 20 77 69 74 68 20 play nice with
137d0 74 68 65 20 71 75 65 75 65 20 62 79 20 65 6e 73 the queue by ens
137e0 75 72 69 6e 67 20 74 68 65 20 72 6f 6c 6c 75 70 uring the rollup
137f0 20 69 73 20 61 74 20 6c 65 61 73 74 20 31 30 6d is at least 10m
13800 73 20 6c 61 74 65 72 20 74 68 61 6e 20 74 68 65 s later than the
13810 20 73 65 74 0a 09 20 20 0a 09 20 20 3b 3b 20 69 set.. .. ;; i
13820 66 20 74 68 65 20 74 65 73 74 20 69 73 20 6e 6f f the test is no
13830 74 20 46 41 49 4c 20 74 68 65 6e 20 73 65 74 20 t FAIL then set
13840 73 74 61 74 75 73 20 62 61 73 65 64 20 6f 6e 20 status based on
13850 74 68 65 20 66 61 69 6c 20 61 6e 64 20 70 61 73 the fail and pas
13860 73 20 63 6f 75 6e 74 73 2e 0a 09 20 20 28 63 64 s counts... (cd
13870 62 3a 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 74 65 b:test-rollup-te
13880 73 74 5f 64 61 74 61 2d 70 61 73 73 2d 66 61 69 st_data-pass-fai
13890 6c 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 l *runremote* te
138a0 73 74 2d 69 64 29 0a 09 20 20 3b 3b 20 28 73 71 st-id).. ;; (sq
138b0 6c 69 74 65 33 3a 65 78 65 63 75 74 65 0a 09 20 lite3:execute..
138c0 20 3b 3b 20 20 64 62 20 20 20 3b 3b 3b 20 4e 4f ;; db ;;; NO
138d0 54 45 3a 20 53 68 6f 75 6c 64 20 74 68 69 73 20 TE: Should this
138e0 62 65 20 57 41 52 4e 2c 46 41 49 4c 3f 20 41 20 be WARN,FAIL? A
138f0 57 41 52 4e 20 69 73 20 6e 6f 74 20 61 20 46 41 WARN is not a FA
13900 49 4c 3f 3f 3f 3f 3f 20 42 55 47 20 46 49 58 4d IL????? BUG FIXM
13910 45 0a 09 20 20 3b 3b 20 20 22 55 50 44 41 54 45 E.. ;; "UPDATE
13920 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 tests.
13930 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
13940 53 45 54 20 73 74 61 74 75 73 3d 43 41 53 45 20 SET status=CASE
13950 57 48 45 4e 20 28 53 45 4c 45 43 54 20 66 61 69 WHEN (SELECT fai
13960 6c 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 l_count FROM tes
13970 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 3e ts WHERE id=?) >
13980 20 30 20 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 0 . ;;
13990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
139a0 54 48 45 4e 20 27 46 41 49 4c 27 0a 20 20 20 20 THEN 'FAIL'.
139b0 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
139c0 20 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 WHEN (SELEC
139d0 54 20 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f T pass_count FRO
139e0 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 M tests WHERE id
139f0 3d 3f 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 =?) > 0 AND .
13a00 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
13a10 20 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 (SELE
13a20 43 54 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 CT status FROM t
13a30 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 ests WHERE id=?)
13a40 20 4e 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c NOT IN ('WARN',
13a50 27 46 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 'FAIL').
13a60 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ;;
13a70 20 54 48 45 4e 20 27 50 41 53 53 27 0a 20 20 20 THEN 'PASS'.
13a80 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
13a90 20 20 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 ELSE statu
13aa0 73 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 s. ;;
13ab0 20 20 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 END WHERE
13ac0 20 69 64 3d 3f 3b 22 0a 09 20 20 3b 3b 20 20 74 id=?;".. ;; t
13ad0 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 est-id test-id t
13ae0 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 29 0a est-id test-id).
13af0 09 20 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 . ))))..(define
13b00 20 28 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f (db:get-prev-to
13b10 6c 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 l-for-test db te
13b20 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 st-id category v
13b30 61 72 69 61 62 6c 65 29 0a 20 20 3b 3b 20 46 69 ariable). ;; Fi
13b40 6e 69 73 68 20 6d 65 3f 0a 20 20 28 76 61 6c 75 nish me?. (valu
13b50 65 73 20 23 66 20 23 66 20 23 66 29 29 0a 0a 3b es #f #f #f))..;
13b60 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
13b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13b90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ba0 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 54 20 45 =======.;; S T E
13bb0 20 50 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d P S .;;========
13bc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13bd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13be0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13bf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
13c00 28 64 65 66 69 6e 65 20 28 64 62 3a 73 74 65 70 (define (db:step
13c10 2d 67 65 74 2d 74 69 6d 65 2d 61 73 2d 73 74 72 -get-time-as-str
13c20 69 6e 67 20 76 65 63 29 0a 20 20 28 73 65 63 6f ing vec). (seco
13c30 6e 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 nds->time-string
13c40 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
13c50 65 6e 74 5f 74 69 6d 65 20 76 65 63 29 29 29 0a ent_time vec))).
13c60 0a 3b 3b 20 64 62 2d 67 65 74 2d 74 65 73 74 2d .;; db-get-test-
13c70 73 74 65 70 73 2d 66 6f 72 2d 72 75 6e 0a 28 64 steps-for-run.(d
13c80 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 efine (db:get-st
13c90 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 eps-for-test db
13ca0 74 65 73 74 2d 69 64 20 23 21 6b 65 79 20 28 77 test-id #!key (w
13cb0 6f 72 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 20 ork-area #f)).
13cc0 28 6c 65 74 2a 20 28 28 74 64 62 20 28 64 62 3a (let* ((tdb (db:
13cd0 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d open-test-db-by-
13ce0 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d test-id db test-
13cf0 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 77 6f id work-area: wo
13d00 72 6b 2d 61 72 65 61 29 29 0a 09 20 28 72 65 73 rk-area)).. (res
13d10 20 27 28 29 29 29 0a 20 20 20 20 28 69 66 20 74 '())). (if t
13d20 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 db..(begin.. (s
13d30 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
13d40 72 6f 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 row .. (lambda
13d50 20 28 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 (id test-id ste
13d60 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 pname state stat
13d70 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 6c 6f us event-time lo
13d80 67 66 69 6c 65 29 0a 09 20 20 20 20 20 28 73 65 gfile).. (se
13d90 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 t! res (cons (ve
13da0 63 74 6f 72 20 69 64 20 74 65 73 74 2d 69 64 20 ctor id test-id
13db0 73 74 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 stepname state s
13dc0 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
13dd0 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f (if (string? lo
13de0 67 66 69 6c 65 29 20 6c 6f 67 66 69 6c 65 20 22 gfile) logfile "
13df0 22 29 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 ")) res))).. t
13e00 64 62 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 db.. "SELECT i
13e10 64 2c 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 d,test_id,stepna
13e20 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c me,state,status,
13e30 65 76 65 6e 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 event_time,logfi
13e40 6c 65 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 le FROM test_ste
13e50 70 73 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 ps WHERE test_id
13e60 3d 3f 20 4f 52 44 45 52 20 42 59 20 69 64 20 41 =? ORDER BY id A
13e70 53 43 3b 22 20 3b 3b 20 65 76 65 6e 74 5f 74 69 SC;" ;; event_ti
13e80 6d 65 20 44 45 53 43 2c 69 64 20 41 53 43 3b 0a me DESC,id ASC;.
13e90 09 20 20 20 74 65 73 74 2d 69 64 29 0a 09 20 20 . test-id)..
13ea0 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
13eb0 65 21 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 e! tdb).. (reve
13ec0 72 73 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 rse res))..'()))
13ed0 29 0a 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 )..;; get a pret
13ee0 74 79 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d ty table to summ
13ef0 61 72 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 arize steps.;;.(
13f00 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 define (db:get-s
13f10 74 65 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 teps-table db te
13f20 73 74 2d 69 64 20 23 21 6b 65 79 20 28 77 6f 72 st-id #!key (wor
13f30 6b 2d 61 72 65 61 20 23 66 29 29 0a 20 20 28 6c k-area #f)). (l
13f40 65 74 20 28 28 73 74 65 70 73 20 20 20 28 64 62 et ((steps (db
13f50 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
13f60 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 20 77 est db test-id w
13f70 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 ork-area: work-a
13f80 72 65 61 29 29 29 0a 20 20 20 20 3b 3b 20 6f 72 rea))). ;; or
13f90 67 61 6e 69 73 65 20 74 68 65 20 73 74 65 70 73 ganise the steps
13fa0 20 66 6f 72 20 62 65 74 74 65 72 20 72 65 61 64 for better read
13fb0 61 62 69 6c 69 74 79 0a 20 20 20 20 28 6c 65 74 ability. (let
13fc0 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 68 61 73 ((res (make-has
13fd0 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 20 h-table))).
13fe0 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 (for-each .
13ff0 20 20 20 28 6c 61 6d 62 64 61 20 28 73 74 65 70 (lambda (step
14000 29 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ).. (debug:print
14010 20 36 20 22 73 74 65 70 3d 22 20 73 74 65 70 29 6 "step=" step)
14020 0a 09 20 28 6c 65 74 20 28 28 72 65 63 6f 72 64 .. (let ((record
14030 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
14040 2f 64 65 66 61 75 6c 74 20 0a 09 09 09 72 65 73 /default ....res
14050 20 0a 09 09 09 28 64 62 3a 73 74 65 70 2d 67 65 ....(db:step-ge
14060 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 29 t-stepname step)
14070 20 0a 09 09 09 3b 3b 20 20 20 20 20 20 20 20 73 ....;; s
14080 74 65 70 6e 61 6d 65 20 20 20 20 20 20 20 20 20 tepname
14090 20 20 20 20 20 20 20 73 74 61 72 74 20 65 6e 64 start end
140a0 20 73 74 61 74 75 73 20 44 75 72 61 74 69 6f 6e status Duration
140b0 20 20 4c 6f 67 66 69 6c 65 20 0a 09 09 09 28 76 Logfile ....(v
140c0 65 63 74 6f 72 20 28 64 62 3a 73 74 65 70 2d 67 ector (db:step-g
140d0 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 65 70 et-stepname step
140e0 29 20 22 22 20 20 20 22 22 20 22 22 20 20 20 20 ) "" "" ""
140f0 20 22 22 20 20 20 20 20 20 20 20 22 22 29 29 29 "" "")))
14100 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ).. (debug:pri
14110 6e 74 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 nt 6 "record(bef
14120 6f 72 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 ore) = " record
14130 0a 09 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 ...."\nid:
14140 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d " (db:step-get-
14150 69 64 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 id step)...."\ns
14160 74 65 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 tepname: " (db:s
14170 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
14180 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 step)...."\nsta
14190 74 65 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 te: " (db:ste
141a0 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
141b0 29 0a 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 )...."\nstatus:
141c0 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 " (db:step-get
141d0 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 -status step)...
141e0 09 22 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 ."\ntime: "
141f0 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 (db:step-get-eve
14200 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 nt_time step))..
14210 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string
14220 2d 3e 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 ->symbol (db:ste
14230 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
14240 29 29 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 )).. ((start
14250 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 )(vector-set! re
14260 63 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d cord 1 (db:step-
14270 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 get-event_time s
14280 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
14290 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
142a0 20 33 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 3 (if (equal? (
142b0 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
142c0 64 20 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 d 3) "")......(d
142d0 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 b:step-get-statu
142e0 73 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 s step)))..
142f0 20 28 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d (if (> (string-
14300 6c 65 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d length (db:step-
14310 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 get-logfile step
14320 29 29 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 ))... 0)...
14330 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
14340 63 6f 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d cord 5 (db:step-
14350 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 get-logfile step
14360 29 29 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 )))).. ((end
14370 29 20 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 ) .. (vect
14380 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 or-set! record 2
14390 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 (any->number (d
143a0 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
143b0 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 _time step)))..
143c0 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
143d0 21 20 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 ! record 3 (db:s
143e0 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
143f0 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
14400 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
14410 20 34 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 4 (let ((startt
14420 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 (any->number (v
14430 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 ector-ref record
14440 20 31 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 1)))...... (en
14450 64 74 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 dt (any->numbe
14460 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 r (vector-ref re
14470 63 6f 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 cord 2)))).....
14480 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
14490 74 20 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 t 4 "record[1]="
144a0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 (vector-ref rec
144b0 6f 72 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 ord 1) .......
144c0 20 22 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 ", startt=" sta
144d0 72 74 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e rtt ", endt=" en
144e0 64 74 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 dt....... ", g
144f0 65 74 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 et-status: " (db
14500 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
14510 20 73 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 step)).....
14520 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 (if (and (numb
14530 65 72 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 er? startt)(numb
14540 65 72 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 er? endt))......
14550 20 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d (seconds->hr-m
14560 69 6e 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 in-sec (- endt s
14570 74 61 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a tartt)) "-1"))).
14580 09 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 . (if (> (s
14590 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 tring-length (db
145a0 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c :step-get-logfil
145b0 65 20 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 e step))...
145c0 30 29 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 0)... (vector-s
145d0 65 74 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 et! record 5 (db
145e0 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c :step-get-logfil
145f0 65 20 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 e step))))..
14600 20 28 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 (else.. (v
14610 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 ector-set! recor
14620 64 20 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 d 2 (db:step-get
14630 2d 73 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 -state step))..
14640 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
14650 21 20 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 ! record 3 (db:s
14660 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
14670 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
14680 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
14690 20 34 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 4 (db:step-get-
146a0 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 event_time step)
146b0 29 29 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 ))).. (hash-ta
146c0 62 6c 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 ble-set! res (db
146d0 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 :step-get-stepna
146e0 6d 65 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 me step) record)
146f0 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
14700 74 20 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 t 6 "record(afte
14710 72 29 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a r) = " record .
14720 09 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 ..."\nid:
14730 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 " (db:step-get-i
14740 64 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 d step)...."\nst
14750 65 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 epname: " (db:st
14760 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 ep-get-stepname
14770 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 step)...."\nstat
14780 65 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 e: " (db:step
14790 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 -get-state step)
147a0 0a 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 ...."\nstatus:
147b0 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d " (db:step-get-
147c0 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 status step)....
147d0 22 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 "\ntime: " (
147e0 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
147f0 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a t_time step)))).
14800 20 20 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 ;; (else
14810 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
14820 65 63 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 ecord 1 (db:step
14830 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
14840 73 74 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 step))). (
14850 73 6f 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 sort steps (lamb
14860 64 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 da (a b)...
14870 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 28 (cond... ((
14880 3c 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 < (db:step-get
14890 2d 65 76 65 6e 74 5f 74 69 6d 65 20 61 29 28 64 -event_time a)(d
148a0 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
148b0 5f 74 69 6d 65 20 62 29 29 20 23 74 29 0a 09 09 _time b)) #t)...
148c0 20 20 20 20 20 20 28 28 65 71 3f 20 28 64 62 3a ((eq? (db:
148d0 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
148e0 69 6d 65 20 61 29 28 64 62 3a 73 74 65 70 2d 67 ime a)(db:step-g
148f0 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 et-event_time b)
14900 29 20 0a 09 09 20 20 20 20 20 20 20 28 3c 20 20 ) ... (<
14910 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
14920 20 61 29 20 20 20 20 20 20 20 20 28 64 62 3a 73 a) (db:s
14930 74 65 70 2d 67 65 74 2d 69 64 20 62 29 29 29 0a tep-get-id b))).
14940 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 .. (else #f
14950 29 29 29 29 29 0a 20 20 20 20 20 20 72 65 73 29 ))))). res)
14960 29 29 0a 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 ))..;; get a pre
14970 74 74 79 20 74 61 62 6c 65 20 74 6f 20 73 75 6d tty table to sum
14980 6d 61 72 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a marize steps.;;.
14990 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
149a0 73 74 65 70 73 2d 74 61 62 6c 65 2d 6c 69 73 74 steps-table-list
149b0 20 64 62 20 74 65 73 74 2d 69 64 20 23 21 6b 65 db test-id #!ke
149c0 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 y (work-area #f)
149d0 29 0a 20 20 28 6c 65 74 20 28 28 73 74 65 70 73 ). (let ((steps
149e0 20 20 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 (db:get-steps
149f0 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 -for-test db tes
14a00 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a 20 t-id work-area:
14a10 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 20 20 20 work-area))).
14a20 20 3b 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 ;; organise the
14a30 20 73 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 steps for bette
14a40 72 20 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 r readability.
14a50 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 (let ((res (ma
14a60 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
14a70 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 . (for-each
14a80 20 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 . (lambda
14a90 20 28 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 (step).. (debug
14aa0 3a 70 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 :print 6 "step="
14ab0 20 73 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 step).. (let ((
14ac0 72 65 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 record (hash-tab
14ad0 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a le-ref/default .
14ae0 09 09 09 72 65 73 20 0a 09 09 09 28 64 62 3a 73 ...res ....(db:s
14af0 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
14b00 20 73 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 20 step) ....;;
14b10 20 20 20 20 20 73 74 65 70 6e 61 6d 65 20 20 20 stepname
14b20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 sta
14b30 72 74 20 65 6e 64 20 73 74 61 74 75 73 20 20 20 rt end status
14b40 20 0a 09 09 09 28 76 65 63 74 6f 72 20 28 64 62 ....(vector (db
14b50 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 :step-get-stepna
14b60 6d 65 20 73 74 65 70 29 20 22 22 20 20 20 22 22 me step) "" ""
14b70 20 22 22 20 20 20 20 20 22 22 20 22 22 29 29 29 "" "" "")))
14b80 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ).. (debug:pri
14b90 6e 74 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 nt 6 "record(bef
14ba0 6f 72 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 ore) = " record
14bb0 0a 09 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 ...."\nid:
14bc0 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d " (db:step-get-
14bd0 69 64 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 id step)...."\ns
14be0 74 65 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 tepname: " (db:s
14bf0 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
14c00 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 step)...."\nsta
14c10 74 65 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 te: " (db:ste
14c20 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
14c30 29 0a 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 )...."\nstatus:
14c40 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 " (db:step-get
14c50 2d 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 -status step)...
14c60 09 22 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 ."\ntime: "
14c70 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 (db:step-get-eve
14c80 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 nt_time step))..
14c90 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string
14ca0 2d 3e 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 ->symbol (db:ste
14cb0 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
14cc0 29 29 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 )).. ((start
14cd0 29 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 )(vector-set! re
14ce0 63 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d cord 1 (db:step-
14cf0 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 get-event_time s
14d00 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
14d10 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
14d20 20 33 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 3 (if (equal? (
14d30 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
14d40 64 20 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 d 3) "")......(d
14d50 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 b:step-get-statu
14d60 73 20 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 s step)))..
14d70 20 28 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d (if (> (string-
14d80 6c 65 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d length (db:step-
14d90 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 get-logfile step
14da0 29 29 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 ))... 0)...
14db0 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
14dc0 63 6f 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d cord 5 (db:step-
14dd0 67 65 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 get-logfile step
14de0 29 29 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 )))).. ((end
14df0 29 20 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 ) .. (vect
14e00 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 or-set! record 2
14e10 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 (any->number (d
14e20 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
14e30 5f 74 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 _time step)))..
14e40 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
14e50 21 20 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 ! record 3 (db:s
14e60 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
14e70 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
14e80 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
14e90 20 34 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 4 (let ((startt
14ea0 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 (any->number (v
14eb0 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 ector-ref record
14ec0 20 31 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 1)))...... (en
14ed0 64 74 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 dt (any->numbe
14ee0 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 r (vector-ref re
14ef0 63 6f 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 cord 2)))).....
14f00 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
14f10 74 20 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 t 4 "record[1]="
14f20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 (vector-ref rec
14f30 6f 72 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 ord 1) .......
14f40 20 22 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 ", startt=" sta
14f50 72 74 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e rtt ", endt=" en
14f60 64 74 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 dt....... ", g
14f70 65 74 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 et-status: " (db
14f80 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 :step-get-status
14f90 20 73 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 step)).....
14fa0 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 (if (and (numb
14fb0 65 72 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 er? startt)(numb
14fc0 65 72 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 er? endt))......
14fd0 20 20 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d (seconds->hr-m
14fe0 69 6e 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 in-sec (- endt s
14ff0 74 61 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a tartt)) "-1"))).
15000 09 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 . (if (> (s
15010 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 tring-length (db
15020 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c :step-get-logfil
15030 65 20 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 e step))...
15040 30 29 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 0)... (vector-s
15050 65 74 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 et! record 5 (db
15060 3a 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c :step-get-logfil
15070 65 20 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 e step))))..
15080 20 28 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 (else.. (v
15090 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 ector-set! recor
150a0 64 20 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 d 2 (db:step-get
150b0 2d 73 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 -state step))..
150c0 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
150d0 21 20 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 ! record 3 (db:s
150e0 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
150f0 74 65 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 tep)).. (ve
15100 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 ctor-set! record
15110 20 34 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 4 (db:step-get-
15120 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 event_time step)
15130 29 29 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 ))).. (hash-ta
15140 62 6c 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 ble-set! res (db
15150 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 :step-get-stepna
15160 6d 65 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 me step) record)
15170 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
15180 74 20 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 t 6 "record(afte
15190 72 29 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a r) = " record .
151a0 09 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 ..."\nid:
151b0 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 " (db:step-get-i
151c0 64 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 d step)...."\nst
151d0 65 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 epname: " (db:st
151e0 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 ep-get-stepname
151f0 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 step)...."\nstat
15200 65 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 e: " (db:step
15210 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 -get-state step)
15220 0a 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 ...."\nstatus:
15230 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d " (db:step-get-
15240 73 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 status step)....
15250 22 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 "\ntime: " (
15260 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e db:step-get-even
15270 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a t_time step)))).
15280 20 20 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 ;; (else
15290 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
152a0 65 63 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 ecord 1 (db:step
152b0 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
152c0 73 74 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 step))). (
152d0 73 6f 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 sort steps (lamb
152e0 64 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 da (a b)...
152f0 28 63 6f 6e 64 0a 09 09 20 20 20 20 20 20 28 28 (cond... ((
15300 3c 20 20 20 28 64 62 3a 73 74 65 70 2d 67 65 74 < (db:step-get
15310 2d 65 76 65 6e 74 5f 74 69 6d 65 20 61 29 28 64 -event_time a)(d
15320 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
15330 5f 74 69 6d 65 20 62 29 29 20 23 74 29 0a 09 09 _time b)) #t)...
15340 20 20 20 20 20 20 28 28 65 71 3f 20 28 64 62 3a ((eq? (db:
15350 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
15360 69 6d 65 20 61 29 28 64 62 3a 73 74 65 70 2d 67 ime a)(db:step-g
15370 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 et-event_time b)
15380 29 20 0a 09 09 20 20 20 20 20 20 20 28 3c 20 20 ) ... (<
15390 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
153a0 20 61 29 20 20 20 20 20 20 20 20 28 64 62 3a 73 a) (db:s
153b0 74 65 70 2d 67 65 74 2d 69 64 20 62 29 29 29 0a tep-get-id b))).
153c0 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 .. (else #f
153d0 29 29 29 29 29 0a 20 20 20 20 20 20 72 65 73 29 ))))). res)
153e0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
153f0 67 65 74 2d 63 6f 6d 70 72 65 73 73 65 64 2d 73 get-compressed-s
15400 74 65 70 73 20 74 65 73 74 2d 69 64 20 23 21 6b teps test-id #!k
15410 65 79 20 28 77 6f 72 6b 2d 61 72 65 61 20 23 66 ey (work-area #f
15420 29 29 0a 20 20 28 69 66 20 28 6f 72 20 28 6e 6f )). (if (or (no
15430 74 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 t work-area)..
15440 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 (file-exists? (c
15450 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f onc work-area "/
15460 74 65 73 74 64 61 74 2e 64 62 22 29 29 29 0a 20 testdat.db"))).
15470 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d (let* ((com
15480 70 72 73 74 65 70 73 20 28 6f 70 65 6e 2d 72 75 prsteps (open-ru
15490 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 73 n-close db:get-s
154a0 74 65 70 73 2d 74 61 62 6c 65 20 23 66 20 74 65 teps-table #f te
154b0 73 74 2d 69 64 20 77 6f 72 6b 2d 61 72 65 61 3a st-id work-area:
154c0 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 09 28 work-area)))..(
154d0 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 0a map (lambda (x).
154e0 09 20 20 20 20 20 20 20 3b 3b 20 74 61 6b 65 20 . ;; take
154f0 61 64 76 61 6e 74 61 67 65 20 6f 66 20 74 68 65 advantage of the
15500 20 5c 6e 20 6f 6e 20 74 69 6d 65 2d 3e 73 74 72 \n on time->str
15510 69 6e 67 0a 09 20 20 20 20 20 20 20 28 76 65 63 ing.. (vec
15520 74 6f 72 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 tor...(vector-re
15530 66 20 78 20 30 29 0a 09 09 28 6c 65 74 20 28 28 f x 0)...(let ((
15540 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 s (vector-ref x
15550 31 29 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 1)))... (if (nu
15560 6d 62 65 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 mber? s)(seconds
15570 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 ->time-string s)
15580 20 73 29 29 0a 09 09 28 6c 65 74 20 28 28 73 20 s))...(let ((s
15590 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 32 29 (vector-ref x 2)
155a0 29 29 0a 09 09 20 20 28 69 66 20 28 6e 75 6d 62 ))... (if (numb
155b0 65 72 3f 20 73 29 28 73 65 63 6f 6e 64 73 2d 3e er? s)(seconds->
155c0 74 69 6d 65 2d 73 74 72 69 6e 67 20 73 29 20 73 time-string s) s
155d0 29 29 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 66 ))...(vector-ref
155e0 20 78 20 33 29 20 20 20 20 3b 3b 20 73 74 61 74 x 3) ;; stat
155f0 75 73 0a 09 09 28 76 65 63 74 6f 72 2d 72 65 66 us...(vector-ref
15600 20 78 20 34 29 0a 09 09 28 76 65 63 74 6f 72 2d x 4)...(vector-
15610 72 65 66 20 78 20 35 29 29 29 20 20 3b 3b 20 74 ref x 5))) ;; t
15620 69 6d 65 20 64 65 6c 74 61 0a 09 20 20 20 20 20 ime delta..
15630 28 73 6f 72 74 20 28 68 61 73 68 2d 74 61 62 6c (sort (hash-tabl
15640 65 2d 76 61 6c 75 65 73 20 63 6f 6d 70 72 73 74 e-values comprst
15650 65 70 73 29 0a 09 09 20 20 20 28 6c 61 6d 62 64 eps)... (lambd
15660 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 28 a (a b)... (
15670 6c 65 74 20 28 28 74 69 6d 65 2d 61 20 28 76 65 let ((time-a (ve
15680 63 74 6f 72 2d 72 65 66 20 61 20 31 29 29 0a 09 ctor-ref a 1))..
15690 09 09 20 20 20 28 74 69 6d 65 2d 62 20 28 76 65 .. (time-b (ve
156a0 63 74 6f 72 2d 72 65 66 20 62 20 31 29 29 29 0a ctor-ref b 1))).
156b0 09 09 20 20 20 20 20 20 20 28 69 66 20 28 61 6e .. (if (an
156c0 64 20 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d d (number? time-
156d0 61 29 28 6e 75 6d 62 65 72 3f 20 74 69 6d 65 2d a)(number? time-
156e0 62 29 29 0a 09 09 09 20 20 20 28 69 66 20 28 3c b)).... (if (<
156f0 20 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 0a time-a time-b).
15700 09 09 09 20 20 20 20 20 20 20 23 74 0a 09 09 09 ... #t....
15710 20 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 (if (eq?
15720 74 69 6d 65 2d 61 20 74 69 6d 65 2d 62 29 0a 09 time-a time-b)..
15730 09 09 09 20 20 20 28 73 74 72 69 6e 67 3c 3f 20 ... (string<?
15740 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 (conc (vector-re
15750 66 20 61 20 32 29 29 0a 09 09 09 09 09 20 20 20 f a 2))......
15760 20 20 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d (conc (vector-
15770 72 65 66 20 62 20 32 29 29 29 0a 09 09 09 09 20 ref b 2))).....
15780 20 20 23 66 29 29 0a 09 09 09 20 20 20 28 73 74 #f)).... (st
15790 72 69 6e 67 3c 3f 20 28 63 6f 6e 63 20 74 69 6d ring<? (conc tim
157a0 65 2d 61 29 28 63 6f 6e 63 20 74 69 6d 65 2d 62 e-a)(conc time-b
157b0 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 27 )))))))). '
157c0 28 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ()))..;;========
157d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
157e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
157f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
15810 3b 20 4d 20 49 20 53 20 43 20 20 20 4d 20 41 20 ; M I S C M A
15820 4e 20 41 20 47 20 45 20 4d 20 45 20 4e 20 54 20 N A G E M E N T
15830 20 20 49 20 54 20 45 20 4d 20 53 20 0a 3b 3b 3d I T E M S .;;=
15840 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15850 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15860 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15870 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15880 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 68 65 20 6e 65 =====..;; the ne
15890 77 20 70 72 65 72 65 71 73 20 63 61 6c 63 75 6c w prereqs calcul
158a0 61 74 69 6f 6e 2c 20 6c 6f 6f 6b 73 20 61 6c 73 ation, looks als
158b0 6f 20 61 74 20 69 74 65 6d 70 61 74 68 20 69 66 o at itempath if
158c0 20 73 70 65 63 69 66 69 65 64 0a 3b 3b 20 61 6c specified.;; al
158d0 6c 20 70 72 65 72 65 71 73 20 6d 75 73 74 20 62 l prereqs must b
158e0 65 20 6d 65 74 3a 0a 3b 3b 20 20 20 20 69 66 20 e met:.;; if
158f0 70 72 65 72 65 71 20 74 65 73 74 20 77 69 74 68 prereq test with
15900 20 69 74 65 6d 70 61 74 68 3d 27 27 20 69 73 20 itempath='' is
15910 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 41 COMPLETED and PA
15920 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c SS, WARN, CHECK,
15930 20 6f 72 20 57 41 49 56 45 44 20 74 68 65 6e 20 or WAIVED then
15940 70 72 65 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b prereq is met.;;
15950 20 20 20 20 69 66 20 70 72 65 72 65 71 20 74 65 if prereq te
15960 73 74 20 77 69 74 68 20 69 74 65 6d 70 61 74 68 st with itempath
15970 3d 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 61 =ref-item-path a
15980 6e 64 20 43 4f 4d 50 4c 45 54 45 44 20 77 69 74 nd COMPLETED wit
15990 68 20 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 h PASS, WARN, CH
159a0 45 43 4b 2c 20 6f 72 20 57 41 49 56 45 44 20 74 ECK, or WAIVED t
159b0 68 65 6e 20 70 72 65 72 65 71 20 69 73 20 6d 65 hen prereq is me
159c0 74 0a 3b 3b 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f t.;;.;; Note: mo
159d0 64 65 20 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 de 'normal means
159e0 20 74 68 61 74 20 74 65 73 74 73 20 6d 75 73 74 that tests must
159f0 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e be COMPLETED an
15a00 64 20 6f 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c d ok (i.e. PASS,
15a10 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 53 4b WARN, CHECK, SK
15a20 49 50 20 6f 72 20 57 41 49 56 45 44 29 0a 3b 3b IP or WAIVED).;;
15a30 20 20 20 20 20 20 20 6d 6f 64 65 20 27 74 6f 70 mode 'top
15a40 6c 65 76 65 6c 20 6d 65 61 6e 73 20 74 68 61 74 level means that
15a50 20 74 65 73 74 73 20 6d 75 73 74 20 62 65 20 43 tests must be C
15a60 4f 4d 50 4c 45 54 45 44 20 6f 6e 6c 79 0a 3b 3b OMPLETED only.;;
15a70 20 20 20 20 20 20 20 6d 6f 64 65 20 27 69 74 65 mode 'ite
15a80 6d 6d 61 74 63 68 20 6d 65 61 6e 73 20 74 68 61 mmatch means tha
15a90 74 20 74 65 73 74 73 20 69 74 65 6d 73 20 6d 75 t tests items mu
15aa0 73 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 20 st be COMPLETED
15ab0 61 6e 64 20 28 50 41 53 53 7c 57 41 52 4e 7c 57 and (PASS|WARN|W
15ac0 41 49 56 45 44 7c 43 48 45 43 4b 29 20 5b 5b 20 AIVED|CHECK) [[
15ad0 4e 42 2f 2f 20 4e 4f 54 20 49 4d 50 4c 45 4d 45 NB// NOT IMPLEME
15ae0 4e 54 45 44 20 59 45 54 20 5d 5d 0a 3b 3b 20 0a NTED YET ]].;; .
15af0 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
15b00 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 prereqs-not-met
15b10 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e 73 20 72 run-id waitons r
15b20 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 23 21 6b ef-item-path #!k
15b30 65 79 20 28 6d 6f 64 65 20 27 6e 6f 72 6d 61 6c ey (mode 'normal
15b40 29 29 0a 20 20 28 69 66 20 28 6f 72 20 28 6e 6f )). (if (or (no
15b50 74 20 77 61 69 74 6f 6e 73 29 0a 09 20 20 28 6e t waitons).. (n
15b60 75 6c 6c 3f 20 77 61 69 74 6f 6e 73 29 29 0a 20 ull? waitons)).
15b70 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 28 '(). (
15b80 6c 65 74 2a 20 28 28 75 6e 6d 65 74 2d 70 72 65 let* ((unmet-pre
15b90 2d 72 65 71 73 20 27 28 29 29 0a 09 20 20 20 20 -reqs '())..
15ba0 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 20 20 (result
15bb0 20 27 28 29 29 29 0a 09 28 66 6f 72 2d 65 61 63 '()))..(for-eac
15bc0 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 77 61 h .. (lambda (wa
15bd0 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 0a 09 itontest-name)..
15be0 20 20 20 3b 3b 20 62 79 20 67 65 74 74 69 6e 67 ;; by getting
15bf0 20 74 68 65 20 74 65 73 74 73 20 77 69 74 68 20 the tests with
15c00 6d 61 74 63 68 69 6e 67 20 6e 61 6d 65 20 77 65 matching name we
15c10 20 61 72 65 20 6c 6f 6f 6b 69 6e 67 20 6f 6e 6c are looking onl
15c20 79 20 61 74 20 74 68 65 20 6d 61 74 63 68 69 6e y at the matchin
15c30 67 20 74 65 73 74 20 0a 09 20 20 20 3b 3b 20 61 g test .. ;; a
15c40 6e 64 20 72 65 6c 61 74 65 64 20 73 75 62 20 69 nd related sub i
15c50 74 65 6d 73 0a 09 20 20 20 28 6c 65 74 20 28 28 tems.. (let ((
15c60 74 65 73 74 73 20 20 20 20 20 20 20 20 20 20 20 tests
15c70 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 (cdb:remote-ru
15c80 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 n db:get-tests-f
15c90 6f 72 2d 72 75 6e 20 23 66 20 72 75 6e 2d 69 64 or-run #f run-id
15ca0 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 waitontest-name
15cb0 20 27 28 29 20 27 28 29 29 29 0a 09 09 20 28 65 '() '()))... (e
15cc0 76 65 72 2d 73 65 65 6e 20 20 20 20 20 20 20 20 ver-seen
15cd0 20 23 66 29 0a 09 09 20 28 70 61 72 65 6e 74 2d #f)... (parent-
15ce0 77 61 69 74 6f 6e 2d 6d 65 74 20 23 66 29 0a 09 waiton-met #f)..
15cf0 09 20 28 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d . (item-waiton-m
15d00 65 74 20 20 20 23 66 29 29 0a 09 20 20 20 20 20 et #f))..
15d10 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 20 (for-each ..
15d20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 (lambda (test)
15d30 0a 09 09 3b 3b 20 28 69 66 20 28 65 71 75 61 6c ...;; (if (equal
15d40 3f 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d ? waitontest-nam
15d50 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 e (db:test-get-t
15d60 65 73 74 6e 61 6d 65 20 74 65 73 74 29 29 20 3b estname test)) ;
15d70 3b 20 62 79 20 64 65 66 69 6e 74 69 6f 6e 20 74 ; by defintion t
15d80 68 69 73 20 68 61 64 20 62 65 74 74 65 72 20 62 his had better b
15d90 65 20 74 72 75 65 20 2e 2e 2e 0a 09 09 28 6c 65 e true ......(le
15da0 74 2a 20 28 28 73 74 61 74 65 20 20 20 20 20 20 t* ((state
15db0 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d (db:test-
15dc0 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 29 29 get-state test))
15dd0 0a 09 09 20 20 20 20 20 20 20 28 73 74 61 74 75 ... (statu
15de0 73 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 s (db
15df0 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
15e00 20 74 65 73 74 29 29 0a 09 09 20 20 20 20 20 20 test))...
15e10 20 28 69 74 65 6d 2d 70 61 74 68 20 20 20 20 20 (item-path
15e20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (db:test-get
15e30 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 29 -item-path test)
15e40 29 0a 09 09 20 20 20 20 20 20 20 28 69 73 2d 63 )... (is-c
15e50 6f 6d 70 6c 65 74 65 64 20 20 20 20 20 20 28 65 ompleted (e
15e60 71 75 61 6c 3f 20 73 74 61 74 65 20 22 43 4f 4d qual? state "COM
15e70 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 20 20 PLETED"))...
15e80 20 20 20 28 69 73 2d 6f 6b 20 20 20 20 20 20 20 (is-ok
15e90 20 20 20 20 20 20 28 6d 65 6d 62 65 72 20 73 74 (member st
15ea0 61 74 75 73 20 27 28 22 50 41 53 53 22 20 22 57 atus '("PASS" "W
15eb0 41 52 4e 22 20 22 43 48 45 43 4b 22 20 22 57 41 ARN" "CHECK" "WA
15ec0 49 56 45 44 22 20 22 53 4b 49 50 22 29 29 29 0a IVED" "SKIP"))).
15ed0 09 09 20 20 20 20 20 20 20 28 73 61 6d 65 2d 69 .. (same-i
15ee0 74 65 6d 70 61 74 68 20 20 20 20 20 28 65 71 75 tempath (equ
15ef0 61 6c 3f 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 al? ref-item-pat
15f00 68 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 h item-path)))..
15f10 09 20 20 28 73 65 74 21 20 65 76 65 72 2d 73 65 . (set! ever-se
15f20 65 6e 20 23 74 29 0a 09 09 20 20 28 63 6f 6e 64 en #t)... (cond
15f30 0a 09 09 20 20 20 3b 3b 20 63 61 73 65 20 31 2c ... ;; case 1,
15f40 20 6e 6f 6e 2d 69 74 65 6d 20 28 70 61 72 65 6e non-item (paren
15f50 74 20 74 65 73 74 29 20 69 73 20 0a 09 09 20 20 t test) is ...
15f60 20 28 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 69 ((and (equal? i
15f70 74 65 6d 2d 70 61 74 68 20 22 22 29 20 3b 3b 20 tem-path "") ;;
15f80 74 68 69 73 20 69 73 20 74 68 65 20 70 61 72 65 this is the pare
15f90 6e 74 20 74 65 73 74 0a 09 09 09 20 69 73 2d 63 nt test.... is-c
15fa0 6f 6d 70 6c 65 74 65 64 0a 09 09 09 20 28 6f 72 ompleted.... (or
15fb0 20 69 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 is-ok (eq? mode
15fc0 20 27 74 6f 70 6c 65 76 65 6c 29 29 29 0a 09 09 'toplevel)))...
15fd0 20 20 20 20 28 73 65 74 21 20 70 61 72 65 6e 74 (set! parent
15fe0 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 -waiton-met #t))
15ff0 0a 09 09 20 20 20 28 28 61 6e 64 20 73 61 6d 65 ... ((and same
16000 2d 69 74 65 6d 70 61 74 68 0a 09 09 09 20 69 73 -itempath.... is
16010 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 09 09 20 28 -completed.... (
16020 6f 72 20 69 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f or is-ok (eq? mo
16030 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 29 29 0a de 'toplevel))).
16040 09 09 20 20 20 20 28 73 65 74 21 20 69 74 65 6d .. (set! item
16050 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 -waiton-met #t))
16060 29 29 29 0a 09 20 20 20 20 20 20 74 65 73 74 73 ))).. tests
16070 29 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ).. (if (not
16080 20 28 6f 72 20 70 61 72 65 6e 74 2d 77 61 69 74 (or parent-wait
16090 6f 6e 2d 6d 65 74 20 69 74 65 6d 2d 77 61 69 74 on-met item-wait
160a0 6f 6e 2d 6d 65 74 29 29 0a 09 09 20 28 73 65 74 on-met))... (set
160b0 21 20 72 65 73 75 6c 74 20 28 61 70 70 65 6e 64 ! result (append
160c0 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 (if (null? test
160d0 73 29 20 28 6c 69 73 74 20 77 61 69 74 6f 6e 74 s) (list waitont
160e0 65 73 74 2d 6e 61 6d 65 29 20 74 65 73 74 73 29 est-name) tests)
160f0 20 72 65 73 75 6c 74 29 29 29 0a 09 20 20 20 20 result)))..
16100 20 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 ;; if the test
16110 69 73 20 6e 6f 74 20 66 6f 75 6e 64 20 74 68 65 is not found the
16120 6e 20 63 6c 65 61 72 6c 79 20 74 68 65 20 77 61 n clearly the wa
16130 69 74 6f 6e 20 69 73 20 6e 6f 74 20 6d 65 74 2e iton is not met.
16140 2e 2e 0a 09 20 20 20 20 20 3b 3b 20 28 69 66 20 .... ;; (if
16150 28 6e 6f 74 20 65 76 65 72 2d 73 65 65 6e 29 28 (not ever-seen)(
16160 73 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e set! result (con
16170 73 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d s waitontest-nam
16180 65 20 72 65 73 75 6c 74 29 29 29 29 29 0a 09 20 e result)))))..
16190 20 20 20 20 28 69 66 20 28 6e 6f 74 20 65 76 65 (if (not eve
161a0 72 2d 73 65 65 6e 29 0a 09 09 20 28 73 65 74 21 r-seen)... (set!
161b0 20 72 65 73 75 6c 74 20 28 61 70 70 65 6e 64 20 result (append
161c0 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 (if (null? tests
161d0 29 28 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 73 )(list waitontes
161e0 74 2d 6e 61 6d 65 29 20 74 65 73 74 73 29 20 72 t-name) tests) r
161f0 65 73 75 6c 74 29 29 29 29 29 0a 09 20 77 61 69 esult))))).. wai
16200 74 6f 6e 73 29 0a 09 28 64 65 6c 65 74 65 2d 64 tons)..(delete-d
16210 75 70 6c 69 63 61 74 65 73 20 72 65 73 75 6c 74 uplicates result
16220 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ))))..(define (d
16230 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 b:teststep-set-s
16240 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 tatus! db test-i
16250 64 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 d teststep-name
16260 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d state-in status-
16270 69 6e 20 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 in comment logfi
16280 6c 65 20 23 21 6b 65 79 20 28 77 6f 72 6b 2d 61 le #!key (work-a
16290 72 65 61 20 23 66 29 29 0a 20 20 28 64 65 62 75 rea #f)). (debu
162a0 67 3a 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d g:print 4 "test-
162b0 69 64 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 id: " test-id "
162c0 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 3a 20 22 teststep-name: "
162d0 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 29 0a teststep-name).
162e0 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ;;
162f0 20 20 20 20 20 64 62 3a 6f 70 65 6e 2d 74 65 73 db:open-tes
16300 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
16310 64 6f 65 73 20 63 64 62 3a 72 65 6d 6f 74 65 2d does cdb:remote-
16320 72 75 6e 0a 20 20 28 6c 65 74 2a 20 28 28 74 64 run. (let* ((td
16330 62 20 20 20 20 20 20 20 28 64 62 3a 6f 70 65 6e b (db:open
16340 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 -test-db-by-test
16350 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 20 77 -id db test-id w
16360 6f 72 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 ork-area: work-a
16370 72 65 61 29 29 0a 09 20 28 73 74 61 74 65 20 20 rea)).. (state
16380 20 20 20 28 69 74 65 6d 73 3a 63 68 65 63 6b 2d (items:check-
16390 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 61 valid-items "sta
163a0 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a 09 te" state-in))..
163b0 20 28 73 74 61 74 75 73 20 20 20 20 28 69 74 65 (status (ite
163c0 6d 73 3a 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 ms:check-valid-i
163d0 74 65 6d 73 20 22 73 74 61 74 75 73 22 20 73 74 tems "status" st
163e0 61 74 75 73 2d 69 6e 29 29 29 0a 20 20 20 20 28 atus-in))). (
163f0 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 74 if (or (not stat
16400 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 29 0a e)(not status)).
16410 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 .(debug:print 3
16420 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 61 6c 69 "WARNING: Invali
16430 64 20 22 20 28 69 66 20 73 74 61 74 75 73 20 22 d " (if status "
16440 73 74 61 74 75 73 22 20 22 73 74 61 74 65 22 29 status" "state")
16450 0a 09 09 20 20 20 20 20 22 20 76 61 6c 75 65 20 ... " value
16460 5c 22 22 20 28 69 66 20 73 74 61 74 75 73 20 73 \"" (if status s
16470 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 tate-in status-i
16480 6e 29 20 22 5c 22 2c 20 75 70 64 61 74 65 20 79 n) "\", update y
16490 6f 75 72 20 76 61 6c 69 64 76 61 6c 75 65 73 20 our validvalues
164a0 73 65 63 74 69 6f 6e 20 69 6e 20 6d 65 67 61 74 section in megat
164b0 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a 20 20 est.config")).
164c0 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 67 69 (if tdb..(begi
164d0 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 n.. (sqlite3:ex
164e0 65 63 75 74 65 20 0a 09 20 20 20 74 64 62 0a 09 ecute .. tdb..
164f0 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 "INSERT OR RE
16500 50 4c 41 43 45 20 69 6e 74 6f 20 74 65 73 74 5f PLACE into test_
16510 73 74 65 70 73 20 28 74 65 73 74 5f 69 64 2c 73 steps (test_id,s
16520 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 tepname,state,st
16530 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c atus,event_time,
16540 63 6f 6d 6d 65 6e 74 2c 6c 6f 67 66 69 6c 65 29 comment,logfile)
16550 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c VALUES(?,?,?,?,
16560 3f 2c 3f 2c 3f 29 3b 22 0a 09 20 20 20 74 65 73 ?,?,?);".. tes
16570 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d 6e 61 t-id teststep-na
16580 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 me state-in stat
16590 75 73 2d 69 6e 20 28 63 75 72 72 65 6e 74 2d 73 us-in (current-s
165a0 65 63 6f 6e 64 73 29 20 28 69 66 20 63 6f 6d 6d econds) (if comm
165b0 65 6e 74 20 63 6f 6d 6d 65 6e 74 20 22 22 29 20 ent comment "")
165c0 28 69 66 20 6c 6f 67 66 69 6c 65 20 6c 6f 67 66 (if logfile logf
165d0 69 6c 65 20 22 22 29 29 0a 09 20 20 28 73 71 6c ile "")).. (sql
165e0 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
165f0 64 62 29 0a 09 20 20 23 74 29 0a 09 23 66 29 29 db).. #t)..#f))
16600 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
16610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 ===========.;; E
16650 78 74 72 61 63 74 20 6f 64 73 20 66 69 6c 65 20 xtract ods file
16660 66 72 6f 6d 20 74 68 65 20 64 62 0a 3b 3b 3d 3d from the db.;;==
16670 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16680 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16690 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
166a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
166b0 3d 3d 3d 3d 0a 0a 3b 3b 20 72 75 6e 73 70 61 74 ====..;; runspat
166c0 74 20 69 73 20 61 20 63 6f 6d 6d 61 20 64 65 6c t is a comma del
166d0 69 6d 69 74 65 64 20 6c 69 73 74 20 6f 66 20 72 imited list of r
166e0 75 6e 20 70 61 74 74 65 72 6e 73 0a 3b 3b 20 6b un patterns.;; k
166f0 65 79 70 61 74 74 2d 61 6c 69 73 74 20 6d 75 73 eypatt-alist mus
16700 74 20 63 6f 6e 74 61 69 6e 20 2a 61 6c 6c 2a 20 t contain *all*
16710 6b 65 79 73 20 77 69 74 68 20 61 6e 20 61 73 73 keys with an ass
16720 6f 63 69 61 74 65 64 20 70 61 74 74 65 72 6e 3a ociated pattern:
16730 20 27 28 20 28 22 4b 45 59 31 22 20 22 25 22 29 '( ("KEY1" "%")
16740 20 2e 2e 20 29 0a 28 64 65 66 69 6e 65 20 28 64 .. ).(define (d
16750 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 b:extract-ods-fi
16760 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 6c 65 le db outputfile
16770 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 20 72 keypatt-alist r
16780 75 6e 73 70 61 74 74 20 70 61 74 68 6d 6f 64 29 unspatt pathmod)
16790 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 73 . (let* ((keyss
167a0 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 tr (string-inte
167b0 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 72 rsperse (map car
167c0 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20 keypatt-alist)
167d0 22 2c 22 29 29 0a 09 20 28 6b 65 79 71 72 79 20 ",")).. (keyqry
167e0 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
167f0 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
16800 64 61 20 28 70 29 28 63 6f 6e 63 20 28 63 61 72 da (p)(conc (car
16810 20 70 29 20 22 20 4c 49 4b 45 20 3f 20 22 29 29 p) " LIKE ? "))
16820 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 20 keypatt-alist)
16830 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6e 75 6d " AND ")).. (num
16840 6b 65 79 73 20 20 28 6c 65 6e 67 74 68 20 6b 65 keys (length ke
16850 79 70 61 74 74 2d 61 6c 69 73 74 29 29 0a 09 20 ypatt-alist))..
16860 28 74 65 73 74 2d 69 64 73 20 27 28 29 29 0a 09 (test-ids '())..
16870 20 28 77 69 6e 64 6f 77 73 20 20 28 61 6e 64 20 (windows (and
16880 70 61 74 68 6d 6f 64 20 28 73 75 62 73 74 72 69 pathmod (substri
16890 6e 67 2d 69 6e 64 65 78 20 22 5c 5c 22 20 70 61 ng-index "\\" pa
168a0 74 68 6d 6f 64 29 29 29 0a 09 20 28 74 65 6d 70 thmod))).. (temp
168b0 64 69 72 20 20 28 63 6f 6e 63 20 22 2f 74 6d 70 dir (conc "/tmp
168c0 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 73 65 72 /" (current-user
168d0 2d 6e 61 6d 65 29 20 22 2f 22 20 72 75 6e 73 70 -name) "/" runsp
168e0 61 74 74 20 22 5f 22 20 28 72 61 6e 64 6f 6d 20 att "_" (random
168f0 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 72 72 10000) "_" (curr
16900 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 ent-process-id))
16910 29 0a 09 20 28 72 75 6e 73 68 65 61 64 65 72 20 ).. (runsheader
16920 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 22 52 (append (list "R
16930 75 6e 20 49 64 22 20 22 52 75 6e 6e 61 6d 65 22 un Id" "Runname"
16940 29 20 3b 20 30 20 31 0a 09 09 09 20 20 20 20 20 ) ; 0 1....
16950 28 6d 61 70 20 63 61 72 20 6b 65 79 70 61 74 74 (map car keypatt
16960 2d 61 6c 69 73 74 29 20 20 20 3b 20 2b 20 4e 20 -alist) ; + N
16970 3d 20 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 = length keypatt
16980 2d 61 6c 69 73 74 0a 09 09 09 20 20 20 20 20 28 -alist.... (
16990 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 22 20 list "Testname"
169a0 20 20 20 20 20 20 20 20 20 3b 20 32 0a 09 09 09 ; 2....
169b0 09 20 20 20 22 49 74 65 6d 20 50 61 74 68 22 20 . "Item Path"
169c0 20 20 20 20 20 20 20 20 3b 20 33 20 0a 09 09 09 ; 3 ....
169d0 09 20 20 20 22 44 65 73 63 72 69 70 74 69 6f 6e . "Description
169e0 22 20 20 20 20 20 20 20 3b 20 34 20 0a 09 09 09 " ; 4 ....
169f0 09 20 20 20 22 53 74 61 74 65 22 20 20 20 20 20 . "State"
16a00 20 20 20 20 20 20 20 20 3b 20 35 20 0a 09 09 09 ; 5 ....
16a10 09 20 20 20 22 53 74 61 74 75 73 22 20 20 20 20 . "Status"
16a20 20 20 20 20 20 20 20 20 3b 20 36 20 20 0a 09 09 ; 6 ...
16a30 09 09 20 20 20 22 46 69 6e 61 6c 20 4c 6f 67 22 .. "Final Log"
16a40 20 20 20 20 20 20 20 20 20 3b 20 37 20 0a 09 09 ; 7 ...
16a50 09 09 20 20 20 22 52 75 6e 20 44 75 72 61 74 69 .. "Run Durati
16a60 6f 6e 22 20 20 20 20 20 20 3b 20 38 20 0a 09 09 on" ; 8 ...
16a70 09 09 20 20 20 22 57 68 65 6e 20 52 75 6e 22 20 .. "When Run"
16a80 20 20 20 20 20 20 20 20 20 3b 20 39 20 0a 09 09 ; 9 ...
16a90 09 09 20 20 20 22 54 61 67 73 22 20 20 20 20 20 .. "Tags"
16aa0 20 20 20 20 20 20 20 20 20 3b 20 31 30 0a 09 09 ; 10...
16ab0 09 09 20 20 20 22 52 75 6e 20 4f 77 6e 65 72 22 .. "Run Owner"
16ac0 20 20 20 20 20 20 20 20 20 3b 20 31 31 0a 09 09 ; 11...
16ad0 09 09 20 20 20 22 43 6f 6d 6d 65 6e 74 22 20 20 .. "Comment"
16ae0 20 20 20 20 20 20 20 20 20 3b 20 31 32 0a 09 09 ; 12...
16af0 09 09 20 20 20 22 41 75 74 68 6f 72 22 20 20 20 .. "Author"
16b00 20 20 20 20 20 20 20 20 20 3b 20 31 33 0a 09 09 ; 13...
16b10 09 09 20 20 20 22 54 65 73 74 20 4f 77 6e 65 72 .. "Test Owner
16b20 22 20 20 20 20 20 20 20 20 3b 20 31 34 0a 09 09 " ; 14...
16b30 09 09 20 20 20 22 52 65 76 69 65 77 65 64 22 20 .. "Reviewed"
16b40 20 20 20 20 20 20 20 20 20 3b 20 31 35 0a 09 09 ; 15...
16b50 09 09 20 20 20 22 44 69 73 6b 66 72 65 65 22 20 .. "Diskfree"
16b60 20 20 20 20 20 20 20 20 20 3b 20 31 36 0a 09 09 ; 16...
16b70 09 09 20 20 20 22 55 6e 61 6d 65 22 20 20 20 20 .. "Uname"
16b80 20 20 20 20 20 20 20 20 20 3b 20 31 37 0a 09 09 ; 17...
16b90 09 09 20 20 20 22 52 75 6e 64 69 72 22 20 20 20 .. "Rundir"
16ba0 20 20 20 20 20 20 20 20 20 3b 20 31 38 0a 09 09 ; 18...
16bb0 09 09 20 20 20 22 48 6f 73 74 22 20 20 20 20 20 .. "Host"
16bc0 20 20 20 20 20 20 20 20 20 3b 20 31 39 0a 09 09 ; 19...
16bd0 09 09 20 20 20 22 43 70 75 20 4c 6f 61 64 22 20 .. "Cpu Load"
16be0 20 20 20 20 20 20 20 20 20 3b 20 32 30 0a 09 09 ; 20...
16bf0 09 09 20 20 20 29 29 29 0a 09 20 28 72 65 73 75 .. ))).. (resu
16c00 6c 74 73 20 28 6c 69 73 74 20 72 75 6e 73 68 65 lts (list runshe
16c10 61 64 65 72 29 29 09 09 09 20 0a 09 20 28 74 65 ader))... .. (te
16c20 73 74 64 61 74 61 2d 68 65 61 64 65 72 20 28 6c stdata-header (l
16c30 69 73 74 20 22 52 75 6e 20 49 64 22 20 22 54 65 ist "Run Id" "Te
16c40 73 74 6e 61 6d 65 22 20 22 49 74 65 6d 20 50 61 stname" "Item Pa
16c50 74 68 22 20 22 43 61 74 65 67 6f 72 79 22 20 22 th" "Category" "
16c60 56 61 72 69 61 62 6c 65 22 20 22 56 61 6c 75 65 Variable" "Value
16c70 22 20 22 45 78 70 65 63 74 65 64 22 20 22 54 6f " "Expected" "To
16c80 6c 22 20 22 55 6e 69 74 73 22 20 22 53 74 61 74 l" "Units" "Stat
16c90 75 73 22 20 22 43 6f 6d 6d 65 6e 74 22 29 29 0a us" "Comment")).
16ca0 09 20 28 6d 61 69 6e 71 72 79 20 28 63 6f 6e 63 . (mainqry (conc
16cb0 20 22 53 45 4c 45 43 54 0a 20 20 20 20 20 20 20 "SELECT.
16cc0 20 20 20 20 20 20 20 74 2e 74 65 73 74 6e 61 6d t.testnam
16cd0 65 2c 72 2e 69 64 2c 72 75 6e 6e 61 6d 65 2c 22 e,r.id,runname,"
16ce0 20 6b 65 79 73 73 74 72 20 22 2c 74 2e 74 65 73 keysstr ",t.tes
16cf0 74 6e 61 6d 65 2c 0a 20 20 20 20 20 20 20 20 20 tname,.
16d00 20 20 20 20 20 74 2e 69 74 65 6d 5f 70 61 74 68 t.item_path
16d10 2c 74 6d 2e 64 65 73 63 72 69 70 74 69 6f 6e 2c ,tm.description,
16d20 74 2e 73 74 61 74 65 2c 74 2e 73 74 61 74 75 73 t.state,t.status
16d30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
16d40 66 69 6e 61 6c 5f 6c 6f 67 66 2c 72 75 6e 5f 64 final_logf,run_d
16d50 75 72 61 74 69 6f 6e 2c 20 0a 20 20 20 20 20 20 uration, .
16d60 20 20 20 20 20 20 20 20 73 74 72 66 74 69 6d 65 strftime
16d70 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a 25 4d ('%m/%d/%Y %H:%M
16d80 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 28 74 2e :%S',datetime(t.
16d90 65 76 65 6e 74 5f 74 69 6d 65 2c 27 75 6e 69 78 event_time,'unix
16da0 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c 74 69 epoch'),'localti
16db0 6d 65 27 29 2c 0a 20 20 20 20 20 20 20 20 20 20 me'),.
16dc0 20 20 20 20 74 6d 2e 74 61 67 73 2c 72 2e 6f 77 tm.tags,r.ow
16dd0 6e 65 72 2c 74 2e 63 6f 6d 6d 65 6e 74 2c 0a 20 ner,t.comment,.
16de0 20 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 aut
16df0 68 6f 72 2c 0a 20 20 20 20 20 20 20 20 20 20 20 hor,.
16e00 20 20 20 74 6d 2e 6f 77 6e 65 72 2c 72 65 76 69 tm.owner,revi
16e10 65 77 65 64 2c 0a 20 20 20 20 20 20 20 20 20 20 ewed,.
16e20 20 20 20 20 64 69 73 6b 66 72 65 65 2c 75 6e 61 diskfree,una
16e30 6d 65 2c 72 75 6e 64 69 72 2c 0a 20 20 20 20 20 me,rundir,.
16e40 20 20 20 20 20 20 20 20 20 68 6f 73 74 2c 63 70 host,cp
16e50 75 6c 6f 61 64 0a 20 20 20 20 20 20 20 20 20 20 uload.
16e60 20 20 46 52 4f 4d 20 74 65 73 74 73 20 41 53 20 FROM tests AS
16e70 74 20 4a 4f 49 4e 20 72 75 6e 73 20 41 53 20 72 t JOIN runs AS r
16e80 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 2e 69 ON t.run_id=r.i
16e90 64 20 4a 4f 49 4e 20 74 65 73 74 5f 6d 65 74 61 d JOIN test_meta
16ea0 20 41 53 20 74 6d 20 4f 4e 20 74 6d 2e 74 65 73 AS tm ON tm.tes
16eb0 74 6e 61 6d 65 3d 74 2e 74 65 73 74 6e 61 6d 65 tname=t.testname
16ec0 0a 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 . WHE
16ed0 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 RE runname LIKE
16ee0 3f 20 41 4e 44 20 22 20 6b 65 79 71 72 79 20 22 ? AND " keyqry "
16ef0 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 ;"))). (debug
16f00 3a 70 72 69 6e 74 20 32 20 22 55 73 69 6e 67 20 :print 2 "Using
16f10 22 20 74 65 6d 70 64 69 72 20 22 20 66 6f 72 20 " tempdir " for
16f20 63 6f 6e 73 74 72 75 63 74 69 6e 67 20 74 68 65 constructing the
16f30 20 6f 64 73 20 66 69 6c 65 2e 20 6b 65 79 71 72 ods file. keyqr
16f40 79 3a 20 22 20 6b 65 79 71 72 79 20 22 20 6b 65 y: " keyqry " ke
16f50 79 73 74 72 3a 20 22 20 6b 65 79 73 73 74 72 20 ystr: " keysstr
16f60 22 20 77 69 74 68 20 6b 65 79 73 3a 20 22 20 28 " with keys: " (
16f70 6d 61 70 20 63 61 64 72 20 6b 65 79 70 61 74 74 map cadr keypatt
16f80 2d 61 6c 69 73 74 29 0a 09 09 20 22 5c 6e 20 20 -alist)... "\n
16f90 20 20 20 20 6d 61 69 6e 71 72 79 3a 20 22 20 6d mainqry: " m
16fa0 61 69 6e 71 72 79 29 0a 20 20 20 20 3b 3b 20 22 ainqry). ;; "
16fb0 45 78 70 65 63 74 65 64 20 56 61 6c 75 65 22 0a Expected Value".
16fc0 20 20 20 20 3b 3b 20 22 56 61 6c 75 65 20 46 6f ;; "Value Fo
16fd0 75 6e 64 22 0a 20 20 20 20 3b 3b 20 22 54 6f 6c und". ;; "Tol
16fe0 65 72 61 6e 63 65 22 0a 20 20 20 20 28 61 70 70 erance". (app
16ff0 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 ly sqlite3:for-e
17000 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d ach-row.. (lam
17010 62 64 61 20 28 74 65 73 74 2d 69 64 20 2e 20 62 bda (test-id . b
17020 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 74 65 ).. (set! te
17030 73 74 2d 69 64 73 20 28 63 6f 6e 73 20 74 65 73 st-ids (cons tes
17040 74 2d 69 64 20 74 65 73 74 2d 69 64 73 29 29 20 t-id test-ids))
17050 20 20 3b 3b 20 74 65 73 74 2d 69 64 20 69 73 20 ;; test-id is
17060 6e 6f 77 20 74 65 73 74 6e 61 6d 65 0a 09 20 20 now testname..
17070 20 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 73 (set! results
17080 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 73 (append results
17090 20 3b 3b 20 6e 6f 74 65 2c 20 64 72 6f 70 20 74 ;; note, drop t
170a0 68 65 20 74 65 73 74 2d 69 64 0a 09 09 09 09 20 he test-id.....
170b0 20 20 28 6c 69 73 74 0a 09 09 09 09 20 20 20 20 (list.....
170c0 28 69 66 20 70 61 74 68 6d 6f 64 0a 09 09 09 09 (if pathmod.....
170d0 09 28 6c 65 74 2a 20 28 28 76 62 20 20 20 20 20 .(let* ((vb
170e0 20 20 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 (apply vector
170f0 20 62 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 b))......
17100 20 28 6b 65 79 76 61 6c 73 20 20 20 28 6c 65 74 (keyvals (let
17110 20 6c 6f 6f 70 20 28 28 69 20 20 20 20 30 29 0a loop ((i 0).
17120 09 09 09 09 09 09 09 09 20 20 20 20 20 28 72 65 ........ (re
17130 73 20 27 28 29 29 29 0a 09 09 09 09 09 09 09 20 s '()))........
17140 20 20 20 28 69 66 20 28 3e 3d 20 69 20 6e 75 6d (if (>= i num
17150 6b 65 79 73 29 0a 09 09 09 09 09 09 09 09 72 65 keys).........re
17160 73 0a 09 09 09 09 09 09 09 09 28 6c 6f 6f 70 20 s.........(loop
17170 28 2b 20 69 20 31 29 0a 09 09 09 09 09 09 09 09 (+ i 1).........
17180 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 (append re
17190 73 20 28 6c 69 73 74 20 28 76 65 63 74 6f 72 2d s (list (vector-
171a0 72 65 66 20 76 62 20 28 2b 20 69 20 32 29 29 29 ref vb (+ i 2)))
171b0 29 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 )))))......
171c0 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 76 65 (runname (ve
171d0 63 74 6f 72 2d 72 65 66 20 76 62 20 31 29 29 0a ctor-ref vb 1)).
171e0 09 09 09 09 09 20 20 20 20 20 20 20 28 74 65 73 ..... (tes
171f0 74 6e 61 6d 65 20 20 28 76 65 63 74 6f 72 2d 72 tname (vector-r
17200 65 66 20 76 62 20 28 2b 20 20 32 20 6e 75 6d 6b ef vb (+ 2 numk
17210 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 eys)))......
17220 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 28 76 (item-path (v
17230 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 ector-ref vb (+
17240 20 33 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09 3 numkeys)))...
17250 09 09 09 20 20 20 20 20 20 20 28 66 69 6e 61 6c ... (final
17260 2d 6c 6f 67 20 28 76 65 63 74 6f 72 2d 72 65 66 -log (vector-ref
17270 20 76 62 20 28 2b 20 20 37 20 6e 75 6d 6b 65 79 vb (+ 7 numkey
17280 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 s)))......
17290 20 28 72 75 6e 2d 64 69 72 20 20 20 28 76 65 63 (run-dir (vec
172a0 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 31 38 tor-ref vb (+ 18
172b0 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 numkeys))).....
172c0 09 20 20 20 20 20 20 20 28 6c 6f 67 2d 66 70 61 . (log-fpa
172d0 74 68 20 28 63 6f 6e 63 20 72 75 6e 2d 64 69 72 th (conc run-dir
172e0 20 22 2f 22 20 20 66 69 6e 61 6c 2d 6c 6f 67 29 "/" final-log)
172f0 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 69 6e )) ;; (string-in
17300 74 65 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c tersperse keyval
17310 73 20 22 2f 22 29 20 22 2f 22 20 74 65 73 74 6e s "/") "/" testn
17320 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 ame "/" item-pat
17330 68 20 22 2f 22 0a 09 09 09 09 09 20 20 28 64 65 h "/"...... (de
17340 62 75 67 3a 70 72 69 6e 74 20 34 20 22 6c 6f 67 bug:print 4 "log
17350 3a 20 22 20 6c 6f 67 2d 66 70 61 74 68 20 22 20 : " log-fpath "
17360 65 78 69 73 74 73 3a 20 22 20 28 66 69 6c 65 2d exists: " (file-
17370 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74 exists? log-fpat
17380 68 29 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 h))...... (vect
17390 6f 72 2d 73 65 74 21 20 76 62 20 28 2b 20 37 20 or-set! vb (+ 7
173a0 6e 75 6d 6b 65 79 73 29 20 28 69 66 20 28 66 69 numkeys) (if (fi
173b0 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 le-exists? log-f
173c0 70 61 74 68 29 0a 09 09 09 09 09 09 09 09 09 20 path)..........
173d0 20 20 20 28 6c 65 74 20 28 28 6e 65 77 70 61 74 (let ((newpat
173e0 68 20 28 63 6f 6e 63 20 70 61 74 68 6d 6f 64 20 h (conc pathmod
173f0 22 2f 22 0a 09 09 09 09 09 09 09 09 09 09 09 09 "/".............
17400 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
17410 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22 erse keyvals "/"
17420 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 22 )............. "
17430 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 /" runname "/" t
17440 65 73 74 6e 61 6d 65 20 22 2f 22 0a 09 09 09 09 estname "/".....
17450 09 09 09 09 09 09 09 09 20 28 69 66 20 28 73 74 ........ (if (st
17460 72 69 6e 67 3d 3f 20 69 74 65 6d 2d 70 61 74 68 ring=? item-path
17470 20 22 22 29 20 22 22 20 28 63 6f 6e 63 20 22 2f "") "" (conc "/
17480 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 09 " item-path))...
17490 09 09 09 09 09 09 09 09 09 09 20 66 69 6e 61 6c .......... final
174a0 2d 6c 6f 67 29 29 29 0a 09 09 09 09 09 09 09 09 -log))).........
174b0 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 6e 6f . ;; for no
174c0 77 20 74 68 72 6f 77 20 61 77 61 79 20 6e 65 77 w throw away new
174d0 70 61 74 68 20 61 6e 64 20 75 73 65 20 74 68 65 path and use the
174e0 20 6c 6f 67 2d 66 70 61 74 68 20 63 6f 6e 63 27 log-fpath conc'
174f0 64 20 77 69 74 68 20 70 61 74 68 6d 6f 64 0a 09 d with pathmod..
17500 09 09 09 09 09 09 09 09 20 20 20 20 20 20 28 73 ........ (s
17510 65 74 21 20 6e 65 77 70 61 74 68 20 28 63 6f 6e et! newpath (con
17520 63 20 70 61 74 68 6d 6f 64 20 6c 6f 67 2d 66 70 c pathmod log-fp
17530 61 74 68 29 29 0a 09 09 09 09 09 09 09 09 09 20 ath))..........
17540 20 20 20 20 20 28 69 66 20 77 69 6e 64 6f 77 73 (if windows
17550 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 (string-transla
17560 74 65 20 6e 65 77 70 61 74 68 20 22 2f 22 20 22 te newpath "/" "
17570 5c 5c 22 29 20 6e 65 77 70 61 74 68 29 29 0a 09 \\") newpath))..
17580 09 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 ........ (if
17590 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 (debug:debug-mod
175a0 65 20 31 29 0a 09 09 09 09 09 09 09 09 09 09 28 e 1)...........(
175b0 63 6f 6e 63 20 66 69 6e 61 6c 2d 6c 6f 67 20 22 conc final-log "
175c0 20 6e 6f 74 2d 66 6f 75 6e 64 22 29 0a 09 09 09 not-found")....
175d0 09 09 09 09 09 09 09 22 22 29 29 29 0a 09 09 09 ......."")))....
175e0 09 09 20 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 .. (vector->lis
175f0 74 20 76 62 29 29 0a 09 09 09 09 09 62 29 29 29 t vb))......b)))
17600 29 29 0a 09 20 20 20 64 62 0a 09 20 20 20 6d 61 )).. db.. ma
17610 69 6e 71 72 79 0a 09 20 20 20 72 75 6e 73 70 61 inqry.. runspa
17620 74 74 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 tt (map cadr key
17630 70 61 74 74 2d 61 6c 69 73 74 29 29 0a 20 20 20 patt-alist)).
17640 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
17650 22 46 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 "Found " (length
17660 20 74 65 73 74 2d 69 64 73 29 20 22 20 72 65 63 test-ids) " rec
17670 6f 72 64 73 22 29 0a 20 20 20 20 28 73 65 74 21 ords"). (set!
17680 20 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 results (list (
17690 63 6f 6e 73 20 22 52 75 6e 73 22 20 72 65 73 75 cons "Runs" resu
176a0 6c 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f lts))). ;; no
176b0 77 2c 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 w, for each test
176c0 2c 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 74 65 , collect the te
176d0 73 74 5f 64 61 74 61 20 69 6e 66 6f 20 61 6e 64 st_data info and
176e0 20 61 64 64 20 61 20 6e 65 77 20 73 68 65 65 74 add a new sheet
176f0 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 . (for-each.
17700 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 (lambda (tes
17710 74 2d 69 64 29 0a 20 20 20 20 20 20 20 28 6c 65 t-id). (le
17720 74 20 28 28 74 65 73 74 2d 64 61 74 61 20 28 6c t ((test-data (l
17730 69 73 74 20 74 65 73 74 64 61 74 61 2d 68 65 61 ist testdata-hea
17740 64 65 72 29 29 0a 09 20 20 20 20 20 28 63 75 72 der)).. (cur
17750 72 2d 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 r-test-name #f))
17760 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d .. (sqlite3:for-
17770 65 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d each-row.. (lam
17780 62 64 61 20 28 72 75 6e 2d 69 64 20 74 65 73 74 bda (run-id test
17790 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 63 name item-path c
177a0 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 ategory variable
177b0 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 value expected
177c0 74 6f 6c 20 75 6e 69 74 73 20 73 74 61 74 75 73 tol units status
177d0 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 20 28 comment).. (
177e0 73 65 74 21 20 63 75 72 72 2d 74 65 73 74 2d 6e set! curr-test-n
177f0 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 0a 09 20 ame testname)..
17800 20 20 20 28 73 65 74 21 20 74 65 73 74 2d 64 61 (set! test-da
17810 74 61 20 28 61 70 70 65 6e 64 20 74 65 73 74 2d ta (append test-
17820 64 61 74 61 20 28 6c 69 73 74 20 28 6c 69 73 74 data (list (list
17830 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
17840 20 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 item-path categ
17850 6f 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c ory variable val
17860 75 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 ue expected tol
17870 75 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d units status com
17880 6d 65 6e 74 29 29 29 29 29 0a 09 20 20 64 62 20 ment))))).. db
17890 0a 09 20 20 3b 3b 20 22 53 45 4c 45 43 54 20 72 .. ;; "SELECT r
178a0 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 un_id,testname,i
178b0 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 tem_path,categor
178c0 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 y,variable,td.va
178d0 6c 75 65 20 41 53 20 76 61 6c 75 65 2c 65 78 70 lue AS value,exp
178e0 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c ected,tol,units,
178f0 74 64 2e 73 74 61 74 75 73 20 41 53 20 73 74 61 td.status AS sta
17900 74 75 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 tus,td.comment A
17910 53 20 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 S comment FROM t
17920 65 73 74 5f 64 61 74 61 20 41 53 20 74 64 20 49 est_data AS td I
17930 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 NNER JOIN tests
17940 4f 4e 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 ON tests.id=td.t
17950 65 73 74 5f 69 64 20 57 48 45 52 45 20 74 65 73 est_id WHERE tes
17960 74 5f 69 64 3d 3f 3b 22 0a 09 20 20 22 53 45 4c t_id=?;".. "SEL
17970 45 43 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e ECT run_id,testn
17980 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 63 61 ame,item_path,ca
17990 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c tegory,variable,
179a0 74 64 2e 76 61 6c 75 65 20 41 53 20 76 61 6c 75 td.value AS valu
179b0 65 2c 74 64 2e 65 78 70 65 63 74 65 64 2c 74 64 e,td.expected,td
179c0 2e 74 6f 6c 2c 74 64 2e 75 6e 69 74 73 2c 74 64 .tol,td.units,td
179d0 2e 73 74 61 74 75 73 20 41 53 20 73 74 61 74 75 .status AS statu
179e0 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 s,td.comment AS
179f0 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 comment FROM tes
17a00 74 5f 64 61 74 61 20 41 53 20 74 64 20 49 4e 4e t_data AS td INN
17a10 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e ER JOIN tests ON
17a20 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 tests.id=td.tes
17a30 74 5f 69 64 20 57 48 45 52 45 20 74 65 73 74 6e t_id WHERE testn
17a40 61 6d 65 3d 3f 3b 22 0a 09 20 20 74 65 73 74 2d ame=?;".. test-
17a50 69 64 29 0a 09 20 28 69 66 20 63 75 72 72 2d 74 id).. (if curr-t
17a60 65 73 74 2d 6e 61 6d 65 0a 09 20 20 20 20 20 28 est-name.. (
17a70 73 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 set! results (ap
17a80 70 65 6e 64 20 72 65 73 75 6c 74 73 20 28 6c 69 pend results (li
17a90 73 74 20 28 63 6f 6e 73 20 63 75 72 72 2d 74 65 st (cons curr-te
17aa0 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 64 61 74 st-name test-dat
17ab0 61 29 29 29 29 29 0a 09 20 29 29 0a 20 20 20 20 a))))).. )).
17ac0 20 28 73 6f 72 74 20 28 64 65 6c 65 74 65 2d 64 (sort (delete-d
17ad0 75 70 6c 69 63 61 74 65 73 20 74 65 73 74 2d 69 uplicates test-i
17ae0 64 73 29 20 73 74 72 69 6e 67 3c 3d 29 29 0a 20 ds) string<=)).
17af0 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc
17b00 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 6d "mkdir -p " tem
17b10 70 64 69 72 29 29 0a 20 20 20 20 3b 3b 20 28 70 pdir)). ;; (p
17b20 70 20 72 65 73 75 6c 74 73 29 0a 20 20 20 20 28 p results). (
17b30 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 0a 20 ods:list->ods .
17b40 20 20 20 20 74 65 6d 70 64 69 72 0a 20 20 20 20 tempdir.
17b50 20 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 (if (string-mat
17b60 63 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e ch (regexp "^[/~
17b70 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c ]+.*") outputfil
17b80 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f e) ;; full path?
17b90 0a 09 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 20 .. outputfile..
17ba0 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 (begin.. (debu
17bb0 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
17bc0 4e 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20 NG: path given,
17bd0 22 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69 " outputfile " i
17be0 73 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66 s relative, pref
17bf0 69 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 65 ixing with curre
17c00 6e 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09 nt directory")..
17c10 20 20 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e (conc (curren
17c20 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 t-directory) "/"
17c30 20 6f 75 74 70 75 74 66 69 6c 65 29 29 29 0a 20 outputfile))).
17c40 20 20 20 20 72 65 73 75 6c 74 73 29 0a 20 20 20 results).
17c50 20 3b 3b 20 62 72 75 74 61 6c 20 63 6c 65 61 6e ;; brutal clean
17c60 20 75 70 0a 20 20 20 20 28 73 79 73 74 65 6d 20 up. (system
17c70 22 72 6d 20 2d 72 66 20 74 65 6d 70 64 69 72 22 "rm -rf tempdir"
17c80 29 29 29 0a 0a 3b 3b 20 28 64 62 3a 65 78 74 72 )))..;; (db:extr
17c90 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 act-ods-file db
17ca0 22 6f 75 74 70 75 74 66 69 6c 65 2e 6f 64 73 22 "outputfile.ods"
17cb0 20 27 28 28 22 73 79 73 6e 61 6d 65 22 20 22 25 '(("sysname" "%
17cc0 22 29 28 22 66 73 6e 61 6d 65 22 20 22 25 22 29 ")("fsname" "%")
17cd0 28 22 64 61 74 61 70 61 74 68 22 20 22 25 22 29 ("datapath" "%")
17ce0 29 20 22 25 22 29 0a ) "%").