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 6c 65 74 2a 20 28 28 70 75 73 s). (let* ((pus
bd30: 68 2d 73 6f 63 6b 65 74 20 28 76 65 63 74 6f 72 h-socket (vector
bd40: 2d 72 65 66 20 7a 6d 71 2d 73 6f 63 6b 65 74 73 -ref zmq-sockets
bd50: 20 30 29 29 0a 09 20 28 73 75 62 2d 73 6f 63 6b 0)).. (sub-sock
bd60: 65 74 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 et (vector-ref
bd70: 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 31 29 29 0a zmq-sockets 1)).
bd80: 09 20 28 63 6c 69 65 6e 74 2d 73 69 67 20 20 28 . (client-sig (
bd90: 73 65 72 76 65 72 3a 67 65 74 2d 63 6c 69 65 6e server:get-clien
bda0: 74 2d 73 69 67 6e 61 74 75 72 65 29 29 0a 09 20 t-signature))..
bdb0: 28 71 75 65 72 79 2d 73 69 67 20 20 20 28 6d 65 (query-sig (me
bdc0: 73 73 61 67 65 2d 64 69 67 65 73 74 2d 73 74 72 ssage-digest-str
bdd0: 69 6e 67 20 28 6d 64 35 2d 70 72 69 6d 69 74 69 ing (md5-primiti
bde0: 76 65 29 20 28 63 6f 6e 63 20 71 74 79 70 65 20 ve) (conc qtype
bdf0: 69 6d 6d 65 64 69 61 74 65 20 70 61 72 61 6d 73 immediate params
be00: 29 29 29 0a 09 20 28 7a 64 61 74 20 20 20 20 20 ))).. (zdat
be10: 20 20 20 28 64 62 3a 6f 62 6a 2d 3e 73 74 72 69 (db:obj->stri
be20: 6e 67 20 28 76 65 63 74 6f 72 20 63 6c 69 65 6e ng (vector clien
be30: 74 2d 73 69 67 20 71 74 79 70 65 20 69 6d 6d 65 t-sig qtype imme
be40: 64 69 61 74 65 20 71 75 65 72 79 2d 73 69 67 20 diate query-sig
be50: 70 61 72 61 6d 73 20 28 63 75 72 72 65 6e 74 2d params (current-
be60: 73 65 63 6f 6e 64 73 29 29 29 29 20 3b 3b 20 28 seconds)))) ;; (
be70: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
be80: 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 tring (lambda ()
be90: 28 73 65 72 69 61 6c 69 7a 65 20 70 61 72 61 6d (serialize param
bea0: 73 29 29 29 29 0a 09 20 28 72 65 73 20 20 23 66 s)))).. (res #f
beb0: 29 0a 09 20 28 73 65 6e 64 2d 72 65 63 65 69 76 ).. (send-receiv
bec0: 65 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 e (lambda ()....
bed0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
bee0: 66 6f 20 31 31 20 22 73 65 6e 64 69 6e 67 20 6d fo 11 "sending m
bef0: 65 73 73 61 67 65 22 29 0a 09 09 09 20 28 73 65 essage").... (se
bf00: 6e 64 2d 6d 65 73 73 61 67 65 20 70 75 73 68 2d nd-message push-
bf10: 73 6f 63 6b 65 74 20 7a 64 61 74 29 0a 09 09 09 socket zdat)....
bf20: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
bf30: 66 6f 20 31 31 20 22 6d 65 73 73 61 67 65 20 73 fo 11 "message s
bf40: 65 6e 74 22 29 0a 09 09 09 20 28 6c 65 74 20 6c ent").... (let l
bf50: 6f 6f 70 20 28 29 0a 09 09 09 20 20 20 3b 3b 20 oop ().... ;;
bf60: 67 65 74 20 74 68 65 20 73 65 6e 64 65 72 20 69 get the sender i
bf70: 6e 66 6f 0a 09 09 09 20 20 20 3b 3b 20 74 68 69 nfo.... ;; thi
bf80: 73 20 73 68 6f 75 6c 64 20 6d 61 74 63 68 20 28 s should match (
bf90: 73 65 72 76 65 72 3a 67 65 74 2d 63 6c 69 65 6e server:get-clien
bfa0: 74 2d 73 69 67 6e 61 74 75 72 65 29 0a 09 09 09 t-signature)....
bfb0: 20 20 20 3b 3b 20 77 65 20 77 69 6c 6c 20 6e 65 ;; we will ne
bfc0: 65 64 20 74 6f 20 70 72 6f 63 65 73 73 20 22 61 ed to process "a
bfd0: 6c 6c 22 20 6d 65 73 73 61 67 65 73 20 68 65 72 ll" messages her
bfe0: 65 20 73 6f 6d 65 20 64 61 79 0a 09 09 09 20 20 e some day....
bff0: 20 28 72 65 63 65 69 76 65 2d 6d 65 73 73 61 67 (receive-messag
c000: 65 2a 20 73 75 62 2d 73 6f 63 6b 65 74 29 0a 09 e* sub-socket)..
c010: 09 09 20 20 20 3b 3b 20 6e 6f 77 20 67 65 74 20 .. ;; now get
c020: 74 68 65 20 61 63 74 75 61 6c 20 6d 65 73 73 61 the actual messa
c030: 67 65 0a 09 09 09 20 20 20 28 6c 65 74 20 28 28 ge.... (let ((
c040: 6d 79 72 65 73 20 28 64 62 3a 73 74 72 69 6e 67 myres (db:string
c050: 2d 3e 6f 62 6a 20 28 72 65 63 65 69 76 65 2d 6d ->obj (receive-m
c060: 65 73 73 61 67 65 2a 20 73 75 62 2d 73 6f 63 6b essage* sub-sock
c070: 65 74 29 29 29 29 0a 09 09 09 20 20 20 20 20 28 et)))).... (
c080: 69 66 20 28 65 71 75 61 6c 3f 20 71 75 65 72 79 if (equal? query
c090: 2d 73 69 67 20 28 76 65 63 74 6f 72 2d 72 65 66 -sig (vector-ref
c0a0: 20 6d 79 72 65 73 20 31 29 29 0a 09 09 09 09 20 myres 1)).....
c0b0: 28 73 65 74 21 20 72 65 73 20 28 76 65 63 74 6f (set! res (vecto
c0c0: 72 2d 72 65 66 20 6d 79 72 65 73 20 32 29 29 0a r-ref myres 2)).
c0d0: 09 09 09 09 20 28 6c 6f 6f 70 29 29 29 29 29 29 .... (loop))))))
c0e0: 0a 09 20 28 74 69 6d 65 6f 75 74 20 28 6c 61 6d .. (timeout (lam
c0f0: 62 64 61 20 28 29 0a 09 09 20 20 20 20 28 6c 65 bda ()... (le
c100: 74 20 6c 6f 6f 70 20 28 28 6e 20 6e 75 6d 72 65 t loop ((n numre
c110: 74 72 69 65 73 29 29 0a 09 09 20 20 20 20 20 20 tries))...
c120: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 36 (thread-sleep! 6
c130: 30 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 0)... (if (
c140: 6e 6f 74 20 72 65 73 29 0a 09 09 09 20 20 28 69 not res).... (i
c150: 66 20 28 3e 20 6e 75 6d 72 65 74 72 69 65 73 20 f (> numretries
c160: 30 29 0a 09 09 09 20 20 20 20 20 20 28 62 65 67 0).... (beg
c170: 69 6e 0a 09 09 09 09 28 64 65 62 75 67 3a 70 72 in.....(debug:pr
c180: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
c190: 6e 6f 20 72 65 70 6c 79 20 74 6f 20 71 75 65 72 no reply to quer
c1a0: 79 20 22 20 70 61 72 61 6d 73 20 22 2c 20 74 72 y " params ", tr
c1b0: 79 69 6e 67 20 72 65 73 65 6e 64 22 29 0a 09 09 ying resend")...
c1c0: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
c1d0: 6e 66 6f 20 31 31 20 22 72 65 2d 73 65 6e 64 69 nfo 11 "re-sendi
c1e0: 6e 67 20 6d 65 73 73 61 67 65 22 29 0a 09 09 09 ng message")....
c1f0: 09 28 73 65 6e 64 2d 6d 65 73 73 61 67 65 20 70 .(send-message p
c200: 75 73 68 2d 73 6f 63 6b 65 74 20 7a 64 61 74 29 ush-socket zdat)
c210: 0a 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e .....(debug:prin
c220: 74 2d 69 6e 66 6f 20 31 31 20 22 6d 65 73 73 61 t-info 11 "messa
c230: 67 65 20 72 65 2d 73 65 6e 74 22 29 0a 09 09 09 ge re-sent")....
c240: 09 28 6c 6f 6f 70 20 28 2d 20 6e 20 31 29 29 29 .(loop (- n 1)))
c250: 0a 09 09 09 20 20 20 20 20 20 3b 3b 20 28 61 70 .... ;; (ap
c260: 70 6c 79 20 63 64 62 3a 63 6c 69 65 6e 74 2d 63 ply cdb:client-c
c270: 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b 65 74 73 20 all zmq-sockets
c280: 71 74 79 70 65 20 69 6d 6d 65 64 69 61 74 65 20 qtype immediate
c290: 28 2d 20 6e 75 6d 72 65 74 72 69 65 73 20 31 29 (- numretries 1)
c2a0: 20 70 61 72 61 6d 73 29 29 0a 09 09 09 20 20 20 params))....
c2b0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 28 64 (begin.....(d
c2c0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
c2d0: 52 4f 52 3a 20 63 64 62 3a 63 6c 69 65 6e 74 2d ROR: cdb:client-
c2e0: 63 61 6c 6c 20 74 69 6d 65 64 20 6f 75 74 20 22 call timed out "
c2f0: 20 70 61 72 61 6d 73 20 22 2c 20 65 78 69 74 69 params ", exiti
c300: 6e 67 2e 22 29 0a 09 09 09 09 28 65 78 69 74 20 ng.").....(exit
c310: 35 29 29 29 29 29 29 29 29 0a 20 20 20 20 28 64 5)))))))). (d
c320: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
c330: 31 31 20 22 53 74 61 72 74 69 6e 67 20 74 68 72 11 "Starting thr
c340: 65 61 64 73 22 29 0a 20 20 20 20 28 6c 65 74 20 eads"). (let
c350: 28 28 74 68 31 20 28 6d 61 6b 65 2d 74 68 72 65 ((th1 (make-thre
c360: 61 64 20 73 65 6e 64 2d 72 65 63 65 69 76 65 20 ad send-receive
c370: 22 73 65 6e 64 20 72 65 63 65 69 76 65 22 29 29 "send receive"))
c380: 0a 09 20 20 28 74 68 32 20 28 6d 61 6b 65 2d 74 .. (th2 (make-t
c390: 68 72 65 61 64 20 74 69 6d 65 6f 75 74 20 20 20 hread timeout
c3a0: 20 20 20 22 74 69 6d 65 6f 75 74 22 29 29 29 0a "timeout"))).
c3b0: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 (thread-st
c3c0: 61 72 74 21 20 74 68 31 29 0a 20 20 20 20 20 20 art! th1).
c3d0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t
c3e0: 68 32 29 0a 20 20 20 20 20 20 28 74 68 72 65 61 h2). (threa
c3f0: 64 2d 6a 6f 69 6e 21 20 20 74 68 31 29 0a 20 20 d-join! th1).
c400: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
c410: 2d 69 6e 66 6f 20 31 31 20 22 63 64 62 3a 63 6c -info 11 "cdb:cl
c420: 69 65 6e 74 2d 63 61 6c 6c 20 72 65 74 75 72 6e ient-call return
c430: 69 6e 67 20 72 65 73 3d 22 20 72 65 73 29 0a 20 ing res=" res).
c440: 20 20 20 20 20 72 65 73 29 29 29 0a 20 20 0a 28 res))). .(
c450: 64 65 66 69 6e 65 20 28 63 64 62 3a 73 65 74 2d define (cdb:set-
c460: 76 65 72 62 6f 73 69 74 79 20 7a 6d 71 2d 73 6f verbosity zmq-so
c470: 63 6b 65 74 20 76 61 6c 29 0a 20 20 28 63 64 62 cket val). (cdb
c480: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 :client-call zmq
c490: 2d 73 6f 63 6b 65 74 20 27 73 65 74 2d 76 65 72 -socket 'set-ver
c4a0: 62 6f 73 69 74 79 20 23 66 20 2a 64 65 66 61 75 bosity #f *defau
c4b0: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 76 61 6c lt-numtries* val
c4c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 ))..(define (cdb
c4d0: 3a 6c 6f 67 69 6e 20 7a 6d 71 2d 73 6f 63 6b 65 :login zmq-socke
c4e0: 74 73 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 ts keyval signat
c4f0: 75 72 65 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 ure). (cdb:clie
c500: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f 63 6b nt-call zmq-sock
c510: 65 74 73 20 27 6c 6f 67 69 6e 20 23 74 20 2a 64 ets 'login #t *d
c520: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a efault-numtries*
c530: 20 6b 65 79 76 61 6c 20 6d 65 67 61 74 65 73 74 keyval megatest
c540: 2d 76 65 72 73 69 6f 6e 20 73 69 67 6e 61 74 75 -version signatu
c550: 72 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 re))..(define (c
c560: 64 62 3a 6c 6f 67 6f 75 74 20 7a 6d 71 2d 73 6f db:logout zmq-so
c570: 63 6b 65 74 20 6b 65 79 76 61 6c 20 73 69 67 6e cket keyval sign
c580: 61 74 75 72 65 29 0a 20 20 28 63 64 62 3a 63 6c ature). (cdb:cl
c590: 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 2d 73 6f ient-call zmq-so
c5a0: 63 6b 65 74 20 27 6c 6f 67 6f 75 74 20 23 74 20 cket 'logout #t
c5b0: 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 *default-numtrie
c5c0: 73 2a 20 6b 65 79 76 61 6c 20 73 69 67 6e 61 74 s* keyval signat
c5d0: 75 72 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ure))..(define (
c5e0: 63 64 62 3a 6e 75 6d 2d 63 6c 69 65 6e 74 73 20 cdb:num-clients
c5f0: 7a 6d 71 2d 73 6f 63 6b 65 74 29 0a 20 20 28 63 zmq-socket). (c
c600: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a db:client-call z
c610: 6d 71 2d 73 6f 63 6b 65 74 20 27 6e 75 6d 63 6c mq-socket 'numcl
c620: 69 65 6e 74 73 20 23 74 20 2a 64 65 66 61 75 6c ients #t *defaul
c630: 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a 0a 28 t-numtries*))..(
c640: 64 65 66 69 6e 65 20 28 63 64 62 3a 74 65 73 74 define (cdb:test
c650: 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 61 74 -set-status-stat
c660: 65 20 7a 6d 71 73 6f 63 6b 65 74 20 74 65 73 74 e zmqsocket test
c670: 2d 69 64 20 73 74 61 74 75 73 20 73 74 61 74 65 -id status state
c680: 20 6d 73 67 29 0a 20 20 28 69 66 20 6d 73 67 0a msg). (if msg.
c690: 20 20 20 20 20 20 28 63 64 62 3a 63 6c 69 65 6e (cdb:clien
c6a0: 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 t-call zmqsocket
c6b0: 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 2d 6d 'state-status-m
c6c0: 73 67 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e sg #t *default-n
c6d0: 75 6d 74 72 69 65 73 2a 20 73 74 61 74 65 20 73 umtries* state s
c6e0: 74 61 74 75 73 20 6d 73 67 20 74 65 73 74 2d 69 tatus msg test-i
c6f0: 64 29 0a 20 20 20 20 20 20 28 63 64 62 3a 63 6c d). (cdb:cl
c700: 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 ient-call zmqsoc
c710: 6b 65 74 20 27 73 74 61 74 65 2d 73 74 61 74 75 ket 'state-statu
c720: 73 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e 75 s #t *default-nu
c730: 6d 74 72 69 65 73 2a 20 73 74 61 74 65 20 73 74 mtries* state st
c740: 61 74 75 73 20 74 65 73 74 2d 69 64 29 29 29 20 atus test-id)))
c750: 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ;; run-id test-n
c760: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 6d 69 ame item-path mi
c770: 6e 75 74 65 73 20 63 70 75 6c 6f 61 64 20 64 69 nutes cpuload di
c780: 73 6b 66 72 65 65 20 74 6d 70 66 72 65 65 29 20 skfree tmpfree)
c790: 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 74 ..(define (cdb:t
c7a0: 65 73 74 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 5f est-rollup-test_
c7b0: 64 61 74 61 2d 70 61 73 73 2d 66 61 69 6c 20 7a data-pass-fail z
c7c0: 6d 71 73 6f 63 6b 65 74 20 74 65 73 74 2d 69 64 mqsocket test-id
c7d0: 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d ). (cdb:client-
c7e0: 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 call zmqsocket '
c7f0: 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c test_data-pf-rol
c800: 6c 75 70 20 23 74 20 2a 64 65 66 61 75 6c 74 2d lup #t *default-
c810: 6e 75 6d 74 72 69 65 73 2a 20 74 65 73 74 2d 69 numtries* test-i
c820: 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 d test-id test-i
c830: 64 20 74 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 d test-id))..(de
c840: 66 69 6e 65 20 28 63 64 62 3a 70 61 73 73 2d 66 fine (cdb:pass-f
c850: 61 69 6c 2d 63 6f 75 6e 74 73 20 7a 6d 71 73 6f ail-counts zmqso
c860: 63 6b 65 74 20 74 65 73 74 2d 69 64 20 66 61 69 cket test-id fai
c870: 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 l-count pass-cou
c880: 6e 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e nt). (cdb:clien
c890: 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 t-call zmqsocket
c8a0: 20 27 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 'pass-fail-coun
c8b0: 74 73 20 23 74 20 2a 64 65 66 61 75 6c 74 2d 6e ts #t *default-n
c8c0: 75 6d 74 72 69 65 73 2a 20 66 61 69 6c 2d 63 6f umtries* fail-co
c8d0: 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 20 74 unt pass-count t
c8e0: 65 73 74 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e est-id))..(defin
c8f0: 65 20 28 63 64 62 3a 74 65 73 74 73 2d 72 65 67 e (cdb:tests-reg
c900: 69 73 74 65 72 2d 74 65 73 74 20 7a 6d 71 73 6f ister-test zmqso
c910: 63 6b 65 74 20 72 75 6e 2d 69 64 20 74 65 73 74 cket run-id test
c920: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
c930: 0a 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d 70 . (let ((item-p
c940: 61 74 68 73 20 28 69 66 20 28 65 71 75 61 6c 3f aths (if (equal?
c950: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 item-path "")..
c960: 09 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 74 ..(list item-pat
c970: 68 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d h)....(list item
c980: 2d 70 61 74 68 20 22 22 29 29 29 29 0a 20 20 20 -path "")))).
c990: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
c9a0: 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 72 65 67 l zmqsocket 'reg
c9b0: 69 73 74 65 72 2d 74 65 73 74 20 23 74 20 2a 64 ister-test #t *d
c9c0: 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a efault-numtries*
c9d0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
c9e0: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a e item-path)))..
c9f0: 28 64 65 66 69 6e 65 20 28 63 64 62 3a 66 6c 75 (define (cdb:flu
ca00: 73 68 2d 71 75 65 75 65 20 7a 6d 71 73 6f 63 6b sh-queue zmqsock
ca10: 65 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 6e et). (cdb:clien
ca20: 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 74 t-call zmqsocket
ca30: 20 27 66 6c 75 73 68 20 23 66 20 2a 64 65 66 61 'flush #f *defa
ca40: 75 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 29 29 0a ult-numtries*)).
ca50: 0a 28 64 65 66 69 6e 65 20 28 63 64 62 3a 6b 69 .(define (cdb:ki
ca60: 6c 6c 2d 73 65 72 76 65 72 20 7a 6d 71 73 6f 63 ll-server zmqsoc
ca70: 6b 65 74 29 0a 20 20 28 63 64 62 3a 63 6c 69 65 ket). (cdb:clie
ca80: 6e 74 2d 63 61 6c 6c 20 7a 6d 71 73 6f 63 6b 65 nt-call zmqsocke
ca90: 74 20 27 6b 69 6c 6c 73 65 72 76 65 72 20 23 66 t 'killserver #f
caa0: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
cab0: 65 73 2a 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 es*))..(define (
cac0: 63 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 cdb:roll-up-pass
cad0: 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 7a 6d 71 -fail-counts zmq
cae0: 73 6f 63 6b 65 74 20 72 75 6e 2d 69 64 20 74 65 socket run-id te
caf0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
cb00: 68 20 73 74 61 74 75 73 29 0a 20 20 28 63 64 62 h status). (cdb
cb10: 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a 6d 71 :client-call zmq
cb20: 73 6f 63 6b 65 74 20 27 69 6d 6d 65 64 69 61 74 socket 'immediat
cb30: 65 20 23 66 20 2a 64 65 66 61 75 6c 74 2d 6e 75 e #f *default-nu
cb40: 6d 74 72 69 65 73 2a 20 6f 70 65 6e 2d 72 75 6e mtries* open-run
cb50: 2d 63 6c 6f 73 65 20 64 62 3a 72 6f 6c 6c 2d 75 -close db:roll-u
cb60: 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e p-pass-fail-coun
cb70: 74 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 ts #f run-id tes
cb80: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
cb90: 20 73 74 61 74 75 73 29 29 0a 0a 28 64 65 66 69 status))..(defi
cba0: 6e 65 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 ne (cdb:get-test
cbb0: 2d 69 6e 66 6f 20 7a 6d 71 73 6f 63 6b 65 74 20 -info zmqsocket
cbc0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
cbd0: 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 63 item-path). (c
cbe0: 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c 6c 20 7a db:client-call z
cbf0: 6d 71 73 6f 63 6b 65 74 20 27 69 6d 6d 65 64 69 mqsocket 'immedi
cc00: 61 74 65 20 23 66 20 2a 64 65 66 61 75 6c 74 2d ate #f *default-
cc10: 6e 75 6d 74 72 69 65 73 2a 20 6f 70 65 6e 2d 72 numtries* open-r
cc20: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d un-close db:get-
cc30: 74 65 73 74 2d 69 6e 66 6f 20 23 66 20 72 75 6e test-info #f run
cc40: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
cc50: 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 em-path))..(defi
cc60: 6e 65 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 ne (cdb:get-test
cc70: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 7a 6d 71 73 -info-by-id zmqs
cc80: 6f 63 6b 65 74 20 74 65 73 74 2d 69 64 29 0a 20 ocket test-id).
cc90: 20 28 63 64 62 3a 63 6c 69 65 6e 74 2d 63 61 6c (cdb:client-cal
cca0: 6c 20 7a 6d 71 73 6f 63 6b 65 74 20 27 69 6d 6d l zmqsocket 'imm
ccb0: 65 64 69 61 74 65 20 23 66 20 2a 64 65 66 61 75 ediate #f *defau
ccc0: 6c 74 2d 6e 75 6d 74 72 69 65 73 2a 20 6f 70 65 lt-numtries* ope
ccd0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
cce0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
ccf0: 69 64 20 23 66 20 74 65 73 74 2d 69 64 29 29 0a id #f test-id)).
cd00: 0a 3b 3b 20 64 62 20 73 68 6f 75 6c 64 20 62 65 .;; db should be
cd10: 20 64 62 20 6f 70 65 6e 20 70 72 6f 63 20 6f 72 db open proc or
cd20: 20 23 66 0a 28 64 65 66 69 6e 65 20 28 63 64 62 #f.(define (cdb
cd30: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 70 72 6f 63 :remote-run proc
cd40: 20 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 db . params).
cd50: 28 61 70 70 6c 79 20 63 64 62 3a 63 6c 69 65 6e (apply cdb:clien
cd60: 74 2d 63 61 6c 6c 20 2a 72 75 6e 72 65 6d 6f 74 t-call *runremot
cd70: 65 2a 20 27 69 6d 6d 65 64 69 61 74 65 20 23 66 e* 'immediate #f
cd80: 20 2a 64 65 66 61 75 6c 74 2d 6e 75 6d 74 72 69 *default-numtri
cd90: 65 73 2a 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f es* open-run-clo
cda0: 73 65 20 70 72 6f 63 20 23 66 20 70 61 72 61 6d se proc #f param
cdb0: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 s))..(define (db
cdc0: 3a 74 65 73 74 2d 67 65 74 2d 6c 6f 67 66 69 6c :test-get-logfil
cdd0: 65 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 e-info db run-id
cde0: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 6c test-name). (l
cdf0: 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 20 et ((res #f)).
ce00: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
ce10: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c ach-row . (l
ce20: 61 6d 62 64 61 20 28 70 61 74 68 20 66 69 6e 61 ambda (path fina
ce30: 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 28 l_logf). (
ce40: 73 65 74 21 20 6c 6f 67 66 20 66 69 6e 61 6c 5f set! logf final_
ce50: 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 28 73 65 logf). (se
ce60: 74 21 20 72 65 73 20 28 6c 69 73 74 20 70 61 74 t! res (list pat
ce70: 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a 20 h final_logf)).
ce80: 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 63 (if (direc
ce90: 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 20 tory? path)..
cea0: 28 70 72 69 6e 74 20 22 46 6f 75 6e 64 20 70 61 (print "Found pa
ceb0: 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20 th: " path)..
cec0: 28 70 72 69 6e 74 20 22 4e 6f 20 73 75 63 68 20 (print "No such
ced0: 70 61 74 68 3a 20 22 20 70 61 74 68 29 29 29 0a path: " path))).
cee0: 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 22 53 db . "S
cef0: 45 4c 45 43 54 20 72 75 6e 64 69 72 2c 66 69 6e ELECT rundir,fin
cf00: 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d 20 74 65 73 al_logf FROM tes
cf10: 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d ts WHERE run_id=
cf20: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f ? AND testname=?
cf30: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 AND item_path='
cf40: 27 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 64 20 ';". run-id
cf50: 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 72 test-name). r
cf60: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 62 es))..(define db
cf70: 3a 71 75 65 72 69 65 73 20 0a 20 20 28 6c 69 73 :queries . (lis
cf80: 74 20 27 28 72 65 67 69 73 74 65 72 2d 74 65 73 t '(register-tes
cf90: 74 20 20 20 20 20 20 20 20 20 20 22 49 4e 53 45 t "INSE
cfa0: 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 RT OR IGNORE INT
cfb0: 4f 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c O tests (run_id,
cfc0: 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 testname,event_t
cfd0: 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 ime,item_path,st
cfe0: 61 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 ate,status) VALU
cff0: 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 ES (?,?,strftime
d000: 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 ('%s','now'),?,'
d010: 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 2f NOT_STARTED','n/
d020: 61 27 29 3b 22 29 0a 09 27 28 73 74 61 74 65 2d a');")..'(state-
d030: 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 20 status
d040: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
d050: 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 ET state=?,statu
d060: 73 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 s=? WHERE id=?;"
d070: 29 0a 09 27 28 73 74 61 74 65 2d 73 74 61 74 75 )..'(state-statu
d080: 73 2d 6d 73 67 20 20 20 20 20 20 20 22 55 50 44 s-msg "UPD
d090: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
d0a0: 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 ate=?,status=?,c
d0b0: 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 omment=? WHERE i
d0c0: 64 3d 3f 3b 22 29 0a 09 27 28 70 61 73 73 2d 66 d=?;")..'(pass-f
d0d0: 61 69 6c 2d 63 6f 75 6e 74 73 20 20 20 20 20 20 ail-counts
d0e0: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
d0f0: 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c ET fail_count=?,
d100: 70 61 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 pass_count=? WHE
d110: 52 45 20 69 64 3d 3f 3b 22 29 0a 09 3b 3b 20 74 RE id=?;")..;; t
d120: 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c est_data-pf-roll
d130: 75 70 20 69 73 20 75 73 65 64 20 74 6f 20 73 65 up is used to se
d140: 74 20 61 20 74 65 73 74 73 20 50 41 53 53 2f 46 t a tests PASS/F
d150: 41 49 4c 20 62 61 73 65 64 20 6f 6e 20 74 68 65 AIL based on the
d160: 20 70 61 73 73 2f 66 61 69 6c 20 69 6e 66 6f 20 pass/fail info
d170: 66 72 6f 6d 20 74 68 65 20 73 74 65 70 73 0a 09 from the steps..
d180: 27 28 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 '(test_data-pf-r
d190: 6f 6c 6c 75 70 20 20 20 20 22 55 50 44 41 54 45 ollup "UPDATE
d1a0: 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 tests.
d1b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d1c0: 20 20 20 20 20 20 20 20 20 20 20 53 45 54 20 73 SET s
d1d0: 74 61 74 75 73 3d 43 41 53 45 20 57 48 45 4e 20 tatus=CASE WHEN
d1e0: 28 53 45 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 (SELECT fail_cou
d1f0: 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 nt FROM tests WH
d200: 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 ERE id=?) > 0 .
d210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d230: 20 20 20 20 20 54 48 45 4e 20 27 46 41 49 4c 27 THEN 'FAIL'
d240: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d260: 20 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 WHEN (SELEC
d270: 54 20 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f T pass_count FRO
d280: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 M tests WHERE id
d290: 3d 3f 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 =?) > 0 AND .
d2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2c0: 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 (SELECT statu
d2d0: 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 s FROM tests WHE
d2e0: 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 RE id=?) NOT IN
d2f0: 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a ('WARN','FAIL').
d300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d320: 20 20 20 20 54 48 45 4e 20 27 50 41 53 53 27 0a THEN 'PASS'.
d330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d350: 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 0a ELSE status.
d360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d380: 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 69 64 END WHERE id
d390: 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 2d 73 65 =?;")..'(test-se
d3a0: 74 2d 6c 6f 67 20 20 20 20 20 20 20 20 20 20 20 t-log
d3b0: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
d3c0: 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 ET final_logf=?
d3d0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 WHERE id=?;")..'
d3e0: 28 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 (test-set-rundir
d3f0: 2d 62 79 2d 74 65 73 74 2d 69 64 20 22 55 50 44 -by-test-id "UPD
d400: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 75 ATE tests SET ru
d410: 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 69 64 3d ndir=? WHERE id=
d420: 3f 22 29 0a 09 27 28 74 65 73 74 2d 73 65 74 2d ?")..'(test-set-
d430: 72 75 6e 64 69 72 20 20 20 20 20 20 20 20 20 22 rundir "
d440: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
d450: 20 72 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 rundir=? WHERE
d460: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
d470: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
d480: 5f 70 61 74 68 3d 3f 3b 22 29 0a 09 27 28 64 65 _path=?;")..'(de
d490: 6c 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 lete-tests-in-st
d4a0: 61 74 65 20 20 20 22 44 45 4c 45 54 45 20 46 52 ate "DELETE FR
d4b0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 73 OM tests WHERE s
d4c0: 74 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 tate=? AND run_i
d4d0: 64 3d 3f 3b 22 29 0a 09 27 28 74 65 73 74 73 3a d=?;")..'(tests:
d4e0: 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 test-set-toplog
d4f0: 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
d500: 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f SET final_logf=?
d510: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
d520: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
d530: 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b ND item_path='';
d540: 22 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 64 6f "). ))..;; do
d550: 20 6e 6f 74 20 72 75 6e 20 74 68 65 73 65 20 61 not run these a
d560: 73 20 70 61 72 74 20 6f 66 20 74 68 65 20 74 72 s part of the tr
d570: 61 6e 73 61 63 74 69 6f 6e 0a 28 64 65 66 69 6e ansaction.(defin
d580: 65 20 64 62 3a 73 70 65 63 69 61 6c 2d 71 75 65 e db:special-que
d590: 72 69 65 73 20 20 20 27 28 72 6f 6c 6c 75 70 2d ries '(rollup-
d5a0: 74 65 73 74 73 2d 70 61 73 73 2d 66 61 69 6c 0a tests-pass-fail.
d5b0: 09 09 09 20 20 20 20 20 20 20 64 62 3a 72 6f 6c ... db:rol
d5c0: 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 l-up-pass-fail-c
d5d0: 6f 75 6e 74 73 0a 20 20 20 20 20 20 20 20 20 20 ounts.
d5e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d5f0: 20 20 20 20 20 6c 6f 67 69 6e 0a 20 20 20 20 20 login.
d600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d610: 20 20 20 20 20 20 20 20 20 20 69 6d 6d 65 64 69 immedi
d620: 61 74 65 0a 09 09 09 20 20 20 20 20 20 20 66 6c ate.... fl
d630: 75 73 68 0a 09 09 09 20 20 20 20 20 20 20 73 79 ush.... sy
d640: 6e 63 0a 09 09 09 20 20 20 20 20 20 20 73 65 74 nc.... set
d650: 2d 76 65 72 62 6f 73 69 74 79 0a 09 09 09 20 20 -verbosity....
d660: 20 20 20 20 20 6b 69 6c 6c 73 65 72 76 65 72 29 killserver)
d670: 29 0a 0a 3b 3b 20 6e 6f 74 20 75 73 65 64 2c 20 )..;; not used,
d680: 69 6e 74 65 6e 64 65 64 20 74 6f 20 69 6e 64 69 intended to indi
d690: 63 61 74 65 20 74 6f 20 72 75 6e 20 69 6e 20 63 cate to run in c
d6a0: 61 6c 6c 69 6e 67 20 70 72 6f 63 65 73 73 0a 28 alling process.(
d6b0: 64 65 66 69 6e 65 20 64 62 3a 72 75 6e 2d 6c 6f define db:run-lo
d6c0: 63 61 6c 2d 71 75 65 72 69 65 73 20 27 28 29 29 cal-queries '())
d6d0: 20 3b 3b 20 72 6f 6c 6c 75 70 2d 74 65 73 74 73 ;; rollup-tests
d6e0: 2d 70 61 73 73 2d 66 61 69 6c 29 29 0a 0a 3b 3b -pass-fail))..;;
d6f0: 20 54 68 65 20 71 75 65 75 65 20 69 73 20 61 20 The queue is a
d700: 6c 69 73 74 20 6f 66 20 76 65 63 74 6f 72 73 20 list of vectors
d710: 77 68 65 72 65 20 74 68 65 20 7a 65 72 6f 74 68 where the zeroth
d720: 20 73 6c 6f 74 20 69 6e 64 69 63 61 74 65 73 20 slot indicates
d730: 74 68 65 20 74 79 70 65 20 6f 66 20 71 75 65 72 the type of quer
d740: 79 20 74 6f 0a 3b 3b 20 61 70 70 6c 79 20 61 6e y to.;; apply an
d750: 64 20 74 68 65 20 73 65 63 6f 6e 64 20 73 6c 6f d the second slo
d760: 74 20 69 73 20 74 68 65 20 74 69 6d 65 20 6f 66 t is the time of
d770: 20 74 68 65 20 71 75 65 72 79 20 61 6e 64 20 74 the query and t
d780: 68 65 20 74 68 69 72 64 20 65 6e 74 72 79 20 69 he third entry i
d790: 73 20 61 20 6c 69 73 74 20 6f 66 20 0a 3b 3b 20 s a list of .;;
d7a0: 76 61 6c 75 65 73 20 74 6f 20 62 65 20 61 70 70 values to be app
d7b0: 6c 69 65 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 lied.;;.(define
d7c0: 28 64 62 3a 70 72 6f 63 65 73 73 2d 71 75 65 75 (db:process-queu
d7d0: 65 20 70 75 62 73 6f 63 6b 20 69 6e 64 61 74 61 e pubsock indata
d7e0: 29 0a 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ). (open-run-cl
d7f0: 6f 73 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 ose. (lambda (
d800: 64 62 20 2e 20 6a 75 6e 6b 70 61 72 61 6d 73 29 db . junkparams)
d810: 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 71 75 . (let* ((qu
d820: 65 72 69 65 73 20 20 20 20 28 6d 61 6b 65 2d 68 eries (make-h
d830: 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 ash-table))..
d840: 20 28 64 61 74 61 20 20 20 20 20 20 20 28 73 6f (data (so
d850: 72 74 20 69 6e 64 61 74 61 20 28 6c 61 6d 62 64 rt indata (lambd
d860: 61 20 28 61 20 62 29 0a 09 09 09 09 20 20 20 20 a (a b).....
d870: 20 20 28 3c 20 28 63 64 62 3a 70 61 63 6b 65 74 (< (cdb:packet
d880: 2d 67 65 74 2d 71 74 69 6d 65 20 61 29 28 63 64 -get-qtime a)(cd
d890: 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d 71 74 69 b:packet-get-qti
d8a0: 6d 65 20 62 29 29 29 29 29 29 0a 20 20 20 20 20 me b)))))).
d8b0: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 28 6c 61 (for-each..(la
d8c0: 6d 62 64 61 20 28 73 70 65 63 69 61 6c 2d 71 72 mbda (special-qr
d8d0: 79 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 73 74 y).. (let* ((st
d8e0: 6d 74 2d 6b 65 79 20 20 20 20 20 20 20 28 63 64 mt-key (cd
d8f0: 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d 71 74 79 b:packet-get-qty
d900: 70 65 20 73 70 65 63 69 61 6c 2d 71 72 79 29 29 pe special-qry))
d910: 0a 09 09 20 28 71 72 79 2d 73 69 67 20 20 20 20 ... (qry-sig
d920: 20 20 20 20 28 63 64 62 3a 70 61 63 6b 65 74 2d (cdb:packet-
d930: 67 65 74 2d 71 75 65 72 79 2d 73 69 67 20 73 70 get-query-sig sp
d940: 65 63 69 61 6c 2d 71 72 79 29 29 0a 09 09 20 28 ecial-qry))... (
d950: 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 28 return-address (
d960: 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 74 2d 63 cdb:packet-get-c
d970: 6c 69 65 6e 74 2d 73 69 67 20 73 70 65 63 69 61 lient-sig specia
d980: 6c 2d 71 72 79 29 29 0a 09 09 20 28 71 72 79 20 l-qry))... (qry
d990: 20 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 (hash
d9a0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
d9b0: 6c 74 20 71 75 65 72 69 65 73 20 73 74 6d 74 2d lt queries stmt-
d9c0: 6b 65 79 20 23 66 29 29 0a 09 09 20 28 70 61 72 key #f))... (par
d9d0: 61 6d 73 20 20 20 20 20 20 20 20 20 28 63 64 62 ams (cdb
d9e0: 3a 70 61 63 6b 65 74 2d 67 65 74 2d 70 61 72 61 :packet-get-para
d9f0: 6d 73 20 73 70 65 63 69 61 6c 2d 71 72 79 29 29 ms special-qry))
da00: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
da10: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 53 70 65 int-info 11 "Spe
da20: 63 69 61 6c 20 71 75 65 72 69 65 73 2f 72 65 71 cial queries/req
da30: 75 65 73 74 73 20 73 74 6d 74 2d 6b 65 79 3d 22 uests stmt-key="
da40: 20 73 74 6d 74 2d 6b 65 79 20 22 2c 20 72 65 74 stmt-key ", ret
da50: 75 72 6e 2d 61 64 64 72 65 73 73 3d 22 20 72 65 urn-address=" re
da60: 74 75 72 6e 2d 61 64 64 72 65 73 73 20 22 2c 20 turn-address ",
da70: 71 72 79 3d 22 20 71 72 79 20 22 2c 20 70 61 72 qry=" qry ", par
da80: 61 6d 73 3d 22 20 70 61 72 61 6d 73 29 0a 09 20 ams=" params)..
da90: 20 20 20 28 63 6f 6e 64 0a 09 20 20 20 20 20 3b (cond.. ;
daa0: 3b 20 53 70 65 63 69 61 6c 20 71 75 65 72 69 65 ; Special querie
dab0: 73 0a 09 20 20 20 20 20 28 28 73 74 72 69 6e 67 s.. ((string
dac0: 3f 20 71 72 79 29 0a 09 20 20 20 20 20 20 28 61 ? qry).. (a
dad0: 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 pply sqlite3:exe
dae0: 63 75 74 65 20 64 62 20 71 72 79 20 70 61 72 61 cute db qry para
daf0: 6d 73 29 0a 09 20 20 20 20 20 20 28 73 65 72 76 ms).. (serv
db00: 65 72 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b er:reply pubsock
db10: 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
db20: 71 72 79 2d 73 69 67 20 23 74 20 23 74 29 29 0a qry-sig #t #t)).
db30: 09 20 20 20 20 20 3b 3b 20 28 28 61 6e 64 20 28 . ;; ((and (
db40: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 70 61 72 61 6d not (null? param
db50: 73 29 29 0a 09 20 20 20 20 20 3b 3b 20 20 20 20 s)).. ;;
db60: 20 20 20 28 70 72 6f 63 65 64 75 72 65 3f 20 28 (procedure? (
db70: 63 61 72 20 70 61 72 61 6d 73 29 29 29 0a 09 20 car params)))..
db80: 20 20 20 20 3b 3b 20 20 28 6c 65 74 20 28 28 70 ;; (let ((p
db90: 72 6f 63 20 20 20 20 20 20 28 63 61 72 20 70 61 roc (car pa
dba0: 72 61 6d 73 29 29 0a 09 20 20 20 20 20 3b 3b 20 rams)).. ;;
dbb0: 20 20 20 20 20 20 20 28 72 65 6d 70 61 72 61 6d (remparam
dbc0: 73 20 28 63 64 72 20 70 61 72 61 6d 73 29 29 29 s (cdr params)))
dbd0: 0a 09 20 20 20 20 20 3b 3b 20 20 20 20 3b 3b 20 .. ;; ;;
dbe0: 77 65 20 61 72 65 20 62 65 69 6e 67 20 68 61 6e we are being han
dbf0: 64 65 64 20 61 20 70 72 6f 63 65 64 75 72 65 20 ded a procedure
dc00: 73 6f 20 63 61 6c 6c 20 69 74 0a 09 20 20 20 20 so call it..
dc10: 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
dc20: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 52 75 6e int-info 11 "Run
dc30: 6e 69 6e 67 20 28 61 70 70 6c 79 20 22 20 70 72 ning (apply " pr
dc40: 6f 63 20 22 20 22 20 64 62 20 22 20 22 20 72 65 oc " " db " " re
dc50: 6d 70 61 72 61 6d 73 20 22 29 22 29 0a 09 20 20 mparams ")")..
dc60: 20 20 20 3b 3b 20 20 20 20 28 73 65 72 76 65 72 ;; (server
dc70: 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 72 :reply pubsock r
dc80: 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 28 61 eturn-address (a
dc90: 70 70 6c 79 20 70 72 6f 63 20 64 62 20 72 65 6d pply proc db rem
dca0: 70 61 72 61 6d 73 29 29 29 29 0a 09 20 20 20 20 params))))..
dcb0: 20 0a 09 20 20 20 20 20 28 65 6c 73 65 20 0a 09 .. (else ..
dcc0: 20 20 20 20 20 20 28 63 61 73 65 20 73 74 6d 74 (case stmt
dcd0: 2d 6b 65 79 0a 09 09 28 28 69 6d 6d 65 64 69 61 -key...((immedia
dce0: 74 65 29 0a 09 09 20 28 6c 65 74 20 28 28 70 72 te)... (let ((pr
dcf0: 6f 63 20 20 20 20 20 20 28 63 61 72 20 70 61 72 oc (car par
dd00: 61 6d 73 29 29 0a 09 09 20 20 20 20 20 20 20 28 ams))... (
dd10: 72 65 6d 70 61 72 61 6d 73 20 28 63 64 72 20 70 remparams (cdr p
dd20: 61 72 61 6d 73 29 29 29 0a 09 09 20 20 20 3b 3b arams)))... ;;
dd30: 20 77 65 20 61 72 65 20 62 65 69 6e 67 20 68 61 we are being ha
dd40: 6e 64 65 64 20 61 20 70 72 6f 63 65 64 75 72 65 nded a procedure
dd50: 20 73 6f 20 63 61 6c 6c 20 69 74 0a 09 09 20 20 so call it...
dd60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
dd70: 66 6f 20 31 31 20 22 52 75 6e 6e 69 6e 67 20 28 fo 11 "Running (
dd80: 61 70 70 6c 79 20 22 20 70 72 6f 63 20 22 20 22 apply " proc " "
dd90: 20 72 65 6d 70 61 72 61 6d 73 20 22 29 22 29 0a remparams ")").
dda0: 09 09 20 20 20 28 73 65 72 76 65 72 3a 72 65 70 .. (server:rep
ddb0: 6c 79 20 70 75 62 73 6f 63 6b 20 72 65 74 75 72 ly pubsock retur
ddc0: 6e 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 n-address qry-si
ddd0: 67 20 23 74 20 28 61 70 70 6c 79 20 70 72 6f 63 g #t (apply proc
dde0: 20 72 65 6d 70 61 72 61 6d 73 29 29 29 29 0a 09 remparams))))..
ddf0: 09 28 28 6c 6f 67 69 6e 29 0a 09 09 20 28 69 66 .((login)... (if
de00: 20 28 3c 20 28 6c 65 6e 67 74 68 20 70 61 72 61 (< (length para
de10: 6d 73 29 20 33 29 20 3b 3b 20 73 68 6f 75 6c 64 ms) 3) ;; should
de20: 20 67 65 74 20 74 6f 70 70 61 74 68 2c 20 76 65 get toppath, ve
de30: 72 73 69 6f 6e 20 61 6e 64 20 73 69 67 6e 61 74 rsion and signat
de40: 75 72 65 0a 09 09 20 20 20 20 20 27 28 23 66 20 ure... '(#f
de50: 22 6c 6f 67 69 6e 20 66 61 69 6c 65 64 20 64 75 "login failed du
de60: 65 20 74 6f 20 6d 69 73 73 69 6e 67 20 70 61 72 e to missing par
de70: 61 6d 73 22 29 20 3b 3b 20 6d 69 73 73 69 6e 67 ams") ;; missing
de80: 20 70 61 72 61 6d 73 0a 09 09 20 20 20 20 20 28 params... (
de90: 6c 65 74 20 28 28 63 61 6c 6c 69 6e 67 2d 70 61 let ((calling-pa
dea0: 74 68 20 28 63 61 72 20 20 20 70 61 72 61 6d 73 th (car params
deb0: 29 29 0a 09 09 09 20 20 20 28 63 61 6c 6c 69 6e )).... (callin
dec0: 67 2d 76 65 72 73 20 28 63 61 64 72 20 20 70 61 g-vers (cadr pa
ded0: 72 61 6d 73 29 29 0a 09 09 09 20 20 20 28 63 6c rams)).... (cl
dee0: 69 65 6e 74 2d 6b 65 79 20 20 20 28 63 61 64 64 ient-key (cadd
def0: 72 20 70 61 72 61 6d 73 29 29 29 0a 09 09 20 20 r params)))...
df00: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 (if (and (e
df10: 71 75 61 6c 3f 20 63 61 6c 6c 69 6e 67 2d 70 61 qual? calling-pa
df20: 74 68 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 th *toppath*)...
df30: 09 09 28 65 71 75 61 6c 3f 20 6d 65 67 61 74 65 ..(equal? megate
df40: 73 74 2d 76 65 72 73 69 6f 6e 20 63 61 6c 6c 69 st-version calli
df50: 6e 67 2d 76 65 72 73 29 29 0a 09 09 09 20 20 20 ng-vers))....
df60: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 28 (begin.... (
df70: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
df80: 2a 6c 6f 67 67 65 64 2d 69 6e 2d 63 6c 69 65 6e *logged-in-clien
df90: 74 73 2a 20 63 6c 69 65 6e 74 2d 6b 65 79 20 28 ts* client-key (
dfa0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
dfb0: 29 0a 09 09 09 20 20 20 20 20 28 73 65 72 76 65 ).... (serve
dfc0: 72 3a 72 65 70 6c 79 20 20 70 75 62 73 6f 63 6b r:reply pubsock
dfd0: 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
dfe0: 71 72 79 2d 73 69 67 20 23 74 20 27 28 23 74 20 qry-sig #t '(#t
dff0: 22 73 75 63 63 65 73 73 66 75 6c 20 6c 6f 67 69 "successful logi
e000: 6e 22 29 29 29 20 20 20 20 20 20 3b 3b 20 70 61 n"))) ;; pa
e010: 74 68 20 6d 61 74 63 68 65 73 20 2d 20 70 61 73 th matches - pas
e020: 73 21 20 53 68 6f 75 6c 64 20 76 65 74 20 74 68 s! Should vet th
e030: 65 20 63 61 6c 6c 65 72 20 61 74 20 74 68 69 73 e caller at this
e040: 20 74 69 6d 65 20 2e 2e 2e 0a 09 09 09 20 20 20 time .......
e050: 28 6c 69 73 74 20 23 66 20 28 63 6f 6e 63 20 22 (list #f (conc "
e060: 4c 6f 67 69 6e 20 66 61 69 6c 65 64 20 64 75 65 Login failed due
e070: 20 74 6f 20 6d 69 73 6d 61 74 63 68 20 70 61 74 to mismatch pat
e080: 68 73 3a 20 22 20 63 61 6c 6c 69 6e 67 2d 70 61 hs: " calling-pa
e090: 74 68 20 22 2c 20 22 20 2a 74 6f 70 70 61 74 68 th ", " *toppath
e0a0: 2a 29 29 29 29 29 29 0a 09 09 28 28 66 6c 75 73 *))))))...((flus
e0b0: 68 20 73 79 6e 63 29 0a 09 09 20 28 73 65 72 76 h sync)... (serv
e0c0: 65 72 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b er:reply pubsock
e0d0: 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 return-address
e0e0: 71 72 79 2d 73 69 67 20 23 74 20 28 6c 65 6e 67 qry-sig #t (leng
e0f0: 74 68 20 64 61 74 61 29 29 29 0a 09 09 28 28 73 th data)))...((s
e100: 65 74 2d 76 65 72 62 6f 73 69 74 79 29 0a 09 09 et-verbosity)...
e110: 20 28 73 65 74 21 20 2a 76 65 72 62 6f 73 69 74 (set! *verbosit
e120: 79 2a 20 28 63 61 72 20 70 61 72 61 6d 73 29 29 y* (car params))
e130: 0a 09 09 20 28 73 65 72 76 65 72 3a 72 65 70 6c ... (server:repl
e140: 79 20 70 75 62 73 6f 63 6b 20 72 65 74 75 72 6e y pubsock return
e150: 2d 61 64 64 72 65 73 73 20 71 72 79 2d 73 69 67 -address qry-sig
e160: 20 23 74 20 27 28 23 74 20 2a 76 65 72 62 6f 73 #t '(#t *verbos
e170: 69 74 79 2a 29 29 29 0a 09 09 28 28 6b 69 6c 6c ity*)))...((kill
e180: 73 65 72 76 65 72 29 0a 09 09 20 28 64 65 62 75 server)... (debu
e190: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
e1a0: 4e 47 3a 20 53 65 72 76 65 72 20 67 6f 69 6e 67 NG: Server going
e1b0: 20 64 6f 77 6e 20 69 6e 20 31 35 20 73 65 63 6f down in 15 seco
e1c0: 6e 64 73 20 62 79 20 75 73 65 72 20 72 65 71 75 nds by user requ
e1d0: 65 73 74 21 22 29 0a 09 09 20 28 6f 70 65 6e 2d est!")... (open-
e1e0: 72 75 6e 2d 63 6c 6f 73 65 20 74 61 73 6b 73 3a run-close tasks:
e1f0: 73 65 72 76 65 72 2d 64 65 72 65 67 69 73 74 65 server-deregiste
e200: 72 20 74 61 73 6b 73 3a 6f 70 65 6e 2d 64 62 20 r tasks:open-db
e210: 0a 09 09 09 09 20 28 63 61 64 72 20 2a 73 65 72 ..... (cadr *ser
e220: 76 65 72 2d 69 6e 66 6f 2a 29 0a 09 09 09 09 20 ver-info*).....
e230: 70 75 6c 6c 70 6f 72 74 3a 20 28 63 61 64 64 72 pullport: (caddr
e240: 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f 2a 29 29 *server-info*))
e250: 0a 09 09 20 28 74 68 72 65 61 64 2d 73 74 61 72 ... (thread-star
e260: 74 21 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 t! (make-thread
e270: 28 6c 61 6d 62 64 61 20 28 29 28 74 68 72 65 61 (lambda ()(threa
e280: 64 2d 73 6c 65 65 70 21 20 31 35 29 28 65 78 69 d-sleep! 15)(exi
e290: 74 29 29 29 29 0a 09 09 20 28 73 65 72 76 65 72 t))))... (server
e2a0: 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 72 :reply pubsock r
e2b0: 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 eturn-address qr
e2c0: 79 2d 73 69 67 20 23 74 20 27 28 23 74 20 22 65 y-sig #t '(#t "e
e2d0: 78 69 74 20 70 72 6f 63 65 73 73 20 73 74 61 72 xit process star
e2e0: 74 65 64 22 29 29 29 0a 09 20 20 20 20 28 6c 65 ted"))).. (le
e2f0: 74 20 28 28 70 61 72 61 6d 73 20 20 20 20 20 20 t ((params
e300: 20 20 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 (cdb:packet-g
e310: 65 74 2d 70 61 72 61 6d 73 20 68 65 64 29 29 0a et-params hed)).
e320: 09 09 09 09 20 20 20 20 20 20 20 28 72 65 74 75 .... (retu
e330: 72 6e 2d 61 64 64 72 65 73 73 20 28 63 64 62 3a rn-address (cdb:
e340: 70 61 63 6b 65 74 2d 67 65 74 2d 63 6c 69 65 6e packet-get-clien
e350: 74 2d 73 69 67 20 68 65 64 29 29 0a 09 09 09 09 t-sig hed)).....
e360: 20 20 20 20 20 20 20 28 71 72 79 2d 73 69 67 20 (qry-sig
e370: 20 20 20 20 20 20 20 28 63 64 62 3a 70 61 63 6b (cdb:pack
e380: 65 74 2d 67 65 74 2d 71 75 65 72 79 2d 73 69 67 et-get-query-sig
e390: 20 68 65 64 29 29 0a 09 09 09 09 20 20 20 20 20 hed)).....
e3a0: 20 20 28 73 74 6d 74 2d 6b 65 79 20 20 20 20 20 (stmt-key
e3b0: 20 20 28 63 64 62 3a 70 61 63 6b 65 74 2d 67 65 (cdb:packet-ge
e3c0: 74 2d 71 74 79 70 65 20 68 65 64 29 29 29 0a 09 t-qtype hed)))..
e3d0: 09 09 09 20 20 20 28 69 66 20 28 6f 72 20 28 6e ... (if (or (n
e3e0: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ot (hash-table-r
e3f0: 65 66 2f 64 65 66 61 75 6c 74 20 71 75 65 72 69 ef/default queri
e400: 65 73 20 73 74 6d 74 2d 6b 65 79 20 23 66 29 29 es stmt-key #f))
e410: 0a 09 09 09 09 09 20 20 20 28 6d 65 6d 62 65 72 ...... (member
e420: 20 73 74 6d 74 2d 6b 65 79 20 64 62 3a 73 70 65 stmt-key db:spe
e430: 63 69 61 6c 2d 71 75 65 72 69 65 73 29 29 0a 09 cial-queries))..
e440: 09 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ... (begin
e450: 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 ...... (debug:pr
e460: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 48 61 6e int-info 11 "Han
e470: 64 6c 69 6e 67 20 73 70 65 63 69 61 6c 20 73 74 dling special st
e480: 61 74 65 6d 65 6e 74 20 22 20 73 74 6d 74 2d 6b atement " stmt-k
e490: 65 79 29 0a 09 09 09 09 09 20 28 63 6f 6e 73 20 ey)...... (cons
e4a0: 68 65 64 20 74 61 6c 29 29 0a 09 09 09 09 20 20 hed tal)).....
e4b0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
e4c0: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 . (debug:print-i
e4d0: 6e 66 6f 20 31 31 20 22 45 78 65 63 75 74 69 6e nfo 11 "Executin
e4e0: 67 20 22 20 73 74 6d 74 2d 6b 65 79 20 22 20 66 g " stmt-key " f
e4f0: 6f 72 20 22 20 70 61 72 61 6d 73 29 0a 09 09 09 or " params)....
e500: 09 09 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 .. (apply sqlite
e510: 33 3a 65 78 65 63 75 74 65 20 28 68 61 73 68 2d 3:execute (hash-
e520: 74 61 62 6c 65 2d 72 65 66 20 71 75 65 72 69 65 table-ref querie
e530: 73 20 73 74 6d 74 2d 6b 65 79 29 20 70 61 72 61 s stmt-key) para
e540: 6d 73 29 0a 09 09 09 09 09 20 28 73 65 72 76 65 ms)...... (serve
e550: 72 3a 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 r:reply pubsock
e560: 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 return-address q
e570: 72 79 2d 73 69 67 20 23 74 20 23 74 29 0a 09 09 ry-sig #t #t)...
e580: 09 09 09 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 ... (if (not (nu
e590: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 09 09 20 ll? tal))......
e5a0: 20 20 20 20 28 69 6e 6e 65 72 6c 6f 6f 70 20 28 (innerloop (
e5b0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
e5c0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 27 28 29 ))...... '()
e5d0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 29 29 ))..... ))
e5e0: 29 29 29 29 29 29 0a 0a 09 09 28 65 6c 73 65 0a ))))))....(else.
e5f0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 .. (debug:print
e600: 30 20 22 45 52 52 4f 52 3a 20 55 6e 72 65 63 6f 0 "ERROR: Unreco
e610: 67 6e 69 73 65 64 20 71 75 65 75 65 64 20 63 61 gnised queued ca
e620: 6c 6c 20 22 20 71 72 79 20 22 20 22 20 70 61 72 ll " qry " " par
e630: 61 6d 73 29 0a 09 09 20 28 73 65 72 76 65 72 3a ams)... (server:
e640: 72 65 70 6c 79 20 70 75 62 73 6f 63 6b 20 72 65 reply pubsock re
e650: 74 75 72 6e 2d 61 64 64 72 65 73 73 20 71 72 79 turn-address qry
e660: 2d 73 69 67 20 23 66 20 23 74 29 29 0a 0a 0a 0a -sig #f #t))....
e670: 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
e680: 74 20 28 6e 75 6c 6c 3f 20 72 65 6d 29 29 0a 09 t (null? rem))..
e690: 09 20 20 20 28 6f 75 74 65 72 6c 6f 6f 70 20 28 . (outerloop (
e6a0: 63 61 72 20 72 65 6d 29 28 63 64 72 20 72 65 6d car rem)(cdr rem
e6b0: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 66 )))))). (f
e6c0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
e6d0: 28 73 74 6d 74 2d 6b 65 79 29 0a 09 09 20 20 20 (stmt-key)...
e6e0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
e6f0: 65 21 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 e! (hash-table-r
e700: 65 66 20 71 75 65 72 69 65 73 20 73 74 6d 74 2d ef queries stmt-
e710: 6b 65 79 29 29 29 0a 09 09 20 28 68 61 73 68 2d key)))... (hash-
e720: 74 61 62 6c 65 2d 6b 65 79 73 20 71 75 65 72 69 table-keys queri
e730: 65 73 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 es)). (let
e740: 20 28 28 63 61 63 68 65 2d 73 69 7a 65 20 28 6c ((cache-size (l
e750: 65 6e 67 74 68 20 64 61 74 61 29 29 29 0a 09 20 ength data)))..
e760: 28 69 66 20 28 3e 20 63 61 63 68 65 2d 73 69 7a (if (> cache-siz
e770: 65 20 2a 6d 61 78 2d 63 61 63 68 65 2d 73 69 7a e *max-cache-siz
e780: 65 2a 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 e*).. (set!
e790: 2a 6d 61 78 2d 63 61 63 68 65 2d 73 69 7a 65 2a *max-cache-size*
e7a0: 20 63 61 63 68 65 2d 73 69 7a 65 29 29 29 0a 20 cache-size))).
e7b0: 20 20 20 20 20 20 29 29 0a 20 20 20 23 66 29 29 )). #f))
e7c0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ..(define (db:te
e7d0: 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 st-get-records-f
e7e0: 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 62 or-index-file db
e7f0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
e800: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 e). (let ((res
e810: 27 28 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 '())). (sqlit
e820: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
e830: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
e840: 64 20 69 74 65 6d 70 61 74 68 20 73 74 61 74 65 d itempath state
e850: 20 73 74 61 74 75 73 20 72 75 6e 5f 64 75 72 61 status run_dura
e860: 74 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e tion logf commen
e870: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
e880: 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f res (cons (vecto
e890: 72 20 69 64 20 69 74 65 6d 70 61 74 68 20 73 74 r id itempath st
e8a0: 61 74 65 20 73 74 61 74 75 73 20 72 75 6e 5f 64 ate status run_d
e8b0: 75 72 61 74 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d uration logf com
e8c0: 6d 65 6e 74 29 20 72 65 73 29 29 29 0a 20 20 20 ment) res))).
e8d0: 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c 45 43 db. "SELEC
e8e0: 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 68 2c 73 T id,item_path,s
e8f0: 74 61 74 65 2c 73 74 61 74 75 73 2c 72 75 6e 5f tate,status,run_
e900: 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c duration,final_l
e910: 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d ogf,comment FROM
e920: 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e tests WHERE run
e930: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
e940: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
e950: 74 68 20 21 3d 20 27 27 3b 22 0a 20 20 20 20 20 th != '';".
e960: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
e970: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
e980: 52 6f 6c 6c 75 70 20 74 68 65 20 70 61 73 73 2f Rollup the pass/
e990: 66 61 69 6c 20 63 6f 75 6e 74 73 20 66 72 6f 6d fail counts from
e9a0: 20 69 74 65 6d 69 7a 65 64 20 74 65 73 74 73 20 itemized tests
e9b0: 69 6e 74 6f 20 66 61 69 6c 5f 63 6f 75 6e 74 20 into fail_count
e9c0: 61 6e 64 20 70 61 73 73 5f 63 6f 75 6e 74 0a 28 and pass_count.(
e9d0: 64 65 66 69 6e 65 20 28 64 62 3a 72 6f 6c 6c 2d define (db:roll-
e9e0: 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 up-pass-fail-cou
e9f0: 6e 74 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 nts db run-id te
ea00: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
ea10: 68 20 73 74 61 74 75 73 29 0a 20 20 3b 3b 20 28 h status). ;; (
ea20: 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 20 cdb:flush-queue
ea30: 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 20 20 28 *runremote*). (
ea40: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 if (and (not (eq
ea50: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
ea60: 22 29 29 0a 09 20 20 20 28 6d 65 6d 62 65 72 20 ")).. (member
ea70: 73 74 61 74 75 73 20 27 28 22 50 41 53 53 22 20 status '("PASS"
ea80: 22 57 41 52 4e 22 20 22 46 41 49 4c 22 20 22 57 "WARN" "FAIL" "W
ea90: 41 49 56 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 AIVED" "RUNNING"
eaa0: 20 22 43 48 45 43 4b 22 29 29 29 0a 20 20 20 20 "CHECK"))).
eab0: 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 74 (begin..(sqlit
eac0: 65 33 3a 65 78 65 63 75 74 65 20 0a 09 20 64 62 e3:execute .. db
ead0: 0a 09 20 22 55 50 44 41 54 45 20 74 65 73 74 73 .. "UPDATE tests
eae0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 53 . S
eaf0: 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 28 53 ET fail_count=(S
eb00: 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 ELECT count(id)
eb10: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
eb20: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
eb30: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
eb40: 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 m_path != '' AND
eb50: 20 73 74 61 74 75 73 3d 27 46 41 49 4c 27 29 2c status='FAIL'),
eb60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
eb70: 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d 28 53 45 pass_count=(SE
eb80: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
eb90: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
eba0: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
ebb0: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
ebc0: 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 20 _path != '' AND
ebd0: 28 73 74 61 74 75 73 3d 27 50 41 53 53 27 20 4f (status='PASS' O
ebe0: 52 20 73 74 61 74 75 73 3d 27 57 41 52 4e 27 20 R status='WARN'
ebf0: 4f 52 20 73 74 61 74 75 73 3d 27 57 41 49 56 45 OR status='WAIVE
ec00: 44 27 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 D')).
ec10: 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f WHERE run_id=?
ec20: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
ec30: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
ec40: 3b 22 0a 09 20 72 75 6e 2d 69 64 20 74 65 73 74 ;".. run-id test
ec50: 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 -name run-id tes
ec60: 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 t-name run-id te
ec70: 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 st-name).
ec80: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
ec90: 70 21 20 30 2e 31 29 20 3b 3b 20 67 69 76 65 20 p! 0.1) ;; give
eca0: 6f 74 68 65 72 20 70 72 6f 63 65 73 73 65 73 20 other processes
ecb0: 61 20 63 68 61 6e 63 65 20 68 65 72 65 2c 20 6e a chance here, n
ecc0: 6f 2c 20 62 65 74 74 65 72 20 74 6f 20 62 65 20 o, better to be
ecd0: 64 6f 6e 65 20 41 53 41 50 3f 0a 09 28 69 66 20 done ASAP?..(if
ece0: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
ecf0: 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 72 75 6e RUNNING") ;; run
ed00: 6e 69 6e 67 20 74 61 6b 65 73 20 70 72 69 6f 72 ning takes prior
ed10: 69 74 79 20 6f 76 65 72 20 61 6c 6c 20 6f 74 68 ity over all oth
ed20: 65 72 20 73 74 61 74 65 73 2c 20 66 6f 72 63 65 er states, force
ed30: 20 74 68 65 20 74 65 73 74 20 73 74 61 74 65 20 the test state
ed40: 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 20 20 20 20 to RUNNING..
ed50: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
ed60: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
ed70: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 s SET state=? WH
ed80: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
ed90: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
eda0: 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 22 item_path='';" "
edb0: 52 55 4e 4e 49 4e 47 22 20 72 75 6e 2d 69 64 20 RUNNING" run-id
edc0: 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 test-name)..
edd0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
ede0: 0a 09 20 20 20 20 20 64 62 0a 09 20 20 20 20 20 .. db..
edf0: 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 20 "UPDATE tests.
ee00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee10: 20 20 20 20 20 53 45 54 20 73 74 61 74 65 3d 43 SET state=C
ee20: 41 53 45 20 0a 20 20 20 20 20 20 20 20 20 20 20 ASE .
ee30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee40: 20 20 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 WHEN (SE
ee50: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
ee60: 52 4f 4d 20 74 65 73 74 73 20 0a 20 20 20 20 20 ROM tests .
ee70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee90: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
eea0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
eeb0: 73 74 6e 61 6d 65 3d 3f 0a 20 20 20 20 20 20 20 stname=?.
eec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 41 4e AN
eef0: 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
ef00: 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ' .
ef10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef30: 20 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 74 AND stat
ef40: 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e 47 27 2c e in ('RUNNING',
ef50: 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 29 29 20 'NOT_STARTED'))
ef60: 3e 20 30 20 54 48 45 4e 20 27 52 55 4e 4e 49 4e > 0 THEN 'RUNNIN
ef70: 47 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 G'.
ef80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ef90: 20 20 20 20 20 20 45 4c 53 45 20 27 43 4f 4d 50 ELSE 'COMP
efa0: 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 20 20 20 LETED' END,.
efb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
efc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
efd0: 20 20 73 74 61 74 75 73 3d 43 41 53 45 20 0a 20 status=CASE .
efe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
eff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f000: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 4e 20 WHEN
f010: 66 61 69 6c 5f 63 6f 75 6e 74 20 3e 20 30 20 54 fail_count > 0 T
f020: 48 45 4e 20 27 46 41 49 4c 27 20 0a 20 20 20 20 HEN 'FAIL' .
f030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f050: 20 20 20 20 20 20 20 20 57 48 45 4e 20 70 61 73 WHEN pas
f060: 73 5f 63 6f 75 6e 74 20 3e 20 30 20 41 4e 44 20 s_count > 0 AND
f070: 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 20 54 48 45 fail_count=0 THE
f080: 4e 20 27 50 41 53 53 27 20 0a 20 20 20 20 20 20 N 'PASS' .
f090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f0a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f0b0: 20 20 20 20 20 20 45 4c 53 45 20 27 55 4e 4b 4e ELSE 'UNKN
f0c0: 4f 57 4e 27 20 45 4e 44 0a 20 20 20 20 20 20 20 OWN' END.
f0d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f0e0: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
f0f0: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
f100: 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 D item_path='';"
f110: 0a 09 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 .. run-id te
f120: 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 st-name run-id t
f130: 65 73 74 2d 6e 61 6d 65 29 29 0a 09 23 66 29 0a est-name))..#f).
f140: 20 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d #f))..;;==
f150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f190: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 73 20 6d 65 ====.;; Tests me
f1a0: 74 61 20 64 61 74 61 0a 3b 3b 3d 3d 3d 3d 3d 3d ta data.;;======
f1b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f1c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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: 0a 0a 3b 3b 20 72 65 61 64 20 74 68 65 20 72 65 ..;; read the re
f200: 63 6f 72 64 20 67 69 76 65 6e 20 61 20 74 65 73 cord given a tes
f210: 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 tname.(define (d
f220: 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 2d 72 b:testmeta-get-r
f230: 65 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d ecord db testnam
f240: 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 e). (let ((res
f250: 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 #f)). (sqlite
f260: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
f270: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 (lambda (id
f280: 74 65 73 74 6e 61 6d 65 20 61 75 74 68 6f 72 20 testname author
f290: 6f 77 6e 65 72 20 64 65 73 63 72 69 70 74 69 6f owner descriptio
f2a0: 6e 20 72 65 76 69 65 77 65 64 20 69 74 65 72 61 n reviewed itera
f2b0: 74 65 64 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 ted avg_runtime
f2c0: 61 76 67 5f 64 69 73 6b 20 74 61 67 73 29 0a 20 avg_disk tags).
f2d0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
f2e0: 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 74 6e (vector id testn
f2f0: 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 72 ame author owner
f300: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 76 description rev
f310: 69 65 77 65 64 20 69 74 65 72 61 74 65 64 20 61 iewed iterated a
f320: 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f 64 vg_runtime avg_d
f330: 69 73 6b 20 74 61 67 73 29 29 29 0a 20 20 20 20 isk tags))).
f340: 20 64 62 20 22 53 45 4c 45 43 54 20 69 64 2c 74 db "SELECT id,t
f350: 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f 72 2c 6f estname,author,o
f360: 77 6e 65 72 2c 64 65 73 63 72 69 70 74 69 6f 6e wner,description
f370: 2c 72 65 76 69 65 77 65 64 2c 69 74 65 72 61 74 ,reviewed,iterat
f380: 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d 65 2c 61 ed,avg_runtime,a
f390: 76 67 5f 64 69 73 6b 2c 74 61 67 73 20 46 52 4f vg_disk,tags FRO
f3a0: 4d 20 74 65 73 74 5f 6d 65 74 61 20 57 48 45 52 M test_meta WHER
f3b0: 45 20 74 65 73 74 6e 61 6d 65 3d 3f 3b 22 0a 20 E testname=?;".
f3c0: 20 20 20 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 testname).
f3d0: 20 20 72 65 73 29 29 0a 0a 3b 3b 20 63 72 65 61 res))..;; crea
f3e0: 74 65 20 61 20 6e 65 77 20 72 65 63 6f 72 64 20 te a new record
f3f0: 66 6f 72 20 61 20 67 69 76 65 6e 20 74 65 73 74 for a given test
f400: 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 64 62 name.(define (db
f410: 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 :testmeta-add-re
f420: 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 6d 65 cord db testname
f430: 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 ). (sqlite3:exe
f440: 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 20 cute db "INSERT
f450: 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 74 OR IGNORE INTO t
f460: 65 73 74 5f 6d 65 74 61 20 28 74 65 73 74 6e 61 est_meta (testna
f470: 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 2c me,author,owner,
f480: 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 69 description,revi
f490: 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 76 ewed,iterated,av
f4a0: 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 69 g_runtime,avg_di
f4b0: 73 6b 2c 74 61 67 73 29 20 56 41 4c 55 45 53 20 sk,tags) VALUES
f4c0: 28 3f 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c 27 (?,'','','','','
f4d0: 27 2c 27 27 2c 27 27 2c 27 27 29 3b 22 20 74 65 ','','','');" te
f4e0: 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b 20 75 70 64 stname))..;; upd
f4f0: 61 74 65 20 6f 6e 65 20 6f 66 20 74 68 65 20 74 ate one of the t
f500: 65 73 74 6d 65 74 61 20 66 69 65 6c 64 73 0a 28 estmeta fields.(
f510: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 6d define (db:testm
f520: 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 eta-update-field
f530: 20 64 62 20 74 65 73 74 6e 61 6d 65 20 66 69 65 db testname fie
f540: 6c 64 20 76 61 6c 75 65 29 0a 20 20 28 73 71 6c ld value). (sql
f550: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
f560: 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 (conc "UPDATE te
f570: 73 74 5f 6d 65 74 61 20 53 45 54 20 22 20 66 69 st_meta SET " fi
f580: 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 74 65 eld "=? WHERE te
f590: 73 74 6e 61 6d 65 3d 3f 3b 22 29 20 76 61 6c 75 stname=?;") valu
f5a0: 65 20 74 65 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b e testname))..;;
f5b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f5f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 53 20 ======.;; T E S
f600: 54 20 20 20 44 20 41 20 54 20 41 20 0a 3b 3b 3d T D A T A .;;=
f610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f650: 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
f660: 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 74 db:csv->test-dat
f670: 61 20 64 62 20 74 65 73 74 2d 69 64 20 63 73 76 a db test-id csv
f680: 64 61 74 61 29 0a 20 20 28 64 65 62 75 67 3a 70 data). (debug:p
f690: 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 64 20 rint 4 "test-id
f6a0: 22 20 74 65 73 74 2d 69 64 20 22 2c 20 63 73 76 " test-id ", csv
f6b0: 64 61 74 61 3a 20 22 20 63 73 76 64 61 74 61 29 data: " csvdata)
f6c0: 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 20 20 . (let ((tdb
f6d0: 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d (db:open-test-
f6e0: 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 64 62 db-by-test-id db
f6f0: 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 test-id))).
f700: 28 69 66 20 74 64 62 0a 09 28 6c 65 74 20 28 28 (if tdb..(let ((
f710: 63 73 76 6c 69 73 74 20 28 63 73 76 2d 3e 6c 69 csvlist (csv->li
f720: 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d 72 65 61 st (make-csv-rea
f730: 64 65 72 0a 09 09 09 09 20 20 20 28 6f 70 65 6e der..... (open
f740: 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 63 73 -input-string cs
f750: 76 64 61 74 61 29 0a 09 09 09 09 20 20 20 27 28 vdata)..... '(
f760: 28 73 74 72 69 70 2d 6c 65 61 64 69 6e 67 2d 77 (strip-leading-w
f770: 68 69 74 65 73 70 61 63 65 3f 20 23 74 29 0a 09 hitespace? #t)..
f780: 09 09 09 20 20 20 20 20 28 73 74 72 69 70 2d 74 ... (strip-t
f790: 72 61 69 6c 69 6e 67 2d 77 68 69 74 65 73 70 61 railing-whitespa
f7a0: 63 65 3f 20 23 74 29 29 20 29 29 29 29 20 3b 3b ce? #t)) )))) ;;
f7b0: 20 28 63 73 76 2d 3e 6c 69 73 74 20 63 73 76 64 (csv->list csvd
f7c0: 61 74 61 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 ata))).. (for-e
f7d0: 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 ach .. (lambda
f7e0: 20 28 63 73 76 72 6f 77 29 0a 09 20 20 20 20 20 (csvrow)..
f7f0: 28 6c 65 74 2a 20 28 28 70 61 64 64 65 64 2d 72 (let* ((padded-r
f800: 6f 77 20 20 28 74 61 6b 65 20 28 61 70 70 65 6e ow (take (appen
f810: 64 20 63 73 76 72 6f 77 20 28 6c 69 73 74 20 23 d csvrow (list #
f820: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
f830: 20 23 66 20 23 66 20 23 66 29 29 20 39 29 29 0a #f #f #f)) 9)).
f840: 09 09 20 20 20 20 28 63 61 74 65 67 6f 72 79 20 .. (category
f850: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 (list-ref pad
f860: 64 65 64 2d 72 6f 77 20 30 29 29 0a 09 09 20 20 ded-row 0))...
f870: 20 20 28 76 61 72 69 61 62 6c 65 20 20 20 20 28 (variable (
f880: 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d list-ref padded-
f890: 72 6f 77 20 31 29 29 0a 09 09 20 20 20 20 28 76 row 1))... (v
f8a0: 61 6c 75 65 20 20 20 20 20 20 20 28 61 6e 79 2d alue (any-
f8b0: 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69 >number-if-possi
f8c0: 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61 ble (list-ref pa
f8d0: 64 64 65 64 2d 72 6f 77 20 32 29 29 29 0a 09 09 dded-row 2)))...
f8e0: 20 20 20 20 28 65 78 70 65 63 74 65 64 20 20 20 (expected
f8f0: 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 (any->number-if
f900: 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 74 2d -possible (list-
f910: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 33 ref padded-row 3
f920: 29 29 29 0a 09 09 20 20 20 20 28 74 6f 6c 20 20 )))... (tol
f930: 20 20 20 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d (any->num
f940: 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 ber-if-possible
f950: 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 (list-ref padded
f960: 2d 72 6f 77 20 34 29 29 29 20 3b 3b 20 3e 2c 20 -row 4))) ;; >,
f970: 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 6f 72 20 61 20 <, >=, <=, or a
f980: 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 75 6e number... (un
f990: 69 74 73 20 20 20 20 20 20 20 28 6c 69 73 74 2d its (list-
f9a0: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 35 ref padded-row 5
f9b0: 29 29 0a 09 09 20 20 20 20 28 63 6f 6d 6d 65 6e ))... (commen
f9c0: 74 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 t (list-ref
f9d0: 70 61 64 64 65 64 2d 72 6f 77 20 36 29 29 0a 09 padded-row 6))..
f9e0: 09 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 . (status
f9f0: 20 20 28 6c 65 74 20 28 28 73 20 28 6c 69 73 74 (let ((s (list
fa00: 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 -ref padded-row
fa10: 37 29 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 7)))..... (if
fa20: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 29 (and (string? s)
fa30: 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (or (string-matc
fa40: 68 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a h (regexp "^\\s*
fa50: 24 22 29 20 73 29 0a 09 09 09 09 09 09 09 20 20 $") s)........
fa60: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match (
fa70: 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 22 29 20 regexp "^n/a$")
fa80: 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 s))).....
fa90: 23 66 0a 09 09 09 09 20 20 20 20 20 20 20 73 29 #f..... s)
faa0: 29 29 20 3b 3b 20 69 66 20 73 70 65 63 69 66 69 )) ;; if specifi
fab0: 65 64 20 6f 6e 20 74 68 65 20 69 6e 70 75 74 20 ed on the input
fac0: 74 68 65 6e 20 75 73 65 2c 20 65 6c 73 65 20 63 then use, else c
fad0: 61 6c 63 75 6c 61 74 65 0a 09 09 20 20 20 20 28 alculate... (
fae0: 74 79 70 65 20 20 20 20 20 20 20 20 28 6c 69 73 type (lis
faf0: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
fb00: 20 38 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 8))).. ;;
fb10: 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 63 74 65 look up expecte
fb20: 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 72 6f 6d d,tol,units from
fb30: 20 70 72 65 76 69 6f 75 73 20 62 65 73 74 20 66 previous best f
fb40: 69 74 20 74 65 73 74 20 69 66 20 74 68 65 79 20 it test if they
fb50: 61 72 65 20 61 6c 6c 20 65 69 74 68 65 72 20 23 are all either #
fb60: 66 20 6f 72 20 27 27 0a 09 20 20 20 20 20 20 20 f or ''..
fb70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
fb80: 42 45 46 4f 52 45 3a 20 63 61 74 65 67 6f 72 79 BEFORE: category
fb90: 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 76 : " category " v
fba0: 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 61 ariable: " varia
fbb0: 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 76 ble " value: " v
fbc0: 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c 20 alue .... ",
fbd0: 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 65 expected: " expe
fbe0: 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 6f cted " tol: " to
fbf0: 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e 69 l " units: " uni
fc00: 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 73 ts " status: " s
fc10: 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 3a tatus " comment:
fc20: 20 22 20 63 6f 6d 6d 65 6e 74 20 22 20 74 79 70 " comment " typ
fc30: 65 3a 20 22 20 74 79 70 65 29 0a 0a 09 20 20 20 e: " type)...
fc40: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6f 72 (if (and (or
fc50: 20 28 6e 6f 74 20 65 78 70 65 63 74 65 64 29 28 (not expected)(
fc60: 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 equal? expected
fc70: 22 22 29 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 ""))....(or (not
fc80: 20 74 6f 6c 29 20 20 20 20 20 28 65 71 75 61 6c tol) (equal
fc90: 3f 20 65 78 70 65 63 74 65 64 20 22 22 29 29 0a ? expected "")).
fca0: 09 09 09 28 6f 72 20 28 6e 6f 74 20 75 6e 69 74 ...(or (not unit
fcb0: 73 29 20 20 20 28 65 71 75 61 6c 3f 20 65 78 70 s) (equal? exp
fcc0: 65 63 74 65 64 20 22 22 29 29 29 0a 09 09 20 20 ected "")))...
fcd0: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
fce0: 6e 65 77 2d 65 78 70 65 63 74 65 64 20 6e 65 77 new-expected new
fcf0: 2d 74 6f 6c 20 6e 65 77 2d 75 6e 69 74 73 29 28 -tol new-units)(
fd00: 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c 2d db:get-prev-tol-
fd10: 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 74 for-test db test
fd20: 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 -id category var
fd30: 69 61 62 6c 65 29 29 29 0a 09 09 09 20 20 20 20 iable)))....
fd40: 20 20 20 28 73 65 74 21 20 65 78 70 65 63 74 65 (set! expecte
fd50: 64 20 6e 65 77 2d 65 78 70 65 63 74 65 64 29 0a d new-expected).
fd60: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
fd70: 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d 74 6f 6c tol new-tol
fd80: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
fd90: 21 20 75 6e 69 74 73 20 20 20 20 6e 65 77 2d 75 ! units new-u
fda0: 6e 69 74 73 29 29 29 0a 0a 09 20 20 20 20 20 20 nits)))...
fdb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
fdc0: 22 41 46 54 45 52 3a 20 20 63 61 74 65 67 6f 72 "AFTER: categor
fdd0: 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 20 y: " category "
fde0: 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 69 variable: " vari
fdf0: 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 20 able " value: "
fe00: 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 2c value .... ",
fe10: 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 70 expected: " exp
fe20: 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 74 ected " tol: " t
fe30: 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 6e ol " units: " un
fe40: 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 20 its " status: "
fe50: 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e 74 status " comment
fe60: 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 : " comment)..
fe70: 20 20 20 20 20 3b 3b 20 63 61 6c 63 75 6c 61 74 ;; calculat
fe80: 65 20 73 74 61 74 75 73 20 69 66 20 4e 4f 54 20 e status if NOT
fe90: 73 70 65 63 69 66 69 65 64 0a 09 20 20 20 20 20 specified..
fea0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
feb0: 73 74 61 74 75 73 29 28 6e 75 6d 62 65 72 3f 20 status)(number?
fec0: 65 78 70 65 63 74 65 64 29 28 6e 75 6d 62 65 72 expected)(number
fed0: 3f 20 76 61 6c 75 65 29 29 20 3b 3b 20 6e 65 65 ? value)) ;; nee
fee0: 64 20 65 78 70 65 63 74 65 64 20 61 6e 64 20 76 d expected and v
fef0: 61 6c 75 65 20 74 6f 20 62 65 20 6e 75 6d 62 65 alue to be numbe
ff00: 72 73 0a 09 09 20 20 20 28 69 66 20 28 6e 75 6d rs... (if (num
ff10: 62 65 72 3f 20 74 6f 6c 29 20 3b 3b 20 69 66 20 ber? tol) ;; if
ff20: 74 6f 6c 20 69 73 20 61 20 6e 75 6d 62 65 72 20 tol is a number
ff30: 74 68 65 6e 20 77 65 20 64 6f 20 74 68 65 20 73 then we do the s
ff40: 74 61 6e 64 61 72 64 20 63 6f 6d 70 61 72 69 73 tandard comparis
ff50: 6f 6e 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 on... (let
ff60: 2a 20 28 28 6d 61 78 2d 76 61 6c 20 28 2b 20 65 * ((max-val (+ e
ff70: 78 70 65 63 74 65 64 20 74 6f 6c 29 29 0a 09 09 xpected tol))...
ff80: 09 20 20 20 20 20 20 28 6d 69 6e 2d 76 61 6c 20 . (min-val
ff90: 28 2d 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 (- expected tol)
ffa0: 29 0a 09 09 09 20 20 20 20 20 20 28 72 65 73 75 ).... (resu
ffb0: 6c 74 20 20 28 61 6e 64 20 28 3e 3d 20 20 76 61 lt (and (>= va
ffc0: 6c 75 65 20 6d 69 6e 2d 76 61 6c 29 28 3c 3d 20 lue min-val)(<=
ffd0: 76 61 6c 75 65 20 6d 61 78 2d 76 61 6c 29 29 29 value max-val)))
ffe0: 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 ).... (debug:pri
fff0: 6e 74 20 34 20 22 6d 61 78 2d 76 61 6c 3a 20 22 nt 4 "max-val: "
10000 20 6d 61 78 2d 76 61 6c 20 22 20 6d 69 6e 2d 76 max-val " min-v
10010 61 6c 3a 20 22 20 6d 69 6e 2d 76 61 6c 20 22 20 al: " min-val "
10020 72 65 73 75 6c 74 3a 20 22 20 72 65 73 75 6c 74 result: " result
10030 29 0a 09 09 09 20 28 73 65 74 21 20 73 74 61 74 ).... (set! stat
10040 75 73 20 28 69 66 20 72 65 73 75 6c 74 20 22 70 us (if result "p
10050 61 73 73 22 20 22 66 61 69 6c 22 29 29 29 0a 09 ass" "fail")))..
10060 09 20 20 20 20 20 20 20 28 73 65 74 21 20 73 74 . (set! st
10070 61 74 75 73 20 3b 3b 20 4e 42 2f 2f 20 6e 65 65 atus ;; NB// nee
10080 64 20 74 6f 20 61 73 73 65 73 73 20 65 61 63 68 d to assess each
10090 20 6f 6e 65 20 28 69 2e 65 2e 20 6e 6f 74 20 72 one (i.e. not r
100a0 65 74 75 72 6e 20 6f 70 65 72 61 74 6f 72 20 73 eturn operator s
100b0 69 6e 63 65 20 6e 65 65 64 20 74 6f 20 61 63 74 ince need to act
100c0 20 69 66 20 6e 6f 74 20 76 61 6c 69 64 20 6f 70 if not valid op
100d0 2e 0a 09 09 09 20 20 20 20 20 28 63 61 73 65 20 ..... (case
100e0 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
100f0 74 6f 6c 29 20 3b 3b 20 74 6f 6c 20 73 68 6f 75 tol) ;; tol shou
10100 6c 64 20 62 65 20 3e 2c 20 3c 2c 20 3e 3d 2c 20 ld be >, <, >=,
10110 3c 3d 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e <=.... ((>
10120 29 20 20 28 69 66 20 28 3e 20 20 76 61 6c 75 65 ) (if (> value
10130 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
10140 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
10150 20 20 20 20 20 28 28 3c 29 20 20 28 69 66 20 28 ((<) (if (
10160 3c 20 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 < value expecte
10170 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
10180 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 28 3e )).... ((>
10190 3d 29 20 28 69 66 20 28 3e 3d 20 76 61 6c 75 65 =) (if (>= value
101a0 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 73 expected) "pass
101b0 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 20 " "fail"))....
101c0 20 20 20 20 20 28 28 3c 3d 29 20 28 69 66 20 28 ((<=) (if (
101d0 3c 3d 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 <= value expecte
101e0 64 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 d) "pass" "fail"
101f0 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 65 6c )).... (el
10200 73 65 20 28 63 6f 6e 63 20 22 45 52 52 4f 52 3a se (conc "ERROR:
10210 20 62 61 64 20 74 6f 6c 20 63 6f 6d 70 61 72 61 bad tol compara
10220 74 6f 72 20 22 20 74 6f 6c 29 29 29 29 29 29 0a tor " tol)))))).
10230 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
10240 72 69 6e 74 20 34 20 22 41 46 54 45 52 32 3a 20 rint 4 "AFTER2:
10250 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 category: " cate
10260 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c 65 3a gory " variable:
10270 20 22 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 " variable " va
10280 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 lue: " value ...
10290 09 20 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 . ", expected
102a0 3a 20 22 20 65 78 70 65 63 74 65 64 20 22 20 74 : " expected " t
102b0 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 ol: " tol " unit
102c0 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73 74 61 s: " units " sta
102d0 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 tus: " status "
102e0 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
102f0 6e 74 29 0a 09 20 20 20 20 20 20 20 28 73 71 6c nt).. (sql
10300 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 64 62 ite3:execute tdb
10310 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
10320 41 43 45 20 49 4e 54 4f 20 74 65 73 74 5f 64 61 ACE INTO test_da
10330 74 61 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 ta (test_id,cate
10340 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
10350 6c 75 65 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c lue,expected,tol
10360 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 ,units,comment,s
10370 74 61 74 75 73 2c 74 79 70 65 29 20 56 41 4c 55 tatus,type) VALU
10380 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ES (?,?,?,?,?,?,
10390 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 09 74 ?,?,?,?);".....t
103a0 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 est-id category
103b0 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 variable value e
103c0 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 xpected tol unit
103d0 73 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f s (if comment co
103e0 6d 6d 65 6e 74 20 22 22 29 20 73 74 61 74 75 73 mment "") status
103f0 20 74 79 70 65 29 0a 09 20 20 20 20 20 20 20 28 type).. (
10400 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
10410 21 20 74 64 62 29 29 29 0a 09 20 20 20 63 73 76 ! tdb))).. csv
10420 6c 69 73 74 29 29 29 29 29 0a 0a 3b 3b 20 67 65 list)))))..;; ge
10430 74 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 t a list of test
10440 5f 64 61 74 61 20 72 65 63 6f 72 64 73 20 6d 61 _data records ma
10450 74 63 68 69 6e 67 20 63 61 74 65 67 6f 72 79 70 tching categoryp
10460 61 74 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a att.(define (db:
10470 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 20 64 read-test-data d
10480 62 20 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f b test-id catego
10490 72 79 70 61 74 74 29 0a 20 20 28 6c 65 74 20 28 rypatt). (let (
104a0 28 74 64 62 20 20 28 64 62 3a 6f 70 65 6e 2d 74 (tdb (db:open-t
104b0 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
104c0 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a d db test-id))).
104d0 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 6c 65 (if tdb..(le
104e0 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 20 t ((res '()))..
104f0 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
10500 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c 61 6d ch-row .. (lam
10510 62 64 61 20 28 69 64 20 74 65 73 74 5f 69 64 20 bda (id test_id
10520 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c category variabl
10530 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 e value expected
10540 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f 6d 6d 65 tol units comme
10550 6e 74 20 73 74 61 74 75 73 20 74 79 70 65 29 0a nt status type).
10560 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 . (set! res
10570 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 (cons (vector id
10580 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 6f 72 test_id categor
10590 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
105a0 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e expected tol un
105b0 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 61 74 its comment stat
105c0 75 73 20 74 79 70 65 29 20 72 65 73 29 29 29 0a us type) res))).
105d0 09 20 20 20 74 64 62 0a 09 20 20 20 22 53 45 4c . tdb.. "SEL
105e0 45 43 54 20 69 64 2c 74 65 73 74 5f 69 64 2c 63 ECT id,test_id,c
105f0 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 ategory,variable
10600 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 2c ,value,expected,
10610 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e tol,units,commen
10620 74 2c 73 74 61 74 75 73 2c 74 79 70 65 20 46 52 t,status,type FR
10630 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 OM test_data WHE
10640 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 RE test_id=? AND
10650 20 63 61 74 65 67 6f 72 79 20 4c 49 4b 45 20 3f category LIKE ?
10660 20 4f 52 44 45 52 20 42 59 20 63 61 74 65 67 6f ORDER BY catego
10670 72 79 2c 76 61 72 69 61 62 6c 65 3b 22 20 74 65 ry,variable;" te
10680 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 70 61 st-id categorypa
10690 74 74 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a tt).. (sqlite3:
106a0 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
106b0 20 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 (reverse res))
106c0 0a 09 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e ..'())))..(defin
106d0 65 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 74 2d e (db:load-test-
106e0 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 29 data db test-id)
106f0 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c . (let loop ((l
10700 69 6e 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 in (read-line)))
10710 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
10720 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 69 6e 29 29 of-object? lin))
10730 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
10740 75 67 3a 70 72 69 6e 74 20 34 20 6c 69 6e 29 0a ug:print 4 lin).
10750 09 20 20 28 64 62 3a 63 73 76 2d 3e 74 65 73 74 . (db:csv->test
10760 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 -data db test-id
10770 20 6c 69 6e 29 0a 09 20 20 28 6c 6f 6f 70 20 28 lin).. (loop (
10780 72 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 0a 20 read-line))))).
10790 20 3b 3b 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 ;; roll up the
107a0 63 75 72 72 65 6e 74 20 72 65 73 75 6c 74 73 2e current results.
107b0 0a 20 20 3b 3b 20 46 49 58 4d 45 3a 20 41 64 64 . ;; FIXME: Add
107c0 20 74 68 65 20 73 74 61 74 75 73 20 74 6f 20 0a the status to .
107d0 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d (db:test-data-
107e0 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 rollup db test-i
107f0 64 20 23 66 29 29 0a 0a 3b 3b 20 57 41 52 4e 49 d #f))..;; WARNI
10800 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 61 6c 6c 20 NG: Do NOT call
10810 74 68 69 73 20 66 6f 72 20 74 68 65 20 70 61 72 this for the par
10820 65 6e 74 20 74 65 73 74 20 6f 6e 20 61 6e 20 69 ent test on an i
10830 74 65 72 61 74 65 64 20 74 65 73 74 0a 3b 3b 20 terated test.;;
10840 52 6f 6c 6c 20 75 70 20 74 65 73 74 5f 64 61 74 Roll up test_dat
10850 61 20 70 61 73 73 2f 66 61 69 6c 20 72 65 73 75 a pass/fail resu
10860 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 61 74 20 74 lts.;; look at t
10870 68 65 20 74 65 73 74 5f 64 61 74 61 20 73 74 61 he test_data sta
10880 74 75 73 20 66 69 65 6c 64 2c 20 0a 3b 3b 20 20 tus field, .;;
10890 20 20 69 66 20 61 6c 6c 20 61 72 65 20 70 61 73 if all are pas
108a0 73 20 28 61 6e 79 20 63 61 73 65 29 20 61 6e 64 s (any case) and
108b0 20 74 68 65 20 74 65 73 74 20 73 74 61 74 75 73 the test status
108c0 20 69 73 20 50 41 53 53 20 6f 72 20 4e 55 4c 4c is PASS or NULL
108d0 20 6f 72 20 27 27 20 74 68 65 6e 20 73 65 74 20 or '' then set
108e0 74 65 73 74 20 73 74 61 74 75 73 20 74 6f 20 50 test status to P
108f0 41 53 53 2e 0a 3b 3b 20 20 20 20 69 66 20 6f 6e ASS..;; if on
10900 65 20 6f 72 20 6d 6f 72 65 20 61 72 65 20 66 61 e or more are fa
10910 69 6c 20 28 61 6e 79 20 63 61 73 65 29 20 74 68 il (any case) th
10920 65 6e 20 73 65 74 20 74 65 73 74 20 73 74 61 74 en set test stat
10930 75 73 20 74 6f 20 50 41 53 53 2c 20 6e 6f 6e 20 us to PASS, non
10940 22 70 61 73 73 22 20 6f 72 20 22 66 61 69 6c 22 "pass" or "fail"
10950 20 61 72 65 20 69 67 6e 6f 72 65 64 0a 28 64 65 are ignored.(de
10960 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 64 61 fine (db:test-da
10970 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 ta-rollup db tes
10980 74 2d 69 64 20 73 74 61 74 75 73 29 0a 20 20 28 t-id status). (
10990 6c 65 74 20 28 28 74 64 62 20 28 6f 70 65 6e 2d let ((tdb (open-
109a0 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6f 70 65 run-close db:ope
109b0 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 n-test-db-by-tes
109c0 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 t-id db test-id)
109d0 29 0a 09 28 66 61 69 6c 2d 63 6f 75 6e 74 20 30 )..(fail-count 0
109e0 29 0a 09 28 70 61 73 73 2d 63 6f 75 6e 74 20 30 )..(pass-count 0
109f0 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 )). (if tdb..
10a00 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
10a10 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
10a20 09 20 20 20 28 6c 61 6d 62 64 61 20 28 66 63 6f . (lambda (fco
10a30 75 6e 74 20 70 63 6f 75 6e 74 29 0a 09 20 20 20 unt pcount)..
10a40 20 20 28 73 65 74 21 20 66 61 69 6c 2d 63 6f 75 (set! fail-cou
10a50 6e 74 20 66 63 6f 75 6e 74 29 0a 09 20 20 20 20 nt fcount)..
10a60 20 28 73 65 74 21 20 70 61 73 73 2d 63 6f 75 6e (set! pass-coun
10a70 74 20 70 63 6f 75 6e 74 29 29 0a 09 20 20 20 74 t pcount)).. t
10a80 64 62 20 0a 09 20 20 20 22 53 45 4c 45 43 54 20 db .. "SELECT
10a90 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
10aa0 29 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 ) FROM test_data
10ab0 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
10ac0 20 41 4e 44 20 73 74 61 74 75 73 20 6c 69 6b 65 AND status like
10ad0 20 27 66 61 69 6c 27 29 20 41 53 20 66 61 69 6c 'fail') AS fail
10ae0 5f 63 6f 75 6e 74 2c 0a 20 20 20 20 20 20 20 20 _count,.
10af0 20 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 (SELE
10b00 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
10b10 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 45 52 M test_data WHER
10b20 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 E test_id=? AND
10b30 73 74 61 74 75 73 20 6c 69 6b 65 20 27 70 61 73 status like 'pas
10b40 73 27 29 20 41 53 20 70 61 73 73 5f 63 6f 75 6e s') AS pass_coun
10b50 74 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 t;".. test-id
10b60 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 71 6c test-id).. (sql
10b70 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
10b80 64 62 29 0a 0a 09 20 20 3b 3b 20 4e 6f 77 20 72 db)... ;; Now r
10b90 6f 6c 6c 75 70 20 74 68 65 20 63 6f 75 6e 74 73 ollup the counts
10ba0 20 74 6f 20 74 68 65 20 63 65 6e 74 72 61 6c 20 to the central
10bb0 6d 65 67 61 74 65 73 74 2e 64 62 0a 09 20 20 28 megatest.db.. (
10bc0 63 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f cdb:pass-fail-co
10bd0 75 6e 74 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a unts *runremote*
10be0 20 74 65 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f test-id fail-co
10bf0 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e 74 29 0a unt pass-count).
10c00 09 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 . ;; (sqlite3:e
10c10 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
10c20 45 20 74 65 73 74 73 20 53 45 54 20 66 61 69 6c E tests SET fail
10c30 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f 63 6f _count=?,pass_co
10c40 75 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f unt=? WHERE id=?
10c50 3b 22 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 ;" .. ;;
10c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 61 fa
10c70 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
10c80 75 6e 74 20 74 65 73 74 2d 69 64 29 0a 09 20 20 unt test-id)..
10c90 28 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 75 65 (cdb:flush-queue
10ca0 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 09 20 *runremote*)..
10cb0 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
10cc0 70 21 20 31 29 20 3b 3b 20 70 6c 61 79 20 6e 69 p! 1) ;; play ni
10cd0 63 65 20 77 69 74 68 20 74 68 65 20 71 75 65 75 ce with the queu
10ce0 65 20 62 79 20 65 6e 73 75 72 69 6e 67 20 74 68 e by ensuring th
10cf0 65 20 72 6f 6c 6c 75 70 20 69 73 20 61 74 20 6c e rollup is at l
10d00 65 61 73 74 20 31 30 6d 73 20 6c 61 74 65 72 20 east 10ms later
10d10 74 68 61 6e 20 74 68 65 20 73 65 74 0a 09 20 20 than the set..
10d20 0a 09 20 20 3b 3b 20 69 66 20 74 68 65 20 74 65 .. ;; if the te
10d30 73 74 20 69 73 20 6e 6f 74 20 46 41 49 4c 20 74 st is not FAIL t
10d40 68 65 6e 20 73 65 74 20 73 74 61 74 75 73 20 62 hen set status b
10d50 61 73 65 64 20 6f 6e 20 74 68 65 20 66 61 69 6c ased on the fail
10d60 20 61 6e 64 20 70 61 73 73 20 63 6f 75 6e 74 73 and pass counts
10d70 2e 0a 09 20 20 28 63 64 62 3a 74 65 73 74 2d 72 ... (cdb:test-r
10d80 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 2d ollup-test_data-
10d90 70 61 73 73 2d 66 61 69 6c 20 2a 72 75 6e 72 65 pass-fail *runre
10da0 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 0a 09 mote* test-id)..
10db0 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ;; (sqlite3:ex
10dc0 65 63 75 74 65 0a 09 20 20 3b 3b 20 20 64 62 20 ecute.. ;; db
10dd0 20 20 3b 3b 3b 20 4e 4f 54 45 3a 20 53 68 6f 75 ;;; NOTE: Shou
10de0 6c 64 20 74 68 69 73 20 62 65 20 57 41 52 4e 2c ld this be WARN,
10df0 46 41 49 4c 3f 20 41 20 57 41 52 4e 20 69 73 20 FAIL? A WARN is
10e00 6e 6f 74 20 61 20 46 41 49 4c 3f 3f 3f 3f 3f 20 not a FAIL?????
10e10 42 55 47 20 46 49 58 4d 45 0a 09 20 20 3b 3b 20 BUG FIXME.. ;;
10e20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 0a 20 "UPDATE tests.
10e30 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ;;
10e40 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 SET stat
10e50 75 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 us=CASE WHEN (SE
10e60 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 20 LECT fail_count
10e70 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
10e80 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 20 id=?) > 0 .
10e90 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
10ea0 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 THEN 'FA
10eb0 49 4c 27 0a 20 20 20 20 20 20 20 20 20 20 3b 3b IL'. ;;
10ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 WHE
10ed0 4e 20 28 53 45 4c 45 43 54 20 70 61 73 73 5f 63 N (SELECT pass_c
10ee0 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 20 ount FROM tests
10ef0 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 30 20 WHERE id=?) > 0
10f00 41 4e 44 20 0a 20 20 20 20 20 20 20 20 20 20 3b AND . ;
10f10 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
10f20 20 20 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 (SELECT statu
10f30 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 s FROM tests WHE
10f40 52 45 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 RE id=?) NOT IN
10f50 28 27 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a ('WARN','FAIL').
10f60 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
10f70 20 20 20 20 20 20 20 20 20 54 48 45 4e 20 27 50 THEN 'P
10f80 41 53 53 27 0a 20 20 20 20 20 20 20 20 20 20 3b ASS'. ;
10f90 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c ; EL
10fa0 53 45 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 SE status.
10fb0 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 45 ;; E
10fc0 4e 44 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a ND WHERE id=?;".
10fd0 09 20 20 3b 3b 20 20 74 65 73 74 2d 69 64 20 74 . ;; test-id t
10fe0 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 est-id test-id t
10ff0 65 73 74 2d 69 64 29 0a 09 20 20 29 29 29 29 0a est-id).. )))).
11000 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
11010 2d 70 72 65 76 2d 74 6f 6c 2d 66 6f 72 2d 74 65 -prev-tol-for-te
11020 73 74 20 64 62 20 74 65 73 74 2d 69 64 20 63 61 st db test-id ca
11030 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 29 tegory variable)
11040 0a 20 20 3b 3b 20 46 69 6e 69 73 68 20 6d 65 3f . ;; Finish me?
11050 0a 20 20 28 76 61 6c 75 65 73 20 23 66 20 23 66 . (values #f #f
11060 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #f))..;;=======
11070 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11080 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11090 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
110b0 3b 3b 20 53 20 54 20 45 20 50 20 53 20 0a 3b 3b ;; S T E P S .;;
110c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
110f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11100 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
11110 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 74 69 6d (db:step-get-tim
11120 65 2d 61 73 2d 73 74 72 69 6e 67 20 76 65 63 29 e-as-string vec)
11130 0a 20 20 28 73 65 63 6f 6e 64 73 2d 3e 74 69 6d . (seconds->tim
11140 65 2d 73 74 72 69 6e 67 20 28 64 62 3a 73 74 65 e-string (db:ste
11150 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
11160 20 76 65 63 29 29 29 0a 0a 3b 3b 20 64 62 2d 67 vec)))..;; db-g
11170 65 74 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 6f et-test-steps-fo
11180 72 2d 72 75 6e 0a 28 64 65 66 69 6e 65 20 28 64 r-run.(define (d
11190 62 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d b:get-steps-for-
111a0 74 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 test db test-id)
111b0 0a 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 28 . (let* ((tdb (
111c0 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d db:open-test-db-
111d0 62 79 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 by-test-id db te
111e0 73 74 2d 69 64 29 29 0a 09 20 28 72 65 73 20 27 st-id)).. (res '
111f0 28 29 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 ())). (if tdb
11200 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c ..(begin.. (sql
11210 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
11220 77 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 w .. (lambda (
11230 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e id test-id stepn
11240 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
11250 20 65 76 65 6e 74 2d 74 69 6d 65 20 6c 6f 67 66 event-time logf
11260 69 6c 65 29 0a 09 20 20 20 20 20 28 73 65 74 21 ile).. (set!
11270 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 63 74 res (cons (vect
11280 6f 72 20 69 64 20 74 65 73 74 2d 69 64 20 73 74 or id test-id st
11290 65 70 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 epname state sta
112a0 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 tus event-time (
112b0 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 if (string? logf
112c0 69 6c 65 29 20 6c 6f 67 66 69 6c 65 20 22 22 29 ile) logfile "")
112d0 29 20 72 65 73 29 29 29 0a 09 20 20 20 74 64 62 ) res))).. tdb
112e0 0a 09 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c .. "SELECT id,
112f0 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 test_id,stepname
11300 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
11310 65 6e 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 ent_time,logfile
11320 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 FROM test_steps
11330 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f WHERE test_id=?
11340 20 4f 52 44 45 52 20 42 59 20 69 64 20 41 53 43 ORDER BY id ASC
11350 3b 22 20 3b 3b 20 65 76 65 6e 74 5f 74 69 6d 65 ;" ;; event_time
11360 20 44 45 53 43 2c 69 64 20 41 53 43 3b 0a 09 20 DESC,id ASC;..
11370 20 20 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 test-id).. (s
11380 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
11390 20 74 64 62 29 0a 09 20 20 28 72 65 76 65 72 73 tdb).. (revers
113a0 65 20 72 65 73 29 29 0a 09 27 28 29 29 29 29 0a e res))..'()))).
113b0 0a 3b 3b 20 67 65 74 20 61 20 70 72 65 74 74 79 .;; get a pretty
113c0 20 74 61 62 6c 65 20 74 6f 20 73 75 6d 6d 61 72 table to summar
113d0 69 7a 65 20 73 74 65 70 73 0a 3b 3b 0a 28 64 65 ize steps.;;.(de
113e0 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 fine (db:get-ste
113f0 70 73 2d 74 61 62 6c 65 20 64 62 20 74 65 73 74 ps-table db test
11400 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 73 74 -id). (let ((st
11410 65 70 73 20 20 20 28 64 62 3a 67 65 74 2d 73 74 eps (db:get-st
11420 65 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 eps-for-test db
11430 74 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 3b test-id))). ;
11440 3b 20 6f 72 67 61 6e 69 73 65 20 74 68 65 20 73 ; organise the s
11450 74 65 70 73 20 66 6f 72 20 62 65 74 74 65 72 20 teps for better
11460 72 65 61 64 61 62 69 6c 69 74 79 0a 20 20 20 20 readability.
11470 28 6c 65 74 20 28 28 72 65 73 20 28 6d 61 6b 65 (let ((res (make
11480 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 -hash-table))).
11490 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
114a0 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
114b0 73 74 65 70 29 0a 09 20 28 64 65 62 75 67 3a 70 step).. (debug:p
114c0 72 69 6e 74 20 36 20 22 73 74 65 70 3d 22 20 73 rint 6 "step=" s
114d0 74 65 70 29 0a 09 20 28 6c 65 74 20 28 28 72 65 tep).. (let ((re
114e0 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cord (hash-table
114f0 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 0a 09 09 -ref/default ...
11500 09 72 65 73 20 0a 09 09 09 28 64 62 3a 73 74 65 .res ....(db:ste
11510 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
11520 74 65 70 29 20 0a 09 09 09 3b 3b 20 20 20 20 20 tep) ....;;
11530 20 20 20 73 74 65 70 6e 61 6d 65 20 20 20 20 20 stepname
11540 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 74 start
11550 20 65 6e 64 20 73 74 61 74 75 73 20 20 20 20 0a end status .
11560 09 09 09 28 76 65 63 74 6f 72 20 28 64 62 3a 73 ...(vector (db:s
11570 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
11580 20 73 74 65 70 29 20 22 22 20 20 20 22 22 20 22 step) "" "" "
11590 22 20 20 20 20 20 22 22 20 22 22 29 29 29 29 0a " "" "")))).
115a0 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
115b0 20 36 20 22 72 65 63 6f 72 64 28 62 65 66 6f 72 6 "record(befor
115c0 65 29 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 e) = " record ..
115d0 09 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 .."\nid: "
115e0 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 (db:step-get-id
115f0 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 step)...."\nste
11600 70 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 pname: " (db:ste
11610 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 p-get-stepname s
11620 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 tep)...."\nstate
11630 3a 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d : " (db:step-
11640 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a get-state step).
11650 09 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 ..."\nstatus:
11660 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
11670 74 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 tatus step)...."
11680 5c 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 \ntime: " (d
11690 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 b:step-get-event
116a0 5f 74 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 _time step))..
116b0 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
116c0 73 79 6d 62 6f 6c 20 28 64 62 3a 73 74 65 70 2d symbol (db:step-
116d0 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 29 get-state step))
116e0 0a 09 20 20 20 20 20 28 28 73 74 61 72 74 29 28 .. ((start)(
116f0 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
11700 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 1 (db:step-ge
11710 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
11720 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11730 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 or-set! record 3
11740 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 76 65 (if (equal? (ve
11750 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 ctor-ref record
11760 33 29 20 22 22 29 0a 09 09 09 09 09 28 64 62 3a 3) "")......(db:
11770 73 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 step-get-status
11780 73 74 65 70 29 29 29 0a 09 20 20 20 20 20 20 28 step))).. (
11790 69 66 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 if (> (string-le
117a0 6e 67 74 68 20 28 64 62 3a 73 74 65 70 2d 67 65 ngth (db:step-ge
117b0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
117c0 0a 09 09 20 20 20 20 20 30 29 0a 09 09 20 20 28 ... 0)... (
117d0 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 6f vector-set! reco
117e0 72 64 20 35 20 28 64 62 3a 73 74 65 70 2d 67 65 rd 5 (db:step-ge
117f0 74 2d 6c 6f 67 66 69 6c 65 20 73 74 65 70 29 29 t-logfile step))
11800 29 29 0a 09 20 20 20 20 20 28 28 65 6e 64 29 20 )).. ((end)
11810 20 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f 72 .. (vector
11820 2d 73 65 74 21 20 72 65 63 6f 72 64 20 32 20 28 -set! record 2 (
11830 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
11840 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
11850 69 6d 65 20 73 74 65 70 29 29 29 0a 09 20 20 20 ime step)))..
11860 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
11870 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
11880 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
11890 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
118a0 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
118b0 20 28 6c 65 74 20 28 28 73 74 61 72 74 74 20 28 (let ((startt (
118c0 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 76 65 63 any->number (vec
118d0 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 64 20 31 tor-ref record 1
118e0 29 29 29 0a 09 09 09 09 09 20 20 28 65 6e 64 74 )))...... (endt
118f0 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 (any->number
11900 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f (vector-ref reco
11910 72 64 20 32 29 29 29 29 0a 09 09 09 09 20 20 20 rd 2)))).....
11920 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
11930 34 20 22 72 65 63 6f 72 64 5b 31 5d 3d 22 20 28 4 "record[1]=" (
11940 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 6f 72 vector-ref recor
11950 64 20 31 29 20 0a 09 09 09 09 09 09 20 20 20 22 d 1) ....... "
11960 2c 20 73 74 61 72 74 74 3d 22 20 73 74 61 72 74 , startt=" start
11970 74 20 22 2c 20 65 6e 64 74 3d 22 20 65 6e 64 74 t ", endt=" endt
11980 0a 09 09 09 09 09 09 20 20 20 22 2c 20 67 65 74 ....... ", get
11990 2d 73 74 61 74 75 73 3a 20 22 20 28 64 62 3a 73 -status: " (db:s
119a0 74 65 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 tep-get-status s
119b0 74 65 70 29 29 0a 09 09 09 09 20 20 20 20 20 20 tep)).....
119c0 28 69 66 20 28 61 6e 64 20 28 6e 75 6d 62 65 72 (if (and (number
119d0 3f 20 73 74 61 72 74 74 29 28 6e 75 6d 62 65 72 ? startt)(number
119e0 3f 20 65 6e 64 74 29 29 0a 09 09 09 09 09 20 20 ? endt))......
119f0 28 73 65 63 6f 6e 64 73 2d 3e 68 72 2d 6d 69 6e (seconds->hr-min
11a00 2d 73 65 63 20 28 2d 20 65 6e 64 74 20 73 74 61 -sec (- endt sta
11a10 72 74 74 29 29 20 22 2d 31 22 29 29 29 0a 09 20 rtt)) "-1")))..
11a20 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 72 (if (> (str
11a30 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a 73 ing-length (db:s
11a40 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
11a50 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 29 step))... 0)
11a60 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
11a70 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a 73 ! record 5 (db:s
11a80 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 20 tep-get-logfile
11a90 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 28 step)))).. (
11aa0 65 6c 73 65 0a 09 20 20 20 20 20 20 28 76 65 63 else.. (vec
11ab0 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
11ac0 32 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 2 (db:step-get-s
11ad0 74 61 74 65 20 73 74 65 70 29 29 0a 09 20 20 20 tate step))..
11ae0 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
11af0 72 65 63 6f 72 64 20 33 20 28 64 62 3a 73 74 65 record 3 (db:ste
11b00 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
11b10 70 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 p)).. (vect
11b20 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 34 or-set! record 4
11b30 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 (db:step-get-ev
11b40 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 29 29 ent_time step)))
11b50 29 0a 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ).. (hash-tabl
11b60 65 2d 73 65 74 21 20 72 65 73 20 28 64 62 3a 73 e-set! res (db:s
11b70 74 65 70 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 tep-get-stepname
11b80 20 73 74 65 70 29 20 72 65 63 6f 72 64 29 0a 09 step) record)..
11b90 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
11ba0 36 20 22 72 65 63 6f 72 64 28 61 66 74 65 72 29 6 "record(after)
11bb0 20 20 3d 20 22 20 72 65 63 6f 72 64 20 0a 09 09 = " record ...
11bc0 09 22 5c 6e 69 64 3a 20 20 20 20 20 20 20 22 20 ."\nid: "
11bd0 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 69 64 20 (db:step-get-id
11be0 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 65 70 step)...."\nstep
11bf0 6e 61 6d 65 3a 20 22 20 28 64 62 3a 73 74 65 70 name: " (db:step
11c00 2d 67 65 74 2d 73 74 65 70 6e 61 6d 65 20 73 74 -get-stepname st
11c10 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 65 3a ep)...."\nstate:
11c20 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 " (db:step-g
11c30 65 74 2d 73 74 61 74 65 20 73 74 65 70 29 0a 09 et-state step)..
11c40 09 09 22 5c 6e 73 74 61 74 75 73 3a 20 20 20 22 .."\nstatus: "
11c50 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 (db:step-get-st
11c60 61 74 75 73 20 73 74 65 70 29 0a 09 09 09 22 5c atus step)...."\
11c70 6e 74 69 6d 65 3a 20 20 20 20 20 22 20 28 64 62 ntime: " (db
11c80 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
11c90 74 69 6d 65 20 73 74 65 70 29 29 29 29 0a 20 20 time step)))).
11ca0 20 20 20 20 20 3b 3b 20 28 65 6c 73 65 20 20 20 ;; (else
11cb0 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
11cc0 6f 72 64 20 31 20 28 64 62 3a 73 74 65 70 2d 67 ord 1 (db:step-g
11cd0 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 et-event_time st
11ce0 65 70 29 29 29 0a 20 20 20 20 20 20 20 28 73 6f ep))). (so
11cf0 72 74 20 73 74 65 70 73 20 28 6c 61 6d 62 64 61 rt steps (lambda
11d00 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 0a 09 (a b)... ..
11d10 09 20 20 20 20 20 28 3c 20 28 64 62 3a 73 74 65 . (< (db:ste
11d20 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 p-get-event_time
11d30 20 61 29 28 64 62 3a 73 74 65 70 2d 67 65 74 2d a)(db:step-get-
11d40 65 76 65 6e 74 5f 74 69 6d 65 20 62 29 29 0a 09 event_time b))..
11d50 09 20 20 20 20 20 0a 09 09 20 20 20 20 20 29 29 . ... ))
11d60 29 0a 20 20 20 20 20 20 72 65 73 29 29 29 0a 0a ). res)))..
11d70 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
11d80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11da0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11db0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 49 20 ========.;; M I
11dc0 53 20 43 20 20 20 4d 20 41 20 4e 20 41 20 47 20 S C M A N A G
11dd0 45 20 4d 20 45 20 4e 20 54 20 20 20 49 20 54 20 E M E N T I T
11de0 45 20 4d 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d E M S .;;=======
11df0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11e20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
11e30 0a 3b 3b 20 74 68 65 20 6e 65 77 20 70 72 65 72 .;; the new prer
11e40 65 71 73 20 63 61 6c 63 75 6c 61 74 69 6f 6e 2c eqs calculation,
11e50 20 6c 6f 6f 6b 73 20 61 6c 73 6f 20 61 74 20 69 looks also at i
11e60 74 65 6d 70 61 74 68 20 69 66 20 73 70 65 63 69 tempath if speci
11e70 66 69 65 64 0a 3b 3b 20 61 6c 6c 20 70 72 65 72 fied.;; all prer
11e80 65 71 73 20 6d 75 73 74 20 62 65 20 6d 65 74 3a eqs must be met:
11e90 0a 3b 3b 20 20 20 20 69 66 20 70 72 65 72 65 71 .;; if prereq
11ea0 20 74 65 73 74 20 77 69 74 68 20 69 74 65 6d 70 test with itemp
11eb0 61 74 68 3d 27 27 20 69 73 20 43 4f 4d 50 4c 45 ath='' is COMPLE
11ec0 54 45 44 20 61 6e 64 20 50 41 53 53 2c 20 57 41 TED and PASS, WA
11ed0 52 4e 2c 20 43 48 45 43 4b 2c 20 6f 72 20 57 41 RN, CHECK, or WA
11ee0 49 56 45 44 20 74 68 65 6e 20 70 72 65 72 65 71 IVED then prereq
11ef0 20 69 73 20 6d 65 74 0a 3b 3b 20 20 20 20 69 66 is met.;; if
11f00 20 70 72 65 72 65 71 20 74 65 73 74 20 77 69 74 prereq test wit
11f10 68 20 69 74 65 6d 70 61 74 68 3d 72 65 66 2d 69 h itempath=ref-i
11f20 74 65 6d 2d 70 61 74 68 20 61 6e 64 20 43 4f 4d tem-path and COM
11f30 50 4c 45 54 45 44 20 77 69 74 68 20 50 41 53 53 PLETED with PASS
11f40 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 6f , WARN, CHECK, o
11f50 72 20 57 41 49 56 45 44 20 74 68 65 6e 20 70 72 r WAIVED then pr
11f60 65 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b 0a 3b ereq is met.;;.;
11f70 3b 20 4e 6f 74 65 3a 20 64 6f 20 6e 6f 74 20 63 ; Note: do not c
11f80 6f 6e 76 65 72 74 20 74 6f 20 72 65 6d 6f 74 65 onvert to remote
11f90 20 61 73 20 69 74 20 63 61 6c 6c 73 20 72 65 6d as it calls rem
11fa0 6f 74 65 20 75 6e 64 65 72 20 74 68 65 20 68 6f ote under the ho
11fb0 6f 64 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f 64 65 od.;; Note: mode
11fc0 20 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 20 74 'normal means t
11fd0 68 61 74 20 74 65 73 74 73 20 6d 75 73 74 20 62 hat tests must b
11fe0 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 e COMPLETED and
11ff0 6f 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c 20 57 ok (i.e. PASS, W
12000 41 52 4e 2c 20 43 48 45 43 4b 20 6f 72 20 57 41 ARN, CHECK or WA
12010 49 56 45 44 29 0a 3b 3b 20 20 20 20 20 20 20 6d IVED).;; m
12020 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 20 6d 65 ode 'toplevel me
12030 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 6d ans that tests m
12040 75 73 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 ust be COMPLETED
12050 20 6f 6e 6c 79 0a 3b 3b 20 20 20 20 20 20 20 6d only.;; m
12060 6f 64 65 20 27 69 74 65 6d 6d 61 74 63 68 20 6d ode 'itemmatch m
12070 65 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 20 eans that tests
12080 69 74 65 6d 73 20 6d 75 73 74 20 62 65 20 43 4f items must be CO
12090 4d 50 4c 45 54 45 44 20 61 6e 64 20 28 50 41 53 MPLETED and (PAS
120a0 53 7c 57 41 52 4e 7c 57 41 49 56 45 44 7c 43 48 S|WARN|WAIVED|CH
120b0 45 43 4b 29 20 5b 5b 20 4e 42 2f 2f 20 4e 4f 54 ECK) [[ NB// NOT
120c0 20 49 4d 50 4c 45 4d 45 4e 54 45 44 20 59 45 54 IMPLEMENTED YET
120d0 20 5d 5d 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 ]].;; .(define
120e0 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d (db:get-prereqs-
120f0 6e 6f 74 2d 6d 65 74 20 64 62 20 72 75 6e 2d 69 not-met db run-i
12100 64 20 77 61 69 74 6f 6e 73 20 72 65 66 2d 69 74 d waitons ref-it
12110 65 6d 2d 70 61 74 68 20 23 21 6b 65 79 20 28 6d em-path #!key (m
12120 6f 64 65 20 27 6e 6f 72 6d 61 6c 29 29 0a 20 20 ode 'normal)).
12130 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 77 61 69 (if (or (not wai
12140 74 6f 6e 73 29 0a 09 20 20 28 6e 75 6c 6c 3f 20 tons).. (null?
12150 77 61 69 74 6f 6e 73 29 29 0a 20 20 20 20 20 20 waitons)).
12160 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 '(). (let*
12170 28 28 75 6e 6d 65 74 2d 70 72 65 2d 72 65 71 73 ((unmet-pre-reqs
12180 20 27 28 29 29 0a 09 20 20 20 20 20 28 72 65 73 '()).. (res
12190 75 6c 74 20 20 20 20 20 20 20 20 20 27 28 29 29 ult '())
121a0 29 0a 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 )..(for-each ..
121b0 28 6c 61 6d 62 64 61 20 28 77 61 69 74 6f 6e 74 (lambda (waitont
121c0 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 3b 3b est-name).. ;;
121d0 20 62 79 20 67 65 74 74 69 6e 67 20 74 68 65 20 by getting the
121e0 74 65 73 74 73 20 77 69 74 68 20 6d 61 74 63 68 tests with match
121f0 69 6e 67 20 6e 61 6d 65 20 77 65 20 61 72 65 20 ing name we are
12200 6c 6f 6f 6b 69 6e 67 20 6f 6e 6c 79 20 61 74 20 looking only at
12210 74 68 65 20 6d 61 74 63 68 69 6e 67 20 74 65 73 the matching tes
12220 74 20 0a 09 20 20 20 3b 3b 20 61 6e 64 20 72 65 t .. ;; and re
12230 6c 61 74 65 64 20 73 75 62 20 69 74 65 6d 73 0a lated sub items.
12240 09 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 73 . (let ((tests
12250 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 (db
12260 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
12270 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 77 61 69 un db run-id wai
12280 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 27 28 29 tontest-name '()
12290 20 27 28 29 29 29 0a 09 09 20 28 65 76 65 72 2d '()))... (ever-
122a0 73 65 65 6e 20 20 20 20 20 20 20 20 20 23 66 29 seen #f)
122b0 0a 09 09 20 28 70 61 72 65 6e 74 2d 77 61 69 74 ... (parent-wait
122c0 6f 6e 2d 6d 65 74 20 23 66 29 0a 09 09 20 28 69 on-met #f)... (i
122d0 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 20 tem-waiton-met
122e0 20 23 66 29 29 0a 09 20 20 20 20 20 28 66 6f 72 #f)).. (for
122f0 2d 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 6c -each .. (l
12300 61 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 3b ambda (test)...;
12310 3b 20 28 69 66 20 28 65 71 75 61 6c 3f 20 77 61 ; (if (equal? wa
12320 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 28 64 itontest-name (d
12330 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
12340 61 6d 65 20 74 65 73 74 29 29 20 3b 3b 20 62 79 ame test)) ;; by
12350 20 64 65 66 69 6e 74 69 6f 6e 20 74 68 69 73 20 defintion this
12360 68 61 64 20 62 65 74 74 65 72 20 62 65 20 74 72 had better be tr
12370 75 65 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a 20 28 ue ......(let* (
12380 28 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 (state
12390 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
123a0 73 74 61 74 65 20 74 65 73 74 29 29 0a 09 09 20 state test))...
123b0 20 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 (status
123c0 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 (db:tes
123d0 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
123e0 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 74 t))... (it
123f0 65 6d 2d 70 61 74 68 20 20 20 20 20 20 20 20 20 em-path
12400 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
12410 6d 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 m-path test))...
12420 20 20 20 20 20 20 20 28 69 73 2d 63 6f 6d 70 6c (is-compl
12430 65 74 65 64 20 20 20 20 20 20 28 65 71 75 61 6c eted (equal
12440 3f 20 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 ? state "COMPLET
12450 45 44 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 ED"))... (
12460 69 73 2d 6f 6b 20 20 20 20 20 20 20 20 20 20 20 is-ok
12470 20 20 28 6d 65 6d 62 65 72 20 73 74 61 74 75 73 (member status
12480 20 27 28 22 50 41 53 53 22 20 22 57 41 52 4e 22 '("PASS" "WARN"
12490 20 22 43 48 45 43 4b 22 20 22 57 41 49 56 45 44 "CHECK" "WAIVED
124a0 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 ")))... (s
124b0 61 6d 65 2d 69 74 65 6d 70 61 74 68 20 20 20 20 ame-itempath
124c0 20 28 65 71 75 61 6c 3f 20 72 65 66 2d 69 74 65 (equal? ref-ite
124d0 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 68 m-path item-path
124e0 29 29 29 0a 09 09 20 20 28 73 65 74 21 20 65 76 )))... (set! ev
124f0 65 72 2d 73 65 65 6e 20 23 74 29 0a 09 09 20 20 er-seen #t)...
12500 28 63 6f 6e 64 0a 09 09 20 20 20 3b 3b 20 63 61 (cond... ;; ca
12510 73 65 20 31 2c 20 6e 6f 6e 2d 69 74 65 6d 20 28 se 1, non-item (
12520 70 61 72 65 6e 74 20 74 65 73 74 29 20 69 73 20 parent test) is
12530 0a 09 09 20 20 20 28 28 61 6e 64 20 28 65 71 75 ... ((and (equ
12540 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
12550 29 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 ) ;; this is the
12560 20 70 61 72 65 6e 74 20 74 65 73 74 0a 09 09 09 parent test....
12570 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 09 is-completed...
12580 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 71 3f . (or is-ok (eq?
12590 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 mode 'toplevel)
125a0 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 70 ))... (set! p
125b0 61 72 65 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 arent-waiton-met
125c0 20 23 74 29 29 0a 09 09 20 20 20 28 28 61 6e 64 #t))... ((and
125d0 20 73 61 6d 65 2d 69 74 65 6d 70 61 74 68 0a 09 same-itempath..
125e0 09 09 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a .. is-completed.
125f0 09 09 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 65 ... (or is-ok (e
12600 71 3f 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 q? mode 'topleve
12610 6c 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 l)))... (set!
12620 20 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 item-waiton-met
12630 20 23 74 29 29 29 29 29 0a 09 20 20 20 20 20 20 #t)))))..
12640 74 65 73 74 73 29 0a 09 20 20 20 20 20 28 69 66 tests).. (if
12650 20 28 6e 6f 74 20 28 6f 72 20 70 61 72 65 6e 74 (not (or parent
12660 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 69 74 65 6d -waiton-met item
12670 2d 77 61 69 74 6f 6e 2d 6d 65 74 29 29 0a 09 09 -waiton-met))...
12680 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 (set! result (a
12690 70 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f ppend (if (null?
126a0 20 74 65 73 74 73 29 20 28 6c 69 73 74 20 77 61 tests) (list wa
126b0 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 itontest-name) t
126c0 65 73 74 73 29 20 72 65 73 75 6c 74 29 29 29 0a ests) result))).
126d0 09 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 . ;; if the
126e0 74 65 73 74 20 69 73 20 6e 6f 74 20 66 6f 75 6e test is not foun
126f0 64 20 74 68 65 6e 20 63 6c 65 61 72 6c 79 20 74 d then clearly t
12700 68 65 20 77 61 69 74 6f 6e 20 69 73 20 6e 6f 74 he waiton is not
12710 20 6d 65 74 2e 2e 2e 0a 09 20 20 20 20 20 3b 3b met..... ;;
12720 20 28 69 66 20 28 6e 6f 74 20 65 76 65 72 2d 73 (if (not ever-s
12730 65 65 6e 29 28 73 65 74 21 20 72 65 73 75 6c 74 een)(set! result
12740 20 28 63 6f 6e 73 20 77 61 69 74 6f 6e 74 65 73 (cons waitontes
12750 74 2d 6e 61 6d 65 20 72 65 73 75 6c 74 29 29 29 t-name result)))
12760 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f )).. (if (no
12770 74 20 65 76 65 72 2d 73 65 65 6e 29 0a 09 09 20 t ever-seen)...
12780 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 61 70 (set! result (ap
12790 70 65 6e 64 20 28 69 66 20 28 6e 75 6c 6c 3f 20 pend (if (null?
127a0 74 65 73 74 73 29 28 6c 69 73 74 20 77 61 69 74 tests)(list wait
127b0 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 20 74 65 73 ontest-name) tes
127c0 74 73 29 20 72 65 73 75 6c 74 29 29 29 29 29 0a ts) result))))).
127d0 09 20 77 61 69 74 6f 6e 73 29 0a 09 28 64 65 6c . waitons)..(del
127e0 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 72 ete-duplicates r
127f0 65 73 75 6c 74 29 29 29 29 0a 0a 28 64 65 66 69 esult))))..(defi
12800 6e 65 20 28 64 62 3a 74 65 73 74 73 74 65 70 2d ne (db:teststep-
12810 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
12820 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d est-id teststep-
12830 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 name state-in st
12840 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 6e 74 20 atus-in comment
12850 6c 6f 67 66 69 6c 65 29 0a 20 20 28 64 65 62 75 logfile). (debu
12860 67 3a 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d g:print 4 "test-
12870 69 64 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 id: " test-id "
12880 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 3a 20 22 teststep-name: "
12890 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 29 0a teststep-name).
128a0 20 20 28 6c 65 74 2a 20 28 28 74 64 62 20 20 20 (let* ((tdb
128b0 20 20 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 (db:open-tes
128c0 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
128d0 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 db test-id)).. (
128e0 73 74 61 74 65 20 20 20 20 20 28 63 68 65 63 6b state (check
128f0 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 -valid-items "st
12900 61 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a ate" state-in)).
12910 09 20 28 73 74 61 74 75 73 20 20 20 20 28 63 68 . (status (ch
12920 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
12930 22 73 74 61 74 75 73 22 20 73 74 61 74 75 73 2d "status" status-
12940 69 6e 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f in))). (if (o
12950 72 20 28 6e 6f 74 20 73 74 61 74 65 29 28 6e 6f r (not state)(no
12960 74 20 73 74 61 74 75 73 29 29 0a 09 28 64 65 62 t status))..(deb
12970 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
12980 49 4e 47 3a 20 49 6e 76 61 6c 69 64 20 22 20 28 ING: Invalid " (
12990 69 66 20 73 74 61 74 75 73 20 22 73 74 61 74 75 if status "statu
129a0 73 22 20 22 73 74 61 74 65 22 29 0a 09 09 20 20 s" "state")...
129b0 20 20 20 22 20 76 61 6c 75 65 20 5c 22 22 20 28 " value \"" (
129c0 69 66 20 73 74 61 74 75 73 20 73 74 61 74 65 2d if status state-
129d0 69 6e 20 73 74 61 74 75 73 2d 69 6e 29 20 22 5c in status-in) "\
129e0 22 2c 20 75 70 64 61 74 65 20 79 6f 75 72 20 76 ", update your v
129f0 61 6c 69 64 76 61 6c 75 65 73 20 73 65 63 74 69 alidvalues secti
12a00 6f 6e 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 on in megatest.c
12a10 6f 6e 66 69 67 22 29 29 0a 20 20 20 20 28 69 66 onfig")). (if
12a20 20 74 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 tdb..(begin..
12a30 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
12a40 20 0a 09 20 20 20 74 64 62 0a 09 20 20 20 22 49 .. tdb.. "I
12a50 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
12a60 20 69 6e 74 6f 20 74 65 73 74 5f 73 74 65 70 73 into test_steps
12a70 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 (test_id,stepna
12a80 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c me,state,status,
12a90 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 event_time,comme
12aa0 6e 74 2c 6c 6f 67 66 69 6c 65 29 20 56 41 4c 55 nt,logfile) VALU
12ab0 45 53 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ES(?,?,?,?,?,?,?
12ac0 29 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 20 );".. test-id
12ad0 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 teststep-name st
12ae0 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e ate-in status-in
12af0 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
12b00 73 29 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 s) (if comment c
12b10 6f 6d 6d 65 6e 74 20 22 22 29 20 28 69 66 20 6c omment "") (if l
12b20 6f 67 66 69 6c 65 20 6c 6f 67 66 69 6c 65 20 22 ogfile logfile "
12b30 22 29 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a ")).. (sqlite3:
12b40 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
12b50 20 20 23 74 29 0a 09 23 66 29 29 29 0a 0a 3b 3b #t)..#f)))..;;
12b60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b70 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b80 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12b90 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12ba0 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 78 74 72 61 63 ======.;; Extrac
12bb0 74 20 6f 64 73 20 66 69 6c 65 20 66 72 6f 6d 20 t ods file from
12bc0 74 68 65 20 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d the db.;;=======
12bd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12be0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12bf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12c00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
12c10 0a 3b 3b 20 72 75 6e 73 70 61 74 74 20 69 73 20 .;; runspatt is
12c20 61 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 74 65 a comma delimite
12c30 64 20 6c 69 73 74 20 6f 66 20 72 75 6e 20 70 61 d list of run pa
12c40 74 74 65 72 6e 73 0a 3b 3b 20 6b 65 79 70 61 74 tterns.;; keypat
12c50 74 2d 61 6c 69 73 74 20 6d 75 73 74 20 63 6f 6e t-alist must con
12c60 74 61 69 6e 20 2a 61 6c 6c 2a 20 6b 65 79 73 20 tain *all* keys
12c70 77 69 74 68 20 61 6e 20 61 73 73 6f 63 69 61 74 with an associat
12c80 65 64 20 70 61 74 74 65 72 6e 3a 20 27 28 20 28 ed pattern: '( (
12c90 22 4b 45 59 31 22 20 22 25 22 29 20 2e 2e 20 29 "KEY1" "%") .. )
12ca0 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 65 78 74 .(define (db:ext
12cb0 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 ract-ods-file db
12cc0 20 6f 75 74 70 75 74 66 69 6c 65 20 6b 65 79 70 outputfile keyp
12cd0 61 74 74 2d 61 6c 69 73 74 20 72 75 6e 73 70 61 att-alist runspa
12ce0 74 74 20 70 61 74 68 6d 6f 64 29 0a 20 20 28 6c tt pathmod). (l
12cf0 65 74 2a 20 28 28 6b 65 79 73 73 74 72 20 20 28 et* ((keysstr (
12d00 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12d10 73 65 20 28 6d 61 70 20 63 61 72 20 6b 65 79 70 se (map car keyp
12d20 61 74 74 2d 61 6c 69 73 74 29 20 22 2c 22 29 29 att-alist) ","))
12d30 0a 09 20 28 6b 65 79 71 72 79 20 20 20 28 73 74 .. (keyqry (st
12d40 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
12d50 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 (map (lambda (p
12d60 29 28 63 6f 6e 63 20 28 63 61 72 20 70 29 20 22 )(conc (car p) "
12d70 20 4c 49 4b 45 20 3f 20 22 29 29 20 6b 65 79 70 LIKE ? ")) keyp
12d80 61 74 74 2d 61 6c 69 73 74 29 20 22 20 41 4e 44 att-alist) " AND
12d90 20 22 29 29 0a 09 20 28 6e 75 6d 6b 65 79 73 20 ")).. (numkeys
12da0 20 28 6c 65 6e 67 74 68 20 6b 65 79 70 61 74 74 (length keypatt
12db0 2d 61 6c 69 73 74 29 29 0a 09 20 28 74 65 73 74 -alist)).. (test
12dc0 2d 69 64 73 20 27 28 29 29 0a 09 20 28 77 69 6e -ids '()).. (win
12dd0 64 6f 77 73 20 20 28 61 6e 64 20 70 61 74 68 6d dows (and pathm
12de0 6f 64 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e od (substring-in
12df0 64 65 78 20 22 5c 5c 22 20 70 61 74 68 6d 6f 64 dex "\\" pathmod
12e00 29 29 29 0a 09 20 28 74 65 6d 70 64 69 72 20 20 ))).. (tempdir
12e10 28 63 6f 6e 63 20 22 2f 74 6d 70 2f 22 20 28 63 (conc "/tmp/" (c
12e20 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
12e30 29 20 22 2f 22 20 72 75 6e 73 70 61 74 74 20 22 ) "/" runspatt "
12e40 5f 22 20 28 72 61 6e 64 6f 6d 20 31 30 30 30 30 _" (random 10000
12e50 29 20 22 5f 22 20 28 63 75 72 72 65 6e 74 2d 70 ) "_" (current-p
12e60 72 6f 63 65 73 73 2d 69 64 29 29 29 0a 09 20 28 rocess-id))).. (
12e70 72 75 6e 73 68 65 61 64 65 72 20 28 61 70 70 65 runsheader (appe
12e80 6e 64 20 28 6c 69 73 74 20 22 52 75 6e 20 49 64 nd (list "Run Id
12e90 22 20 22 52 75 6e 6e 61 6d 65 22 29 20 3b 20 30 " "Runname") ; 0
12ea0 20 31 0a 09 09 09 20 20 20 20 20 28 6d 61 70 20 1.... (map
12eb0 63 61 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 car keypatt-alis
12ec0 74 29 20 20 20 3b 20 2b 20 4e 20 3d 20 6c 65 6e t) ; + N = len
12ed0 67 74 68 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 gth keypatt-alis
12ee0 74 0a 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 t.... (list
12ef0 22 54 65 73 74 6e 61 6d 65 22 20 20 20 20 20 20 "Testname"
12f00 20 20 20 20 3b 20 32 0a 09 09 09 09 20 20 20 22 ; 2..... "
12f10 49 74 65 6d 20 50 61 74 68 22 20 20 20 20 20 20 Item Path"
12f20 20 20 20 3b 20 33 20 0a 09 09 09 09 20 20 20 22 ; 3 ..... "
12f30 44 65 73 63 72 69 70 74 69 6f 6e 22 20 20 20 20 Description"
12f40 20 20 20 3b 20 34 20 0a 09 09 09 09 20 20 20 22 ; 4 ..... "
12f50 53 74 61 74 65 22 20 20 20 20 20 20 20 20 20 20 State"
12f60 20 20 20 3b 20 35 20 0a 09 09 09 09 20 20 20 22 ; 5 ..... "
12f70 53 74 61 74 75 73 22 20 20 20 20 20 20 20 20 20 Status"
12f80 20 20 20 3b 20 36 20 20 0a 09 09 09 09 20 20 20 ; 6 .....
12f90 22 46 69 6e 61 6c 20 4c 6f 67 22 20 20 20 20 20 "Final Log"
12fa0 20 20 20 20 3b 20 37 20 0a 09 09 09 09 20 20 20 ; 7 .....
12fb0 22 52 75 6e 20 44 75 72 61 74 69 6f 6e 22 20 20 "Run Duration"
12fc0 20 20 20 20 3b 20 38 20 0a 09 09 09 09 20 20 20 ; 8 .....
12fd0 22 57 68 65 6e 20 52 75 6e 22 20 20 20 20 20 20 "When Run"
12fe0 20 20 20 20 3b 20 39 20 0a 09 09 09 09 20 20 20 ; 9 .....
12ff0 22 54 61 67 73 22 20 20 20 20 20 20 20 20 20 20 "Tags"
13000 20 20 20 20 3b 20 31 30 0a 09 09 09 09 20 20 20 ; 10.....
13010 22 52 75 6e 20 4f 77 6e 65 72 22 20 20 20 20 20 "Run Owner"
13020 20 20 20 20 3b 20 31 31 0a 09 09 09 09 20 20 20 ; 11.....
13030 22 43 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 20 "Comment"
13040 20 20 20 20 3b 20 31 32 0a 09 09 09 09 20 20 20 ; 12.....
13050 22 41 75 74 68 6f 72 22 20 20 20 20 20 20 20 20 "Author"
13060 20 20 20 20 3b 20 31 33 0a 09 09 09 09 20 20 20 ; 13.....
13070 22 54 65 73 74 20 4f 77 6e 65 72 22 20 20 20 20 "Test Owner"
13080 20 20 20 20 3b 20 31 34 0a 09 09 09 09 20 20 20 ; 14.....
13090 22 52 65 76 69 65 77 65 64 22 20 20 20 20 20 20 "Reviewed"
130a0 20 20 20 20 3b 20 31 35 0a 09 09 09 09 20 20 20 ; 15.....
130b0 22 44 69 73 6b 66 72 65 65 22 20 20 20 20 20 20 "Diskfree"
130c0 20 20 20 20 3b 20 31 36 0a 09 09 09 09 20 20 20 ; 16.....
130d0 22 55 6e 61 6d 65 22 20 20 20 20 20 20 20 20 20 "Uname"
130e0 20 20 20 20 3b 20 31 37 0a 09 09 09 09 20 20 20 ; 17.....
130f0 22 52 75 6e 64 69 72 22 20 20 20 20 20 20 20 20 "Rundir"
13100 20 20 20 20 3b 20 31 38 0a 09 09 09 09 20 20 20 ; 18.....
13110 22 48 6f 73 74 22 20 20 20 20 20 20 20 20 20 20 "Host"
13120 20 20 20 20 3b 20 31 39 0a 09 09 09 09 20 20 20 ; 19.....
13130 22 43 70 75 20 4c 6f 61 64 22 20 20 20 20 20 20 "Cpu Load"
13140 20 20 20 20 3b 20 32 30 0a 09 09 09 09 20 20 20 ; 20.....
13150 29 29 29 0a 09 20 28 72 65 73 75 6c 74 73 20 28 ))).. (results (
13160 6c 69 73 74 20 72 75 6e 73 68 65 61 64 65 72 29 list runsheader)
13170 29 09 09 09 20 0a 09 20 28 74 65 73 74 64 61 74 )... .. (testdat
13180 61 2d 68 65 61 64 65 72 20 28 6c 69 73 74 20 22 a-header (list "
13190 52 75 6e 20 49 64 22 20 22 54 65 73 74 6e 61 6d Run Id" "Testnam
131a0 65 22 20 22 49 74 65 6d 20 50 61 74 68 22 20 22 e" "Item Path" "
131b0 43 61 74 65 67 6f 72 79 22 20 22 56 61 72 69 61 Category" "Varia
131c0 62 6c 65 22 20 22 56 61 6c 75 65 22 20 22 45 78 ble" "Value" "Ex
131d0 70 65 63 74 65 64 22 20 22 54 6f 6c 22 20 22 55 pected" "Tol" "U
131e0 6e 69 74 73 22 20 22 53 74 61 74 75 73 22 20 22 nits" "Status" "
131f0 43 6f 6d 6d 65 6e 74 22 29 29 0a 09 20 28 6d 61 Comment")).. (ma
13200 69 6e 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c inqry (conc "SEL
13210 45 43 54 0a 20 20 20 20 20 20 20 20 20 20 20 20 ECT.
13220 20 20 74 2e 74 65 73 74 6e 61 6d 65 2c 72 2e 69 t.testname,r.i
13230 64 2c 72 75 6e 6e 61 6d 65 2c 22 20 6b 65 79 73 d,runname," keys
13240 73 74 72 20 22 2c 74 2e 74 65 73 74 6e 61 6d 65 str ",t.testname
13250 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
13260 74 2e 69 74 65 6d 5f 70 61 74 68 2c 74 6d 2e 64 t.item_path,tm.d
13270 65 73 63 72 69 70 74 69 6f 6e 2c 74 2e 73 74 61 escription,t.sta
13280 74 65 2c 74 2e 73 74 61 74 75 73 2c 0a 20 20 20 te,t.status,.
13290 20 20 20 20 20 20 20 20 20 20 20 66 69 6e 61 6c final
132a0 5f 6c 6f 67 66 2c 72 75 6e 5f 64 75 72 61 74 69 _logf,run_durati
132b0 6f 6e 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 on, .
132c0 20 20 20 73 74 72 66 74 69 6d 65 28 27 25 6d 2f strftime('%m/
132d0 25 64 2f 25 59 20 25 48 3a 25 4d 3a 25 53 27 2c %d/%Y %H:%M:%S',
132e0 64 61 74 65 74 69 6d 65 28 74 2e 65 76 65 6e 74 datetime(t.event
132f0 5f 74 69 6d 65 2c 27 75 6e 69 78 65 70 6f 63 68 _time,'unixepoch
13300 27 29 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 2c '),'localtime'),
13310 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 . t
13320 6d 2e 74 61 67 73 2c 72 2e 6f 77 6e 65 72 2c 74 m.tags,r.owner,t
13330 2e 63 6f 6d 6d 65 6e 74 2c 0a 20 20 20 20 20 20 .comment,.
13340 20 20 20 20 20 20 20 20 61 75 74 68 6f 72 2c 0a author,.
13350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6d tm
13360 2e 6f 77 6e 65 72 2c 72 65 76 69 65 77 65 64 2c .owner,reviewed,
13370 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 64 . d
13380 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 iskfree,uname,ru
13390 6e 64 69 72 2c 0a 20 20 20 20 20 20 20 20 20 20 ndir,.
133a0 20 20 20 20 68 6f 73 74 2c 63 70 75 6c 6f 61 64 host,cpuload
133b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 46 52 4f . FRO
133c0 4d 20 74 65 73 74 73 20 41 53 20 74 20 4a 4f 49 M tests AS t JOI
133d0 4e 20 72 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 N runs AS r ON t
133e0 2e 72 75 6e 5f 69 64 3d 72 2e 69 64 20 4a 4f 49 .run_id=r.id JOI
133f0 4e 20 74 65 73 74 5f 6d 65 74 61 20 41 53 20 74 N test_meta AS t
13400 6d 20 4f 4e 20 74 6d 2e 74 65 73 74 6e 61 6d 65 m ON tm.testname
13410 3d 74 2e 74 65 73 74 6e 61 6d 65 0a 20 20 20 20 =t.testname.
13420 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 WHERE ru
13430 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 41 4e 44 nname LIKE ? AND
13440 20 22 20 6b 65 79 71 72 79 20 22 3b 22 29 29 29 " keyqry ";")))
13450 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
13460 74 20 32 20 22 55 73 69 6e 67 20 22 20 74 65 6d t 2 "Using " tem
13470 70 64 69 72 20 22 20 66 6f 72 20 63 6f 6e 73 74 pdir " for const
13480 72 75 63 74 69 6e 67 20 74 68 65 20 6f 64 73 20 ructing the ods
13490 66 69 6c 65 2e 20 6b 65 79 71 72 79 3a 20 22 20 file. keyqry: "
134a0 6b 65 79 71 72 79 20 22 20 6b 65 79 73 74 72 3a keyqry " keystr:
134b0 20 22 20 6b 65 79 73 73 74 72 20 22 20 77 69 74 " keysstr " wit
134c0 68 20 6b 65 79 73 3a 20 22 20 28 6d 61 70 20 63 h keys: " (map c
134d0 61 64 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 adr keypatt-alis
134e0 74 29 0a 09 09 20 22 5c 6e 20 20 20 20 20 20 6d t)... "\n m
134f0 61 69 6e 71 72 79 3a 20 22 20 6d 61 69 6e 71 72 ainqry: " mainqr
13500 79 29 0a 20 20 20 20 3b 3b 20 22 45 78 70 65 63 y). ;; "Expec
13510 74 65 64 20 56 61 6c 75 65 22 0a 20 20 20 20 3b ted Value". ;
13520 3b 20 22 56 61 6c 75 65 20 46 6f 75 6e 64 22 0a ; "Value Found".
13530 20 20 20 20 3b 3b 20 22 54 6f 6c 65 72 61 6e 63 ;; "Toleranc
13540 65 22 0a 20 20 20 20 28 61 70 70 6c 79 20 73 71 e". (apply sq
13550 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
13560 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 ow.. (lambda (
13570 74 65 73 74 2d 69 64 20 2e 20 62 29 0a 09 20 20 test-id . b)..
13580 20 20 20 28 73 65 74 21 20 74 65 73 74 2d 69 64 (set! test-id
13590 73 20 28 63 6f 6e 73 20 74 65 73 74 2d 69 64 20 s (cons test-id
135a0 74 65 73 74 2d 69 64 73 29 29 20 20 20 3b 3b 20 test-ids)) ;;
135b0 74 65 73 74 2d 69 64 20 69 73 20 6e 6f 77 20 74 test-id is now t
135c0 65 73 74 6e 61 6d 65 0a 09 20 20 20 20 20 28 73 estname.. (s
135d0 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 70 et! results (app
135e0 65 6e 64 20 72 65 73 75 6c 74 73 20 3b 3b 20 6e end results ;; n
135f0 6f 74 65 2c 20 64 72 6f 70 20 74 68 65 20 74 65 ote, drop the te
13600 73 74 2d 69 64 0a 09 09 09 09 20 20 20 28 6c 69 st-id..... (li
13610 73 74 0a 09 09 09 09 20 20 20 20 28 69 66 20 70 st..... (if p
13620 61 74 68 6d 6f 64 0a 09 09 09 09 09 28 6c 65 74 athmod......(let
13630 2a 20 28 28 76 62 20 20 20 20 20 20 20 20 28 61 * ((vb (a
13640 70 70 6c 79 20 76 65 63 74 6f 72 20 62 29 29 0a pply vector b)).
13650 09 09 09 09 09 20 20 20 20 20 20 20 28 6b 65 79 ..... (key
13660 76 61 6c 73 20 20 20 28 6c 65 74 20 6c 6f 6f 70 vals (let loop
13670 20 28 28 69 20 20 20 20 30 29 0a 09 09 09 09 09 ((i 0)......
13680 09 09 09 20 20 20 20 20 28 72 65 73 20 27 28 29 ... (res '()
13690 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 ))........ (i
136a0 66 20 28 3e 3d 20 69 20 6e 75 6d 6b 65 79 73 29 f (>= i numkeys)
136b0 0a 09 09 09 09 09 09 09 09 72 65 73 0a 09 09 09 .........res....
136c0 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 20 .....(loop (+ i
136d0 31 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 1).........
136e0 20 28 61 70 70 65 6e 64 20 72 65 73 20 28 6c 69 (append res (li
136f0 73 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 st (vector-ref v
13700 62 20 28 2b 20 69 20 32 29 29 29 29 29 29 29 29 b (+ i 2))))))))
13710 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 ...... (ru
13720 6e 6e 61 6d 65 20 20 20 28 76 65 63 74 6f 72 2d nname (vector-
13730 72 65 66 20 76 62 20 31 29 29 0a 09 09 09 09 09 ref vb 1))......
13740 20 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 (testname
13750 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 (vector-ref vb
13760 20 28 2b 20 20 32 20 6e 75 6d 6b 65 79 73 29 29 (+ 2 numkeys))
13770 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 )...... (i
13780 74 65 6d 2d 70 61 74 68 20 28 76 65 63 74 6f 72 tem-path (vector
13790 2d 72 65 66 20 76 62 20 28 2b 20 20 33 20 6e 75 -ref vb (+ 3 nu
137a0 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 mkeys)))......
137b0 20 20 20 20 20 28 66 69 6e 61 6c 2d 6c 6f 67 20 (final-log
137c0 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 (vector-ref vb (
137d0 2b 20 20 37 20 6e 75 6d 6b 65 79 73 29 29 29 0a + 7 numkeys))).
137e0 09 09 09 09 09 20 20 20 20 20 20 20 28 72 75 6e ..... (run
137f0 2d 64 69 72 20 20 20 28 76 65 63 74 6f 72 2d 72 -dir (vector-r
13800 65 66 20 76 62 20 28 2b 20 31 38 20 6e 75 6d 6b ef vb (+ 18 numk
13810 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 eys)))......
13820 20 20 20 28 6c 6f 67 2d 66 70 61 74 68 20 28 63 (log-fpath (c
13830 6f 6e 63 20 72 75 6e 2d 64 69 72 20 22 2f 22 20 onc run-dir "/"
13840 20 66 69 6e 61 6c 2d 6c 6f 67 29 29 29 20 3b 3b final-log))) ;;
13850 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
13860 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 2f 22 erse keyvals "/"
13870 29 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 20 22 ) "/" testname "
13880 2f 22 20 69 74 65 6d 2d 70 61 74 68 20 22 2f 22 /" item-path "/"
13890 0a 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
138a0 72 69 6e 74 20 34 20 22 6c 6f 67 3a 20 22 20 6c rint 4 "log: " l
138b0 6f 67 2d 66 70 61 74 68 20 22 20 65 78 69 73 74 og-fpath " exist
138c0 73 3a 20 22 20 28 66 69 6c 65 2d 65 78 69 73 74 s: " (file-exist
138d0 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 29 0a 09 s? log-fpath))..
138e0 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 .... (vector-se
138f0 74 21 20 76 62 20 28 2b 20 37 20 6e 75 6d 6b 65 t! vb (+ 7 numke
13900 79 73 29 20 28 69 66 20 28 66 69 6c 65 2d 65 78 ys) (if (file-ex
13910 69 73 74 73 3f 20 6c 6f 67 2d 66 70 61 74 68 29 ists? log-fpath)
13920 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 6c .......... (l
13930 65 74 20 28 28 6e 65 77 70 61 74 68 20 28 63 6f et ((newpath (co
13940 6e 63 20 70 61 74 68 6d 6f 64 20 22 2f 22 0a 09 nc pathmod "/"..
13950 09 09 09 09 09 09 09 09 09 09 09 20 28 73 74 72 ........... (str
13960 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
13970 6b 65 79 76 61 6c 73 20 22 2f 22 29 0a 09 09 09 keyvals "/")....
13980 09 09 09 09 09 09 09 09 09 20 22 2f 22 20 72 75 ......... "/" ru
13990 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
139a0 6d 65 20 22 2f 22 0a 09 09 09 09 09 09 09 09 09 me "/"..........
139b0 09 09 09 20 28 69 66 20 28 73 74 72 69 6e 67 3d ... (if (string=
139c0 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 20 ? item-path "")
139d0 22 22 20 28 63 6f 6e 63 20 22 2f 22 20 69 74 65 "" (conc "/" ite
139e0 6d 2d 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 m-path))........
139f0 09 09 09 09 09 20 66 69 6e 61 6c 2d 6c 6f 67 29 ..... final-log)
13a00 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
13a10 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 20 74 68 72 ;; for now thr
13a20 6f 77 20 61 77 61 79 20 6e 65 77 70 61 74 68 20 ow away newpath
13a30 61 6e 64 20 75 73 65 20 74 68 65 20 6c 6f 67 2d and use the log-
13a40 66 70 61 74 68 20 63 6f 6e 63 27 64 20 77 69 74 fpath conc'd wit
13a50 68 20 70 61 74 68 6d 6f 64 0a 09 09 09 09 09 09 h pathmod.......
13a60 09 09 09 20 20 20 20 20 20 28 73 65 74 21 20 6e ... (set! n
13a70 65 77 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 ewpath (conc pat
13a80 68 6d 6f 64 20 6c 6f 67 2d 66 70 61 74 68 29 29 hmod log-fpath))
13a90 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
13aa0 28 69 66 20 77 69 6e 64 6f 77 73 20 28 73 74 72 (if windows (str
13ab0 69 6e 67 2d 74 72 61 6e 73 6c 61 74 65 20 6e 65 ing-translate ne
13ac0 77 70 61 74 68 20 22 2f 22 20 22 5c 5c 22 29 20 wpath "/" "\\")
13ad0 6e 65 77 70 61 74 68 29 29 0a 09 09 09 09 09 09 newpath)).......
13ae0 09 09 09 20 20 20 20 28 69 66 20 28 64 65 62 75 ... (if (debu
13af0 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 0a g:debug-mode 1).
13b00 09 09 09 09 09 09 09 09 09 09 28 63 6f 6e 63 20 ..........(conc
13b10 66 69 6e 61 6c 2d 6c 6f 67 20 22 20 6e 6f 74 2d final-log " not-
13b20 66 6f 75 6e 64 22 29 0a 09 09 09 09 09 09 09 09 found").........
13b30 09 09 22 22 29 29 29 0a 09 09 09 09 09 20 20 28 .."")))...... (
13b40 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 62 29 vector->list vb)
13b50 29 0a 09 09 09 09 09 62 29 29 29 29 29 0a 09 20 )......b)))))..
13b60 20 20 64 62 0a 09 20 20 20 6d 61 69 6e 71 72 79 db.. mainqry
13b70 0a 09 20 20 20 72 75 6e 73 70 61 74 74 20 28 6d .. runspatt (m
13b80 61 70 20 63 61 64 72 20 6b 65 79 70 61 74 74 2d ap cadr keypatt-
13b90 61 6c 69 73 74 29 29 0a 20 20 20 20 28 64 65 62 alist)). (deb
13ba0 75 67 3a 70 72 69 6e 74 20 32 20 22 46 6f 75 6e ug:print 2 "Foun
13bb0 64 20 22 20 28 6c 65 6e 67 74 68 20 74 65 73 74 d " (length test
13bc0 2d 69 64 73 29 20 22 20 72 65 63 6f 72 64 73 22 -ids) " records"
13bd0 29 0a 20 20 20 20 28 73 65 74 21 20 72 65 73 75 ). (set! resu
13be0 6c 74 73 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 lts (list (cons
13bf0 22 52 75 6e 73 22 20 72 65 73 75 6c 74 73 29 29 "Runs" results))
13c00 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 2c 20 66 6f ). ;; now, fo
13c10 72 20 65 61 63 68 20 74 65 73 74 2c 20 63 6f 6c r each test, col
13c20 6c 65 63 74 20 74 68 65 20 74 65 73 74 5f 64 61 lect the test_da
13c30 74 61 20 69 6e 66 6f 20 61 6e 64 20 61 64 64 20 ta info and add
13c40 61 20 6e 65 77 20 73 68 65 65 74 0a 20 20 20 20 a new sheet.
13c50 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 28 (for-each. (
13c60 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 29 lambda (test-id)
13c70 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
13c80 65 73 74 2d 64 61 74 61 20 28 6c 69 73 74 20 74 est-data (list t
13c90 65 73 74 64 61 74 61 2d 68 65 61 64 65 72 29 29 estdata-header))
13ca0 0a 09 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 .. (curr-tes
13cb0 74 2d 6e 61 6d 65 20 23 66 29 29 0a 09 20 28 73 t-name #f)).. (s
13cc0 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
13cd0 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 row.. (lambda (
13ce0 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
13cf0 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 6f item-path catego
13d00 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
13d10 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
13d20 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d 6d nits status comm
13d30 65 6e 74 29 0a 09 20 20 20 20 28 73 65 74 21 20 ent).. (set!
13d40 63 75 72 72 2d 74 65 73 74 2d 6e 61 6d 65 20 74 curr-test-name t
13d50 65 73 74 6e 61 6d 65 29 0a 09 20 20 20 20 28 73 estname).. (s
13d60 65 74 21 20 74 65 73 74 2d 64 61 74 61 20 28 61 et! test-data (a
13d70 70 70 65 6e 64 20 74 65 73 74 2d 64 61 74 61 20 ppend test-data
13d80 28 6c 69 73 74 20 28 6c 69 73 74 20 72 75 6e 2d (list (list run-
13d90 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
13da0 2d 70 61 74 68 20 63 61 74 65 67 6f 72 79 20 76 -path category v
13db0 61 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 78 ariable value ex
13dc0 70 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 pected tol units
13dd0 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 29 status comment)
13de0 29 29 29 29 0a 09 20 20 64 62 20 0a 09 20 20 3b )))).. db .. ;
13df0 3b 20 22 53 45 4c 45 43 54 20 72 75 6e 5f 69 64 ; "SELECT run_id
13e00 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 ,testname,item_p
13e10 61 74 68 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 ath,category,var
13e20 69 61 62 6c 65 2c 74 64 2e 76 61 6c 75 65 20 41 iable,td.value A
13e30 53 20 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 S value,expected
13e40 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 64 2e 73 74 ,tol,units,td.st
13e50 61 74 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 atus AS status,t
13e60 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d d.comment AS com
13e70 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 ment FROM test_d
13e80 61 74 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 ata AS td INNER
13e90 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 JOIN tests ON te
13ea0 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 sts.id=td.test_i
13eb0 64 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d d WHERE test_id=
13ec0 3f 3b 22 0a 09 20 20 22 53 45 4c 45 43 54 20 72 ?;".. "SELECT r
13ed0 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 un_id,testname,i
13ee0 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 tem_path,categor
13ef0 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 y,variable,td.va
13f00 6c 75 65 20 41 53 20 76 61 6c 75 65 2c 74 64 2e lue AS value,td.
13f10 65 78 70 65 63 74 65 64 2c 74 64 2e 74 6f 6c 2c expected,td.tol,
13f20 74 64 2e 75 6e 69 74 73 2c 74 64 2e 73 74 61 74 td.units,td.stat
13f30 75 73 20 41 53 20 73 74 61 74 75 73 2c 74 64 2e us AS status,td.
13f40 63 6f 6d 6d 65 6e 74 20 41 53 20 63 6f 6d 6d 65 comment AS comme
13f50 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 nt FROM test_dat
13f60 61 20 41 53 20 74 64 20 49 4e 4e 45 52 20 4a 4f a AS td INNER JO
13f70 49 4e 20 74 65 73 74 73 20 4f 4e 20 74 65 73 74 IN tests ON test
13f80 73 2e 69 64 3d 74 64 2e 74 65 73 74 5f 69 64 20 s.id=td.test_id
13f90 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f WHERE testname=?
13fa0 3b 22 0a 09 20 20 74 65 73 74 2d 69 64 29 0a 09 ;".. test-id)..
13fb0 20 28 69 66 20 63 75 72 72 2d 74 65 73 74 2d 6e (if curr-test-n
13fc0 61 6d 65 0a 09 20 20 20 20 20 28 73 65 74 21 20 ame.. (set!
13fd0 72 65 73 75 6c 74 73 20 28 61 70 70 65 6e 64 20 results (append
13fe0 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 63 results (list (c
13ff0 6f 6e 73 20 63 75 72 72 2d 74 65 73 74 2d 6e 61 ons curr-test-na
14000 6d 65 20 74 65 73 74 2d 64 61 74 61 29 29 29 29 me test-data))))
14010 29 0a 09 20 29 29 0a 20 20 20 20 20 28 73 6f 72 ).. )). (sor
14020 74 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 t (delete-duplic
14030 61 74 65 73 20 74 65 73 74 2d 69 64 73 29 20 73 ates test-ids) s
14040 74 72 69 6e 67 3c 3d 29 29 0a 20 20 20 20 28 73 tring<=)). (s
14050 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 ystem (conc "mkd
14060 69 72 20 2d 70 20 22 20 74 65 6d 70 64 69 72 29 ir -p " tempdir)
14070 29 0a 20 20 20 20 3b 3b 20 28 70 70 20 72 65 73 ). ;; (pp res
14080 75 6c 74 73 29 0a 20 20 20 20 28 6f 64 73 3a 6c ults). (ods:l
14090 69 73 74 2d 3e 6f 64 73 20 0a 20 20 20 20 20 74 ist->ods . t
140a0 65 6d 70 64 69 72 0a 20 20 20 20 20 28 69 66 20 empdir. (if
140b0 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 (string-match (r
140c0 65 67 65 78 70 20 22 5e 5b 2f 7e 5d 2b 2e 2a 22 egexp "^[/~]+.*"
140d0 29 20 6f 75 74 70 75 74 66 69 6c 65 29 20 3b 3b ) outputfile) ;;
140e0 20 66 75 6c 6c 20 70 61 74 68 3f 0a 09 20 6f 75 full path?.. ou
140f0 74 70 75 74 66 69 6c 65 0a 09 20 28 62 65 67 69 tputfile.. (begi
14100 6e 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 n.. (debug:pri
14110 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 70 nt 0 "WARNING: p
14120 61 74 68 20 67 69 76 65 6e 2c 20 22 20 6f 75 74 ath given, " out
14130 70 75 74 66 69 6c 65 20 22 20 69 73 20 72 65 6c putfile " is rel
14140 61 74 69 76 65 2c 20 70 72 65 66 69 78 69 6e 67 ative, prefixing
14150 20 77 69 74 68 20 63 75 72 72 65 6e 74 20 64 69 with current di
14160 72 65 63 74 6f 72 79 22 29 0a 09 20 20 20 28 63 rectory").. (c
14170 6f 6e 63 20 28 63 75 72 72 65 6e 74 2d 64 69 72 onc (current-dir
14180 65 63 74 6f 72 79 29 20 22 2f 22 20 6f 75 74 70 ectory) "/" outp
14190 75 74 66 69 6c 65 29 29 29 0a 20 20 20 20 20 72 utfile))). r
141a0 65 73 75 6c 74 73 29 0a 20 20 20 20 3b 3b 20 62 esults). ;; b
141b0 72 75 74 61 6c 20 63 6c 65 61 6e 20 75 70 0a 20 rutal clean up.
141c0 20 20 20 28 73 79 73 74 65 6d 20 22 72 6d 20 2d (system "rm -
141d0 72 66 20 74 65 6d 70 64 69 72 22 29 29 29 0a 0a rf tempdir")))..
141e0 3b 3b 20 28 64 62 3a 65 78 74 72 61 63 74 2d 6f ;; (db:extract-o
141f0 64 73 2d 66 69 6c 65 20 64 62 20 22 6f 75 74 70 ds-file db "outp
14200 75 74 66 69 6c 65 2e 6f 64 73 22 20 27 28 28 22 utfile.ods" '(("
14210 73 79 73 6e 61 6d 65 22 20 22 25 22 29 28 22 66 sysname" "%")("f
14220 73 6e 61 6d 65 22 20 22 25 22 29 28 22 64 61 74 sname" "%")("dat
14230 61 70 61 74 68 22 20 22 25 22 29 29 20 22 25 22 apath" "%")) "%"
14240 29 0a ).