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 29 0a 28 69 6d 70 6f 72 74 20 28 igest).(import (
0330: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0340: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 75 73 65 20 qlite3:))..(use
0350: 7a 6d 71 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 zmq)..(declare (
0360: 75 6e 69 74 20 64 62 29 29 0a 28 64 65 63 6c 61 unit db)).(decla
0370: 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 re (uses common)
0380: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0390: 20 6b 65 79 73 29 29 0a 28 64 65 63 6c 61 72 65 keys)).(declare
03a0: 20 28 75 73 65 73 20 6f 64 73 29 29 0a 0a 28 69 (uses ods))..(i
03b0: 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 nclude "common_r
03c0: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
03d0: 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 clude "db_record
03e0: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
03f0: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0400: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 m").(include "ru
0410: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm").
0420: 0a 3b 3b 20 74 69 6d 65 73 74 61 6d 70 20 74 79 .;; timestamp ty
0430: 70 65 20 28 76 61 6c 31 20 76 61 6c 32 20 2e 2e pe (val1 val2 ..
0440: 2e 29 0a 3b 3b 20 74 79 70 65 3a 20 6d 65 74 61 .).;; type: meta
0450: 2d 69 6e 66 6f 2c 20 73 74 65 70 0a 28 64 65 66 -info, step.(def
0460: 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 ine *incoming-da
0470: 74 61 2a 20 20 20 20 20 20 27 28 29 29 0a 28 64 ta* '()).(d
0480: 65 66 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d efine *incoming-
0490: 6c 61 73 74 2d 74 69 6d 65 2a 20 28 63 75 72 72 last-time* (curr
04a0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 64 ent-seconds)).(d
04b0: 65 66 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d efine *incoming-
04c0: 6d 75 74 65 78 2a 20 20 20 20 20 28 6d 61 6b 65 mutex* (make
04d0: 2d 6d 75 74 65 78 29 29 0a 28 64 65 66 69 6e 65 -mutex)).(define
04e0: 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 23 66 29 0a *cache-on* #f).
04f0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 .(define (db:set
0500: 2d 73 79 6e 63 20 64 62 29 0a 20 20 28 6c 65 74 -sync db). (let
0510: 2a 20 28 28 73 79 6e 63 76 61 6c 20 20 28 63 6f * ((syncval (co
0520: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e nfig-lookup *con
0530: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
0540: 20 20 20 20 22 73 79 6e 63 68 72 6f 6e 6f 75 73 "synchronous
0550: 22 29 29 0a 09 20 28 76 61 6c 20 20 20 20 20 20 ")).. (val
0560: 28 63 6f 6e 64 20 20 20 3b 3b 20 30 20 7c 20 4f (cond ;; 0 | O
0570: 46 46 20 7c 20 31 20 7c 20 4e 4f 52 4d 41 4c 20 FF | 1 | NORMAL
0580: 7c 20 32 20 7c 20 46 55 4c 4c 3b 0a 09 09 20 20 | 2 | FULL;...
0590: 20 20 28 28 6e 6f 74 20 73 79 6e 63 76 61 6c 29 ((not syncval)
05a0: 20 23 66 29 0a 09 09 20 20 20 20 28 28 73 74 72 #f)... ((str
05b0: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 79 6e 63 ing->number sync
05c0: 76 61 6c 29 0a 09 09 20 20 20 20 20 28 6c 65 74 val)... (let
05d0: 20 28 28 76 61 6c 20 28 73 74 72 69 6e 67 2d 3e ((val (string->
05e0: 6e 75 6d 62 65 72 20 73 79 6e 63 76 61 6c 29 29 number syncval))
05f0: 29 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 )... (if (
0600: 6d 65 6d 62 65 72 20 76 61 6c 20 27 28 30 20 31 member val '(0 1
0610: 20 32 29 29 20 76 61 6c 20 23 66 29 29 29 0a 09 2)) val #f)))..
0620: 09 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 . ((string-ma
0630: 74 63 68 20 28 72 65 67 65 78 70 20 22 79 65 73 tch (regexp "yes
0640: 22 20 23 74 29 20 73 79 6e 63 76 61 6c 29 20 31 " #t) syncval) 1
0650: 29 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e 67 )... ((string
0660: 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 -match (regexp "
0670: 6e 6f 22 20 20 23 74 29 20 73 79 6e 63 76 61 6c no" #t) syncval
0680: 29 20 30 29 0a 09 09 20 20 20 20 28 28 73 74 72 ) 0)... ((str
0690: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 ing-match (regex
06a0: 70 20 22 28 6f 66 66 7c 6e 6f 72 6d 61 6c 7c 66 p "(off|normal|f
06b0: 75 6c 6c 29 22 20 23 74 29 20 73 79 6e 63 76 61 ull)" #t) syncva
06c0: 6c 29 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 l) syncval)...
06d0: 20 20 28 65 6c 73 65 20 0a 09 09 20 20 20 20 20 (else ...
06e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
06f0: 45 52 52 4f 52 3a 20 73 79 6e 63 68 72 6f 6e 6f ERROR: synchrono
0700: 75 73 20 6d 75 73 74 20 62 65 20 30 2c 31 2c 32 us must be 0,1,2
0710: 2c 4f 46 46 2c 4e 4f 52 4d 41 4c 20 6f 72 20 46 ,OFF,NORMAL or F
0720: 55 4c 4c 2c 20 79 6f 75 20 70 72 6f 76 69 64 65 ULL, you provide
0730: 64 3a 20 22 20 73 79 6e 63 76 61 6c 29 0a 09 09 d: " syncval)...
0740: 20 20 20 20 20 23 66 29 29 29 29 0a 20 20 20 20 #f)))).
0750: 28 69 66 20 76 61 6c 0a 09 28 62 65 67 69 6e 0a (if val..(begin.
0760: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
0770: 69 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 2d info 11 "db:set-
0780: 73 79 6e 63 2c 20 73 65 74 74 69 6e 67 20 70 72 sync, setting pr
0790: 61 67 6d 61 20 73 79 6e 63 68 72 6f 6e 6f 75 73 agma synchronous
07a0: 20 74 6f 20 22 20 76 61 6c 29 0a 09 20 20 28 73 to " val).. (s
07b0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
07c0: 62 20 28 63 6f 6e 63 20 22 50 52 41 47 4d 41 20 b (conc "PRAGMA
07d0: 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 27 22 synchronous = '"
07e0: 20 76 61 6c 20 22 27 3b 22 29 29 29 29 29 29 0a val "';")))))).
07f0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 64 .(define (open-d
0800: 62 29 20 3b 3b 20 20 28 63 6f 6e 63 20 2a 74 6f b) ;; (conc *to
0810: 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 ppath* "/megates
0820: 74 2e 64 62 22 29 20 28 63 61 72 20 2a 63 6f 6e t.db") (car *con
0830: 66 69 67 69 6e 66 6f 2a 29 29 29 0a 20 20 28 69 figinfo*))). (i
0840: 66 20 28 6e 6f 74 20 2a 74 6f 70 70 61 74 68 2a f (not *toppath*
0850: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
0860: 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 (setup-for-run)
0870: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
0880: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
0890: 22 45 52 52 4f 52 3a 20 41 74 74 65 6d 70 74 65 "ERROR: Attempte
08a0: 64 20 74 6f 20 6f 70 65 6e 20 64 62 20 77 68 65 d to open db whe
08b0: 6e 20 6e 6f 74 20 69 6e 20 6d 65 67 61 74 65 73 n not in megates
08c0: 74 20 61 72 65 61 2e 20 45 78 69 74 69 6e 67 2e t area. Exiting.
08d0: 22 29 0a 09 20 20 20 20 28 65 78 69 74 29 29 29 ").. (exit)))
08e0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 70 61 ). (let* ((dbpa
08f0: 74 68 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 th (conc *top
0900: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
0910: 2e 64 62 22 29 29 20 3b 3b 20 66 6e 61 6d 65 29 .db")) ;; fname)
0920: 0a 09 20 28 64 62 65 78 69 73 74 73 20 20 28 66 .. (dbexists (f
0930: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61 ile-exists? dbpa
0940: 74 68 29 29 0a 09 20 28 64 62 20 20 20 20 20 20 th)).. (db
0950: 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d (sqlite3:open-
0960: 64 61 74 61 62 61 73 65 20 64 62 70 61 74 68 29 database dbpath)
0970: 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 ) ;; (never-give
0980: 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 -up-open-db dbpa
0990: 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 th)).. (handler
09a0: 20 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d (make-busy-tim
09b0: 65 6f 75 74 20 28 69 66 20 28 61 72 67 73 3a 67 eout (if (args:g
09c0: 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 et-arg "-overrid
09d0: 65 2d 74 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 e-timeout").....
09e0: 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d . (string->num
09f0: 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ber (args:get-ar
0a00: 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d g "-override-tim
0a10: 65 6f 75 74 22 29 29 0a 09 09 09 09 09 20 20 20 eout"))......
0a20: 31 33 36 30 30 30 29 29 29 29 20 3b 3b 20 31 33 136000)))) ;; 13
0a30: 36 30 30 30 29 29 29 20 3b 3b 20 31 33 36 30 30 6000))) ;; 13600
0a40: 30 20 3d 20 32 2e 32 20 6d 69 6e 75 74 65 73 0a 0 = 2.2 minutes.
0a50: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
0a60: 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 64 -info 11 "open-d
0a70: 62 2c 20 64 62 70 61 74 68 3d 22 20 64 62 70 61 b, dbpath=" dbpa
0a80: 74 68 20 22 20 61 72 67 76 3d 22 20 28 61 72 67 th " argv=" (arg
0a90: 76 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 v)). (sqlite3
0aa0: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 :set-busy-handle
0ab0: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 r! db handler).
0ac0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 (if (not dbex
0ad0: 69 73 74 73 29 0a 09 28 64 62 3a 69 6e 69 74 69 ists)..(db:initi
0ae0: 61 6c 69 7a 65 20 64 62 29 29 0a 20 20 20 20 28 alize db)). (
0af0: 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a db:set-sync db).
0b00: 20 20 20 20 64 62 29 29 0a 0a 3b 3b 20 6b 65 65 db))..;; kee
0b10: 70 69 6e 67 20 69 74 20 61 72 6f 75 6e 64 20 66 ping it around f
0b20: 6f 72 20 64 65 62 75 67 67 69 6e 67 20 70 75 72 or debugging pur
0b30: 70 6f 73 65 73 20 6f 6e 6c 79 0a 28 64 65 66 69 poses only.(defi
0b40: 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ne (open-run-clo
0b50: 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d se-no-exception-
0b60: 68 61 6e 64 6c 69 6e 67 20 20 70 72 6f 63 20 69 handling proc i
0b70: 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 db . params). (
0b80: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
0b90: 20 31 31 20 22 6f 70 65 6e 2d 72 75 6e 2d 63 6c 11 "open-run-cl
0ba0: 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e ose-no-exception
0bb0: 2d 68 61 6e 64 6c 69 6e 67 20 53 54 41 52 54 20 -handling START
0bc0: 67 69 76 65 6e 20 61 20 64 62 3d 22 20 28 69 66 given a db=" (if
0bd0: 20 69 64 62 20 22 79 65 73 20 22 20 22 6e 6f 20 idb "yes " "no
0be0: 22 29 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 ") ", params=" p
0bf0: 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 arams). (let* (
0c00: 28 64 62 20 20 20 28 69 66 20 69 64 62 20 0a 09 (db (if idb ..
0c10: 09 20 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 . (if (procedu
0c20: 72 65 3f 20 69 64 62 29 0a 09 09 20 20 20 20 20 re? idb)...
0c30: 20 20 28 69 64 62 29 0a 09 09 20 20 20 20 20 20 (idb)...
0c40: 20 69 64 62 29 0a 09 09 20 20 20 28 6f 70 65 6e idb)... (open
0c50: 2d 64 62 29 29 29 0a 09 20 28 72 65 73 20 23 66 -db))).. (res #f
0c60: 29 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 )). (set! res
0c70: 20 28 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 (apply proc db
0c80: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 params)). (if
0c90: 20 28 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 (not idb)(sqlit
0ca0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
0cb0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
0cc0: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e nt-info 11 "open
0cd0: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 -run-close-no-ex
0ce0: 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 ception-handling
0cf0: 20 45 4e 44 22 20 29 0a 20 20 20 20 72 65 73 29 END" ). res)
0d00: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e )..(define (open
0d10: 2d 72 75 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70 -run-close-excep
0d20: 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 tion-handling pr
0d30: 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 oc idb . params)
0d40: 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
0d50: 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 20 20 tions. exn.
0d60: 28 62 65 67 69 6e 0a 20 20 20 20 20 28 64 65 62 (begin. (deb
0d70: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 58 43 45 ug:print 0 "EXCE
0d80: 50 54 49 4f 4e 3a 20 64 61 74 61 62 61 73 65 20 PTION: database
0d90: 70 72 6f 62 61 62 6c 79 20 6f 76 65 72 6c 6f 61 probably overloa
0da0: 64 65 64 3f 22 29 0a 20 20 20 20 20 28 64 65 62 ded?"). (deb
0db0: 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20 22 20 ug:print 0 " "
0dc0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
0dd0: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
0de0: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
0df0: 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74 2d 63 )). (print-c
0e00: 61 6c 6c 2d 63 68 61 69 6e 29 0a 20 20 20 20 20 all-chain).
0e10: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 (thread-sleep! (
0e20: 72 61 6e 64 6f 6d 20 31 32 30 29 29 0a 20 20 20 random 120)).
0e30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
0e40: 6e 66 6f 20 30 20 22 74 72 79 69 6e 67 20 64 62 nfo 0 "trying db
0e50: 20 63 61 6c 6c 20 6f 6e 65 20 6d 6f 72 65 20 74 call one more t
0e60: 69 6d 65 2e 2e 2e 2e 22 29 0a 20 20 20 20 20 28 ime...."). (
0e70: 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d 63 apply open-run-c
0e80: 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f lose-no-exceptio
0e90: 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 20 n-handling proc
0ea0: 69 64 62 20 70 61 72 61 6d 73 29 29 0a 20 20 20 idb params)).
0eb0: 28 61 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d (apply open-run-
0ec0: 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 close-no-excepti
0ed0: 6f 6e 2d 68 61 6e 64 6c 69 6e 67 20 70 72 6f 63 on-handling proc
0ee0: 20 69 64 62 20 70 61 72 61 6d 73 29 29 29 0a 0a idb params)))..
0ef0: 28 64 65 66 69 6e 65 20 6f 70 65 6e 2d 72 75 6e (define open-run
0f00: 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 6e 2d -close open-run-
0f10: 63 6c 6f 73 65 2d 65 78 63 65 70 74 69 6f 6e 2d close-exception-
0f20: 68 61 6e 64 6c 69 6e 67 29 0a 0a 28 64 65 66 69 handling)..(defi
0f30: 6e 65 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 ne *global-delta
0f40: 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 2a 6c 61 * 0).(define *la
0f50: 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d st-global-delta-
0f60: 70 72 69 6e 74 65 64 2a 20 30 29 0a 0a 28 64 65 printed* 0)..(de
0f70: 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 fine (open-run-c
0f80: 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 20 70 72 lose-measure pr
0f90: 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d 73 29 oc idb . params)
0fa0: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
0fb0: 69 6e 66 6f 20 31 31 20 22 6f 70 65 6e 2d 72 75 info 11 "open-ru
0fc0: 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 n-close-measure
0fd0: 53 54 41 52 54 2c 20 69 64 62 3d 22 20 69 64 62 START, idb=" idb
0fe0: 20 22 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 ", params=" par
0ff0: 61 6d 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 ams). (let* ((s
1000: 74 61 72 74 2d 6d 73 20 28 63 75 72 72 65 6e 74 tart-ms (current
1010: 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a -milliseconds)).
1020: 09 20 28 64 62 20 20 20 20 20 20 20 28 69 66 20 . (db (if
1030: 69 64 62 20 69 64 62 20 28 6f 70 65 6e 2d 64 62 idb idb (open-db
1040: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 68 ))). (th
1050: 72 6f 74 74 6c 65 20 28 73 74 72 69 6e 67 2d 3e rottle (string->
1060: 6e 75 6d 62 65 72 20 28 63 6f 6e 66 69 67 2d 6c number (config-l
1070: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
1080: 2a 20 22 73 65 74 75 70 22 20 22 74 68 72 6f 74 * "setup" "throt
1090: 74 6c 65 22 29 29 29 29 0a 20 20 20 20 28 64 62 tle")))). (db
10a0: 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 :set-sync db).
10b0: 20 20 28 73 65 74 21 20 72 65 73 20 20 20 20 20 (set! res
10c0: 20 28 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 (apply proc db
10d0: 70 61 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 params)). (if
10e0: 20 28 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 (not idb)(sqlit
10f0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
1100: 29 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 ). ;; scale b
1110: 79 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 y 10, average wi
1120: 74 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 th current value
1130: 2e 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
1140: 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b bal-delta* (/ (+
1150: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 *global-delta*
1160: 28 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d (* (- (current-m
1170: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 illiseconds) sta
1180: 72 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 rt-ms)....... (i
1190: 66 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 f throttle throt
11a0: 74 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 tle 0.01)))....
11b0: 20 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 2)). (if (
11c0: 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d > (abs (- *last-
11d0: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 global-delta-pri
11e0: 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 nted* *global-de
11f0: 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 lta*)) 0.08) ;;
1200: 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 don't print all
1210: 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 the time, only i
1220: 66 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 f it changes a b
1230: 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 it..(begin.. (d
1240: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
1250: 31 20 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 1 "launch thrott
1260: 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f le factor=" *glo
1270: 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 bal-delta*).. (
1280: 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 set! *last-globa
1290: 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a l-delta-printed*
12a0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*)
12b0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
12c0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 int-info 11 "ope
12d0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 n-run-close-meas
12e0: 75 72 65 20 45 4e 44 22 20 29 0a 20 20 20 20 72 ure END" ). r
12f0: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 es))..(define (d
1300: 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 b:initialize db)
1310: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
1320: 69 6e 66 6f 20 31 31 20 22 64 62 3a 69 6e 69 74 info 11 "db:init
1330: 69 61 6c 69 7a 65 20 53 54 41 52 54 22 29 0a 20 ialize START").
1340: 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 64 (let* ((configd
1350: 61 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 at (car *configi
1360: 6e 66 6f 2a 29 29 20 20 3b 3b 20 74 75 74 20 74 nfo*)) ;; tut t
1370: 75 74 2c 20 67 6c 6f 62 61 6c 20 77 61 72 6e 69 ut, global warni
1380: 6e 67 2e 2e 2e 0a 09 20 28 6b 65 79 73 20 20 20 ng..... (keys
1390: 20 20 28 63 6f 6e 66 69 67 2d 67 65 74 2d 66 69 (config-get-fi
13a0: 65 6c 64 73 20 63 6f 6e 66 69 67 64 61 74 29 29 elds configdat))
13b0: 0a 09 20 28 68 61 76 65 6b 65 79 73 20 28 3e 20 .. (havekeys (>
13c0: 28 6c 65 6e 67 74 68 20 6b 65 79 73 29 20 30 29 (length keys) 0)
13d0: 29 0a 09 20 28 6b 65 79 73 74 72 20 20 20 28 6b ).. (keystr (k
13e0: 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 eys->keystr keys
13f0: 29 29 0a 09 20 28 66 69 65 6c 64 73 74 72 20 28 )).. (fieldstr (
1400: 6b 65 79 73 2d 3e 6b 65 79 2f 66 69 65 6c 64 20 keys->key/field
1410: 6b 65 79 73 29 29 29 0a 20 20 20 20 28 66 6f 72 keys))). (for
1420: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
1430: 65 79 29 0a 09 09 28 6c 65 74 20 28 28 6b 65 79 ey)...(let ((key
1440: 6e 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b 65 n (vector-ref ke
1450: 79 20 30 29 29 29 0a 09 09 20 20 28 69 66 20 28 y 0)))... (if (
1460: 6d 65 6d 62 65 72 20 28 73 74 72 69 6e 67 2d 64 member (string-d
1470: 6f 77 6e 63 61 73 65 20 6b 65 79 6e 29 0a 09 09 owncase keyn)...
1480: 09 20 20 20 20 20 20 28 6c 69 73 74 20 22 72 75 . (list "ru
1490: 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 22 nname" "state" "
14a0: 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 20 status" "owner"
14b0: 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 6f "event_time" "co
14c0: 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f 75 mment" "fail_cou
14d0: 6e 74 22 0a 09 09 09 09 20 20 20 20 22 70 61 73 nt"..... "pas
14e0: 73 5f 63 6f 75 6e 74 22 29 29 0a 09 09 20 20 20 s_count"))...
14f0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 70 72 (begin....(pr
1500: 69 6e 74 20 22 45 52 52 4f 52 3a 20 79 6f 75 72 int "ERROR: your
1510: 20 6b 65 79 20 63 61 6e 6e 6f 74 20 62 65 20 6e key cannot be n
1520: 61 6d 65 64 20 22 20 6b 65 79 6e 20 22 20 61 73 amed " keyn " as
1530: 20 74 68 69 73 20 63 6f 6e 66 6c 69 63 74 73 20 this conflicts
1540: 77 69 74 68 20 74 68 65 20 73 61 6d 65 20 6e 61 with the same na
1550: 6d 65 64 20 66 69 65 6c 64 20 69 6e 20 74 68 65 med field in the
1560: 20 72 75 6e 73 20 74 61 62 6c 65 22 29 0a 09 09 runs table")...
1570: 09 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 .(system (conc "
1580: 72 6d 20 2d 66 20 22 20 64 62 70 61 74 68 29 29 rm -f " dbpath))
1590: 0a 09 09 09 28 65 78 69 74 20 31 29 29 29 29 29 ....(exit 1)))))
15a0: 0a 09 20 20 20 20 20 20 6b 65 79 73 29 0a 20 20 .. keys).
15b0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
15c0: 74 65 20 64 62 20 22 50 52 41 47 4d 41 20 73 79 te db "PRAGMA sy
15d0: 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 4f 46 46 3b nchronous = OFF;
15e0: 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a "). (sqlite3:
15f0: 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 execute db "CREA
1600: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
1610: 45 58 49 53 54 53 20 6b 65 79 73 20 28 69 64 20 EXISTS keys (id
1620: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
1630: 4b 45 59 2c 20 66 69 65 6c 64 6e 61 6d 65 20 54 KEY, fieldname T
1640: 45 58 54 2c 20 66 69 65 6c 64 74 79 70 65 20 54 EXT, fieldtype T
1650: 45 58 54 2c 20 43 4f 4e 53 54 52 41 49 4e 54 20 EXT, CONSTRAINT
1660: 6b 65 79 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e keyconstraint UN
1670: 49 51 55 45 20 28 66 69 65 6c 64 6e 61 6d 65 29 IQUE (fieldname)
1680: 29 3b 22 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 );"). (for-ea
1690: 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 ch (lambda (key)
16a0: 0a 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ...(sqlite3:exec
16b0: 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 ute db "INSERT I
16c0: 4e 54 4f 20 6b 65 79 73 20 28 66 69 65 6c 64 6e NTO keys (fieldn
16d0: 61 6d 65 2c 66 69 65 6c 64 74 79 70 65 29 20 56 ame,fieldtype) V
16e0: 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 20 28 6b ALUES (?,?);" (k
16f0: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
1700: 20 6b 65 79 29 28 6b 65 79 3a 67 65 74 2d 66 69 key)(key:get-fi
1710: 65 6c 64 74 79 70 65 20 6b 65 79 29 29 29 0a 09 eldtype key)))..
1720: 20 20 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 keys).
1730: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1740: 20 64 62 20 28 63 6f 6e 63 20 0a 09 09 09 20 22 db (conc .... "
1750: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
1760: 4e 4f 54 20 45 58 49 53 54 53 20 72 75 6e 73 20 NOT EXISTS runs
1770: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
1780: 41 52 59 20 4b 45 59 2c 20 22 20 0a 09 09 09 20 ARY KEY, " ....
1790: 66 69 65 6c 64 73 74 72 20 28 69 66 20 68 61 76 fieldstr (if hav
17a0: 65 6b 65 79 73 20 22 2c 22 20 22 22 29 0a 09 09 ekeys "," "")...
17b0: 09 20 22 72 75 6e 6e 61 6d 65 20 54 45 58 54 2c . "runname TEXT,
17c0: 22 0a 09 09 09 20 22 73 74 61 74 65 20 54 45 58 ".... "state TEX
17d0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 T DEFAULT '',"..
17e0: 09 09 20 22 73 74 61 74 75 73 20 54 45 58 54 20 .. "status TEXT
17f0: 44 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 DEFAULT '',"....
1800: 20 22 6f 77 6e 65 72 20 54 45 58 54 20 44 45 46 "owner TEXT DEF
1810: 41 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 65 AULT '',".... "e
1820: 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 vent_time TIMEST
1830: 41 4d 50 2c 22 0a 09 09 09 20 22 63 6f 6d 6d 65 AMP,".... "comme
1840: 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 nt TEXT DEFAULT
1850: 27 27 2c 22 0a 09 09 09 20 22 66 61 69 6c 5f 63 '',".... "fail_c
1860: 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45 46 ount INTEGER DEF
1870: 41 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 70 61 AULT 0,".... "pa
1880: 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 ss_count INTEGER
1890: 20 44 45 46 41 55 4c 54 20 30 2c 22 0a 09 09 09 DEFAULT 0,"....
18a0: 20 22 43 4f 4e 53 54 52 41 49 4e 54 20 72 75 6e "CONSTRAINT run
18b0: 73 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 sconstraint UNIQ
18c0: 55 45 20 28 72 75 6e 6e 61 6d 65 22 20 28 69 66 UE (runname" (if
18d0: 20 68 61 76 65 6b 65 79 73 20 22 2c 22 20 22 22 havekeys "," ""
18e0: 29 20 6b 65 79 73 74 72 20 22 29 29 3b 22 29 29 ) keystr "));"))
18f0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
1900: 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 ecute db (conc "
1910: 43 52 45 41 54 45 20 49 4e 44 45 58 20 72 75 6e CREATE INDEX run
1920: 73 5f 69 6e 64 65 78 20 4f 4e 20 72 75 6e 73 20 s_index ON runs
1930: 28 72 75 6e 6e 61 6d 65 22 20 28 69 66 20 68 61 (runname" (if ha
1940: 76 65 6b 65 79 73 20 22 2c 22 20 22 22 29 20 6b vekeys "," "") k
1950: 65 79 73 74 72 20 22 29 3b 22 29 29 0a 20 20 20 eystr ");")).
1960: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
1970: 65 20 64 62 20 0a 09 09 20 20 20 20 20 22 43 52 e db ... "CR
1980: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
1990: 54 20 45 58 49 53 54 53 20 74 65 73 74 73 20 0a T EXISTS tests .
19a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b0: 20 20 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 (id INTEGER
19c0: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
19d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19e0: 20 20 72 75 6e 5f 69 64 20 20 20 20 20 49 4e 54 run_id INT
19f0: 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 20 20 EGER,.
1a00: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e testn
1a10: 61 6d 65 20 20 20 54 45 58 54 2c 0a 20 20 20 20 ame TEXT,.
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a30: 20 68 6f 73 74 20 20 20 20 20 20 20 54 45 58 54 host TEXT
1a40: 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a DEFAULT 'n/a',.
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a60: 20 20 20 20 20 63 70 75 6c 6f 61 64 20 20 20 20 cpuload
1a70: 52 45 41 4c 20 44 45 46 41 55 4c 54 20 2d 31 2c REAL DEFAULT -1,
1a80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a90: 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 20 20 diskfree
1aa0: 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 INTEGER DEFAULT
1ab0: 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 -1,.
1ac0: 20 20 20 20 20 20 20 20 20 20 75 6e 61 6d 65 20 uname
1ad0: 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c TEXT DEFAUL
1ae0: 54 20 27 6e 2f 61 27 2c 20 0a 20 20 20 20 20 20 T 'n/a', .
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1b00: 75 6e 64 69 72 20 20 20 20 20 54 45 58 54 20 44 undir TEXT D
1b10: 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 EFAULT 'n/a',.
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 20 73 68 6f 72 74 64 69 72 20 20 20 54 45 shortdir TE
1b40: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
1b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b60: 20 20 20 20 69 74 65 6d 5f 70 61 74 68 20 20 54 item_path T
1b70: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
1b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b90: 20 20 20 20 20 73 74 61 74 65 20 20 20 20 20 20 state
1ba0: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f TEXT DEFAULT 'NO
1bb0: 54 5f 53 54 41 52 54 45 44 27 2c 0a 20 20 20 20 T_STARTED',.
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 73 74 61 74 75 73 20 20 20 20 20 54 45 58 54 status TEXT
1be0: 20 44 45 46 41 55 4c 54 20 27 46 41 49 4c 27 2c DEFAULT 'FAIL',
1bf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c00: 20 20 20 20 20 20 61 74 74 65 6d 70 74 6e 75 6d attemptnum
1c10: 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 INTEGER DEFAULT
1c20: 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 0,.
1c30: 20 20 20 20 20 20 20 20 20 66 69 6e 61 6c 5f 6c final_l
1c40: 6f 67 66 20 54 45 58 54 20 44 45 46 41 55 4c 54 ogf TEXT DEFAULT
1c50: 20 27 6c 6f 67 73 2f 66 69 6e 61 6c 2e 6c 6f 67 'logs/final.log
1c60: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
1c70: 20 20 20 20 20 20 20 20 6c 6f 67 64 61 74 20 20 logdat
1c80: 20 20 20 42 4c 4f 42 2c 20 0a 20 20 20 20 20 20 BLOB, .
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1ca0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 49 4e 54 45 un_duration INTE
1cb0: 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 GER DEFAULT 0,.
1cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cd0: 20 20 20 20 63 6f 6d 6d 65 6e 74 20 20 20 20 54 comment T
1ce0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d00: 20 20 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 event_time
1d10: 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 TIMESTAMP,.
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d30: 66 61 69 6c 5f 63 6f 75 6e 74 20 49 4e 54 45 47 fail_count INTEG
1d40: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 ER DEFAULT 0,.
1d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d60: 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 20 49 4e pass_count IN
1d70: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 2c TEGER DEFAULT 0,
1d80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d90: 20 20 20 20 20 20 61 72 63 68 69 76 65 64 20 20 archived
1da0: 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 INTEGER DEFAULT
1db0: 20 30 2c 20 2d 2d 20 30 3d 6e 6f 2c 20 31 3d 69 0, -- 0=no, 1=i
1dc0: 6e 20 70 72 6f 67 72 65 73 73 2c 20 32 3d 79 65 n progress, 2=ye
1dd0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
1de0: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
1df0: 54 20 74 65 73 74 73 63 6f 6e 73 74 72 61 69 6e T testsconstrain
1e00: 74 20 55 4e 49 51 55 45 20 28 72 75 6e 5f 69 64 t UNIQUE (run_id
1e10: 2c 20 74 65 73 74 6e 61 6d 65 2c 20 69 74 65 6d , testname, item
1e20: 5f 70 61 74 68 29 0a 20 20 20 20 20 20 20 20 20 _path).
1e30: 20 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 );"). (sqlit
1e40: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
1e50: 52 45 41 54 45 20 49 4e 44 45 58 20 74 65 73 74 REATE INDEX test
1e60: 73 5f 69 6e 64 65 78 20 4f 4e 20 74 65 73 74 73 s_index ON tests
1e70: 20 28 72 75 6e 5f 69 64 2c 20 74 65 73 74 6e 61 (run_id, testna
1e80: 6d 65 2c 20 69 74 65 6d 5f 70 61 74 68 29 3b 22 me, item_path);"
1e90: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
1ea0: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
1eb0: 45 20 56 49 45 57 20 72 75 6e 73 5f 74 65 73 74 E VIEW runs_test
1ec0: 73 20 41 53 20 53 45 4c 45 43 54 20 2a 20 46 52 s AS SELECT * FR
1ed0: 4f 4d 20 72 75 6e 73 20 49 4e 4e 45 52 20 4a 4f OM runs INNER JO
1ee0: 49 4e 20 74 65 73 74 73 20 4f 4e 20 72 75 6e 73 IN tests ON runs
1ef0: 2e 69 64 3d 74 65 73 74 73 2e 72 75 6e 5f 69 64 .id=tests.run_id
1f00: 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ;"). (sqlite3
1f10: 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 :execute db "CRE
1f20: 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 ATE TABLE IF NOT
1f30: 20 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 65 EXISTS test_ste
1f40: 70 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ps .
1f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f60: 20 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 (id INTEGER PR
1f70: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
1f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f90: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
1fa0: 64 20 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 d INTEGER, .
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc0: 20 20 20 20 20 20 20 20 20 20 20 73 74 65 70 6e stepn
1fd0: 61 6d 65 20 54 45 58 54 2c 20 0a 20 20 20 20 20 ame TEXT, .
1fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ff0: 20 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 state
2000: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f TEXT DEFAULT 'NO
2010: 54 5f 53 54 41 52 54 45 44 27 2c 20 0a 20 20 20 T_STARTED', .
2020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2030: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 stat
2040: 75 73 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 us TEXT DEFAULT
2050: 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 'n/a',.
2060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2070: 20 20 20 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 event_time
2080: 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 TIMESTAMP,.
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 63 6f 6d 6d 65 comme
20b0: 6e 74 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 nt TEXT DEFAULT
20c0: 27 27 2c 0a 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 20 20 20
20e0: 20 20 20 6c 6f 67 66 69 6c 65 20 54 45 58 54 20 logfile TEXT
20f0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
2100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2110: 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 CONST
2120: 52 41 49 4e 54 20 74 65 73 74 5f 73 74 65 70 73 RAINT test_steps
2130: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
2140: 55 45 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 UE (test_id,step
2150: 6e 61 6d 65 2c 73 74 61 74 65 29 29 3b 22 29 0a name,state));").
2160: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
2170: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 cute db "CREATE
2180: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
2190: 53 54 53 20 65 78 74 72 61 64 61 74 20 28 69 64 STS extradat (id
21a0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
21b0: 20 4b 45 59 2c 20 72 75 6e 5f 69 64 20 49 4e 54 KEY, run_id INT
21c0: 45 47 45 52 2c 20 6b 65 79 20 54 45 58 54 2c 20 EGER, key TEXT,
21d0: 76 61 6c 20 54 45 58 54 29 3b 22 29 0a 20 20 20 val TEXT);").
21e0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
21f0: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
2200: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
2210: 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e 54 metadat (id INT
2220: 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 EGER PRIMARY KEY
2230: 2c 20 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 , var TEXT, val
2240: 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 TEXT,.
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2260: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 CONSTRAI
2270: 4e 54 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 NT metadat_const
2280: 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 raint UNIQUE (va
2290: 72 29 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 r));"). (sqli
22a0: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
22b0: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
22c0: 4e 4f 54 20 45 58 49 53 54 53 20 61 63 63 65 73 NOT EXISTS acces
22d0: 73 5f 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 s_log (id INTEGE
22e0: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 75 R PRIMARY KEY, u
22f0: 73 65 72 20 54 45 58 54 2c 20 61 63 63 65 73 73 ser TEXT, access
2300: 65 64 20 54 49 4d 45 53 54 41 4d 50 2c 20 61 72 ed TIMESTAMP, ar
2310: 67 73 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 gs TEXT);").
2320: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
2330: 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c db "CREATE TABL
2340: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
2350: 74 65 73 74 5f 6d 65 74 61 20 28 69 64 20 49 4e test_meta (id IN
2360: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
2370: 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 Y,.
2380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2390: 20 20 20 20 20 20 20 20 74 65 73 74 6e 61 6d 65 testname
23a0: 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 TEXT DEFAULT
23b0: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
23c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23d0: 20 20 20 20 20 20 20 20 20 20 61 75 74 68 6f 72 author
23e0: 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 TEXT DEFAU
23f0: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
2400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2410: 20 20 20 20 20 20 20 20 20 20 20 20 6f 77 6e 65 owne
2420: 72 20 20 20 20 20 20 20 54 45 58 54 20 44 45 46 r TEXT DEF
2430: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 65 de
2460: 73 63 72 69 70 74 69 6f 6e 20 54 45 58 54 20 44 scription TEXT D
2470: 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 EFAULT '',.
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24a0: 72 65 76 69 65 77 65 64 20 20 20 20 54 49 4d 45 reviewed TIME
24b0: 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 STAMP,.
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 69 74 65 72 iter
24e0: 61 74 65 64 20 20 20 20 54 45 58 54 20 44 45 46 ated TEXT DEF
24f0: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 76 av
2520: 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 4c 2c 0a g_runtime REAL,.
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2550: 20 20 20 20 20 61 76 67 5f 64 69 73 6b 20 20 20 avg_disk
2560: 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 REAL,.
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 20 20 20 74 61 67 73 tags
2590: 20 20 20 20 20 20 20 20 54 45 58 54 20 44 45 46 TEXT DEF
25a0: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
25b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6a 6f jo
25d0: 62 67 72 6f 75 70 20 20 20 20 54 45 58 54 20 44 bgroup TEXT D
25e0: 45 46 41 55 4c 54 20 27 64 65 66 61 75 6c 74 27 EFAULT 'default'
25f0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
2600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2610: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 CONSTRAINT tes
2620: 74 5f 6d 65 74 61 5f 63 6f 6e 73 74 72 61 69 6e t_meta_constrain
2630: 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 6e 61 t UNIQUE (testna
2640: 6d 65 29 29 3b 22 29 0a 20 20 20 20 28 73 71 6c me));"). (sql
2650: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
2660: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
2670: 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 NOT EXISTS test
2680: 5f 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 _data (id INTEGE
2690: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
26c0: 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a est_id INTEGER,.
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26f0: 63 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 category TEXT DE
2700: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 20 20 20 20 20 20 76 61 72 69 61 62 variab
2730: 6c 65 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 le TEXT,..
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 value REAL,..
2760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2770: 20 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 expected
2780: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 REAL,..
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
27a0: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27c0: 20 20 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 units T
27d0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
27e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27f0: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 comment TEX
2800: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
2830: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
2840: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
2850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2860: 20 20 20 20 20 20 20 20 20 74 79 70 65 20 54 45 type TE
2870: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
2880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
28a0: 53 54 52 41 49 4e 54 20 74 65 73 74 5f 64 61 74 STRAINT test_dat
28b0: 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 a_constraint UNI
28c0: 51 55 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 QUE (test_id,cat
28d0: 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 egory,variable))
28e0: 3b 22 29 0a 20 20 20 20 3b 3b 20 4d 75 73 74 20 ;"). ;; Must
28f0: 64 6f 20 74 68 69 73 20 2a 61 66 74 65 72 2a 20 do this *after*
2900: 72 75 6e 6e 69 6e 67 20 70 61 74 63 68 20 64 62 running patch db
2910: 20 21 21 20 4e 6f 20 6d 6f 72 65 2e 20 0a 20 20 !! No more. .
2920: 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 (db:set-var db
2930: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 "MEGATEST_VERSI
2940: 4f 4e 22 20 6d 65 67 61 74 65 73 74 2d 76 65 72 ON" megatest-ver
2950: 73 69 6f 6e 29 0a 20 20 20 20 28 64 65 62 75 67 sion). (debug
2960: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
2970: 64 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e db:initialize EN
2980: 44 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d D"). ))..;;==
2990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
29d0: 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 54 20 ====.;; T E S T
29e0: 20 20 53 20 50 20 45 20 43 20 49 20 46 20 49 20 S P E C I F I
29f0: 43 20 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d C D B .;;=====
2a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2a40: 3d 0a 0a 3b 3b 20 43 72 65 61 74 65 20 74 68 65 =..;; Create the
2a50: 20 73 71 6c 69 74 65 20 64 62 20 66 6f 72 20 74 sqlite db for t
2a60: 68 65 20 69 6e 64 69 76 69 64 75 61 6c 20 74 65 he individual te
2a70: 73 74 28 73 29 0a 28 64 65 66 69 6e 65 20 28 6f st(s).(define (o
2a80: 70 65 6e 2d 74 65 73 74 2d 64 62 20 74 65 73 74 pen-test-db test
2a90: 70 61 74 68 29 20 0a 20 20 28 64 65 62 75 67 3a path) . (debug:
2aa0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f print-info 11 "o
2ab0: 70 65 6e 2d 74 65 73 74 2d 64 62 20 22 20 74 65 pen-test-db " te
2ac0: 73 74 70 61 74 68 29 0a 20 20 28 69 66 20 28 61 stpath). (if (a
2ad0: 6e 64 20 74 65 73 74 70 61 74 68 20 0a 09 20 20 nd testpath ..
2ae0: 20 28 64 69 72 65 63 74 6f 72 79 3f 20 74 65 73 (directory? tes
2af0: 74 70 61 74 68 29 0a 09 20 20 20 28 66 69 6c 65 tpath).. (file
2b00: 2d 72 65 61 64 2d 61 63 63 65 73 73 3f 20 74 65 -read-access? te
2b10: 73 74 70 61 74 68 29 29 0a 20 20 20 20 20 20 28 stpath)). (
2b20: 6c 65 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 let* ((dbpath
2b30: 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 68 20 (conc testpath
2b40: 22 2f 74 65 73 74 64 61 74 2e 64 62 22 29 29 0a "/testdat.db")).
2b50: 09 20 20 20 20 20 28 64 62 65 78 69 73 74 73 20 . (dbexists
2b60: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 (file-exists? d
2b70: 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 28 64 bpath)).. (d
2b80: 62 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 b (sqlite
2b90: 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 3:open-database
2ba0: 64 62 70 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 dbpath)) ;; (nev
2bb0: 65 72 2d 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d er-give-up-open-
2bc0: 64 62 20 64 62 70 61 74 68 29 29 0a 09 20 20 20 db dbpath))..
2bd0: 20 20 28 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 (handler (ma
2be0: 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 ke-busy-timeout
2bf0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
2c00: 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d g "-override-tim
2c10: 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 20 20 eout")......
2c20: 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 (string->numb
2c30: 65 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 er (args:get-arg
2c40: 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 "-override-time
2c50: 6f 75 74 22 29 29 0a 09 09 09 09 09 20 20 20 20 out"))......
2c60: 20 20 20 31 33 36 30 30 30 29 29 29 29 0a 09 28 136000))))..(
2c70: 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 73 79 sqlite3:set-busy
2c80: 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 61 6e -handler! db han
2c90: 64 6c 65 72 29 0a 09 28 69 66 20 28 6e 6f 74 20 dler)..(if (not
2ca0: 64 62 65 78 69 73 74 73 29 0a 09 20 20 20 20 28 dbexists).. (
2cb0: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 71 begin.. (sq
2cc0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
2cd0: 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f "PRAGMA synchro
2ce0: 6e 6f 75 73 20 3d 20 46 55 4c 4c 3b 22 29 0a 09 nous = FULL;")..
2cf0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2d00: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 49 6e 69 74 nt-info 11 "Init
2d10: 69 61 6c 69 7a 65 64 20 74 65 73 74 20 64 61 74 ialized test dat
2d20: 61 62 61 73 65 20 22 20 64 62 70 61 74 68 29 0a abase " dbpath).
2d30: 09 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 64 . (db:testd
2d40: 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 b-initialize db)
2d50: 29 29 0a 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a ))..;; (sqlite3:
2d60: 65 78 65 63 75 74 65 20 64 62 20 22 50 52 41 47 execute db "PRAG
2d70: 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d MA synchronous =
2d80: 20 30 3b 22 29 0a 09 28 64 65 62 75 67 3a 70 72 0;")..(debug:pr
2d90: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 int-info 11 "ope
2da0: 6e 2d 74 65 73 74 2d 64 62 20 45 4e 44 20 28 73 n-test-db END (s
2db0: 75 63 65 73 73 66 75 6c 29 22 20 74 65 73 74 70 ucessful)" testp
2dc0: 61 74 68 29 0a 09 64 62 29 0a 20 20 20 20 20 20 ath)..db).
2dd0: 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 (begin..(debug:p
2de0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 rint-info 11 "op
2df0: 65 6e 2d 74 65 73 74 2d 64 62 20 45 4e 44 20 28 en-test-db END (
2e00: 75 6e 73 75 63 65 73 73 66 75 6c 29 22 20 74 65 unsucessful)" te
2e10: 73 74 70 61 74 68 29 0a 09 23 66 29 29 29 0a 0a stpath)..#f)))..
2e20: 3b 3b 20 66 69 6e 64 20 61 6e 64 20 6f 70 65 6e ;; find and open
2e30: 20 74 68 65 20 74 65 73 74 64 61 74 2e 64 62 20 the testdat.db
2e40: 66 69 6c 65 20 66 6f 72 20 61 6e 20 65 78 69 73 file for an exis
2e50: 74 69 6e 67 20 74 65 73 74 0a 28 64 65 66 69 6e ting test.(defin
2e60: 65 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d e (db:open-test-
2e70: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
2e80: 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 test-id). (let
2e90: 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 28 64 * ((test-path (d
2ea0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
2eb0: 72 2d 66 72 6f 6d 2d 74 65 73 74 2d 69 64 20 64 r-from-test-id d
2ec0: 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 b test-id))).
2ed0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 (debug:print 3
2ee0: 22 54 45 53 54 20 50 41 54 48 3a 20 22 20 74 65 "TEST PATH: " te
2ef0: 73 74 2d 70 61 74 68 29 0a 20 20 20 20 28 6f 70 st-path). (op
2f00: 65 6e 2d 74 65 73 74 2d 64 62 20 74 65 73 74 2d en-test-db test-
2f10: 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 path)))..(define
2f20: 20 28 64 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 (db:testdb-init
2f30: 69 61 6c 69 7a 65 20 64 62 29 0a 20 20 28 64 65 ialize db). (de
2f40: 62 75 67 3a 70 72 69 6e 74 20 31 31 20 22 64 62 bug:print 11 "db
2f50: 3a 74 65 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 :testdb-initiali
2f60: 7a 65 20 53 54 41 52 54 22 29 0a 20 20 28 66 6f ze START"). (fo
2f70: 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 r-each. (lambd
2f80: 61 20 28 73 71 6c 63 6d 64 29 0a 20 20 20 20 20 a (sqlcmd).
2f90: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
2fa0: 20 64 62 20 73 71 6c 63 6d 64 29 29 0a 20 20 20 db sqlcmd)).
2fb0: 28 6c 69 73 74 20 22 43 52 45 41 54 45 20 54 41 (list "CREATE TA
2fc0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
2fd0: 53 20 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a S test_rundat (.
2fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 64 id
2ff0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
3000: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
3010: 20 20 20 20 75 70 64 61 74 65 5f 74 69 6d 65 20 update_time
3020: 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 TIMESTAMP,.
3030: 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 cpuload
3040: 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 INTEGER DEFAULT
3050: 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 -1,.
3060: 20 20 20 64 69 73 6b 66 72 65 65 20 49 4e 54 45 diskfree INTE
3070: 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a GER DEFAULT -1,.
3080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 69 di
3090: 73 6b 75 73 61 67 65 20 49 4e 54 47 45 52 20 44 skusage INTGER D
30a0: 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 EFAULT -1,.
30b0: 20 20 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 run_dur
30c0: 61 74 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 ation INTEGER DE
30d0: 46 41 55 4c 54 20 30 29 3b 22 0a 09 20 22 43 52 FAULT 0);".. "CR
30e0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
30f0: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 T EXISTS test_da
3100: 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 ta (.
3110: 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 id INTEGER PR
3120: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
3130: 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 test_id
3140: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
3150: 20 20 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 category
3160: 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 TEXT DEFAULT ''
3170: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
3180: 76 61 72 69 61 62 6c 65 20 54 45 58 54 2c 0a 09 variable TEXT,..
3190: 20 20 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c value REAL
31a0: 2c 0a 09 20 20 20 20 20 20 65 78 70 65 63 74 65 ,.. expecte
31b0: 64 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 74 d REAL,.. t
31c0: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
31d0: 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 units TEX
31e0: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
31f0: 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 comment TEXT DE
3200: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
3210: 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 status T
3220: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 EXT DEFAULT 'n/a
3230: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
3240: 20 74 79 70 65 20 54 45 58 54 20 44 45 46 41 55 type TEXT DEFAU
3250: 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 LT '',.
3260: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
3270: 74 65 73 74 5f 64 61 74 61 5f 63 6f 6e 73 74 72 test_data_constr
3280: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 aint UNIQUE (tes
3290: 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 t_id,category,va
32a0: 72 69 61 62 6c 65 29 29 3b 22 0a 09 20 22 43 52 riable));".. "CR
32b0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
32c0: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 T EXISTS test_st
32d0: 65 70 73 20 28 0a 20 20 20 20 20 20 20 20 20 20 eps (.
32e0: 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 id INTEGER P
32f0: 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 RIMARY KEY,.
3300: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
3310: 64 20 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 d INTEGER, .
3320: 20 20 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 stepna
3330: 6d 65 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 me TEXT, .
3340: 20 20 20 20 20 20 20 20 73 74 61 74 65 20 54 45 state TE
3350: 58 54 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f XT DEFAULT 'NOT_
3360: 53 54 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 STARTED', .
3370: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 status
3380: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f TEXT DEFAULT 'n/
3390: 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 a',.
33a0: 20 20 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d event_time TIM
33b0: 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 ESTAMP,.
33c0: 20 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 comment TE
33d0: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
33e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
33f0: 66 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c file TEXT DEFAUL
3400: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
3410: 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 CONSTRAINT t
3420: 65 73 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 72 est_steps_constr
3430: 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 aint UNIQUE (tes
3440: 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 t_id,stepname,st
3450: 61 74 65 29 29 3b 22 0a 09 20 3b 3b 20 74 65 73 ate));".. ;; tes
3460: 74 5f 6d 65 74 61 20 63 61 6e 20 62 65 20 75 73 t_meta can be us
3470: 65 64 20 66 6f 72 20 68 61 6e 64 69 6e 67 20 63 ed for handing c
3480: 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 74 ommands to the t
3490: 65 73 74 0a 09 20 3b 3b 20 65 2e 67 2e 20 4b 49 est.. ;; e.g. KI
34a0: 4c 4c 52 45 51 0a 09 20 3b 3b 20 20 20 20 20 20 LLREQ.. ;;
34b0: 74 68 65 20 61 63 6b 73 74 61 74 65 20 69 73 20 the ackstate is
34c0: 73 65 74 20 74 6f 20 31 20 6f 6e 63 65 20 74 68 set to 1 once th
34d0: 65 20 63 6f 6d 6d 61 6e 64 20 68 61 73 20 62 65 e command has be
34e0: 65 6e 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 22 en completed.. "
34f0: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
3500: 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f NOT EXISTS test_
3510: 6d 65 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 meta (.
3520: 20 20 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 id INTEGER
3530: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
3540: 20 20 20 20 20 20 20 20 20 20 20 76 61 72 20 54 var T
3550: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
3560: 20 20 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 val TEXT,.
3570: 20 20 20 20 20 20 20 20 20 20 20 61 63 6b 73 74 ackst
3580: 61 74 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 ate INTEGER DEFA
3590: 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 ULT 0,.
35a0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
35b0: 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 metadat_constrai
35c0: 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 nt UNIQUE (var))
35d0: 3b 22 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 ;")). (debug:pr
35e0: 69 6e 74 20 31 31 20 22 64 62 3a 74 65 73 74 64 int 11 "db:testd
35f0: 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 45 4e 44 b-initialize END
3600: 22 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d "))..;;=========
3610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
3650: 20 4c 20 4f 20 47 20 47 20 49 20 4e 20 47 20 20 L O G G I N G
3660: 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d D B .;;=======
3670: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
36b0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c .(define (open-l
36c0: 6f 67 67 69 6e 67 2d 64 62 29 20 3b 3b 20 20 28 ogging-db) ;; (
36d0: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
36e0: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 /megatest.db") (
36f0: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
3700: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 ))). (let* ((db
3710: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 28 69 path (conc (i
3720: 66 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e f *toppath* (con
3730: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 22 29 c *toppath* "/")
3740: 20 22 22 29 20 22 6c 6f 67 67 69 6e 67 2e 64 62 "") "logging.db
3750: 22 29 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 20 ")) ;; fname)..
3760: 28 64 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 (dbexists (file
3770: 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 -exists? dbpath)
3780: 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 20 28 ).. (db (
3790: 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 sqlite3:open-dat
37a0: 61 62 61 73 65 20 64 62 70 61 74 68 29 29 20 3b abase dbpath)) ;
37b0: 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 ; (never-give-up
37c0: 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 -open-db dbpath)
37d0: 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 28 ).. (handler (
37e0: 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 make-busy-timeou
37f0: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
3800: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 arg "-override-t
3810: 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 imeout")......
3820: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
3830: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3840: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
3850: 74 22 29 29 0a 09 09 09 09 09 20 20 20 31 33 36 t"))...... 136
3860: 30 30 30 29 29 29 29 20 3b 3b 20 31 33 36 30 30 000)))) ;; 13600
3870: 30 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 0))). (sqlite
3880: 33 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 3:set-busy-handl
3890: 65 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a er! db handler).
38a0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 (if (not dbe
38b0: 78 69 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 xists)..(begin..
38c0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
38d0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
38e0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
38f0: 53 20 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 S log (id INTEGE
3900: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 65 76 R PRIMARY KEY,ev
3910: 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 ent_time TIMESTA
3920: 4d 50 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 MP DEFAULT (strf
3930: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
3940: 29 2c 6c 6f 67 6c 69 6e 65 20 54 45 58 54 2c 70 ),logline TEXT,p
3950: 77 64 20 54 45 58 54 2c 63 6d 64 6c 69 6e 65 20 wd TEXT,cmdline
3960: 54 45 58 54 2c 70 69 64 20 49 4e 54 45 47 45 52 TEXT,pid INTEGER
3970: 29 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 );").. (sqlite3
3980: 3a 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e :execute db (con
3990: 63 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 c "PRAGMA synchr
39a0: 6f 6e 6f 75 73 20 3d 20 30 3b 22 29 29 29 29 0a onous = 0;")))).
39b0: 20 20 20 20 64 62 29 29 0a 0a 28 64 65 66 69 6e db))..(defin
39c0: 65 20 28 64 62 3a 6c 6f 67 2d 65 76 65 6e 74 20 e (db:log-event
39d0: 2e 20 6c 6f 67 6c 73 74 29 0a 20 20 28 6c 65 74 . loglst). (let
39e0: 20 28 28 64 62 20 20 20 20 20 20 28 6f 70 65 6e ((db (open
39f0: 2d 6c 6f 67 67 69 6e 67 2d 64 62 29 29 0a 09 28 -logging-db))..(
3a00: 6c 6f 67 6c 69 6e 65 20 28 61 70 70 6c 79 20 63 logline (apply c
3a10: 6f 6e 63 20 6c 6f 67 6c 73 74 29 29 29 0a 20 20 onc loglst))).
3a20: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3a30: 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e te db "INSERT IN
3a40: 54 4f 20 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 2c TO log (logline,
3a50: 70 77 64 2c 63 6d 64 6c 69 6e 65 2c 70 69 64 29 pwd,cmdline,pid)
3a60: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f VALUES (?,?,?,?
3a70: 29 3b 22 20 6c 6f 67 6c 69 6e 65 20 28 63 75 72 );" logline (cur
3a80: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 28 rent-directory)(
3a90: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
3aa0: 73 65 20 28 61 72 67 76 29 20 22 20 22 29 28 63 se (argv) " ")(c
3ab0: 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
3ac0: 64 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 d)). (sqlite3
3ad0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 :finalize! db).
3ae0: 20 20 20 6c 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b logline))..;;
3af0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3b30: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 4f 44 4f 3a 0a ======.;; TODO:.
3b40: 3b 3b 20 20 20 70 75 74 20 64 65 6c 74 61 73 20 ;; put deltas
3b50: 69 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 6c 69 into an assoc li
3b60: 73 74 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 st with version
3b70: 6e 75 6d 62 65 72 73 0a 3b 3b 20 20 20 61 70 70 numbers.;; app
3b80: 6c 79 20 61 6c 6c 20 66 72 6f 6d 20 6c 61 73 74 ly all from last
3b90: 20 74 6f 20 63 75 72 72 65 6e 74 0a 3b 3b 3d 3d to current.;;==
3ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3be0: 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 70 61 ====.(define (pa
3bf0: 74 63 68 2d 64 62 20 64 62 29 0a 20 20 28 68 61 tch-db db). (ha
3c00: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
3c10: 20 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e exn. (begin
3c20: 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 78 . (print "Ex
3c30: 63 65 70 74 69 6f 6e 3a 20 22 20 65 78 6e 29 0a ception: " exn).
3c40: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR
3c50: 4f 52 3a 20 50 6f 73 73 69 62 6c 65 20 6f 75 74 OR: Possible out
3c60: 20 6f 66 20 64 61 74 65 20 73 63 68 65 6d 61 2c of date schema,
3c70: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 61 attempting to a
3c80: 64 64 20 74 61 62 6c 65 20 6d 65 74 61 64 61 74 dd table metadat
3c90: 61 2e 2e 2e 22 29 0a 20 20 20 20 20 28 73 71 6c a..."). (sql
3ca0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
3cb0: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
3cc0: 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 NOT EXISTS meta
3cd0: 64 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 2c dat (id INTEGER,
3ce0: 20 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 var TEXT, val T
3cf0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
3d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d10: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
3d20: 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 metadat_constra
3d30: 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 int UNIQUE (var)
3d40: 29 3b 22 29 0a 20 20 20 20 20 28 69 66 20 28 6e );"). (if (n
3d50: 6f 74 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 ot (db:get-var d
3d60: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
3d70: 49 4f 4e 22 29 29 0a 09 20 28 64 62 3a 73 65 74 ION")).. (db:set
3d80: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
3d90: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 29 T_VERSION" 1.17)
3da0: 29 29 0a 20 20 20 28 6c 65 74 20 28 28 6d 76 65 )). (let ((mve
3db0: 72 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 r (db:get-var db
3dc0: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 "MEGATEST_VERSI
3dd0: 4f 4e 22 29 29 0a 09 20 28 74 65 73 74 2d 6d 65 ON")).. (test-me
3de0: 74 61 2d 64 65 66 20 22 43 52 45 41 54 45 20 54 ta-def "CREATE T
3df0: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
3e00: 54 53 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 TS test_meta (id
3e10: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
3e20: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e40: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e testn
3e50: 61 6d 65 20 20 20 20 54 45 58 54 20 44 45 46 41 ame TEXT DEFA
3e60: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
3e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 aut
3e90: 68 6f 72 20 20 20 20 20 20 54 45 58 54 20 44 45 hor TEXT DE
3ea0: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f o
3ed0: 77 6e 65 72 20 20 20 20 20 20 20 54 45 58 54 20 wner TEXT
3ee0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f10: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 description TEX
3f20: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f50: 20 20 20 72 65 76 69 65 77 65 64 20 20 20 20 54 reviewed T
3f60: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 IMESTAMP,.
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
3f90: 74 65 72 61 74 65 64 20 20 20 20 54 45 58 54 20 terated TEXT
3fa0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fd0: 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 avg_runtime REA
3fe0: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 L,.
3ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4000: 20 20 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b avg_disk
4010: 20 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 REAL,.
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
4040: 61 67 73 20 20 20 20 20 20 20 20 54 45 58 54 20 ags TEXT
4050: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4070: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
4080: 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 TRAINT test_meta
4090: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
40a0: 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 UE (testname));"
40b0: 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 )). (print "
40c0: 43 75 72 72 65 6e 74 20 73 63 68 65 6d 61 20 76 Current schema v
40d0: 65 72 73 69 6f 6e 3a 20 22 20 6d 76 65 72 20 22 ersion: " mver "
40e0: 20 63 75 72 72 65 6e 74 20 6d 65 67 61 74 65 73 current megates
40f0: 74 20 76 65 72 73 69 6f 6e 3a 20 22 20 6d 65 67 t version: " meg
4100: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 atest-version).
4110: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
4120: 28 28 6e 6f 74 20 6d 76 65 72 29 0a 20 20 20 20 ((not mver).
4130: 20 20 20 28 70 72 69 6e 74 20 22 41 64 64 69 6e (print "Addin
4140: 67 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 g megatest-versi
4150: 6f 6e 20 74 6f 20 6d 65 74 61 64 61 74 61 22 29 on to metadata")
4160: 20 3b 3b 20 4e 65 65 64 20 74 6f 20 72 65 63 72 ;; Need to recr
4170: 65 61 74 65 20 74 68 65 20 74 61 62 6c 65 0a 20 eate the table.
4180: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4190: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
41a0: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
41b0: 6d 65 74 61 64 61 74 3b 22 29 0a 20 20 20 20 20 metadat;").
41c0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
41d0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
41e0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
41f0: 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e S metadat (id IN
4200: 54 45 47 45 52 2c 20 76 61 72 20 54 45 58 54 2c TEGER, var TEXT,
4210: 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 val TEXT,.
4220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
4240: 53 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f STRAINT metadat_
4250: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
4260: 45 20 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 E (var));").
4270: 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 (db:set-var d
4280: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
4290: 49 4f 4e 22 20 31 2e 31 37 29 0a 20 20 20 20 20 ION" 1.17).
42a0: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
42b0: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
42c0: 31 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 1). (sqlit
42d0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 e3:execute db "D
42e0: 52 4f 50 20 54 41 42 4c 45 20 49 46 20 45 58 49 ROP TABLE IF EXI
42f0: 53 54 53 20 6d 65 74 61 64 61 74 3b 22 29 0a 20 STS metadat;").
4300: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4310: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
4320: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
4330: 58 49 53 54 53 20 6d 65 74 61 64 61 74 20 28 69 XISTS metadat (i
4340: 64 20 49 4e 54 45 47 45 52 2c 20 76 61 72 20 54 d INTEGER, var T
4350: 45 58 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 EXT, val TEXT,.
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 61 CONSTRAINT meta
4390: 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 dat_constraint U
43a0: 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 29 0a NIQUE (var));").
43b0: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
43c0: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
43d0: 56 45 52 53 49 4f 4e 22 20 31 2e 32 31 29 20 3b VERSION" 1.21) ;
43e0: 3b 20 73 65 74 20 62 65 66 6f 72 65 2c 20 6a 75 ; set before, ju
43f0: 73 74 20 69 6e 20 63 61 73 65 20 74 68 65 20 63 st in case the c
4400: 68 61 6e 67 65 73 20 61 72 65 20 61 6c 72 65 61 hanges are alrea
4410: 64 79 20 61 70 70 6c 69 65 64 0a 20 20 20 20 20 dy applied.
4420: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4430: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
4440: 64 65 66 29 0a 09 09 09 09 09 3b 28 66 6f 72 2d def)......;(for-
4450: 65 61 63 68 20 0a 09 09 09 09 09 3b 20 28 6c 61 each ......; (la
4460: 6d 62 64 61 20 28 73 74 6d 74 29 0a 09 09 09 09 mbda (stmt).....
4470: 09 3b 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 .; (sqlite3:ex
4480: 65 63 75 74 65 20 64 62 20 73 74 6d 74 29 29 0a ecute db stmt)).
4490: 09 09 09 09 09 3b 20 28 6c 69 73 74 20 0a 09 09 .....; (list ...
44a0: 09 09 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 ...; "ALTER TAB
44b0: 4c 45 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c LE tests ADD COL
44c0: 55 4d 4e 20 66 69 72 73 74 5f 65 72 72 20 54 45 UMN first_err TE
44d0: 58 54 3b 22 0a 09 09 09 09 09 3b 20 20 22 41 4c XT;"......; "AL
44e0: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 TER TABLE tests
44f0: 41 44 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 ADD COLUMN first
4500: 5f 77 61 72 6e 20 54 45 58 54 3b 22 0a 09 09 09 _warn TEXT;"....
4510: 09 09 3b 20 20 29 29 0a 20 20 20 20 20 20 20 28 ..; )). (
4520: 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 patch-db)).
4530: 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 34 29 0a ((< mver 1.24).
4540: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4550: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4560: 56 45 52 53 49 4f 4e 22 20 31 2e 32 34 29 0a 20 VERSION" 1.24).
4570: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4580: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
4590: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
45a0: 74 65 73 74 5f 64 61 74 61 3b 22 29 0a 20 20 20 test_data;").
45b0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
45c0: 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 cute db "DROP TA
45d0: 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 74 65 BLE IF EXISTS te
45e0: 73 74 5f 6d 65 74 61 3b 22 29 0a 20 20 20 20 20 st_meta;").
45f0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4600: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
4610: 64 65 66 29 0a 20 20 20 20 20 20 20 28 73 71 6c def). (sql
4620: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
4630: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
4640: 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 NOT EXISTS test
4650: 5f 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 _data (id INTEGE
4660: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
4670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
4690: 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a est_id INTEGER,.
46a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46c0: 63 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 category TEXT DE
46d0: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
46e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46f0: 20 20 20 20 20 20 20 20 20 20 76 61 72 69 61 62 variab
4700: 6c 65 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 le TEXT,..
4710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4720: 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 value REAL,..
4730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4740: 20 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 expected
4750: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 REAL,..
4760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
4770: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4790: 20 20 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 units T
47a0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
47b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47c0: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 comment TEX
47d0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
47e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
4800: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
4810: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
4820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4830: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
4840: 54 20 74 65 73 74 5f 64 61 74 61 20 55 4e 49 51 T test_data UNIQ
4850: 55 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 UE (test_id,cate
4860: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b gory,variable));
4870: 22 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 "). (print
4880: 20 22 57 41 52 4e 49 4e 47 3a 20 54 61 62 6c 65 "WARNING: Table
4890: 20 74 65 73 74 5f 64 61 74 61 20 61 6e 64 20 74 test_data and t
48a0: 65 73 74 5f 6d 65 74 61 20 77 65 72 65 20 72 65 est_meta were re
48b0: 63 72 65 61 74 65 64 2e 20 50 6c 65 61 73 65 20 created. Please
48c0: 64 6f 20 6d 65 67 61 74 65 73 74 20 2d 75 70 64 do megatest -upd
48d0: 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 20 ate-meta").
48e0: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
48f0: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
4900: 37 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 7). (db:se
4910: 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 t-var db "MEGATE
4920: 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 32 37 ST_VERSION" 1.27
4930: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
4940: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 3:execute db "AL
4950: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 64 TER TABLE test_d
4960: 61 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 74 ata ADD COLUMN t
4970: 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ype TEXT DEFAULT
4980: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 70 '';"). (p
4990: 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 atch-db)).
49a0: 28 28 3c 20 6d 76 65 72 20 31 2e 32 39 29 0a 20 ((< mver 1.29).
49b0: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 (db:set-va
49c0: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 r db "MEGATEST_V
49d0: 45 52 53 49 4f 4e 22 20 31 2e 32 39 29 0a 20 20 ERSION" 1.29).
49e0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
49f0: 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 ecute db "ALTER
4a00: 54 41 42 4c 45 20 74 65 73 74 5f 73 74 65 70 73 TABLE test_steps
4a10: 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6c 6f 67 66 ADD COLUMN logf
4a20: 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ile TEXT DEFAULT
4a30: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 73 '';"). (s
4a40: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
4a50: 62 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 b "ALTER TABLE t
4a60: 65 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 ests ADD COLUMN
4a70: 73 68 6f 72 74 64 69 72 20 54 45 58 54 20 44 45 shortdir TEXT DE
4a80: 46 41 55 4c 54 20 27 27 3b 22 29 29 0a 20 20 20 FAULT '';")).
4a90: 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 33 36 ((< mver 1.36
4aa0: 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 ). (db:set
4ab0: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
4ac0: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 33 36 29 T_VERSION" 1.36)
4ad0: 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 . (sqlite3
4ae0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 :execute db "ALT
4af0: 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 6d 65 ER TABLE test_me
4b00: 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6a 6f ta ADD COLUMN jo
4b10: 62 67 72 6f 75 70 20 54 45 58 54 20 44 45 46 41 bgroup TEXT DEFA
4b20: 55 4c 54 20 27 64 65 66 61 75 6c 74 27 3b 22 29 ULT 'default';")
4b30: 29 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 ). ((< mver
4b40: 20 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 64 1.37). (d
4b50: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
4b60: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
4b70: 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 73 71 1.37). (sq
4b80: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4b90: 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 "ALTER TABLE te
4ba0: 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 61 sts ADD COLUMN a
4bb0: 72 63 68 69 76 65 64 20 49 4e 54 45 47 45 52 20 rchived INTEGER
4bc0: 44 45 46 41 55 4c 54 20 30 3b 22 29 29 20 0a 20 DEFAULT 0;")) .
4bd0: 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20 6d 65 ((< mver me
4be0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
4bf0: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4c00: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4c10: 56 45 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 VERSION" megates
4c20: 74 2d 76 65 72 73 69 6f 6e 29 29 29 29 29 29 0a t-version)))))).
4c30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 65 74 =========.;; met
4c80: 61 20 67 65 74 20 61 6e 64 20 73 65 74 20 76 61 a get and set va
4c90: 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d rs.;;===========
4ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
4ce0: 72 65 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 returns number i
4cf0: 66 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 f string->number
4d00: 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 is successful,
4d10: 73 74 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 string otherwise
4d20: 0a 3b 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 .;; also updates
4d30: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a *global-delta*.
4d40: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
4d50: 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 28 64 var db var). (d
4d60: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
4d70: 31 31 20 22 64 62 3a 67 65 74 2d 76 61 72 20 53 11 "db:get-var S
4d80: 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 28 6c TART " var). (l
4d90: 65 74 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 et* ((start-ms (
4da0: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
4db0: 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 onds)).
4dc0: 28 74 68 72 6f 74 74 6c 65 20 28 6c 65 74 20 28 (throttle (let (
4dd0: 28 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b (t (config-look
4de0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
4df0: 73 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c 65 setup" "throttle
4e00: 22 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 ")))... (if
4e10: 74 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 t (string->numbe
4e20: 72 20 74 29 20 74 29 29 29 0a 09 20 28 72 65 73 r t) t))).. (res
4e30: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 #f)). (
4e40: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
4e50: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
4e60: 61 20 28 76 61 6c 29 0a 20 20 20 20 20 20 20 28 a (val). (
4e70: 73 65 74 21 20 72 65 73 20 76 61 6c 29 29 0a 20 set! res val)).
4e80: 20 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 76 db "SELECT v
4e90: 61 6c 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 al FROM metadat
4ea0: 57 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 WHERE var=?;" va
4eb0: 72 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 r). ;; conver
4ec0: 74 20 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 t to number if c
4ed0: 61 6e 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 an. (if (stri
4ee0: 6e 67 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 ng? res)..(let (
4ef0: 28 76 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d (valnum (string-
4f00: 3e 6e 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 >number res)))..
4f10: 20 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 (if valnum (se
4f20: 74 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 t! res valnum)))
4f30: 29 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 ). ;; scale b
4f40: 79 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 y 10, average wi
4f50: 74 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 th current value
4f60: 2e 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
4f70: 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b bal-delta* (/ (+
4f80: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 *global-delta*
4f90: 28 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d (* (- (current-m
4fa0: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 illiseconds) sta
4fb0: 72 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 rt-ms)....... (i
4fc0: 66 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 f throttle throt
4fd0: 74 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 tle 0.01)))....
4fe0: 20 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 2)). (if (
4ff0: 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d > (abs (- *last-
5000: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 global-delta-pri
5010: 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 nted* *global-de
5020: 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 lta*)) 0.08) ;;
5030: 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 don't print all
5040: 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 the time, only i
5050: 66 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 f it changes a b
5060: 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 it..(begin.. (d
5070: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
5080: 34 20 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 4 "launch thrott
5090: 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f le factor=" *glo
50a0: 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 bal-delta*).. (
50b0: 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 set! *last-globa
50c0: 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a l-delta-printed*
50d0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*)
50e0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
50f0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
5100: 67 65 74 2d 76 61 72 20 45 4e 44 20 22 20 76 61 get-var END " va
5110: 72 20 22 20 76 61 6c 3d 22 20 72 65 73 29 0a 20 r " val=" res).
5120: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
5130: 65 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 62 e (db:set-var db
5140: 20 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 var val). (deb
5150: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
5160: 20 22 64 62 3a 73 65 74 2d 76 61 72 20 53 54 41 "db:set-var STA
5170: 52 54 20 22 20 76 61 72 20 22 20 22 20 76 61 6c RT " var " " val
5180: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
5190: 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 cute db "INSERT
51a0: 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 OR REPLACE INTO
51b0: 6d 65 74 61 64 61 74 20 28 76 61 72 2c 76 61 6c metadat (var,val
51c0: 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 ) VALUES (?,?);"
51d0: 20 76 61 72 20 76 61 6c 29 0a 20 20 28 64 65 62 var val). (deb
51e0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
51f0: 20 22 64 62 3a 73 65 74 2d 76 61 72 20 45 4e 44 "db:set-var END
5200: 20 22 20 76 61 72 20 22 20 22 20 76 61 6c 29 29 " var " " val))
5210: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 ..(define (db:de
5220: 6c 2d 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 l-var db var).
5230: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
5240: 6f 20 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 o 11 "db:del-var
5250: 20 53 54 41 52 54 20 22 20 76 61 72 29 0a 20 20 START " var).
5260: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
5270: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
5280: 20 6d 65 74 61 64 61 74 20 57 48 45 52 45 20 76 metadat WHERE v
5290: 61 72 3d 3f 3b 22 20 76 61 72 29 0a 20 20 28 64 ar=?;" var). (d
52a0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
52b0: 31 31 20 22 64 62 3a 64 65 6c 2d 76 61 72 20 45 11 "db:del-var E
52c0: 4e 44 20 22 20 76 61 72 29 29 0a 0a 3b 3b 20 75 ND " var))..;; u
52d0: 73 65 20 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 se a global for
52e0: 73 6f 6d 65 20 70 72 69 6d 69 74 69 76 65 20 63 some primitive c
52f0: 61 63 68 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 aching, it is ju
5300: 73 74 20 73 69 6c 6c 79 20 74 6f 20 72 65 2d 72 st silly to re-r
5310: 65 61 64 20 74 68 65 20 64 62 20 0a 3b 3b 20 6f ead the db .;; o
5320: 76 65 72 20 61 6e 64 20 6f 76 65 72 20 61 67 61 ver and over aga
5330: 69 6e 20 66 6f 72 20 74 68 65 20 6b 65 79 73 20 in for the keys
5340: 73 69 6e 63 65 20 74 68 65 79 20 6e 65 76 65 72 since they never
5350: 20 63 68 61 6e 67 65 0a 0a 28 64 65 66 69 6e 65 change..(define
5360: 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (db:get-keys db
5370: 29 0a 20 20 28 69 66 20 2a 64 62 2d 6b 65 79 73 ). (if *db-keys
5380: 2a 20 2a 64 62 2d 6b 65 79 73 2a 20 0a 20 20 20 * *db-keys* .
5390: 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 (let ((res '(
53a0: 29 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e )))..(debug:prin
53b0: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
53c0: 74 2d 6b 65 79 73 20 53 54 41 52 54 20 28 63 61 t-keys START (ca
53d0: 63 68 65 20 6d 69 73 73 29 22 29 0a 09 28 73 71 che miss)")..(sq
53e0: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
53f0: 6f 77 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 6b ow .. (lambda (k
5400: 65 79 20 6b 65 79 74 79 70 65 29 0a 09 20 20 20 ey keytype)..
5410: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
5420: 28 76 65 63 74 6f 72 20 6b 65 79 20 6b 65 79 74 (vector key keyt
5430: 79 70 65 29 20 72 65 73 29 29 29 0a 09 20 64 62 ype) res))).. db
5440: 0a 09 20 22 53 45 4c 45 43 54 20 66 69 65 6c 64 .. "SELECT field
5450: 6e 61 6d 65 2c 66 69 65 6c 64 74 79 70 65 20 46 name,fieldtype F
5460: 52 4f 4d 20 6b 65 79 73 20 4f 52 44 45 52 20 42 ROM keys ORDER B
5470: 59 20 69 64 20 44 45 53 43 3b 22 29 0a 09 28 73 Y id DESC;")..(s
5480: 65 74 21 20 2a 64 62 2d 6b 65 79 73 2a 20 72 65 et! *db-keys* re
5490: 73 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 s)..(debug:print
54a0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
54b0: 2d 6b 65 79 73 20 45 4e 44 20 28 63 61 63 68 65 -keys END (cache
54c0: 20 6d 69 73 73 29 22 29 0a 09 72 65 73 29 29 29 miss)")..res)))
54d0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 ..(define (db:ge
54e0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
54f0: 72 20 72 6f 77 20 68 65 61 64 65 72 20 66 69 65 r row header fie
5500: 6c 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 ld). (debug:pri
5510: 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 nt-info 4 "db:ge
5520: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
5530: 72 20 72 6f 77 3a 20 22 20 72 6f 77 20 22 20 68 r row: " row " h
5540: 65 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 eader: " header
5550: 22 20 66 69 65 6c 64 3a 20 22 20 66 69 65 6c 64 " field: " field
5560: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 68 ). (if (null? h
5570: 65 61 64 65 72 29 20 23 66 0a 20 20 20 20 20 20 eader) #f.
5580: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
5590: 28 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 09 (car header))...
55a0: 20 28 74 61 6c 20 28 63 64 72 20 68 65 61 64 65 (tal (cdr heade
55b0: 72 29 29 0a 09 09 20 28 6e 20 20 20 30 29 29 0a r))... (n 0)).
55c0: 09 28 69 66 20 28 65 71 75 61 6c 3f 20 68 65 64 .(if (equal? hed
55d0: 20 66 69 65 6c 64 29 0a 09 20 20 20 20 28 76 65 field).. (ve
55e0: 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 6e 29 0a ctor-ref row n).
55f0: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
5600: 74 61 6c 29 20 23 66 20 28 6c 6f 6f 70 20 28 63 tal) #f (loop (c
5610: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
5620: 28 2b 20 6e 20 31 29 29 29 29 29 29 29 0a 0a 3b (+ n 1)))))))..;
5630: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5660: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5670: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 20 =======.;; R U
5680: 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N S.;;==========
5690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
56c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
56d0: 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 2d efine (runs:get-
56e0: 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 20 6b std-run-fields k
56f0: 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29 0a 20 eys remfields).
5700: 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 20 (let* ((header
5710: 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 (append (map
5720: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
5730: 65 20 6b 65 79 73 29 0a 09 09 09 20 20 20 20 72 e keys).... r
5740: 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28 6b 65 emfields)).. (ke
5750: 79 73 74 72 20 20 20 20 28 63 6f 6e 63 20 28 6b ystr (conc (k
5760: 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 eys->keystr keys
5770: 29 20 22 2c 22 0a 09 09 09 20 20 28 73 74 72 69 ) ",".... (stri
5780: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 ng-intersperse r
5790: 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 29 emfields ","))))
57a0: 0a 20 20 20 20 28 6c 69 73 74 20 6b 65 79 73 74 . (list keyst
57b0: 72 20 68 65 61 64 65 72 29 29 29 0a 0a 3b 3b 20 r header)))..;;
57c0: 6d 61 6b 65 20 61 20 71 75 65 72 79 20 28 66 69 make a query (fi
57d0: 65 6c 64 6e 61 6d 65 20 6c 69 6b 65 20 27 70 61 eldname like 'pa
57e0: 74 74 31 27 20 4f 52 20 66 69 65 6c 64 6e 61 6d tt1' OR fieldnam
57f0: 65 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 70 e .(define (db:p
5800: 61 74 74 2d 3e 6c 69 6b 65 20 66 69 65 6c 64 6e att->like fieldn
5810: 61 6d 65 20 70 61 74 74 73 74 72 20 23 21 6b 65 ame pattstr #!ke
5820: 79 20 28 63 6f 6d 70 61 72 61 74 6f 72 20 22 20 y (comparator "
5830: 4f 52 20 22 29 29 0a 20 20 28 6c 65 74 20 28 28 OR ")). (let ((
5840: 70 61 74 74 73 20 28 69 66 20 28 73 74 72 69 6e patts (if (strin
5850: 67 3f 20 70 61 74 74 73 74 72 29 0a 09 09 20 20 g? pattstr)...
5860: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 (string-split p
5870: 61 74 74 73 74 72 20 22 2c 22 29 0a 09 09 20 20 attstr ",")...
5880: 20 27 28 22 25 22 29 29 29 29 0a 20 20 20 20 28 '("%")))). (
5890: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
58a0: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
58b0: 28 70 61 74 74 29 0a 09 09 09 20 20 20 20 20 20 (patt)....
58c0: 20 28 6c 65 74 20 28 28 77 69 6c 64 74 79 70 65 (let ((wildtype
58d0: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
58e0: 69 6e 64 65 78 20 22 25 22 20 70 61 74 74 29 20 index "%" patt)
58f0: 22 4c 49 4b 45 22 20 22 47 4c 4f 42 22 29 29 29 "LIKE" "GLOB")))
5900: 0a 09 09 09 09 20 28 63 6f 6e 63 20 66 69 65 6c ..... (conc fiel
5910: 64 6e 61 6d 65 20 22 20 22 20 77 69 6c 64 74 79 dname " " wildty
5920: 70 65 20 22 20 27 22 20 70 61 74 74 20 22 27 22 pe " '" patt "'"
5930: 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 ))).... (if
5940: 28 6e 75 6c 6c 3f 20 70 61 74 74 73 29 0a 09 09 (null? patts)...
5950: 09 09 20 27 28 22 22 29 0a 09 09 09 09 20 70 61 .. '("")..... pa
5960: 74 74 73 29 29 0a 09 09 09 63 6f 6d 70 61 72 61 tts))....compara
5970: 74 6f 72 29 29 29 0a 0a 3b 3b 20 72 65 70 6c 61 tor)))..;; repla
5980: 63 65 20 68 65 61 64 65 72 20 61 6e 64 20 6b 65 ce header and ke
5990: 79 73 74 72 20 77 69 74 68 20 61 20 63 61 6c 6c ystr with a call
59a0: 20 74 6f 20 72 75 6e 73 3a 67 65 74 2d 73 74 64 to runs:get-std
59b0: 2d 72 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b 0a 3b -run-fields.;;.;
59c0: 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b ; keypatts: ( (K
59d0: 45 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b EY1 "abc%def")(K
59e0: 45 59 32 20 22 25 22 29 20 29 0a 3b 3b 20 72 75 EY2 "%") ).;; ru
59f0: 6e 70 61 74 74 73 3a 20 70 61 74 74 31 2c 70 61 npatts: patt1,pa
5a00: 74 74 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 tt2 ....;;.(defi
5a10: 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 ne (db:get-runs
5a20: 64 62 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 db runpatt count
5a30: 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 offset keypatts
5a40: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 ). (let* ((res
5a50: 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 6b 65 '()).. (ke
5a60: 79 73 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 ys (db:get
5a70: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 72 75 -keys db)).. (ru
5a80: 6e 70 61 74 74 73 74 72 20 28 64 62 3a 70 61 74 npattstr (db:pat
5a90: 74 2d 3e 6c 69 6b 65 20 22 72 75 6e 6e 61 6d 65 t->like "runname
5aa0: 22 20 72 75 6e 70 61 74 74 29 29 0a 09 20 28 72 " runpatt)).. (r
5ab0: 65 6d 66 69 65 6c 64 73 20 20 28 6c 69 73 74 20 emfields (list
5ac0: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
5ad0: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
5ae0: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
5af0: 69 6d 65 22 29 29 0a 09 20 28 68 65 61 64 65 72 ime")).. (header
5b00: 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 (append (ma
5b10: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
5b20: 61 6d 65 20 6b 65 79 73 29 0a 09 09 20 20 20 20 ame keys)...
5b30: 20 20 20 20 20 20 20 20 20 72 65 6d 66 69 65 6c remfiel
5b40: 64 73 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 ds)).. (keystr
5b50: 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e (conc (keys->
5b60: 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 keystr keys) ","
5b70: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 28 73 ... (s
5b80: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
5b90: 65 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 e remfields ",")
5ba0: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 )).. (qrystr
5bb0: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 (conc "SELECT "
5bc0: 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 keystr " FROM r
5bd0: 75 6e 73 20 57 48 45 52 45 20 28 22 20 72 75 6e uns WHERE (" run
5be0: 70 61 74 74 73 74 72 20 22 29 20 22 20 3b 3b 20 pattstr ") " ;;
5bf0: 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 22 runname LIKE ? "
5c00: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 3b 3b ... ;;
5c10: 20 47 65 6e 65 72 61 74 65 3a 20 22 20 41 4e 44 Generate: " AND
5c20: 20 78 20 4c 49 4b 45 20 27 6b 65 79 70 61 74 74 x LIKE 'keypatt
5c30: 27 20 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 20 ' ..."...
5c40: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6b (if (null? k
5c50: 65 79 70 61 74 74 73 29 20 22 22 0a 09 09 20 20 eypatts) ""...
5c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5c70: 6e 63 20 22 20 41 4e 44 20 22 0a 09 09 09 09 20 nc " AND ".....
5c80: 20 20 20 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e (string-join
5c90: 20 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 ..... (map
5ca0: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 70 61 74 (lambda (keypat
5cb0: 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 t)...... (le
5cc0: 74 20 28 28 6b 65 79 20 20 28 63 61 72 20 6b 65 t ((key (car ke
5cd0: 79 70 61 74 74 29 29 0a 09 09 09 09 09 09 20 20 ypatt)).......
5ce0: 20 28 70 61 74 74 20 28 63 61 64 72 20 6b 65 79 (patt (cadr key
5cf0: 70 61 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 patt)))......
5d00: 20 20 20 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 (db:patt->li
5d10: 6b 65 20 6b 65 79 20 70 61 74 74 29 29 29 0a 09 ke key patt)))..
5d20: 09 09 09 09 20 20 20 6b 65 79 70 61 74 74 73 29 .... keypatts)
5d30: 0a 09 09 09 09 20 20 20 20 20 20 22 20 41 4e 44 ..... " AND
5d40: 20 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 ")))...
5d50: 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 " ORDER BY ev
5d60: 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a ent_time DESC ".
5d70: 09 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66 .. (if
5d80: 20 28 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 (number? count)
5d90: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 ...
5da0: 20 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 (conc " LIMIT
5db0: 22 20 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 " count)...
5dc0: 20 20 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 "")...
5dd0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5de0: 6e 75 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a number? offset).
5df0: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
5e00: 20 28 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 (conc " OFFSET
5e10: 22 20 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 " offset)...
5e20: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 29 29 "")))
5e30: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
5e40: 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 nt-info 11 "db:g
5e50: 65 74 2d 72 75 6e 73 20 53 54 41 52 54 20 71 72 et-runs START qr
5e60: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
5e70: 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 keypatts: " key
5e80: 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 patts " offset:
5e90: 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 " offset " limit
5ea0: 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 : " count). (
5eb0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
5ec0: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
5ed0: 61 20 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 a (a . x).
5ee0: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
5ef0: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
5f00: 20 78 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 x) res))).
5f10: 64 62 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 db. qrystr.
5f20: 20 20 20 20 29 0a 20 20 20 20 28 64 65 62 75 67 ). (debug
5f30: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
5f40: 64 62 3a 67 65 74 2d 72 75 6e 73 20 45 4e 44 20 db:get-runs END
5f50: 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 qrystr: " qrystr
5f60: 20 22 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b " keypatts: " k
5f70: 65 79 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 eypatts " offset
5f80: 3a 20 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d : " offset " lim
5f90: 69 74 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 it: " count).
5fa0: 20 28 76 65 63 74 6f 72 20 68 65 61 64 65 72 20 (vector header
5fb0: 72 65 73 29 29 29 0a 0a 3b 3b 20 6a 75 73 74 20 res)))..;; just
5fc0: 67 65 74 20 63 6f 75 6e 74 20 6f 66 20 72 75 6e get count of run
5fd0: 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 s.(define (db:ge
5fe0: 74 2d 6e 75 6d 2d 72 75 6e 73 20 64 62 20 72 75 t-num-runs db ru
5ff0: 6e 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 28 npatt). (let ((
6000: 6e 75 6d 72 75 6e 73 20 30 29 29 0a 20 20 20 20 numruns 0)).
6010: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
6020: 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 6d o 11 "db:get-num
6030: 2d 72 75 6e 73 20 53 54 41 52 54 20 22 20 72 75 -runs START " ru
6040: 6e 70 61 74 74 29 0a 20 20 20 20 28 73 71 6c 69 npatt). (sqli
6050: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
6060: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
6070: 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 73 count). (s
6080: 65 74 21 20 6e 75 6d 72 75 6e 73 20 63 6f 75 6e et! numruns coun
6090: 74 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 t)). db.
60a0: 20 22 53 45 4c 45 43 54 20 43 4f 55 4e 54 28 69 "SELECT COUNT(i
60b0: 64 29 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 d) FROM runs WHE
60c0: 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 RE runname LIKE
60d0: 3f 3b 22 20 72 75 6e 70 61 74 74 29 0a 20 20 20 ?;" runpatt).
60e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
60f0: 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 6e 75 fo 11 "db:get-nu
6100: 6d 2d 72 75 6e 73 20 45 4e 44 20 22 20 72 75 6e m-runs END " run
6110: 70 61 74 74 29 0a 20 20 20 20 6e 75 6d 72 75 6e patt). numrun
6120: 73 29 29 0a 0a 3b 3b 20 75 73 65 20 28 67 65 74 s))..;; use (get
6130: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
6140: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
6150: 72 75 6e 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d runinfo)(db:get-
6160: 72 6f 77 20 72 75 6e 69 6e 66 6f 29 29 0a 28 64 row runinfo)).(d
6170: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 efine (db:get-ru
6180: 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 n-info db run-id
6190: 29 0a 20 20 28 69 66 20 28 68 61 73 68 2d 74 61 ). (if (hash-ta
61a0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
61b0: 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 65 2a *run-info-cache*
61c0: 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 20 20 20 run-id #f).
61d0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
61e0: 66 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 f *run-info-cach
61f0: 65 2a 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 e* run-id).
6200: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 20 (let* ((res
6210: 20 20 23 66 29 0a 09 20 20 20 20 20 28 6b 65 79 #f).. (key
6220: 73 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b s (db:get-k
6230: 65 79 73 20 64 62 29 29 0a 09 20 20 20 20 20 28 eys db)).. (
6240: 72 65 6d 66 69 65 6c 64 73 20 28 6c 69 73 74 20 remfields (list
6250: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
6260: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
6270: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
6280: 69 6d 65 22 29 29 0a 09 20 20 20 20 20 28 68 65 ime")).. (he
6290: 61 64 65 72 20 20 20 20 28 61 70 70 65 6e 64 20 ader (append
62a0: 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 (map key:get-fie
62b0: 6c 64 6e 61 6d 65 20 6b 65 79 73 29 0a 09 09 09 ldname keys)....
62c0: 09 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 20 .remfields))..
62d0: 20 20 20 28 6b 65 79 73 74 72 20 20 20 20 28 63 (keystr (c
62e0: 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 onc (keys->keyst
62f0: 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 09 09 20 r keys) ","....
6300: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
6310: 65 72 73 70 65 72 73 65 20 72 65 6d 66 69 65 6c ersperse remfiel
6320: 64 73 20 22 2c 22 29 29 29 29 0a 09 28 64 65 62 ds ","))))..(deb
6330: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 ug:print-info 11
6340: 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 "db:get-run-inf
6350: 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d o run-id: " run-
6360: 69 64 20 22 20 68 65 61 64 65 72 3a 20 22 20 68 id " header: " h
6370: 65 61 64 65 72 20 22 20 6b 65 79 73 74 72 3a 20 eader " keystr:
6380: 22 20 6b 65 79 73 74 72 29 0a 09 28 73 71 6c 69 " keystr)..(sqli
6390: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
63a0: 0a 09 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 .. (lambda (a .
63b0: 78 29 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 x).. (set! res
63c0: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
63d0: 20 78 29 29 29 0a 09 20 64 62 0a 09 20 28 63 6f x))).. db.. (co
63e0: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 79 nc "SELECT " key
63f0: 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 str " FROM runs
6400: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 20 WHERE id=?;")..
6410: 72 75 6e 2d 69 64 29 0a 09 28 64 65 62 75 67 3a run-id)..(debug:
6420: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 print-info 11 "d
6430: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 b:get-run-info r
6440: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 un-id: " run-id
6450: 22 20 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 " header: " head
6460: 65 72 20 22 20 6b 65 79 73 74 72 3a 20 22 20 6b er " keystr: " k
6470: 65 79 73 74 72 29 0a 09 28 6c 65 74 20 28 28 66 eystr)..(let ((f
6480: 69 6e 61 6c 72 65 73 20 28 76 65 63 74 6f 72 20 inalres (vector
6490: 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 09 20 header res)))..
64a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
64b0: 21 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 68 ! *run-info-cach
64c0: 65 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c 72 e* run-id finalr
64d0: 65 73 29 0a 09 20 20 66 69 6e 61 6c 72 65 73 29 es).. finalres)
64e0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
64f0: 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 6f 72 :set-comment-for
6500: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 63 -run db run-id c
6510: 6f 6d 6d 65 6e 74 29 0a 20 20 28 64 65 62 75 67 omment). (debug
6520: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
6530: 64 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 db:set-comment-f
6540: 6f 72 2d 72 75 6e 20 53 54 41 52 54 20 72 75 6e or-run START run
6550: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 -id: " run-id "
6560: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
6570: 6e 74 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 nt). (sqlite3:e
6580: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
6590: 45 20 72 75 6e 73 20 53 45 54 20 63 6f 6d 6d 65 E runs SET comme
65a0: 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b nt=? WHERE id=?;
65b0: 22 20 63 6f 6d 6d 65 6e 74 20 72 75 6e 2d 69 64 " comment run-id
65c0: 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ). (debug:print
65d0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 73 65 74 -info 11 "db:set
65e0: 2d 63 6f 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e -comment-for-run
65f0: 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 72 END run-id: " r
6600: 75 6e 2d 69 64 20 22 20 63 6f 6d 6d 65 6e 74 3a un-id " comment:
6610: 20 22 20 63 6f 6d 6d 65 6e 74 29 29 0a 0a 3b 3b " comment))..;;
6620: 20 64 6f 65 73 20 6e 6f 74 20 28 6f 62 76 69 6f does not (obvio
6630: 75 73 6c 79 21 29 20 72 65 6d 6f 76 65 64 20 64 usly!) removed d
6640: 65 70 65 6e 64 65 6e 74 20 64 61 74 61 2e 20 42 ependent data. B
6650: 75 74 20 77 68 79 20 6e 6f 74 21 21 3f 0a 28 64 ut why not!!?.(d
6660: 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 efine (db:delete
6670: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 29 0a -run db run-id).
6680: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
6690: 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 te db "DELETE FR
66a0: 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 OM runs WHERE id
66b0: 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 =?;" run-id))..(
66c0: 64 65 66 69 6e 65 20 28 64 62 3a 75 70 64 61 74 define (db:updat
66d0: 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 e-run-event_time
66e0: 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 64 db run-id). (d
66f0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
6700: 31 31 20 22 64 62 3a 75 70 64 61 74 65 2d 72 75 11 "db:update-ru
6710: 6e 2d 65 76 65 6e 74 5f 74 69 6d 65 20 53 54 41 n-event_time STA
6720: 52 54 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e RT run-id: " run
6730: 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 3a -id). (sqlite3:
6740: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
6750: 54 45 20 72 75 6e 73 20 53 45 54 20 65 76 65 6e TE runs SET even
6760: 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 t_time=strftime(
6770: 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 '%s','now') WHER
6780: 45 20 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 E id=?;" run-id)
6790: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
67a0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 75 70 64 61 info 11 "db:upda
67b0: 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f 74 69 6d te-run-event_tim
67c0: 65 20 45 4e 44 20 72 75 6e 2d 69 64 3a 20 22 20 e END run-id: "
67d0: 72 75 6e 2d 69 64 29 29 20 0a 0a 28 64 65 66 69 run-id)) ..(defi
67e0: 6e 65 20 28 64 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f ne (db:lock/unlo
67f0: 63 6b 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 ck-run db run-id
6800: 20 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 lock unlock use
6810: 72 29 0a 20 20 28 6c 65 74 20 28 28 6e 65 77 6c r). (let ((newl
6820: 6f 63 6b 76 61 6c 20 28 69 66 20 6c 6f 63 6b 20 ockval (if lock
6830: 22 6c 6f 63 6b 65 64 22 0a 09 09 09 28 69 66 20 "locked"....(if
6840: 75 6e 6c 6f 63 6b 0a 09 09 09 20 20 20 20 22 75 unlock.... "u
6850: 6e 6c 6f 63 6b 65 64 22 0a 09 09 09 20 20 20 20 nlocked"....
6860: 22 6c 6f 63 6b 65 64 22 29 29 29 29 20 3b 3b 20 "locked")))) ;;
6870: 73 65 6d 69 2d 66 61 69 6c 73 61 66 65 0a 20 20 semi-failsafe.
6880: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
6890: 74 65 20 64 62 20 22 55 50 44 41 54 45 20 72 75 te db "UPDATE ru
68a0: 6e 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 ns SET state=? W
68b0: 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c HERE id=?;" newl
68c0: 6f 63 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 ockval run-id).
68d0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
68e0: 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 49 ute db "INSERT I
68f0: 4e 54 4f 20 61 63 63 65 73 73 5f 6c 6f 67 20 28 NTO access_log (
6900: 75 73 65 72 2c 61 63 63 65 73 73 65 64 2c 61 72 user,accessed,ar
6910: 67 73 29 20 56 41 4c 55 45 53 28 3f 2c 73 74 72 gs) VALUES(?,str
6920: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
6930: 29 2c 3f 29 3b 22 0a 09 09 20 20 20 20 20 75 73 ),?);"... us
6940: 65 72 20 28 63 6f 6e 63 20 6e 65 77 6c 6f 63 6b er (conc newlock
6950: 76 61 6c 20 22 20 22 20 72 75 6e 2d 69 64 29 29 val " " run-id))
6960: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
6970: 74 2d 69 6e 66 6f 20 31 20 22 22 20 6e 65 77 6c t-info 1 "" newl
6980: 6f 63 6b 76 61 6c 20 22 20 72 75 6e 20 6e 75 6d ockval " run num
6990: 62 65 72 20 22 20 72 75 6e 2d 69 64 29 29 29 0a ber " run-id))).
69a0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
69b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
69e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 =========.;; K E
69f0: 20 59 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d Y S.;;=========
6a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
6a40: 3b 20 67 65 74 20 6b 65 79 20 76 61 6c 20 70 61 ; get key val pa
6a50: 69 72 73 20 66 6f 72 20 61 20 67 69 76 65 6e 20 irs for a given
6a60: 72 75 6e 2d 69 64 0a 3b 3b 20 28 20 28 46 49 45 run-id.;; ( (FIE
6a70: 4c 44 4e 41 4d 45 31 20 6b 65 79 76 61 6c 31 29 LDNAME1 keyval1)
6a80: 20 28 46 49 45 4c 44 4e 41 4d 45 32 20 6b 65 79 (FIELDNAME2 key
6a90: 76 61 6c 32 29 20 2e 2e 2e 20 29 0a 28 64 65 66 val2) ... ).(def
6aa0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d ine (db:get-key-
6ab0: 76 61 6c 2d 70 61 69 72 73 20 64 62 20 72 75 6e val-pairs db run
6ac0: 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b -id). (let* ((k
6ad0: 65 79 73 20 28 67 65 74 2d 6b 65 79 73 20 64 62 eys (get-keys db
6ae0: 29 29 0a 09 20 28 72 65 73 20 20 27 28 29 29 29 )).. (res '()))
6af0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
6b00: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
6b10: 74 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 t-key-val-pairs
6b20: 53 54 41 52 54 20 6b 65 79 73 3a 20 22 20 6b 65 START keys: " ke
6b30: 79 73 20 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 ys " run-id: " r
6b40: 75 6e 2d 69 64 29 0a 20 20 20 20 28 66 6f 72 2d un-id). (for-
6b50: 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 each . (lamb
6b60: 64 61 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 da (key).
6b70: 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 (let ((qry (conc
6b80: 20 22 53 45 4c 45 43 54 20 22 20 28 6b 65 79 3a "SELECT " (key:
6b90: 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 get-fieldname ke
6ba0: 79 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 y) " FROM runs W
6bb0: 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a 09 HERE id=?;")))..
6bc0: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
6bd0: 20 30 20 22 71 72 79 3a 20 22 20 71 72 79 29 0a 0 "qry: " qry).
6be0: 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 . (sqlite3:for-e
6bf0: 61 63 68 2d 72 6f 77 20 0a 09 20 20 28 6c 61 6d ach-row .. (lam
6c00: 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a 09 20 bda (key-val)..
6c10: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
6c20: 6e 73 20 28 6c 69 73 74 20 28 6b 65 79 3a 67 65 ns (list (key:ge
6c30: 74 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 t-fieldname key)
6c40: 20 6b 65 79 2d 76 61 6c 29 20 72 65 73 29 29 29 key-val) res)))
6c50: 0a 09 20 20 64 62 20 71 72 79 20 72 75 6e 2d 69 .. db qry run-i
6c60: 64 29 29 29 0a 20 20 20 20 20 6b 65 79 73 29 0a d))). keys).
6c70: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6c80: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6c90: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 45 -key-val-pairs E
6ca0: 4e 44 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 ND keys: " keys
6cb0: 22 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d " run-id: " run-
6cc0: 69 64 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 id). (reverse
6cd0: 20 72 65 73 29 29 29 0a 0a 3b 3b 20 67 65 74 20 res)))..;; get
6ce0: 6b 65 79 20 76 61 6c 73 20 66 6f 72 20 61 20 67 key vals for a g
6cf0: 69 76 65 6e 20 72 75 6e 2d 69 64 0a 28 64 65 66 iven run-id.(def
6d00: 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d ine (db:get-key-
6d10: 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vals db run-id).
6d20: 20 20 28 6c 65 74 20 28 28 6d 79 6b 65 79 76 61 (let ((mykeyva
6d30: 6c 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ls (hash-table-r
6d40: 65 66 2f 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 ef/default *keyv
6d50: 61 6c 73 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 als* run-id #f))
6d60: 29 0a 20 20 20 20 28 69 66 20 6d 79 6b 65 79 76 ). (if mykeyv
6d70: 61 6c 73 20 0a 09 6d 79 6b 65 79 76 61 6c 73 0a als ..mykeyvals.
6d80: 09 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 28 67 .(let* ((keys (g
6d90: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 et-keys db))..
6da0: 20 20 20 20 20 28 72 65 73 20 20 27 28 29 29 29 (res '()))
6db0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
6dc0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
6dd0: 2d 6b 65 79 2d 76 61 6c 73 20 53 54 41 52 54 20 -key-vals START
6de0: 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 72 keys: " keys " r
6df0: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 un-id: " run-id)
6e00: 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 .. (for-each ..
6e10: 20 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 (lambda (key)
6e20: 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 .. (let ((qr
6e30: 79 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 y (conc "SELECT
6e40: 22 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 " (key:get-field
6e50: 6e 61 6d 65 20 6b 65 79 29 20 22 20 46 52 4f 4d name key) " FROM
6e60: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d 3f runs WHERE id=?
6e70: 3b 22 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b ;"))).. ;;
6e80: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6e90: 22 71 72 79 3a 20 22 20 71 72 79 29 0a 09 20 20 "qry: " qry)..
6ea0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f (sqlite3:fo
6eb0: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 09 28 6c r-each-row ...(l
6ec0: 61 6d 62 64 61 20 28 6b 65 79 2d 76 61 6c 29 0a ambda (key-val).
6ed0: 09 09 20 20 28 73 65 74 21 20 72 65 73 20 28 63 .. (set! res (c
6ee0: 6f 6e 73 20 6b 65 79 2d 76 61 6c 20 72 65 73 29 ons key-val res)
6ef0: 29 29 0a 09 09 64 62 20 71 72 79 20 72 75 6e 2d ))...db qry run-
6f00: 69 64 29 29 29 0a 09 20 20 20 6b 65 79 73 29 0a id))).. keys).
6f10: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
6f20: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
6f30: 6b 65 79 2d 76 61 6c 73 20 45 4e 44 20 6b 65 79 key-vals END key
6f40: 73 3a 20 22 20 6b 65 79 73 20 22 20 72 75 6e 2d s: " keys " run-
6f50: 69 64 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 20 id: " run-id)..
6f60: 20 28 6c 65 74 20 28 28 66 69 6e 61 6c 2d 72 65 (let ((final-re
6f70: 73 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 s (reverse res))
6f80: 29 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ).. (hash-tab
6f90: 6c 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 le-set! *keyvals
6fa0: 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c 2d 72 * run-id final-r
6fb0: 65 73 29 0a 09 20 20 20 20 66 69 6e 61 6c 2d 72 es).. final-r
6fc0: 65 73 29 29 29 29 29 0a 0a 3b 3b 20 54 68 65 20 es)))))..;; The
6fd0: 74 61 72 67 65 74 20 69 73 20 6b 65 79 76 61 6c target is keyval
6fe0: 31 2f 6b 65 79 76 61 6c 32 2e 2e 2e 2c 20 63 61 1/keyval2..., ca
6ff0: 63 68 65 64 20 69 6e 20 2a 74 61 72 67 65 74 2a ched in *target*
7000: 20 61 73 20 69 74 20 69 73 20 75 73 65 64 20 6f as it is used o
7010: 66 74 65 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 ften.(define (db
7020: 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 :get-target db r
7030: 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 un-id). (let ((
7040: 6d 79 74 61 72 67 20 28 68 61 73 68 2d 74 61 62 mytarg (hash-tab
7050: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
7060: 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 64 20 23 target* run-id #
7070: 66 29 29 29 0a 20 20 20 20 28 69 66 20 6d 79 74 f))). (if myt
7080: 61 72 67 0a 09 6d 79 74 61 72 67 0a 09 28 6c 65 arg..mytarg..(le
7090: 74 2a 20 28 28 6b 65 79 76 61 6c 73 20 28 64 62 t* ((keyvals (db
70a0: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 :get-key-vals db
70b0: 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 run-id))..
70c0: 20 20 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 (thekey (stri
70d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
70e0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 map (lambda (x)(
70f0: 69 66 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 if x x "-na-"))
7100: 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 29 0a keyvals) "/"))).
7110: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
7120: 65 74 21 20 2a 74 61 72 67 65 74 2a 20 72 75 6e et! *target* run
7130: 2d 69 64 20 74 68 65 6b 65 79 29 0a 09 20 20 74 -id thekey).. t
7140: 68 65 6b 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d hekey))))..;;===
7150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7190: 3d 3d 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 ===.;; T E S T
71a0: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
71b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
71e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
71f0: 69 6e 65 20 28 64 62 3a 74 65 73 74 73 2d 72 65 ine (db:tests-re
7200: 67 69 73 74 65 72 2d 74 65 73 74 20 64 62 20 72 gister-test db r
7210: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
7220: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 64 65 item-path). (de
7230: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 bug:print-info 1
7240: 31 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 69 1 "db:tests-regi
7250: 73 74 65 72 2d 74 65 73 74 20 53 54 41 52 54 20 ster-test START
7260: 64 62 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 db=" db ", run-i
7270: 64 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 d=" run-id ", te
7280: 73 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e st-name=" test-n
7290: 61 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 ame ", item-path
72a0: 3d 5c 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 =\"" item-path "
72b0: 5c 22 22 29 0a 20 20 28 6c 65 74 20 28 28 69 74 \""). (let ((it
72c0: 65 6d 2d 70 61 74 68 73 20 28 69 66 20 28 65 71 em-paths (if (eq
72d0: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
72e0: 22 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d ")....(list item
72f0: 2d 70 61 74 68 29 0a 09 09 09 28 6c 69 73 74 20 -path)....(list
7300: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 29 item-path ""))))
7310: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a . (for-each .
7320: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 74 (lambda (pt
7330: 68 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 h). (sqlit
7340: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 e3:execute db "I
7350: 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 NSERT OR IGNORE
7360: 49 4e 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f INTO tests (run_
7370: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e id,testname,even
7380: 74 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 t_time,item_path
7390: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 ,state,status) V
73a0: 41 4c 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 ALUES (?,?,strft
73b0: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c ime('%s','now'),
73c0: 3f 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c ?,'NOT_STARTED',
73d0: 27 6e 2f 61 27 29 3b 22 20 0a 09 09 09 72 75 6e 'n/a');" ....run
73e0: 2d 69 64 20 0a 09 09 09 74 65 73 74 2d 6e 61 6d -id ....test-nam
73f0: 65 0a 09 09 09 70 74 68 29 29 0a 20 20 20 20 20 e....pth)).
7400: 69 74 65 6d 2d 70 61 74 68 73 29 0a 20 20 28 64 item-paths). (d
7410: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7420: 31 31 20 22 64 62 3a 74 65 73 74 73 2d 72 65 67 11 "db:tests-reg
7430: 69 73 74 65 72 2d 74 65 73 74 20 45 4e 44 20 64 ister-test END d
7440: 62 3d 22 20 64 62 20 22 2c 20 72 75 6e 2d 69 64 b=" db ", run-id
7450: 3d 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 =" run-id ", tes
7460: 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d 6e 61 t-name=" test-na
7470: 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 3d me ", item-path=
7480: 5c 22 22 20 69 74 65 6d 2d 70 61 74 68 20 22 5c \"" item-path "\
7490: 22 22 29 0a 20 20 20 20 23 66 29 29 0a 0a 0a 3b ""). #f))...;
74a0: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 ; states and sta
74b0: 74 75 73 65 73 20 61 72 65 20 6c 69 73 74 73 2c tuses are lists,
74c0: 20 74 75 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20 turn them into
74d0: 28 22 50 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e ("PASS","FAIL"..
74e0: 2e 29 20 61 6e 64 20 75 73 65 20 4e 4f 54 20 49 .) and use NOT I
74f0: 4e 0a 3b 3b 20 69 2e 65 2e 20 74 68 65 73 65 20 N.;; i.e. these
7500: 6c 69 73 74 73 20 64 65 66 69 6e 65 20 77 68 61 lists define wha
7510: 74 20 74 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b t to NOT show..;
7520: 3b 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 ; states and sta
7530: 74 75 73 65 73 20 61 72 65 20 72 65 71 75 69 72 tuses are requir
7540: 65 64 20 74 6f 20 62 65 20 6c 69 73 74 73 2c 20 ed to be lists,
7550: 65 6d 70 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e empty is ok.;; n
7560: 6f 74 2d 69 6e 20 23 74 20 3d 20 61 62 6f 76 65 ot-in #t = above
7570: 20 62 65 68 61 76 69 6f 75 72 2c 20 23 66 20 3d behaviour, #f =
7580: 20 6d 75 73 74 20 6d 61 74 63 68 0a 28 64 65 66 must match.(def
7590: 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 ine (db:get-test
75a0: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e s-for-run db run
75b0: 2d 69 64 20 74 65 73 74 70 61 74 74 20 73 74 61 -id testpatt sta
75c0: 74 65 73 20 73 74 61 74 75 73 65 73 20 0a 09 09 tes statuses ...
75d0: 09 20 20 20 20 20 20 23 21 6b 65 79 20 28 6e 6f . #!key (no
75e0: 74 2d 69 6e 20 23 74 29 0a 09 09 09 20 20 20 20 t-in #t)....
75f0: 20 20 28 73 6f 72 74 2d 62 79 20 23 66 29 20 3b (sort-by #f) ;
7600: 3b 20 27 72 75 6e 64 69 72 20 27 65 76 65 6e 74 ; 'rundir 'event
7610: 5f 74 69 6d 65 0a 09 09 09 20 20 20 20 20 20 29 _time.... )
7620: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
7630: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
7640: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 tests-for-run ST
7650: 41 52 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e ART run-id=" run
7660: 2d 69 64 20 22 2c 20 74 65 73 74 70 61 74 74 3d -id ", testpatt=
7670: 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 " testpatt ", st
7680: 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c ates=" states ",
7690: 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 statuses=" stat
76a0: 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 uses ", not-in="
76b0: 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d not-in ", sort-
76c0: 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 by=" sort-by).
76d0: 28 6c 65 74 2a 20 28 28 72 65 73 20 27 28 29 29 (let* ((res '())
76e0: 0a 09 20 3b 3b 20 69 66 20 73 74 61 74 65 73 20 .. ;; if states
76f0: 6f 72 20 73 74 61 74 75 73 65 73 20 61 72 65 20 or statuses are
7700: 6e 75 6c 6c 20 74 68 65 6e 20 61 73 73 75 6d 65 null then assume
7710: 20 6d 61 74 63 68 20 61 6c 6c 20 77 68 65 6e 20 match all when
7720: 6e 6f 74 2d 69 6e 20 69 73 20 66 61 6c 73 65 0a not-in is false.
7730: 09 20 28 73 74 61 74 65 73 2d 71 72 79 20 20 20 . (states-qry
7740: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 73 74 (if (null? st
7750: 61 74 65 73 29 20 0a 09 09 09 20 20 20 20 20 20 ates) ....
7760: 23 66 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e #f.... (con
7770: 63 20 22 20 73 74 61 74 65 20 22 20 20 0a 09 09 c " state " ...
7780: 09 09 20 20 20 20 28 69 66 20 6e 6f 74 2d 69 6e .. (if not-in
7790: 20 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 09 09 "NOT" "") .....
77a0: 20 20 20 20 22 20 49 4e 20 28 27 22 20 0a 09 09 " IN ('" ...
77b0: 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e .. (string-in
77c0: 74 65 72 73 70 65 72 73 65 20 73 74 61 74 65 73 tersperse states
77d0: 20 20 20 22 27 2c 27 22 29 0a 09 09 09 09 20 20 "','").....
77e0: 20 20 22 27 29 22 29 29 29 0a 09 20 28 73 74 61 "')"))).. (sta
77f0: 74 75 73 65 73 2d 71 72 79 20 20 20 20 28 69 66 tuses-qry (if
7800: 20 28 6e 75 6c 6c 3f 20 73 74 61 74 75 73 65 73 (null? statuses
7810: 29 0a 09 09 09 20 20 20 20 20 20 23 66 0a 09 09 ).... #f...
7820: 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 73 . (conc " s
7830: 74 61 74 75 73 20 22 0a 09 09 09 09 20 20 20 20 tatus ".....
7840: 28 69 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f 54 22 (if not-in "NOT"
7850: 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 22 20 "") ..... "
7860: 49 4e 20 28 27 22 20 0a 09 09 09 09 20 20 20 20 IN ('" .....
7870: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7880: 72 73 65 20 73 74 61 74 75 73 65 73 20 22 27 2c rse statuses "',
7890: 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29 22 '")..... "')"
78a0: 29 29 29 0a 09 20 28 74 65 73 74 73 2d 6d 61 74 ))).. (tests-mat
78b0: 63 68 2d 71 72 79 20 28 74 65 73 74 73 3a 6d 61 ch-qry (tests:ma
78c0: 74 63 68 2d 3e 73 71 6c 71 72 79 20 74 65 73 74 tch->sqlqry test
78d0: 70 61 74 74 29 29 0a 09 20 28 71 72 79 20 20 20 patt)).. (qry
78e0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 (conc
78f0: 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e 5f 69 "SELECT id,run_i
7900: 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 d,testname,state
7910: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
7920: 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c me,host,cpuload,
7930: 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 diskfree,uname,r
7940: 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c undir,item_path,
7950: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e run_duration,fin
7960: 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 al_logf,comment
7970: 22 0a 09 09 09 09 22 20 46 52 4f 4d 20 74 65 73 "....." FROM tes
7980: 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d ts WHERE run_id=
7990: 3f 20 22 0a 09 09 09 09 28 69 66 20 73 74 61 74 ? ".....(if stat
79a0: 65 73 2d 71 72 79 20 20 20 28 63 6f 6e 63 20 22 es-qry (conc "
79b0: 20 41 4e 44 20 22 20 73 74 61 74 65 73 2d 71 72 AND " states-qr
79c0: 79 29 20 20 20 22 22 29 0a 09 09 09 09 28 69 66 y) "").....(if
79d0: 20 73 74 61 74 75 73 65 73 2d 71 72 79 20 28 63 statuses-qry (c
79e0: 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 onc " AND " stat
79f0: 75 73 65 73 2d 71 72 79 29 20 22 22 29 0a 09 09 uses-qry) "")...
7a00: 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 74 63 ..(if tests-matc
7a10: 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 41 4e h-qry (conc " AN
7a20: 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 63 68 D (" tests-match
7a30: 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 0a 09 -qry ") ") "")..
7a40: 09 09 09 28 63 61 73 65 20 73 6f 72 74 2d 62 79 ...(case sort-by
7a50: 0a 09 09 09 09 20 20 28 28 72 75 6e 64 69 72 29 ..... ((rundir)
7a60: 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 " ORDER BY
7a70: 6c 65 6e 67 74 68 28 72 75 6e 64 69 72 29 20 44 length(rundir) D
7a80: 45 53 43 3b 22 29 0a 09 09 09 09 20 20 28 28 65 ESC;")..... ((e
7a90: 76 65 6e 74 5f 74 69 6d 65 29 20 22 20 4f 52 44 vent_time) " ORD
7aa0: 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 ER BY event_time
7ab0: 20 41 53 43 3b 22 29 0a 09 09 09 09 20 20 28 65 ASC;")..... (e
7ac0: 6c 73 65 20 20 20 20 20 20 20 20 20 22 3b 22 29 lse ";")
7ad0: 29 0a 09 09 09 20 29 29 29 0a 20 20 20 20 28 64 ).... ))). (d
7ae0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7af0: 38 20 22 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 8 "db:get-tests-
7b00: 66 6f 72 2d 72 75 6e 20 71 72 79 3d 22 20 71 72 for-run qry=" qr
7b10: 79 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a y). (sqlite3:
7b20: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 for-each-row .
7b30: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 (lambda (a .
7b40: 62 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 b) ;; id run-id
7b50: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
7b60: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
7b70: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
7b80: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
7b90: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
7ba0: 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n-duration final
7bb0: 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 20 -logf comment).
7bc0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
7bd0: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 (cons (apply vec
7be0: 74 6f 72 20 61 20 62 29 20 72 65 73 29 29 29 20 tor a b) res)))
7bf0: 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 ;; id run-id tes
7c00: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
7c10: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
7c20: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
7c30: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
7c40: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 item-path run-d
7c50: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c 6f uration final-lo
7c60: 67 66 20 63 6f 6d 6d 65 6e 74 29 20 72 65 73 29 gf comment) res)
7c70: 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 )). db .
7c80: 20 71 72 79 0a 20 20 20 20 20 72 75 6e 2d 69 64 qry. run-id
7c90: 0a 20 20 20 20 20 3b 3b 20 28 69 66 20 74 65 73 . ;; (if tes
7ca0: 74 70 61 74 74 20 74 65 73 74 70 61 74 74 20 22 tpatt testpatt "
7cb0: 25 22 29 0a 20 20 20 20 20 3b 3b 20 28 69 66 20 %"). ;; (if
7cc0: 69 74 65 6d 70 61 74 74 20 69 74 65 6d 70 61 74 itempatt itempat
7cd0: 74 20 22 25 22 29 29 0a 20 20 20 20 20 29 0a 20 t "%")). ).
7ce0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
7cf0: 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d info 11 "db:get-
7d00: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 53 54 tests-for-run ST
7d10: 41 52 54 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e ART run-id=" run
7d20: 2d 69 64 20 22 2c 20 74 65 73 74 70 61 74 74 3d -id ", testpatt=
7d30: 22 20 74 65 73 74 70 61 74 74 20 22 2c 20 73 74 " testpatt ", st
7d40: 61 74 65 73 3d 22 20 73 74 61 74 65 73 20 22 2c ates=" states ",
7d50: 20 73 74 61 74 75 73 65 73 3d 22 20 73 74 61 74 statuses=" stat
7d60: 75 73 65 73 20 22 2c 20 6e 6f 74 2d 69 6e 3d 22 uses ", not-in="
7d70: 20 6e 6f 74 2d 69 6e 20 22 2c 20 73 6f 72 74 2d not-in ", sort-
7d80: 62 79 3d 22 20 73 6f 72 74 2d 62 79 29 0a 20 20 by=" sort-by).
7d90: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 74 68 69 73 res))..;; this
7da0: 20 6f 6e 65 20 69 73 20 61 20 62 69 74 20 62 72 one is a bit br
7db0: 6f 6b 65 6e 20 42 55 47 20 46 49 58 4d 45 0a 28 oken BUG FIXME.(
7dc0: 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 define (db:delet
7dd0: 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f e-test-step-reco
7de0: 72 64 73 20 64 62 20 74 65 73 74 2d 69 64 29 0a rds db test-id).
7df0: 20 20 3b 3b 20 42 72 65 61 6b 69 6e 67 20 69 74 ;; Breaking it
7e00: 20 69 6e 74 6f 20 74 77 6f 20 71 75 65 72 69 65 into two querie
7e10: 73 20 66 6f 72 20 62 65 74 74 65 72 20 66 69 6c s for better fil
7e20: 65 20 61 63 63 65 73 73 20 69 6e 74 65 72 6c 65 e access interle
7e30: 61 76 69 6e 67 0a 20 20 28 6c 65 74 2a 20 28 28 aving. (let* ((
7e40: 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 tdb (db:open-tes
7e50: 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
7e60: 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 db test-id))).
7e70: 20 20 3b 3b 20 74 65 73 74 20 64 62 27 73 20 63 ;; test db's c
7e80: 61 6e 20 67 6f 20 61 77 61 79 20 2d 20 6d 75 73 an go away - mus
7e90: 74 20 63 68 65 63 6b 20 65 76 65 72 79 20 74 69 t check every ti
7ea0: 6d 65 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 me. (if tdb..
7eb0: 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
7ec0: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
7ed0: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
7ee0: 5f 73 74 65 70 73 3b 22 29 0a 09 20 20 28 73 71 _steps;").. (sq
7ef0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 lite3:execute td
7f00: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 b "DELETE FROM t
7f10: 65 73 74 5f 64 61 74 61 3b 22 29 0a 09 20 20 28 est_data;").. (
7f20: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
7f30: 21 20 74 64 62 29 29 29 29 29 0a 0a 3b 3b 20 0a ! tdb)))))..;; .
7f40: 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 (define (db:dele
7f50: 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 te-test-records
7f60: 64 62 20 74 64 62 20 74 65 73 74 2d 69 64 20 23 db tdb test-id #
7f70: 21 6b 65 79 20 28 66 6f 72 63 65 20 23 66 29 29 !key (force #f))
7f80: 0a 20 20 28 69 66 20 74 64 62 20 0a 20 20 20 20 . (if tdb .
7f90: 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 (begin..(sqlit
7fa0: 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 22 e3:execute tdb "
7fb0: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
7fc0: 5f 73 74 65 70 73 3b 22 29 0a 09 28 73 71 6c 69 _steps;")..(sqli
7fd0: 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 20 te3:execute tdb
7fe0: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 "DELETE FROM tes
7ff0: 74 5f 64 61 74 61 3b 22 29 29 29 0a 20 20 3b 3b t_data;"))). ;;
8000: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
8010: 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f e db "DELETE FRO
8020: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 M tests WHERE id
8030: 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 29 0a 20 =?;" test-id)).
8040: 20 28 69 66 20 64 62 20 0a 20 20 20 20 20 20 28 (if db . (
8050: 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 65 33 3a begin..(sqlite3:
8060: 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 execute db "DELE
8070: 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 TE FROM test_ste
8080: 70 73 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 ps WHERE test_id
8090: 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 0a 09 28 =?;" test-id)..(
80a0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
80b0: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 db "DELETE FROM
80c0: 74 65 73 74 5f 64 61 74 61 20 20 57 48 45 52 45 test_data WHERE
80d0: 20 74 65 73 74 5f 69 64 3d 3f 3b 22 20 74 65 73 test_id=?;" tes
80e0: 74 2d 69 64 29 0a 09 28 69 66 20 66 6f 72 63 65 t-id)..(if force
80f0: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 .. (sqlite3:e
8100: 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 xecute db "DELET
8110: 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 E FROM tests WHE
8120: 52 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 RE id=?;" test-i
8130: 64 29 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 d).. (sqlite3
8140: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
8150: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
8160: 61 74 65 3d 27 44 45 4c 45 54 45 44 27 2c 73 74 ate='DELETED',st
8170: 61 74 75 73 3d 27 6e 2f 61 27 20 57 48 45 52 45 atus='n/a' WHERE
8180: 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 29 id=?;" test-id)
8190: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ))))..(define (d
81a0: 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 66 b:delete-tests-f
81b0: 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 or-run db run-id
81c0: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
81d0: 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 cute db "DELETE
81e0: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
81f0: 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 72 75 6e 2d run_id=?;" run-
8200: 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 id))..(define (d
8210: 62 3a 64 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c b:delete-old-del
8220: 65 74 65 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 eted-test-record
8230: 73 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 74 s db). (let ((t
8240: 61 72 67 74 69 6d 65 20 28 2d 20 28 63 75 72 72 argtime (- (curr
8250: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2a 20 33 ent-seconds)(* 3
8260: 30 20 32 34 20 36 30 20 36 30 29 29 29 29 20 3b 0 24 60 60)))) ;
8270: 3b 20 6f 6e 65 20 6d 6f 6e 74 68 20 69 6e 20 74 ; one month in t
8280: 68 65 20 70 61 73 74 0a 20 20 20 20 28 73 71 6c he past. (sql
8290: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
82a0: 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 "DELETE FROM tes
82b0: 74 73 20 57 48 45 52 45 20 73 74 61 74 65 3d 27 ts WHERE state='
82c0: 44 45 4c 45 54 45 44 27 20 41 4e 44 20 65 76 65 DELETED' AND eve
82d0: 6e 74 5f 74 69 6d 65 3c 3f 3b 22 20 74 61 72 67 nt_time<?;" targ
82e0: 74 69 6d 65 29 29 29 0a 0a 3b 3b 20 73 65 74 20 time)))..;; set
82f0: 74 65 73 74 73 20 77 69 74 68 20 73 74 61 74 65 tests with state
8300: 20 63 75 72 72 73 74 61 74 65 20 61 6e 64 20 73 currstate and s
8310: 74 61 74 75 73 20 63 75 72 72 73 74 61 74 75 73 tatus currstatus
8320: 20 74 6f 20 6e 65 77 73 74 61 74 65 20 61 6e 64 to newstate and
8330: 20 6e 65 77 73 74 61 74 75 73 0a 3b 3b 20 75 73 newstatus.;; us
8340: 65 20 63 75 72 72 73 74 61 74 65 20 3d 20 23 66 e currstate = #f
8350: 20 61 6e 64 20 6f 72 20 63 75 72 72 73 74 61 74 and or currstat
8360: 75 73 20 3d 20 23 66 20 74 6f 20 61 70 70 6c 79 us = #f to apply
8370: 20 74 6f 20 61 6e 79 20 73 74 61 74 65 20 6f 72 to any state or
8380: 20 73 74 61 74 75 73 20 72 65 73 70 65 63 74 69 status respecti
8390: 76 65 6c 79 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a vely.;; WARNING:
83a0: 20 53 51 4c 20 69 6e 6a 65 63 74 69 6f 6e 20 72 SQL injection r
83b0: 69 73 6b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a isk.(define (db:
83c0: 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
83d0: 73 74 61 74 75 73 20 64 62 20 72 75 6e 2d 69 64 status db run-id
83e0: 20 74 65 73 74 6e 61 6d 65 73 20 63 75 72 72 73 testnames currs
83f0: 74 61 74 65 20 63 75 72 72 73 74 61 74 75 73 20 tate currstatus
8400: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 newstate newstat
8410: 75 73 29 0a 20 20 28 66 6f 72 2d 65 61 63 68 20 us). (for-each
8420: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 6e 61 6d (lambda (testnam
8430: 65 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 e).. (let (
8440: 28 71 72 79 20 28 63 6f 6e 63 20 22 55 50 44 41 (qry (conc "UPDA
8450: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
8460: 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 57 48 te=?,status=? WH
8470: 45 52 45 20 22 0a 09 09 09 20 20 20 20 20 20 20 ERE "....
8480: 28 69 66 20 63 75 72 72 73 74 61 74 65 20 20 28 (if currstate (
8490: 63 6f 6e 63 20 22 73 74 61 74 65 3d 27 22 20 63 conc "state='" c
84a0: 75 72 72 73 74 61 74 65 20 22 27 20 41 4e 44 20 urrstate "' AND
84b0: 22 29 20 22 22 29 0a 09 09 09 20 20 20 20 20 20 ") "")....
84c0: 20 28 69 66 20 63 75 72 72 73 74 61 74 75 73 20 (if currstatus
84d0: 28 63 6f 6e 63 20 22 73 74 61 74 75 73 3d 27 22 (conc "status='"
84e0: 20 63 75 72 72 73 74 61 74 75 73 20 22 27 20 41 currstatus "' A
84f0: 4e 44 20 22 29 20 22 22 29 0a 09 09 09 20 20 20 ND ") "")....
8500: 20 20 20 20 22 20 72 75 6e 5f 69 64 3d 3f 20 41 " run_id=? A
8510: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
8520: 44 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 68 D NOT (item_path
8530: 3d 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 ='' AND testname
8540: 20 69 6e 20 28 53 45 4c 45 43 54 20 44 49 53 54 in (SELECT DIST
8550: 49 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 INCT testname FR
8560: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 74 OM tests WHERE t
8570: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
8580: 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 3b em_path != ''));
8590: 22 29 29 29 0a 09 09 3b 3b 28 64 65 62 75 67 3a ")))...;;(debug:
85a0: 70 72 69 6e 74 20 30 20 22 51 52 59 3a 20 22 20 print 0 "QRY: "
85b0: 71 72 79 29 0a 09 09 28 73 71 6c 69 74 65 33 3a qry)...(sqlite3:
85c0: 65 78 65 63 75 74 65 20 64 62 20 71 72 79 20 72 execute db qry r
85d0: 75 6e 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e un-id newstate n
85e0: 65 77 73 74 61 74 75 73 20 74 65 73 74 6e 61 6d ewstatus testnam
85f0: 65 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 09 20 e testname)))..
8600: 20 20 20 74 65 73 74 6e 61 6d 65 73 29 29 0a 0a testnames))..
8610: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 64 65 6c (define (cdb:del
8620: 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 ete-tests-in-sta
8630: 74 65 20 7a 6d 71 73 6f 63 6b 65 74 20 72 75 6e te zmqsocket run
8640: 2d 69 64 20 73 74 61 74 65 29 0a 20 20 28 63 64 -id state). (cd
8650: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d b:client-call zm
8660: 71 73 6f 63 6b 65 74 20 27 64 65 6c 65 74 65 2d qsocket 'delete-
8670: 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 65 20 23 tests-in-state #
8680: 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 t *default-numtr
8690: 69 65 73 2a 20 72 75 6e 2d 69 64 20 73 74 61 74 ies* run-id stat
86a0: 65 29 29 0a 0a 3b 3b 20 73 70 65 65 64 20 75 70 e))..;; speed up
86b0: 20 66 6f 72 20 63 6f 6d 6d 6f 6e 20 63 61 73 65 for common case
86c0: 73 20 77 69 74 68 20 61 20 6c 69 74 74 6c 65 20 s with a little
86d0: 6c 6f 67 69 63 0a 28 64 65 66 69 6e 65 20 28 64 logic.(define (d
86e0: 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 b:test-set-state
86f0: 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 20 64 62 -status-by-id db
8700: 20 74 65 73 74 2d 69 64 20 6e 65 77 73 74 61 74 test-id newstat
8710: 65 20 6e 65 77 73 74 61 74 75 73 20 6e 65 77 63 e newstatus newc
8720: 6f 6d 6d 65 6e 74 29 0a 20 20 28 63 6f 6e 64 0a omment). (cond.
8730: 20 20 20 28 28 61 6e 64 20 6e 65 77 73 74 61 74 ((and newstat
8740: 65 20 6e 65 77 73 74 61 74 75 73 20 6e 65 77 63 e newstatus newc
8750: 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 28 73 71 6c omment). (sql
8760: 69 74 65 33 3a 65 78 65 63 74 75 74 65 20 64 62 ite3:exectute db
8770: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
8780: 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 ET state=?,statu
8790: 73 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 s=?,comment=? WH
87a0: 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 ERE id=?;" newst
87b0: 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 ate newstatus te
87c0: 73 74 2d 69 64 29 29 0a 20 20 20 28 28 61 6e 64 st-id)). ((and
87d0: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
87e0: 74 75 73 29 0a 20 20 20 20 28 73 71 6c 69 74 65 tus). (sqlite
87f0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 3:execute db "UP
8800: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 DATE tests SET s
8810: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 20 tate=?,status=?
8820: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 WHERE id=?;" new
8830: 73 74 61 74 65 20 6e 65 77 73 74 61 74 75 73 20 state newstatus
8840: 74 65 73 74 2d 69 64 29 29 0a 20 20 20 28 65 6c test-id)). (el
8850: 73 65 0a 20 20 20 20 28 69 66 20 6e 65 77 73 74 se. (if newst
8860: 61 74 65 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ate (sqlite3:e
8870: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
8880: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
8890: 65 3d 3f 20 20 20 57 48 45 52 45 20 69 64 3d 3f e=? WHERE id=?
88a0: 3b 22 20 6e 65 77 73 74 61 74 65 20 20 20 74 65 ;" newstate te
88b0: 73 74 2d 69 64 29 29 0a 20 20 20 20 28 69 66 20 st-id)). (if
88c0: 6e 65 77 73 74 61 74 75 73 20 20 28 73 71 6c 69 newstatus (sqli
88d0: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
88e0: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
88f0: 20 73 74 61 74 75 73 3d 3f 20 20 57 48 45 52 45 status=? WHERE
8900: 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 61 74 75 id=?;" newstatu
8910: 73 20 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20 s test-id)).
8920: 20 28 69 66 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 (if newcomment
8930: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
8940: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
8950: 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 s SET comment=?
8960: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 WHERE id=?;" new
8970: 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d 69 64 29 comment test-id)
8980: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ))))..(define (d
8990: 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 b:test-set-state
89a0: 2d 73 74 61 74 75 73 2d 62 79 2d 72 75 6e 2d 69 -status-by-run-i
89b0: 64 2d 74 65 73 74 6e 61 6d 65 20 64 62 20 72 75 d-testname db ru
89c0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
89d0: 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73 20 tem-path status
89e0: 73 74 61 74 65 29 0a 20 20 28 73 71 6c 69 74 65 state). (sqlite
89f0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 3:execute db "UP
8a00: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 DATE tests SET s
8a10: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c tate=?,status=?,
8a20: 65 76 65 6e 74 5f 74 69 6d 65 3d 73 74 72 66 74 event_time=strft
8a30: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 ime('%s','now')
8a40: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
8a50: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
8a60: 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 D item_path=?;"
8a70: 0a 09 09 20 20 20 73 74 61 74 65 20 73 74 61 74 ... state stat
8a80: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e us run-id test-n
8a90: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a ame item-path)).
8aa0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
8ab0: 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e -count-tests-run
8ac0: 6e 69 6e 67 20 64 62 29 0a 20 20 28 6c 65 74 20 ning db). (let
8ad0: 28 28 72 65 73 20 30 29 29 0a 20 20 20 20 28 73 ((res 0)). (s
8ae0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
8af0: 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 row. (lambda
8b00: 20 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 (count).
8b10: 28 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 29 (set! res count)
8b20: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 ). db. "
8b30: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
8b40: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
8b50: 45 20 73 74 61 74 65 20 69 6e 20 28 27 52 55 4e E state in ('RUN
8b60: 4e 49 4e 47 27 2c 27 4c 41 55 4e 43 48 45 44 27 NING','LAUNCHED'
8b70: 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 ,'REMOTEHOSTSTAR
8b80: 54 27 29 3b 22 29 0a 20 20 20 20 72 65 73 29 29 T');"). res))
8b90: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 ..(define (db:ge
8ba0: 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 t-count-tests-ru
8bb0: 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 nning-in-jobgrou
8bc0: 70 20 64 62 20 6a 6f 62 67 72 6f 75 70 29 0a 20 p db jobgroup).
8bd0: 20 28 69 66 20 28 6e 6f 74 20 6a 6f 62 67 72 6f (if (not jobgro
8be0: 75 70 29 0a 20 20 20 20 20 20 30 20 3b 3b 20 0a up). 0 ;; .
8bf0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
8c00: 20 30 29 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 0))..(sqlite3:f
8c10: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 6c or-each-row.. (l
8c20: 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 09 20 ambda (count)..
8c30: 20 20 28 73 65 74 21 20 72 65 73 20 63 6f 75 6e (set! res coun
8c40: 74 29 29 0a 09 20 64 62 0a 09 20 22 53 45 4c 45 t)).. db.. "SELE
8c50: 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
8c60: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 73 74 M tests WHERE st
8c70: 61 74 65 20 3d 20 27 52 55 4e 4e 49 4e 47 27 20 ate = 'RUNNING'
8c80: 4f 52 20 73 74 61 74 65 20 3d 20 27 4c 41 55 4e OR state = 'LAUN
8c90: 43 48 45 44 27 20 4f 52 20 73 74 61 74 65 20 3d CHED' OR state =
8ca0: 20 27 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 'REMOTEHOSTSTAR
8cb0: 54 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T'.
8cc0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 20 69 6e 20 AND testname in
8cd0: 28 53 45 4c 45 43 54 20 74 65 73 74 6e 61 6d 65 (SELECT testname
8ce0: 20 46 52 4f 4d 20 74 65 73 74 5f 6d 65 74 61 20 FROM test_meta
8cf0: 57 48 45 52 45 20 6a 6f 62 67 72 6f 75 70 3d 3f WHERE jobgroup=?
8d00: 3b 22 0a 09 20 6a 6f 62 67 72 6f 75 70 29 0a 09 ;".. jobgroup)..
8d10: 72 65 73 29 29 29 0a 0a 3b 3b 20 64 6f 6e 65 20 res)))..;; done
8d20: 77 69 74 68 20 72 75 6e 20 77 68 65 6e 3a 0a 3b with run when:.;
8d30: 3b 20 20 20 30 20 74 65 73 74 73 20 69 6e 20 4c ; 0 tests in L
8d40: 41 55 4e 43 48 45 44 2c 20 4e 4f 54 5f 53 54 41 AUNCHED, NOT_STA
8d50: 52 54 45 44 2c 20 52 45 4d 4f 54 45 48 4f 53 54 RTED, REMOTEHOST
8d60: 53 54 41 52 54 2c 20 52 55 4e 4e 49 4e 47 0a 28 START, RUNNING.(
8d70: 64 65 66 69 6e 65 20 28 64 62 3a 65 73 74 69 6d define (db:estim
8d80: 61 74 65 64 2d 74 65 73 74 73 2d 72 65 6d 61 69 ated-tests-remai
8d90: 6e 69 6e 67 20 64 62 20 72 75 6e 2d 69 64 29 0a ning db run-id).
8da0: 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 29 (let ((res 0))
8db0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
8dc0: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
8dd0: 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a (lambda (count).
8de0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
8df0: 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 64 62 count)). db
8e00: 20 3b 3b 20 4e 42 2f 2f 20 4b 49 4c 4c 52 45 51 ;; NB// KILLREQ
8e10: 20 6d 65 61 6e 73 20 74 68 65 20 6a 6f 62 73 20 means the jobs
8e20: 69 73 20 73 74 69 6c 6c 20 70 72 6f 62 61 62 6c is still probabl
8e30: 79 20 72 75 6e 6e 69 6e 67 0a 20 20 20 20 20 22 y running. "
8e40: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
8e50: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
8e60: 45 20 73 74 61 74 65 20 69 6e 20 28 27 4c 41 55 E state in ('LAU
8e70: 4e 43 48 45 44 27 2c 27 4e 4f 54 5f 53 54 41 52 NCHED','NOT_STAR
8e80: 54 45 44 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 TED','REMOTEHOST
8e90: 53 54 41 52 54 27 2c 27 52 55 4e 4e 49 4e 47 27 START','RUNNING'
8ea0: 2c 27 4b 49 4c 4c 52 45 51 27 29 20 41 4e 44 20 ,'KILLREQ') AND
8eb0: 72 75 6e 5f 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 run_id=?;" run-i
8ec0: 64 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b d). res))..;;
8ed0: 20 6d 61 70 20 72 75 6e 2d 69 64 2c 20 74 65 73 map run-id, tes
8ee0: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 tname item-path
8ef0: 74 6f 20 74 65 73 74 2d 69 64 0a 28 64 65 66 69 to test-id.(defi
8f00: 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d ne (db:get-test-
8f10: 69 64 2d 63 61 63 68 65 64 20 64 62 20 72 75 6e id-cached db run
8f20: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 -id testname ite
8f30: 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 m-path). (let*
8f40: 28 28 74 65 73 74 2d 6b 65 79 20 28 63 6f 6e 63 ((test-key (conc
8f50: 20 72 75 6e 2d 69 64 20 22 2d 22 20 74 65 73 74 run-id "-" test
8f60: 6e 61 6d 65 20 22 2d 22 20 69 74 65 6d 2d 70 61 name "-" item-pa
8f70: 74 68 29 29 0a 09 20 28 72 65 73 20 20 20 20 20 th)).. (res
8f80: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
8f90: 2f 64 65 66 61 75 6c 74 20 2a 74 65 73 74 2d 69 /default *test-i
8fa0: 64 73 2a 20 74 65 73 74 2d 6b 65 79 20 23 66 29 ds* test-key #f)
8fb0: 29 29 0a 20 20 20 20 28 69 66 20 72 65 73 20 0a )). (if res .
8fc0: 09 72 65 73 0a 09 28 62 65 67 69 6e 0a 09 20 20 .res..(begin..
8fd0: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
8fe0: 68 2d 72 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 h-row.. (lambd
8ff0: 61 20 28 69 64 29 20 3b 3b 20 20 72 75 6e 2d 69 a (id) ;; run-i
9000: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
9010: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
9020: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
9030: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
9040: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
9050: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
9060: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 al_logf comment
9070: 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 72 65 ).. (set! re
9080: 73 20 69 64 29 29 20 3b 3b 20 28 76 65 63 74 6f s id)) ;; (vecto
9090: 72 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 r id run-id test
90a0: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
90b0: 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 s event-time hos
90c0: 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 t cpuload diskfr
90d0: 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 ee uname rundir
90e0: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 item-path run_du
90f0: 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 ration final_log
9100: 66 20 63 6f 6d 6d 65 6e 74 20 29 29 29 0a 09 20 f comment )))..
9110: 20 20 64 62 20 0a 09 20 20 20 22 53 45 4c 45 43 db .. "SELEC
9120: 54 20 69 64 20 46 52 4f 4d 20 74 65 73 74 73 20 T id FROM tests
9130: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
9140: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
9150: 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 0a D item_path=?;".
9160: 09 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e . run-id testn
9170: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 ame item-path)..
9180: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
9190: 74 21 20 2a 74 65 73 74 2d 69 64 73 2a 20 74 65 t! *test-ids* te
91a0: 73 74 2d 6b 65 79 20 72 65 73 29 0a 09 20 20 72 st-key res).. r
91b0: 65 73 29 29 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 es))))..;; map r
91c0: 75 6e 2d 69 64 2c 20 74 65 73 74 6e 61 6d 65 20 un-id, testname
91d0: 69 74 65 6d 2d 70 61 74 68 20 74 6f 20 74 65 73 item-path to tes
91e0: 74 2d 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 t-id.(define (db
91f0: 3a 67 65 74 2d 74 65 73 74 2d 69 64 2d 6e 6f 74 :get-test-id-not
9200: 2d 63 61 63 68 65 64 20 64 62 20 72 75 6e 2d 69 -cached db run-i
9210: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
9220: 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 path). (let* ((
9230: 72 65 73 20 23 66 29 29 0a 20 20 20 20 28 73 71 res #f)). (sq
9240: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
9250: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
9260: 28 69 64 29 20 3b 3b 20 20 72 75 6e 2d 69 64 20 (id) ;; run-id
9270: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
9280: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
9290: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
92a0: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
92b0: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
92c0: 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n_duration final
92d0: 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 29 0a _logf comment ).
92e0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
92f0: 20 69 64 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 id)) ;; (vector
9300: 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e id run-id testn
9310: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
9320: 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 event-time host
9330: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
9340: 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 e uname rundir i
9350: 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 tem-path run_dur
9360: 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 ation final_logf
9370: 20 63 6f 6d 6d 65 6e 74 20 29 29 29 0a 20 20 20 comment ))).
9380: 20 20 64 62 20 0a 20 20 20 20 20 22 53 45 4c 45 db . "SELE
9390: 43 54 20 69 64 20 46 52 4f 4d 20 74 65 73 74 73 CT id FROM tests
93a0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
93b0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
93c0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 ND item_path=?;"
93d0: 0a 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 73 . run-id tes
93e0: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 tname item-path)
93f0: 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 . res))..(def
9400: 69 6e 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d ine db:get-test-
9410: 69 64 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 id db:get-test-i
9420: 64 2d 6e 6f 74 2d 63 61 63 68 65 64 29 0a 0a 3b d-not-cached)..;
9430: 3b 20 67 69 76 65 6e 20 61 20 74 65 73 74 2d 69 ; given a test-i
9440: 6e 66 6f 20 72 65 63 6f 72 64 2c 20 70 61 74 63 nfo record, patc
9450: 68 20 69 6e 20 74 68 65 20 6c 61 74 65 73 74 20 h in the latest
9460: 64 61 74 61 20 66 72 6f 6d 20 74 68 65 20 74 65 data from the te
9470: 73 74 64 61 74 2e 64 62 20 66 69 6c 65 0a 3b 3b stdat.db file.;;
9480: 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 74 65 found in the te
9490: 73 74 20 72 75 6e 20 64 69 72 65 63 74 6f 72 79 st run directory
94a0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 70 61 74 .(define (db:pat
94b0: 63 68 2d 74 64 62 2d 64 61 74 61 2d 69 6e 74 6f ch-tdb-data-into
94c0: 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 74 65 -test-info db te
94d0: 73 74 2d 69 64 20 72 65 73 29 0a 20 20 28 6c 65 st-id res). (le
94e0: 74 20 28 28 74 64 62 20 28 64 62 3a 6f 70 65 6e t ((tdb (db:open
94f0: 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 -test-db-by-test
9500: 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 -id db test-id))
9510: 29 0a 20 20 20 20 3b 3b 20 67 65 74 20 73 74 61 ). ;; get sta
9520: 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 66 72 te and status fr
9530: 6f 6d 20 6d 65 67 61 74 65 73 74 2e 64 62 20 69 om megatest.db i
9540: 6e 20 72 65 61 6c 20 74 69 6d 65 0a 20 20 20 20 n real time.
9550: 3b 3b 20 6f 74 68 65 72 20 66 69 65 6c 64 73 20 ;; other fields
9560: 74 68 61 74 20 70 65 72 68 61 70 73 20 73 68 6f that perhaps sho
9570: 75 6c 64 20 62 65 20 75 70 64 61 74 65 64 3a 0a uld be updated:.
9580: 20 20 20 20 3b 3b 20 20 20 66 61 69 6c 5f 63 6f ;; fail_co
9590: 75 6e 74 0a 20 20 20 20 3b 3b 20 20 20 70 61 73 unt. ;; pas
95a0: 73 5f 63 6f 75 6e 74 0a 20 20 20 20 3b 3b 20 20 s_count. ;;
95b0: 20 66 69 6e 61 6c 5f 6c 6f 67 66 0a 20 20 20 20 final_logf.
95c0: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
95d0: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 h-row. (lamb
95e0: 64 61 20 28 73 74 61 74 65 20 73 74 61 74 75 73 da (state status
95f0: 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 final_logf).
9600: 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 (db:test-set
9610: 2d 73 74 61 74 65 21 20 20 20 20 20 20 20 20 72 -state! r
9620: 65 73 20 73 74 61 74 65 29 0a 20 20 20 20 20 20 es state).
9630: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
9640: 61 74 75 73 21 20 20 20 20 20 20 20 72 65 73 20 atus! res
9650: 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 20 28 status). (
9660: 64 62 3a 74 65 73 74 2d 73 65 74 2d 66 69 6e 61 db:test-set-fina
9670: 6c 5f 6c 6f 67 66 21 20 20 20 72 65 73 20 66 69 l_logf! res fi
9680: 6e 61 6c 5f 6c 6f 67 66 29 29 0a 20 20 20 20 20 nal_logf)).
9690: 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 db. "SELECT
96a0: 73 74 61 74 65 2c 73 74 61 74 75 73 2c 66 69 6e state,status,fin
96b0: 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20 74 65 73 al_logf FROM tes
96c0: 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a ts WHERE id=?;".
96d0: 20 20 20 20 20 74 65 73 74 2d 69 64 29 0a 20 20 test-id).
96e0: 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 67 69 (if tdb..(begi
96f0: 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 6f n.. (sqlite3:fo
9700: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 r-each-row.. (
9710: 6c 61 6d 62 64 61 20 28 75 70 64 61 74 65 5f 74 lambda (update_t
9720: 69 6d 65 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ime cpuload disk
9730: 5f 66 72 65 65 20 72 75 6e 5f 64 75 72 61 74 69 _free run_durati
9740: 6f 6e 29 0a 09 20 20 20 20 20 28 64 62 3a 74 65 on).. (db:te
9750: 73 74 2d 73 65 74 2d 63 70 75 6c 6f 61 64 21 20 st-set-cpuload!
9760: 20 20 20 20 20 72 65 73 20 63 70 75 6c 6f 61 64 res cpuload
9770: 29 0a 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 ).. (db:test
9780: 2d 73 65 74 2d 64 69 73 6b 66 72 65 65 21 20 20 -set-diskfree!
9790: 20 20 20 72 65 73 20 64 69 73 6b 5f 66 72 65 65 res disk_free
97a0: 29 0a 09 20 20 20 20 20 28 64 62 3a 74 65 73 74 ).. (db:test
97b0: 2d 73 65 74 2d 72 75 6e 5f 64 75 72 61 74 69 6f -set-run_duratio
97c0: 6e 21 20 72 65 73 20 72 75 6e 5f 64 75 72 61 74 n! res run_durat
97d0: 69 6f 6e 29 29 0a 09 20 20 20 74 64 62 0a 09 20 ion)).. tdb..
97e0: 20 20 22 53 45 4c 45 43 54 20 75 70 64 61 74 65 "SELECT update
97f0: 5f 74 69 6d 65 2c 63 70 75 6c 6f 61 64 2c 64 69 _time,cpuload,di
9800: 73 6b 66 72 65 65 2c 72 75 6e 5f 64 75 72 61 74 skfree,run_durat
9810: 69 6f 6e 20 46 52 4f 4d 20 74 65 73 74 5f 72 75 ion FROM test_ru
9820: 6e 64 61 74 20 4f 52 44 45 52 20 42 59 20 69 64 ndat ORDER BY id
9830: 20 44 45 53 43 20 4c 49 4d 49 54 20 31 3b 22 29 DESC LIMIT 1;")
9840: 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e .. (sqlite3:fin
9850: 61 6c 69 7a 65 21 20 74 64 62 29 29 0a 09 3b 3b alize! tdb))..;;
9860: 20 69 66 20 74 68 65 20 74 65 73 74 20 64 62 20 if the test db
9870: 69 73 20 6e 6f 74 20 66 6f 75 6e 64 20 77 68 61 is not found wha
9880: 74 20 74 6f 20 64 6f 3f 0a 09 3b 3b 20 31 2e 20 t to do?..;; 1.
9890: 73 65 74 20 73 74 61 74 65 20 74 6f 20 44 45 4c set state to DEL
98a0: 45 54 45 44 0a 09 3b 3b 20 32 2e 20 73 65 74 20 ETED..;; 2. set
98b0: 73 74 61 74 75 73 20 74 6f 20 6e 2f 61 0a 09 28 status to n/a..(
98c0: 62 65 67 69 6e 0a 09 20 20 28 64 62 3a 74 65 73 begin.. (db:tes
98d0: 74 2d 73 65 74 2d 73 74 61 74 65 21 20 20 72 65 t-set-state! re
98e0: 73 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 s "NOT_STARTED")
98f0: 0a 09 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 .. (db:test-set
9900: 2d 73 74 61 74 75 73 21 20 72 65 73 20 22 6e 2f -status! res "n/
9910: 61 22 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 a")))))..(define
9920: 20 2a 6c 61 73 74 2d 74 65 73 74 2d 63 61 63 68 *last-test-cach
9930: 65 2d 64 65 6c 65 74 65 2a 20 28 63 75 72 72 65 e-delete* (curre
9940: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 0a 28 64 nt-seconds))..(d
9950: 65 66 69 6e 65 20 28 64 62 3a 63 6c 65 61 6e 2d efine (db:clean-
9960: 61 6c 6c 2d 63 61 63 68 65 73 29 0a 20 20 28 73 all-caches). (s
9970: 65 74 21 20 2a 74 65 73 74 2d 69 6e 66 6f 2a 20 et! *test-info*
9980: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
9990: 29 29 0a 20 20 28 73 65 74 21 20 2a 74 65 73 74 )). (set! *test
99a0: 2d 69 64 2d 63 61 63 68 65 2a 20 28 6d 61 6b 65 -id-cache* (make
99b0: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 0a -hash-table)))..
99c0: 3b 3b 20 47 65 74 20 74 65 73 74 20 64 61 74 61 ;; Get test data
99d0: 20 75 73 69 6e 67 20 74 65 73 74 5f 69 64 0a 28 using test_id.(
99e0: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
99f0: 65 73 74 2d 69 6e 66 6f 2d 63 61 63 68 65 64 2d est-info-cached-
9a00: 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 by-id db test-id
9a10: 29 0a 20 20 3b 3b 20 69 73 20 61 6c 6c 20 74 68 ). ;; is all th
9a20: 69 73 20 63 72 61 70 20 72 65 61 6c 6c 79 20 77 is crap really w
9a30: 6f 72 74 68 20 69 74 3f 20 49 20 73 6f 6d 65 68 orth it? I someh
9a40: 6f 77 20 64 6f 75 62 74 20 69 74 2e 0a 20 20 28 ow doubt it.. (
9a50: 6c 65 74 2a 20 28 28 6c 61 73 74 2d 64 65 6c 65 let* ((last-dele
9a60: 74 65 2d 73 74 72 20 28 64 62 3a 67 65 74 2d 76 te-str (db:get-v
9a70: 61 72 20 64 62 20 22 44 45 4c 45 54 45 44 5f 54 ar db "DELETED_T
9a80: 45 53 54 53 22 29 29 0a 09 20 28 6c 61 73 74 2d ESTS")).. (last-
9a90: 64 65 6c 65 74 65 20 20 20 20 20 28 69 66 20 28 delete (if (
9aa0: 73 74 72 69 6e 67 3f 20 6c 61 73 74 2d 64 65 6c string? last-del
9ab0: 65 74 65 2d 73 74 72 29 28 73 74 72 69 6e 67 2d ete-str)(string-
9ac0: 3e 6e 75 6d 62 65 72 20 6c 61 73 74 2d 64 65 6c >number last-del
9ad0: 65 74 65 2d 73 74 72 29 20 23 66 29 29 29 0a 20 ete-str) #f))).
9ae0: 20 20 20 28 69 66 20 28 61 6e 64 20 6c 61 73 74 (if (and last
9af0: 2d 64 65 6c 65 74 65 20 28 3e 20 6c 61 73 74 2d -delete (> last-
9b00: 64 65 6c 65 74 65 20 2a 6c 61 73 74 2d 74 65 73 delete *last-tes
9b10: 74 2d 63 61 63 68 65 2d 64 65 6c 65 74 65 2a 29 t-cache-delete*)
9b20: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 )..(begin.. (se
9b30: 74 21 20 2a 74 65 73 74 2d 69 6e 66 6f 2a 20 28 t! *test-info* (
9b40: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
9b50: 29 0a 09 20 20 28 73 65 74 21 20 2a 74 65 73 74 ).. (set! *test
9b60: 2d 69 64 2d 63 61 63 68 65 2a 20 28 6d 61 6b 65 -id-cache* (make
9b70: 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 -hash-table))..
9b80: 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 74 65 73 (set! *last-tes
9b90: 74 2d 63 61 63 68 65 2d 64 65 6c 65 74 65 2a 20 t-cache-delete*
9ba0: 6c 61 73 74 2d 64 65 6c 65 74 65 29 0a 09 20 20 last-delete)..
9bb0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
9bc0: 6f 20 34 20 22 43 6c 65 61 72 69 6e 67 20 74 65 o 4 "Clearing te
9bd0: 73 74 20 64 61 74 61 20 63 61 63 68 65 22 29 29 st data cache"))
9be0: 29 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 74 65 )). (if (not te
9bf0: 73 74 2d 69 64 29 0a 20 20 20 20 20 20 28 62 65 st-id). (be
9c00: 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e gin..(debug:prin
9c10: 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 65 74 t-info 4 "db:get
9c20: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
9c30: 20 63 61 6c 6c 65 64 20 77 69 74 68 20 74 65 73 called with tes
9c40: 74 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 29 0a t-id=" test-id).
9c50: 09 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 2a .#f). (let*
9c60: 20 28 28 72 65 73 20 28 68 61 73 68 2d 74 61 62 ((res (hash-tab
9c70: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
9c80: 74 65 73 74 2d 69 6e 66 6f 2a 20 74 65 73 74 2d test-info* test-
9c90: 69 64 20 23 66 29 29 29 0a 09 28 69 66 20 28 61 id #f)))..(if (a
9ca0: 6e 64 20 72 65 73 0a 09 09 20 28 6d 65 6d 62 65 nd res... (membe
9cb0: 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 r (db:test-get-s
9cc0: 74 61 74 65 20 72 65 73 29 20 27 28 22 52 55 4e tate res) '("RUN
9cd0: 4e 49 4e 47 22 20 22 43 4f 4d 50 4c 45 54 45 44 NING" "COMPLETED
9ce0: 22 29 29 29 0a 09 20 20 20 20 28 64 62 3a 70 61 "))).. (db:pa
9cf0: 74 63 68 2d 74 64 62 2d 64 61 74 61 2d 69 6e 74 tch-tdb-data-int
9d00: 6f 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 74 o-test-info db t
9d10: 65 73 74 2d 69 64 20 72 65 73 29 0a 09 20 20 20 est-id res)..
9d20: 20 3b 3b 20 69 66 20 6e 6f 20 63 61 63 68 65 64 ;; if no cached
9d30: 20 76 61 6c 75 65 20 74 68 65 6e 20 66 75 6c 6c value then full
9d40: 20 72 65 61 64 20 61 6e 64 20 77 72 69 74 65 20 read and write
9d50: 74 6f 20 63 61 63 68 65 0a 09 20 20 20 20 28 62 to cache.. (b
9d60: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 71 6c egin.. (sql
9d70: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
9d80: 77 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 w.. (lambd
9d90: 61 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73 a (id run-id tes
9da0: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
9db0: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
9dc0: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
9dd0: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
9de0: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 item-path run_d
9df0: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f uration final_lo
9e00: 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 3b gf comment)... ;
9e10: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
9e20: 20 20 30 20 20 20 20 31 20 20 20 20 20 20 20 32 0 1 2
9e30: 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20 20 3 4
9e40: 20 20 20 20 20 20 35 20 20 20 20 20 20 20 36 20 5 6
9e50: 20 20 20 20 20 37 20 20 20 20 20 20 20 20 38 20 7 8
9e60: 20 20 20 20 39 20 20 20 20 20 31 30 20 20 20 20 9 10
9e70: 20 20 31 31 20 20 20 20 20 20 20 20 20 20 31 32 11 12
9e80: 20 20 20 20 20 20 20 20 20 20 31 33 20 20 20 20 13
9e90: 20 20 20 31 34 0a 09 09 20 28 73 65 74 21 20 72 14... (set! r
9ea0: 65 73 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 es (vector id ru
9eb0: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 n-id testname st
9ec0: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
9ed0: 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f -time host cpulo
9ee0: 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d ad diskfree unam
9ef0: 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 e rundir item-pa
9f00: 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 th run_duration
9f10: 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 final_logf comme
9f20: 6e 74 29 29 29 0a 09 20 20 20 20 20 20 20 64 62 nt))).. db
9f30: 20 0a 09 20 20 20 20 20 20 20 22 53 45 4c 45 43 .. "SELEC
9f40: 54 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 T id,run_id,test
9f50: 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 name,state,statu
9f60: 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 s,event_time,hos
9f70: 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 t,cpuload,diskfr
9f80: 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c ee,uname,rundir,
9f90: 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 item_path,run_du
9fa0: 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 ration,final_log
9fb0: 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 f,comment FROM t
9fc0: 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b ests WHERE id=?;
9fd0: 22 0a 09 20 20 20 20 20 20 20 74 65 73 74 2d 69 ".. test-i
9fe0: 64 29 0a 09 20 20 20 20 20 20 28 69 66 20 72 65 d).. (if re
9ff0: 73 20 28 64 62 3a 70 61 74 63 68 2d 74 64 62 2d s (db:patch-tdb-
a000: 64 61 74 61 2d 69 6e 74 6f 2d 74 65 73 74 2d 69 data-into-test-i
a010: 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 64 20 72 nfo db test-id r
a020: 65 73 29 29 0a 09 20 20 20 20 20 20 72 65 73 29 es)).. res)
a030: 29 29 29 29 0a 0a 3b 3b 20 47 65 74 20 74 65 73 ))))..;; Get tes
a040: 74 20 64 61 74 61 20 75 73 69 6e 67 20 74 65 73 t data using tes
a050: 74 5f 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 t_id.(define (db
a060: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 6e :get-test-info-n
a070: 6f 74 2d 63 61 63 68 65 64 2d 62 79 2d 69 64 20 ot-cached-by-id
a080: 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 28 69 db test-id). (i
a090: 66 20 28 6e 6f 74 20 74 65 73 74 2d 69 64 29 0a f (not test-id).
a0a0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 (begin..(d
a0b0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
a0c0: 34 20 22 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 4 "db:get-test-i
a0d0: 6e 66 6f 2d 62 79 2d 69 64 20 63 61 6c 6c 65 64 nfo-by-id called
a0e0: 20 77 69 74 68 20 74 65 73 74 2d 69 64 3d 22 20 with test-id="
a0f0: 74 65 73 74 2d 69 64 29 0a 09 23 66 29 0a 20 20 test-id)..#f).
a100: 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 (let ((res #
a110: 66 29 29 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f f))..(sqlite3:fo
a120: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 6c 61 r-each-row.. (la
a130: 6d 62 64 61 20 28 69 64 20 72 75 6e 2d 69 64 20 mbda (id run-id
a140: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
a150: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
a160: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
a170: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
a180: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
a190: 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n_duration final
a1a0: 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 _logf comment)..
a1b0: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
a1c0: 20 20 20 20 20 20 30 20 20 20 20 31 20 20 20 20 0 1
a1d0: 20 20 20 32 20 20 20 20 20 20 33 20 20 20 20 20 2 3
a1e0: 20 34 20 20 20 20 20 20 20 20 35 20 20 20 20 20 4 5
a1f0: 20 20 36 20 20 20 20 20 20 37 20 20 20 20 20 20 6 7
a200: 20 20 38 20 20 20 20 20 39 20 20 20 20 20 31 30 8 9 10
a210: 20 20 20 20 20 20 31 31 20 20 20 20 20 20 20 20 11
a220: 20 20 31 32 20 20 20 20 20 20 20 20 20 20 31 33 12 13
a230: 20 20 20 20 20 20 20 31 34 0a 09 20 20 20 28 73 14.. (s
a240: 65 74 21 20 72 65 73 20 28 76 65 63 74 6f 72 20 et! res (vector
a250: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 id run-id testna
a260: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
a270: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host
a280: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
a290: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it
a2a0: 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 em-path run_dura
a2b0: 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 tion final_logf
a2c0: 63 6f 6d 6d 65 6e 74 29 29 29 0a 09 20 64 62 20 comment))).. db
a2d0: 0a 09 20 22 53 45 4c 45 43 54 20 69 64 2c 72 75 .. "SELECT id,ru
a2e0: 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 n_id,testname,st
a2f0: 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 ate,status,event
a300: 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f _time,host,cpulo
a310: 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d ad,diskfree,unam
a320: 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 e,rundir,item_pa
a330: 74 68 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c th,run_duration,
a340: 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 final_logf,comme
a350: 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 nt FROM tests WH
a360: 45 52 45 20 69 64 3d 3f 3b 22 0a 09 20 74 65 73 ERE id=?;".. tes
a370: 74 2d 69 64 29 0a 09 72 65 73 29 29 29 0a 0a 28 t-id)..res)))..(
a380: 64 65 66 69 6e 65 20 64 62 3a 67 65 74 2d 74 65 define db:get-te
a390: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 st-info-by-id db
a3a0: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 6e :get-test-info-n
a3b0: 6f 74 2d 63 61 63 68 65 64 2d 62 79 2d 69 64 29 ot-cached-by-id)
a3c0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 ..(define (db:ge
a3d0: 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 t-test-info db r
a3e0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
a3f0: 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 64 62 3a tem-path). (db:
a400: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
a410: 2d 69 64 20 64 62 20 28 64 62 3a 67 65 74 2d 74 -id db (db:get-t
a420: 65 73 74 2d 69 64 20 64 62 20 72 75 6e 2d 69 64 est-id db run-id
a430: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
a440: 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ath)))..(define
a450: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 63 6f 6d (db:test-set-com
a460: 6d 65 6e 74 20 64 62 20 74 65 73 74 2d 69 64 20 ment db test-id
a470: 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73 71 6c 69 comment). (sqli
a480: 74 65 33 3a 65 78 65 63 75 74 65 20 0a 20 20 20 te3:execute .
a490: 64 62 20 0a 20 20 20 22 55 50 44 41 54 45 20 74 db . "UPDATE t
a4a0: 65 73 74 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 ests SET comment
a4b0: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a =? WHERE id=?;".
a4c0: 20 20 20 63 6f 6d 6d 65 6e 74 20 74 65 73 74 2d comment test-
a4d0: 69 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 id))..(define (c
a4e0: 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 db:test-set-rund
a4f0: 69 72 21 20 7a 6d 71 73 6f 63 6b 65 74 20 72 75 ir! zmqsocket ru
a500: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
a510: 74 65 6d 2d 70 61 74 68 20 72 75 6e 64 69 72 29 tem-path rundir)
a520: 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 . (cdb:client-c
a530: 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 74 all zmqsocket 't
a540: 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 20 23 est-set-rundir #
a550: 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 t *default-numtr
a560: 69 65 73 2a 20 72 75 6e 64 69 72 20 72 75 6e 2d ies* rundir run-
a570: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
a580: 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 6e m-path))..(defin
a590: 65 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d e (cdb:test-set-
a5a0: 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 74 2d 69 rundir-by-test-i
a5b0: 64 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 74 d zmqsocket test
a5c0: 2d 69 64 20 72 75 6e 64 69 72 29 0a 20 20 28 63 -id rundir). (c
a5d0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a db:client-call z
a5e0: 6d 71 73 6f 63 6b 65 74 20 27 74 65 73 74 2d 73 mqsocket 'test-s
a5f0: 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 et-rundir-by-tes
a600: 74 2d 69 64 20 23 74 20 2a 64 65 66 61 75 6c 74 t-id #t *default
a610: 2d 6e 75 6d 74 72 69 65 73 2a 20 72 75 6e 64 69 -numtries* rundi
a620: 72 20 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 r test-id))..(de
a630: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 fine (db:test-ge
a640: 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 t-rundir-from-te
a650: 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 st-id db test-id
a660: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 ). (let ((res #
a670: 66 29 29 20 3b 3b 20 28 68 61 73 68 2d 74 61 62 f)) ;; (hash-tab
a680: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
a690: 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 test-paths* test
a6a0: 2d 69 64 20 23 66 29 29 29 0a 20 20 20 20 3b 3b -id #f))). ;;
a6b0: 20 28 69 66 20 72 65 73 0a 20 20 20 20 3b 3b 20 (if res. ;;
a6c0: 20 20 20 20 72 65 73 0a 20 20 20 20 3b 3b 20 20 res. ;;
a6d0: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 28 73 (begin. (s
a6e0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
a6f0: 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 row. (lambda
a700: 20 28 74 70 61 74 68 29 0a 20 20 20 20 20 20 20 (tpath).
a710: 28 73 65 74 21 20 72 65 73 20 74 70 61 74 68 29 (set! res tpath)
a720: 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 ). db .
a730: 22 53 45 4c 45 43 54 20 72 75 6e 64 69 72 20 46 "SELECT rundir F
a740: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
a750: 69 64 3d 3f 3b 22 0a 20 20 20 20 20 74 65 73 74 id=?;". test
a760: 2d 69 64 29 0a 20 20 20 20 3b 3b 20 28 68 61 73 -id). ;; (has
a770: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 h-table-set! *te
a780: 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 2d 69 st-paths* test-i
a790: 64 20 72 65 73 29 0a 20 20 20 20 72 65 73 29 29 d res). res))
a7a0: 20 3b 3b 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 ;; ))..(define
a7b0: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (cdb:test-set-lo
a7c0: 67 21 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 g! zmqsocket tes
a7d0: 74 2d 69 64 20 6c 6f 67 66 29 0a 20 20 28 69 66 t-id logf). (if
a7e0: 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 29 28 (string? logf)(
a7f0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
a800: 7a 6d 71 73 6f 63 6b 65 74 20 27 74 65 73 74 2d zmqsocket 'test-
a810: 73 65 74 2d 6c 6f 67 20 23 66 20 2a 64 65 66 61 set-log #f *defa
a820: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6c 6f ult-numtries* lo
a830: 67 66 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 3b gf test-id)))..;
a840: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
a850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a880: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 69 73 63 2e =======.;; Misc.
a890: 20 74 65 73 74 20 72 65 6c 61 74 65 64 20 71 75 test related qu
a8a0: 65 72 69 65 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d eries.;;========
a8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
a8e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
a8f0: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
a900: 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 -get-paths-match
a910: 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 ing db keynames
a920: 74 61 72 67 65 74 20 66 6e 61 6d 65 70 61 74 74 target fnamepatt
a930: 20 23 21 6b 65 79 20 28 72 65 73 20 27 28 29 29 #!key (res '())
a940: 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 ). (let* ((test
a950: 70 61 74 74 20 20 20 28 69 66 20 28 61 72 67 73 patt (if (args
a960: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
a970: 61 74 74 22 29 28 61 72 67 73 3a 67 65 74 2d 61 att")(args:get-a
a980: 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 rg "-testpatt")
a990: 22 25 22 29 29 0a 09 20 28 73 74 61 74 65 70 61 "%")).. (statepa
a9a0: 74 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 tt (if (args:ge
a9b0: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 t-arg ":state")
a9c0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
a9d0: 22 3a 73 74 61 74 65 22 29 20 20 20 20 22 25 22 ":state") "%"
a9e0: 29 29 0a 09 20 28 73 74 61 74 75 73 70 61 74 74 )).. (statuspatt
a9f0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
aa00: 72 67 20 22 3a 73 74 61 74 75 73 22 29 20 20 28 rg ":status") (
aa10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 args:get-arg ":s
aa20: 74 61 74 75 73 22 29 20 20 20 22 25 22 29 29 0a tatus") "%")).
aa30: 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 28 69 . (runname (i
aa40: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
aa50: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 28 61 72 67 ":runname") (arg
aa60: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
aa70: 61 6d 65 22 29 20 20 22 25 22 29 29 0a 09 20 28 ame") "%")).. (
aa80: 6b 65 79 73 74 72 20 28 73 74 72 69 6e 67 2d 69 keystr (string-i
aa90: 6e 74 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 ntersperse ...
aaa0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 (map (lambda (ke
aab0: 79 20 76 61 6c 29 0a 09 09 09 20 28 63 6f 6e 63 y val).... (conc
aac0: 20 22 72 2e 22 20 6b 65 79 20 22 20 6c 69 6b 65 "r." key " like
aad0: 20 27 22 20 76 61 6c 20 22 27 22 29 29 0a 09 09 '" val "'"))...
aae0: 20 20 20 20 20 20 20 6b 65 79 6e 61 6d 65 73 20 keynames
aaf0: 0a 09 09 20 20 20 20 20 20 20 28 73 74 72 69 6e ... (strin
ab00: 67 2d 73 70 6c 69 74 20 74 61 72 67 65 74 20 22 g-split target "
ab10: 2f 22 29 29 0a 09 09 20 20 22 20 41 4e 44 20 22 /"))... " AND "
ab20: 29 29 0a 09 20 28 74 65 73 74 71 72 79 20 28 74 )).. (testqry (t
ab30: 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 71 6c 71 ests:match->sqlq
ab40: 72 79 20 74 65 73 74 70 61 74 74 29 29 0a 09 20 ry testpatt))..
ab50: 28 71 72 79 73 74 72 20 28 63 6f 6e 63 20 22 53 (qrystr (conc "S
ab60: 45 4c 45 43 54 20 74 2e 72 75 6e 64 69 72 20 46 ELECT t.rundir F
ab70: 52 4f 4d 20 74 65 73 74 73 20 41 53 20 74 20 49 ROM tests AS t I
ab80: 4e 4e 45 52 20 4a 4f 49 4e 20 72 75 6e 73 20 41 NNER JOIN runs A
ab90: 53 20 72 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d S r ON t.run_id=
aba0: 72 2e 69 64 20 57 48 45 52 45 20 22 0a 09 09 20 r.id WHERE "...
abb0: 20 20 20 20 20 20 6b 65 79 73 74 72 20 22 20 41 keystr " A
abc0: 4e 44 20 72 2e 72 75 6e 6e 61 6d 65 20 4c 49 4b ND r.runname LIK
abd0: 45 20 27 22 20 72 75 6e 6e 61 6d 65 20 22 27 20 E '" runname "'
abe0: 41 4e 44 20 22 20 74 65 73 74 71 72 79 0a 09 09 AND " testqry...
abf0: 20 20 20 20 20 20 20 22 20 41 4e 44 20 74 2e 73 " AND t.s
ac00: 74 61 74 65 20 4c 49 4b 45 20 27 22 20 73 74 61 tate LIKE '" sta
ac10: 74 65 70 61 74 74 20 22 27 20 41 4e 44 20 74 2e tepatt "' AND t.
ac20: 73 74 61 74 75 73 20 4c 49 4b 45 20 27 22 20 73 status LIKE '" s
ac30: 74 61 74 75 73 70 61 74 74 20 0a 09 09 20 20 20 tatuspatt ...
ac40: 20 20 20 20 22 27 20 4f 52 44 45 52 20 42 59 20 "' ORDER BY
ac50: 74 2e 65 76 65 6e 74 5f 74 69 6d 65 20 41 53 43 t.event_time ASC
ac60: 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 ;"))). (debug
ac70: 3a 70 72 69 6e 74 20 33 20 22 71 72 79 73 74 72 :print 3 "qrystr
ac80: 3a 20 22 20 71 72 79 73 74 72 29 0a 20 20 20 20 : " qrystr).
ac90: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
aca0: 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d h-row . (lam
acb0: 62 64 61 20 28 70 29 0a 20 20 20 20 20 20 20 28 bda (p). (
acc0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 70 set! res (cons p
acd0: 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 res))). db
ace0: 0a 20 20 20 20 20 71 72 79 73 74 72 29 0a 20 20 . qrystr).
acf0: 20 20 28 69 66 20 66 6e 61 6d 65 70 61 74 74 0a (if fnamepatt.
ad00: 09 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 0a .(apply append .
ad10: 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 . (map (la
ad20: 6d 62 64 61 20 28 70 29 0a 09 09 20 20 20 20 20 mbda (p)...
ad30: 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 70 20 22 (glob (conc p "
ad40: 2f 22 20 66 6e 61 6d 65 70 61 74 74 29 29 29 0a /" fnamepatt))).
ad50: 09 09 20 20 20 20 72 65 73 29 29 0a 09 72 65 73 .. res))..res
ad60: 29 29 29 0a 0a 3b 3b 20 6c 6f 6f 6b 20 74 68 72 )))..;; look thr
ad70: 6f 75 67 68 20 74 65 73 74 73 20 66 72 6f 6d 20 ough tests from
ad80: 6d 61 74 63 68 69 6e 67 20 72 75 6e 73 20 66 6f matching runs fo
ad90: 72 20 61 20 66 69 6c 65 0a 28 64 65 66 69 6e 65 r a file.(define
ada0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 69 (db:test-get-fi
adb0: 72 73 74 2d 70 61 74 68 2d 6d 61 74 63 68 69 6e rst-path-matchin
adc0: 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 g db keynames ta
add0: 72 67 65 74 20 66 6e 61 6d 65 29 0a 20 20 3b 3b rget fname). ;;
ade0: 20 5b 72 65 66 70 61 74 68 73 5d 20 69 73 20 74 [refpaths] is t
adf0: 68 65 20 73 65 63 74 69 6f 6e 20 77 68 65 72 65 he section where
ae00: 20 72 65 66 65 72 65 6e 63 65 73 20 74 6f 20 6f references to o
ae10: 74 68 65 72 20 6d 65 67 61 74 65 73 74 20 64 61 ther megatest da
ae20: 74 61 62 61 73 65 73 20 61 72 65 20 73 74 6f 72 tabases are stor
ae30: 65 64 0a 20 20 28 6c 65 74 20 28 28 6d 74 2d 70 ed. (let ((mt-p
ae40: 61 74 68 73 20 28 63 6f 6e 66 69 67 66 3a 67 65 aths (configf:ge
ae50: 74 2d 73 65 63 74 69 6f 6e 20 22 72 65 66 70 61 t-section "refpa
ae60: 74 68 73 22 29 29 0a 09 28 72 65 73 20 20 20 20 ths"))..(res
ae70: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
ae80: 70 61 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 paths-matching d
ae90: 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 b keynames targe
aea0: 74 20 66 6e 61 6d 65 29 29 29 0a 20 20 20 20 28 t fname))). (
aeb0: 6c 65 74 20 6c 6f 6f 70 20 28 28 70 61 74 68 64 let loop ((pathd
aec0: 61 74 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 at (if (null? pa
aed0: 74 68 73 29 20 23 66 20 28 63 61 72 20 6d 74 2d ths) #f (car mt-
aee0: 70 61 74 68 73 29 29 29 0a 09 20 20 20 20 20 20 paths)))..
aef0: 20 28 74 61 6c 20 20 20 20 20 28 69 66 20 28 6e (tal (if (n
af00: 75 6c 6c 3f 20 70 61 74 68 73 29 20 27 28 29 28 ull? paths) '()(
af10: 63 64 72 20 6d 74 2d 70 61 74 68 73 29 29 29 29 cdr mt-paths))))
af20: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
af30: 28 6e 75 6c 6c 3f 20 72 65 73 29 29 0a 09 20 20 (null? res))..
af40: 28 63 61 72 20 72 65 73 29 20 3b 3b 20 72 65 74 (car res) ;; ret
af50: 75 72 6e 20 66 69 72 73 74 20 66 6f 75 6e 64 0a urn first found.
af60: 09 20 20 28 69 66 20 70 61 74 68 0a 09 20 20 20 . (if path..
af70: 20 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 20 (let* ((db
af80: 20 20 28 6f 70 65 6e 2d 64 62 20 70 61 74 68 3a (open-db path:
af90: 20 28 63 61 64 72 20 70 61 74 68 64 61 74 29 29 (cadr pathdat))
afa0: 29 0a 09 09 20 20 20 20 20 28 6e 65 77 72 65 73 )... (newres
afb0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 (db:test-get-pa
afc0: 74 68 73 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 ths-matching db
afd0: 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 74 20 keynames target
afe0: 66 6e 61 6d 65 29 29 29 0a 09 09 28 64 65 62 75 fname)))...(debu
aff0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 g:print-info 4 "
b000: 54 72 79 69 6e 67 20 22 20 28 63 61 72 20 70 61 Trying " (car pa
b010: 74 68 64 61 74 29 20 22 20 61 74 20 22 20 28 63 thdat) " at " (c
b020: 61 64 72 20 70 61 74 68 64 61 74 29 29 0a 09 09 adr pathdat))...
b030: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
b040: 65 21 20 64 62 29 0a 09 09 28 69 66 20 28 6e 6f e! db)...(if (no
b050: 74 20 28 6e 75 6c 6c 3f 20 6e 65 77 72 65 73 29 t (null? newres)
b060: 29 0a 09 09 20 20 20 20 28 63 61 72 20 6e 65 77 )... (car new
b070: 72 65 73 29 0a 09 09 20 20 20 20 28 69 66 20 28 res)... (if (
b080: 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 09 23 66 null? tal)....#f
b090: 0a 09 09 09 28 6c 6f 6f 70 20 28 63 61 72 20 74 ....(loop (car t
b0a0: 61 6c 29 28 63 64 72 20 74 61 6c 29 29 29 29 29 al)(cdr tal)))))
b0b0: 29 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 )))))...(define
b0c0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
b0d0: 74 2d 72 65 63 6f 72 64 73 2d 6d 61 74 63 68 69 t-records-matchi
b0e0: 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 ng db keynames t
b0f0: 61 72 67 65 74 29 0a 20 20 28 6c 65 74 2a 20 28 arget). (let* (
b100: 28 72 65 73 20 27 28 29 29 0a 09 20 28 69 74 65 (res '()).. (ite
b110: 6d 70 61 74 74 20 20 20 28 69 66 20 28 61 72 67 mpatt (if (arg
b120: 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 6d s:get-arg "-item
b130: 70 61 74 74 22 29 28 61 72 67 73 3a 67 65 74 2d patt")(args:get-
b140: 61 72 67 20 22 2d 69 74 65 6d 70 61 74 74 22 29 arg "-itempatt")
b150: 20 22 25 22 29 29 0a 09 20 28 74 65 73 74 70 61 "%")).. (testpa
b160: 74 74 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 tt (if (args:g
b170: 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
b180: 74 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 t")(args:get-arg
b190: 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 25 "-testpatt") "%
b1a0: 22 29 29 0a 09 20 28 73 74 61 74 65 70 61 74 74 ")).. (statepatt
b1b0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
b1c0: 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 arg ":state")
b1d0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
b1e0: 73 74 61 74 65 22 29 20 20 20 20 22 25 22 29 29 state") "%"))
b1f0: 0a 09 20 28 73 74 61 74 75 73 70 61 74 74 20 28 .. (statuspatt (
b200: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
b210: 20 22 3a 73 74 61 74 75 73 22 29 20 20 28 61 72 ":status") (ar
b220: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
b230: 74 75 73 22 29 20 20 20 22 25 22 29 29 0a 09 20 tus") "%"))..
b240: 28 72 75 6e 6e 61 6d 65 20 20 20 20 28 69 66 20 (runname (if
b250: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
b260: 72 75 6e 6e 61 6d 65 22 29 20 28 61 72 67 73 3a runname") (args:
b270: 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
b280: 65 22 29 20 20 22 25 22 29 29 0a 09 20 28 6b 65 e") "%")).. (ke
b290: 79 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 ystr (string-int
b2a0: 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 28 6d ersperse ... (m
b2b0: 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 20 ap (lambda (key
b2c0: 76 61 6c 29 0a 09 09 09 20 28 63 6f 6e 63 20 22 val).... (conc "
b2d0: 72 2e 22 20 6b 65 79 20 22 20 6c 69 6b 65 20 27 r." key " like '
b2e0: 22 20 76 61 6c 20 22 27 22 29 29 0a 09 09 20 20 " val "'"))...
b2f0: 20 20 20 20 20 6b 65 79 6e 61 6d 65 73 20 0a 09 keynames ..
b300: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
b310: 73 70 6c 69 74 20 74 61 72 67 65 74 20 22 2f 22 split target "/"
b320: 29 29 0a 09 09 20 20 22 20 41 4e 44 20 22 29 29 ))... " AND "))
b330: 0a 09 20 28 71 72 79 73 74 72 20 28 63 6f 6e 63 .. (qrystr (conc
b340: 20 22 53 45 4c 45 43 54 20 0a 20 20 20 20 20 20 "SELECT .
b350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b360: 20 20 20 20 20 20 74 2e 69 64 0a 20 20 20 20 20 t.id.
b370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b380: 20 20 20 20 20 20 20 74 2e 72 75 6e 5f 69 64 20 t.run_id
b390: 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 .
b3a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3b0: 20 74 2e 74 65 73 74 6e 61 6d 65 20 20 20 0a 20 t.testname .
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3d0: 20 20 20 20 20 20 20 20 20 20 20 74 2e 68 6f 73 t.hos
b3e0: 74 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 t .
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b400: 20 20 20 20 20 74 2e 63 70 75 6c 6f 61 64 20 20 t.cpuload
b410: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
b430: 2e 64 69 73 6b 66 72 65 65 20 20 20 0a 20 20 20 .diskfree .
b440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b450: 20 20 20 20 20 20 20 20 20 74 2e 75 6e 61 6d 65 t.uname
b460: 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 .
b470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b480: 20 20 20 74 2e 72 75 6e 64 69 72 20 20 20 20 20 t.rundir
b490: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 73 t.s
b4b0: 68 6f 72 74 64 69 72 20 20 20 0a 20 20 20 20 20 hortdir .
b4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4d0: 20 20 20 20 20 20 20 74 2e 69 74 65 6d 5f 70 61 t.item_pa
b4e0: 74 68 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 th .
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b500: 20 74 2e 73 74 61 74 65 20 20 20 20 20 20 0a 20 t.state .
b510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b520: 20 20 20 20 20 20 20 20 20 20 20 74 2e 73 74 61 t.sta
b530: 74 75 73 20 20 20 20 20 0a 20 20 20 20 20 20 20 tus .
b540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b550: 20 20 20 20 20 74 2e 61 74 74 65 6d 70 74 6e 75 t.attemptnu
b560: 6d 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 m .
b570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
b580: 2e 66 69 6e 61 6c 5f 6c 6f 67 66 20 0a 20 20 20 .final_logf .
b590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5a0: 20 20 20 20 20 20 20 20 20 74 2e 6c 6f 67 64 61 t.logda
b5b0: 74 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 t .
b5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5d0: 20 20 20 74 2e 72 75 6e 5f 64 75 72 61 74 69 6f t.run_duratio
b5e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 63 t.c
b600: 6f 6d 6d 65 6e 74 20 20 20 20 0a 20 20 20 20 20 omment .
b610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b620: 20 20 20 20 20 20 20 74 2e 65 76 65 6e 74 5f 74 t.event_t
b630: 69 6d 65 20 0a 20 20 20 20 20 20 20 20 20 20 20 ime .
b640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b650: 20 74 2e 66 61 69 6c 5f 63 6f 75 6e 74 20 0a 20 t.fail_count .
b660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b670: 20 20 20 20 20 20 20 20 20 20 20 74 2e 70 61 73 t.pas
b680: 73 5f 63 6f 75 6e 74 20 0a 20 20 20 20 20 20 20 s_count .
b690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b6a0: 20 20 20 20 20 74 2e 61 72 63 68 69 76 65 64 20 t.archived
b6b0: 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b6c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 46 52 FR
b6d0: 4f 4d 20 74 65 73 74 73 20 41 53 20 74 20 49 4e OM tests AS t IN
b6e0: 4e 45 52 20 4a 4f 49 4e 20 72 75 6e 73 20 41 53 NER JOIN runs AS
b6f0: 20 72 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 r ON t.run_id=r
b700: 2e 69 64 20 57 48 45 52 45 20 22 0a 09 09 20 20 .id WHERE "...
b710: 20 20 20 20 20 6b 65 79 73 74 72 20 22 20 41 4e keystr " AN
b720: 44 20 72 2e 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 D r.runname LIKE
b730: 20 27 22 20 72 75 6e 6e 61 6d 65 20 22 27 20 41 '" runname "' A
b740: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 4c 49 4b ND item_path LIK
b750: 45 20 27 22 20 69 74 65 6d 70 61 74 74 20 22 27 E '" itempatt "'
b760: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 20 4c 49 AND testname LI
b770: 4b 45 20 27 22 0a 09 09 20 20 20 20 20 20 20 74 KE '"... t
b780: 65 73 74 70 61 74 74 20 22 27 20 41 4e 44 20 74 estpatt "' AND t
b790: 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 22 20 73 .state LIKE '" s
b7a0: 74 61 74 65 70 61 74 74 20 22 27 20 41 4e 44 20 tatepatt "' AND
b7b0: 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 20 27 22 t.status LIKE '"
b7c0: 20 73 74 61 74 75 73 70 61 74 74 20 0a 09 09 20 statuspatt ...
b7d0: 20 20 20 20 20 20 22 27 4f 52 44 45 52 20 42 59 "'ORDER BY
b7e0: 20 74 2e 65 76 65 6e 74 5f 74 69 6d 65 20 41 53 t.event_time AS
b7f0: 43 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 C;"))). (debu
b800: 67 3a 70 72 69 6e 74 20 33 20 22 71 72 79 73 74 g:print 3 "qryst
b810: 72 3a 20 22 20 71 72 79 73 74 72 29 0a 20 20 20 r: " qrystr).
b820: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
b830: 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 ch-row . (la
b840: 6d 62 64 61 20 28 70 29 0a 20 20 20 20 20 20 20 mbda (p).
b850: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
b860: 70 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 p res))). db
b870: 20 0a 20 20 20 20 20 71 72 79 73 74 72 29 0a 20 . qrystr).
b880: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d res))..;;====
b890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b8d0: 3d 3d 0a 3b 3b 20 51 55 45 55 45 20 55 50 20 4d ==.;; QUEUE UP M
b8e0: 45 54 41 2c 20 54 45 53 54 20 53 54 41 54 55 53 ETA, TEST STATUS
b8f0: 20 41 4e 44 20 53 54 45 50 53 20 52 45 4d 4f 54 AND STEPS REMOT
b900: 45 20 41 43 43 45 53 53 0a 3b 3b 3d 3d 3d 3d 3d E ACCESS.;;=====
b910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b950: 3d 0a 0a 3b 3b 20 64 62 3a 75 70 64 61 74 65 72 =..;; db:updater
b960: 20 69 73 20 72 75 6e 20 69 6e 20 61 20 74 68 72 is run in a thr
b970: 65 61 64 20 74 6f 20 77 72 69 74 65 20 6f 75 74 ead to write out
b980: 20 74 68 65 20 63 61 63 68 65 64 20 64 61 74 61 the cached data
b990: 20 70 65 72 69 6f 64 69 63 61 6c 6c 79 0a 3b 3b periodically.;;
b9a0: 20 28 64 65 66 69 6e 65 20 28 64 62 3a 75 70 64 (define (db:upd
b9b0: 61 74 65 72 29 0a 3b 3b 20 20 20 28 64 65 62 75 ater).;; (debu
b9c0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 g:print-info 4 "
b9d0: 53 74 61 72 74 69 6e 67 20 63 61 63 68 65 20 70 Starting cache p
b9e0: 72 6f 63 65 73 73 69 6e 67 22 29 0a 3b 3b 20 20 rocessing").;;
b9f0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 3b 3b (let loop ().;;
ba00: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 (thread-sle
ba10: 65 70 21 20 31 30 29 20 3b 3b 20 6d 6f 76 65 20 ep! 10) ;; move
ba20: 73 61 76 65 20 74 69 6d 65 20 61 72 6f 75 6e 64 save time around
ba30: 20 74 6f 20 6d 69 6e 69 6d 69 7a 65 20 72 65 67 to minimize reg
ba40: 75 6c 61 72 20 63 6f 6c 6c 69 73 69 6f 6e 73 3f ular collisions?
ba50: 0a 3b 3b 20 20 20 20 20 28 64 62 3a 77 72 69 74 .;; (db:writ
ba60: 65 2d 63 61 63 68 65 64 2d 64 61 74 61 29 0a 3b e-cached-data).;
ba70: 3b 20 20 20 20 20 28 6c 6f 6f 70 29 29 29 0a 0a ; (loop)))..
ba80: 28 64 65 66 69 6e 65 20 28 64 62 3a 6f 62 6a 2d (define (db:obj-
ba90: 3e 73 74 72 69 6e 67 20 6f 62 6a 29 28 77 69 74 >string obj)(wit
baa0: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 h-output-to-stri
bab0: 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 28 73 65 ng (lambda ()(se
bac0: 72 69 61 6c 69 7a 65 20 6f 62 6a 29 29 29 29 0a rialize obj)))).
bad0: 28 64 65 66 69 6e 65 20 28 64 62 3a 73 74 72 69 (define (db:stri
bae0: 6e 67 2d 3e 6f 62 6a 20 6d 73 67 29 28 77 69 74 ng->obj msg)(wit
baf0: 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 h-input-from-str
bb00: 69 6e 67 20 6d 73 67 20 28 6c 61 6d 62 64 61 20 ing msg (lambda
bb10: 28 29 28 64 65 73 65 72 69 61 6c 69 7a 65 29 29 ()(deserialize))
bb20: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
bb30: 3a 75 73 65 2d 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e :use-non-blockin
bb40: 67 2d 6d 6f 64 65 20 70 72 6f 63 29 0a 20 20 28 g-mode proc). (
bb50: 73 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e set! *client-non
bb60: 2d 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 -blocking-mode*
bb70: 23 74 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 #t). (let ((res
bb80: 20 28 70 72 6f 63 29 29 29 0a 20 20 20 20 28 73 (proc))). (s
bb90: 65 74 21 20 2a 63 6c 69 65 6e 74 2d 6e 6f 6e 2d et! *client-non-
bba0: 62 6c 6f 63 6b 69 6e 67 2d 6d 6f 64 65 2a 20 23 blocking-mode* #
bbb0: 66 29 0a 20 20 20 20 72 65 73 29 29 0a 20 20 0a f). res)). .
bbc0: 3b 3b 20 70 61 72 61 6d 73 20 3d 20 27 74 61 72 ;; params = 'tar
bbd0: 67 65 74 20 63 61 63 68 65 64 20 72 65 6d 70 61 get cached rempa
bbe0: 72 61 6d 73 0a 3b 3b 0a 3b 3b 20 6d 61 6b 65 2d rams.;;.;; make-
bbf0: 76 65 63 74 6f 72 2d 72 65 63 6f 72 64 20 63 64 vector-record cd
bc00: 62 20 70 61 63 6b 65 74 20 63 6c 69 65 6e 74 2d b packet client-
bc10: 73 69 67 20 71 74 79 70 65 20 69 6d 6d 65 64 69 sig qtype immedi
bc20: 61 74 65 20 71 75 65 72 79 2d 73 69 67 20 70 61 ate query-sig pa
bc30: 72 61 6d 73 20 71 74 69 6d 65 0a 3b 3b 0a 28 64 rams qtime.;;.(d
bc40: 65 66 69 6e 65 20 28 63 64 62 3a 63 6c 69 65 6e efine (cdb:clien
bc50: 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b 65 t-call zmq-socke
bc60: 74 73 20 71 74 79 70 65 20 69 6d 6d 65 64 69 61 ts qtype immedia
bc70: 74 65 20 6e 75 6d 72 65 74 72 69 65 73 20 2e 20 te numretries .
bc80: 70 61 72 61 6d 73 29 0a 20 20 28 64 65 62 75 67 params). (debug
bc90: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 :print-info 11 "
bca0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
bcb0: 7a 6d 71 2d 73 6f 63 6b 65 74 73 3d 22 20 7a 6d zmq-sockets=" zm
bcc0: 71 2d 73 6f 63 6b 65 74 73 20 22 2c 20 71 74 79 q-sockets ", qty
bcd0: 70 65 3d 22 20 71 74 79 70 65 20 22 2c 20 69 6d pe=" qtype ", im
bce0: 6d 65 64 69 61 74 65 3d 22 20 69 6d 6d 65 64 69 mediate=" immedi
bcf0: 61 74 65 20 22 2c 20 6e 75 6d 72 65 74 72 69 65 ate ", numretrie
bd00: 73 3d 22 20 6e 75 6d 72 65 74 72 69 65 73 20 22 s=" numretries "
bd10: 2c 20 70 61 72 61 6d 73 3d 22 20 70 61 72 61 6d , params=" param
bd20: 73 29 0a 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 s). (handle-exc
bd30: 65 70 74 69 6f 6e 73 0a 20 20 20 65 78 6e 0a 20 eptions. exn.
bd40: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 28 74 (begin. (t
bd50: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 35 29 20 hread-sleep! 5)
bd60: 0a 20 20 20 20 20 28 69 66 20 28 3e 20 6e 75 6d . (if (> num
bd70: 72 65 74 72 69 65 73 20 30 29 28 61 70 70 6c 79 retries 0)(apply
bd80: 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c cdb:client-call
bd90: 20 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 71 74 79 zmq-sockets qty
bda0: 70 65 20 69 6d 6d 65 64 69 61 74 65 20 28 2d 20 pe immediate (-
bdb0: 6e 75 6d 72 65 74 72 69 65 73 20 31 29 20 70 61 numretries 1) pa
bdc0: 72 61 6d 73 29 29 29 0a 20 20 20 28 6c 65 74 2a rams))). (let*
bdd0: 20 28 28 70 75 73 68 2d 73 6f 63 6b 65 74 20 28 ((push-socket (
bde0: 76 65 63 74 6f 72 2d 72 65 66 20 7a 6d 71 2d 73 vector-ref zmq-s
bdf0: 6f 63 6b 65 74 73 20 30 29 29 0a 09 20 20 28 73 ockets 0)).. (s
be00: 75 62 2d 73 6f 63 6b 65 74 20 20 28 76 65 63 74 ub-socket (vect
be10: 6f 72 2d 72 65 66 20 7a 6d 71 2d 73 6f 63 6b 65 or-ref zmq-socke
be20: 74 73 20 31 29 29 0a 09 20 20 28 63 6c 69 65 6e ts 1)).. (clien
be30: 74 2d 73 69 67 20 20 28 73 65 72 76 65 72 3a 67 t-sig (server:g
be40: 65 74 2d 63 6c 69 65 6e 74 2d 73 69 67 6e 61 74 et-client-signat
be50: 75 72 65 29 29 0a 09 20 20 28 71 75 65 72 79 2d ure)).. (query-
be60: 73 69 67 20 20 20 28 6d 65 73 73 61 67 65 2d 64 sig (message-d
be70: 69 67 65 73 74 2d 73 74 72 69 6e 67 20 28 6d 64 igest-string (md
be80: 35 2d 70 72 69 6d 69 74 69 76 65 29 20 28 63 6f 5-primitive) (co
be90: 6e 63 20 71 74 79 70 65 20 69 6d 6d 65 64 69 61 nc qtype immedia
bea0: 74 65 20 70 61 72 61 6d 73 29 29 29 0a 09 20 20 te params)))..
beb0: 28 7a 64 61 74 20 20 20 20 20 20 20 20 28 64 62 (zdat (db
bec0: 3a 6f 62 6a 2d 3e 73 74 72 69 6e 67 20 28 76 65 :obj->string (ve
bed0: 63 74 6f 72 20 63 6c 69 65 6e 74 2d 73 69 67 20 ctor client-sig
bee0: 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 qtype immediate
bef0: 71 75 65 72 79 2d 73 69 67 20 70 61 72 61 6d 73 query-sig params
bf00: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
bf10: 73 29 29 29 29 20 3b 3b 20 28 77 69 74 68 2d 6f s)))) ;; (with-o
bf20: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 utput-to-string
bf30: 28 6c 61 6d 62 64 61 20 28 29 28 73 65 72 69 61 (lambda ()(seria
bf40: 6c 69 7a 65 20 70 61 72 61 6d 73 29 29 29 29 0a lize params)))).
bf50: 09 20 20 28 72 65 73 20 20 23 66 29 0a 09 20 20 . (res #f)..
bf60: 28 73 65 6e 64 2d 72 65 63 65 69 76 65 20 28 6c (send-receive (l
bf70: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 28 64 ambda ().... (d
bf80: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
bf90: 31 31 20 22 73 65 6e 64 69 6e 67 20 6d 65 73 73 11 "sending mess
bfa0: 61 67 65 22 29 0a 09 09 09 20 20 28 73 65 6e 64 age").... (send
bfb0: 2d 6d 65 73 73 61 67 65 20 70 75 73 68 2d 73 6f -message push-so
bfc0: 63 6b 65 74 20 7a 64 61 74 29 0a 09 09 09 20 20 cket zdat)....
bfd0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
bfe0: 6f 20 31 31 20 22 6d 65 73 73 61 67 65 20 73 65 o 11 "message se
bff0: 6e 74 22 29 0a 09 09 09 20 20 28 6c 65 74 20 6c nt").... (let l
c000: 6f 6f 70 20 28 29 0a 09 09 09 20 20 20 20 3b 3b oop ().... ;;
c010: 20 67 65 74 20 74 68 65 20 73 65 6e 64 65 72 20 get the sender
c020: 69 6e 66 6f 0a 09 09 09 20 20 20 20 3b 3b 20 74 info.... ;; t
c030: 68 69 73 20 73 68 6f 75 6c 64 20 6d 61 74 63 68 his should match
c040: 20 28 73 65 72 76 65 72 3a 67 65 74 2d 63 6c 69 (server:get-cli
c050: 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 29 0a 09 ent-signature)..
c060: 09 09 20 20 20 20 3b 3b 20 77 65 20 77 69 6c 6c .. ;; we will
c070: 20 6e 65 65 64 20 74 6f 20 70 72 6f 63 65 73 73 need to process
c080: 20 22 61 6c 6c 22 20 6d 65 73 73 61 67 65 73 20 "all" messages
c090: 68 65 72 65 20 73 6f 6d 65 20 64 61 79 0a 09 09 here some day...
c0a0: 09 20 20 20 20 28 72 65 63 65 69 76 65 2d 6d 65 . (receive-me
c0b0: 73 73 61 67 65 2a 20 73 75 62 2d 73 6f 63 6b 65 ssage* sub-socke
c0c0: 74 29 0a 09 09 09 20 20 20 20 3b 3b 20 6e 6f 77 t).... ;; now
c0d0: 20 67 65 74 20 74 68 65 20 61 63 74 75 61 6c 20 get the actual
c0e0: 6d 65 73 73 61 67 65 0a 09 09 09 20 20 20 20 28 message.... (
c0f0: 6c 65 74 20 28 28 6d 79 72 65 73 20 28 64 62 3a let ((myres (db:
c100: 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 28 72 65 63 string->obj (rec
c110: 65 69 76 65 2d 6d 65 73 73 61 67 65 2a 20 73 75 eive-message* su
c120: 62 2d 73 6f 63 6b 65 74 29 29 29 29 0a 09 09 09 b-socket))))....
c130: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
c140: 3f 20 71 75 65 72 79 2d 73 69 67 20 28 76 65 63 ? query-sig (vec
c150: 74 6f 72 2d 72 65 66 20 6d 79 72 65 73 20 31 29 tor-ref myres 1)
c160: 29 0a 09 09 09 09 20 20 28 73 65 74 21 20 72 65 )..... (set! re
c170: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 79 s (vector-ref my
c180: 72 65 73 20 32 29 29 0a 09 09 09 09 20 20 28 6c res 2))..... (l
c190: 6f 6f 70 29 29 29 29 29 29 0a 09 20 20 28 74 69 oop)))))).. (ti
c1a0: 6d 65 6f 75 74 20 28 6c 61 6d 62 64 61 20 28 29 meout (lambda ()
c1b0: 0a 09 09 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f ... (let loo
c1c0: 70 20 28 28 6e 20 6e 75 6d 72 65 74 72 69 65 73 p ((n numretries
c1d0: 29 29 0a 09 09 20 20 20 20 20 20 20 28 74 68 72 ))... (thr
c1e0: 65 61 64 2d 73 6c 65 65 70 21 20 31 35 29 0a 09 ead-sleep! 15)..
c1f0: 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 . (if (not
c200: 20 72 65 73 29 0a 09 09 09 20 20 20 28 69 66 20 res).... (if
c210: 28 3e 20 6e 75 6d 72 65 74 72 69 65 73 20 30 29 (> numretries 0)
c220: 0a 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 .... (begi
c230: 6e 0a 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 n..... (debug:pr
c240: 69 6e 74 20 32 20 22 57 41 52 4e 49 4e 47 3a 20 int 2 "WARNING:
c250: 6e 6f 20 72 65 70 6c 79 20 74 6f 20 71 75 65 72 no reply to quer
c260: 79 20 22 20 70 61 72 61 6d 73 20 22 2c 20 74 72 y " params ", tr
c270: 79 69 6e 67 20 72 65 73 65 6e 64 22 29 0a 09 09 ying resend")...
c280: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
c290: 69 6e 66 6f 20 31 31 20 22 72 65 2d 73 65 6e 64 info 11 "re-send
c2a0: 69 6e 67 20 6d 65 73 73 61 67 65 22 29 0a 09 09 ing message")...
c2b0: 09 09 20 28 73 65 6e 64 2d 6d 65 73 73 61 67 65 .. (send-message
c2c0: 20 70 75 73 68 2d 73 6f 63 6b 65 74 20 7a 64 61 push-socket zda
c2d0: 74 29 0a 09 09 09 09 20 28 64 65 62 75 67 3a 70 t)..... (debug:p
c2e0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6d 65 rint-info 11 "me
c2f0: 73 73 61 67 65 20 72 65 2d 73 65 6e 74 22 29 0a ssage re-sent").
c300: 09 09 09 09 20 28 6c 6f 6f 70 20 28 2d 20 6e 20 .... (loop (- n
c310: 31 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 3b 1))).... ;
c320: 3b 20 28 61 70 70 6c 79 20 63 64 62 3a 63 6c 69 ; (apply cdb:cli
c330: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 ent-call zmq-soc
c340: 6b 65 74 73 20 71 74 79 70 65 20 69 6d 6d 65 64 kets qtype immed
c350: 69 61 74 65 20 28 2d 20 6e 75 6d 72 65 74 72 69 iate (- numretri
c360: 65 73 20 31 29 20 70 61 72 61 6d 73 29 29 0a 09 es 1) params))..
c370: 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a .. (begin.
c380: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
c390: 74 20 30 20 22 45 52 52 4f 52 3a 20 63 64 62 3a t 0 "ERROR: cdb:
c3a0: 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 74 69 6d 65 client-call time
c3b0: 64 20 6f 75 74 20 22 20 70 61 72 61 6d 73 20 22 d out " params "
c3c0: 2c 20 65 78 69 74 69 6e 67 2e 22 29 0a 09 09 09 , exiting.")....
c3d0: 09 20 28 65 78 69 74 20 35 29 29 29 29 29 29 29 . (exit 5)))))))
c3e0: 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 ). (debug:pr
c3f0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 53 74 61 int-info 11 "Sta
c400: 72 74 69 6e 67 20 74 68 72 65 61 64 73 22 29 0a rting threads").
c410: 20 20 20 20 20 28 6c 65 74 20 28 28 74 68 31 20 (let ((th1
c420: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 73 65 6e (make-thread sen
c430: 64 2d 72 65 63 65 69 76 65 20 22 73 65 6e 64 20 d-receive "send
c440: 72 65 63 65 69 76 65 22 29 29 0a 09 20 20 20 28 receive")).. (
c450: 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 th2 (make-thread
c460: 20 74 69 6d 65 6f 75 74 20 20 20 20 20 20 22 74 timeout "t
c470: 69 6d 65 6f 75 74 22 29 29 29 0a 20 20 20 20 20 imeout"))).
c480: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
c490: 20 74 68 31 29 0a 20 20 20 20 20 20 20 28 74 68 th1). (th
c4a0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 read-start! th2)
c4b0: 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d . (thread-
c4c0: 6a 6f 69 6e 21 20 20 74 68 31 29 0a 20 20 20 20 join! th1).
c4d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
c4e0: 69 6e 66 6f 20 31 31 20 22 63 64 62 3a 63 6c 69 info 11 "cdb:cli
c4f0: 65 6e 74 2d 63 61 6c 6c 20 72 65 74 75 72 6e 69 ent-call returni
c500: 6e 67 20 72 65 73 3d 22 20 72 65 73 29 0a 20 20 ng res=" res).
c510: 20 20 20 20 20 72 65 73 29 29 29 29 0a 20 20 0a res)))). .
c520: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65 74 (define (cdb:set
c530: 2d 76 65 72 62 6f 73 69 74 79 20 7a 6d 71 2d 73 -verbosity zmq-s
c540: 6f 63 6b 65 74 20 76 61 6c 29 0a 20 20 28 63 64 ocket val). (cd
c550: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d b:client-call zm
c560: 71 2d 73 6f 63 6b 65 74 20 27 73 65 74 2d 76 65 q-socket 'set-ve
c570: 72 62 6f 73 69 74 79 20 23 66 20 2a 64 65 66 61 rbosity #f *defa
c580: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 76 61 ult-numtries* va
c590: 6c 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 l))..(define (cd
c5a0: 62 3a 6c 6f 67 69 6e 20 7a 6d 71 2d 73 6f 63 6b b:login zmq-sock
c5b0: 65 74 73 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 ets keyval signa
c5c0: 74 75 72 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 ture). (cdb:cli
c5d0: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 ent-call zmq-soc
c5e0: 6b 65 74 73 20 27 6c 6f 67 69 6e 20 23 74 20 2a kets 'login #t *
c5f0: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
c600: 2a 20 6b 65 79 76 61 6c 20 6d 65 67 61 74 65 73 * keyval megates
c610: 74 2d 76 65 72 73 69 6f 6e 20 73 69 67 6e 61 74 t-version signat
c620: 75 72 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ure))..(define (
c630: 63 64 62 3a 6c 6f 67 6f 75 74 20 7a 6d 71 2d 73 cdb:logout zmq-s
c640: 6f 63 6b 65 74 20 6b 65 79 76 61 6c 20 73 69 67 ocket keyval sig
c650: 6e 61 74 75 72 65 29 0a 20 20 28 63 64 62 3a 63 nature). (cdb:c
c660: 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 lient-call zmq-s
c670: 6f 63 6b 65 74 20 27 6c 6f 67 6f 75 74 20 23 74 ocket 'logout #t
c680: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
c690: 65 73 2a 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 es* keyval signa
c6a0: 74 75 72 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 ture))..(define
c6b0: 28 63 64 62 3a 6e 75 6d 2d 63 6c 69 65 6e 74 73 (cdb:num-clients
c6c0: 20 7a 6d 71 2d 73 6f 63 6b 65 74 29 0a 20 20 28 zmq-socket). (
c6d0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
c6e0: 7a 6d 71 2d 73 6f 63 6b 65 74 20 27 6e 75 6d 63 zmq-socket 'numc
c6f0: 6c 69 65 6e 74 73 20 23 74 20 2a 64 65 66 61 75 lients #t *defau
c700: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a 0a lt-numtries*))..
c710: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 (define (cdb:tes
c720: 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 61 t-set-status-sta
c730: 74 65 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 te zmqsocket tes
c740: 74 2d 69 64 20 73 74 61 74 75 73 20 73 74 61 74 t-id status stat
c750: 65 20 6d 73 67 29 0a 20 20 28 69 66 20 6d 73 67 e msg). (if msg
c760: 0a 20 20 20 20 20 20 28 63 64 62 3a 63 6c 69 65 . (cdb:clie
c770: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
c780: 74 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 2d t 'state-status-
c790: 6d 73 67 20 23 74 20 2a 64 65 66 61 75 6c 74 2d msg #t *default-
c7a0: 6e 75 6d 74 72 69 65 73 2a 20 73 74 61 74 65 20 numtries* state
c7b0: 73 74 61 74 75 73 20 6d 73 67 20 74 65 73 74 2d status msg test-
c7c0: 69 64 29 0a 20 20 20 20 20 20 28 63 64 62 3a 63 id). (cdb:c
c7d0: 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f lient-call zmqso
c7e0: 63 6b 65 74 20 27 73 74 61 74 65 2d 73 74 61 74 cket 'state-stat
c7f0: 75 73 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e us #t *default-n
c800: 75 6d 74 72 69 65 73 2a 20 73 74 61 74 65 20 73 umtries* state s
c810: 74 61 74 75 73 20 74 65 73 74 2d 69 64 29 29 29 tatus test-id)))
c820: 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ;; run-id test-
c830: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 6d name item-path m
c840: 69 6e 75 74 65 73 20 63 70 75 6c 6f 61 64 20 64 inutes cpuload d
c850: 69 73 6b 66 72 65 65 20 74 6d 70 66 72 65 65 29 iskfree tmpfree)
c860: 20 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a ..(define (cdb:
c870: 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 test-rollup-test
c880: 5f 64 61 74 61 2d 70 61 73 73 2d 66 61 69 6c 20 _data-pass-fail
c890: 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 74 2d 69 zmqsocket test-i
c8a0: 64 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 d). (cdb:client
c8b0: 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 -call zmqsocket
c8c0: 27 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 'test_data-pf-ro
c8d0: 6c 6c 75 70 20 23 74 20 2a 64 65 66 61 75 6c 74 llup #t *default
c8e0: 2d 6e 75 6d 74 72 69 65 73 2a 20 74 65 73 74 2d -numtries* test-
c8f0: 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d id test-id test-
c900: 69 64 20 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 id test-id))..(d
c910: 65 66 69 6e 65 20 28 63 64 62 3a 70 61 73 73 2d efine (cdb:pass-
c920: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 7a 6d 71 73 fail-counts zmqs
c930: 6f 63 6b 65 74 20 74 65 73 74 2d 69 64 20 66 61 ocket test-id fa
c940: 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
c950: 75 6e 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 unt). (cdb:clie
c960: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
c970: 74 20 27 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 t 'pass-fail-cou
c980: 6e 74 73 20 23 74 20 2a 64 65 66 61 75 6c 74 2d nts #t *default-
c990: 6e 75 6d 74 72 69 65 73 2a 20 66 61 69 6c 2d 63 numtries* fail-c
c9a0: 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 20 ount pass-count
c9b0: 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 test-id))..(defi
c9c0: 6e 65 20 28 63 64 62 3a 74 65 73 74 73 2d 72 65 ne (cdb:tests-re
c9d0: 67 69 73 74 65 72 2d 74 65 73 74 20 7a 6d 71 73 gister-test zmqs
c9e0: 6f 63 6b 65 74 20 72 75 6e 2d 69 64 20 74 65 73 ocket run-id tes
c9f0: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
ca00: 29 0a 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d ). (let ((item-
ca10: 70 61 74 68 73 20 28 69 66 20 28 65 71 75 61 6c paths (if (equal
ca20: 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a ? item-path "").
ca30: 09 09 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 ...(list item-pa
ca40: 74 68 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 th)....(list ite
ca50: 6d 2d 70 61 74 68 20 22 22 29 29 29 29 0a 20 20 m-path "")))).
ca60: 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 (cdb:client-ca
ca70: 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 72 65 ll zmqsocket 're
ca80: 67 69 73 74 65 72 2d 74 65 73 74 20 23 74 20 2a gister-test #t *
ca90: 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 default-numtries
caa0: 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 * run-id test-na
cab0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a me item-path))).
cac0: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 66 6c .(define (cdb:fl
cad0: 75 73 68 2d 71 75 65 75 65 20 7a 6d 71 73 6f 63 ush-queue zmqsoc
cae0: 6b 65 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 ket). (cdb:clie
caf0: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
cb00: 74 20 27 66 6c 75 73 68 20 23 66 20 2a 64 65 66 t 'flush #f *def
cb10: 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 ault-numtries*))
cb20: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6b ..(define (cdb:k
cb30: 69 6c 6c 2d 73 65 72 76 65 72 20 7a 6d 71 73 6f ill-server zmqso
cb40: 63 6b 65 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 cket). (cdb:cli
cb50: 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b ent-call zmqsock
cb60: 65 74 20 27 6b 69 6c 6c 73 65 72 76 65 72 20 23 et 'killserver #
cb70: 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 f *default-numtr
cb80: 69 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 ies*))..(define
cb90: 28 63 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 (cdb:roll-up-pas
cba0: 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 7a 6d s-fail-counts zm
cbb0: 71 73 6f 63 6b 65 74 20 72 75 6e 2d 69 64 20 74 qsocket run-id t
cbc0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
cbd0: 74 68 20 73 74 61 74 75 73 29 0a 20 20 28 63 64 th status). (cd
cbe0: 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d b:client-call zm
cbf0: 71 73 6f 63 6b 65 74 20 27 69 6d 6d 65 64 69 61 qsocket 'immedia
cc00: 74 65 20 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e te #f *default-n
cc10: 75 6d 74 72 69 65 73 2a 20 6f 70 65 6e 2d 72 75 umtries* open-ru
cc20: 6e 2d 63 6c 6f 73 65 20 64 62 3a 72 6f 6c 6c 2d n-close db:roll-
cc30: 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 up-pass-fail-cou
cc40: 6e 74 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 nts #f run-id te
cc50: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
cc60: 68 20 73 74 61 74 75 73 29 29 0a 0a 28 64 65 66 h status))..(def
cc70: 69 6e 65 20 28 63 64 62 3a 67 65 74 2d 74 65 73 ine (cdb:get-tes
cc80: 74 2d 69 6e 66 6f 20 7a 6d 71 73 6f 63 6b 65 74 t-info zmqsocket
cc90: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
cca0: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
ccb0: 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 cdb:client-call
ccc0: 7a 6d 71 73 6f 63 6b 65 74 20 27 69 6d 6d 65 64 zmqsocket 'immed
ccd0: 69 61 74 65 20 23 66 20 2a 64 65 66 61 75 6c 74 iate #f *default
cce0: 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 65 6e 2d -numtries* open-
ccf0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 run-close db:get
cd00: 2d 74 65 73 74 2d 69 6e 66 6f 20 23 66 20 72 75 -test-info #f ru
cd10: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
cd20: 74 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 tem-path))..(def
cd30: 69 6e 65 20 28 63 64 62 3a 67 65 74 2d 74 65 73 ine (cdb:get-tes
cd40: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 7a 6d 71 t-info-by-id zmq
cd50: 73 6f 63 6b 65 74 20 74 65 73 74 2d 69 64 29 0a socket test-id).
cd60: 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 (cdb:client-ca
cd70: 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 69 6d ll zmqsocket 'im
cd80: 6d 65 64 69 61 74 65 20 23 66 20 2a 64 65 66 61 mediate #f *defa
cd90: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 ult-numtries* op
cda0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
cdb0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
cdc0: 2d 69 64 20 23 66 20 74 65 73 74 2d 69 64 29 29 -id #f test-id))
cdd0: 0a 0a 3b 3b 20 64 62 20 73 68 6f 75 6c 64 20 62 ..;; db should b
cde0: 65 20 64 62 20 6f 70 65 6e 20 70 72 6f 63 20 6f e db open proc o
cdf0: 72 20 23 66 0a 28 64 65 66 69 6e 65 20 28 63 64 r #f.(define (cd
ce00: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 70 72 6f b:remote-run pro
ce10: 63 20 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 c db . params).
ce20: 20 28 61 70 70 6c 79 20 63 64 62 3a 63 6c 69 65 (apply cdb:clie
ce30: 6e 74 2d 63 61 6c 6c 20 2a 72 75 6e 72 65 6d 6f nt-call *runremo
ce40: 74 65 2a 20 27 69 6d 6d 65 64 69 61 74 65 20 23 te* 'immediate #
ce50: 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 f *default-numtr
ce60: 69 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c ies* open-run-cl
ce70: 6f 73 65 20 70 72 6f 63 20 23 66 20 70 61 72 61 ose proc #f para
ce80: 6d 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ms))..(define (d
ce90: 62 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 b:test-get-logfi
cea0: 6c 65 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 le-info db run-i
ceb0: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
cec0: 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 let ((res #f)).
ced0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
cee0: 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 each-row . (
cef0: 6c 61 6d 62 64 61 20 28 70 61 74 68 20 66 69 6e lambda (path fin
cf00: 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 al_logf).
cf10: 28 73 65 74 21 20 6c 6f 67 66 20 66 69 6e 61 6c (set! logf final
cf20: 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 28 73 _logf). (s
cf30: 65 74 21 20 72 65 73 20 28 6c 69 73 74 20 70 61 et! res (list pa
cf40: 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a th final_logf)).
cf50: 20 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 (if (dire
cf60: 63 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 ctory? path)..
cf70: 20 28 70 72 69 6e 74 20 22 46 6f 75 6e 64 20 70 (print "Found p
cf80: 61 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 ath: " path)..
cf90: 20 28 70 72 69 6e 74 20 22 4e 6f 20 73 75 63 68 (print "No such
cfa0: 20 70 61 74 68 3a 20 22 20 70 61 74 68 29 29 29 path: " path)))
cfb0: 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 22 . db . "
cfc0: 53 45 4c 45 43 54 20 72 75 6e 64 69 72 2c 66 69 SELECT rundir,fi
cfd0: 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20 74 65 nal_logf FROM te
cfe0: 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 sts WHERE run_id
cff0: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
d000: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
d010: 27 27 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 '';". run-id
d020: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 test-name).
d030: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 res))..(define d
d040: 62 3a 71 75 65 72 69 65 73 20 0a 20 20 28 6c 69 b:queries . (li
d050: 73 74 20 27 28 72 65 67 69 73 74 65 72 2d 74 65 st '(register-te
d060: 73 74 20 20 20 20 20 20 20 20 20 20 22 49 4e 53 st "INS
d070: 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e ERT OR IGNORE IN
d080: 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 TO tests (run_id
d090: 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f ,testname,event_
d0a0: 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 time,item_path,s
d0b0: 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c tate,status) VAL
d0c0: 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d UES (?,?,strftim
d0d0: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c e('%s','now'),?,
d0e0: 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 'NOT_STARTED','n
d0f0: 2f 61 27 29 3b 22 29 0a 09 27 28 73 74 61 74 65 /a');")..'(state
d100: 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
d110: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d120: 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 SET state=?,stat
d130: 75 73 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b us=? WHERE id=?;
d140: 22 29 0a 09 27 28 73 74 61 74 65 2d 73 74 61 74 ")..'(state-stat
d150: 75 73 2d 6d 73 67 20 20 20 20 20 20 20 22 55 50 us-msg "UP
d160: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 DATE tests SET s
d170: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c tate=?,status=?,
d180: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
d190: 69 64 3d 3f 3b 22 29 0a 09 27 28 70 61 73 73 2d id=?;")..'(pass-
d1a0: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 20 20 20 20 fail-counts
d1b0: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d1c0: 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f SET fail_count=?
d1d0: 2c 70 61 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 ,pass_count=? WH
d1e0: 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 3b 3b 20 ERE id=?;")..;;
d1f0: 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c test_data-pf-rol
d200: 6c 75 70 20 69 73 20 75 73 65 64 20 74 6f 20 73 lup is used to s
d210: 65 74 20 61 20 74 65 73 74 73 20 50 41 53 53 2f et a tests PASS/
d220: 46 41 49 4c 20 62 61 73 65 64 20 6f 6e 20 74 68 FAIL based on th
d230: 65 20 70 61 73 73 2f 66 61 69 6c 20 69 6e 66 6f e pass/fail info
d240: 20 66 72 6f 6d 20 74 68 65 20 73 74 65 70 73 0a from the steps.
d250: 09 27 28 74 65 73 74 5f 64 61 74 61 2d 70 66 2d .'(test_data-pf-
d260: 72 6f 6c 6c 75 70 20 20 20 20 22 55 50 44 41 54 rollup "UPDAT
d270: 45 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 E tests.
d280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d290: 20 20 20 20 20 20 20 20 20 20 20 20 53 45 54 20 SET
d2a0: 73 74 61 74 75 73 3d 43 41 53 45 20 57 48 45 4e status=CASE WHEN
d2b0: 20 28 53 45 4c 45 43 54 20 66 61 69 6c 5f 63 6f (SELECT fail_co
d2c0: 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 57 unt FROM tests W
d2d0: 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 0a HERE id=?) > 0 .
d2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d300: 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 49 4c THEN 'FAIL
d310: 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 '.
d320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d330: 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 WHEN (SELE
d340: 43 54 20 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 CT pass_count FR
d350: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 OM tests WHERE i
d360: 64 3d 3f 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 d=?) > 0 AND .
d370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d390: 20 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 (SELECT stat
d3a0: 75 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 us FROM tests WH
d3b0: 45 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e ERE id=?) NOT IN
d3c0: 20 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 ('WARN','FAIL')
d3d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d3f0: 20 20 20 20 20 54 48 45 4e 20 27 50 41 53 53 27 THEN 'PASS'
d400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d420: 20 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 ELSE status
d430: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d450: 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 69 END WHERE i
d460: 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 2d 73 d=?;")..'(test-s
d470: 65 74 2d 6c 6f 67 20 20 20 20 20 20 20 20 20 20 et-log
d480: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d490: 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f SET final_logf=?
d4a0: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 WHERE id=?;")..
d4b0: 27 28 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 '(test-set-rundi
d4c0: 72 2d 62 79 2d 74 65 73 74 2d 69 64 20 22 55 50 r-by-test-id "UP
d4d0: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 DATE tests SET r
d4e0: 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 69 64 undir=? WHERE id
d4f0: 3d 3f 22 29 0a 09 27 28 74 65 73 74 2d 73 65 74 =?")..'(test-set
d500: 2d 72 75 6e 64 69 72 20 20 20 20 20 20 20 20 20 -rundir
d510: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
d520: 54 20 72 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 T rundir=? WHERE
d530: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
d540: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
d550: 6d 5f 70 61 74 68 3d 3f 3b 22 29 0a 09 27 28 64 m_path=?;")..'(d
d560: 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 elete-tests-in-s
d570: 74 61 74 65 20 20 20 22 44 45 4c 45 54 45 20 46 tate "DELETE F
d580: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
d590: 73 74 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f state=? AND run_
d5a0: 69 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 73 id=?;")..'(tests
d5b0: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 :test-set-toplog
d5c0: 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 "UPDATE tests
d5d0: 20 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d SET final_logf=
d5e0: 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f ? WHERE run_id=?
d5f0: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
d600: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
d610: 3b 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 64 ;"). ))..;; d
d620: 6f 20 6e 6f 74 20 72 75 6e 20 74 68 65 73 65 20 o not run these
d630: 61 73 20 70 61 72 74 20 6f 66 20 74 68 65 20 74 as part of the t
d640: 72 61 6e 73 61 63 74 69 6f 6e 0a 28 64 65 66 69 ransaction.(defi
d650: 6e 65 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 75 ne db:special-qu
d660: 65 72 69 65 73 20 20 20 27 28 72 6f 6c 6c 75 70 eries '(rollup
d670: 2d 74 65 73 74 73 2d 70 61 73 73 2d 66 61 69 6c -tests-pass-fail
d680: 0a 09 09 09 20 20 20 20 20 20 20 64 62 3a 72 6f .... db:ro
d690: 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d ll-up-pass-fail-
d6a0: 63 6f 75 6e 74 73 0a 20 20 20 20 20 20 20 20 20 counts.
d6b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d6c0: 20 20 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 login.
d6d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d6e0: 20 20 20 20 20 20 20 20 20 20 20 69 6d 6d 65 64 immed
d6f0: 69 61 74 65 0a 09 09 09 20 20 20 20 20 20 20 66 iate.... f
d700: 6c 75 73 68 0a 09 09 09 20 20 20 20 20 20 20 73 lush.... s
d710: 79 6e 63 0a 09 09 09 20 20 20 20 20 20 20 73 65 ync.... se
d720: 74 2d 76 65 72 62 6f 73 69 74 79 0a 09 09 09 20 t-verbosity....
d730: 20 20 20 20 20 20 6b 69 6c 6c 73 65 72 76 65 72 killserver
d740: 29 29 0a 0a 3b 3b 20 6e 6f 74 20 75 73 65 64 2c ))..;; not used,
d750: 20 69 6e 74 65 6e 64 65 64 20 74 6f 20 69 6e 64 intended to ind
d760: 69 63 61 74 65 20 74 6f 20 72 75 6e 20 69 6e 20 icate to run in
d770: 63 61 6c 6c 69 6e 67 20 70 72 6f 63 65 73 73 0a calling process.
d780: 28 64 65 66 69 6e 65 20 64 62 3a 72 75 6e 2d 6c (define db:run-l
d790: 6f 63 61 6c 2d 71 75 65 72 69 65 73 20 27 28 29 ocal-queries '()
d7a0: 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 74 65 73 74 ) ;; rollup-test
d7b0: 73 2d 70 61 73 73 2d 66 61 69 6c 29 29 0a 0a 3b s-pass-fail))..;
d7c0: 3b 20 54 68 65 20 71 75 65 75 65 20 69 73 20 61 ; The queue is a
d7d0: 20 6c 69 73 74 20 6f 66 20 76 65 63 74 6f 72 73 list of vectors
d7e0: 20 77 68 65 72 65 20 74 68 65 20 7a 65 72 6f 74 where the zerot
d7f0: 68 20 73 6c 6f 74 20 69 6e 64 69 63 61 74 65 73 h slot indicates
d800: 20 74 68 65 20 74 79 70 65 20 6f 66 20 71 75 65 the type of que
d810: 72 79 20 74 6f 0a 3b 3b 20 61 70 70 6c 79 20 61 ry to.;; apply a
d820: 6e 64 20 74 68 65 20 73 65 63 6f 6e 64 20 73 6c nd the second sl
d830: 6f 74 20 69 73 20 74 68 65 20 74 69 6d 65 20 6f ot is the time o
d840: 66 20 74 68 65 20 71 75 65 72 79 20 61 6e 64 20 f the query and
d850: 74 68 65 20 74 68 69 72 64 20 65 6e 74 72 79 20 the third entry
d860: 69 73 20 61 20 6c 69 73 74 20 6f 66 20 0a 3b 3b is a list of .;;
d870: 20 76 61 6c 75 65 73 20 74 6f 20 62 65 20 61 70 values to be ap
d880: 70 6c 69 65 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 plied.;;.(define
d890: 20 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 (db:process-que
d8a0: 75 65 20 64 62 20 70 75 62 73 6f 63 6b 20 69 6e ue db pubsock in
d8b0: 64 61 74 61 29 0a 20 20 28 6c 65 74 2a 20 28 28 data). (let* ((
d8c0: 64 61 74 61 20 20 20 20 20 20 20 28 73 6f 72 74 data (sort
d8d0: 20 69 6e 64 61 74 61 20 28 6c 61 6d 62 64 61 20 indata (lambda
d8e0: 28 61 20 62 29 0a 09 09 09 09 20 20 20 20 28 3c (a b)..... (<
d8f0: 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 (cdb:packet-get
d900: 2d 71 74 69 6d 65 20 61 29 28 63 64 62 3a 70 61 -qtime a)(cdb:pa
d910: 63 6b 65 74 2d 67 65 74 2d 71 74 69 6d 65 20 62 cket-get-qtime b
d920: 29 29 29 29 29 29 0a 20 20 20 20 28 66 6f 72 2d )))))). (for-
d930: 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 each. (lambd
d940: 61 20 28 69 74 65 6d 29 0a 20 20 20 20 20 20 20 a (item).
d950: 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 (db:process-queu
d960: 65 2d 69 74 65 6d 20 64 62 20 70 75 62 73 6f 63 e-item db pubsoc
d970: 6b 20 69 74 65 6d 29 29 0a 20 20 20 20 20 64 61 k item)). da
d980: 74 61 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ta)))..(define (
d990: 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 65 db:process-queue
d9a0: 2d 69 74 65 6d 20 64 62 20 70 75 62 73 6f 63 6b -item db pubsock
d9b0: 20 69 74 65 6d 29 0a 20 20 28 6c 65 74 2a 20 28 item). (let* (
d9c0: 28 73 74 6d 74 2d 6b 65 79 20 20 20 20 20 20 20 (stmt-key
d9d0: 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d (cdb:packet-get-
d9e0: 71 74 79 70 65 20 69 74 65 6d 29 29 0a 09 20 28 qtype item)).. (
d9f0: 71 72 79 2d 73 69 67 20 20 20 20 20 20 20 20 28 qry-sig (
da00: 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d 71 cdb:packet-get-q
da10: 75 65 72 79 2d 73 69 67 20 69 74 65 6d 29 29 0a uery-sig item)).
da20: 09 20 28 72 65 74 75 72 6e 2d 61 64 64 72 65 73 . (return-addres
da30: 73 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 s (cdb:packet-ge
da40: 74 2d 63 6c 69 65 6e 74 2d 73 69 67 20 69 74 65 t-client-sig ite
da50: 6d 29 29 0a 09 20 28 70 61 72 61 6d 73 20 20 20 m)).. (params
da60: 20 20 20 20 20 20 28 63 64 62 3a 70 61 63 6b 65 (cdb:packe
da70: 74 2d 67 65 74 2d 70 61 72 61 6d 73 20 69 74 65 t-get-params ite
da80: 6d 29 29 0a 09 20 28 71 75 65 72 79 20 20 20 20 m)).. (query
da90: 20 20 20 20 20 20 28 6c 65 74 20 28 28 71 20 28 (let ((q (
daa0: 61 6c 69 73 74 2d 72 65 66 20 73 74 6d 74 2d 6b alist-ref stmt-k
dab0: 65 79 20 64 62 3a 71 75 65 72 69 65 73 29 29 29 ey db:queries)))
dac0: 0a 09 09 09 20 20 20 28 69 66 20 71 20 28 63 61 .... (if q (ca
dad0: 72 20 71 29 20 23 66 29 29 29 29 0a 20 20 20 20 r q) #f)))).
dae0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
daf0: 6f 20 31 31 20 22 53 70 65 63 69 61 6c 20 71 75 o 11 "Special qu
db00: 65 72 69 65 73 2f 72 65 71 75 65 73 74 73 20 73 eries/requests s
db10: 74 6d 74 2d 6b 65 79 3d 22 20 73 74 6d 74 2d 6b tmt-key=" stmt-k
db20: 65 79 20 22 2c 20 72 65 74 75 72 6e 2d 61 64 64 ey ", return-add
db30: 72 65 73 73 3d 22 20 72 65 74 75 72 6e 2d 61 64 ress=" return-ad
db40: 64 72 65 73 73 20 22 2c 20 71 72 65 72 79 3d 22 dress ", qrery="
db50: 20 71 75 65 72 79 20 22 2c 20 70 61 72 61 6d 73 query ", params
db60: 3d 22 20 70 61 72 61 6d 73 29 0a 20 20 20 20 28 =" params). (
db70: 63 6f 6e 64 0a 20 20 20 20 20 28 71 75 65 72 79 cond. (query
db80: 0a 20 20 20 20 20 20 28 61 70 70 6c 79 20 73 71 . (apply sq
db90: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
dba0: 20 71 75 65 72 79 20 70 61 72 61 6d 73 29 0a 20 query params).
dbb0: 20 20 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 (server:rep
dbc0: 6c 79 20 70 75 62 73 6f 63 6b 20 72 65 74 75 72 ly pubsock retur
dbd0: 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 n-address qry-si
dbe0: 67 20 23 74 20 23 74 29 29 0a 20 20 20 20 20 28 g #t #t)). (
dbf0: 28 6d 65 6d 62 65 72 20 73 74 6d 74 2d 6b 65 79 (member stmt-key
dc00: 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 75 65 72 db:special-quer
dc10: 69 65 73 29 0a 20 20 20 20 20 20 28 64 65 62 75 ies). (debu
dc20: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 g:print-info 11
dc30: 22 48 61 6e 64 6c 69 6e 67 20 73 70 65 63 69 61 "Handling specia
dc40: 6c 20 73 74 61 74 65 6d 65 6e 74 20 22 20 73 74 l statement " st
dc50: 6d 74 2d 6b 65 79 29 0a 20 20 20 20 20 20 28 63 mt-key). (c
dc60: 61 73 65 20 73 74 6d 74 2d 6b 65 79 0a 09 28 28 ase stmt-key..((
dc70: 69 6d 6d 65 64 69 61 74 65 29 0a 09 20 28 6c 65 immediate).. (le
dc80: 74 20 28 28 70 72 6f 63 20 20 20 20 20 20 28 63 t ((proc (c
dc90: 61 72 20 70 61 72 61 6d 73 29 29 0a 09 20 20 20 ar params))..
dca0: 20 20 20 20 28 72 65 6d 70 61 72 61 6d 73 20 28 (remparams (
dcb0: 63 64 72 20 70 61 72 61 6d 73 29 29 29 0a 09 20 cdr params)))..
dcc0: 20 20 3b 3b 20 77 65 20 61 72 65 20 62 65 69 6e ;; we are bein
dcd0: 67 20 68 61 6e 64 65 64 20 61 20 70 72 6f 63 65 g handed a proce
dce0: 64 75 72 65 20 73 6f 20 63 61 6c 6c 20 69 74 0a dure so call it.
dcf0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
dd00: 2d 69 6e 66 6f 20 31 31 20 22 52 75 6e 6e 69 6e -info 11 "Runnin
dd10: 67 20 28 61 70 70 6c 79 20 22 20 70 72 6f 63 20 g (apply " proc
dd20: 22 20 22 20 72 65 6d 70 61 72 61 6d 73 20 22 29 " " remparams ")
dd30: 22 29 0a 09 20 20 20 28 73 65 72 76 65 72 3a 72 ").. (server:r
dd40: 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 72 65 74 eply pubsock ret
dd50: 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d urn-address qry-
dd60: 73 69 67 20 23 74 20 28 61 70 70 6c 79 20 70 72 sig #t (apply pr
dd70: 6f 63 20 72 65 6d 70 61 72 61 6d 73 29 29 29 29 oc remparams))))
dd80: 0a 09 28 28 6c 6f 67 69 6e 29 0a 09 20 28 69 66 ..((login).. (if
dd90: 20 28 3c 20 28 6c 65 6e 67 74 68 20 70 61 72 61 (< (length para
dda0: 6d 73 29 20 33 29 20 3b 3b 20 73 68 6f 75 6c 64 ms) 3) ;; should
ddb0: 20 67 65 74 20 74 6f 70 70 61 74 68 2c 20 76 65 get toppath, ve
ddc0: 72 73 69 6f 6e 20 61 6e 64 20 73 69 67 6e 61 74 rsion and signat
ddd0: 75 72 65 0a 09 20 20 20 20 20 27 28 23 66 20 22 ure.. '(#f "
dde0: 6c 6f 67 69 6e 20 66 61 69 6c 65 64 20 64 75 65 login failed due
ddf0: 20 74 6f 20 6d 69 73 73 69 6e 67 20 70 61 72 61 to missing para
de00: 6d 73 22 29 20 3b 3b 20 6d 69 73 73 69 6e 67 20 ms") ;; missing
de10: 70 61 72 61 6d 73 0a 09 20 20 20 20 20 28 6c 65 params.. (le
de20: 74 20 28 28 63 61 6c 6c 69 6e 67 2d 70 61 74 68 t ((calling-path
de30: 20 28 63 61 72 20 20 20 70 61 72 61 6d 73 29 29 (car params))
de40: 0a 09 09 20 20 20 28 63 61 6c 6c 69 6e 67 2d 76 ... (calling-v
de50: 65 72 73 20 28 63 61 64 72 20 20 70 61 72 61 6d ers (cadr param
de60: 73 29 29 0a 09 09 20 20 20 28 63 6c 69 65 6e 74 s))... (client
de70: 2d 6b 65 79 20 20 20 28 63 61 64 64 72 20 70 61 -key (caddr pa
de80: 72 61 6d 73 29 29 29 0a 09 20 20 20 20 20 20 20 rams)))..
de90: 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f (if (and (equal?
dea0: 20 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 2a 74 calling-path *t
deb0: 6f 70 70 61 74 68 2a 29 0a 09 09 09 28 65 71 75 oppath*)....(equ
dec0: 61 6c 3f 20 6d 65 67 61 74 65 73 74 2d 76 65 72 al? megatest-ver
ded0: 73 69 6f 6e 20 63 61 6c 6c 69 6e 67 2d 76 65 72 sion calling-ver
dee0: 73 29 29 0a 09 09 20 20 20 28 62 65 67 69 6e 0a s))... (begin.
def0: 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 .. (hash-tab
df00: 6c 65 2d 73 65 74 21 20 2a 6c 6f 67 67 65 64 2d le-set! *logged-
df10: 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 63 6c 69 65 in-clients* clie
df20: 6e 74 2d 6b 65 79 20 28 63 75 72 72 65 6e 74 2d nt-key (current-
df30: 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 20 20 20 seconds))...
df40: 20 28 73 65 72 76 65 72 3a 72 65 70 6c 79 20 20 (server:reply
df50: 70 75 62 73 6f 63 6b 20 72 65 74 75 72 6e 2d 61 pubsock return-a
df60: 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 20 23 ddress qry-sig #
df70: 74 20 27 28 23 74 20 22 73 75 63 63 65 73 73 66 t '(#t "successf
df80: 75 6c 20 6c 6f 67 69 6e 22 29 29 29 20 20 20 20 ul login")))
df90: 20 20 3b 3b 20 70 61 74 68 20 6d 61 74 63 68 65 ;; path matche
dfa0: 73 20 2d 20 70 61 73 73 21 20 53 68 6f 75 6c 64 s - pass! Should
dfb0: 20 76 65 74 20 74 68 65 20 63 61 6c 6c 65 72 20 vet the caller
dfc0: 61 74 20 74 68 69 73 20 74 69 6d 65 20 2e 2e 2e at this time ...
dfd0: 0a 09 09 20 20 20 28 6c 69 73 74 20 23 66 20 28 ... (list #f (
dfe0: 63 6f 6e 63 20 22 4c 6f 67 69 6e 20 66 61 69 6c conc "Login fail
dff0: 65 64 20 64 75 65 20 74 6f 20 6d 69 73 6d 61 74 ed due to mismat
e000: 63 68 20 70 61 74 68 73 3a 20 22 20 63 61 6c 6c ch paths: " call
e010: 69 6e 67 2d 70 61 74 68 20 22 2c 20 22 20 2a 74 ing-path ", " *t
e020: 6f 70 70 61 74 68 2a 29 29 29 29 29 29 0a 09 28 oppath*))))))..(
e030: 28 66 6c 75 73 68 20 73 79 6e 63 29 0a 09 20 28 (flush sync).. (
e040: 73 65 72 76 65 72 3a 72 65 70 6c 79 20 70 75 62 server:reply pub
e050: 73 6f 63 6b 20 72 65 74 75 72 6e 2d 61 64 64 72 sock return-addr
e060: 65 73 73 20 71 72 79 2d 73 69 67 20 23 74 20 31 ess qry-sig #t 1
e070: 29 29 20 3b 3b 20 28 6c 65 6e 67 74 68 20 64 61 )) ;; (length da
e080: 74 61 29 29 29 0a 09 28 28 73 65 74 2d 76 65 72 ta)))..((set-ver
e090: 62 6f 73 69 74 79 29 0a 09 20 28 73 65 74 21 20 bosity).. (set!
e0a0: 2a 76 65 72 62 6f 73 69 74 79 2a 20 28 63 61 72 *verbosity* (car
e0b0: 20 70 61 72 61 6d 73 29 29 0a 09 20 28 73 65 72 params)).. (ser
e0c0: 76 65 72 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 ver:reply pubsoc
e0d0: 6b 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 k return-address
e0e0: 20 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74 qry-sig #t '(#t
e0f0: 20 2a 76 65 72 62 6f 73 69 74 79 2a 29 29 29 0a *verbosity*))).
e100: 09 28 28 6b 69 6c 6c 73 65 72 76 65 72 29 0a 09 .((killserver)..
e110: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
e120: 22 57 41 52 4e 49 4e 47 3a 20 53 65 72 76 65 72 "WARNING: Server
e130: 20 67 6f 69 6e 67 20 64 6f 77 6e 20 69 6e 20 31 going down in 1
e140: 35 20 73 65 63 6f 6e 64 73 20 62 79 20 75 73 65 5 seconds by use
e150: 72 20 72 65 71 75 65 73 74 21 22 29 0a 09 20 28 r request!").. (
e160: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
e170: 61 73 6b 73 3a 73 65 72 76 65 72 2d 64 65 72 65 asks:server-dere
e180: 67 69 73 74 65 72 20 74 61 73 6b 73 3a 6f 70 65 gister tasks:ope
e190: 6e 2d 64 62 20 0a 09 09 09 20 28 63 61 64 72 20 n-db .... (cadr
e1a0: 2a 73 65 72 76 65 72 2d 69 6e 66 6f 2a 29 0a 09 *server-info*)..
e1b0: 09 09 20 70 75 6c 6c 70 6f 72 74 3a 20 28 63 61 .. pullport: (ca
e1c0: 64 64 72 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f ddr *server-info
e1d0: 2a 29 29 0a 09 20 28 74 68 72 65 61 64 2d 73 74 *)).. (thread-st
e1e0: 61 72 74 21 20 28 6d 61 6b 65 2d 74 68 72 65 61 art! (make-threa
e1f0: 64 20 28 6c 61 6d 62 64 61 20 28 29 28 74 68 72 d (lambda ()(thr
e200: 65 61 64 2d 73 6c 65 65 70 21 20 31 35 29 28 65 ead-sleep! 15)(e
e210: 78 69 74 29 29 29 29 0a 09 20 28 73 65 72 76 65 xit)))).. (serve
e220: 72 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 r:reply pubsock
e230: 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 return-address q
e240: 72 79 2d 73 69 67 20 23 74 20 27 28 23 74 20 22 ry-sig #t '(#t "
e250: 65 78 69 74 20 70 72 6f 63 65 73 73 20 73 74 61 exit process sta
e260: 72 74 65 64 22 29 29 29 0a 09 28 65 6c 73 65 20 rted")))..(else
e270: 3b 3b 20 6e 6f 74 20 61 20 63 6f 6d 6d 61 6e 64 ;; not a command
e280: 2c 20 69 2e 65 2e 20 69 73 20 61 20 71 75 65 72 , i.e. is a quer
e290: 79 0a 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 y.. (debug:print
e2a0: 20 30 20 22 45 52 52 4f 52 3a 20 55 6e 72 65 63 0 "ERROR: Unrec
e2b0: 6f 67 6e 69 73 65 64 20 71 75 65 72 79 2f 63 6f ognised query/co
e2c0: 6d 6d 61 6e 64 20 22 20 73 74 6d 74 2d 6b 65 79 mmand " stmt-key
e2d0: 29 0a 09 20 28 73 65 72 76 65 72 3a 72 65 70 6c ).. (server:repl
e2e0: 79 20 70 75 62 73 6f 63 6b 20 72 65 74 75 72 6e y pubsock return
e2f0: 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 -address qry-sig
e300: 20 23 66 20 27 66 61 69 6c 65 64 29 29 29 29 0a #f 'failed)))).
e310: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
e320: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
e330: 66 6f 20 31 31 20 22 45 78 65 63 75 74 69 6e 67 fo 11 "Executing
e340: 20 22 20 73 74 6d 74 2d 6b 65 79 20 22 20 66 6f " stmt-key " fo
e350: 72 20 22 20 70 61 72 61 6d 73 29 0a 20 20 20 20 r " params).
e360: 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 (apply sqlite3
e370: 3a 65 78 65 63 75 74 65 20 28 68 61 73 68 2d 74 :execute (hash-t
e380: 61 62 6c 65 2d 72 65 66 20 71 75 65 72 69 65 73 able-ref queries
e390: 20 73 74 6d 74 2d 6b 65 79 29 20 70 61 72 61 6d stmt-key) param
e3a0: 73 29 0a 20 20 20 20 20 20 28 73 65 72 76 65 72 s). (server
e3b0: 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 72 :reply pubsock r
e3c0: 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 eturn-address qr
e3d0: 79 2d 73 69 67 20 23 74 20 23 74 29 29 29 29 29 y-sig #t #t)))))
e3e0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ..(define (db:te
e3f0: 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 st-get-records-f
e400: 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 62 or-index-file db
e410: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
e420: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 e). (let ((res
e430: 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 '())). (sqlit
e440: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
e450: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
e460: 64 20 69 74 65 6d 70 61 74 68 20 73 74 61 74 65 d itempath state
e470: 20 73 74 61 74 75 73 20 72 75 6e 5f 64 75 72 61 status run_dura
e480: 74 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e tion logf commen
e490: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
e4a0: 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f res (cons (vecto
e4b0: 72 20 69 64 20 69 74 65 6d 70 61 74 68 20 73 74 r id itempath st
e4c0: 61 74 65 20 73 74 61 74 75 73 20 72 75 6e 5f 64 ate status run_d
e4d0: 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d uration logf com
e4e0: 6d 65 6e 74 29 20 72 65 73 29 29 29 0a 20 20 20 ment) res))).
e4f0: 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 db. "SELEC
e500: 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 68 2c 73 T id,item_path,s
e510: 74 61 74 65 2c 73 74 61 74 75 73 2c 72 75 6e 5f tate,status,run_
e520: 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c duration,final_l
e530: 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d ogf,comment FROM
e540: 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e tests WHERE run
e550: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
e560: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
e570: 74 68 20 21 3d 20 27 27 3b 22 0a 20 20 20 20 20 th != '';".
e580: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
e590: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
e5a0: 52 6f 6c 6c 75 70 20 74 68 65 20 70 61 73 73 2f Rollup the pass/
e5b0: 66 61 69 6c 20 63 6f 75 6e 74 73 20 66 72 6f 6d fail counts from
e5c0: 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 73 20 itemized tests
e5d0: 69 6e 74 6f 20 66 61 69 6c 5f 63 6f 75 6e 74 20 into fail_count
e5e0: 61 6e 64 20 70 61 73 73 5f 63 6f 75 6e 74 0a 28 and pass_count.(
e5f0: 64 65 66 69 6e 65 20 28 64 62 3a 72 6f 6c 6c 2d define (db:roll-
e600: 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 up-pass-fail-cou
e610: 6e 74 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 nts db run-id te
e620: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
e630: 68 20 73 74 61 74 75 73 29 0a 20 20 3b 3b 20 28 h status). ;; (
e640: 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 20 cdb:flush-queue
e650: 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 20 20 28 *runremote*). (
e660: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 if (and (not (eq
e670: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
e680: 22 29 29 0a 09 20 20 20 28 6d 65 6d 62 65 72 20 ")).. (member
e690: 73 74 61 74 75 73 20 27 28 22 50 41 53 53 22 20 status '("PASS"
e6a0: 22 57 41 52 4e 22 20 22 46 41 49 4c 22 20 22 57 "WARN" "FAIL" "W
e6b0: 41 49 56 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 AIVED" "RUNNING"
e6c0: 20 22 43 48 45 43 4b 22 29 29 29 0a 20 20 20 20 "CHECK"))).
e6d0: 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 (begin..(sqlit
e6e0: 65 33 3a 65 78 65 63 75 74 65 20 0a 09 20 64 62 e3:execute .. db
e6f0: 0a 09 20 22 55 50 44 41 54 45 20 74 65 73 74 73 .. "UPDATE tests
e700: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 53 . S
e710: 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 28 53 ET fail_count=(S
e720: 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 ELECT count(id)
e730: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
e740: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
e750: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
e760: 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 m_path != '' AND
e770: 20 73 74 61 74 75 73 3d 27 46 41 49 4c 27 29 2c status='FAIL'),
e780: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e790: 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d 28 53 45 pass_count=(SE
e7a0: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
e7b0: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
e7c0: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
e7d0: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
e7e0: 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 20 _path != '' AND
e7f0: 28 73 74 61 74 75 73 3d 27 50 41 53 53 27 20 4f (status='PASS' O
e800: 52 20 73 74 61 74 75 73 3d 27 57 41 52 4e 27 20 R status='WARN'
e810: 4f 52 20 73 74 61 74 75 73 3d 27 57 41 49 56 45 OR status='WAIVE
e820: 44 27 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 D')).
e830: 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f WHERE run_id=?
e840: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
e850: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
e860: 3b 22 0a 09 20 72 75 6e 2d 69 64 20 74 65 73 74 ;".. run-id test
e870: 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 -name run-id tes
e880: 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 t-name run-id te
e890: 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 st-name).
e8a0: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
e8b0: 70 21 20 30 2e 31 29 20 3b 3b 20 67 69 76 65 20 p! 0.1) ;; give
e8c0: 6f 74 68 65 72 20 70 72 6f 63 65 73 73 65 73 20 other processes
e8d0: 61 20 63 68 61 6e 63 65 20 68 65 72 65 2c 20 6e a chance here, n
e8e0: 6f 2c 20 62 65 74 74 65 72 20 74 6f 20 62 65 20 o, better to be
e8f0: 64 6f 6e 65 20 41 53 41 50 3f 0a 09 28 69 66 20 done ASAP?..(if
e900: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
e910: 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 72 75 6e RUNNING") ;; run
e920: 6e 69 6e 67 20 74 61 6b 65 73 20 70 72 69 6f 72 ning takes prior
e930: 69 74 79 20 6f 76 65 72 20 61 6c 6c 20 6f 74 68 ity over all oth
e940: 65 72 20 73 74 61 74 65 73 2c 20 66 6f 72 63 65 er states, force
e950: 20 74 68 65 20 74 65 73 74 20 73 74 61 74 65 20 the test state
e960: 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 20 20 20 20 to RUNNING..
e970: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
e980: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
e990: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 s SET state=? WH
e9a0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
e9b0: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
e9c0: 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 22 item_path='';" "
e9d0: 52 55 4e 4e 49 4e 47 22 20 72 75 6e 2d 69 64 20 RUNNING" run-id
e9e0: 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 test-name)..
e9f0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
ea00: 0a 09 20 20 20 20 20 64 62 0a 09 20 20 20 20 20 .. db..
ea10: 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 20 "UPDATE tests.
ea20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea30: 20 20 20 20 20 53 45 54 20 73 74 61 74 65 3d 43 SET state=C
ea40: 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 20 20 ASE .
ea50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea60: 20 20 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 WHEN (SE
ea70: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
ea80: 52 4f 4d 20 74 65 73 74 73 20 0a 20 20 20 20 20 ROM tests .
ea90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eaa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eab0: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
eac0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
ead0: 73 74 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 20 20 stname=?.
eae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eaf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eb00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 41 4e AN
eb10: 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
eb20: 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ' .
eb30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eb40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eb50: 20 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 74 AND stat
eb60: 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e 47 27 2c e in ('RUNNING',
eb70: 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 29 29 20 'NOT_STARTED'))
eb80: 3e 20 30 20 54 48 45 4e 20 27 52 55 4e 4e 49 4e > 0 THEN 'RUNNIN
eb90: 47 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 G'.
eba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ebb0: 20 20 20 20 20 20 45 4c 53 45 20 27 43 4f 4d 50 ELSE 'COMP
ebc0: 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 20 20 20 LETED' END,.
ebd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ebe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ebf0: 20 20 73 74 61 74 75 73 3d 43 41 53 45 20 0a 20 status=CASE .
ec00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ec20: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 4e 20 WHEN
ec30: 66 61 69 6c 5f 63 6f 75 6e 74 20 3e 20 30 20 54 fail_count > 0 T
ec40: 48 45 4e 20 27 46 41 49 4c 27 20 0a 20 20 20 20 HEN 'FAIL' .
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 20 20 20 20 20 20 20 57 48 45 4e 20 70 61 73 WHEN pas
ec80: 73 5f 63 6f 75 6e 74 20 3e 20 30 20 41 4e 44 20 s_count > 0 AND
ec90: 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 20 54 48 45 fail_count=0 THE
eca0: 4e 20 27 50 41 53 53 27 20 0a 20 20 20 20 20 20 N 'PASS' .
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 20 20 20 20 45 4c 53 45 20 27 55 4e 4b 4e ELSE 'UNKN
ece0: 4f 57 4e 27 20 45 4e 44 0a 20 20 20 20 20 20 20 OWN' END.
ecf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ed00: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
ed10: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
ed20: 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 D item_path='';"
ed30: 0a 09 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 .. run-id te
ed40: 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 st-name run-id t
ed50: 65 73 74 2d 6e 61 6d 65 29 29 0a 09 23 66 29 0a est-name))..#f).
ed60: 20 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d #f))..;;==
ed70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eda0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
edb0: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 73 20 6d 65 ====.;; Tests me
edc0: 74 61 20 64 61 74 61 0a 3b 3b 3d 3d 3d 3d 3d 3d ta data.;;======
edd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ede0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
edf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ee00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ee10: 0a 0a 3b 3b 20 72 65 61 64 20 74 68 65 20 72 65 ..;; read the re
ee20: 63 6f 72 64 20 67 69 76 65 6e 20 61 20 74 65 73 cord given a tes
ee30: 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 tname.(define (d
ee40: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 b:testmeta-get-r
ee50: 65 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d ecord db testnam
ee60: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 e). (let ((res
ee70: 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 #f)). (sqlite
ee80: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
ee90: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
eea0: 74 65 73 74 6e 61 6d 65 20 61 75 74 68 6f 72 20 testname author
eeb0: 6f 77 6e 65 72 20 64 65 73 63 72 69 70 74 69 6f owner descriptio
eec0: 6e 20 72 65 76 69 65 77 65 64 20 69 74 65 72 61 n reviewed itera
eed0: 74 65 64 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 ted avg_runtime
eee0: 61 76 67 5f 64 69 73 6b 20 74 61 67 73 29 0a 20 avg_disk tags).
eef0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
ef00: 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74 6e (vector id testn
ef10: 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 ame author owner
ef20: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 description rev
ef30: 69 65 77 65 64 20 69 74 65 72 61 74 65 64 20 61 iewed iterated a
ef40: 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 vg_runtime avg_d
ef50: 69 73 6b 20 74 61 67 73 29 29 29 0a 20 20 20 20 isk tags))).
ef60: 20 64 62 20 22 53 45 4c 45 43 54 20 69 64 2c 74 db "SELECT id,t
ef70: 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f 72 2c 6f estname,author,o
ef80: 77 6e 65 72 2c 64 65 73 63 72 69 70 74 69 6f 6e wner,description
ef90: 2c 72 65 76 69 65 77 65 64 2c 69 74 65 72 61 74 ,reviewed,iterat
efa0: 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d 65 2c 61 ed,avg_runtime,a
efb0: 76 67 5f 64 69 73 6b 2c 74 61 67 73 20 46 52 4f vg_disk,tags FRO
efc0: 4d 20 74 65 73 74 5f 6d 65 74 61 20 57 48 45 52 M test_meta WHER
efd0: 45 20 74 65 73 74 6e 61 6d 65 3d 3f 3b 22 0a 20 E testname=?;".
efe0: 20 20 20 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 testname).
eff0: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 63 72 65 61 res))..;; crea
f000: 74 65 20 61 20 6e 65 77 20 72 65 63 6f 72 64 20 te a new record
f010: 66 6f 72 20 61 20 67 69 76 65 6e 20 74 65 73 74 for a given test
f020: 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 62 name.(define (db
f030: 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 :testmeta-add-re
f040: 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d 65 cord db testname
f050: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
f060: 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 cute db "INSERT
f070: 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 74 OR IGNORE INTO t
f080: 65 73 74 5f 6d 65 74 61 20 28 74 65 73 74 6e 61 est_meta (testna
f090: 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c me,author,owner,
f0a0: 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 description,revi
f0b0: 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 ewed,iterated,av
f0c0: 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 g_runtime,avg_di
f0d0: 73 6b 2c 74 61 67 73 29 20 56 41 4c 55 45 53 20 sk,tags) VALUES
f0e0: 28 3f 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 (?,'','','','','
f0f0: 27 2c 27 27 2c 27 27 2c 27 27 29 3b 22 20 74 65 ','','','');" te
f100: 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b 20 75 70 64 stname))..;; upd
f110: 61 74 65 20 6f 6e 65 20 6f 66 20 74 68 65 20 74 ate one of the t
f120: 65 73 74 6d 65 74 61 20 66 69 65 6c 64 73 0a 28 estmeta fields.(
f130: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d define (db:testm
f140: 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 eta-update-field
f150: 20 64 62 20 74 65 73 74 6e 61 6d 65 20 66 69 65 db testname fie
f160: 6c 64 20 76 61 6c 75 65 29 0a 20 20 28 73 71 6c ld value). (sql
f170: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
f180: 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 (conc "UPDATE te
f190: 73 74 5f 6d 65 74 61 20 53 45 54 20 22 20 66 69 st_meta SET " fi
f1a0: 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 74 65 eld "=? WHERE te
f1b0: 73 74 6e 61 6d 65 3d 3f 3b 22 29 20 76 61 6c 75 stname=?;") valu
f1c0: 65 20 74 65 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b e testname))..;;
f1d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f210: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 ======.;; T E S
f220: 54 20 20 20 44 20 41 20 54 20 41 20 0a 3b 3b 3d T D A T A .;;=
f230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f270: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
f280: 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 db:csv->test-dat
f290: 61 20 64 62 20 74 65 73 74 2d 69 64 20 63 73 76 a db test-id csv
f2a0: 64 61 74 61 29 0a 20 20 28 64 65 62 75 67 3a 70 data). (debug:p
f2b0: 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 64 20 rint 4 "test-id
f2c0: 22 20 74 65 73 74 2d 69 64 20 22 2c 20 63 73 76 " test-id ", csv
f2d0: 64 61 74 61 3a 20 22 20 63 73 76 64 61 74 61 29 data: " csvdata)
f2e0: 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 20 20 . (let ((tdb
f2f0: 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d (db:open-test-
f300: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
f310: 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 test-id))).
f320: 28 69 66 20 74 64 62 0a 09 28 6c 65 74 20 28 28 (if tdb..(let ((
f330: 63 73 76 6c 69 73 74 20 28 63 73 76 2d 3e 6c 69 csvlist (csv->li
f340: 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d 72 65 61 st (make-csv-rea
f350: 64 65 72 0a 09 09 09 09 20 20 20 28 6f 70 65 6e der..... (open
f360: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 63 73 -input-string cs
f370: 76 64 61 74 61 29 0a 09 09 09 09 20 20 20 27 28 vdata)..... '(
f380: 28 73 74 72 69 70 2d 6c 65 61 64 69 6e 67 2d 77 (strip-leading-w
f390: 68 69 74 65 73 70 61 63 65 3f 20 23 74 29 0a 09 hitespace? #t)..
f3a0: 09 09 09 20 20 20 20 20 28 73 74 72 69 70 2d 74 ... (strip-t
f3b0: 72 61 69 6c 69 6e 67 2d 77 68 69 74 65 73 70 61 railing-whitespa
f3c0: 63 65 3f 20 23 74 29 29 20 29 29 29 29 20 3b 3b ce? #t)) )))) ;;
f3d0: 20 28 63 73 76 2d 3e 6c 69 73 74 20 63 73 76 64 (csv->list csvd
f3e0: 61 74 61 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 ata))).. (for-e
f3f0: 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 ach .. (lambda
f400: 20 28 63 73 76 72 6f 77 29 0a 09 20 20 20 20 20 (csvrow)..
f410: 28 6c 65 74 2a 20 28 28 70 61 64 64 65 64 2d 72 (let* ((padded-r
f420: 6f 77 20 20 28 74 61 6b 65 20 28 61 70 70 65 6e ow (take (appen
f430: 64 20 63 73 76 72 6f 77 20 28 6c 69 73 74 20 23 d csvrow (list #
f440: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
f450: 20 23 66 20 23 66 20 23 66 29 29 20 39 29 29 0a #f #f #f)) 9)).
f460: 09 09 20 20 20 20 28 63 61 74 65 67 6f 72 79 20 .. (category
f470: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 (list-ref pad
f480: 64 65 64 2d 72 6f 77 20 30 29 29 0a 09 09 20 20 ded-row 0))...
f490: 20 20 28 76 61 72 69 61 62 6c 65 20 20 20 20 28 (variable (
f4a0: 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
f4b0: 72 6f 77 20 31 29 29 0a 09 09 20 20 20 20 28 76 row 1))... (v
f4c0: 61 6c 75 65 20 20 20 20 20 20 20 28 61 6e 79 2d alue (any-
f4d0: 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69 >number-if-possi
f4e0: 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61 ble (list-ref pa
f4f0: 64 64 65 64 2d 72 6f 77 20 32 29 29 29 0a 09 09 dded-row 2)))...
f500: 20 20 20 20 28 65 78 70 65 63 74 65 64 20 20 20 (expected
f510: 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 (any->number-if
f520: 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 74 2d -possible (list-
f530: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 33 ref padded-row 3
f540: 29 29 29 0a 09 09 20 20 20 20 28 74 6f 6c 20 20 )))... (tol
f550: 20 20 20 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d (any->num
f560: 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 ber-if-possible
f570: 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 (list-ref padded
f580: 2d 72 6f 77 20 34 29 29 29 20 3b 3b 20 3e 2c 20 -row 4))) ;; >,
f590: 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 6f 72 20 61 20 <, >=, <=, or a
f5a0: 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 75 6e number... (un
f5b0: 69 74 73 20 20 20 20 20 20 20 28 6c 69 73 74 2d its (list-
f5c0: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 35 ref padded-row 5
f5d0: 29 29 0a 09 09 20 20 20 20 28 63 6f 6d 6d 65 6e ))... (commen
f5e0: 74 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 t (list-ref
f5f0: 70 61 64 64 65 64 2d 72 6f 77 20 36 29 29 0a 09 padded-row 6))..
f600: 09 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 . (status
f610: 20 20 28 6c 65 74 20 28 28 73 20 28 6c 69 73 74 (let ((s (list
f620: 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 -ref padded-row
f630: 37 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 7)))..... (if
f640: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 29 (and (string? s)
f650: 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (or (string-matc
f660: 68 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a h (regexp "^\\s*
f670: 24 22 29 20 73 29 0a 09 09 09 09 09 09 09 20 20 $") s)........
f680: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match (
f690: 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 22 29 20 regexp "^n/a$")
f6a0: 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 s))).....
f6b0: 23 66 0a 09 09 09 09 20 20 20 20 20 20 20 73 29 #f..... s)
f6c0: 29 29 20 3b 3b 20 69 66 20 73 70 65 63 69 66 69 )) ;; if specifi
f6d0: 65 64 20 6f 6e 20 74 68 65 20 69 6e 70 75 74 20 ed on the input
f6e0: 74 68 65 6e 20 75 73 65 2c 20 65 6c 73 65 20 63 then use, else c
f6f0: 61 6c 63 75 6c 61 74 65 0a 09 09 20 20 20 20 28 alculate... (
f700: 74 79 70 65 20 20 20 20 20 20 20 20 28 6c 69 73 type (lis
f710: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
f720: 20 38 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 8))).. ;;
f730: 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 63 74 65 look up expecte
f740: 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 72 6f 6d d,tol,units from
f750: 20 70 72 65 76 69 6f 75 73 20 62 65 73 74 20 66 previous best f
f760: 69 74 20 74 65 73 74 20 69 66 20 74 68 65 79 20 it test if they
f770: 61 72 65 20 61 6c 6c 20 65 69 74 68 65 72 20 23 are all either #
f780: 66 20 6f 72 20 27 27 0a 09 20 20 20 20 20 20 20 f or ''..
f790: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
f7a0: 42 45 46 4f 52 45 3a 20 63 61 74 65 67 6f 72 79 BEFORE: category
f7b0: 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 76 : " category " v
f7c0: 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 61 ariable: " varia
f7d0: 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 76 ble " value: " v
f7e0: 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c 20 alue .... ",
f7f0: 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 65 expected: " expe
f800: 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 6f cted " tol: " to
f810: 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e 69 l " units: " uni
f820: 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 73 ts " status: " s
f830: 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 3a tatus " comment:
f840: 20 22 20 63 6f 6d 6d 65 6e 74 20 22 20 74 79 70 " comment " typ
f850: 65 3a 20 22 20 74 79 70 65 29 0a 0a 09 20 20 20 e: " type)...
f860: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6f 72 (if (and (or
f870: 20 28 6e 6f 74 20 65 78 70 65 63 74 65 64 29 28 (not expected)(
f880: 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 equal? expected
f890: 22 22 29 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 ""))....(or (not
f8a0: 20 74 6f 6c 29 20 20 20 20 20 28 65 71 75 61 6c tol) (equal
f8b0: 3f 20 65 78 70 65 63 74 65 64 20 22 22 29 29 0a ? expected "")).
f8c0: 09 09 09 28 6f 72 20 28 6e 6f 74 20 75 6e 69 74 ...(or (not unit
f8d0: 73 29 20 20 20 28 65 71 75 61 6c 3f 20 65 78 70 s) (equal? exp
f8e0: 65 63 74 65 64 20 22 22 29 29 29 0a 09 09 20 20 ected "")))...
f8f0: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
f900: 6e 65 77 2d 65 78 70 65 63 74 65 64 20 6e 65 77 new-expected new
f910: 2d 74 6f 6c 20 6e 65 77 2d 75 6e 69 74 73 29 28 -tol new-units)(
f920: 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c 2d db:get-prev-tol-
f930: 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 for-test db test
f940: 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 -id category var
f950: 69 61 62 6c 65 29 29 29 0a 09 09 09 20 20 20 20 iable)))....
f960: 20 20 20 28 73 65 74 21 20 65 78 70 65 63 74 65 (set! expecte
f970: 64 20 6e 65 77 2d 65 78 70 65 63 74 65 64 29 0a d new-expected).
f980: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
f990: 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d 74 6f 6c tol new-tol
f9a0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
f9b0: 21 20 75 6e 69 74 73 20 20 20 20 6e 65 77 2d 75 ! units new-u
f9c0: 6e 69 74 73 29 29 29 0a 0a 09 20 20 20 20 20 20 nits)))...
f9d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
f9e0: 22 41 46 54 45 52 3a 20 20 63 61 74 65 67 6f 72 "AFTER: categor
f9f0: 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 y: " category "
fa00: 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 variable: " vari
fa10: 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 able " value: "
fa20: 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c value .... ",
fa30: 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 expected: " exp
fa40: 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 ected " tol: " t
fa50: 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e ol " units: " un
fa60: 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 its " status: "
fa70: 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 status " comment
fa80: 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 : " comment)..
fa90: 20 20 20 20 20 3b 3b 20 63 61 6c 63 75 6c 61 74 ;; calculat
faa0: 65 20 73 74 61 74 75 73 20 69 66 20 4e 4f 54 20 e status if NOT
fab0: 73 70 65 63 69 66 69 65 64 0a 09 20 20 20 20 20 specified..
fac0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
fad0: 73 74 61 74 75 73 29 28 6e 75 6d 62 65 72 3f 20 status)(number?
fae0: 65 78 70 65 63 74 65 64 29 28 6e 75 6d 62 65 72 expected)(number
faf0: 3f 20 76 61 6c 75 65 29 29 20 3b 3b 20 6e 65 65 ? value)) ;; nee
fb00: 64 20 65 78 70 65 63 74 65 64 20 61 6e 64 20 76 d expected and v
fb10: 61 6c 75 65 20 74 6f 20 62 65 20 6e 75 6d 62 65 alue to be numbe
fb20: 72 73 0a 09 09 20 20 20 28 69 66 20 28 6e 75 6d rs... (if (num
fb30: 62 65 72 3f 20 74 6f 6c 29 20 3b 3b 20 69 66 20 ber? tol) ;; if
fb40: 74 6f 6c 20 69 73 20 61 20 6e 75 6d 62 65 72 20 tol is a number
fb50: 74 68 65 6e 20 77 65 20 64 6f 20 74 68 65 20 73 then we do the s
fb60: 74 61 6e 64 61 72 64 20 63 6f 6d 70 61 72 69 73 tandard comparis
fb70: 6f 6e 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 on... (let
fb80: 2a 20 28 28 6d 61 78 2d 76 61 6c 20 28 2b 20 65 * ((max-val (+ e
fb90: 78 70 65 63 74 65 64 20 74 6f 6c 29 29 0a 09 09 xpected tol))...
fba0: 09 20 20 20 20 20 20 28 6d 69 6e 2d 76 61 6c 20 . (min-val
fbb0: 28 2d 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 (- expected tol)
fbc0: 29 0a 09 09 09 20 20 20 20 20 20 28 72 65 73 75 ).... (resu
fbd0: 6c 74 20 20 28 61 6e 64 20 28 3e 3d 20 20 76 61 lt (and (>= va
fbe0: 6c 75 65 20 6d 69 6e 2d 76 61 6c 29 28 3c 3d 20 lue min-val)(<=
fbf0: 76 61 6c 75 65 20 6d 61 78 2d 76 61 6c 29 29 29 value max-val)))
fc00: 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 ).... (debug:pri
fc10: 6e 74 20 34 20 22 6d 61 78 2d 76 61 6c 3a 20 22 nt 4 "max-val: "
fc20: 20 6d 61 78 2d 76 61 6c 20 22 20 6d 69 6e 2d 76 max-val " min-v
fc30: 61 6c 3a 20 22 20 6d 69 6e 2d 76 61 6c 20 22 20 al: " min-val "
fc40: 72 65 73 75 6c 74 3a 20 22 20 72 65 73 75 6c 74 result: " result
fc50: 29 0a 09 09 09 20 28 73 65 74 21 20 73 74 61 74 ).... (set! stat
fc60: 75 73 20 28 69 66 20 72 65 73 75 6c 74 20 22 70 us (if result "p
fc70: 61 73 73 22 20 22 66 61 69 6c 22 29 29 29 0a 09 ass" "fail")))..
fc80: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 73 74 . (set! st
fc90: 61 74 75 73 20 3b 3b 20 4e 42 2f 2f 20 6e 65 65 atus ;; NB// nee
fca0: 64 20 74 6f 20 61 73 73 65 73 73 20 65 61 63 68 d to assess each
fcb0: 20 6f 6e 65 20 28 69 2e 65 2e 20 6e 6f 74 20 72 one (i.e. not r
fcc0: 65 74 75 72 6e 20 6f 70 65 72 61 74 6f 72 20 73 eturn operator s
fcd0: 69 6e 63 65 20 6e 65 65 64 20 74 6f 20 61 63 74 ince need to act
fce0: 20 69 66 20 6e 6f 74 20 76 61 6c 69 64 20 6f 70 if not valid op
fcf0: 2e 0a 09 09 09 20 20 20 20 20 28 63 61 73 65 20 ..... (case
fd00: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
fd10: 74 6f 6c 29 20 3b 3b 20 74 6f 6c 20 73 68 6f 75 tol) ;; tol shou
fd20: 6c 64 20 62 65 20 3e 2c 20 3c 2c 20 3e 3d 2c 20 ld be >, <, >=,
fd30: 3c 3d 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e <=.... ((>
fd40: 29 20 20 28 69 66 20 28 3e 20 20 76 61 6c 75 65 ) (if (> value
fd50: 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
fd60: 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
fd70: 20 20 20 20 20 28 28 3c 29 20 20 28 69 66 20 28 ((<) (if (
fd80: 3c 20 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 < value expecte
fd90: 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
fda0: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e )).... ((>
fdb0: 3d 29 20 28 69 66 20 28 3e 3d 20 76 61 6c 75 65 =) (if (>= value
fdc0: 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
fdd0: 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
fde0: 20 20 20 20 20 28 28 3c 3d 29 20 28 69 66 20 28 ((<=) (if (
fdf0: 3c 3d 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 <= value expecte
fe00: 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
fe10: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 65 6c )).... (el
fe20: 73 65 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a se (conc "ERROR:
fe30: 20 62 61 64 20 74 6f 6c 20 63 6f 6d 70 61 72 61 bad tol compara
fe40: 74 6f 72 20 22 20 74 6f 6c 29 29 29 29 29 29 0a tor " tol)))))).
fe50: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
fe60: 72 69 6e 74 20 34 20 22 41 46 54 45 52 32 3a 20 rint 4 "AFTER2:
fe70: 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 category: " cate
fe80: 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c 65 3a gory " variable:
fe90: 20 22 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 " variable " va
fea0: 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 lue: " value ...
feb0: 09 20 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 . ", expected
fec0: 3a 20 22 20 65 78 70 65 63 74 65 64 20 22 20 74 : " expected " t
fed0: 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 ol: " tol " unit
fee0: 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73 74 61 s: " units " sta
fef0: 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 tus: " status "
ff00: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
ff10: 6e 74 29 0a 09 20 20 20 20 20 20 20 28 73 71 6c nt).. (sql
ff20: 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 ite3:execute tdb
ff30: 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
ff40: 41 43 45 20 49 4e 54 4f 20 74 65 73 74 5f 64 61 ACE INTO test_da
ff50: 74 61 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 ta (test_id,cate
ff60: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
ff70: 6c 75 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c lue,expected,tol
ff80: 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 ,units,comment,s
ff90: 74 61 74 75 73 2c 74 79 70 65 29 20 56 41 4c 55 tatus,type) VALU
ffa0: 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ES (?,?,?,?,?,?,
ffb0: 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 74 ?,?,?,?);".....t
ffc0: 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 est-id category
ffd0: 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 variable value e
ffe0: 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 xpected tol unit
fff0: 73 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f s (if comment co
10000 6d 6d 65 6e 74 20 22 22 29 20 73 74 61 74 75 73 mment "") status
10010 20 74 79 70 65 29 0a 09 20 20 20 20 20 20 20 28 type).. (
10020 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
10030 21 20 74 64 62 29 29 29 0a 09 20 20 20 63 73 76 ! tdb))).. csv
10040 6c 69 73 74 29 29 29 29 29 0a 0a 3b 3b 20 67 65 list)))))..;; ge
10050 74 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 t a list of test
10060 5f 64 61 74 61 20 72 65 63 6f 72 64 73 20 6d 61 _data records ma
10070 74 63 68 69 6e 67 20 63 61 74 65 67 6f 72 79 70 tching categoryp
10080 61 74 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a att.(define (db:
10090 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 read-test-data d
100a0 62 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f b test-id catego
100b0 72 79 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 rypatt). (let (
100c0 28 74 64 62 20 20 28 64 62 3a 6f 70 65 6e 2d 74 (tdb (db:open-t
100d0 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
100e0 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a d db test-id))).
100f0 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 6c 65 (if tdb..(le
10100 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 20 t ((res '()))..
10110 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
10120 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c 61 6d ch-row .. (lam
10130 62 64 61 20 28 69 64 20 74 65 73 74 5f 69 64 20 bda (id test_id
10140 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c category variabl
10150 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 e value expected
10160 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f 6d 6d 65 tol units comme
10170 6e 74 20 73 74 61 74 75 73 20 74 79 70 65 29 0a nt status type).
10180 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 . (set! res
10190 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 (cons (vector id
101a0 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f 72 test_id categor
101b0 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
101c0 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e expected tol un
101d0 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61 74 its comment stat
101e0 75 73 20 74 79 70 65 29 20 72 65 73 29 29 29 0a us type) res))).
101f0 09 20 20 20 74 64 62 0a 09 20 20 20 22 53 45 4c . tdb.. "SEL
10200 45 43 54 20 69 64 2c 74 65 73 74 5f 69 64 2c 63 ECT id,test_id,c
10210 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 ategory,variable
10220 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 2c ,value,expected,
10230 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e tol,units,commen
10240 74 2c 73 74 61 74 75 73 2c 74 79 70 65 20 46 52 t,status,type FR
10250 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 OM test_data WHE
10260 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 RE test_id=? AND
10270 20 63 61 74 65 67 6f 72 79 20 4c 49 4b 45 20 3f category LIKE ?
10280 20 4f 52 44 45 52 20 42 59 20 63 61 74 65 67 6f ORDER BY catego
10290 72 79 2c 76 61 72 69 61 62 6c 65 3b 22 20 74 65 ry,variable;" te
102a0 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 st-id categorypa
102b0 74 74 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a tt).. (sqlite3:
102c0 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
102d0 20 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 (reverse res))
102e0 0a 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e ..'())))..(defin
102f0 65 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d e (db:load-test-
10300 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 29 data db test-id)
10310 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c . (let loop ((l
10320 69 6e 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 in (read-line)))
10330 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
10340 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 69 6e 29 29 of-object? lin))
10350 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
10360 75 67 3a 70 72 69 6e 74 20 34 20 6c 69 6e 29 0a ug:print 4 lin).
10370 09 20 20 28 64 62 3a 63 73 76 2d 3e 74 65 73 74 . (db:csv->test
10380 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 -data db test-id
10390 20 6c 69 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 28 lin).. (loop (
103a0 72 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 0a 20 read-line))))).
103b0 20 3b 3b 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 ;; roll up the
103c0 63 75 72 72 65 6e 74 20 72 65 73 75 6c 74 73 2e current results.
103d0 0a 20 20 3b 3b 20 46 49 58 4d 45 3a 20 41 64 64 . ;; FIXME: Add
103e0 20 74 68 65 20 73 74 61 74 75 73 20 74 6f 20 0a the status to .
103f0 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data-
10400 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 rollup db test-i
10410 64 20 23 66 29 29 0a 0a 3b 3b 20 57 41 52 4e 49 d #f))..;; WARNI
10420 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 61 6c 6c 20 NG: Do NOT call
10430 74 68 69 73 20 66 6f 72 20 74 68 65 20 70 61 72 this for the par
10440 65 6e 74 20 74 65 73 74 20 6f 6e 20 61 6e 20 69 ent test on an i
10450 74 65 72 61 74 65 64 20 74 65 73 74 0a 3b 3b 20 terated test.;;
10460 52 6f 6c 6c 20 75 70 20 74 65 73 74 5f 64 61 74 Roll up test_dat
10470 61 20 70 61 73 73 2f 66 61 69 6c 20 72 65 73 75 a pass/fail resu
10480 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 lts.;; look at t
10490 68 65 20 74 65 73 74 5f 64 61 74 61 20 73 74 61 he test_data sta
104a0 74 75 73 20 66 69 65 6c 64 2c 20 0a 3b 3b 20 20 tus field, .;;
104b0 20 20 69 66 20 61 6c 6c 20 61 72 65 20 70 61 73 if all are pas
104c0 73 20 28 61 6e 79 20 63 61 73 65 29 20 61 6e 64 s (any case) and
104d0 20 74 68 65 20 74 65 73 74 20 73 74 61 74 75 73 the test status
104e0 20 69 73 20 50 41 53 53 20 6f 72 20 4e 55 4c 4c is PASS or NULL
104f0 20 6f 72 20 27 27 20 74 68 65 6e 20 73 65 74 20 or '' then set
10500 74 65 73 74 20 73 74 61 74 75 73 20 74 6f 20 50 test status to P
10510 41 53 53 2e 0a 3b 3b 20 20 20 20 69 66 20 6f 6e ASS..;; if on
10520 65 20 6f 72 20 6d 6f 72 65 20 61 72 65 20 66 61 e or more are fa
10530 69 6c 20 28 61 6e 79 20 63 61 73 65 29 20 74 68 il (any case) th
10540 65 6e 20 73 65 74 20 74 65 73 74 20 73 74 61 74 en set test stat
10550 75 73 20 74 6f 20 50 41 53 53 2c 20 6e 6f 6e 20 us to PASS, non
10560 22 70 61 73 73 22 20 6f 72 20 22 66 61 69 6c 22 "pass" or "fail"
10570 20 61 72 65 20 69 67 6e 6f 72 65 64 0a 28 64 65 are ignored.(de
10580 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 64 61 fine (db:test-da
10590 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 ta-rollup db tes
105a0 74 2d 69 64 20 73 74 61 74 75 73 29 0a 20 20 28 t-id status). (
105b0 6c 65 74 20 28 28 74 64 62 20 28 6f 70 65 6e 2d let ((tdb (open-
105c0 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6f 70 65 run-close db:ope
105d0 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
105e0 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 t-id db test-id)
105f0 29 0a 09 28 66 61 69 6c 2d 63 6f 75 6e 74 20 30 )..(fail-count 0
10600 29 0a 09 28 70 61 73 73 2d 63 6f 75 6e 74 20 30 )..(pass-count 0
10610 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 )). (if tdb..
10620 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
10630 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
10640 09 20 20 20 28 6c 61 6d 62 64 61 20 28 66 63 6f . (lambda (fco
10650 75 6e 74 20 70 63 6f 75 6e 74 29 0a 09 20 20 20 unt pcount)..
10660 20 20 28 73 65 74 21 20 66 61 69 6c 2d 63 6f 75 (set! fail-cou
10670 6e 74 20 66 63 6f 75 6e 74 29 0a 09 20 20 20 20 nt fcount)..
10680 20 28 73 65 74 21 20 70 61 73 73 2d 63 6f 75 6e (set! pass-coun
10690 74 20 70 63 6f 75 6e 74 29 29 0a 09 20 20 20 74 t pcount)).. t
106a0 64 62 20 0a 09 20 20 20 22 53 45 4c 45 43 54 20 db .. "SELECT
106b0 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
106c0 29 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 ) FROM test_data
106d0 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
106e0 20 41 4e 44 20 73 74 61 74 75 73 20 6c 69 6b 65 AND status like
106f0 20 27 66 61 69 6c 27 29 20 41 53 20 66 61 69 6c 'fail') AS fail
10700 5f 63 6f 75 6e 74 2c 0a 20 20 20 20 20 20 20 20 _count,.
10710 20 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 (SELE
10720 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
10730 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 52 M test_data WHER
10740 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 E test_id=? AND
10750 73 74 61 74 75 73 20 6c 69 6b 65 20 27 70 61 73 status like 'pas
10760 73 27 29 20 41 53 20 70 61 73 73 5f 63 6f 75 6e s') AS pass_coun
10770 74 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 t;".. test-id
10780 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 71 6c test-id).. (sql
10790 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
107a0 64 62 29 0a 0a 09 20 20 3b 3b 20 4e 6f 77 20 72 db)... ;; Now r
107b0 6f 6c 6c 75 70 20 74 68 65 20 63 6f 75 6e 74 73 ollup the counts
107c0 20 74 6f 20 74 68 65 20 63 65 6e 74 72 61 6c 20 to the central
107d0 6d 65 67 61 74 65 73 74 2e 64 62 0a 09 20 20 28 megatest.db.. (
107e0 63 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f cdb:pass-fail-co
107f0 75 6e 74 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a unts *runremote*
10800 20 74 65 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f test-id fail-co
10810 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a unt pass-count).
10820 09 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 . ;; (sqlite3:e
10830 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
10840 45 20 74 65 73 74 73 20 53 45 54 20 66 61 69 6c E tests SET fail
10850 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f _count=?,pass_co
10860 75 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f unt=? WHERE id=?
10870 3b 22 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 ;" .. ;;
10880 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 fa
10890 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
108a0 75 6e 74 20 74 65 73 74 2d 69 64 29 0a 09 20 20 unt test-id)..
108b0 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 (cdb:flush-queue
108c0 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 09 20 *runremote*)..
108d0 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
108e0 70 21 20 31 29 20 3b 3b 20 70 6c 61 79 20 6e 69 p! 1) ;; play ni
108f0 63 65 20 77 69 74 68 20 74 68 65 20 71 75 65 75 ce with the queu
10900 65 20 62 79 20 65 6e 73 75 72 69 6e 67 20 74 68 e by ensuring th
10910 65 20 72 6f 6c 6c 75 70 20 69 73 20 61 74 20 6c e rollup is at l
10920 65 61 73 74 20 31 30 6d 73 20 6c 61 74 65 72 20 east 10ms later
10930 74 68 61 6e 20 74 68 65 20 73 65 74 0a 09 20 20 than the set..
10940 0a 09 20 20 3b 3b 20 69 66 20 74 68 65 20 74 65 .. ;; if the te
10950 73 74 20 69 73 20 6e 6f 74 20 46 41 49 4c 20 74 st is not FAIL t
10960 68 65 6e 20 73 65 74 20 73 74 61 74 75 73 20 62 hen set status b
10970 61 73 65 64 20 6f 6e 20 74 68 65 20 66 61 69 6c ased on the fail
10980 20 61 6e 64 20 70 61 73 73 20 63 6f 75 6e 74 73 and pass counts
10990 2e 0a 09 20 20 28 63 64 62 3a 74 65 73 74 2d 72 ... (cdb:test-r
109a0 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 2d ollup-test_data-
109b0 70 61 73 73 2d 66 61 69 6c 20 2a 72 75 6e 72 65 pass-fail *runre
109c0 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 0a 09 mote* test-id)..
109d0 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ;; (sqlite3:ex
109e0 65 63 75 74 65 0a 09 20 20 3b 3b 20 20 64 62 20 ecute.. ;; db
109f0 20 20 3b 3b 3b 20 4e 4f 54 45 3a 20 53 68 6f 75 ;;; NOTE: Shou
10a00 6c 64 20 74 68 69 73 20 62 65 20 57 41 52 4e 2c ld this be WARN,
10a10 46 41 49 4c 3f 20 41 20 57 41 52 4e 20 69 73 20 FAIL? A WARN is
10a20 6e 6f 74 20 61 20 46 41 49 4c 3f 3f 3f 3f 3f 20 not a FAIL?????
10a30 42 55 47 20 46 49 58 4d 45 0a 09 20 20 3b 3b 20 BUG FIXME.. ;;
10a40 20 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 "UPDATE tests.
10a50 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
10a60 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 SET stat
10a70 75 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 us=CASE WHEN (SE
10a80 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 20 LECT fail_count
10a90 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
10aa0 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 20 id=?) > 0 .
10ab0 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
10ac0 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 THEN 'FA
10ad0 49 4c 27 0a 20 20 20 20 20 20 20 20 20 20 3b 3b IL'. ;;
10ae0 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 WHE
10af0 4e 20 28 53 45 4c 45 43 54 20 70 61 73 73 5f 63 N (SELECT pass_c
10b00 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 ount FROM tests
10b10 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 WHERE id=?) > 0
10b20 41 4e 44 20 0a 20 20 20 20 20 20 20 20 20 20 3b AND . ;
10b30 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
10b40 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 (SELECT statu
10b50 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 s FROM tests WHE
10b60 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 RE id=?) NOT IN
10b70 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a ('WARN','FAIL').
10b80 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
10b90 20 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 50 THEN 'P
10ba0 41 53 53 27 0a 20 20 20 20 20 20 20 20 20 20 3b ASS'. ;
10bb0 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c ; EL
10bc0 53 45 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 SE status.
10bd0 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 45 ;; E
10be0 4e 44 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a ND WHERE id=?;".
10bf0 09 20 20 3b 3b 20 20 74 65 73 74 2d 69 64 20 74 . ;; test-id t
10c00 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 est-id test-id t
10c10 65 73 74 2d 69 64 29 0a 09 20 20 29 29 29 29 0a est-id).. )))).
10c20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
10c30 2d 70 72 65 76 2d 74 6f 6c 2d 66 6f 72 2d 74 65 -prev-tol-for-te
10c40 73 74 20 64 62 20 74 65 73 74 2d 69 64 20 63 61 st db test-id ca
10c50 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 29 tegory variable)
10c60 0a 20 20 3b 3b 20 46 69 6e 69 73 68 20 6d 65 3f . ;; Finish me?
10c70 0a 20 20 28 76 61 6c 75 65 73 20 23 66 20 23 66 . (values #f #f
10c80 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #f))..;;=======
10c90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10ca0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cb0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cc0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
10cd0 3b 3b 20 53 20 54 20 45 20 50 20 53 20 0a 3b 3b ;; S T E P S .;;
10ce0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10d20 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
10d30 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 74 69 6d (db:step-get-tim
10d40 65 2d 61 73 2d 73 74 72 69 6e 67 20 76 65 63 29 e-as-string vec)
10d50 0a 20 20 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d . (seconds->tim
10d60 65 2d 73 74 72 69 6e 67 20 28 64 62 3a 73 74 65 e-string (db:ste
10d70 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
10d80 20 76 65 63 29 29 29 0a 0a 3b 3b 20 64 62 2d 67 vec)))..;; db-g
10d90 65 74 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 6f et-test-steps-fo
10da0 72 2d 72 75 6e 0a 28 64 65 66 69 6e 65 20 28 64 r-run.(define (d
10db0 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
10dc0 74 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 test db test-id)
10dd0 0a 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 28 . (let* ((tdb (
10de0 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d db:open-test-db-
10df0 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 by-test-id db te
10e00 73 74 2d 69 64 29 29 0a 09 20 28 72 65 73 20 27 st-id)).. (res '
10e10 28 29 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 ())). (if tdb
10e20 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c ..(begin.. (sql
10e30 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
10e40 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 w .. (lambda (
10e50 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e id test-id stepn
10e60 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
10e70 20 65 76 65 6e 74 2d 74 69 6d 65 20 6c 6f 67 66 event-time logf
10e80 69 6c 65 29 0a 09 20 20 20 20 20 28 73 65 74 21 ile).. (set!
10e90 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 res (cons (vect
10ea0 6f 72 20 69 64 20 74 65 73 74 2d 69 64 20 73 74 or id test-id st
10eb0 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 epname state sta
10ec0 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 tus event-time (
10ed0 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 if (string? logf
10ee0 69 6c 65 29 20 6c 6f 67 66 69 6c 65 20 22 22 29 ile) logfile "")
10ef0 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 62 ) res))).. tdb
10f00 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c .. "SELECT id,
10f10 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 test_id,stepname
10f20 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
10f30 65 6e 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 ent_time,logfile
10f40 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 FROM test_steps
10f50 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
10f60 20 4f 52 44 45 52 20 42 59 20 69 64 20 41 53 43 ORDER BY id ASC
10f70 3b 22 20 3b 3b 20 65 76 65 6e 74 5f 74 69 6d 65 ;" ;; event_time
10f80 20 44 45 53 43 2c 69 64 20 41 53 43 3b 0a 09 20 DESC,id ASC;..
10f90 20 20 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 test-id).. (s
10fa0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
10fb0 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 72 73 tdb).. (revers
10fc0 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 29 0a e res))..'()))).
10fd0 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 79 .;; get a pretty
10fe0 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 72 table to summar
10ff0 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 64 65 ize steps.;;.(de
11000 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 fine (db:get-ste
11010 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 73 74 ps-table db test
11020 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 73 74 -id). (let ((st
11030 65 70 73 20 20 20 28 64 62 3a 67 65 74 2d 73 74 eps (db:get-st
11040 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 eps-for-test db
11050 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 3b test-id))). ;
11060 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 20 73 ; organise the s
11070 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 72 20 teps for better
11080 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 20 20 readability.
11090 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
110a0 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 -hash-table))).
110b0 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
110c0 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
110d0 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 3a 70 step).. (debug:p
110e0 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 20 73 rint 6 "step=" s
110f0 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 72 65 tep).. (let ((re
11100 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cord (hash-table
11110 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 09 09 -ref/default ...
11120 09 72 65 73 20 0a 09 09 09 28 64 62 3a 73 74 65 .res ....(db:ste
11130 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
11140 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 20 20 20 tep) ....;;
11150 20 20 20 73 74 65 70 6e 61 6d 65 20 20 20 20 20 stepname
11160 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 start
11170 20 65 6e 64 20 73 74 61 74 75 73 20 20 20 20 0a end status .
11180 09 09 09 28 76 65 63 74 6f 72 20 28 64 62 3a 73 ...(vector (db:s
11190 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
111a0 20 73 74 65 70 29 20 22 22 20 20 20 22 22 20 22 step) "" "" "
111b0 22 20 20 20 20 20 22 22 20 22 22 29 29 29 29 0a " "" "")))).
111c0 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
111d0 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 6f 72 6 "record(befor
111e0 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 e) = " record ..
111f0 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 .."\nid: "
11200 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
11210 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 step)...."\nste
11220 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 pname: " (db:ste
11230 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
11240 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 tep)...."\nstate
11250 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d : " (db:step-
11260 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
11270 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 ..."\nstatus:
11280 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
11290 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
112a0 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 \ntime: " (d
112b0 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
112c0 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 _time step))..
112d0 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
112e0 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 70 2d symbol (db:step-
112f0 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
11300 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
11310 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
11320 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 1 (db:step-ge
11330 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
11340 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11350 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 or-set! record 3
11360 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 (if (equal? (ve
11370 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 ctor-ref record
11380 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 62 3a 3) "")......(db:
11390 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
113a0 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
113b0 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
113c0 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d 67 65 ngth (db:step-ge
113d0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
113e0 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 ... 0)... (
113f0 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
11400 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 5 (db:step-ge
11410 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
11420 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 29 20 )).. ((end)
11430 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
11440 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 -set! record 2 (
11450 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
11460 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
11470 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 20 20 ime step)))..
11480 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
11490 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
114a0 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
114b0 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
114c0 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
114d0 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 20 28 (let ((startt (
114e0 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 any->number (vec
114f0 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
11500 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 64 74 )))...... (endt
11510 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 (any->number
11520 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
11530 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 20 20 rd 2)))).....
11540 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
11550 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 4 "record[1]=" (
11560 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
11570 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 20 22 d 1) ....... "
11580 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 72 74 , startt=" start
11590 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 t ", endt=" endt
115a0 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 65 74 ....... ", get
115b0 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 73 -status: " (db:s
115c0 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
115d0 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 tep)).....
115e0 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 (if (and (number
115f0 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 ? startt)(number
11600 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 ? endt))......
11610 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e (seconds->hr-min
11620 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 -sec (- endt sta
11630 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 rtt)) "-1")))..
11640 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
11650 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73 ing-length (db:s
11660 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
11670 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 step))... 0)
11680 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
11690 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73 ! record 5 (db:s
116a0 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
116b0 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 step)))).. (
116c0 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 65 63 else.. (vec
116d0 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
116e0 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 2 (db:step-get-s
116f0 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 20 20 tate step))..
11700 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
11710 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
11720 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
11730 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11740 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
11750 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
11760 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
11770 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ).. (hash-tabl
11780 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 3a 73 e-set! res (db:s
11790 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
117a0 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 0a 09 step) record)..
117b0 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
117c0 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 72 29 6 "record(after)
117d0 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 09 = " record ...
117e0 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 20 ."\nid: "
117f0 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 (db:step-get-id
11800 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 step)...."\nstep
11810 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 70 name: " (db:step
11820 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
11830 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a ep)...."\nstate:
11840 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 " (db:step-g
11850 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
11860 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
11870 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
11880 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c atus step)...."\
11890 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 62 ntime: " (db
118a0 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
118b0 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 20 20 time step)))).
118c0 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 20 20 ;; (else
118d0 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
118e0 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 ord 1 (db:step-g
118f0 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
11900 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 73 6f ep))). (so
11910 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 64 61 rt steps (lambda
11920 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 0a 09 (a b)... ..
11930 09 20 20 20 20 20 28 3c 20 28 64 62 3a 73 74 65 . (< (db:ste
11940 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
11950 20 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 2d a)(db:step-get-
11960 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 0a 09 event_time b))..
11970 09 20 20 20 20 20 0a 09 09 20 20 20 20 20 29 29 . ... ))
11980 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 0a 0a ). res)))..
11990 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
119a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
119b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
119c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
119d0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 49 20 ========.;; M I
119e0 53 20 43 20 20 20 4d 20 41 20 4e 20 41 20 47 20 S C M A N A G
119f0 45 20 4d 20 45 20 4e 20 54 20 20 20 49 20 54 20 E M E N T I T
11a00 45 20 4d 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d E M S .;;=======
11a10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11a20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11a30 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
11a50 0a 3b 3b 20 74 68 65 20 6e 65 77 20 70 72 65 72 .;; the new prer
11a60 65 71 73 20 63 61 6c 63 75 6c 61 74 69 6f 6e 2c eqs calculation,
11a70 20 6c 6f 6f 6b 73 20 61 6c 73 6f 20 61 74 20 69 looks also at i
11a80 74 65 6d 70 61 74 68 20 69 66 20 73 70 65 63 69 tempath if speci
11a90 66 69 65 64 0a 3b 3b 20 61 6c 6c 20 70 72 65 72 fied.;; all prer
11aa0 65 71 73 20 6d 75 73 74 20 62 65 20 6d 65 74 3a eqs must be met:
11ab0 0a 3b 3b 20 20 20 20 69 66 20 70 72 65 72 65 71 .;; if prereq
11ac0 20 74 65 73 74 20 77 69 74 68 20 69 74 65 6d 70 test with itemp
11ad0 61 74 68 3d 27 27 20 69 73 20 43 4f 4d 50 4c 45 ath='' is COMPLE
11ae0 54 45 44 20 61 6e 64 20 50 41 53 53 2c 20 57 41 TED and PASS, WA
11af0 52 4e 2c 20 43 48 45 43 4b 2c 20 6f 72 20 57 41 RN, CHECK, or WA
11b00 49 56 45 44 20 74 68 65 6e 20 70 72 65 72 65 71 IVED then prereq
11b10 20 69 73 20 6d 65 74 0a 3b 3b 20 20 20 20 69 66 is met.;; if
11b20 20 70 72 65 72 65 71 20 74 65 73 74 20 77 69 74 prereq test wit
11b30 68 20 69 74 65 6d 70 61 74 68 3d 72 65 66 2d 69 h itempath=ref-i
11b40 74 65 6d 2d 70 61 74 68 20 61 6e 64 20 43 4f 4d tem-path and COM
11b50 50 4c 45 54 45 44 20 77 69 74 68 20 50 41 53 53 PLETED with PASS
11b60 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 6f , WARN, CHECK, o
11b70 72 20 57 41 49 56 45 44 20 74 68 65 6e 20 70 72 r WAIVED then pr
11b80 65 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b 0a 3b ereq is met.;;.;
11b90 3b 20 4e 6f 74 65 3a 20 64 6f 20 6e 6f 74 20 63 ; Note: do not c
11ba0 6f 6e 76 65 72 74 20 74 6f 20 72 65 6d 6f 74 65 onvert to remote
11bb0 20 61 73 20 69 74 20 63 61 6c 6c 73 20 72 65 6d as it calls rem
11bc0 6f 74 65 20 75 6e 64 65 72 20 74 68 65 20 68 6f ote under the ho
11bd0 6f 64 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f 64 65 od.;; Note: mode
11be0 20 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 20 74 'normal means t
11bf0 68 61 74 20 74 65 73 74 73 20 6d 75 73 74 20 62 hat tests must b
11c00 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 e COMPLETED and
11c10 6f 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c 20 57 ok (i.e. PASS, W
11c20 41 52 4e 2c 20 43 48 45 43 4b 20 6f 72 20 57 41 ARN, CHECK or WA
11c30 49 56 45 44 29 0a 3b 3b 20 20 20 20 20 20 20 6d IVED).;; m
11c40 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 20 6d 65 ode 'toplevel me
11c50 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 6d ans that tests m
11c60 75 73 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 ust be COMPLETED
11c70 20 6f 6e 6c 79 0a 3b 3b 20 20 20 20 20 20 20 6d only.;; m
11c80 6f 64 65 20 27 69 74 65 6d 6d 61 74 63 68 20 6d ode 'itemmatch m
11c90 65 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 eans that tests
11ca0 69 74 65 6d 73 20 6d 75 73 74 20 62 65 20 43 4f items must be CO
11cb0 4d 50 4c 45 54 45 44 20 61 6e 64 20 28 50 41 53 MPLETED and (PAS
11cc0 53 7c 57 41 52 4e 7c 57 41 49 56 45 44 7c 43 48 S|WARN|WAIVED|CH
11cd0 45 43 4b 29 20 5b 5b 20 4e 42 2f 2f 20 4e 4f 54 ECK) [[ NB// NOT
11ce0 20 49 4d 50 4c 45 4d 45 4e 54 45 44 20 59 45 54 IMPLEMENTED YET
11cf0 20 5d 5d 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ]].;; .(define
11d00 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d (db:get-prereqs-
11d10 6e 6f 74 2d 6d 65 74 20 64 62 20 72 75 6e 2d 69 not-met db run-i
11d20 64 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 69 74 d waitons ref-it
11d30 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 20 28 6d em-path #!key (m
11d40 6f 64 65 20 27 6e 6f 72 6d 61 6c 29 29 0a 20 20 ode 'normal)).
11d50 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 77 61 69 (if (or (not wai
11d60 74 6f 6e 73 29 0a 09 20 20 28 6e 75 6c 6c 3f 20 tons).. (null?
11d70 77 61 69 74 6f 6e 73 29 29 0a 20 20 20 20 20 20 waitons)).
11d80 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 '(). (let*
11d90 28 28 75 6e 6d 65 74 2d 70 72 65 2d 72 65 71 73 ((unmet-pre-reqs
11da0 20 27 28 29 29 0a 09 20 20 20 20 20 28 72 65 73 '()).. (res
11db0 75 6c 74 20 20 20 20 20 20 20 20 20 27 28 29 29 ult '())
11dc0 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 )..(for-each ..
11dd0 28 6c 61 6d 62 64 61 20 28 77 61 69 74 6f 6e 74 (lambda (waitont
11de0 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 3b 3b est-name).. ;;
11df0 20 62 79 20 67 65 74 74 69 6e 67 20 74 68 65 20 by getting the
11e00 74 65 73 74 73 20 77 69 74 68 20 6d 61 74 63 68 tests with match
11e10 69 6e 67 20 6e 61 6d 65 20 77 65 20 61 72 65 20 ing name we are
11e20 6c 6f 6f 6b 69 6e 67 20 6f 6e 6c 79 20 61 74 20 looking only at
11e30 74 68 65 20 6d 61 74 63 68 69 6e 67 20 74 65 73 the matching tes
11e40 74 20 0a 09 20 20 20 3b 3b 20 61 6e 64 20 72 65 t .. ;; and re
11e50 6c 61 74 65 64 20 73 75 62 20 69 74 65 6d 73 0a lated sub items.
11e60 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 . (let ((tests
11e70 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 (db
11e80 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
11e90 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 77 61 69 un db run-id wai
11ea0 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 27 28 29 tontest-name '()
11eb0 20 27 28 29 29 29 0a 09 09 20 28 65 76 65 72 2d '()))... (ever-
11ec0 73 65 65 6e 20 20 20 20 20 20 20 20 20 23 66 29 seen #f)
11ed0 0a 09 09 20 28 70 61 72 65 6e 74 2d 77 61 69 74 ... (parent-wait
11ee0 6f 6e 2d 6d 65 74 20 23 66 29 0a 09 09 20 28 69 on-met #f)... (i
11ef0 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 20 tem-waiton-met
11f00 20 23 66 29 29 0a 09 20 20 20 20 20 28 66 6f 72 #f)).. (for
11f10 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 6c -each .. (l
11f20 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 3b ambda (test)...;
11f30 3b 20 28 69 66 20 28 65 71 75 61 6c 3f 20 77 61 ; (if (equal? wa
11f40 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 28 64 itontest-name (d
11f50 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
11f60 61 6d 65 20 74 65 73 74 29 29 20 3b 3b 20 62 79 ame test)) ;; by
11f70 20 64 65 66 69 6e 74 69 6f 6e 20 74 68 69 73 20 defintion this
11f80 68 61 64 20 62 65 74 74 65 72 20 62 65 20 74 72 had better be tr
11f90 75 65 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a 20 28 ue ......(let* (
11fa0 28 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 (state
11fb0 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
11fc0 73 74 61 74 65 20 74 65 73 74 29 29 0a 09 09 20 state test))...
11fd0 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
11fe0 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 (db:tes
11ff0 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
12000 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 74 t))... (it
12010 65 6d 2d 70 61 74 68 20 20 20 20 20 20 20 20 20 em-path
12020 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
12030 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 m-path test))...
12040 20 20 20 20 20 20 20 28 69 73 2d 63 6f 6d 70 6c (is-compl
12050 65 74 65 64 20 20 20 20 20 20 28 65 71 75 61 6c eted (equal
12060 3f 20 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 ? state "COMPLET
12070 45 44 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 ED"))... (
12080 69 73 2d 6f 6b 20 20 20 20 20 20 20 20 20 20 20 is-ok
12090 20 20 28 6d 65 6d 62 65 72 20 73 74 61 74 75 73 (member status
120a0 20 27 28 22 50 41 53 53 22 20 22 57 41 52 4e 22 '("PASS" "WARN"
120b0 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 "CHECK" "WAIVED
120c0 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 ")))... (s
120d0 61 6d 65 2d 69 74 65 6d 70 61 74 68 20 20 20 20 ame-itempath
120e0 20 28 65 71 75 61 6c 3f 20 72 65 66 2d 69 74 65 (equal? ref-ite
120f0 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 68 m-path item-path
12100 29 29 29 0a 09 09 20 20 28 73 65 74 21 20 65 76 )))... (set! ev
12110 65 72 2d 73 65 65 6e 20 23 74 29 0a 09 09 20 20 er-seen #t)...
12120 28 63 6f 6e 64 0a 09 09 20 20 20 3b 3b 20 63 61 (cond... ;; ca
12130 73 65 20 31 2c 20 6e 6f 6e 2d 69 74 65 6d 20 28 se 1, non-item (
12140 70 61 72 65 6e 74 20 74 65 73 74 29 20 69 73 20 parent test) is
12150 0a 09 09 20 20 20 28 28 61 6e 64 20 28 65 71 75 ... ((and (equ
12160 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
12170 29 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 ) ;; this is the
12180 20 70 61 72 65 6e 74 20 74 65 73 74 0a 09 09 09 parent test....
12190 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 09 is-completed...
121a0 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 71 3f . (or is-ok (eq?
121b0 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 mode 'toplevel)
121c0 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 70 ))... (set! p
121d0 61 72 65 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 arent-waiton-met
121e0 20 23 74 29 29 0a 09 09 20 20 20 28 28 61 6e 64 #t))... ((and
121f0 20 73 61 6d 65 2d 69 74 65 6d 70 61 74 68 0a 09 same-itempath..
12200 09 09 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a .. is-completed.
12210 09 09 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 ... (or is-ok (e
12220 71 3f 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 q? mode 'topleve
12230 6c 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 l)))... (set!
12240 20 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 item-waiton-met
12250 20 23 74 29 29 29 29 29 0a 09 20 20 20 20 20 20 #t)))))..
12260 74 65 73 74 73 29 0a 09 20 20 20 20 20 28 69 66 tests).. (if
12270 20 28 6e 6f 74 20 28 6f 72 20 70 61 72 65 6e 74 (not (or parent
12280 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 69 74 65 6d -waiton-met item
12290 2d 77 61 69 74 6f 6e 2d 6d 65 74 29 29 0a 09 09 -waiton-met))...
122a0 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 (set! result (a
122b0 70 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f ppend (if (null?
122c0 20 74 65 73 74 73 29 20 28 6c 69 73 74 20 77 61 tests) (list wa
122d0 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 itontest-name) t
122e0 65 73 74 73 29 20 72 65 73 75 6c 74 29 29 29 0a ests) result))).
122f0 09 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 . ;; if the
12300 74 65 73 74 20 69 73 20 6e 6f 74 20 66 6f 75 6e test is not foun
12310 64 20 74 68 65 6e 20 63 6c 65 61 72 6c 79 20 74 d then clearly t
12320 68 65 20 77 61 69 74 6f 6e 20 69 73 20 6e 6f 74 he waiton is not
12330 20 6d 65 74 2e 2e 2e 0a 09 20 20 20 20 20 3b 3b met..... ;;
12340 20 28 69 66 20 28 6e 6f 74 20 65 76 65 72 2d 73 (if (not ever-s
12350 65 65 6e 29 28 73 65 74 21 20 72 65 73 75 6c 74 een)(set! result
12360 20 28 63 6f 6e 73 20 77 61 69 74 6f 6e 74 65 73 (cons waitontes
12370 74 2d 6e 61 6d 65 20 72 65 73 75 6c 74 29 29 29 t-name result)))
12380 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f )).. (if (no
12390 74 20 65 76 65 72 2d 73 65 65 6e 29 0a 09 09 20 t ever-seen)...
123a0 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 (set! result (ap
123b0 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f 20 pend (if (null?
123c0 74 65 73 74 73 29 28 6c 69 73 74 20 77 61 69 74 tests)(list wait
123d0 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 65 73 ontest-name) tes
123e0 74 73 29 20 72 65 73 75 6c 74 29 29 29 29 29 0a ts) result))))).
123f0 09 20 77 61 69 74 6f 6e 73 29 0a 09 28 64 65 6c . waitons)..(del
12400 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 72 ete-duplicates r
12410 65 73 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 69 esult))))..(defi
12420 6e 65 20 28 64 62 3a 74 65 73 74 73 74 65 70 2d ne (db:teststep-
12430 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
12440 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d est-id teststep-
12450 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 name state-in st
12460 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 6e 74 20 atus-in comment
12470 6c 6f 67 66 69 6c 65 29 0a 20 20 28 64 65 62 75 logfile). (debu
12480 67 3a 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d g:print 4 "test-
12490 69 64 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 id: " test-id "
124a0 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 3a 20 22 teststep-name: "
124b0 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 29 0a teststep-name).
124c0 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 20 20 (let* ((tdb
124d0 20 20 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 (db:open-tes
124e0 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
124f0 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 db test-id)).. (
12500 73 74 61 74 65 20 20 20 20 20 28 63 68 65 63 6b state (check
12510 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 -valid-items "st
12520 61 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a ate" state-in)).
12530 09 20 28 73 74 61 74 75 73 20 20 20 20 28 63 68 . (status (ch
12540 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
12550 22 73 74 61 74 75 73 22 20 73 74 61 74 75 73 2d "status" status-
12560 69 6e 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f in))). (if (o
12570 72 20 28 6e 6f 74 20 73 74 61 74 65 29 28 6e 6f r (not state)(no
12580 74 20 73 74 61 74 75 73 29 29 0a 09 28 64 65 62 t status))..(deb
12590 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
125a0 49 4e 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 ING: Invalid " (
125b0 69 66 20 73 74 61 74 75 73 20 22 73 74 61 74 75 if status "statu
125c0 73 22 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 s" "state")...
125d0 20 20 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 " value \"" (
125e0 69 66 20 73 74 61 74 75 73 20 73 74 61 74 65 2d if status state-
125f0 69 6e 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c in status-in) "\
12600 22 2c 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 ", update your v
12610 61 6c 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 alidvalues secti
12620 6f 6e 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 on in megatest.c
12630 6f 6e 66 69 67 22 29 29 0a 20 20 20 20 28 69 66 onfig")). (if
12640 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 tdb..(begin..
12650 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
12660 20 0a 09 20 20 20 74 64 62 0a 09 20 20 20 22 49 .. tdb.. "I
12670 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
12680 20 69 6e 74 6f 20 74 65 73 74 5f 73 74 65 70 73 into test_steps
12690 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 (test_id,stepna
126a0 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c me,state,status,
126b0 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 event_time,comme
126c0 6e 74 2c 6c 6f 67 66 69 6c 65 29 20 56 41 4c 55 nt,logfile) VALU
126d0 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ES(?,?,?,?,?,?,?
126e0 29 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 );".. test-id
126f0 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
12700 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
12710 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
12720 73 29 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 s) (if comment c
12730 6f 6d 6d 65 6e 74 20 22 22 29 20 28 69 66 20 6c omment "") (if l
12740 6f 67 66 69 6c 65 20 6c 6f 67 66 69 6c 65 20 22 ogfile logfile "
12750 22 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ")).. (sqlite3:
12760 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
12770 20 20 23 74 29 0a 09 23 66 29 29 29 0a 0a 3b 3b #t)..#f)))..;;
12780 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12790 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
127c0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 ======.;; Extrac
127d0 74 20 6f 64 73 20 66 69 6c 65 20 66 72 6f 6d 20 t ods file from
127e0 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d the db.;;=======
127f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12800 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12810 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12820 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12830 0a 3b 3b 20 72 75 6e 73 70 61 74 74 20 69 73 20 .;; runspatt is
12840 61 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 a comma delimite
12850 64 20 6c 69 73 74 20 6f 66 20 72 75 6e 20 70 61 d list of run pa
12860 74 74 65 72 6e 73 0a 3b 3b 20 6b 65 79 70 61 74 tterns.;; keypat
12870 74 2d 61 6c 69 73 74 20 6d 75 73 74 20 63 6f 6e t-alist must con
12880 74 61 69 6e 20 2a 61 6c 6c 2a 20 6b 65 79 73 20 tain *all* keys
12890 77 69 74 68 20 61 6e 20 61 73 73 6f 63 69 61 74 with an associat
128a0 65 64 20 70 61 74 74 65 72 6e 3a 20 27 28 20 28 ed pattern: '( (
128b0 22 4b 45 59 31 22 20 22 25 22 29 20 2e 2e 20 29 "KEY1" "%") .. )
128c0 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 65 78 74 .(define (db:ext
128d0 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 ract-ods-file db
128e0 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 70 outputfile keyp
128f0 61 74 74 2d 61 6c 69 73 74 20 72 75 6e 73 70 61 att-alist runspa
12900 74 74 20 70 61 74 68 6d 6f 64 29 0a 20 20 28 6c tt pathmod). (l
12910 65 74 2a 20 28 28 6b 65 79 73 73 74 72 20 20 28 et* ((keysstr (
12920 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12930 73 65 20 28 6d 61 70 20 63 61 72 20 6b 65 79 70 se (map car keyp
12940 61 74 74 2d 61 6c 69 73 74 29 20 22 2c 22 29 29 att-alist) ","))
12950 0a 09 20 28 6b 65 79 71 72 79 20 20 20 28 73 74 .. (keyqry (st
12960 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
12970 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 (map (lambda (p
12980 29 28 63 6f 6e 63 20 28 63 61 72 20 70 29 20 22 )(conc (car p) "
12990 20 4c 49 4b 45 20 3f 20 22 29 29 20 6b 65 79 70 LIKE ? ")) keyp
129a0 61 74 74 2d 61 6c 69 73 74 29 20 22 20 41 4e 44 att-alist) " AND
129b0 20 22 29 29 0a 09 20 28 6e 75 6d 6b 65 79 73 20 ")).. (numkeys
129c0 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 (length keypatt
129d0 2d 61 6c 69 73 74 29 29 0a 09 20 28 74 65 73 74 -alist)).. (test
129e0 2d 69 64 73 20 27 28 29 29 0a 09 20 28 77 69 6e -ids '()).. (win
129f0 64 6f 77 73 20 20 28 61 6e 64 20 70 61 74 68 6d dows (and pathm
12a00 6f 64 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e od (substring-in
12a10 64 65 78 20 22 5c 5c 22 20 70 61 74 68 6d 6f 64 dex "\\" pathmod
12a20 29 29 29 0a 09 20 28 74 65 6d 70 64 69 72 20 20 ))).. (tempdir
12a30 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
12a40 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
12a50 29 20 22 2f 22 20 72 75 6e 73 70 61 74 74 20 22 ) "/" runspatt "
12a60 5f 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 _" (random 10000
12a70 29 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 ) "_" (current-p
12a80 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 20 28 rocess-id))).. (
12a90 72 75 6e 73 68 65 61 64 65 72 20 28 61 70 70 65 runsheader (appe
12aa0 6e 64 20 28 6c 69 73 74 20 22 52 75 6e 20 49 64 nd (list "Run Id
12ab0 22 20 22 52 75 6e 6e 61 6d 65 22 29 20 3b 20 30 " "Runname") ; 0
12ac0 20 31 0a 09 09 09 20 20 20 20 20 28 6d 61 70 20 1.... (map
12ad0 63 61 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 car keypatt-alis
12ae0 74 29 20 20 20 3b 20 2b 20 4e 20 3d 20 6c 65 6e t) ; + N = len
12af0 67 74 68 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 gth keypatt-alis
12b00 74 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 t.... (list
12b10 22 54 65 73 74 6e 61 6d 65 22 20 20 20 20 20 20 "Testname"
12b20 20 20 20 20 3b 20 32 0a 09 09 09 09 20 20 20 22 ; 2..... "
12b30 49 74 65 6d 20 50 61 74 68 22 20 20 20 20 20 20 Item Path"
12b40 20 20 20 3b 20 33 20 0a 09 09 09 09 20 20 20 22 ; 3 ..... "
12b50 44 65 73 63 72 69 70 74 69 6f 6e 22 20 20 20 20 Description"
12b60 20 20 20 3b 20 34 20 0a 09 09 09 09 20 20 20 22 ; 4 ..... "
12b70 53 74 61 74 65 22 20 20 20 20 20 20 20 20 20 20 State"
12b80 20 20 20 3b 20 35 20 0a 09 09 09 09 20 20 20 22 ; 5 ..... "
12b90 53 74 61 74 75 73 22 20 20 20 20 20 20 20 20 20 Status"
12ba0 20 20 20 3b 20 36 20 20 0a 09 09 09 09 20 20 20 ; 6 .....
12bb0 22 46 69 6e 61 6c 20 4c 6f 67 22 20 20 20 20 20 "Final Log"
12bc0 20 20 20 20 3b 20 37 20 0a 09 09 09 09 20 20 20 ; 7 .....
12bd0 22 52 75 6e 20 44 75 72 61 74 69 6f 6e 22 20 20 "Run Duration"
12be0 20 20 20 20 3b 20 38 20 0a 09 09 09 09 20 20 20 ; 8 .....
12bf0 22 57 68 65 6e 20 52 75 6e 22 20 20 20 20 20 20 "When Run"
12c00 20 20 20 20 3b 20 39 20 0a 09 09 09 09 20 20 20 ; 9 .....
12c10 22 54 61 67 73 22 20 20 20 20 20 20 20 20 20 20 "Tags"
12c20 20 20 20 20 3b 20 31 30 0a 09 09 09 09 20 20 20 ; 10.....
12c30 22 52 75 6e 20 4f 77 6e 65 72 22 20 20 20 20 20 "Run Owner"
12c40 20 20 20 20 3b 20 31 31 0a 09 09 09 09 20 20 20 ; 11.....
12c50 22 43 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 20 "Comment"
12c60 20 20 20 20 3b 20 31 32 0a 09 09 09 09 20 20 20 ; 12.....
12c70 22 41 75 74 68 6f 72 22 20 20 20 20 20 20 20 20 "Author"
12c80 20 20 20 20 3b 20 31 33 0a 09 09 09 09 20 20 20 ; 13.....
12c90 22 54 65 73 74 20 4f 77 6e 65 72 22 20 20 20 20 "Test Owner"
12ca0 20 20 20 20 3b 20 31 34 0a 09 09 09 09 20 20 20 ; 14.....
12cb0 22 52 65 76 69 65 77 65 64 22 20 20 20 20 20 20 "Reviewed"
12cc0 20 20 20 20 3b 20 31 35 0a 09 09 09 09 20 20 20 ; 15.....
12cd0 22 44 69 73 6b 66 72 65 65 22 20 20 20 20 20 20 "Diskfree"
12ce0 20 20 20 20 3b 20 31 36 0a 09 09 09 09 20 20 20 ; 16.....
12cf0 22 55 6e 61 6d 65 22 20 20 20 20 20 20 20 20 20 "Uname"
12d00 20 20 20 20 3b 20 31 37 0a 09 09 09 09 20 20 20 ; 17.....
12d10 22 52 75 6e 64 69 72 22 20 20 20 20 20 20 20 20 "Rundir"
12d20 20 20 20 20 3b 20 31 38 0a 09 09 09 09 20 20 20 ; 18.....
12d30 22 48 6f 73 74 22 20 20 20 20 20 20 20 20 20 20 "Host"
12d40 20 20 20 20 3b 20 31 39 0a 09 09 09 09 20 20 20 ; 19.....
12d50 22 43 70 75 20 4c 6f 61 64 22 20 20 20 20 20 20 "Cpu Load"
12d60 20 20 20 20 3b 20 32 30 0a 09 09 09 09 20 20 20 ; 20.....
12d70 29 29 29 0a 09 20 28 72 65 73 75 6c 74 73 20 28 ))).. (results (
12d80 6c 69 73 74 20 72 75 6e 73 68 65 61 64 65 72 29 list runsheader)
12d90 29 09 09 09 20 0a 09 20 28 74 65 73 74 64 61 74 )... .. (testdat
12da0 61 2d 68 65 61 64 65 72 20 28 6c 69 73 74 20 22 a-header (list "
12db0 52 75 6e 20 49 64 22 20 22 54 65 73 74 6e 61 6d Run Id" "Testnam
12dc0 65 22 20 22 49 74 65 6d 20 50 61 74 68 22 20 22 e" "Item Path" "
12dd0 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 61 Category" "Varia
12de0 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 78 ble" "Value" "Ex
12df0 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 55 pected" "Tol" "U
12e00 6e 69 74 73 22 20 22 53 74 61 74 75 73 22 20 22 nits" "Status" "
12e10 43 6f 6d 6d 65 6e 74 22 29 29 0a 09 20 28 6d 61 Comment")).. (ma
12e20 69 6e 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c inqry (conc "SEL
12e30 45 43 54 0a 20 20 20 20 20 20 20 20 20 20 20 20 ECT.
12e40 20 20 74 2e 74 65 73 74 6e 61 6d 65 2c 72 2e 69 t.testname,r.i
12e50 64 2c 72 75 6e 6e 61 6d 65 2c 22 20 6b 65 79 73 d,runname," keys
12e60 73 74 72 20 22 2c 74 2e 74 65 73 74 6e 61 6d 65 str ",t.testname
12e70 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
12e80 74 2e 69 74 65 6d 5f 70 61 74 68 2c 74 6d 2e 64 t.item_path,tm.d
12e90 65 73 63 72 69 70 74 69 6f 6e 2c 74 2e 73 74 61 escription,t.sta
12ea0 74 65 2c 74 2e 73 74 61 74 75 73 2c 0a 20 20 20 te,t.status,.
12eb0 20 20 20 20 20 20 20 20 20 20 20 66 69 6e 61 6c final
12ec0 5f 6c 6f 67 66 2c 72 75 6e 5f 64 75 72 61 74 69 _logf,run_durati
12ed0 6f 6e 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 on, .
12ee0 20 20 20 73 74 72 66 74 69 6d 65 28 27 25 6d 2f strftime('%m/
12ef0 25 64 2f 25 59 20 25 48 3a 25 4d 3a 25 53 27 2c %d/%Y %H:%M:%S',
12f00 64 61 74 65 74 69 6d 65 28 74 2e 65 76 65 6e 74 datetime(t.event
12f10 5f 74 69 6d 65 2c 27 75 6e 69 78 65 70 6f 63 68 _time,'unixepoch
12f20 27 29 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 2c '),'localtime'),
12f30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 . t
12f40 6d 2e 74 61 67 73 2c 72 2e 6f 77 6e 65 72 2c 74 m.tags,r.owner,t
12f50 2e 63 6f 6d 6d 65 6e 74 2c 0a 20 20 20 20 20 20 .comment,.
12f60 20 20 20 20 20 20 20 20 61 75 74 68 6f 72 2c 0a author,.
12f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6d tm
12f80 2e 6f 77 6e 65 72 2c 72 65 76 69 65 77 65 64 2c .owner,reviewed,
12f90 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 . d
12fa0 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 iskfree,uname,ru
12fb0 6e 64 69 72 2c 0a 20 20 20 20 20 20 20 20 20 20 ndir,.
12fc0 20 20 20 20 68 6f 73 74 2c 63 70 75 6c 6f 61 64 host,cpuload
12fd0 0a 20 20 20 20 20 20 20 20 20 20 20 20 46 52 4f . FRO
12fe0 4d 20 74 65 73 74 73 20 41 53 20 74 20 4a 4f 49 M tests AS t JOI
12ff0 4e 20 72 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 N runs AS r ON t
13000 2e 72 75 6e 5f 69 64 3d 72 2e 69 64 20 4a 4f 49 .run_id=r.id JOI
13010 4e 20 74 65 73 74 5f 6d 65 74 61 20 41 53 20 74 N test_meta AS t
13020 6d 20 4f 4e 20 74 6d 2e 74 65 73 74 6e 61 6d 65 m ON tm.testname
13030 3d 74 2e 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 =t.testname.
13040 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 WHERE ru
13050 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 41 4e 44 nname LIKE ? AND
13060 20 22 20 6b 65 79 71 72 79 20 22 3b 22 29 29 29 " keyqry ";")))
13070 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13080 74 20 32 20 22 55 73 69 6e 67 20 22 20 74 65 6d t 2 "Using " tem
13090 70 64 69 72 20 22 20 66 6f 72 20 63 6f 6e 73 74 pdir " for const
130a0 72 75 63 74 69 6e 67 20 74 68 65 20 6f 64 73 20 ructing the ods
130b0 66 69 6c 65 2e 20 6b 65 79 71 72 79 3a 20 22 20 file. keyqry: "
130c0 6b 65 79 71 72 79 20 22 20 6b 65 79 73 74 72 3a keyqry " keystr:
130d0 20 22 20 6b 65 79 73 73 74 72 20 22 20 77 69 74 " keysstr " wit
130e0 68 20 6b 65 79 73 3a 20 22 20 28 6d 61 70 20 63 h keys: " (map c
130f0 61 64 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 adr keypatt-alis
13100 74 29 0a 09 09 20 22 5c 6e 20 20 20 20 20 20 6d t)... "\n m
13110 61 69 6e 71 72 79 3a 20 22 20 6d 61 69 6e 71 72 ainqry: " mainqr
13120 79 29 0a 20 20 20 20 3b 3b 20 22 45 78 70 65 63 y). ;; "Expec
13130 74 65 64 20 56 61 6c 75 65 22 0a 20 20 20 20 3b ted Value". ;
13140 3b 20 22 56 61 6c 75 65 20 46 6f 75 6e 64 22 0a ; "Value Found".
13150 20 20 20 20 3b 3b 20 22 54 6f 6c 65 72 61 6e 63 ;; "Toleranc
13160 65 22 0a 20 20 20 20 28 61 70 70 6c 79 20 73 71 e". (apply sq
13170 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
13180 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 ow.. (lambda (
13190 74 65 73 74 2d 69 64 20 2e 20 62 29 0a 09 20 20 test-id . b)..
131a0 20 20 20 28 73 65 74 21 20 74 65 73 74 2d 69 64 (set! test-id
131b0 73 20 28 63 6f 6e 73 20 74 65 73 74 2d 69 64 20 s (cons test-id
131c0 74 65 73 74 2d 69 64 73 29 29 20 20 20 3b 3b 20 test-ids)) ;;
131d0 74 65 73 74 2d 69 64 20 69 73 20 6e 6f 77 20 74 test-id is now t
131e0 65 73 74 6e 61 6d 65 0a 09 20 20 20 20 20 28 73 estname.. (s
131f0 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 70 et! results (app
13200 65 6e 64 20 72 65 73 75 6c 74 73 20 3b 3b 20 6e end results ;; n
13210 6f 74 65 2c 20 64 72 6f 70 20 74 68 65 20 74 65 ote, drop the te
13220 73 74 2d 69 64 0a 09 09 09 09 20 20 20 28 6c 69 st-id..... (li
13230 73 74 0a 09 09 09 09 20 20 20 20 28 69 66 20 70 st..... (if p
13240 61 74 68 6d 6f 64 0a 09 09 09 09 09 28 6c 65 74 athmod......(let
13250 2a 20 28 28 76 62 20 20 20 20 20 20 20 20 28 61 * ((vb (a
13260 70 70 6c 79 20 76 65 63 74 6f 72 20 62 29 29 0a pply vector b)).
13270 09 09 09 09 09 20 20 20 20 20 20 20 28 6b 65 79 ..... (key
13280 76 61 6c 73 20 20 20 28 6c 65 74 20 6c 6f 6f 70 vals (let loop
13290 20 28 28 69 20 20 20 20 30 29 0a 09 09 09 09 09 ((i 0)......
132a0 09 09 09 20 20 20 20 20 28 72 65 73 20 27 28 29 ... (res '()
132b0 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 ))........ (i
132c0 66 20 28 3e 3d 20 69 20 6e 75 6d 6b 65 79 73 29 f (>= i numkeys)
132d0 0a 09 09 09 09 09 09 09 09 72 65 73 0a 09 09 09 .........res....
132e0 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 20 .....(loop (+ i
132f0 31 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 1).........
13300 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
13310 73 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 st (vector-ref v
13320 62 20 28 2b 20 69 20 32 29 29 29 29 29 29 29 29 b (+ i 2))))))))
13330 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 ...... (ru
13340 6e 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d nname (vector-
13350 72 65 66 20 76 62 20 31 29 29 0a 09 09 09 09 09 ref vb 1))......
13360 20 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 (testname
13370 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 (vector-ref vb
13380 20 28 2b 20 20 32 20 6e 75 6d 6b 65 79 73 29 29 (+ 2 numkeys))
13390 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 )...... (i
133a0 74 65 6d 2d 70 61 74 68 20 28 76 65 63 74 6f 72 tem-path (vector
133b0 2d 72 65 66 20 76 62 20 28 2b 20 20 33 20 6e 75 -ref vb (+ 3 nu
133c0 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 mkeys)))......
133d0 20 20 20 20 20 28 66 69 6e 61 6c 2d 6c 6f 67 20 (final-log
133e0 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 (vector-ref vb (
133f0 2b 20 20 37 20 6e 75 6d 6b 65 79 73 29 29 29 0a + 7 numkeys))).
13400 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ..... (run
13410 2d 64 69 72 20 20 20 28 76 65 63 74 6f 72 2d 72 -dir (vector-r
13420 65 66 20 76 62 20 28 2b 20 31 38 20 6e 75 6d 6b ef vb (+ 18 numk
13430 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 eys)))......
13440 20 20 20 28 6c 6f 67 2d 66 70 61 74 68 20 28 63 (log-fpath (c
13450 6f 6e 63 20 72 75 6e 2d 64 69 72 20 22 2f 22 20 onc run-dir "/"
13460 20 66 69 6e 61 6c 2d 6c 6f 67 29 29 29 20 3b 3b final-log))) ;;
13470 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
13480 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22 erse keyvals "/"
13490 29 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 20 22 ) "/" testname "
134a0 2f 22 20 69 74 65 6d 2d 70 61 74 68 20 22 2f 22 /" item-path "/"
134b0 0a 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
134c0 72 69 6e 74 20 34 20 22 6c 6f 67 3a 20 22 20 6c rint 4 "log: " l
134d0 6f 67 2d 66 70 61 74 68 20 22 20 65 78 69 73 74 og-fpath " exist
134e0 73 3a 20 22 20 28 66 69 6c 65 2d 65 78 69 73 74 s: " (file-exist
134f0 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 29 0a 09 s? log-fpath))..
13500 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 .... (vector-se
13510 74 21 20 76 62 20 28 2b 20 37 20 6e 75 6d 6b 65 t! vb (+ 7 numke
13520 79 73 29 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ys) (if (file-ex
13530 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 ists? log-fpath)
13540 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 6c .......... (l
13550 65 74 20 28 28 6e 65 77 70 61 74 68 20 28 63 6f et ((newpath (co
13560 6e 63 20 70 61 74 68 6d 6f 64 20 22 2f 22 0a 09 nc pathmod "/"..
13570 09 09 09 09 09 09 09 09 09 09 09 20 28 73 74 72 ........... (str
13580 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
13590 6b 65 79 76 61 6c 73 20 22 2f 22 29 0a 09 09 09 keyvals "/")....
135a0 09 09 09 09 09 09 09 09 09 20 22 2f 22 20 72 75 ......... "/" ru
135b0 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
135c0 6d 65 20 22 2f 22 0a 09 09 09 09 09 09 09 09 09 me "/"..........
135d0 09 09 09 20 28 69 66 20 28 73 74 72 69 6e 67 3d ... (if (string=
135e0 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 20 ? item-path "")
135f0 22 22 20 28 63 6f 6e 63 20 22 2f 22 20 69 74 65 "" (conc "/" ite
13600 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 m-path))........
13610 09 09 09 09 09 20 66 69 6e 61 6c 2d 6c 6f 67 29 ..... final-log)
13620 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
13630 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 74 68 72 ;; for now thr
13640 6f 77 20 61 77 61 79 20 6e 65 77 70 61 74 68 20 ow away newpath
13650 61 6e 64 20 75 73 65 20 74 68 65 20 6c 6f 67 2d and use the log-
13660 66 70 61 74 68 20 63 6f 6e 63 27 64 20 77 69 74 fpath conc'd wit
13670 68 20 70 61 74 68 6d 6f 64 0a 09 09 09 09 09 09 h pathmod.......
13680 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 6e ... (set! n
13690 65 77 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 ewpath (conc pat
136a0 68 6d 6f 64 20 6c 6f 67 2d 66 70 61 74 68 29 29 hmod log-fpath))
136b0 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
136c0 28 69 66 20 77 69 6e 64 6f 77 73 20 28 73 74 72 (if windows (str
136d0 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 6e 65 ing-translate ne
136e0 77 70 61 74 68 20 22 2f 22 20 22 5c 5c 22 29 20 wpath "/" "\\")
136f0 6e 65 77 70 61 74 68 29 29 0a 09 09 09 09 09 09 newpath)).......
13700 09 09 09 20 20 20 20 28 69 66 20 28 64 65 62 75 ... (if (debu
13710 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 0a g:debug-mode 1).
13720 09 09 09 09 09 09 09 09 09 09 28 63 6f 6e 63 20 ..........(conc
13730 66 69 6e 61 6c 2d 6c 6f 67 20 22 20 6e 6f 74 2d final-log " not-
13740 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 09 09 found").........
13750 09 09 22 22 29 29 29 0a 09 09 09 09 09 20 20 28 .."")))...... (
13760 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 62 29 vector->list vb)
13770 29 0a 09 09 09 09 09 62 29 29 29 29 29 0a 09 20 )......b)))))..
13780 20 20 64 62 0a 09 20 20 20 6d 61 69 6e 71 72 79 db.. mainqry
13790 0a 09 20 20 20 72 75 6e 73 70 61 74 74 20 28 6d .. runspatt (m
137a0 61 70 20 63 61 64 72 20 6b 65 79 70 61 74 74 2d ap cadr keypatt-
137b0 61 6c 69 73 74 29 29 0a 20 20 20 20 28 64 65 62 alist)). (deb
137c0 75 67 3a 70 72 69 6e 74 20 32 20 22 46 6f 75 6e ug:print 2 "Foun
137d0 64 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 d " (length test
137e0 2d 69 64 73 29 20 22 20 72 65 63 6f 72 64 73 22 -ids) " records"
137f0 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 75 ). (set! resu
13800 6c 74 73 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 lts (list (cons
13810 22 52 75 6e 73 22 20 72 65 73 75 6c 74 73 29 29 "Runs" results))
13820 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 2c 20 66 6f ). ;; now, fo
13830 72 20 65 61 63 68 20 74 65 73 74 2c 20 63 6f 6c r each test, col
13840 6c 65 63 74 20 74 68 65 20 74 65 73 74 5f 64 61 lect the test_da
13850 74 61 20 69 6e 66 6f 20 61 6e 64 20 61 64 64 20 ta info and add
13860 61 20 6e 65 77 20 73 68 65 65 74 0a 20 20 20 20 a new sheet.
13870 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 (for-each. (
13880 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 29 lambda (test-id)
13890 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
138a0 65 73 74 2d 64 61 74 61 20 28 6c 69 73 74 20 74 est-data (list t
138b0 65 73 74 64 61 74 61 2d 68 65 61 64 65 72 29 29 estdata-header))
138c0 0a 09 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 .. (curr-tes
138d0 74 2d 6e 61 6d 65 20 23 66 29 29 0a 09 20 28 73 t-name #f)).. (s
138e0 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
138f0 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 row.. (lambda (
13900 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
13910 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 6f item-path catego
13920 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
13930 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
13940 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d 6d nits status comm
13950 65 6e 74 29 0a 09 20 20 20 20 28 73 65 74 21 20 ent).. (set!
13960 63 75 72 72 2d 74 65 73 74 2d 6e 61 6d 65 20 74 curr-test-name t
13970 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 28 73 estname).. (s
13980 65 74 21 20 74 65 73 74 2d 64 61 74 61 20 28 61 et! test-data (a
13990 70 70 65 6e 64 20 74 65 73 74 2d 64 61 74 61 20 ppend test-data
139a0 28 6c 69 73 74 20 28 6c 69 73 74 20 72 75 6e 2d (list (list run-
139b0 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
139c0 2d 70 61 74 68 20 63 61 74 65 67 6f 72 79 20 76 -path category v
139d0 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 78 ariable value ex
139e0 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 pected tol units
139f0 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 status comment)
13a00 29 29 29 29 0a 09 20 20 64 62 20 0a 09 20 20 3b )))).. db .. ;
13a10 3b 20 22 53 45 4c 45 43 54 20 72 75 6e 5f 69 64 ; "SELECT run_id
13a20 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
13a30 61 74 68 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 ath,category,var
13a40 69 61 62 6c 65 2c 74 64 2e 76 61 6c 75 65 20 41 iable,td.value A
13a50 53 20 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 S value,expected
13a60 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 64 2e 73 74 ,tol,units,td.st
13a70 61 74 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 atus AS status,t
13a80 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d d.comment AS com
13a90 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 ment FROM test_d
13aa0 61 74 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 ata AS td INNER
13ab0 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 JOIN tests ON te
13ac0 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 sts.id=td.test_i
13ad0 64 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d d WHERE test_id=
13ae0 3f 3b 22 0a 09 20 20 22 53 45 4c 45 43 54 20 72 ?;".. "SELECT r
13af0 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 un_id,testname,i
13b00 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 tem_path,categor
13b10 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 y,variable,td.va
13b20 6c 75 65 20 41 53 20 76 61 6c 75 65 2c 74 64 2e lue AS value,td.
13b30 65 78 70 65 63 74 65 64 2c 74 64 2e 74 6f 6c 2c expected,td.tol,
13b40 74 64 2e 75 6e 69 74 73 2c 74 64 2e 73 74 61 74 td.units,td.stat
13b50 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 64 2e us AS status,td.
13b60 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d 6d 65 comment AS comme
13b70 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 nt FROM test_dat
13b80 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 4a 4f a AS td INNER JO
13b90 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 73 74 IN tests ON test
13ba0 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 64 20 s.id=td.test_id
13bb0 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f WHERE testname=?
13bc0 3b 22 0a 09 20 20 74 65 73 74 2d 69 64 29 0a 09 ;".. test-id)..
13bd0 20 28 69 66 20 63 75 72 72 2d 74 65 73 74 2d 6e (if curr-test-n
13be0 61 6d 65 0a 09 20 20 20 20 20 28 73 65 74 21 20 ame.. (set!
13bf0 72 65 73 75 6c 74 73 20 28 61 70 70 65 6e 64 20 results (append
13c00 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 63 results (list (c
13c10 6f 6e 73 20 63 75 72 72 2d 74 65 73 74 2d 6e 61 ons curr-test-na
13c20 6d 65 20 74 65 73 74 2d 64 61 74 61 29 29 29 29 me test-data))))
13c30 29 0a 09 20 29 29 0a 20 20 20 20 20 28 73 6f 72 ).. )). (sor
13c40 74 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 t (delete-duplic
13c50 61 74 65 73 20 74 65 73 74 2d 69 64 73 29 20 73 ates test-ids) s
13c60 74 72 69 6e 67 3c 3d 29 29 0a 20 20 20 20 28 73 tring<=)). (s
13c70 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 ystem (conc "mkd
13c80 69 72 20 2d 70 20 22 20 74 65 6d 70 64 69 72 29 ir -p " tempdir)
13c90 29 0a 20 20 20 20 3b 3b 20 28 70 70 20 72 65 73 ). ;; (pp res
13ca0 75 6c 74 73 29 0a 20 20 20 20 28 6f 64 73 3a 6c ults). (ods:l
13cb0 69 73 74 2d 3e 6f 64 73 20 0a 20 20 20 20 20 74 ist->ods . t
13cc0 65 6d 70 64 69 72 0a 20 20 20 20 20 28 69 66 20 empdir. (if
13cd0 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 (string-match (r
13ce0 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 egexp "^[/~]+.*"
13cf0 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b ) outputfile) ;;
13d00 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 20 6f 75 full path?.. ou
13d10 74 70 75 74 66 69 6c 65 0a 09 20 28 62 65 67 69 tputfile.. (begi
13d20 6e 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 n.. (debug:pri
13d30 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 70 nt 0 "WARNING: p
13d40 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f 75 74 ath given, " out
13d50 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 65 6c putfile " is rel
13d60 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 6e 67 ative, prefixing
13d70 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 64 69 with current di
13d80 72 65 63 74 6f 72 79 22 29 0a 09 20 20 20 28 63 rectory").. (c
13d90 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 onc (current-dir
13da0 65 63 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 ectory) "/" outp
13db0 75 74 66 69 6c 65 29 29 29 0a 20 20 20 20 20 72 utfile))). r
13dc0 65 73 75 6c 74 73 29 0a 20 20 20 20 3b 3b 20 62 esults). ;; b
13dd0 72 75 74 61 6c 20 63 6c 65 61 6e 20 75 70 0a 20 rutal clean up.
13de0 20 20 20 28 73 79 73 74 65 6d 20 22 72 6d 20 2d (system "rm -
13df0 72 66 20 74 65 6d 70 64 69 72 22 29 29 29 0a 0a rf tempdir")))..
13e00 3b 3b 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f ;; (db:extract-o
13e10 64 73 2d 66 69 6c 65 20 64 62 20 22 6f 75 74 70 ds-file db "outp
13e20 75 74 66 69 6c 65 2e 6f 64 73 22 20 27 28 28 22 utfile.ods" '(("
13e30 73 79 73 6e 61 6d 65 22 20 22 25 22 29 28 22 66 sysname" "%")("f
13e40 73 6e 61 6d 65 22 20 22 25 22 29 28 22 64 61 74 sname" "%")("dat
13e50 61 70 61 74 68 22 20 22 25 22 29 29 20 22 25 22 apath" "%")) "%"
13e60 29 0a ).