0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 44 61 74 61 62 61 73 65 ====.;; Database
0230: 20 61 63 63 65 73 73 0a 3b 3b 3d 3d 3d 3d 3d 3d access.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e ..(require-exten
0290: 73 69 6f 6e 20 28 73 72 66 69 20 31 38 29 20 65 sion (srfi 18) e
02a0: 78 74 72 61 73 20 74 63 70 20 72 70 63 29 0a 28 xtras tcp rpc).(
02b0: 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 72 import (prefix r
02c0: 70 63 20 72 70 63 3a 29 29 0a 0a 28 75 73 65 20 pc rpc:))..(use
02d0: 73 71 6c 69 74 65 33 20 73 72 66 69 2d 31 20 70 sqlite3 srfi-1 p
02e0: 6f 73 69 78 20 72 65 67 65 78 20 72 65 67 65 78 osix regex regex
02f0: 2d 63 61 73 65 20 73 72 66 69 2d 36 39 20 63 73 -case srfi-69 cs
0300: 76 2d 78 6d 6c 29 0a 28 69 6d 70 6f 72 74 20 28 v-xml).(import (
0310: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0320: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
0330: 61 72 65 20 28 75 6e 69 74 20 64 62 29 29 0a 28 are (unit db)).(
0340: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
0350: 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 mmon)).(declare
0360: 28 75 73 65 73 20 6b 65 79 73 29 29 0a 28 64 65 (uses keys)).(de
0370: 63 6c 61 72 65 20 28 75 73 65 73 20 6f 64 73 29 clare (uses ods)
0380: 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d )..(include "com
0390: 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 mon_records.scm"
03a0: 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 ).(include "db_r
03b0: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
03c0: 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 clude "key_recor
03d0: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
03e0: 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 e "run_records.s
03f0: 63 6d 22 29 0a 0a 3b 3b 20 74 69 6d 65 73 74 61 cm")..;; timesta
0400: 6d 70 20 74 79 70 65 20 28 76 61 6c 31 20 76 61 mp type (val1 va
0410: 6c 32 20 2e 2e 2e 29 0a 3b 3b 20 74 79 70 65 3a l2 ...).;; type:
0420: 20 6d 65 74 61 2d 69 6e 66 6f 2c 20 73 74 65 70 meta-info, step
0430: 0a 28 64 65 66 69 6e 65 20 2a 69 6e 63 6f 6d 69 .(define *incomi
0440: 6e 67 2d 64 61 74 61 2a 20 20 20 20 20 20 27 28 ng-data* '(
0450: 29 29 0a 28 64 65 66 69 6e 65 20 2a 69 6e 63 6f )).(define *inco
0460: 6d 69 6e 67 2d 6c 61 73 74 2d 74 69 6d 65 2a 20 ming-last-time*
0470: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
0480: 29 29 0a 28 64 65 66 69 6e 65 20 2a 69 6e 63 6f )).(define *inco
0490: 6d 69 6e 67 2d 6d 75 74 65 78 2a 20 20 20 20 20 ming-mutex*
04a0: 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 28 64 (make-mutex)).(d
04b0: 65 66 69 6e 65 20 2a 63 61 63 68 65 2d 6f 6e 2a efine *cache-on*
04c0: 20 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 #f)..(define (d
04d0: 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 b:set-sync db).
04e0: 20 28 6c 65 74 2a 20 28 28 73 79 6e 63 76 61 6c (let* ((syncval
04f0: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
0500: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
0510: 74 75 70 22 20 20 20 20 20 22 73 79 6e 63 68 72 tup" "synchr
0520: 6f 6e 6f 75 73 22 29 29 0a 09 20 28 76 61 6c 20 onous")).. (val
0530: 20 20 20 20 20 28 63 6f 6e 64 20 20 20 3b 3b 20 (cond ;;
0540: 30 20 7c 20 4f 46 46 20 7c 20 31 20 7c 20 4e 4f 0 | OFF | 1 | NO
0550: 52 4d 41 4c 20 7c 20 32 20 7c 20 46 55 4c 4c 3b RMAL | 2 | FULL;
0560: 0a 09 09 20 20 20 20 28 28 6e 6f 74 20 73 79 6e ... ((not syn
0570: 63 76 61 6c 29 20 23 66 29 0a 09 09 20 20 20 20 cval) #f)...
0580: 28 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 ((string->number
0590: 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 20 syncval)...
05a0: 20 28 6c 65 74 20 28 28 76 61 6c 20 28 73 74 72 (let ((val (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 29 29 0a 09 09 20 20 20 20 20 20 20 val)))...
05d0: 28 69 66 20 28 6d 65 6d 62 65 72 20 76 61 6c 20 (if (member val
05e0: 27 28 30 20 31 20 32 29 29 20 76 61 6c 20 23 66 '(0 1 2)) val #f
05f0: 29 29 29 0a 09 09 20 20 20 20 28 28 73 74 72 69 )))... ((stri
0600: 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 ng-match (regexp
0610: 20 22 79 65 73 22 20 23 74 29 20 73 79 6e 63 76 "yes" #t) syncv
0620: 61 6c 29 20 31 29 0a 09 09 20 20 20 20 28 28 73 al) 1)... ((s
0630: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
0640: 65 78 70 20 22 6e 6f 22 20 20 23 74 29 20 73 79 exp "no" #t) sy
0650: 6e 63 76 61 6c 29 20 30 29 0a 09 09 20 20 20 20 ncval) 0)...
0660: 28 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 ((string-match (
0670: 72 65 67 65 78 70 20 22 28 6f 66 66 7c 6e 6f 72 regexp "(off|nor
0680: 6d 61 6c 7c 66 75 6c 6c 29 22 20 23 74 29 20 73 mal|full)" #t) s
0690: 79 6e 63 76 61 6c 29 20 73 79 6e 63 76 61 6c 29 yncval) syncval)
06a0: 0a 09 09 20 20 20 20 28 65 6c 73 65 20 0a 09 09 ... (else ...
06b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
06c0: 74 20 30 20 22 45 52 52 4f 52 3a 20 73 79 6e 63 t 0 "ERROR: sync
06d0: 68 72 6f 6e 6f 75 73 20 6d 75 73 74 20 62 65 20 hronous must be
06e0: 30 2c 31 2c 32 2c 4f 46 46 2c 4e 4f 52 4d 41 4c 0,1,2,OFF,NORMAL
06f0: 20 6f 72 20 46 55 4c 4c 2c 20 79 6f 75 20 70 72 or FULL, you pr
0700: 6f 76 69 64 65 64 3a 20 22 20 73 79 6e 63 76 61 ovided: " syncva
0710: 6c 29 0a 09 09 20 20 20 20 20 23 66 29 29 29 29 l)... #f))))
0720: 0a 20 20 20 20 28 69 66 20 76 61 6c 0a 09 28 62 . (if val..(b
0730: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
0740: 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 53 65 rint 4 "INFO: Se
0750: 74 74 69 6e 67 20 70 72 61 67 6d 61 20 73 79 6e tting pragma syn
0760: 63 68 72 6f 6e 6f 75 73 20 74 6f 20 22 20 76 61 chronous to " va
0770: 6c 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 l).. (sqlite3:e
0780: 78 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 xecute db (conc
0790: 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e "PRAGMA synchron
07a0: 6f 75 73 20 3d 20 27 22 20 76 61 6c 20 22 27 3b ous = '" val "';
07b0: 22 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 "))))))..(define
07c0: 20 28 6f 70 65 6e 2d 64 62 29 20 3b 3b 20 20 28 (open-db) ;; (
07d0: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
07e0: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 /megatest.db") (
07f0: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
0800: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 ))). (let* ((db
0810: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 2a 74 path (conc *t
0820: 6f 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 oppath* "/megate
0830: 73 74 2e 64 62 22 29 29 20 3b 3b 20 66 6e 61 6d st.db")) ;; fnam
0840: 65 29 0a 09 20 28 64 62 65 78 69 73 74 73 20 20 e).. (dbexists
0850: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 (file-exists? db
0860: 70 61 74 68 29 29 0a 09 20 28 64 62 20 20 20 20 path)).. (db
0870: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 (sqlite3:ope
0880: 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 61 74 n-database dbpat
0890: 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d 67 69 h)) ;; (never-gi
08a0: 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 64 62 ve-up-open-db db
08b0: 70 61 74 68 29 29 0a 09 20 28 68 61 6e 64 6c 65 path)).. (handle
08c0: 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 79 2d 74 r (make-busy-t
08d0: 69 6d 65 6f 75 74 20 28 69 66 20 28 61 72 67 73 imeout (if (args
08e0: 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 :get-arg "-overr
08f0: 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 0a 09 09 ide-timeout")...
0900: 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e ... (string->n
0910: 75 6d 62 65 72 20 28 61 72 67 73 3a 67 65 74 2d umber (args:get-
0920: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 arg "-override-t
0930: 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 09 09 20 imeout"))......
0940: 20 20 33 36 30 30 30 29 29 29 29 20 3b 3b 20 31 36000)))) ;; 1
0950: 33 36 30 30 30 29 29 29 0a 20 20 20 20 28 64 65 36000))). (de
0960: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF
0970: 4f 3a 20 64 62 70 61 74 68 3d 22 20 64 62 70 61 O: dbpath=" dbpa
0980: 74 68 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 th). (sqlite3
0990: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 :set-busy-handle
09a0: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 r! db handler).
09b0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 (if (not dbex
09c0: 69 73 74 73 29 0a 09 28 64 62 3a 69 6e 69 74 69 ists)..(db:initi
09d0: 61 6c 69 7a 65 20 64 62 29 29 0a 20 20 20 20 28 alize db)). (
09e0: 64 62 3a 73 65 74 2d 73 79 6e 63 20 64 62 29 0a db:set-sync db).
09f0: 20 20 20 20 64 62 29 29 0a 0a 3b 3b 20 6b 65 65 db))..;; kee
0a00: 70 69 6e 67 20 69 74 20 61 72 6f 75 6e 64 20 66 ping it around f
0a10: 6f 72 20 64 65 62 75 67 67 69 6e 67 20 70 75 72 or debugging pur
0a20: 70 6f 73 65 73 20 6f 6e 6c 79 0a 28 64 65 66 69 poses only.(defi
0a30: 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ne (open-run-clo
0a40: 73 65 2d 6e 6f 2d 65 78 63 65 70 74 69 6f 6e 2d se-no-exception-
0a50: 68 61 6e 64 6c 69 6e 67 20 20 70 72 6f 63 20 69 handling proc i
0a60: 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 db . params). (
0a70: 6c 65 74 2a 20 28 28 64 62 20 20 20 28 69 66 20 let* ((db (if
0a80: 69 64 62 20 69 64 62 20 28 6f 70 65 6e 2d 64 62 idb idb (open-db
0a90: 29 29 29 0a 09 20 28 72 65 73 20 23 66 29 29 0a ))).. (res #f)).
0aa0: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 61 (set! res (a
0ab0: 70 70 6c 79 20 70 72 6f 63 20 64 62 20 70 61 72 pply proc db par
0ac0: 61 6d 73 29 29 0a 20 20 20 20 28 69 66 20 28 6e ams)). (if (n
0ad0: 6f 74 20 69 64 62 29 28 73 71 6c 69 74 65 33 3a ot idb)(sqlite3:
0ae0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 20 finalize! db)).
0af0: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
0b00: 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 e (open-run-clos
0b10: 65 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 e-exception-hand
0b20: 6c 69 6e 67 20 70 72 6f 63 20 69 64 62 20 2e 20 ling proc idb .
0b30: 70 61 72 61 6d 73 29 0a 20 20 28 6c 65 74 20 28 params). (let (
0b40: 28 72 75 6e 6e 65 72 20 28 6c 61 6d 62 64 61 20 (runner (lambda
0b50: 28 29 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 64 ()... (let* ((d
0b60: 62 20 20 20 28 69 66 20 69 64 62 20 69 64 62 20 b (if idb idb
0b70: 28 6f 70 65 6e 2d 64 62 29 29 29 0a 09 09 09 20 (open-db)))....
0b80: 28 72 65 73 20 23 66 29 29 0a 09 09 20 20 20 20 (res #f))...
0b90: 28 73 65 74 21 20 72 65 73 20 28 61 70 70 6c 79 (set! res (apply
0ba0: 20 70 72 6f 63 20 64 62 20 70 61 72 61 6d 73 29 proc db params)
0bb0: 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 )... (if (not
0bc0: 20 69 64 62 29 28 73 71 6c 69 74 65 33 3a 66 69 idb)(sqlite3:fi
0bd0: 6e 61 6c 69 7a 65 21 20 64 62 29 29 0a 09 09 20 nalize! db))...
0be0: 20 20 20 72 65 73 29 29 29 29 0a 20 20 20 20 28 res)))). (
0bf0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
0c00: 73 0a 20 20 20 20 20 65 78 6e 0a 20 20 20 20 20 s. exn.
0c10: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 28 64 (begin. (d
0c20: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 58 ebug:print 0 "EX
0c30: 43 45 50 54 49 4f 4e 3a 20 64 61 74 61 62 61 73 CEPTION: databas
0c40: 65 20 70 72 6f 62 61 62 6c 79 20 6f 76 65 72 6c e probably overl
0c50: 6f 61 64 65 64 3f 22 29 0a 20 20 20 20 20 20 20 oaded?").
0c60: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
0c70: 20 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d " ((condition-
0c80: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
0c90: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
0ca0: 20 65 78 6e 29 29 0a 20 20 20 20 20 20 20 28 70 exn)). (p
0cb0: 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 rint-call-chain)
0cc0: 0a 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d . (thread-
0cd0: 73 6c 65 65 70 21 20 28 72 61 6e 64 6f 6d 20 31 sleep! (random 1
0ce0: 32 30 29 29 0a 20 20 20 20 20 20 20 28 64 65 62 20)). (deb
0cf0: 75 67 3a 70 72 69 6e 74 20 30 20 22 74 72 79 69 ug:print 0 "tryi
0d00: 6e 67 20 64 62 20 63 61 6c 6c 20 6f 6e 65 20 6d ng db call one m
0d10: 6f 72 65 20 74 69 6d 65 2e 2e 2e 2e 22 29 0a 20 ore time....").
0d20: 20 20 20 20 20 20 28 72 75 6e 6e 65 72 29 29 0a (runner)).
0d30: 20 20 20 20 20 28 72 75 6e 6e 65 72 29 29 29 29 (runner))))
0d40: 0a 0a 28 64 65 66 69 6e 65 20 6f 70 65 6e 2d 72 ..(define open-r
0d50: 75 6e 2d 63 6c 6f 73 65 20 6f 70 65 6e 2d 72 75 un-close open-ru
0d60: 6e 2d 63 6c 6f 73 65 2d 65 78 63 65 70 74 69 6f n-close-exceptio
0d70: 6e 2d 68 61 6e 64 6c 69 6e 67 29 0a 0a 28 64 65 n-handling)..(de
0d80: 66 69 6e 65 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c fine *global-del
0d90: 74 61 2a 20 30 29 0a 28 64 65 66 69 6e 65 20 2a ta* 0).(define *
0da0: 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 last-global-delt
0db0: 61 2d 70 72 69 6e 74 65 64 2a 20 30 29 0a 0a 28 a-printed* 0)..(
0dc0: 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e define (open-run
0dd0: 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 20 -close-measure
0de0: 70 72 6f 63 20 69 64 62 20 2e 20 70 61 72 61 6d proc idb . param
0df0: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 s). (let* ((sta
0e00: 72 74 2d 6d 73 20 28 63 75 72 72 65 6e 74 2d 6d rt-ms (current-m
0e10: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 20 illiseconds))..
0e20: 28 64 62 20 20 20 20 20 20 20 28 69 66 20 69 64 (db (if id
0e30: 62 20 69 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 b idb (open-db))
0e40: 29 0a 20 20 20 20 20 20 20 20 20 28 74 68 72 6f ). (thro
0e50: 74 74 6c 65 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ttle (string->nu
0e60: 6d 62 65 72 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f mber (config-loo
0e70: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
0e80: 22 73 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c "setup" "throttl
0e90: 65 22 29 29 29 29 0a 0a 20 20 20 20 28 64 62 3a e")))).. (db:
0ea0: 73 65 74 2d 73 79 6e 63 20 64 62 29 0a 20 20 20 set-sync db).
0eb0: 20 28 73 65 74 21 20 72 65 73 20 20 20 20 20 20 (set! res
0ec0: 28 61 70 70 6c 79 20 70 72 6f 63 20 64 62 20 70 (apply proc db p
0ed0: 61 72 61 6d 73 29 29 0a 20 20 20 20 28 69 66 20 arams)). (if
0ee0: 28 6e 6f 74 20 69 64 62 29 28 73 71 6c 69 74 65 (not idb)(sqlite
0ef0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 29 3:finalize! db))
0f00: 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 79 . ;; scale by
0f10: 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 74 10, average wit
0f20: 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 2e h current value.
0f30: 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 . (set! *glob
0f40: 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b 20 al-delta* (/ (+
0f50: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28 *global-delta* (
0f60: 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 * (- (current-mi
0f70: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
0f80: 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 66 t-ms)....... (if
0f90: 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 74 throttle thrott
0fa0: 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 20 le 0.01)))....
0fb0: 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 3e 2)). (if (>
0fc0: 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d 67 (abs (- *last-g
0fd0: 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e lobal-delta-prin
0fe0: 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c ted* *global-del
0ff0: 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 64 ta*)) 0.08) ;; d
1000: 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 74 on't print all t
1010: 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 66 he time, only if
1020: 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 69 it changes a bi
1030: 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 t..(begin.. (de
1040: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 49 4e 46 bug:print 1 "INF
1050: 4f 3a 20 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 O: launch thrott
1060: 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f le factor=" *glo
1070: 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 bal-delta*).. (
1080: 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 set! *last-globa
1090: 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a l-delta-printed*
10a0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 *global-delta*)
10b0: 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 )). res))..(d
10c0: 65 66 69 6e 65 20 28 64 62 3a 69 6e 69 74 69 61 efine (db:initia
10d0: 6c 69 7a 65 20 64 62 29 0a 20 20 28 6c 65 74 2a lize db). (let*
10e0: 20 28 28 63 6f 6e 66 69 67 64 61 74 20 28 63 61 ((configdat (ca
10f0: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 29 r *configinfo*))
1100: 20 20 3b 3b 20 74 75 74 20 74 75 74 2c 20 67 6c ;; tut tut, gl
1110: 6f 62 61 6c 20 77 61 72 6e 69 6e 67 2e 2e 2e 0a obal warning....
1120: 09 20 28 6b 65 79 73 20 20 20 20 20 28 63 6f 6e . (keys (con
1130: 66 69 67 2d 67 65 74 2d 66 69 65 6c 64 73 20 63 fig-get-fields c
1140: 6f 6e 66 69 67 64 61 74 29 29 0a 09 20 28 68 61 onfigdat)).. (ha
1150: 76 65 6b 65 79 73 20 28 3e 20 28 6c 65 6e 67 74 vekeys (> (lengt
1160: 68 20 6b 65 79 73 29 20 30 29 29 0a 09 20 28 6b h keys) 0)).. (k
1170: 65 79 73 74 72 20 20 20 28 6b 65 79 73 2d 3e 6b eystr (keys->k
1180: 65 79 73 74 72 20 6b 65 79 73 29 29 0a 09 20 28 eystr keys)).. (
1190: 66 69 65 6c 64 73 74 72 20 28 6b 65 79 73 2d 3e fieldstr (keys->
11a0: 6b 65 79 2f 66 69 65 6c 64 20 6b 65 79 73 29 29 key/field keys))
11b0: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
11c0: 28 6c 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 (lambda (key)...
11d0: 28 6c 65 74 20 28 28 6b 65 79 6e 20 28 76 65 63 (let ((keyn (vec
11e0: 74 6f 72 2d 72 65 66 20 6b 65 79 20 30 29 29 29 tor-ref key 0)))
11f0: 0a 09 09 20 20 28 69 66 20 28 6d 65 6d 62 65 72 ... (if (member
1200: 20 28 73 74 72 69 6e 67 2d 64 6f 77 6e 63 61 73 (string-downcas
1210: 65 20 6b 65 79 6e 29 0a 09 09 09 20 20 20 20 20 e keyn)....
1220: 20 28 6c 69 73 74 20 22 72 75 6e 6e 61 6d 65 22 (list "runname"
1230: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
1240: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
1250: 5f 74 69 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 _time" "comment"
1260: 20 22 66 61 69 6c 5f 63 6f 75 6e 74 22 0a 09 09 "fail_count"...
1270: 09 09 20 20 20 20 22 70 61 73 73 5f 63 6f 75 6e .. "pass_coun
1280: 74 22 29 29 0a 09 09 20 20 20 20 20 20 28 62 65 t"))... (be
1290: 67 69 6e 0a 09 09 09 28 70 72 69 6e 74 20 22 45 gin....(print "E
12a0: 52 52 4f 52 3a 20 79 6f 75 72 20 6b 65 79 20 63 RROR: your key c
12b0: 61 6e 6e 6f 74 20 62 65 20 6e 61 6d 65 64 20 22 annot be named "
12c0: 20 6b 65 79 6e 20 22 20 61 73 20 74 68 69 73 20 keyn " as this
12d0: 63 6f 6e 66 6c 69 63 74 73 20 77 69 74 68 20 74 conflicts with t
12e0: 68 65 20 73 61 6d 65 20 6e 61 6d 65 64 20 66 69 he same named fi
12f0: 65 6c 64 20 69 6e 20 74 68 65 20 72 75 6e 73 20 eld in the runs
1300: 74 61 62 6c 65 22 29 0a 09 09 09 28 73 79 73 74 table")....(syst
1310: 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 66 20 em (conc "rm -f
1320: 22 20 64 62 70 61 74 68 29 29 0a 09 09 09 28 65 " dbpath))....(e
1330: 78 69 74 20 31 29 29 29 29 29 0a 09 20 20 20 20 xit 1)))))..
1340: 20 20 6b 65 79 73 29 0a 20 20 20 20 28 73 71 6c keys). (sql
1350: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
1360: 22 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e "PRAGMA synchron
1370: 6f 75 73 20 3d 20 4f 46 46 3b 22 29 0a 20 20 20 ous = OFF;").
1380: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
1390: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
13a0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
13b0: 20 6b 65 79 73 20 28 69 64 20 49 4e 54 45 47 45 keys (id INTEGE
13c0: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 66 R PRIMARY KEY, f
13d0: 69 65 6c 64 6e 61 6d 65 20 54 45 58 54 2c 20 66 ieldname TEXT, f
13e0: 69 65 6c 64 74 79 70 65 20 54 45 58 54 2c 20 43 ieldtype TEXT, C
13f0: 4f 4e 53 54 52 41 49 4e 54 20 6b 65 79 63 6f 6e ONSTRAINT keycon
1400: 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 straint UNIQUE (
1410: 66 69 65 6c 64 6e 61 6d 65 29 29 3b 22 29 0a 20 fieldname));").
1420: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
1430: 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 28 73 71 mbda (key)...(sq
1440: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
1450: 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 6b 65 "INSERT INTO ke
1460: 79 73 20 28 66 69 65 6c 64 6e 61 6d 65 2c 66 69 ys (fieldname,fi
1470: 65 6c 64 74 79 70 65 29 20 56 41 4c 55 45 53 20 eldtype) VALUES
1480: 28 3f 2c 3f 29 3b 22 20 28 6b 65 79 3a 67 65 74 (?,?);" (key:get
1490: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 28 -fieldname key)(
14a0: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 74 79 70 key:get-fieldtyp
14b0: 65 20 6b 65 79 29 29 29 0a 09 20 20 20 20 20 20 e key)))..
14c0: 6b 65 79 73 29 0a 20 20 20 20 28 73 71 6c 69 74 keys). (sqlit
14d0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 28 63 e3:execute db (c
14e0: 6f 6e 63 20 0a 09 09 09 20 22 43 52 45 41 54 45 onc .... "CREATE
14f0: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 TABLE IF NOT EX
1500: 49 53 54 53 20 72 75 6e 73 20 28 69 64 20 49 4e ISTS runs (id IN
1510: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
1520: 59 2c 20 22 20 0a 09 09 09 20 66 69 65 6c 64 73 Y, " .... fields
1530: 74 72 20 28 69 66 20 68 61 76 65 6b 65 79 73 20 tr (if havekeys
1540: 22 2c 22 20 22 22 29 0a 09 09 09 20 22 72 75 6e "," "").... "run
1550: 6e 61 6d 65 20 54 45 58 54 2c 22 0a 09 09 09 20 name TEXT,"....
1560: 22 73 74 61 74 65 20 54 45 58 54 20 44 45 46 41 "state TEXT DEFA
1570: 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 73 74 ULT '',".... "st
1580: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
1590: 54 20 27 27 2c 22 0a 09 09 09 20 22 6f 77 6e 65 T '',".... "owne
15a0: 72 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 r TEXT DEFAULT '
15b0: 27 2c 22 0a 09 09 09 20 22 65 76 65 6e 74 5f 74 ',".... "event_t
15c0: 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 22 0a ime TIMESTAMP,".
15d0: 09 09 09 20 22 63 6f 6d 6d 65 6e 74 20 54 45 58 ... "comment TEX
15e0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 22 0a 09 T DEFAULT '',"..
15f0: 09 09 20 22 66 61 69 6c 5f 63 6f 75 6e 74 20 49 .. "fail_count I
1600: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 30 NTEGER DEFAULT 0
1610: 2c 22 0a 09 09 09 20 22 70 61 73 73 5f 63 6f 75 ,".... "pass_cou
1620: 6e 74 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 nt INTEGER DEFAU
1630: 4c 54 20 30 2c 22 0a 09 09 09 20 22 43 4f 4e 53 LT 0,".... "CONS
1640: 54 52 41 49 4e 54 20 72 75 6e 73 63 6f 6e 73 74 TRAINT runsconst
1650: 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 72 75 raint UNIQUE (ru
1660: 6e 6e 61 6d 65 22 20 28 69 66 20 68 61 76 65 6b nname" (if havek
1670: 65 79 73 20 22 2c 22 20 22 22 29 20 6b 65 79 73 eys "," "") keys
1680: 74 72 20 22 29 29 3b 22 29 29 0a 20 20 20 20 28 tr "));")). (
1690: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
16a0: 64 62 20 28 63 6f 6e 63 20 22 43 52 45 41 54 45 db (conc "CREATE
16b0: 20 49 4e 44 45 58 20 72 75 6e 73 5f 69 6e 64 65 INDEX runs_inde
16c0: 78 20 4f 4e 20 72 75 6e 73 20 28 72 75 6e 6e 61 x ON runs (runna
16d0: 6d 65 22 20 28 69 66 20 68 61 76 65 6b 65 79 73 me" (if havekeys
16e0: 20 22 2c 22 20 22 22 29 20 6b 65 79 73 74 72 20 "," "") keystr
16f0: 22 29 3b 22 29 29 0a 20 20 20 20 28 73 71 6c 69 ");")). (sqli
1700: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 0a te3:execute db .
1710: 09 09 20 20 20 20 20 22 43 52 45 41 54 45 20 54 .. "CREATE T
1720: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
1730: 54 53 20 74 65 73 74 73 20 0a 20 20 20 20 20 20 TS tests .
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1750: 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 d INTEGER PRIMAR
1760: 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 Y KEY,.
1770: 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 5f run_
1780: 69 64 20 20 20 20 20 49 4e 54 45 47 45 52 2c 0a id INTEGER,.
1790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17a0: 20 20 20 20 20 74 65 73 74 6e 61 6d 65 20 20 20 testname
17b0: 54 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 TEXT,.
17c0: 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 20 host
17d0: 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 TEXT DEFAU
17e0: 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 LT 'n/a',.
17f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
1800: 70 75 6c 6f 61 64 20 20 20 20 52 45 41 4c 20 44 puload REAL D
1810: 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 EFAULT -1,.
1820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1830: 64 69 73 6b 66 72 65 65 20 20 20 49 4e 54 45 47 diskfree INTEG
1840: 45 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 ER DEFAULT -1,.
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1860: 20 20 20 20 75 6e 61 6d 65 20 20 20 20 20 20 54 uname T
1870: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 EXT DEFAULT 'n/a
1880: 27 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ', .
1890: 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 20 rundir
18a0: 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 TEXT DEFAULT
18b0: 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 'n/a',.
18c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 68 6f sho
18d0: 72 74 64 69 72 20 20 20 54 45 58 54 20 44 45 46 rtdir TEXT DEF
18e0: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74 it
1900: 65 6d 5f 70 61 74 68 20 20 54 45 58 54 20 44 45 em_path TEXT DE
1910: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
1930: 74 61 74 65 20 20 20 20 20 20 54 45 58 54 20 44 tate TEXT D
1940: 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 41 52 EFAULT 'NOT_STAR
1950: 54 45 44 27 2c 0a 20 20 20 20 20 20 20 20 20 20 TED',.
1960: 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 75 statu
1970: 73 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 s TEXT DEFAU
1980: 4c 54 20 27 46 41 49 4c 27 2c 0a 20 20 20 20 20 LT 'FAIL',.
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a0: 61 74 74 65 6d 70 74 6e 75 6d 20 49 4e 54 45 47 attemptnum INTEG
19b0: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 ER DEFAULT 0,.
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d0: 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 54 45 final_logf TE
19e0: 58 54 20 44 45 46 41 55 4c 54 20 27 6c 6f 67 73 XT DEFAULT 'logs
19f0: 2f 66 69 6e 61 6c 2e 6c 6f 67 27 2c 0a 20 20 20 /final.log',.
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a10: 20 20 6c 6f 67 64 61 74 20 20 20 20 20 42 4c 4f logdat BLO
1a20: 42 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 B, .
1a30: 20 20 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 run_dur
1a40: 61 74 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 ation INTEGER DE
1a50: 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 FAULT 0,.
1a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f co
1a70: 6d 6d 65 6e 74 20 20 20 20 54 45 58 54 20 44 45 mment TEXT DE
1a80: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 65 e
1aa0: 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 vent_time TIMEST
1ab0: 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 20 AMP,.
1ac0: 20 20 20 20 20 20 20 20 20 20 66 61 69 6c 5f 63 fail_c
1ad0: 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45 46 ount INTEGER DEF
1ae0: 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 20 AULT 0,.
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 73 pas
1b00: 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 s_count INTEGER
1b10: 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 DEFAULT 0,.
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 61 72 63 68 69 76 65 64 20 20 20 49 4e 54 45 47 archived INTEG
1b40: 45 52 20 44 45 46 41 55 4c 54 20 30 2c 20 2d 2d ER DEFAULT 0, --
1b50: 20 30 3d 6e 6f 2c 20 31 3d 69 6e 20 70 72 6f 67 0=no, 1=in prog
1b60: 72 65 73 73 2c 20 32 3d 79 65 73 0a 20 20 20 20 ress, 2=yes.
1b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b80: 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 74 CONSTRAINT test
1b90: 73 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 sconstraint UNIQ
1ba0: 55 45 20 28 72 75 6e 5f 69 64 2c 20 74 65 73 74 UE (run_id, test
1bb0: 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 61 74 68 29 name, item_path)
1bc0: 0a 20 20 20 20 20 20 20 20 20 20 29 3b 22 29 0a . );").
1bd0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
1be0: 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 20 cute db "CREATE
1bf0: 49 4e 44 45 58 20 74 65 73 74 73 5f 69 6e 64 65 INDEX tests_inde
1c00: 78 20 4f 4e 20 74 65 73 74 73 20 28 72 75 6e 5f x ON tests (run_
1c10: 69 64 2c 20 74 65 73 74 6e 61 6d 65 2c 20 69 74 id, testname, it
1c20: 65 6d 5f 70 61 74 68 29 3b 22 29 0a 20 20 20 20 em_path);").
1c30: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
1c40: 20 64 62 20 22 43 52 45 41 54 45 20 56 49 45 57 db "CREATE VIEW
1c50: 20 72 75 6e 73 5f 74 65 73 74 73 20 41 53 20 53 runs_tests AS S
1c60: 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 72 75 6e ELECT * FROM run
1c70: 73 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 s INNER JOIN tes
1c80: 74 73 20 4f 4e 20 72 75 6e 73 2e 69 64 3d 74 65 ts ON runs.id=te
1c90: 73 74 73 2e 72 75 6e 5f 69 64 3b 22 29 0a 20 20 sts.run_id;").
1ca0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
1cb0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
1cc0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
1cd0: 53 20 74 65 73 74 5f 73 74 65 70 73 20 0a 20 20 S test_steps .
1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cf0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 64 20 (id
1d00: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
1d10: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 KEY,.
1d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d30: 20 20 20 20 74 65 73 74 5f 69 64 20 49 4e 54 45 test_id INTE
1d40: 47 45 52 2c 20 0a 20 20 20 20 20 20 20 20 20 20 GER, .
1d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d60: 20 20 20 20 20 73 74 65 70 6e 61 6d 65 20 54 45 stepname TE
1d70: 58 54 2c 20 0a 20 20 20 20 20 20 20 20 20 20 20 XT, .
1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d90: 20 20 20 20 73 74 61 74 65 20 54 45 58 54 20 44 state TEXT D
1da0: 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 41 52 EFAULT 'NOT_STAR
1db0: 54 45 44 27 2c 20 0a 20 20 20 20 20 20 20 20 20 TED', .
1dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dd0: 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 58 status TEX
1de0: 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c T DEFAULT 'n/a',
1df0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e10: 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 event_time TIMES
1e20: 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 TAMP,.
1e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e40: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 comment TEX
1e50: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
1e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 log
1e80: 66 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c file TEXT DEFAUL
1e90: 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 T '',.
1ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb0: 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 CONSTRAINT
1ec0: 74 65 73 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 test_steps_const
1ed0: 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 raint UNIQUE (te
1ee0: 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 st_id,stepname,s
1ef0: 74 61 74 65 29 29 3b 22 29 0a 20 20 20 20 28 73 tate));"). (s
1f00: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
1f10: 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 b "CREATE TABLE
1f20: 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 65 78 IF NOT EXISTS ex
1f30: 74 72 61 64 61 74 20 28 69 64 20 49 4e 54 45 47 tradat (id INTEG
1f40: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 ER PRIMARY KEY,
1f50: 72 75 6e 5f 69 64 20 49 4e 54 45 47 45 52 2c 20 run_id INTEGER,
1f60: 6b 65 79 20 54 45 58 54 2c 20 76 61 6c 20 54 45 key TEXT, val TE
1f70: 58 54 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 XT);"). (sqli
1f80: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
1f90: 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 CREATE TABLE IF
1fa0: 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 64 NOT EXISTS metad
1fb0: 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 at (id INTEGER P
1fc0: 52 49 4d 41 52 59 20 4b 45 59 2c 20 76 61 72 20 RIMARY KEY, var
1fd0: 54 45 58 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a TEXT, val 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 20 20 20 20 20 20
2000: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 CONSTRAINT met
2010: 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 adat_constraint
2020: 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 29 UNIQUE (var));")
2030: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 . (sqlite3:ex
2040: 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 45 ecute db "CREATE
2050: 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 TABLE IF NOT EX
2060: 49 53 54 53 20 61 63 63 65 73 73 5f 6c 6f 67 20 ISTS access_log
2070: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
2080: 41 52 59 20 4b 45 59 2c 20 75 73 65 72 20 54 45 ARY KEY, user TE
2090: 58 54 2c 20 61 63 63 65 73 73 65 64 20 54 49 4d XT, accessed TIM
20a0: 45 53 54 41 4d 50 2c 20 61 72 67 73 20 54 45 58 ESTAMP, args TEX
20b0: 54 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 T);"). (sqlit
20c0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
20d0: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
20e0: 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 6d OT EXISTS test_m
20f0: 65 74 61 20 28 69 64 20 49 4e 54 45 47 45 52 20 eta (id INTEGER
2100: 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 PRIMARY KEY,.
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2130: 20 20 74 65 73 74 6e 61 6d 65 20 20 20 20 54 45 testname TE
2140: 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 XT DEFAULT '',.
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2170: 20 20 20 20 61 75 74 68 6f 72 20 20 20 20 20 20 author
2180: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c TEXT DEFAULT '',
2190: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b0: 20 20 20 20 20 20 6f 77 6e 65 72 20 20 20 20 20 owner
21c0: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
21d0: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 64 65 73 63 72 69 70 74 descript
2200: 69 6f 6e 20 54 45 58 54 20 44 45 46 41 55 4c 54 ion TEXT DEFAULT
2210: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2230: 20 20 20 20 20 20 20 20 20 20 72 65 76 69 65 77 review
2240: 65 64 20 20 20 20 54 49 4d 45 53 54 41 4d 50 2c ed TIMESTAMP,
2250: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 69 74 65 72 61 74 65 64 20 20 iterated
2280: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
2290: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
22a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22b0: 20 20 20 20 20 20 20 20 61 76 67 5f 72 75 6e 74 avg_runt
22c0: 69 6d 65 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 ime REAL,.
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
22f0: 76 67 5f 64 69 73 6b 20 20 20 20 52 45 41 4c 2c vg_disk REAL,
2300: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2320: 20 20 20 20 20 20 74 61 67 73 20 20 20 20 20 20 tags
2330: 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 TEXT DEFAULT '
2340: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
2350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2360: 20 20 20 20 20 20 20 20 6a 6f 62 67 72 6f 75 70 jobgroup
2370: 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 TEXT DEFAULT
2380: 20 27 64 65 66 61 75 6c 74 27 2c 0a 20 20 20 20 'default',.
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
23b0: 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 TRAINT test_meta
23c0: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
23d0: 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 UE (testname));"
23e0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
23f0: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
2400: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
2410: 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 20 XISTS test_data
2420: 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d (id INTEGER PRIM
2430: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY KEY,.
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 74 65 73 74 5f 69 64 test_id
2460: 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 INTEGER,.
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2480: 20 20 20 20 20 20 20 20 20 20 63 61 74 65 67 6f catego
2490: 72 79 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 ry TEXT DEFAULT
24a0: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c0: 20 20 20 20 76 61 72 69 61 62 6c 65 20 54 45 58 variable TEX
24d0: 54 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 T,..
24e0: 20 20 20 20 20 20 20 20 20 20 20 20 76 61 6c 75 valu
24f0: 65 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 e REAL,..
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2510: 20 65 78 70 65 63 74 65 64 20 52 45 41 4c 2c 0a expected REAL,.
2520: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2530: 20 20 20 20 20 20 20 20 20 74 6f 6c 20 52 45 41 tol REA
2540: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 L,.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 75 6e 69 74 73 20 54 45 58 54 2c 0a 20 units TEXT,.
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
2590: 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 omment TEXT DEFA
25a0: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
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 73 74 61 74 75 73 20 54 status T
25d0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 EXT DEFAULT 'n/a
25e0: 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ',.
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2600: 20 20 20 74 79 70 65 20 54 45 58 54 20 44 45 46 type TEXT DEF
2610: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
2640: 54 20 74 65 73 74 5f 64 61 74 61 5f 63 6f 6e 73 T test_data_cons
2650: 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 traint UNIQUE (t
2660: 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c est_id,category,
2670: 76 61 72 69 61 62 6c 65 29 29 3b 22 29 0a 20 20 variable));").
2680: 20 20 3b 3b 20 4d 75 73 74 20 64 6f 20 74 68 69 ;; Must do thi
2690: 73 20 2a 61 66 74 65 72 2a 20 72 75 6e 6e 69 6e s *after* runnin
26a0: 67 20 70 61 74 63 68 20 64 62 20 21 21 20 4e 6f g patch db !! No
26b0: 20 6d 6f 72 65 2e 20 0a 20 20 20 20 28 64 62 3a more. . (db:
26c0: 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 set-var db "MEGA
26d0: 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 6d 65 TEST_VERSION" me
26e0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
26f0: 20 20 20 20 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ))..;;======
2700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2740: 0a 3b 3b 20 54 20 45 20 53 20 54 20 20 20 53 20 .;; T E S T S
2750: 50 20 45 20 43 20 49 20 46 20 49 20 43 20 20 20 P E C I F I C
2760: 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d D B .;;=========
2770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
27a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
27b0: 3b 20 43 72 65 61 74 65 20 74 68 65 20 73 71 6c ; Create the sql
27c0: 69 74 65 20 64 62 20 66 6f 72 20 74 68 65 20 69 ite db for the i
27d0: 6e 64 69 76 69 64 75 61 6c 20 74 65 73 74 28 73 ndividual test(s
27e0: 29 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d ).(define (open-
27f0: 74 65 73 74 2d 64 62 20 74 65 73 74 70 61 74 68 test-db testpath
2800: 29 20 0a 20 20 28 69 66 20 28 61 6e 64 20 28 64 ) . (if (and (d
2810: 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 70 61 irectory? testpa
2820: 74 68 29 0a 09 20 20 20 28 66 69 6c 65 2d 72 65 th).. (file-re
2830: 61 64 2d 61 63 63 65 73 73 3f 20 74 65 73 74 70 ad-access? testp
2840: 61 74 68 29 29 0a 20 20 20 20 20 20 28 6c 65 74 ath)). (let
2850: 2a 20 28 28 64 62 70 61 74 68 20 20 20 20 28 63 * ((dbpath (c
2860: 6f 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 74 onc testpath "/t
2870: 65 73 74 64 61 74 2e 64 62 22 29 29 0a 09 20 20 estdat.db"))..
2880: 20 20 20 28 64 62 65 78 69 73 74 73 20 20 28 66 (dbexists (f
2890: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 62 70 61 ile-exists? dbpa
28a0: 74 68 29 29 0a 09 20 20 20 20 20 28 64 62 20 20 th)).. (db
28b0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f (sqlite3:o
28c0: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 70 pen-database dbp
28d0: 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 2d ath)) ;; (never-
28e0: 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 20 give-up-open-db
28f0: 64 62 70 61 74 68 29 29 0a 09 20 20 20 20 20 28 dbpath)).. (
2900: 68 61 6e 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d handler (make-
2910: 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 28 69 66 busy-timeout (if
2920: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2930: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
2940: 74 22 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 t")......
2950: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
2960: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2970: 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 override-timeout
2980: 22 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 "))......
2990: 33 36 30 30 30 29 29 29 29 0a 09 28 64 65 62 75 36000))))..(debu
29a0: 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a g:print 4 "INFO:
29b0: 20 74 65 73 74 20 64 62 70 61 74 68 3d 22 20 64 test dbpath=" d
29c0: 62 70 61 74 68 29 0a 09 28 73 71 6c 69 74 65 33 bpath)..(sqlite3
29d0: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 :set-busy-handle
29e0: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 09 r! db handler)..
29f0: 28 69 66 20 28 6e 6f 74 20 64 62 65 78 69 73 74 (if (not dbexist
2a00: 73 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 s).. (begin..
2a10: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
2a20: 78 65 63 75 74 65 20 64 62 20 22 50 52 41 47 4d xecute db "PRAGM
2a30: 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 A synchronous =
2a40: 46 55 4c 4c 3b 22 29 0a 09 20 20 20 20 20 20 28 FULL;").. (
2a50: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 49 debug:print 0 "I
2a60: 6e 69 74 69 61 6c 69 7a 65 64 20 74 65 73 74 20 nitialized test
2a70: 64 61 74 61 62 61 73 65 20 22 20 64 62 70 61 74 database " dbpat
2a80: 68 29 0a 09 20 20 20 20 20 20 28 64 62 3a 74 65 h).. (db:te
2a90: 73 74 64 62 2d 69 6e 69 74 69 61 6c 69 7a 65 20 stdb-initialize
2aa0: 64 62 29 29 29 0a 09 3b 3b 20 28 73 71 6c 69 74 db)))..;; (sqlit
2ab0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 50 e3:execute db "P
2ac0: 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 RAGMA synchronou
2ad0: 73 20 3d 20 30 3b 22 29 0a 09 64 62 29 0a 20 20 s = 0;")..db).
2ae0: 20 20 20 20 23 66 29 29 0a 0a 3b 3b 20 66 69 6e #f))..;; fin
2af0: 64 20 61 6e 64 20 6f 70 65 6e 20 74 68 65 20 74 d and open the t
2b00: 65 73 74 64 61 74 2e 64 62 20 66 69 6c 65 20 66 estdat.db file f
2b10: 6f 72 20 61 6e 20 65 78 69 73 74 69 6e 67 20 74 or an existing t
2b20: 65 73 74 0a 28 64 65 66 69 6e 65 20 28 64 62 3a est.(define (db:
2b30: 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d open-test-db-by-
2b40: 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d test-id db test-
2b50: 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 id). (let* ((te
2b60: 73 74 2d 70 61 74 68 20 28 64 62 3a 74 65 73 74 st-path (db:test
2b70: 2d 67 65 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d -get-rundir-from
2b80: 2d 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 -test-id db test
2b90: 2d 69 64 29 29 29 0a 20 20 20 20 28 6f 70 65 6e -id))). (open
2ba0: 2d 74 65 73 74 2d 64 62 20 74 65 73 74 2d 70 61 -test-db test-pa
2bb0: 74 68 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 th)))..(define (
2bc0: 64 62 3a 74 65 73 74 64 62 2d 69 6e 69 74 69 61 db:testdb-initia
2bd0: 6c 69 7a 65 20 64 62 29 0a 20 20 28 66 6f 72 2d lize db). (for-
2be0: 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 20 each. (lambda
2bf0: 28 73 71 6c 63 6d 64 29 0a 20 20 20 20 20 28 73 (sqlcmd). (s
2c00: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
2c10: 62 20 73 71 6c 63 6d 64 29 29 0a 20 20 20 28 6c b sqlcmd)). (l
2c20: 69 73 74 20 22 43 52 45 41 54 45 20 54 41 42 4c ist "CREATE TABL
2c30: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
2c40: 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a 20 20 test_rundat (.
2c50: 20 20 20 20 20 20 20 20 20 20 20 20 69 64 20 49 id I
2c60: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
2c70: 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 EY,.
2c80: 20 20 75 70 64 61 74 65 5f 74 69 6d 65 20 54 49 update_time TI
2c90: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
2ca0: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 20 49 cpuload I
2cb0: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 2d NTEGER DEFAULT -
2cc0: 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1,.
2cd0: 20 64 69 73 6b 66 72 65 65 20 49 4e 54 45 47 45 diskfree INTEGE
2ce0: 52 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 R DEFAULT -1,.
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 73 6b disk
2d00: 75 73 61 67 65 20 49 4e 54 47 45 52 20 44 45 46 usage INTGER DEF
2d10: 41 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 AULT -1,.
2d20: 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 61 74 run_durat
2d30: 69 6f 6e 20 49 4e 54 45 47 45 52 20 44 45 46 41 ion INTEGER DEFA
2d40: 55 4c 54 20 30 29 3b 22 0a 09 20 22 43 52 45 41 ULT 0);".. "CREA
2d50: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
2d60: 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 EXISTS test_data
2d70: 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 (.
2d80: 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d id INTEGER PRIM
2d90: 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 ARY KEY,.
2da0: 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 49 test_id I
2db0: 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 20 20 20 NTEGER,.
2dc0: 20 20 20 20 20 20 63 61 74 65 67 6f 72 79 20 54 category T
2dd0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
2df0: 72 69 61 62 6c 65 20 54 45 58 54 2c 0a 09 20 20 riable TEXT,..
2e00: 20 20 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a value REAL,.
2e10: 09 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 . expected
2e20: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 74 6f 6c REAL,.. tol
2e30: 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 REAL,.
2e40: 20 20 20 20 20 75 6e 69 74 73 20 54 45 58 54 2c units TEXT,
2e50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 . c
2e60: 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 omment TEXT DEFA
2e70: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
2e80: 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 58 status TEX
2e90: 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c T DEFAULT 'n/a',
2ea0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 . t
2eb0: 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ype TEXT DEFAULT
2ec0: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
2ed0: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 CONSTRAINT te
2ee0: 73 74 5f 64 61 74 61 5f 63 6f 6e 73 74 72 61 69 st_data_constrai
2ef0: 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f nt UNIQUE (test_
2f00: 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 id,category,vari
2f10: 61 62 6c 65 29 29 3b 22 0a 09 20 22 43 52 45 41 able));".. "CREA
2f20: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
2f30: 45 58 49 53 54 53 20 74 65 73 74 5f 73 74 65 70 EXISTS test_step
2f40: 73 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 s (.
2f50: 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 id INTEGER PRI
2f60: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
2f70: 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 64 20 test_id
2f80: 49 4e 54 45 47 45 52 2c 20 0a 20 20 20 20 20 20 INTEGER, .
2f90: 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 6d 65 stepname
2fa0: 20 54 45 58 54 2c 20 0a 20 20 20 20 20 20 20 20 TEXT, .
2fb0: 20 20 20 20 20 20 73 74 61 74 65 20 54 45 58 54 state TEXT
2fc0: 20 44 45 46 41 55 4c 54 20 27 4e 4f 54 5f 53 54 DEFAULT 'NOT_ST
2fd0: 41 52 54 45 44 27 2c 20 0a 20 20 20 20 20 20 20 ARTED', .
2fe0: 20 20 20 20 20 20 20 73 74 61 74 75 73 20 54 45 status TE
2ff0: 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 XT DEFAULT 'n/a'
3000: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
3010: 65 76 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 event_time TIMES
3020: 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 20 20 20 TAMP,.
3030: 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 54 comment TEXT
3040: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
3050: 20 20 20 20 20 20 20 20 20 20 20 6c 6f 67 66 69 logfi
3060: 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 le TEXT DEFAULT
3070: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
3080: 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 CONSTRAINT tes
3090: 74 5f 73 74 65 70 73 5f 63 6f 6e 73 74 72 61 69 t_steps_constrai
30a0: 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 5f nt UNIQUE (test_
30b0: 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 id,stepname,stat
30c0: 65 29 29 3b 22 0a 09 20 3b 3b 20 74 65 73 74 5f e));".. ;; test_
30d0: 6d 65 74 61 20 63 61 6e 20 62 65 20 75 73 65 64 meta can be used
30e0: 20 66 6f 72 20 68 61 6e 64 69 6e 67 20 63 6f 6d for handing com
30f0: 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 74 65 73 mands to the tes
3100: 74 0a 09 20 3b 3b 20 65 2e 67 2e 20 4b 49 4c 4c t.. ;; e.g. KILL
3110: 52 45 51 0a 09 20 3b 3b 20 20 20 20 20 20 74 68 REQ.. ;; th
3120: 65 20 61 63 6b 73 74 61 74 65 20 69 73 20 73 65 e ackstate is se
3130: 74 20 74 6f 20 31 20 6f 6e 63 65 20 74 68 65 20 t to 1 once the
3140: 63 6f 6d 6d 61 6e 64 20 68 61 73 20 62 65 65 6e command has been
3150: 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 22 43 52 completed.. "CR
3160: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
3170: 54 20 45 58 49 53 54 53 20 74 65 73 74 5f 6d 65 T EXISTS test_me
3180: 74 61 20 28 0a 20 20 20 20 20 20 20 20 20 20 20 ta (.
3190: 20 20 20 69 64 20 49 4e 54 45 47 45 52 20 50 52 id INTEGER PR
31a0: 49 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 IMARY KEY,.
31b0: 20 20 20 20 20 20 20 20 20 76 61 72 20 54 45 58 var TEX
31c0: 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 T,.
31d0: 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 val TEXT,.
31e0: 20 20 20 20 20 20 20 20 20 61 63 6b 73 74 61 74 ackstat
31f0: 65 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c e INTEGER DEFAUL
3200: 54 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 T 0,.
3210: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 CONSTRAINT me
3220: 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 tadat_constraint
3230: 20 55 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 UNIQUE (var));"
3240: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
3250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
3290: 20 4c 20 4f 20 47 20 47 20 49 20 4e 20 47 20 20 L O G G I N G
32a0: 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d D B .;;=======
32b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
32e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
32f0: 0a 28 64 65 66 69 6e 65 20 28 6f 70 65 6e 2d 6c .(define (open-l
3300: 6f 67 67 69 6e 67 2d 64 62 29 20 3b 3b 20 20 28 ogging-db) ;; (
3310: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
3320: 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 29 20 28 /megatest.db") (
3330: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
3340: 29 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 ))). (let* ((db
3350: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 28 69 path (conc (i
3360: 66 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e f *toppath* (con
3370: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 22 29 c *toppath* "/")
3380: 20 22 22 29 20 22 6c 6f 67 67 69 6e 67 2e 64 62 "") "logging.db
3390: 22 29 29 20 3b 3b 20 66 6e 61 6d 65 29 0a 09 20 ")) ;; fname)..
33a0: 28 64 62 65 78 69 73 74 73 20 20 28 66 69 6c 65 (dbexists (file
33b0: 2d 65 78 69 73 74 73 3f 20 64 62 70 61 74 68 29 -exists? dbpath)
33c0: 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 20 28 ).. (db (
33d0: 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 74 sqlite3:open-dat
33e0: 61 62 61 73 65 20 64 62 70 61 74 68 29 29 20 3b abase dbpath)) ;
33f0: 3b 20 28 6e 65 76 65 72 2d 67 69 76 65 2d 75 70 ; (never-give-up
3400: 2d 6f 70 65 6e 2d 64 62 20 64 62 70 61 74 68 29 -open-db dbpath)
3410: 29 0a 09 20 28 68 61 6e 64 6c 65 72 20 20 20 28 ).. (handler (
3420: 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 make-busy-timeou
3430: 74 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d t (if (args:get-
3440: 61 72 67 20 22 2d 6f 76 65 72 72 69 64 65 2d 74 arg "-override-t
3450: 69 6d 65 6f 75 74 22 29 0a 09 09 09 09 09 20 20 imeout")......
3460: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
3470: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3480: 2d 6f 76 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 -override-timeou
3490: 74 22 29 29 0a 09 09 09 09 09 20 20 20 33 36 30 t"))...... 360
34a0: 30 30 29 29 29 29 20 3b 3b 20 31 33 36 30 30 30 00)))) ;; 136000
34b0: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ))). (sqlite3
34c0: 3a 73 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 :set-busy-handle
34d0: 72 21 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 r! db handler).
34e0: 20 20 20 28 69 66 20 28 6e 6f 74 20 64 62 65 78 (if (not dbex
34f0: 69 73 74 73 29 0a 09 28 62 65 67 69 6e 0a 09 20 ists)..(begin..
3500: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
3510: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
3520: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
3530: 20 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52 log (id INTEGER
3540: 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 65 76 65 PRIMARY KEY,eve
3550: 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 4d nt_time TIMESTAM
3560: 50 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 74 P DEFAULT (strft
3570: 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 29 ime('%s','now'))
3580: 2c 6c 6f 67 6c 69 6e 65 20 54 45 58 54 29 3b 22 ,logline TEXT);"
3590: 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 ).. (sqlite3:ex
35a0: 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 ecute db (conc "
35b0: 50 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f PRAGMA synchrono
35c0: 75 73 20 3d 20 30 3b 22 29 29 29 29 0a 20 20 20 us = 0;")))).
35d0: 20 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 db))..(define (
35e0: 64 62 3a 6c 6f 67 2d 65 76 65 6e 74 20 2e 20 6c db:log-event . l
35f0: 6f 67 6c 73 74 29 0a 20 20 28 6c 65 74 20 28 28 oglst). (let ((
3600: 64 62 20 20 20 20 20 20 28 6f 70 65 6e 2d 6c 6f db (open-lo
3610: 67 67 69 6e 67 2d 64 62 29 29 0a 09 28 6c 6f 67 gging-db))..(log
3620: 6c 69 6e 65 20 28 61 70 70 6c 79 20 63 6f 6e 63 line (apply conc
3630: 20 6c 6f 67 6c 73 74 29 29 29 0a 20 20 20 20 28 loglst))). (
3640: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
3650: 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 db "INSERT INTO
3660: 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 29 20 56 41 log (logline) VA
3670: 4c 55 45 53 20 28 3f 29 3b 22 20 6c 6f 67 6c 69 LUES (?);" logli
3680: 6e 65 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ne). (sqlite3
3690: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 :finalize! db).
36a0: 20 20 20 6c 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b logline))..;;
36b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
36f0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 4f 44 4f 3a 0a ======.;; TODO:.
3700: 3b 3b 20 20 20 70 75 74 20 64 65 6c 74 61 73 20 ;; put deltas
3710: 69 6e 74 6f 20 61 6e 20 61 73 73 6f 63 20 6c 69 into an assoc li
3720: 73 74 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 st with version
3730: 6e 75 6d 62 65 72 73 0a 3b 3b 20 20 20 61 70 70 numbers.;; app
3740: 6c 79 20 61 6c 6c 20 66 72 6f 6d 20 6c 61 73 74 ly all from last
3750: 20 74 6f 20 63 75 72 72 65 6e 74 0a 3b 3b 3d 3d to current.;;==
3760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
37a0: 3d 3d 3d 3d 0a 28 64 65 66 69 6e 65 20 28 70 61 ====.(define (pa
37b0: 74 63 68 2d 64 62 20 64 62 29 0a 20 20 28 68 61 tch-db db). (ha
37c0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
37d0: 20 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e exn. (begin
37e0: 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 78 . (print "Ex
37f0: 63 65 70 74 69 6f 6e 3a 20 22 20 65 78 6e 29 0a ception: " exn).
3800: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR
3810: 4f 52 3a 20 50 6f 73 73 69 62 6c 65 20 6f 75 74 OR: Possible out
3820: 20 6f 66 20 64 61 74 65 20 73 63 68 65 6d 61 2c of date schema,
3830: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 61 attempting to a
3840: 64 64 20 74 61 62 6c 65 20 6d 65 74 61 64 61 74 dd table metadat
3850: 61 2e 2e 2e 22 29 0a 20 20 20 20 20 28 73 71 6c a..."). (sql
3860: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
3870: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
3880: 20 4e 4f 54 20 45 58 49 53 54 53 20 6d 65 74 61 NOT EXISTS meta
3890: 64 61 74 20 28 69 64 20 49 4e 54 45 47 45 52 2c dat (id INTEGER,
38a0: 20 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 var TEXT, val T
38b0: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38d0: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
38e0: 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 metadat_constra
38f0: 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 int UNIQUE (var)
3900: 29 3b 22 29 0a 20 20 20 20 20 28 69 66 20 28 6e );"). (if (n
3910: 6f 74 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 ot (db:get-var d
3920: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
3930: 49 4f 4e 22 29 29 0a 09 20 28 64 62 3a 73 65 74 ION")).. (db:set
3940: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
3950: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 31 37 29 T_VERSION" 1.17)
3960: 29 29 0a 20 20 20 28 6c 65 74 20 28 28 6d 76 65 )). (let ((mve
3970: 72 20 28 64 62 3a 67 65 74 2d 76 61 72 20 64 62 r (db:get-var db
3980: 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 49 "MEGATEST_VERSI
3990: 4f 4e 22 29 29 0a 09 20 28 74 65 73 74 2d 6d 65 ON")).. (test-me
39a0: 74 61 2d 64 65 66 20 22 43 52 45 41 54 45 20 54 ta-def "CREATE T
39b0: 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 ABLE IF NOT EXIS
39c0: 54 53 20 74 65 73 74 5f 6d 65 74 61 20 28 69 64 TS test_meta (id
39d0: 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 INTEGER PRIMARY
39e0: 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 KEY,.
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a00: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 6e testn
3a10: 61 6d 65 20 20 20 20 54 45 58 54 20 44 45 46 41 ame TEXT DEFA
3a20: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 75 74 aut
3a50: 68 6f 72 20 20 20 20 20 20 54 45 58 54 20 44 45 hor TEXT DE
3a60: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
3a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6f o
3a90: 77 6e 65 72 20 20 20 20 20 20 20 54 45 58 54 20 wner TEXT
3aa0: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ad0: 20 64 65 73 63 72 69 70 74 69 6f 6e 20 54 45 58 description TEX
3ae0: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
3af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b10: 20 20 20 72 65 76 69 65 77 65 64 20 20 20 20 54 reviewed T
3b20: 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 IMESTAMP,.
3b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 i
3b50: 74 65 72 61 74 65 64 20 20 20 20 54 45 58 54 20 terated TEXT
3b60: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b90: 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 45 41 avg_runtime REA
3ba0: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 L,.
3bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bc0: 20 20 20 20 20 20 20 20 61 76 67 5f 64 69 73 6b avg_disk
3bd0: 20 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 REAL,.
3be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
3c00: 61 67 73 20 20 20 20 20 20 20 20 54 45 58 54 20 ags TEXT
3c10: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
3c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3c30: 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e 53 CONS
3c40: 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 61 TRAINT test_meta
3c50: 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 _constraint UNIQ
3c60: 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b 22 UE (testname));"
3c70: 29 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 22 )). (print "
3c80: 43 75 72 72 65 6e 74 20 73 63 68 65 6d 61 20 76 Current schema v
3c90: 65 72 73 69 6f 6e 3a 20 22 20 6d 76 65 72 20 22 ersion: " mver "
3ca0: 20 63 75 72 72 65 6e 74 20 6d 65 67 61 74 65 73 current megates
3cb0: 74 20 76 65 72 73 69 6f 6e 3a 20 22 20 6d 65 67 t version: " meg
3cc0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 atest-version).
3cd0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
3ce0: 28 28 6e 6f 74 20 6d 76 65 72 29 0a 20 20 20 20 ((not mver).
3cf0: 20 20 20 28 70 72 69 6e 74 20 22 41 64 64 69 6e (print "Addin
3d00: 67 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 g megatest-versi
3d10: 6f 6e 20 74 6f 20 6d 65 74 61 64 61 74 61 22 29 on to metadata")
3d20: 20 3b 3b 20 4e 65 65 64 20 74 6f 20 72 65 63 72 ;; Need to recr
3d30: 65 61 74 65 20 74 68 65 20 74 61 62 6c 65 0a 20 eate the table.
3d40: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
3d50: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
3d60: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
3d70: 6d 65 74 61 64 61 74 3b 22 29 0a 20 20 20 20 20 metadat;").
3d80: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3d90: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
3da0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
3db0: 53 20 6d 65 74 61 64 61 74 20 28 69 64 20 49 4e S metadat (id IN
3dc0: 54 45 47 45 52 2c 20 76 61 72 20 54 45 58 54 2c TEGER, var TEXT,
3dd0: 20 76 61 6c 20 54 45 58 54 2c 0a 20 20 20 20 20 val TEXT,.
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
3e00: 53 54 52 41 49 4e 54 20 6d 65 74 61 64 61 74 5f STRAINT metadat_
3e10: 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 constraint UNIQU
3e20: 45 20 28 76 61 72 29 29 3b 22 29 0a 20 20 20 20 E (var));").
3e30: 20 20 20 28 64 62 3a 73 65 74 2d 76 61 72 20 64 (db:set-var d
3e40: 62 20 22 4d 45 47 41 54 45 53 54 5f 56 45 52 53 b "MEGATEST_VERS
3e50: 49 4f 4e 22 20 31 2e 31 37 29 0a 20 20 20 20 20 ION" 1.17).
3e60: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
3e70: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
3e80: 31 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 1). (sqlit
3e90: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 e3:execute db "D
3ea0: 52 4f 50 20 54 41 42 4c 45 20 49 46 20 45 58 49 ROP TABLE IF EXI
3eb0: 53 54 53 20 6d 65 74 61 64 61 74 3b 22 29 0a 20 STS metadat;").
3ec0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
3ed0: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
3ee0: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
3ef0: 58 49 53 54 53 20 6d 65 74 61 64 61 74 20 28 69 XISTS metadat (i
3f00: 64 20 49 4e 54 45 47 45 52 2c 20 76 61 72 20 54 d INTEGER, var T
3f10: 45 58 54 2c 20 76 61 6c 20 54 45 58 54 2c 0a 20 EXT, val TEXT,.
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 43 4f 4e 53 54 52 41 49 4e 54 20 6d 65 74 61 CONSTRAINT meta
3f50: 64 61 74 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 dat_constraint U
3f60: 4e 49 51 55 45 20 28 76 61 72 29 29 3b 22 29 0a NIQUE (var));").
3f70: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
3f80: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
3f90: 56 45 52 53 49 4f 4e 22 20 31 2e 32 31 29 20 3b VERSION" 1.21) ;
3fa0: 3b 20 73 65 74 20 62 65 66 6f 72 65 2c 20 6a 75 ; set before, ju
3fb0: 73 74 20 69 6e 20 63 61 73 65 20 74 68 65 20 63 st in case the c
3fc0: 68 61 6e 67 65 73 20 61 72 65 20 61 6c 72 65 61 hanges are alrea
3fd0: 64 79 20 61 70 70 6c 69 65 64 0a 20 20 20 20 20 dy applied.
3fe0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
3ff0: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
4000: 64 65 66 29 0a 09 09 09 09 09 3b 28 66 6f 72 2d def)......;(for-
4010: 65 61 63 68 20 0a 09 09 09 09 09 3b 20 28 6c 61 each ......; (la
4020: 6d 62 64 61 20 28 73 74 6d 74 29 0a 09 09 09 09 mbda (stmt).....
4030: 09 3b 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 .; (sqlite3:ex
4040: 65 63 75 74 65 20 64 62 20 73 74 6d 74 29 29 0a ecute db stmt)).
4050: 09 09 09 09 09 3b 20 28 6c 69 73 74 20 0a 09 09 .....; (list ...
4060: 09 09 09 3b 20 20 22 41 4c 54 45 52 20 54 41 42 ...; "ALTER TAB
4070: 4c 45 20 74 65 73 74 73 20 41 44 44 20 43 4f 4c LE tests ADD COL
4080: 55 4d 4e 20 66 69 72 73 74 5f 65 72 72 20 54 45 UMN first_err TE
4090: 58 54 3b 22 0a 09 09 09 09 09 3b 20 20 22 41 4c XT;"......; "AL
40a0: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 73 20 TER TABLE tests
40b0: 41 44 44 20 43 4f 4c 55 4d 4e 20 66 69 72 73 74 ADD COLUMN first
40c0: 5f 77 61 72 6e 20 54 45 58 54 3b 22 0a 09 09 09 _warn TEXT;"....
40d0: 09 09 3b 20 20 29 29 0a 20 20 20 20 20 20 20 28 ..; )). (
40e0: 70 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 patch-db)).
40f0: 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 34 29 0a ((< mver 1.24).
4100: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
4110: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
4120: 56 45 52 53 49 4f 4e 22 20 31 2e 32 34 29 0a 20 VERSION" 1.24).
4130: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
4140: 78 65 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 xecute db "DROP
4150: 54 41 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 TABLE IF EXISTS
4160: 74 65 73 74 5f 64 61 74 61 3b 22 29 0a 20 20 20 test_data;").
4170: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
4180: 63 75 74 65 20 64 62 20 22 44 52 4f 50 20 54 41 cute db "DROP TA
4190: 42 4c 45 20 49 46 20 45 58 49 53 54 53 20 74 65 BLE IF EXISTS te
41a0: 73 74 5f 6d 65 74 61 3b 22 29 0a 20 20 20 20 20 st_meta;").
41b0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
41c0: 74 65 20 64 62 20 74 65 73 74 2d 6d 65 74 61 2d te db test-meta-
41d0: 64 65 66 29 0a 20 20 20 20 20 20 20 28 73 71 6c def). (sql
41e0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
41f0: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
4200: 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 NOT EXISTS test
4210: 5f 64 61 74 61 20 28 69 64 20 49 4e 54 45 47 45 _data (id INTEGE
4220: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
4250: 65 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 0a est_id INTEGER,.
4260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4280: 63 61 74 65 67 6f 72 79 20 54 45 58 54 20 44 45 category TEXT DE
4290: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42b0: 20 20 20 20 20 20 20 20 20 20 76 61 72 69 61 62 variab
42c0: 6c 65 20 54 45 58 54 2c 0a 09 20 20 20 20 20 20 le TEXT,..
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 76 61 6c 75 65 20 52 45 41 4c 2c 0a 09 20 value REAL,..
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4300: 20 20 20 20 20 20 20 65 78 70 65 63 74 65 64 20 expected
4310: 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 20 20 20 REAL,..
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
4330: 6f 6c 20 52 45 41 4c 2c 0a 20 20 20 20 20 20 20 ol REAL,.
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 75 6e 69 74 73 20 54 units T
4360: 45 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EXT,.
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 20 20 20 20 63 6f 6d 6d 65 6e 74 20 54 45 58 comment TEX
4390: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
43c0: 61 74 75 73 20 54 45 58 54 20 44 45 46 41 55 4c atus TEXT DEFAUL
43d0: 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 T 'n/a',.
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
4400: 54 20 74 65 73 74 5f 64 61 74 61 20 55 4e 49 51 T test_data UNIQ
4410: 55 45 20 28 74 65 73 74 5f 69 64 2c 63 61 74 65 UE (test_id,cate
4420: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 29 29 3b gory,variable));
4430: 22 29 0a 20 20 20 20 20 20 20 28 70 72 69 6e 74 "). (print
4440: 20 22 57 41 52 4e 49 4e 47 3a 20 54 61 62 6c 65 "WARNING: Table
4450: 20 74 65 73 74 5f 64 61 74 61 20 61 6e 64 20 74 test_data and t
4460: 65 73 74 5f 6d 65 74 61 20 77 65 72 65 20 72 65 est_meta were re
4470: 63 72 65 61 74 65 64 2e 20 50 6c 65 61 73 65 20 created. Please
4480: 64 6f 20 6d 65 67 61 74 65 73 74 20 2d 75 70 64 do megatest -upd
4490: 61 74 65 2d 6d 65 74 61 22 29 0a 20 20 20 20 20 ate-meta").
44a0: 20 20 28 70 61 74 63 68 2d 64 62 29 29 0a 20 20 (patch-db)).
44b0: 20 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 32 ((< mver 1.2
44c0: 37 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 7). (db:se
44d0: 74 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 t-var db "MEGATE
44e0: 53 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 32 37 ST_VERSION" 1.27
44f0: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
4500: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 3:execute db "AL
4510: 54 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 64 TER TABLE test_d
4520: 61 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 74 ata ADD COLUMN t
4530: 79 70 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ype TEXT DEFAULT
4540: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 70 '';"). (p
4550: 61 74 63 68 2d 64 62 29 29 0a 20 20 20 20 20 20 atch-db)).
4560: 28 28 3c 20 6d 76 65 72 20 31 2e 32 39 29 0a 20 ((< mver 1.29).
4570: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 61 (db:set-va
4580: 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f 56 r db "MEGATEST_V
4590: 45 52 53 49 4f 4e 22 20 31 2e 32 39 29 0a 20 20 ERSION" 1.29).
45a0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
45b0: 65 63 75 74 65 20 64 62 20 22 41 4c 54 45 52 20 ecute db "ALTER
45c0: 54 41 42 4c 45 20 74 65 73 74 5f 73 74 65 70 73 TABLE test_steps
45d0: 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6c 6f 67 66 ADD COLUMN logf
45e0: 69 6c 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ile TEXT DEFAULT
45f0: 20 27 27 3b 22 29 0a 20 20 20 20 20 20 20 28 73 '';"). (s
4600: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
4610: 62 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 b "ALTER TABLE t
4620: 65 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 ests ADD COLUMN
4630: 73 68 6f 72 74 64 69 72 20 54 45 58 54 20 44 45 shortdir TEXT DE
4640: 46 41 55 4c 54 20 27 27 3b 22 29 29 0a 20 20 20 FAULT '';")).
4650: 20 20 20 28 28 3c 20 6d 76 65 72 20 31 2e 33 36 ((< mver 1.36
4660: 29 0a 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 ). (db:set
4670: 2d 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 -var db "MEGATES
4680: 54 5f 56 45 52 53 49 4f 4e 22 20 31 2e 33 36 29 T_VERSION" 1.36)
4690: 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 . (sqlite3
46a0: 3a 65 78 65 63 75 74 65 20 64 62 20 22 41 4c 54 :execute db "ALT
46b0: 45 52 20 54 41 42 4c 45 20 74 65 73 74 5f 6d 65 ER TABLE test_me
46c0: 74 61 20 41 44 44 20 43 4f 4c 55 4d 4e 20 6a 6f ta ADD COLUMN jo
46d0: 62 67 72 6f 75 70 20 54 45 58 54 20 44 45 46 41 bgroup TEXT DEFA
46e0: 55 4c 54 20 27 64 65 66 61 75 6c 74 27 3b 22 29 ULT 'default';")
46f0: 29 0a 20 20 20 20 20 20 28 28 3c 20 6d 76 65 72 ). ((< mver
4700: 20 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 64 1.37). (d
4710: 62 3a 73 65 74 2d 76 61 72 20 64 62 20 22 4d 45 b:set-var db "ME
4720: 47 41 54 45 53 54 5f 56 45 52 53 49 4f 4e 22 20 GATEST_VERSION"
4730: 31 2e 33 37 29 0a 20 20 20 20 20 20 20 28 73 71 1.37). (sq
4740: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4750: 20 22 41 4c 54 45 52 20 54 41 42 4c 45 20 74 65 "ALTER TABLE te
4760: 73 74 73 20 41 44 44 20 43 4f 4c 55 4d 4e 20 61 sts ADD COLUMN a
4770: 72 63 68 69 76 65 64 20 49 4e 54 45 47 45 52 20 rchived INTEGER
4780: 44 45 46 41 55 4c 54 20 30 3b 22 29 29 20 0a 20 DEFAULT 0;")) .
4790: 20 20 20 20 20 28 28 3c 20 6d 76 65 72 20 6d 65 ((< mver me
47a0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 0a gatest-version).
47b0: 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 76 (db:set-v
47c0: 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 5f ar db "MEGATEST_
47d0: 56 45 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 73 VERSION" megates
47e0: 74 2d 76 65 72 73 69 6f 6e 29 29 29 29 29 29 0a t-version)))))).
47f0: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
4800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 6d 65 74 =========.;; met
4840: 61 20 67 65 74 20 61 6e 64 20 73 65 74 20 76 61 a get and set va
4850: 72 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d rs.;;===========
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
48a0: 72 65 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 returns number i
48b0: 66 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 f string->number
48c0: 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 is successful,
48d0: 73 74 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 string otherwise
48e0: 0a 3b 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 .;; also updates
48f0: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a *global-delta*.
4900: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
4910: 76 61 72 20 64 62 20 76 61 72 29 0a 20 20 28 6c var db var). (l
4920: 65 74 2a 20 28 28 73 74 61 72 74 2d 6d 73 20 28 et* ((start-ms (
4930: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
4940: 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 onds)).
4950: 28 74 68 72 6f 74 74 6c 65 20 28 6c 65 74 20 28 (throttle (let (
4960: 28 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b (t (config-look
4970: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
4980: 73 65 74 75 70 22 20 22 74 68 72 6f 74 74 6c 65 setup" "throttle
4990: 22 29 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 ")))... (if
49a0: 74 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 t (string->numbe
49b0: 72 20 74 29 20 74 29 29 29 0a 09 20 28 72 65 73 r t) t))).. (res
49c0: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 #f)). (
49d0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
49e0: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
49f0: 61 20 28 76 61 6c 29 0a 20 20 20 20 20 20 20 28 a (val). (
4a00: 73 65 74 21 20 72 65 73 20 76 61 6c 29 29 0a 20 set! res val)).
4a10: 20 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 76 db "SELECT v
4a20: 61 6c 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 al FROM metadat
4a30: 57 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 WHERE var=?;" va
4a40: 72 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 r). ;; conver
4a50: 74 20 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 t to number if c
4a60: 61 6e 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 an. (if (stri
4a70: 6e 67 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 ng? res)..(let (
4a80: 28 76 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d (valnum (string-
4a90: 3e 6e 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 >number res)))..
4aa0: 20 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 (if valnum (se
4ab0: 74 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 t! res valnum)))
4ac0: 29 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 ). ;; scale b
4ad0: 79 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 y 10, average wi
4ae0: 74 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 th current value
4af0: 2e 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f .. (set! *glo
4b00: 62 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b bal-delta* (/ (+
4b10: 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 *global-delta*
4b20: 28 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d (* (- (current-m
4b30: 69 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 illiseconds) sta
4b40: 72 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 rt-ms)....... (i
4b50: 66 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 f throttle throt
4b60: 74 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 tle 0.01)))....
4b70: 20 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 2)). (if (
4b80: 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d > (abs (- *last-
4b90: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 global-delta-pri
4ba0: 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 nted* *global-de
4bb0: 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 lta*)) 0.08) ;;
4bc0: 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 don't print all
4bd0: 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 the time, only i
4be0: 66 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 f it changes a b
4bf0: 69 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 it..(begin.. (d
4c00: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e ebug:print 4 "IN
4c10: 46 4f 3a 20 6c 61 75 6e 63 68 20 74 68 72 6f 74 FO: launch throt
4c20: 74 6c 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c tle factor=" *gl
4c30: 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 obal-delta*)..
4c40: 28 73 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 (set! *last-glob
4c50: 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 al-delta-printed
4c60: 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a * *global-delta*
4c70: 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 ))). res))..(
4c80: 64 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 76 define (db:set-v
4c90: 61 72 20 64 62 20 76 61 72 20 76 61 6c 29 0a 20 ar db var val).
4ca0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4cb0: 65 20 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 e db "INSERT OR
4cc0: 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 6d 65 74 REPLACE INTO met
4cd0: 61 64 61 74 20 28 76 61 72 2c 76 61 6c 29 20 56 adat (var,val) V
4ce0: 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 20 76 61 ALUES (?,?);" va
4cf0: 72 20 76 61 6c 29 29 0a 0a 3b 3b 20 75 73 65 20 r val))..;; use
4d00: 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 73 6f 6d a global for som
4d10: 65 20 70 72 69 6d 69 74 69 76 65 20 63 61 63 68 e primitive cach
4d20: 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 73 74 20 ing, it is just
4d30: 73 69 6c 6c 79 20 74 6f 20 72 65 2d 72 65 61 64 silly to re-read
4d40: 20 74 68 65 20 64 62 20 0a 3b 3b 20 6f 76 65 72 the db .;; over
4d50: 20 61 6e 64 20 6f 76 65 72 20 61 67 61 69 6e 20 and over again
4d60: 66 6f 72 20 74 68 65 20 6b 65 79 73 20 73 69 6e for the keys sin
4d70: 63 65 20 74 68 65 79 20 6e 65 76 65 72 20 63 68 ce they never ch
4d80: 61 6e 67 65 0a 0a 28 64 65 66 69 6e 65 20 28 64 ange..(define (d
4d90: 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 0a 20 b:get-keys db).
4da0: 20 28 69 66 20 2a 64 62 2d 6b 65 79 73 2a 20 2a (if *db-keys* *
4db0: 64 62 2d 6b 65 79 73 2a 20 0a 20 20 20 20 20 20 db-keys* .
4dc0: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
4dd0: 0a 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 ..(sqlite3:for-e
4de0: 61 63 68 2d 72 6f 77 20 0a 09 20 28 6c 61 6d 62 ach-row .. (lamb
4df0: 64 61 20 28 6b 65 79 20 6b 65 79 74 79 70 65 29 da (key keytype)
4e00: 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 .. (set! res (
4e10: 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 6b 65 79 cons (vector key
4e20: 20 6b 65 79 74 79 70 65 29 20 72 65 73 29 29 29 keytype) res)))
4e30: 0a 09 20 64 62 0a 09 20 22 53 45 4c 45 43 54 20 .. db.. "SELECT
4e40: 66 69 65 6c 64 6e 61 6d 65 2c 66 69 65 6c 64 74 fieldname,fieldt
4e50: 79 70 65 20 46 52 4f 4d 20 6b 65 79 73 20 4f 52 ype FROM keys OR
4e60: 44 45 52 20 42 59 20 69 64 20 44 45 53 43 3b 22 DER BY id DESC;"
4e70: 29 0a 09 28 73 65 74 21 20 2a 64 62 2d 6b 65 79 )..(set! *db-key
4e80: 73 2a 20 72 65 73 29 0a 09 72 65 73 29 29 29 0a s* res)..res))).
4e90: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
4ea0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
4eb0: 20 72 6f 77 20 68 65 61 64 65 72 20 66 69 65 6c row header fiel
4ec0: 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e d). (debug:prin
4ed0: 74 20 34 20 22 49 4e 46 4f 3a 20 64 62 3a 67 65 t 4 "INFO: db:ge
4ee0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
4ef0: 72 20 72 6f 77 3a 20 22 20 72 6f 77 20 22 20 68 r row: " row " h
4f00: 65 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 20 eader: " header
4f10: 22 20 66 69 65 6c 64 3a 20 22 20 66 69 65 6c 64 " field: " field
4f20: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 68 ). (if (null? h
4f30: 65 61 64 65 72 29 20 23 66 0a 20 20 20 20 20 20 eader) #f.
4f40: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
4f50: 28 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 09 (car header))...
4f60: 20 28 74 61 6c 20 28 63 64 72 20 68 65 61 64 65 (tal (cdr heade
4f70: 72 29 29 0a 09 09 20 28 6e 20 20 20 30 29 29 0a r))... (n 0)).
4f80: 09 28 69 66 20 28 65 71 75 61 6c 3f 20 68 65 64 .(if (equal? hed
4f90: 20 66 69 65 6c 64 29 0a 09 20 20 20 20 28 76 65 field).. (ve
4fa0: 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 6e 29 0a ctor-ref row n).
4fb0: 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
4fc0: 74 61 6c 29 20 23 66 20 28 6c 6f 6f 70 20 28 63 tal) #f (loop (c
4fd0: 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 ar tal)(cdr tal)
4fe0: 28 2b 20 6e 20 31 29 29 29 29 29 29 29 0a 0a 3b (+ n 1)))))))..;
4ff0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5000: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5030: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 20 =======.;; R U
5040: 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d N S.;;==========
5050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
5090: 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 2d efine (runs:get-
50a0: 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 73 20 6b std-run-fields k
50b0: 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29 0a 20 eys remfields).
50c0: 20 28 6c 65 74 2a 20 28 28 68 65 61 64 65 72 20 (let* ((header
50d0: 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 70 20 (append (map
50e0: 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d key:get-fieldnam
50f0: 65 20 6b 65 79 73 29 0a 09 09 09 20 20 20 20 72 e keys).... r
5100: 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28 6b 65 emfields)).. (ke
5110: 79 73 74 72 20 20 20 20 28 63 6f 6e 63 20 28 6b ystr (conc (k
5120: 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 eys->keystr keys
5130: 29 20 22 2c 22 0a 09 09 09 20 20 28 73 74 72 69 ) ",".... (stri
5140: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 72 ng-intersperse r
5150: 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 29 29 29 emfields ","))))
5160: 0a 20 20 20 20 28 6c 69 73 74 20 6b 65 79 73 74 . (list keyst
5170: 72 20 68 65 61 64 65 72 29 29 29 0a 0a 3b 3b 20 r header)))..;;
5180: 6d 61 6b 65 20 61 20 71 75 65 72 79 20 28 66 69 make a query (fi
5190: 65 6c 64 6e 61 6d 65 20 6c 69 6b 65 20 27 70 61 eldname like 'pa
51a0: 74 74 31 27 20 4f 52 20 66 69 65 6c 64 6e 61 6d tt1' OR fieldnam
51b0: 65 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 70 e .(define (db:p
51c0: 61 74 74 2d 3e 6c 69 6b 65 20 66 69 65 6c 64 6e att->like fieldn
51d0: 61 6d 65 20 70 61 74 74 73 74 72 20 23 21 6b 65 ame pattstr #!ke
51e0: 79 20 28 63 6f 6d 70 61 72 61 74 6f 72 20 22 20 y (comparator "
51f0: 4f 52 20 22 29 29 0a 20 20 28 6c 65 74 20 28 28 OR ")). (let ((
5200: 70 61 74 74 73 20 28 69 66 20 28 73 74 72 69 6e patts (if (strin
5210: 67 3f 20 70 61 74 74 73 74 72 29 0a 09 09 20 20 g? pattstr)...
5220: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 (string-split p
5230: 61 74 74 73 74 72 20 22 2c 22 29 0a 09 09 20 20 attstr ",")...
5240: 20 27 28 22 25 22 29 29 29 29 0a 20 20 20 20 28 '("%")))). (
5250: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5260: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
5270: 28 70 61 74 74 29 0a 09 09 09 20 20 20 20 20 20 (patt)....
5280: 20 28 6c 65 74 20 28 28 77 69 6c 64 74 79 70 65 (let ((wildtype
5290: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
52a0: 69 6e 64 65 78 20 22 25 22 20 70 61 74 74 29 20 index "%" patt)
52b0: 22 4c 49 4b 45 22 20 22 47 4c 4f 42 22 29 29 29 "LIKE" "GLOB")))
52c0: 0a 09 09 09 09 20 28 63 6f 6e 63 20 66 69 65 6c ..... (conc fiel
52d0: 64 6e 61 6d 65 20 22 20 22 20 77 69 6c 64 74 79 dname " " wildty
52e0: 70 65 20 22 20 27 22 20 70 61 74 74 20 22 27 22 pe " '" patt "'"
52f0: 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 ))).... (if
5300: 28 6e 75 6c 6c 3f 20 70 61 74 74 73 29 0a 09 09 (null? patts)...
5310: 09 09 20 27 28 22 22 29 0a 09 09 09 09 20 70 61 .. '("")..... pa
5320: 74 74 73 29 29 0a 09 09 09 63 6f 6d 70 61 72 61 tts))....compara
5330: 74 6f 72 29 29 29 0a 0a 3b 3b 20 72 65 70 6c 61 tor)))..;; repla
5340: 63 65 20 68 65 61 64 65 72 20 61 6e 64 20 6b 65 ce header and ke
5350: 79 73 74 72 20 77 69 74 68 20 61 20 63 61 6c 6c ystr with a call
5360: 20 74 6f 20 72 75 6e 73 3a 67 65 74 2d 73 74 64 to runs:get-std
5370: 2d 72 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b 0a 3b -run-fields.;;.;
5380: 3b 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b ; keypatts: ( (K
5390: 45 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b EY1 "abc%def")(K
53a0: 45 59 32 20 22 25 22 29 20 29 0a 3b 3b 20 72 75 EY2 "%") ).;; ru
53b0: 6e 70 61 74 74 73 3a 20 70 61 74 74 31 2c 70 61 npatts: patt1,pa
53c0: 74 74 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 tt2 ....;;.(defi
53d0: 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 ne (db:get-runs
53e0: 64 62 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 db runpatt count
53f0: 20 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 offset keypatts
5400: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 ). (let* ((res
5410: 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 6b 65 '()).. (ke
5420: 79 73 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 ys (db:get
5430: 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 72 75 -keys db)).. (ru
5440: 6e 70 61 74 74 73 74 72 20 28 64 62 3a 70 61 74 npattstr (db:pat
5450: 74 2d 3e 6c 69 6b 65 20 22 72 75 6e 6e 61 6d 65 t->like "runname
5460: 22 20 72 75 6e 70 61 74 74 29 29 0a 09 20 28 72 " runpatt)).. (r
5470: 65 6d 66 69 65 6c 64 73 20 20 28 6c 69 73 74 20 emfields (list
5480: 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 "id" "runname" "
5490: 73 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 state" "status"
54a0: 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 "owner" "event_t
54b0: 69 6d 65 22 29 29 0a 09 20 28 68 65 61 64 65 72 ime")).. (header
54c0: 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 (append (ma
54d0: 70 20 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e p key:get-fieldn
54e0: 61 6d 65 20 6b 65 79 73 29 0a 09 09 20 20 20 20 ame keys)...
54f0: 20 20 20 20 20 20 20 20 20 72 65 6d 66 69 65 6c remfiel
5500: 64 73 29 29 0a 09 20 28 6b 65 79 73 74 72 20 20 ds)).. (keystr
5510: 20 20 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e (conc (keys->
5520: 6b 65 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 keystr keys) ","
5530: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 28 73 ... (s
5540: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
5550: 65 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 29 e remfields ",")
5560: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 )).. (qrystr
5570: 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 (conc "SELECT "
5580: 20 6b 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 keystr " FROM r
5590: 75 6e 73 20 57 48 45 52 45 20 28 22 20 72 75 6e uns WHERE (" run
55a0: 70 61 74 74 73 74 72 20 22 29 20 22 20 3b 3b 20 pattstr ") " ;;
55b0: 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 22 runname LIKE ? "
55c0: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 3b 3b ... ;;
55d0: 20 47 65 6e 65 72 61 74 65 3a 20 22 20 41 4e 44 Generate: " AND
55e0: 20 78 20 4c 49 4b 45 20 27 6b 65 79 70 61 74 74 x LIKE 'keypatt
55f0: 27 20 2e 2e 2e 22 0a 09 09 20 20 20 20 20 20 20 ' ..."...
5600: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6b (if (null? k
5610: 65 79 70 61 74 74 73 29 20 22 22 0a 09 09 20 20 eypatts) ""...
5620: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5630: 6e 63 20 22 20 41 4e 44 20 22 0a 09 09 09 09 20 nc " AND ".....
5640: 20 20 20 20 28 73 74 72 69 6e 67 2d 6a 6f 69 6e (string-join
5650: 20 0a 09 09 09 09 20 20 20 20 20 20 28 6d 61 70 ..... (map
5660: 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 70 61 74 (lambda (keypat
5670: 74 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 t)...... (le
5680: 74 20 28 28 6b 65 79 20 20 28 63 61 72 20 6b 65 t ((key (car ke
5690: 79 70 61 74 74 29 29 0a 09 09 09 09 09 09 20 20 ypatt)).......
56a0: 20 28 70 61 74 74 20 28 63 61 64 72 20 6b 65 79 (patt (cadr key
56b0: 70 61 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 patt)))......
56c0: 20 20 20 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 (db:patt->li
56d0: 6b 65 20 6b 65 79 20 70 61 74 74 29 29 29 0a 09 ke key patt)))..
56e0: 09 09 09 09 20 20 20 6b 65 79 70 61 74 74 73 29 .... keypatts)
56f0: 0a 09 09 09 09 20 20 20 20 20 20 22 20 41 4e 44 ..... " AND
5700: 20 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 ")))...
5710: 20 20 20 22 20 4f 52 44 45 52 20 42 59 20 65 76 " ORDER BY ev
5720: 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a ent_time DESC ".
5730: 09 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66 .. (if
5740: 20 28 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 (number? count)
5750: 0a 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 ...
5760: 20 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 (conc " LIMIT
5770: 22 20 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 " count)...
5780: 20 20 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 "")...
5790: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
57a0: 6e 75 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a number? offset).
57b0: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
57c0: 20 28 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 (conc " OFFSET
57d0: 22 20 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 " offset)...
57e0: 20 20 20 20 20 20 20 20 20 20 20 22 22 29 29 29 "")))
57f0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
5800: 6e 74 20 38 20 22 49 4e 46 4f 3a 20 64 62 3a 67 nt 8 "INFO: db:g
5810: 65 74 2d 72 75 6e 73 20 71 72 79 73 74 72 3a 20 et-runs qrystr:
5820: 22 20 71 72 79 73 74 72 20 22 5c 6e 6b 65 79 70 " qrystr "\nkeyp
5830: 61 74 74 73 3a 20 22 20 6b 65 79 70 61 74 74 73 atts: " keypatts
5840: 20 22 5c 6e 20 20 6f 66 66 73 65 74 3a 20 22 20 "\n offset: "
5850: 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 3a 20 offset " limit:
5860: 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 73 71 " count). (sq
5870: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
5880: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
5890: 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 20 28 (a . x). (
58a0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 set! res (cons (
58b0: 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 78 apply vector a x
58c0: 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 ) res))). db
58d0: 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 20 20 . qrystr.
58e0: 20 20 29 0a 20 20 20 20 28 76 65 63 74 6f 72 20 ). (vector
58f0: 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 0a 3b header res)))..;
5900: 3b 20 6a 75 73 74 20 67 65 74 20 63 6f 75 6e 74 ; just get count
5910: 20 6f 66 20 72 75 6e 73 0a 28 64 65 66 69 6e 65 of runs.(define
5920: 20 28 64 62 3a 67 65 74 2d 6e 75 6d 2d 72 75 6e (db:get-num-run
5930: 73 20 64 62 20 72 75 6e 70 61 74 74 29 0a 20 20 s db runpatt).
5940: 28 6c 65 74 20 28 28 6e 75 6d 72 75 6e 73 20 30 (let ((numruns 0
5950: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
5960: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 for-each-row .
5970: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e (lambda (coun
5980: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
5990: 6e 75 6d 72 75 6e 73 20 63 6f 75 6e 74 29 29 0a numruns count)).
59a0: 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 db. "SE
59b0: 4c 45 43 54 20 43 4f 55 4e 54 28 69 64 29 20 46 LECT COUNT(id) F
59c0: 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 72 ROM runs WHERE r
59d0: 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 3b 22 20 unname LIKE ?;"
59e0: 72 75 6e 70 61 74 74 29 0a 20 20 20 20 6e 75 6d runpatt). num
59f0: 72 75 6e 73 29 29 0a 0a 3b 3b 20 75 73 65 20 28 runs))..;; use (
5a00: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
5a10: 64 65 72 20 28 64 62 3a 67 65 74 2d 68 65 61 64 der (db:get-head
5a20: 65 72 20 72 75 6e 69 6e 66 6f 29 28 64 62 3a 67 er runinfo)(db:g
5a30: 65 74 2d 72 6f 77 20 72 75 6e 69 6e 66 6f 29 29 et-row runinfo))
5a40: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
5a50: 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e -run-info db run
5a60: 2d 69 64 29 0a 20 20 28 69 66 20 28 68 61 73 68 -id). (if (hash
5a70: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5a80: 6c 74 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 lt *run-info-cac
5a90: 68 65 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 he* run-id #f).
5aa0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
5ab0: 2d 72 65 66 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 -ref *run-info-c
5ac0: 61 63 68 65 2a 20 72 75 6e 2d 69 64 29 0a 20 20 ache* run-id).
5ad0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 (let* ((res
5ae0: 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 28 #f).. (
5af0: 6b 65 79 73 20 20 20 20 20 20 28 64 62 3a 67 65 keys (db:ge
5b00: 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 20 20 t-keys db))..
5b10: 20 20 28 72 65 6d 66 69 65 6c 64 73 20 28 6c 69 (remfields (li
5b20: 73 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 st "id" "runname
5b30: 22 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 " "state" "statu
5b40: 73 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e s" "owner" "even
5b50: 74 5f 74 69 6d 65 22 29 29 0a 09 20 20 20 20 20 t_time"))..
5b60: 28 68 65 61 64 65 72 20 20 20 20 28 61 70 70 65 (header (appe
5b70: 6e 64 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d nd (map key:get-
5b80: 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 0a fieldname keys).
5b90: 09 09 09 09 72 65 6d 66 69 65 6c 64 73 29 29 0a ....remfields)).
5ba0: 09 20 20 20 20 20 28 6b 65 79 73 74 72 20 20 20 . (keystr
5bb0: 20 28 63 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 (conc (keys->ke
5bc0: 79 73 74 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 ystr keys) ","..
5bd0: 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d .. (string-
5be0: 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 6d 66 intersperse remf
5bf0: 69 65 6c 64 73 20 22 2c 22 29 29 29 29 0a 09 3b ields ","))))..;
5c00: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ; (debug:print 0
5c10: 20 22 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 "db:get-run-inf
5c20: 6f 20 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d o run-id: " run-
5c30: 69 64 20 22 20 68 65 61 64 65 72 3a 20 22 20 68 id " header: " h
5c40: 65 61 64 65 72 20 22 20 6b 65 79 73 74 72 3a 20 eader " keystr:
5c50: 22 20 6b 65 79 73 74 72 29 0a 09 28 73 71 6c 69 " keystr)..(sqli
5c60: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
5c70: 0a 09 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 .. (lambda (a .
5c80: 78 29 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 x).. (set! res
5c90: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
5ca0: 20 78 29 29 29 0a 09 20 64 62 0a 09 20 28 63 6f x))).. db.. (co
5cb0: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 79 nc "SELECT " key
5cc0: 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 str " FROM runs
5cd0: 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 20 WHERE id=?;")..
5ce0: 72 75 6e 2d 69 64 29 0a 09 28 6c 65 74 20 28 28 run-id)..(let ((
5cf0: 66 69 6e 61 6c 72 65 73 20 28 76 65 63 74 6f 72 finalres (vector
5d00: 20 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 09 header res)))..
5d10: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
5d20: 74 21 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 t! *run-info-cac
5d30: 68 65 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c he* run-id final
5d40: 72 65 73 29 0a 09 20 20 66 69 6e 61 6c 72 65 73 res).. finalres
5d50: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 ))))..(define (d
5d60: 62 3a 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 6f b:set-comment-fo
5d70: 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 r-run db run-id
5d80: 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 73 71 6c 69 comment). (sqli
5d90: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
5da0: 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 54 20 UPDATE runs SET
5db0: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
5dc0: 69 64 3d 3f 3b 22 20 63 6f 6d 6d 65 6e 74 20 72 id=?;" comment r
5dd0: 75 6e 2d 69 64 29 29 0a 0a 3b 3b 20 64 6f 65 73 un-id))..;; does
5de0: 20 6e 6f 74 20 28 6f 62 76 69 6f 75 73 6c 79 21 not (obviously!
5df0: 29 20 72 65 6d 6f 76 65 64 20 64 65 70 65 6e 64 ) removed depend
5e00: 65 6e 74 20 64 61 74 61 2e 20 42 75 74 20 77 68 ent data. But wh
5e10: 79 20 6e 6f 74 21 21 3f 0a 28 64 65 66 69 6e 65 y not!!?.(define
5e20: 20 28 64 62 3a 64 65 6c 65 74 65 2d 72 75 6e 20 (db:delete-run
5e30: 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 73 71 db run-id). (sq
5e40: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
5e50: 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 72 75 "DELETE FROM ru
5e60: 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 ns WHERE id=?;"
5e70: 72 75 6e 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e run-id))..(defin
5e80: 65 20 28 64 62 3a 75 70 64 61 74 65 2d 72 75 6e e (db:update-run
5e90: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 64 62 20 72 -event_time db r
5ea0: 75 6e 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 un-id). (sqlite
5eb0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 3:execute db "UP
5ec0: 44 41 54 45 20 72 75 6e 73 20 53 45 54 20 65 76 DATE runs SET ev
5ed0: 65 6e 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d ent_time=strftim
5ee0: 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 e('%s','now') WH
5ef0: 45 52 45 20 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 ERE id=?;" run-i
5f00: 64 29 29 20 0a 0a 28 64 65 66 69 6e 65 20 28 64 d)) ..(define (d
5f10: 62 3a 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 b:lock/unlock-ru
5f20: 6e 20 64 62 20 72 75 6e 2d 69 64 20 6c 6f 63 6b n db run-id lock
5f30: 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 20 unlock user).
5f40: 28 6c 65 74 20 28 28 6e 65 77 6c 6f 63 6b 76 61 (let ((newlockva
5f50: 6c 20 28 69 66 20 6c 6f 63 6b 20 22 6c 6f 63 6b l (if lock "lock
5f60: 65 64 22 0a 09 09 09 28 69 66 20 75 6e 6c 6f 63 ed"....(if unloc
5f70: 6b 0a 09 09 09 20 20 20 20 22 75 6e 6c 6f 63 6b k.... "unlock
5f80: 65 64 22 0a 09 09 09 20 20 20 20 22 6c 6f 63 6b ed".... "lock
5f90: 65 64 22 29 29 29 29 20 3b 3b 20 73 65 6d 69 2d ed")))) ;; semi-
5fa0: 66 61 69 6c 73 61 66 65 0a 20 20 20 20 28 73 71 failsafe. (sq
5fb0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
5fc0: 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 "UPDATE runs SE
5fd0: 54 20 73 74 61 74 65 3d 3f 20 57 48 45 52 45 20 T state=? WHERE
5fe0: 69 64 3d 3f 3b 22 20 6e 65 77 6c 6f 63 6b 76 61 id=?;" newlockva
5ff0: 6c 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 73 l run-id). (s
6000: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
6010: 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 61 b "INSERT INTO a
6020: 63 63 65 73 73 5f 6c 6f 67 20 28 75 73 65 72 2c ccess_log (user,
6030: 61 63 63 65 73 73 65 64 2c 61 72 67 73 29 20 56 accessed,args) V
6040: 41 4c 55 45 53 28 3f 2c 73 74 72 66 74 69 6d 65 ALUES(?,strftime
6050: 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 29 3b ('%s','now'),?);
6060: 22 0a 09 09 20 20 20 20 20 75 73 65 72 20 28 63 "... user (c
6070: 6f 6e 63 20 6e 65 77 6c 6f 63 6b 76 61 6c 20 22 onc newlockval "
6080: 20 22 20 72 75 6e 2d 69 64 29 29 0a 20 20 20 20 " run-id)).
6090: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
60a0: 49 4e 46 4f 3a 20 22 20 6e 65 77 6c 6f 63 6b 76 INFO: " newlockv
60b0: 61 6c 20 22 20 72 75 6e 20 6e 75 6d 62 65 72 20 al " run number
60c0: 22 20 72 75 6e 2d 69 64 29 29 29 0a 0a 3b 3b 3d " run-id)))..;;=
60d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6110: 3d 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 20 59 20 53 =====.;; K E Y S
6120: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
6130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 67 65 =========..;; ge
6170: 74 20 6b 65 79 20 76 61 6c 20 70 61 69 72 73 20 t key val pairs
6180: 66 6f 72 20 61 20 67 69 76 65 6e 20 72 75 6e 2d for a given run-
6190: 69 64 0a 3b 3b 20 28 20 28 46 49 45 4c 44 4e 41 id.;; ( (FIELDNA
61a0: 4d 45 31 20 6b 65 79 76 61 6c 31 29 20 28 46 49 ME1 keyval1) (FI
61b0: 45 4c 44 4e 41 4d 45 32 20 6b 65 79 76 61 6c 32 ELDNAME2 keyval2
61c0: 29 20 2e 2e 2e 20 29 0a 28 64 65 66 69 6e 65 20 ) ... ).(define
61d0: 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 2d (db:get-key-val-
61e0: 70 61 69 72 73 20 64 62 20 72 75 6e 2d 69 64 29 pairs db run-id)
61f0: 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 . (let* ((keys
6200: 28 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 (get-keys db))..
6210: 20 28 72 65 73 20 20 27 28 29 29 29 0a 20 20 20 (res '())).
6220: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 (debug:print 6
6230: 22 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 "keys: " keys "
6240: 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 run-id: " run-id
6250: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
6260: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b . (lambda (k
6270: 65 79 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 ey). (let
6280: 28 28 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c ((qry (conc "SEL
6290: 45 43 54 20 22 20 28 6b 65 79 3a 67 65 74 2d 66 ECT " (key:get-f
62a0: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 20 22 20 ieldname key) "
62b0: 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 FROM runs WHERE
62c0: 69 64 3d 3f 3b 22 29 29 29 0a 09 20 3b 3b 20 28 id=?;"))).. ;; (
62d0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 71 debug:print 0 "q
62e0: 72 79 3a 20 22 20 71 72 79 29 0a 09 20 28 73 71 ry: " qry).. (sq
62f0: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
6300: 6f 77 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 ow .. (lambda (
6310: 6b 65 79 2d 76 61 6c 29 0a 09 20 20 20 20 28 73 key-val).. (s
6320: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c et! res (cons (l
6330: 69 73 74 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 ist (key:get-fie
6340: 6c 64 6e 61 6d 65 20 6b 65 79 29 20 6b 65 79 2d ldname key) key-
6350: 76 61 6c 29 20 72 65 73 29 29 29 0a 09 20 20 64 val) res))).. d
6360: 62 20 71 72 79 20 72 75 6e 2d 69 64 29 29 29 0a b qry run-id))).
6370: 20 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 keys). (
6380: 72 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 0a reverse res)))..
6390: 3b 3b 20 67 65 74 20 6b 65 79 20 76 61 6c 73 20 ;; get key vals
63a0: 66 6f 72 20 61 20 67 69 76 65 6e 20 72 75 6e 2d for a given run-
63b0: 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 id.(define (db:g
63c0: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 et-key-vals db r
63d0: 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 un-id). (let ((
63e0: 6d 79 6b 65 79 76 61 6c 73 20 28 68 61 73 68 2d mykeyvals (hash-
63f0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
6400: 74 20 2a 6b 65 79 76 61 6c 73 2a 20 72 75 6e 2d t *keyvals* run-
6410: 69 64 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 id #f))). (if
6420: 20 6d 79 6b 65 79 76 61 6c 73 20 0a 09 6d 79 6b mykeyvals ..myk
6430: 65 79 76 61 6c 73 0a 09 28 6c 65 74 2a 20 28 28 eyvals..(let* ((
6440: 6b 65 79 73 20 28 67 65 74 2d 6b 65 79 73 20 64 keys (get-keys d
6450: 62 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 b)).. (res
6460: 20 20 27 28 29 29 29 0a 09 20 20 28 64 65 62 75 '())).. (debu
6470: 67 3a 70 72 69 6e 74 20 36 20 22 6b 65 79 73 3a g:print 6 "keys:
6480: 20 22 20 6b 65 79 73 20 22 20 72 75 6e 2d 69 64 " keys " run-id
6490: 3a 20 22 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 : " run-id).. (
64a0: 66 6f 72 2d 65 61 63 68 20 0a 09 20 20 20 28 6c for-each .. (l
64b0: 61 6d 62 64 61 20 28 6b 65 79 29 0a 09 20 20 20 ambda (key)..
64c0: 20 20 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f (let ((qry (co
64d0: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 28 6b 65 nc "SELECT " (ke
64e0: 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 20 y:get-fieldname
64f0: 6b 65 79 29 20 22 20 46 52 4f 4d 20 72 75 6e 73 key) " FROM runs
6500: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 WHERE id=?;")))
6510: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 64 65 62 .. ;; (deb
6520: 75 67 3a 70 72 69 6e 74 20 30 20 22 71 72 79 3a ug:print 0 "qry:
6530: 20 22 20 71 72 79 29 0a 09 20 20 20 20 20 20 20 " qry)..
6540: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
6550: 68 2d 72 6f 77 20 0a 09 09 28 6c 61 6d 62 64 61 h-row ...(lambda
6560: 20 28 6b 65 79 2d 76 61 6c 29 0a 09 09 20 20 28 (key-val)... (
6570: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 6b set! res (cons k
6580: 65 79 2d 76 61 6c 20 72 65 73 29 29 29 0a 09 09 ey-val res)))...
6590: 64 62 20 71 72 79 20 72 75 6e 2d 69 64 29 29 29 db qry run-id)))
65a0: 0a 09 20 20 20 6b 65 79 73 29 0a 09 20 20 28 6c .. keys).. (l
65b0: 65 74 20 28 28 66 69 6e 61 6c 2d 72 65 73 20 28 et ((final-res (
65c0: 72 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 09 reverse res)))..
65d0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
65e0: 73 65 74 21 20 2a 6b 65 79 76 61 6c 73 2a 20 72 set! *keyvals* r
65f0: 75 6e 2d 69 64 20 66 69 6e 61 6c 2d 72 65 73 29 un-id final-res)
6600: 0a 09 20 20 20 20 66 69 6e 61 6c 2d 72 65 73 29 .. final-res)
6610: 29 29 29 29 0a 0a 3b 3b 20 54 68 65 20 74 61 72 ))))..;; The tar
6620: 67 65 74 20 69 73 20 6b 65 79 76 61 6c 31 2f 6b get is keyval1/k
6630: 65 79 76 61 6c 32 2e 2e 2e 2c 20 63 61 63 68 65 eyval2..., cache
6640: 64 20 69 6e 20 2a 74 61 72 67 65 74 2a 20 61 73 d in *target* as
6650: 20 69 74 20 69 73 20 75 73 65 64 20 6f 66 74 65 it is used ofte
6660: 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 n.(define (db:ge
6670: 74 2d 74 61 72 67 65 74 20 64 62 20 72 75 6e 2d t-target db run-
6680: 69 64 29 0a 20 20 28 6c 65 74 20 28 28 6d 79 74 id). (let ((myt
6690: 61 72 67 20 28 68 61 73 68 2d 74 61 62 6c 65 2d arg (hash-table-
66a0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 61 72 ref/default *tar
66b0: 67 65 74 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 get* run-id #f))
66c0: 29 0a 20 20 20 20 28 69 66 20 6d 79 74 61 72 67 ). (if mytarg
66d0: 0a 09 6d 79 74 61 72 67 0a 09 28 6c 65 74 2a 20 ..mytarg..(let*
66e0: 28 28 6b 65 79 76 61 6c 73 20 28 64 62 3a 67 65 ((keyvals (db:ge
66f0: 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 75 t-key-vals db ru
6700: 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 20 20 28 n-id)).. (
6710: 74 68 65 6b 65 79 20 20 28 73 74 72 69 6e 67 2d thekey (string-
6720: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
6730: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69 66 20 (lambda (x)(if
6740: 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b 65 79 x x "-na-")) key
6750: 76 61 6c 73 29 20 22 2f 22 29 29 29 0a 09 20 20 vals) "/")))..
6760: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
6770: 20 2a 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 64 *target* run-id
6780: 20 74 68 65 6b 65 79 29 0a 09 20 20 74 68 65 6b thekey).. thek
6790: 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ey))))..;;======
67a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
67e0: 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53 0a 3b .;; T E S T S.;
67f0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
6800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6830: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
6840: 20 28 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 (db:tests-regis
6850: 74 65 72 2d 74 65 73 74 20 64 62 20 72 75 6e 2d ter-test db run-
6860: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
6870: 6d 2d 70 61 74 68 29 0a 20 20 28 64 65 62 75 67 m-path). (debug
6880: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
6890: 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 74 65 db:tests-registe
68a0: 72 2d 74 65 73 74 20 64 62 3d 22 20 64 62 20 22 r-test db=" db "
68b0: 2c 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 , run-id=" run-i
68c0: 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d 65 3d 22 d ", test-name="
68d0: 20 74 65 73 74 2d 6e 61 6d 65 20 22 2c 20 69 74 test-name ", it
68e0: 65 6d 2d 70 61 74 68 3d 5c 22 22 20 69 74 65 6d em-path=\"" item
68f0: 2d 70 61 74 68 20 22 5c 22 22 29 0a 20 20 28 6c -path "\""). (l
6900: 65 74 20 28 28 69 74 65 6d 2d 70 61 74 68 73 20 et ((item-paths
6910: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item
6920: 2d 70 61 74 68 20 22 22 29 0a 09 09 09 28 6c 69 -path "")....(li
6930: 73 74 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 st item-path)...
6940: 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 74 68 .(list item-path
6950: 20 22 22 29 29 29 29 0a 20 20 20 20 28 66 6f 72 "")))). (for
6960: 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d -each . (lam
6970: 62 64 61 20 28 70 74 68 29 0a 20 20 20 20 20 20 bda (pth).
6980: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
6990: 65 20 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 e db "INSERT OR
69a0: 49 47 4e 4f 52 45 20 49 4e 54 4f 20 74 65 73 74 IGNORE INTO test
69b0: 73 20 28 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 s (run_id,testna
69c0: 6d 65 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 69 74 me,event_time,it
69d0: 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 em_path,state,st
69e0: 61 74 75 73 29 20 56 41 4c 55 45 53 20 28 3f 2c atus) VALUES (?,
69f0: 3f 2c 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c ?,strftime('%s',
6a00: 27 6e 6f 77 27 29 2c 3f 2c 27 4e 4f 54 5f 53 54 'now'),?,'NOT_ST
6a10: 41 52 54 45 44 27 2c 27 6e 2f 61 27 29 3b 22 20 ARTED','n/a');"
6a20: 0a 09 09 09 72 75 6e 2d 69 64 20 0a 09 09 09 74 ....run-id ....t
6a30: 65 73 74 2d 6e 61 6d 65 0a 09 09 09 70 74 68 29 est-name....pth)
6a40: 29 0a 20 20 20 20 20 69 74 65 6d 2d 70 61 74 68 ). item-path
6a50: 73 29 0a 20 20 20 20 23 66 29 29 0a 0a 0a 3b 3b s). #f))...;;
6a60: 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 states and stat
6a70: 75 73 65 73 20 61 72 65 20 6c 69 73 74 73 2c 20 uses are lists,
6a80: 74 75 72 6e 20 74 68 65 6d 20 69 6e 74 6f 20 28 turn them into (
6a90: 22 50 41 53 53 22 2c 22 46 41 49 4c 22 2e 2e 2e "PASS","FAIL"...
6aa0: 29 20 61 6e 64 20 75 73 65 20 4e 4f 54 20 49 4e ) and use NOT IN
6ab0: 0a 3b 3b 20 69 2e 65 2e 20 74 68 65 73 65 20 6c .;; i.e. these l
6ac0: 69 73 74 73 20 64 65 66 69 6e 65 20 77 68 61 74 ists define what
6ad0: 20 74 6f 20 4e 4f 54 20 73 68 6f 77 2e 0a 3b 3b to NOT show..;;
6ae0: 20 73 74 61 74 65 73 20 61 6e 64 20 73 74 61 74 states and stat
6af0: 75 73 65 73 20 61 72 65 20 72 65 71 75 69 72 65 uses are require
6b00: 64 20 74 6f 20 62 65 20 6c 69 73 74 73 2c 20 65 d to be lists, e
6b10: 6d 70 74 79 20 69 73 20 6f 6b 0a 3b 3b 20 6e 6f mpty is ok.;; no
6b20: 74 2d 69 6e 20 23 74 20 3d 20 61 62 6f 76 65 20 t-in #t = above
6b30: 62 65 68 61 76 69 6f 75 72 2c 20 23 66 20 3d 20 behaviour, #f =
6b40: 6d 75 73 74 20 6d 61 74 63 68 0a 28 64 65 66 69 must match.(defi
6b50: 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 ne (db:get-tests
6b60: 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e 2d -for-run db run-
6b70: 69 64 20 74 65 73 74 70 61 74 74 20 73 74 61 74 id testpatt stat
6b80: 65 73 20 73 74 61 74 75 73 65 73 20 0a 09 09 09 es statuses ....
6b90: 20 20 20 20 20 20 23 21 6b 65 79 20 28 6e 6f 74 #!key (not
6ba0: 2d 69 6e 20 23 74 29 0a 09 09 09 20 20 20 20 20 -in #t)....
6bb0: 20 28 73 6f 72 74 2d 62 79 20 23 66 29 20 3b 3b (sort-by #f) ;;
6bc0: 20 27 72 75 6e 64 69 72 20 27 65 76 65 6e 74 5f 'rundir 'event_
6bd0: 74 69 6d 65 0a 09 09 09 20 20 20 20 20 20 29 0a time.... ).
6be0: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 27 28 (let* ((res '(
6bf0: 29 29 0a 09 20 3b 3b 20 69 66 20 73 74 61 74 65 )).. ;; if state
6c00: 73 20 6f 72 20 73 74 61 74 75 73 65 73 20 61 72 s or statuses ar
6c10: 65 20 6e 75 6c 6c 20 74 68 65 6e 20 61 73 73 75 e null then assu
6c20: 6d 65 20 6d 61 74 63 68 20 61 6c 6c 20 77 68 65 me match all whe
6c30: 6e 20 6e 6f 74 2d 69 6e 20 69 73 20 66 61 6c 73 n not-in is fals
6c40: 65 0a 09 20 28 73 74 61 74 65 73 2d 71 72 79 20 e.. (states-qry
6c50: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
6c60: 73 74 61 74 65 73 29 20 0a 09 09 09 20 20 20 20 states) ....
6c70: 20 20 23 66 0a 09 09 09 20 20 20 20 20 20 28 63 #f.... (c
6c80: 6f 6e 63 20 22 20 73 74 61 74 65 20 22 20 20 0a onc " state " .
6c90: 09 09 09 09 20 20 20 20 28 69 66 20 6e 6f 74 2d .... (if not-
6ca0: 69 6e 20 22 4e 4f 54 22 20 22 22 29 20 0a 09 09 in "NOT" "") ...
6cb0: 09 09 20 20 20 20 22 20 49 4e 20 28 27 22 20 0a .. " IN ('" .
6cc0: 09 09 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d .... (string-
6cd0: 69 6e 74 65 72 73 70 65 72 73 65 20 73 74 61 74 intersperse stat
6ce0: 65 73 20 20 20 22 27 2c 27 22 29 0a 09 09 09 09 es "','").....
6cf0: 20 20 20 20 22 27 29 22 29 29 29 0a 09 20 28 73 "')"))).. (s
6d00: 74 61 74 75 73 65 73 2d 71 72 79 20 20 20 20 28 tatuses-qry (
6d10: 69 66 20 28 6e 75 6c 6c 3f 20 73 74 61 74 75 73 if (null? status
6d20: 65 73 29 0a 09 09 09 20 20 20 20 20 20 23 66 0a es).... #f.
6d30: 09 09 09 20 20 20 20 20 20 28 63 6f 6e 63 20 22 ... (conc "
6d40: 20 73 74 61 74 75 73 20 22 0a 09 09 09 09 20 20 status ".....
6d50: 20 20 28 69 66 20 6e 6f 74 2d 69 6e 20 22 4e 4f (if not-in "NO
6d60: 54 22 20 22 22 29 20 0a 09 09 09 09 20 20 20 20 T" "") .....
6d70: 22 20 49 4e 20 28 27 22 20 0a 09 09 09 09 20 20 " IN ('" .....
6d80: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
6d90: 70 65 72 73 65 20 73 74 61 74 75 73 65 73 20 22 perse statuses "
6da0: 27 2c 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 ','")..... "'
6db0: 29 22 29 29 29 0a 09 20 28 74 65 73 74 73 2d 6d )"))).. (tests-m
6dc0: 61 74 63 68 2d 71 72 79 20 28 74 65 73 74 73 3a atch-qry (tests:
6dd0: 6d 61 74 63 68 2d 3e 73 71 6c 71 72 79 20 74 65 match->sqlqry te
6de0: 73 74 70 61 74 74 29 29 0a 09 20 28 71 72 79 20 stpatt)).. (qry
6df0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
6e00: 63 20 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e c "SELECT id,run
6e10: 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 _id,testname,sta
6e20: 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f te,status,event_
6e30: 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 time,host,cpuloa
6e40: 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 d,diskfree,uname
6e50: 2c 72 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 ,rundir,item_pat
6e60: 68 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 h,run_duration,f
6e70: 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e inal_logf,commen
6e80: 74 20 22 0a 09 09 09 09 22 20 46 52 4f 4d 20 74 t "....." FROM t
6e90: 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 ests WHERE run_i
6ea0: 64 3d 3f 20 22 0a 09 09 09 09 28 69 66 20 73 74 d=? ".....(if st
6eb0: 61 74 65 73 2d 71 72 79 20 20 20 28 63 6f 6e 63 ates-qry (conc
6ec0: 20 22 20 41 4e 44 20 22 20 73 74 61 74 65 73 2d " AND " states-
6ed0: 71 72 79 29 20 20 20 22 22 29 0a 09 09 09 09 28 qry) "").....(
6ee0: 69 66 20 73 74 61 74 75 73 65 73 2d 71 72 79 20 if statuses-qry
6ef0: 28 63 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 (conc " AND " st
6f00: 61 74 75 73 65 73 2d 71 72 79 29 20 22 22 29 0a atuses-qry) "").
6f10: 09 09 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 ....(if tests-ma
6f20: 74 63 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 tch-qry (conc "
6f30: 41 4e 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 AND (" tests-mat
6f40: 63 68 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 ch-qry ") ") "")
6f50: 0a 09 09 09 09 28 63 61 73 65 20 73 6f 72 74 2d .....(case sort-
6f60: 62 79 0a 09 09 09 09 20 20 28 28 72 75 6e 64 69 by..... ((rundi
6f70: 72 29 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 r) " ORDER B
6f80: 59 20 6c 65 6e 67 74 68 28 72 75 6e 64 69 72 29 Y length(rundir)
6f90: 20 44 45 53 43 3b 22 29 0a 09 09 09 09 20 20 28 DESC;")..... (
6fa0: 28 65 76 65 6e 74 5f 74 69 6d 65 29 20 22 20 4f (event_time) " O
6fb0: 52 44 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 RDER BY event_ti
6fc0: 6d 65 20 41 53 43 3b 22 29 0a 09 09 09 09 20 20 me ASC;").....
6fd0: 28 65 6c 73 65 20 20 20 20 20 20 20 20 20 22 3b (else ";
6fe0: 22 29 29 0a 09 09 09 20 29 29 29 0a 20 20 20 20 ")).... ))).
6ff0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 38 20 22 (debug:print 8 "
7000: 49 4e 46 4f 3a 20 64 62 3a 67 65 74 2d 74 65 73 INFO: db:get-tes
7010: 74 73 2d 66 6f 72 2d 72 75 6e 20 71 72 79 3d 22 ts-for-run qry="
7020: 20 71 72 79 29 0a 20 20 20 20 28 73 71 6c 69 74 qry). (sqlit
7030: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
7040: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 . (lambda (a
7050: 20 2e 20 62 29 20 3b 3b 20 69 64 20 72 75 6e 2d . b) ;; id run-
7060: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
7070: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
7080: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
7090: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
70a0: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
70b0: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 run-duration fi
70c0: 6e 61 6c 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 nal-logf comment
70d0: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 ). (set! r
70e0: 65 73 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 es (cons (apply
70f0: 76 65 63 74 6f 72 20 61 20 62 29 20 72 65 73 29 vector a b) res)
7100: 29 29 20 3b 3b 20 69 64 20 72 75 6e 2d 69 64 20 )) ;; id run-id
7110: 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 testname state s
7120: 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 tatus event-time
7130: 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 host cpuload di
7140: 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e skfree uname run
7150: 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 75 dir item-path ru
7160: 6e 2d 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c n-duration final
7170: 2d 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 20 72 -logf comment) r
7180: 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 0a 20 es))). db .
7190: 20 20 20 20 71 72 79 0a 20 20 20 20 20 72 75 6e qry. run
71a0: 2d 69 64 0a 20 20 20 20 20 3b 3b 20 28 69 66 20 -id. ;; (if
71b0: 74 65 73 74 70 61 74 74 20 74 65 73 74 70 61 74 testpatt testpat
71c0: 74 20 22 25 22 29 0a 20 20 20 20 20 3b 3b 20 28 t "%"). ;; (
71d0: 69 66 20 69 74 65 6d 70 61 74 74 20 69 74 65 6d if itempatt item
71e0: 70 61 74 74 20 22 25 22 29 29 0a 20 20 20 20 20 patt "%")).
71f0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
7200: 74 68 69 73 20 6f 6e 65 20 69 73 20 61 20 62 69 this one is a bi
7210: 74 20 62 72 6f 6b 65 6e 20 42 55 47 20 46 49 58 t broken BUG FIX
7220: 4d 45 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 ME.(define (db:d
7230: 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 2d elete-test-step-
7240: 72 65 63 6f 72 64 73 20 64 62 20 74 65 73 74 2d records db test-
7250: 69 64 29 0a 20 20 3b 3b 20 42 72 65 61 6b 69 6e id). ;; Breakin
7260: 67 20 69 74 20 69 6e 74 6f 20 74 77 6f 20 71 75 g it into two qu
7270: 65 72 69 65 73 20 66 6f 72 20 62 65 74 74 65 72 eries for better
7280: 20 66 69 6c 65 20 61 63 63 65 73 73 20 69 6e 74 file access int
7290: 65 72 6c 65 61 76 69 6e 67 0a 20 20 28 6c 65 74 erleaving. (let
72a0: 2a 20 28 28 74 64 62 20 28 64 62 3a 6f 70 65 6e * ((tdb (db:open
72b0: 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 -test-db-by-test
72c0: 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 -id db test-id))
72d0: 29 0a 20 20 20 20 3b 3b 20 74 65 73 74 20 64 62 ). ;; test db
72e0: 27 73 20 63 61 6e 20 67 6f 20 61 77 61 79 20 2d 's can go away -
72f0: 20 6d 75 73 74 20 63 68 65 63 6b 20 65 76 65 72 must check ever
7300: 79 20 74 69 6d 65 0a 20 20 20 20 28 69 66 20 74 y time. (if t
7310: 64 62 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 db..(begin.. (s
7320: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 qlite3:execute t
7330: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 db "DELETE FROM
7340: 74 65 73 74 5f 73 74 65 70 73 3b 22 29 0a 09 20 test_steps;")..
7350: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
7360: 65 20 74 64 62 20 22 44 45 4c 45 54 45 20 46 52 e tdb "DELETE FR
7370: 4f 4d 20 74 65 73 74 5f 64 61 74 61 3b 22 29 0a OM test_data;").
7380: 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 . (sqlite3:fina
7390: 6c 69 7a 65 21 20 74 64 62 29 29 29 29 29 0a 0a lize! tdb)))))..
73a0: 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ;; .(define (db:
73b0: 64 65 6c 65 74 65 2d 74 65 73 74 2d 72 65 63 6f delete-test-reco
73c0: 72 64 73 20 64 62 20 74 64 62 20 74 65 73 74 2d rds db tdb test-
73d0: 69 64 20 23 21 6b 65 79 20 28 66 6f 72 63 65 20 id #!key (force
73e0: 23 66 29 29 0a 20 20 28 69 66 20 74 64 62 20 0a #f)). (if tdb .
73f0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 73 (begin..(s
7400: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 qlite3:execute t
7410: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 db "DELETE FROM
7420: 74 65 73 74 5f 73 74 65 70 73 3b 22 29 0a 09 28 test_steps;")..(
7430: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
7440: 74 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d tdb "DELETE FROM
7450: 20 74 65 73 74 5f 64 61 74 61 3b 22 29 29 29 0a test_data;"))).
7460: 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 78 ;; (sqlite3:ex
7470: 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 ecute db "DELETE
7480: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
7490: 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 E id=?;" test-id
74a0: 29 29 0a 20 20 28 69 66 20 64 62 20 0a 20 20 20 )). (if db .
74b0: 20 20 20 28 62 65 67 69 6e 0a 09 28 73 71 6c 69 (begin..(sqli
74c0: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
74d0: 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 DELETE FROM test
74e0: 5f 73 74 65 70 73 20 57 48 45 52 45 20 74 65 73 _steps WHERE tes
74f0: 74 5f 69 64 3d 3f 3b 22 20 74 65 73 74 2d 69 64 t_id=?;" test-id
7500: 29 0a 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 )..(sqlite3:exec
7510: 75 74 65 20 64 62 20 22 44 45 4c 45 54 45 20 46 ute db "DELETE F
7520: 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 20 57 ROM test_data W
7530: 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 3b 22 HERE test_id=?;"
7540: 20 74 65 73 74 2d 69 64 29 0a 09 28 69 66 20 66 test-id)..(if f
7550: 6f 72 63 65 0a 09 20 20 20 20 28 73 71 6c 69 74 orce.. (sqlit
7560: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 e3:execute db "D
7570: 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 ELETE FROM tests
7580: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 74 65 WHERE id=?;" te
7590: 73 74 2d 69 64 29 0a 09 20 20 20 20 28 73 71 6c st-id).. (sql
75a0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
75b0: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
75c0: 54 20 73 74 61 74 65 3d 27 44 45 4c 45 54 45 44 T state='DELETED
75d0: 27 2c 73 74 61 74 75 73 3d 27 6e 2f 61 27 20 57 ',status='n/a' W
75e0: 48 45 52 45 20 69 64 3d 3f 3b 22 20 74 65 73 74 HERE id=?;" test
75f0: 2d 69 64 29 29 29 29 29 0a 0a 28 64 65 66 69 6e -id)))))..(defin
7600: 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 e (db:delete-tes
7610: 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 ts-for-run db ru
7620: 6e 2d 69 64 29 0a 20 20 28 73 71 6c 69 74 65 33 n-id). (sqlite3
7630: 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 45 4c :execute db "DEL
7640: 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 ETE FROM tests W
7650: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 HERE run_id=?;"
7660: 72 75 6e 2d 69 64 29 29 0a 0a 28 64 65 66 69 6e run-id))..(defin
7670: 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 6f 6c 64 e (db:delete-old
7680: 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 65 -deleted-test-re
7690: 63 6f 72 64 73 20 64 62 29 0a 20 20 28 6c 65 74 cords db). (let
76a0: 20 28 28 74 61 72 67 74 69 6d 65 20 28 2d 20 28 ((targtime (- (
76b0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
76c0: 28 2a 20 33 30 20 32 34 20 36 30 20 36 30 29 29 (* 30 24 60 60))
76d0: 29 29 20 3b 3b 20 6f 6e 65 20 6d 6f 6e 74 68 20 )) ;; one month
76e0: 69 6e 20 74 68 65 20 70 61 73 74 0a 20 20 20 20 in the past.
76f0: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
7700: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
7710: 20 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 tests WHERE sta
7720: 74 65 3d 27 44 45 4c 45 54 45 44 27 20 41 4e 44 te='DELETED' AND
7730: 20 65 76 65 6e 74 5f 74 69 6d 65 3c 3f 3b 22 20 event_time<?;"
7740: 74 61 72 67 74 69 6d 65 29 29 29 0a 0a 3b 3b 20 targtime)))..;;
7750: 73 65 74 20 74 65 73 74 73 20 77 69 74 68 20 73 set tests with s
7760: 74 61 74 65 20 63 75 72 72 73 74 61 74 65 20 61 tate currstate a
7770: 6e 64 20 73 74 61 74 75 73 20 63 75 72 72 73 74 nd status currst
7780: 61 74 75 73 20 74 6f 20 6e 65 77 73 74 61 74 65 atus to newstate
7790: 20 61 6e 64 20 6e 65 77 73 74 61 74 75 73 0a 3b and newstatus.;
77a0: 3b 20 75 73 65 20 63 75 72 72 73 74 61 74 65 20 ; use currstate
77b0: 3d 20 23 66 20 61 6e 64 20 6f 72 20 63 75 72 72 = #f and or curr
77c0: 73 74 61 74 75 73 20 3d 20 23 66 20 74 6f 20 61 status = #f to a
77d0: 70 70 6c 79 20 74 6f 20 61 6e 79 20 73 74 61 74 pply to any stat
77e0: 65 20 6f 72 20 73 74 61 74 75 73 20 72 65 73 70 e or status resp
77f0: 65 63 74 69 76 65 6c 79 0a 3b 3b 20 57 41 52 4e ectively.;; WARN
7800: 49 4e 47 3a 20 53 51 4c 20 69 6e 6a 65 63 74 69 ING: SQL injecti
7810: 6f 6e 20 72 69 73 6b 0a 28 64 65 66 69 6e 65 20 on risk.(define
7820: 28 64 62 3a 73 65 74 2d 74 65 73 74 73 2d 73 74 (db:set-tests-st
7830: 61 74 65 2d 73 74 61 74 75 73 20 64 62 20 72 75 ate-status db ru
7840: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 73 20 63 n-id testnames c
7850: 75 72 72 73 74 61 74 65 20 63 75 72 72 73 74 61 urrstate currsta
7860: 74 75 73 20 6e 65 77 73 74 61 74 65 20 6e 65 77 tus newstate new
7870: 73 74 61 74 75 73 29 0a 20 20 28 66 6f 72 2d 65 status). (for-e
7880: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 73 ach (lambda (tes
7890: 74 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c tname).. (l
78a0: 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 et ((qry (conc "
78b0: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
78c0: 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d state=?,status=
78d0: 3f 20 57 48 45 52 45 20 22 0a 09 09 09 20 20 20 ? WHERE "....
78e0: 20 20 20 20 28 69 66 20 63 75 72 72 73 74 61 74 (if currstat
78f0: 65 20 20 28 63 6f 6e 63 20 22 73 74 61 74 65 3d e (conc "state=
7900: 27 22 20 63 75 72 72 73 74 61 74 65 20 22 27 20 '" currstate "'
7910: 41 4e 44 20 22 29 20 22 22 29 0a 09 09 09 20 20 AND ") "")....
7920: 20 20 20 20 20 28 69 66 20 63 75 72 72 73 74 61 (if currsta
7930: 74 75 73 20 28 63 6f 6e 63 20 22 73 74 61 74 75 tus (conc "statu
7940: 73 3d 27 22 20 63 75 72 72 73 74 61 74 75 73 20 s='" currstatus
7950: 22 27 20 41 4e 44 20 22 29 20 22 22 29 0a 09 09 "' AND ") "")...
7960: 09 20 20 20 20 20 20 20 22 20 72 75 6e 5f 69 64 . " run_id
7970: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
7980: 3f 20 41 4e 44 20 4e 4f 54 20 28 69 74 65 6d 5f ? AND NOT (item_
7990: 70 61 74 68 3d 27 27 20 41 4e 44 20 74 65 73 74 path='' AND test
79a0: 6e 61 6d 65 20 69 6e 20 28 53 45 4c 45 43 54 20 name in (SELECT
79b0: 44 49 53 54 49 4e 43 54 20 74 65 73 74 6e 61 6d DISTINCT testnam
79c0: 65 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 e FROM tests WHE
79d0: 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e RE testname=? AN
79e0: 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
79f0: 27 29 29 3b 22 29 29 29 0a 09 09 3b 3b 28 64 65 '));")))...;;(de
7a00: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 51 52 59 bug:print 0 "QRY
7a10: 3a 20 22 20 71 72 79 29 0a 09 09 28 73 71 6c 69 : " qry)...(sqli
7a20: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 71 te3:execute db q
7a30: 72 79 20 72 75 6e 2d 69 64 20 6e 65 77 73 74 61 ry run-id newsta
7a40: 74 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 te newstatus tes
7a50: 74 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 29 tname testname))
7a60: 29 0a 09 20 20 20 20 74 65 73 74 6e 61 6d 65 73 ).. testnames
7a70: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
7a80: 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 6e 2d delete-tests-in-
7a90: 73 74 61 74 65 20 64 62 20 72 75 6e 2d 69 64 20 state db run-id
7aa0: 73 74 61 74 65 29 0a 20 20 28 73 71 6c 69 74 65 state). (sqlite
7ab0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 45 3:execute db "DE
7ac0: 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20 LETE FROM tests
7ad0: 57 48 45 52 45 20 73 74 61 74 65 3d 3f 20 41 4e WHERE state=? AN
7ae0: 44 20 72 75 6e 5f 69 64 3d 3f 3b 22 20 73 74 61 D run_id=?;" sta
7af0: 74 65 20 72 75 6e 2d 69 64 29 29 0a 0a 3b 3b 20 te run-id))..;;
7b00: 73 70 65 65 64 20 75 70 20 66 6f 72 20 63 6f 6d speed up for com
7b10: 6d 6f 6e 20 63 61 73 65 73 20 77 69 74 68 20 61 mon cases with a
7b20: 20 6c 69 74 74 6c 65 20 6c 6f 67 69 63 0a 28 64 little logic.(d
7b30: 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 73 efine (db:test-s
7b40: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
7b50: 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 by-id db test-id
7b60: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
7b70: 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 0a tus newcomment).
7b80: 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 61 6e 64 (cond. ((and
7b90: 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 newstate newsta
7ba0: 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 0a tus newcomment).
7bb0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
7bc0: 63 74 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ctute db "UPDATE
7bd0: 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 tests SET state
7be0: 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 6f 6d 6d =?,status=?,comm
7bf0: 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f ent=? WHERE id=?
7c00: 3b 22 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 ;" newstate news
7c10: 74 61 74 75 73 20 74 65 73 74 2d 69 64 29 29 0a tatus test-id)).
7c20: 20 20 20 28 28 61 6e 64 20 6e 65 77 73 74 61 74 ((and newstat
7c30: 65 20 6e 65 77 73 74 61 74 75 73 29 0a 20 20 20 e newstatus).
7c40: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
7c50: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
7c60: 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 ts SET state=?,s
7c70: 74 61 74 75 73 3d 3f 20 57 48 45 52 45 20 69 64 tatus=? WHERE id
7c80: 3d 3f 3b 22 20 6e 65 77 73 74 61 74 65 20 6e 65 =?;" newstate ne
7c90: 77 73 74 61 74 75 73 20 74 65 73 74 2d 69 64 29 wstatus test-id)
7ca0: 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 ). (else. (
7cb0: 69 66 20 6e 65 77 73 74 61 74 65 20 20 20 28 73 if newstate (s
7cc0: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
7cd0: 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 b "UPDATE tests
7ce0: 53 45 54 20 73 74 61 74 65 3d 3f 20 20 20 57 48 SET state=? WH
7cf0: 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 73 74 ERE id=?;" newst
7d00: 61 74 65 20 20 20 74 65 73 74 2d 69 64 29 29 0a ate test-id)).
7d10: 20 20 20 20 28 69 66 20 6e 65 77 73 74 61 74 75 (if newstatu
7d20: 73 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 s (sqlite3:exec
7d30: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
7d40: 65 73 74 73 20 53 45 54 20 73 74 61 74 75 73 3d ests SET status=
7d50: 3f 20 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 ? WHERE id=?;"
7d60: 6e 65 77 73 74 61 74 75 73 20 20 74 65 73 74 2d newstatus test-
7d70: 69 64 29 29 0a 20 20 20 20 28 69 66 20 6e 65 77 id)). (if new
7d80: 63 6f 6d 6d 65 6e 74 20 28 73 71 6c 69 74 65 33 comment (sqlite3
7d90: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
7da0: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 63 6f ATE tests SET co
7db0: 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 mment=? WHERE id
7dc0: 3d 3f 3b 22 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 =?;" newcomment
7dd0: 74 65 73 74 2d 69 64 29 29 29 29 29 0a 0a 28 64 test-id)))))..(d
7de0: 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 73 efine (db:test-s
7df0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
7e00: 62 79 2d 72 75 6e 2d 69 64 2d 74 65 73 74 6e 61 by-run-id-testna
7e10: 6d 65 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 me db run-id tes
7e20: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
7e30: 20 73 74 61 74 75 73 20 73 74 61 74 65 29 0a 20 status state).
7e40: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
7e50: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
7e60: 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 ts SET state=?,s
7e70: 74 61 74 75 73 3d 3f 2c 65 76 65 6e 74 5f 74 69 tatus=?,event_ti
7e80: 6d 65 3d 73 74 72 66 74 69 6d 65 28 27 25 73 27 me=strftime('%s'
7e90: 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 20 72 75 ,'now') WHERE ru
7ea0: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
7eb0: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
7ec0: 61 74 68 3d 3f 3b 22 20 0a 09 09 20 20 20 73 74 ath=?;" ... st
7ed0: 61 74 65 20 73 74 61 74 75 73 20 72 75 6e 2d 69 ate status run-i
7ee0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
7ef0: 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 6e 65 -path))..(define
7f00: 20 28 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 (db:get-count-t
7f10: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 64 62 29 ests-running db)
7f20: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 . (let ((res 0)
7f30: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
7f40: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
7f50: 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 (lambda (count)
7f60: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
7f70: 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 64 s count)). d
7f80: 62 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 63 b. "SELECT c
7f90: 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 ount(id) FROM te
7fa0: 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 20 sts WHERE state
7fb0: 69 6e 20 28 27 52 55 4e 4e 49 4e 47 27 2c 27 4c in ('RUNNING','L
7fc0: 41 55 4e 43 48 45 44 27 2c 27 52 45 4d 4f 54 45 AUNCHED','REMOTE
7fd0: 48 4f 53 54 53 54 41 52 54 27 29 3b 22 29 0a 20 HOSTSTART');").
7fe0: 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e res))..(defin
7ff0: 65 20 28 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d e (db:get-count-
8000: 74 65 73 74 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e tests-running-in
8010: 2d 6a 6f 62 67 72 6f 75 70 20 64 62 20 6a 6f 62 -jobgroup db job
8020: 67 72 6f 75 70 29 0a 20 20 28 69 66 20 28 6e 6f group). (if (no
8030: 74 20 6a 6f 62 67 72 6f 75 70 29 0a 20 20 20 20 t jobgroup).
8040: 20 20 30 20 3b 3b 20 0a 20 20 20 20 20 20 28 6c 0 ;; . (l
8050: 65 74 20 28 28 72 65 73 20 30 29 29 0a 09 28 73 et ((res 0))..(s
8060: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
8070: 72 6f 77 0a 09 20 28 6c 61 6d 62 64 61 20 28 63 row.. (lambda (c
8080: 6f 75 6e 74 29 0a 09 20 20 20 28 73 65 74 21 20 ount).. (set!
8090: 72 65 73 20 63 6f 75 6e 74 29 29 0a 09 20 64 62 res count)).. db
80a0: 0a 09 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 .. "SELECT count
80b0: 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 (id) FROM tests
80c0: 57 48 45 52 45 20 73 74 61 74 65 20 3d 20 27 52 WHERE state = 'R
80d0: 55 4e 4e 49 4e 47 27 20 4f 52 20 73 74 61 74 65 UNNING' OR state
80e0: 20 3d 20 27 4c 41 55 4e 43 48 45 44 27 20 4f 52 = 'LAUNCHED' OR
80f0: 20 73 74 61 74 65 20 3d 20 27 52 45 4d 4f 54 45 state = 'REMOTE
8100: 48 4f 53 54 53 54 41 52 54 27 0a 20 20 20 20 20 HOSTSTART'.
8110: 20 20 20 20 20 20 20 20 41 4e 44 20 74 65 73 74 AND test
8120: 6e 61 6d 65 20 69 6e 20 28 53 45 4c 45 43 54 20 name in (SELECT
8130: 74 65 73 74 6e 61 6d 65 20 46 52 4f 4d 20 74 65 testname FROM te
8140: 73 74 5f 6d 65 74 61 20 57 48 45 52 45 20 6a 6f st_meta WHERE jo
8150: 62 67 72 6f 75 70 3d 3f 3b 22 0a 09 20 6a 6f 62 bgroup=?;".. job
8160: 67 72 6f 75 70 29 0a 09 72 65 73 29 29 29 0a 0a group)..res)))..
8170: 3b 3b 20 64 6f 6e 65 20 77 69 74 68 20 72 75 6e ;; done with run
8180: 20 77 68 65 6e 3a 0a 3b 3b 20 20 20 30 20 74 65 when:.;; 0 te
8190: 73 74 73 20 69 6e 20 4c 41 55 4e 43 48 45 44 2c sts in LAUNCHED,
81a0: 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c 20 52 45 NOT_STARTED, RE
81b0: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 2c 20 52 MOTEHOSTSTART, R
81c0: 55 4e 4e 49 4e 47 0a 28 64 65 66 69 6e 65 20 28 UNNING.(define (
81d0: 64 62 3a 65 73 74 69 6d 61 74 65 64 2d 74 65 73 db:estimated-tes
81e0: 74 73 2d 72 65 6d 61 69 6e 69 6e 67 20 64 62 20 ts-remaining db
81f0: 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 run-id). (let (
8200: 28 72 65 73 20 30 29 29 0a 20 20 20 20 28 73 71 (res 0)). (sq
8210: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
8220: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
8230: 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 20 28 (count). (
8240: 73 65 74 21 20 72 65 73 20 63 6f 75 6e 74 29 29 set! res count))
8250: 0a 20 20 20 20 20 64 62 20 3b 3b 20 4e 42 2f 2f . db ;; NB//
8260: 20 4b 49 4c 4c 52 45 51 20 6d 65 61 6e 73 20 74 KILLREQ means t
8270: 68 65 20 6a 6f 62 73 20 69 73 20 73 74 69 6c 6c he jobs is still
8280: 20 70 72 6f 62 61 62 6c 79 20 72 75 6e 6e 69 6e probably runnin
8290: 67 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 63 g. "SELECT c
82a0: 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 ount(id) FROM te
82b0: 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 20 sts WHERE state
82c0: 69 6e 20 28 27 4c 41 55 4e 43 48 45 44 27 2c 27 in ('LAUNCHED','
82d0: 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 52 45 NOT_STARTED','RE
82e0: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 2c 27 MOTEHOSTSTART','
82f0: 52 55 4e 4e 49 4e 47 27 2c 27 4b 49 4c 4c 52 45 RUNNING','KILLRE
8300: 51 27 29 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f Q') AND run_id=?
8310: 3b 22 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 ;" run-id). r
8320: 65 73 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 75 6e es))..;; map run
8330: 2d 69 64 2c 20 74 65 73 74 6e 61 6d 65 20 69 74 -id, testname it
8340: 65 6d 2d 70 61 74 68 20 74 6f 20 74 65 73 74 2d em-path to test-
8350: 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 id.(define (db:g
8360: 65 74 2d 74 65 73 74 2d 69 64 2d 63 61 63 68 65 et-test-id-cache
8370: 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 d db run-id test
8380: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a name item-path).
8390: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6b (let* ((test-k
83a0: 65 79 20 28 63 6f 6e 63 20 72 75 6e 2d 69 64 20 ey (conc run-id
83b0: 22 2d 22 20 74 65 73 74 6e 61 6d 65 20 22 2d 22 "-" testname "-"
83c0: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 item-path)).. (
83d0: 72 65 73 20 20 20 20 20 20 28 68 61 73 68 2d 74 res (hash-t
83e0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
83f0: 20 2a 74 65 73 74 2d 69 64 73 2a 20 74 65 73 74 *test-ids* test
8400: 2d 6b 65 79 20 23 66 29 29 29 0a 20 20 20 20 28 -key #f))). (
8410: 69 66 20 72 65 73 20 0a 09 72 65 73 0a 09 28 62 if res ..res..(b
8420: 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 egin.. (sqlite3
8430: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 :for-each-row..
8440: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 20 3b (lambda (id) ;
8450: 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 ; run-id testna
8460: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
8470: 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 event-time host
8480: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
8490: 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 uname rundir it
84a0: 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 em-path run_dura
84b0: 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 tion final_logf
84c0: 63 6f 6d 6d 65 6e 74 20 29 0a 09 20 20 20 20 20 comment )..
84d0: 28 73 65 74 21 20 72 65 73 20 69 64 29 29 20 3b (set! res id)) ;
84e0: 3b 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e ; (vector id run
84f0: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 -id testname sta
8500: 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d te status event-
8510: 74 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 time host cpuloa
8520: 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 d diskfree uname
8530: 20 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 rundir item-pat
8540: 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 h run_duration f
8550: 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e inal_logf commen
8560: 74 20 29 29 29 0a 09 20 20 20 64 62 20 0a 09 20 t ))).. db ..
8570: 20 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f "SELECT id FRO
8580: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 M tests WHERE ru
8590: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
85a0: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
85b0: 61 74 68 3d 3f 3b 22 0a 09 20 20 20 72 75 6e 2d ath=?;".. run-
85c0: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
85d0: 2d 70 61 74 68 29 0a 09 20 20 28 68 61 73 68 2d -path).. (hash-
85e0: 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 74 table-set! *test
85f0: 2d 69 64 73 2a 20 74 65 73 74 2d 6b 65 79 20 72 -ids* test-key r
8600: 65 73 29 0a 09 20 20 72 65 73 29 29 29 29 0a 0a es).. res))))..
8610: 3b 3b 20 6d 61 70 20 72 75 6e 2d 69 64 2c 20 74 ;; map run-id, t
8620: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
8630: 68 20 74 6f 20 74 65 73 74 2d 69 64 0a 28 64 65 h to test-id.(de
8640: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 fine (db:get-tes
8650: 74 2d 69 64 2d 6e 6f 74 2d 63 61 63 68 65 64 20 t-id-not-cached
8660: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
8670: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 me item-path).
8680: 28 6c 65 74 2a 20 28 28 72 65 73 20 23 66 29 29 (let* ((res #f))
8690: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
86a0: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
86b0: 28 6c 61 6d 62 64 61 20 28 69 64 29 20 3b 3b 20 (lambda (id) ;;
86c0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
86d0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
86e0: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
86f0: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
8700: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d name rundir item
8710: 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 -path run_durati
8720: 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f on final_logf co
8730: 6d 6d 65 6e 74 20 29 0a 20 20 20 20 20 20 20 28 mment ). (
8740: 73 65 74 21 20 72 65 73 20 69 64 29 29 20 3b 3b set! res id)) ;;
8750: 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d (vector id run-
8760: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
8770: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
8780: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
8790: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
87a0: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
87b0: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 run_duration fi
87c0: 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 nal_logf comment
87d0: 20 29 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 ))). db .
87e0: 20 20 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 "SELECT id FR
87f0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 OM tests WHERE r
8800: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
8810: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
8820: 70 61 74 68 3d 3f 3b 22 0a 20 20 20 20 20 72 75 path=?;". ru
8830: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 n-id testname it
8840: 65 6d 2d 70 61 74 68 29 0a 20 20 20 20 72 65 73 em-path). res
8850: 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 62 3a 67 ))..(define db:g
8860: 65 74 2d 74 65 73 74 2d 69 64 20 64 62 3a 67 65 et-test-id db:ge
8870: 74 2d 74 65 73 74 2d 69 64 2d 63 61 63 68 65 64 t-test-id-cached
8880: 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 74 65 )..;; given a te
8890: 73 74 2d 69 6e 66 6f 20 72 65 63 6f 72 64 2c 20 st-info record,
88a0: 70 61 74 63 68 20 69 6e 20 74 68 65 20 6c 61 74 patch in the lat
88b0: 65 73 74 20 64 61 74 61 20 66 72 6f 6d 20 74 68 est data from th
88c0: 65 20 74 65 73 74 64 61 74 2e 64 62 20 66 69 6c e testdat.db fil
88d0: 65 0a 3b 3b 20 66 6f 75 6e 64 20 69 6e 20 74 68 e.;; found in th
88e0: 65 20 74 65 73 74 20 72 75 6e 20 64 69 72 65 63 e test run direc
88f0: 74 6f 72 79 0a 28 64 65 66 69 6e 65 20 28 64 62 tory.(define (db
8900: 3a 70 61 74 63 68 2d 74 64 62 2d 64 61 74 61 2d :patch-tdb-data-
8910: 69 6e 74 6f 2d 74 65 73 74 2d 69 6e 66 6f 20 64 into-test-info d
8920: 62 20 74 65 73 74 2d 69 64 20 72 65 73 29 0a 20 b test-id res).
8930: 20 28 6c 65 74 20 28 28 74 64 62 20 28 64 62 3a (let ((tdb (db:
8940: 6f 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d open-test-db-by-
8950: 74 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d test-id db test-
8960: 69 64 29 29 29 0a 20 20 20 20 3b 3b 20 67 65 74 id))). ;; get
8970: 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 state and statu
8980: 73 20 66 72 6f 6d 20 6d 65 67 61 74 65 73 74 2e s from megatest.
8990: 64 62 20 69 6e 20 72 65 61 6c 20 74 69 6d 65 0a db in real time.
89a0: 20 20 20 20 3b 3b 20 6f 74 68 65 72 20 66 69 65 ;; other fie
89b0: 6c 64 73 20 74 68 61 74 20 70 65 72 68 61 70 73 lds that perhaps
89c0: 20 73 68 6f 75 6c 64 20 62 65 20 75 70 64 61 74 should be updat
89d0: 65 64 3a 0a 20 20 20 20 3b 3b 20 20 20 66 61 69 ed:. ;; fai
89e0: 6c 5f 63 6f 75 6e 74 0a 20 20 20 20 3b 3b 20 20 l_count. ;;
89f0: 20 70 61 73 73 5f 63 6f 75 6e 74 0a 20 20 20 20 pass_count.
8a00: 3b 3b 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 0a ;; final_logf.
8a10: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
8a20: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
8a30: 6c 61 6d 62 64 61 20 28 73 74 61 74 65 20 73 74 lambda (state st
8a40: 61 74 75 73 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 atus final_logf)
8a50: 0a 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 . (db:test
8a60: 2d 73 65 74 2d 73 74 61 74 65 21 20 20 20 20 20 -set-state!
8a70: 20 20 20 72 65 73 20 73 74 61 74 65 29 0a 20 20 res state).
8a80: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 (db:test-se
8a90: 74 2d 73 74 61 74 75 73 21 20 20 20 20 20 20 20 t-status!
8aa0: 72 65 73 20 73 74 61 74 75 73 29 0a 20 20 20 20 res status).
8ab0: 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d (db:test-set-
8ac0: 66 69 6e 61 6c 5f 6c 6f 67 66 21 20 20 20 72 65 final_logf! re
8ad0: 73 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 29 0a 20 s final_logf)).
8ae0: 20 20 20 20 64 62 0a 20 20 20 20 20 22 53 45 4c db. "SEL
8af0: 45 43 54 20 73 74 61 74 65 2c 73 74 61 74 75 73 ECT state,status
8b00: 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d ,final_logf FROM
8b10: 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d tests WHERE id=
8b20: 3f 3b 22 0a 20 20 20 20 20 74 65 73 74 2d 69 64 ?;". test-id
8b30: 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 ). (if tdb..(
8b40: 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 begin.. (sqlite
8b50: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 3:for-each-row..
8b60: 20 20 20 28 6c 61 6d 62 64 61 20 28 75 70 64 61 (lambda (upda
8b70: 74 65 5f 74 69 6d 65 20 63 70 75 6c 6f 61 64 20 te_time cpuload
8b80: 64 69 73 6b 5f 66 72 65 65 20 72 75 6e 5f 64 75 disk_free run_du
8b90: 72 61 74 69 6f 6e 29 0a 09 20 20 20 20 20 28 64 ration).. (d
8ba0: 62 3a 74 65 73 74 2d 73 65 74 2d 63 70 75 6c 6f b:test-set-cpulo
8bb0: 61 64 21 20 20 20 20 20 20 72 65 73 20 63 70 75 ad! res cpu
8bc0: 6c 6f 61 64 29 0a 09 20 20 20 20 20 28 64 62 3a load).. (db:
8bd0: 74 65 73 74 2d 73 65 74 2d 64 69 73 6b 66 72 65 test-set-diskfre
8be0: 65 21 20 20 20 20 20 72 65 73 20 64 69 73 6b 5f e! res disk_
8bf0: 66 72 65 65 29 0a 09 20 20 20 20 20 28 64 62 3a free).. (db:
8c00: 74 65 73 74 2d 73 65 74 2d 72 75 6e 5f 64 75 72 test-set-run_dur
8c10: 61 74 69 6f 6e 21 20 72 65 73 20 72 75 6e 5f 64 ation! res run_d
8c20: 75 72 61 74 69 6f 6e 29 29 0a 09 20 20 20 74 64 uration)).. td
8c30: 62 0a 09 20 20 20 22 53 45 4c 45 43 54 20 75 70 b.. "SELECT up
8c40: 64 61 74 65 5f 74 69 6d 65 2c 63 70 75 6c 6f 61 date_time,cpuloa
8c50: 64 2c 64 69 73 6b 66 72 65 65 2c 72 75 6e 5f 64 d,diskfree,run_d
8c60: 75 72 61 74 69 6f 6e 20 46 52 4f 4d 20 74 65 73 uration FROM tes
8c70: 74 5f 72 75 6e 64 61 74 20 4f 52 44 45 52 20 42 t_rundat ORDER B
8c80: 59 20 69 64 20 44 45 53 43 20 4c 49 4d 49 54 20 Y id DESC LIMIT
8c90: 31 3b 22 29 0a 09 20 20 28 73 71 6c 69 74 65 33 1;").. (sqlite3
8ca0: 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 29 :finalize! tdb))
8cb0: 0a 09 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 ..;; if the test
8cc0: 20 64 62 20 69 73 20 6e 6f 74 20 66 6f 75 6e 64 db is not found
8cd0: 20 77 68 61 74 20 74 6f 20 64 6f 3f 0a 09 3b 3b what to do?..;;
8ce0: 20 31 2e 20 73 65 74 20 73 74 61 74 65 20 74 6f 1. set state to
8cf0: 20 44 45 4c 45 54 45 44 0a 09 3b 3b 20 32 2e 20 DELETED..;; 2.
8d00: 73 65 74 20 73 74 61 74 75 73 20 74 6f 20 6e 2f set status to n/
8d10: 61 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 62 a..(begin.. (db
8d20: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 21 :test-set-state!
8d30: 20 20 72 65 73 20 22 4e 4f 54 5f 53 54 41 52 54 res "NOT_START
8d40: 45 44 22 29 0a 09 20 20 28 64 62 3a 74 65 73 74 ED").. (db:test
8d50: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 65 73 -set-status! res
8d60: 20 22 6e 2f 61 22 29 29 29 29 29 0a 0a 28 64 65 "n/a")))))..(de
8d70: 66 69 6e 65 20 2a 6c 61 73 74 2d 74 65 73 74 2d fine *last-test-
8d80: 63 61 63 68 65 2d 64 65 6c 65 74 65 2a 20 28 63 cache-delete* (c
8d90: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
8da0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 63 6c ..(define (db:cl
8db0: 65 61 6e 2d 61 6c 6c 2d 63 61 63 68 65 73 29 0a ean-all-caches).
8dc0: 20 20 28 73 65 74 21 20 2a 74 65 73 74 2d 69 6e (set! *test-in
8dd0: 66 6f 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 fo* (make-hash-t
8de0: 61 62 6c 65 29 29 0a 20 20 28 73 65 74 21 20 2a able)). (set! *
8df0: 74 65 73 74 2d 69 64 2d 63 61 63 68 65 2a 20 28 test-id-cache* (
8e00: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
8e10: 29 29 0a 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 ))..;; Get test
8e20: 64 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f data using test_
8e30: 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 id.(define (db:g
8e40: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 63 61 63 et-test-info-cac
8e50: 68 65 64 2d 62 79 2d 69 64 20 64 62 20 74 65 73 hed-by-id db tes
8e60: 74 2d 69 64 29 0a 20 20 3b 3b 20 69 73 20 61 6c t-id). ;; is al
8e70: 6c 20 74 68 69 73 20 63 72 61 70 20 72 65 61 6c l this crap real
8e80: 6c 79 20 77 6f 72 74 68 20 69 74 3f 20 49 20 73 ly worth it? I s
8e90: 6f 6d 65 68 6f 77 20 64 6f 75 62 74 20 69 74 2e omehow doubt it.
8ea0: 0a 20 20 28 6c 65 74 2a 20 28 28 6c 61 73 74 2d . (let* ((last-
8eb0: 64 65 6c 65 74 65 2d 73 74 72 20 28 64 62 3a 67 delete-str (db:g
8ec0: 65 74 2d 76 61 72 20 64 62 20 22 44 45 4c 45 54 et-var db "DELET
8ed0: 45 44 5f 54 45 53 54 53 22 29 29 0a 09 20 28 6c ED_TESTS")).. (l
8ee0: 61 73 74 2d 64 65 6c 65 74 65 20 20 20 20 20 28 ast-delete (
8ef0: 69 66 20 28 73 74 72 69 6e 67 3f 20 6c 61 73 74 if (string? last
8f00: 2d 64 65 6c 65 74 65 2d 73 74 72 29 28 73 74 72 -delete-str)(str
8f10: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6c 61 73 74 ing->number last
8f20: 2d 64 65 6c 65 74 65 2d 73 74 72 29 20 23 66 29 -delete-str) #f)
8f30: 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 )). (if (and
8f40: 6c 61 73 74 2d 64 65 6c 65 74 65 20 28 3e 20 6c last-delete (> l
8f50: 61 73 74 2d 64 65 6c 65 74 65 20 2a 6c 61 73 74 ast-delete *last
8f60: 2d 74 65 73 74 2d 63 61 63 68 65 2d 64 65 6c 65 -test-cache-dele
8f70: 74 65 2a 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 te*))..(begin..
8f80: 20 28 73 65 74 21 20 2a 74 65 73 74 2d 69 6e 66 (set! *test-inf
8f90: 6f 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 o* (make-hash-ta
8fa0: 62 6c 65 29 29 0a 09 20 20 28 73 65 74 21 20 2a ble)).. (set! *
8fb0: 74 65 73 74 2d 69 64 2d 63 61 63 68 65 2a 20 28 test-id-cache* (
8fc0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
8fd0: 29 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 73 74 ).. (set! *last
8fe0: 2d 74 65 73 74 2d 63 61 63 68 65 2d 64 65 6c 65 -test-cache-dele
8ff0: 74 65 2a 20 6c 61 73 74 2d 64 65 6c 65 74 65 29 te* last-delete)
9000: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
9010: 20 34 20 22 49 4e 46 4f 3a 20 43 6c 65 61 72 69 4 "INFO: Cleari
9020: 6e 67 20 74 65 73 74 20 64 61 74 61 20 63 61 63 ng test data cac
9030: 68 65 22 29 29 29 29 0a 20 20 28 69 66 20 28 6e he")))). (if (n
9040: 6f 74 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 ot test-id).
9050: 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 75 67 (begin..(debug
9060: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
9070: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
9080: 2d 62 79 2d 69 64 20 63 61 6c 6c 65 64 20 77 69 -by-id called wi
9090: 74 68 20 74 65 73 74 2d 69 64 3d 22 20 74 65 73 th test-id=" tes
90a0: 74 2d 69 64 29 0a 09 23 66 29 0a 20 20 20 20 20 t-id)..#f).
90b0: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 28 68 61 (let* ((res (ha
90c0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
90d0: 61 75 6c 74 20 2a 74 65 73 74 2d 69 6e 66 6f 2a ault *test-info*
90e0: 20 74 65 73 74 2d 69 64 20 23 66 29 29 29 0a 09 test-id #f)))..
90f0: 28 69 66 20 28 61 6e 64 20 72 65 73 0a 09 09 20 (if (and res...
9100: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
9110: 2d 67 65 74 2d 73 74 61 74 65 20 72 65 73 29 20 -get-state res)
9120: 27 28 22 52 55 4e 4e 49 4e 47 22 20 22 43 4f 4d '("RUNNING" "COM
9130: 50 4c 45 54 45 44 22 29 29 29 0a 09 20 20 20 20 PLETED")))..
9140: 28 64 62 3a 70 61 74 63 68 2d 74 64 62 2d 64 61 (db:patch-tdb-da
9150: 74 61 2d 69 6e 74 6f 2d 74 65 73 74 2d 69 6e 66 ta-into-test-inf
9160: 6f 20 64 62 20 74 65 73 74 2d 69 64 20 72 65 73 o db test-id res
9170: 29 0a 09 20 20 20 20 3b 3b 20 69 66 20 6e 6f 20 ).. ;; if no
9180: 63 61 63 68 65 64 20 76 61 6c 75 65 20 74 68 65 cached value the
9190: 6e 20 66 75 6c 6c 20 72 65 61 64 20 61 6e 64 20 n full read and
91a0: 77 72 69 74 65 20 74 6f 20 63 61 63 68 65 0a 09 write to cache..
91b0: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
91c0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
91d0: 61 63 68 2d 72 6f 77 0a 09 20 20 20 20 20 20 20 ach-row..
91e0: 28 6c 61 6d 62 64 61 20 28 69 64 20 72 75 6e 2d (lambda (id run-
91f0: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
9200: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
9210: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
9220: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
9230: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
9240: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 run_duration fi
9250: 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 nal_logf comment
9260: 29 0a 09 09 20 3b 3b 20 20 20 20 20 20 20 20 20 )... ;;
9270: 20 20 20 20 20 20 20 20 30 20 20 20 20 31 20 20 0 1
9280: 20 20 20 20 20 32 20 20 20 20 20 20 33 20 20 20 2 3
9290: 20 20 20 34 20 20 20 20 20 20 20 20 35 20 20 20 4 5
92a0: 20 20 20 20 36 20 20 20 20 20 20 37 20 20 20 20 6 7
92b0: 20 20 20 20 38 20 20 20 20 20 39 20 20 20 20 20 8 9
92c0: 31 30 20 20 20 20 20 20 31 31 20 20 20 20 20 20 10 11
92d0: 20 20 20 20 31 32 20 20 20 20 20 20 20 20 20 20 12
92e0: 31 33 20 20 20 20 20 20 20 31 34 0a 09 09 20 28 13 14... (
92f0: 73 65 74 21 20 72 65 73 20 28 76 65 63 74 6f 72 set! res (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 29 29 29 0a 09 20 20 20 comment)))..
9380: 20 20 20 20 64 62 20 0a 09 20 20 20 20 20 20 20 db ..
9390: 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e 5f 69 "SELECT id,run_i
93a0: 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 d,testname,state
93b0: 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 ,status,event_ti
93c0: 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c me,host,cpuload,
93d0: 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 diskfree,uname,r
93e0: 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c undir,item_path,
93f0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e run_duration,fin
9400: 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 al_logf,comment
9410: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
9420: 20 69 64 3d 3f 3b 22 0a 09 20 20 20 20 20 20 20 id=?;"..
9430: 74 65 73 74 2d 69 64 29 0a 09 20 20 20 20 20 20 test-id)..
9440: 28 69 66 20 72 65 73 20 28 64 62 3a 70 61 74 63 (if res (db:patc
9450: 68 2d 74 64 62 2d 64 61 74 61 2d 69 6e 74 6f 2d h-tdb-data-into-
9460: 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 74 65 73 test-info db tes
9470: 74 2d 69 64 20 72 65 73 29 29 0a 09 20 20 20 20 t-id res))..
9480: 20 20 72 65 73 29 29 29 29 29 0a 0a 3b 3b 20 47 res)))))..;; G
9490: 65 74 20 74 65 73 74 20 64 61 74 61 20 75 73 69 et test data usi
94a0: 6e 67 20 74 65 73 74 5f 69 64 0a 28 64 65 66 69 ng test_id.(defi
94b0: 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d ne (db:get-test-
94c0: 69 6e 66 6f 2d 6e 6f 74 2d 63 61 63 68 65 64 2d info-not-cached-
94d0: 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 by-id db test-id
94e0: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 ). (if (not tes
94f0: 74 2d 69 64 29 0a 20 20 20 20 20 20 28 62 65 67 t-id). (beg
9500: 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 in..(debug:print
9510: 20 34 20 22 49 4e 46 4f 3a 20 64 62 3a 67 65 74 4 "INFO: db:get
9520: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
9530: 20 63 61 6c 6c 65 64 20 77 69 74 68 20 74 65 73 called with tes
9540: 74 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 29 0a t-id=" test-id).
9550: 09 23 66 29 0a 20 20 20 20 20 20 28 6c 65 74 20 .#f). (let
9560: 28 28 72 65 73 20 23 66 29 29 0a 09 28 73 71 6c ((res #f))..(sql
9570: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
9580: 77 0a 09 20 28 6c 61 6d 62 64 61 20 28 69 64 20 w.. (lambda (id
9590: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
95a0: 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 state status eve
95b0: 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 nt-time host cpu
95c0: 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e load diskfree un
95d0: 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d ame rundir item-
95e0: 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f path run_duratio
95f0: 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d n final_logf com
9600: 6d 65 6e 74 29 0a 09 20 20 20 3b 3b 20 20 20 20 ment).. ;;
9610: 20 20 20 20 20 20 20 20 20 20 20 20 20 30 20 20 0
9620: 20 20 31 20 20 20 20 20 20 20 32 20 20 20 20 20 1 2
9630: 20 33 20 20 20 20 20 20 34 20 20 20 20 20 20 20 3 4
9640: 20 35 20 20 20 20 20 20 20 36 20 20 20 20 20 20 5 6
9650: 37 20 20 20 20 20 20 20 20 38 20 20 20 20 20 39 7 8 9
9660: 20 20 20 20 20 31 30 20 20 20 20 20 20 31 31 20 10 11
9670: 20 20 20 20 20 20 20 20 20 31 32 20 20 20 20 20 12
9680: 20 20 20 20 20 31 33 20 20 20 20 20 20 20 31 34 13 14
9690: 0a 09 20 20 20 28 73 65 74 21 20 72 65 73 20 28 .. (set! res (
96a0: 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 vector id run-id
96b0: 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 testname state
96c0: 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d status event-tim
96d0: 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 e host cpuload d
96e0: 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 iskfree uname ru
96f0: 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 72 ndir item-path r
9700: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 un_duration fina
9710: 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 29 l_logf comment))
9720: 29 0a 09 20 64 62 20 0a 09 20 22 53 45 4c 45 43 ).. db .. "SELEC
9730: 54 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 T id,run_id,test
9740: 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 name,state,statu
9750: 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 s,event_time,hos
9760: 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 t,cpuload,diskfr
9770: 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c ee,uname,rundir,
9780: 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 item_path,run_du
9790: 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 ration,final_log
97a0: 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 f,comment FROM t
97b0: 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 3b ests WHERE id=?;
97c0: 22 0a 09 20 74 65 73 74 2d 69 64 29 0a 09 72 65 ".. test-id)..re
97d0: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 62 s)))..(define db
97e0: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
97f0: 79 2d 69 64 20 64 62 3a 67 65 74 2d 74 65 73 74 y-id db:get-test
9800: 2d 69 6e 66 6f 2d 6e 6f 74 2d 63 61 63 68 65 64 -info-not-cached
9810: 2d 62 79 2d 69 64 29 0a 0a 28 64 65 66 69 6e 65 -by-id)..(define
9820: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e (db:get-test-in
9830: 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 fo db run-id tes
9840: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 tname item-path)
9850: 0a 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d . (db:get-test-
9860: 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 20 28 64 info-by-id db (d
9870: 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 b:get-test-id db
9880: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
9890: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 28 item-path)))..(
98a0: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
98b0: 73 65 74 2d 63 6f 6d 6d 65 6e 74 20 64 62 20 74 set-comment db t
98c0: 65 73 74 2d 69 64 20 63 6f 6d 6d 65 6e 74 29 0a est-id comment).
98d0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
98e0: 74 65 20 0a 20 20 20 64 62 20 0a 20 20 20 22 55 te . db . "U
98f0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
9900: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
9910: 69 64 3d 3f 3b 22 0a 20 20 20 63 6f 6d 6d 65 6e id=?;". commen
9920: 74 20 74 65 73 74 2d 69 64 29 29 0a 0a 3b 3b 0a t test-id))..;;.
9930: 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
9940: 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 64 62 20 -set-rundir! db
9950: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
9960: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 64 69 item-path rundi
9970: 72 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 r). (sqlite3:ex
9980: 65 63 75 74 65 20 0a 20 20 20 64 62 20 0a 20 20 ecute . db .
9990: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
99a0: 45 54 20 72 75 6e 64 69 72 3d 3f 20 57 48 45 52 ET rundir=? WHER
99b0: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
99c0: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
99d0: 65 6d 5f 70 61 74 68 3d 3f 3b 22 0a 20 20 20 72 em_path=?;". r
99e0: 75 6e 64 69 72 20 72 75 6e 2d 69 64 20 74 65 73 undir run-id tes
99f0: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
9a00: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
9a10: 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d test-set-rundir-
9a20: 62 79 2d 74 65 73 74 2d 69 64 21 20 64 62 20 74 by-test-id! db t
9a30: 65 73 74 2d 69 64 20 72 75 6e 64 69 72 29 0a 20 est-id rundir).
9a40: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
9a50: 65 20 0a 20 20 20 64 62 20 0a 20 20 20 22 55 50 e . db . "UP
9a60: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 72 DATE tests SET r
9a70: 75 6e 64 69 72 3d 3f 20 57 48 45 52 45 20 69 64 undir=? WHERE id
9a80: 3d 3f 22 0a 20 20 20 72 75 6e 64 69 72 20 74 65 =?". rundir te
9a90: 73 74 2d 69 64 29 29 0a 0a 3b 3b 20 0a 28 64 65 st-id))..;; .(de
9aa0: 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 fine (db:test-ge
9ab0: 74 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 t-rundir-from-te
9ac0: 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 st-id db test-id
9ad0: 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 28 ). (let ((res (
9ae0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
9af0: 65 66 61 75 6c 74 20 2a 74 65 73 74 2d 70 61 74 efault *test-pat
9b00: 68 73 2a 20 74 65 73 74 2d 69 64 20 23 66 29 29 hs* test-id #f))
9b10: 29 0a 20 20 20 20 28 69 66 20 72 65 73 0a 09 72 ). (if res..r
9b20: 65 73 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 es..(begin.. (s
9b30: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
9b40: 72 6f 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 row.. (lambda
9b50: 28 74 70 61 74 68 29 0a 09 20 20 20 20 20 28 73 (tpath).. (s
9b60: 65 74 21 20 72 65 73 20 74 70 61 74 68 29 29 0a et! res tpath)).
9b70: 09 20 20 20 64 62 20 0a 09 20 20 20 22 53 45 4c . db .. "SEL
9b80: 45 43 54 20 72 75 6e 64 69 72 20 46 52 4f 4d 20 ECT rundir FROM
9b90: 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f tests WHERE id=?
9ba0: 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 64 29 0a ;".. test-id).
9bb0: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
9bc0: 65 74 21 20 2a 74 65 73 74 2d 70 61 74 68 73 2a et! *test-paths*
9bd0: 20 74 65 73 74 2d 69 64 20 72 65 73 29 0a 09 20 test-id res)..
9be0: 20 72 65 73 29 29 29 29 0a 0a 28 64 65 66 69 6e res))))..(defin
9bf0: 65 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c e (db:test-set-l
9c00: 6f 67 21 20 64 62 20 74 65 73 74 2d 69 64 20 6c og! db test-id l
9c10: 6f 67 66 29 0a 20 20 28 69 66 20 28 73 74 72 69 ogf). (if (stri
9c20: 6e 67 3f 20 6c 6f 67 66 29 0a 20 20 20 20 20 20 ng? logf).
9c30: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
9c40: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
9c50: 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 s SET final_logf
9c60: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 0a =? WHERE id=?;".
9c70: 09 09 20 20 20 20 20 20 20 6c 6f 67 66 20 74 65 .. logf te
9c80: 73 74 2d 69 64 29 0a 20 20 20 20 20 20 28 64 65 st-id). (de
9c90: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
9ca0: 4f 52 3a 20 64 62 3a 74 65 73 74 2d 73 65 74 2d OR: db:test-set-
9cb0: 6c 6f 67 21 20 63 61 6c 6c 65 64 20 77 69 74 68 log! called with
9cc0: 20 6e 6f 6e 2d 73 74 72 69 6e 67 20 6c 6f 67 20 non-string log
9cd0: 66 69 6c 65 20 6e 61 6d 65 20 22 20 6c 6f 67 66 file name " logf
9ce0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
9cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
9d30: 20 4d 69 73 63 2e 20 74 65 73 74 20 72 65 6c 61 Misc. test rela
9d40: 74 65 64 20 71 75 65 72 69 65 73 0a 3b 3b 3d 3d ted queries.;;==
9d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9d90: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 ====..(define (d
9da0: 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 b:test-get-paths
9db0: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
9dc0: 6e 61 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 names target fna
9dd0: 6d 65 70 61 74 74 20 23 21 6b 65 79 20 28 72 65 mepatt #!key (re
9de0: 73 20 27 28 29 29 29 0a 20 20 28 6c 65 74 2a 20 s '())). (let*
9df0: 28 28 74 65 73 74 70 61 74 74 20 20 20 28 69 66 ((testpatt (if
9e00: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
9e10: 2d 74 65 73 74 70 61 74 74 22 29 28 61 72 67 73 -testpatt")(args
9e20: 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 :get-arg "-testp
9e30: 61 74 74 22 29 20 22 25 22 29 29 0a 09 20 28 73 att") "%")).. (s
9e40: 74 61 74 65 70 61 74 74 20 20 28 69 66 20 28 61 tatepatt (if (a
9e50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 rgs:get-arg ":st
9e60: 61 74 65 22 29 20 20 20 28 61 72 67 73 3a 67 65 ate") (args:ge
9e70: 74 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 t-arg ":state")
9e80: 20 20 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 "%")).. (stat
9e90: 75 73 70 61 74 74 20 28 69 66 20 28 61 72 67 73 uspatt (if (args
9ea0: 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 :get-arg ":statu
9eb0: 73 22 29 20 20 28 61 72 67 73 3a 67 65 74 2d 61 s") (args:get-a
9ec0: 72 67 20 22 3a 73 74 61 74 75 73 22 29 20 20 20 rg ":status")
9ed0: 22 25 22 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 "%")).. (runname
9ee0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
9ef0: 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 t-arg ":runname"
9f00: 29 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ) (args:get-arg
9f10: 22 3a 72 75 6e 6e 61 6d 65 22 29 20 20 22 25 22 ":runname") "%"
9f20: 29 29 0a 09 20 28 6b 65 79 73 74 72 20 28 73 74 )).. (keystr (st
9f30: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
9f40: 20 0a 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 ... (map (lamb
9f50: 64 61 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 da (key val)....
9f60: 20 28 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 (conc "r." key
9f70: 22 20 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 27 " like '" val "'
9f80: 22 29 29 0a 09 09 20 20 20 20 20 20 20 6b 65 79 "))... key
9f90: 6e 61 6d 65 73 20 0a 09 09 20 20 20 20 20 20 20 names ...
9fa0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 (string-split ta
9fb0: 72 67 65 74 20 22 2f 22 29 29 0a 09 09 20 20 22 rget "/"))... "
9fc0: 20 41 4e 44 20 22 29 29 0a 09 20 28 74 65 73 74 AND ")).. (test
9fd0: 71 72 79 20 28 74 65 73 74 73 3a 6d 61 74 63 68 qry (tests:match
9fe0: 2d 3e 73 71 6c 71 72 79 20 74 65 73 74 70 61 74 ->sqlqry testpat
9ff0: 74 29 29 0a 09 20 28 71 72 79 73 74 72 20 28 63 t)).. (qrystr (c
a000: 6f 6e 63 20 22 53 45 4c 45 43 54 20 74 2e 72 75 onc "SELECT t.ru
a010: 6e 64 69 72 20 46 52 4f 4d 20 74 65 73 74 73 20 ndir FROM tests
a020: 41 53 20 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 AS t INNER JOIN
a030: 72 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 runs AS r ON t.r
a040: 75 6e 5f 69 64 3d 72 2e 69 64 20 57 48 45 52 45 un_id=r.id WHERE
a050: 20 22 0a 09 09 20 20 20 20 20 20 20 6b 65 79 73 "... keys
a060: 74 72 20 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 tr " AND r.runna
a070: 6d 65 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 me LIKE '" runna
a080: 6d 65 20 22 27 20 41 4e 44 20 22 20 74 65 73 74 me "' AND " test
a090: 71 72 79 0a 09 09 20 20 20 20 20 20 20 22 20 41 qry... " A
a0a0: 4e 44 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 ND t.state LIKE
a0b0: 27 22 20 73 74 61 74 65 70 61 74 74 20 22 27 20 '" statepatt "'
a0c0: 41 4e 44 20 74 2e 73 74 61 74 75 73 20 4c 49 4b AND t.status LIK
a0d0: 45 20 27 22 20 73 74 61 74 75 73 70 61 74 74 20 E '" statuspatt
a0e0: 0a 09 09 20 20 20 20 20 20 20 22 27 20 4f 52 44 ... "' ORD
a0f0: 45 52 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 ER BY t.event_ti
a100: 6d 65 20 41 53 43 3b 22 29 29 29 0a 20 20 20 20 me ASC;"))).
a110: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 20 22 (debug:print 3 "
a120: 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 qrystr: " qrystr
a130: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
a140: 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 or-each-row .
a150: 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 20 20 (lambda (p).
a160: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
a170: 63 6f 6e 73 20 70 20 72 65 73 29 29 29 0a 20 20 cons p res))).
a180: 20 20 20 64 62 20 0a 20 20 20 20 20 71 72 79 73 db . qrys
a190: 74 72 29 0a 20 20 20 20 28 69 66 20 66 6e 61 6d tr). (if fnam
a1a0: 65 70 61 74 74 0a 09 28 61 70 70 6c 79 20 61 70 epatt..(apply ap
a1b0: 70 65 6e 64 20 0a 09 20 20 20 20 20 20 20 28 6d pend .. (m
a1c0: 61 70 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 ap (lambda (p)..
a1d0: 09 20 20 20 20 20 20 28 67 6c 6f 62 20 28 63 6f . (glob (co
a1e0: 6e 63 20 70 20 22 2f 22 20 66 6e 61 6d 65 70 61 nc p "/" fnamepa
a1f0: 74 74 29 29 29 0a 09 09 20 20 20 20 72 65 73 29 tt)))... res)
a200: 29 0a 09 72 65 73 29 29 29 0a 0a 3b 3b 20 6c 6f )..res)))..;; lo
a210: 6f 6b 20 74 68 72 6f 75 67 68 20 74 65 73 74 73 ok through tests
a220: 20 66 72 6f 6d 20 6d 61 74 63 68 69 6e 67 20 72 from matching r
a230: 75 6e 73 20 66 6f 72 20 61 20 66 69 6c 65 0a 28 uns for a file.(
a240: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
a250: 67 65 74 2d 66 69 72 73 74 2d 70 61 74 68 2d 6d get-first-path-m
a260: 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 atching db keyna
a270: 6d 65 73 20 74 61 72 67 65 74 20 66 6e 61 6d 65 mes target fname
a280: 29 0a 20 20 3b 3b 20 5b 72 65 66 70 61 74 68 73 ). ;; [refpaths
a290: 5d 20 69 73 20 74 68 65 20 73 65 63 74 69 6f 6e ] is the section
a2a0: 20 77 68 65 72 65 20 72 65 66 65 72 65 6e 63 65 where reference
a2b0: 73 20 74 6f 20 6f 74 68 65 72 20 6d 65 67 61 74 s to other megat
a2c0: 65 73 74 20 64 61 74 61 62 61 73 65 73 20 61 72 est databases ar
a2d0: 65 20 73 74 6f 72 65 64 0a 20 20 28 6c 65 74 20 e stored. (let
a2e0: 28 28 6d 74 2d 70 61 74 68 73 20 28 63 6f 6e 66 ((mt-paths (conf
a2f0: 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 igf:get-section
a300: 22 72 65 66 70 61 74 68 73 22 29 29 0a 09 28 72 "refpaths"))..(r
a310: 65 73 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 es (db:tes
a320: 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 t-get-paths-matc
a330: 68 69 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 hing db keynames
a340: 20 74 61 72 67 65 74 20 66 6e 61 6d 65 29 29 29 target fname)))
a350: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
a360: 28 70 61 74 68 64 61 74 20 28 69 66 20 28 6e 75 (pathdat (if (nu
a370: 6c 6c 3f 20 70 61 74 68 73 29 20 23 66 20 28 63 ll? paths) #f (c
a380: 61 72 20 6d 74 2d 70 61 74 68 73 29 29 29 0a 09 ar mt-paths)))..
a390: 20 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 20 (tal
a3a0: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 74 68 73 (if (null? paths
a3b0: 29 20 27 28 29 28 63 64 72 20 6d 74 2d 70 61 74 ) '()(cdr mt-pat
a3c0: 68 73 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 hs)))). (if
a3d0: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 73 (not (null? res
a3e0: 29 29 0a 09 20 20 28 63 61 72 20 72 65 73 29 20 )).. (car res)
a3f0: 3b 3b 20 72 65 74 75 72 6e 20 66 69 72 73 74 20 ;; return first
a400: 66 6f 75 6e 64 0a 09 20 20 28 69 66 20 70 61 74 found.. (if pat
a410: 68 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 h.. (let* (
a420: 28 64 62 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 (db (open-db
a430: 20 70 61 74 68 3a 20 28 63 61 64 72 20 70 61 74 path: (cadr pat
a440: 68 64 61 74 29 29 29 0a 09 09 20 20 20 20 20 28 hdat)))... (
a450: 6e 65 77 72 65 73 20 28 64 62 3a 74 65 73 74 2d newres (db:test-
a460: 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 63 68 69 get-paths-matchi
a470: 6e 67 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 ng db keynames t
a480: 61 72 67 65 74 20 66 6e 61 6d 65 29 29 29 0a 09 arget fname)))..
a490: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 .(debug:print 4
a4a0: 22 49 4e 46 4f 3a 20 54 72 79 69 6e 67 20 22 20 "INFO: Trying "
a4b0: 28 63 61 72 20 70 61 74 68 64 61 74 29 20 22 20 (car pathdat) "
a4c0: 61 74 20 22 20 28 63 61 64 72 20 70 61 74 68 64 at " (cadr pathd
a4d0: 61 74 29 29 0a 09 09 28 73 71 6c 69 74 65 33 3a at))...(sqlite3:
a4e0: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 finalize! db)...
a4f0: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
a500: 6e 65 77 72 65 73 29 29 0a 09 09 20 20 20 20 28 newres))... (
a510: 63 61 72 20 6e 65 77 72 65 73 29 0a 09 09 20 20 car newres)...
a520: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c (if (null? tal
a530: 29 0a 09 09 09 23 66 0a 09 09 09 28 6c 6f 6f 70 )....#f....(loop
a540: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
a550: 61 6c 29 29 29 29 29 29 29 29 29 29 0a 0a 0a 28 al))))))))))...(
a560: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
a570: 67 65 74 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 get-test-records
a580: 2d 6d 61 74 63 68 69 6e 67 20 64 62 20 6b 65 79 -matching db key
a590: 6e 61 6d 65 73 20 74 61 72 67 65 74 29 0a 20 20 names target).
a5a0: 28 6c 65 74 2a 20 28 28 72 65 73 20 27 28 29 29 (let* ((res '())
a5b0: 0a 09 20 28 69 74 65 6d 70 61 74 74 20 20 20 28 .. (itempatt (
a5c0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
a5d0: 20 22 2d 69 74 65 6d 70 61 74 74 22 29 28 61 72 "-itempatt")(ar
a5e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 69 74 65 gs:get-arg "-ite
a5f0: 6d 70 61 74 74 22 29 20 22 25 22 29 29 0a 09 20 mpatt") "%"))..
a600: 28 74 65 73 74 70 61 74 74 20 20 20 28 69 66 20 (testpatt (if
a610: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
a620: 74 65 73 74 70 61 74 74 22 29 28 61 72 67 73 3a testpatt")(args:
a630: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
a640: 74 74 22 29 20 22 25 22 29 29 0a 09 20 28 73 74 tt") "%")).. (st
a650: 61 74 65 70 61 74 74 20 20 28 69 66 20 28 61 72 atepatt (if (ar
a660: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
a670: 74 65 22 29 20 20 20 28 61 72 67 73 3a 67 65 74 te") (args:get
a680: 2d 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 -arg ":state")
a690: 20 20 22 25 22 29 29 0a 09 20 28 73 74 61 74 75 "%")).. (statu
a6a0: 73 70 61 74 74 20 28 69 66 20 28 61 72 67 73 3a spatt (if (args:
a6b0: 67 65 74 2d 61 72 67 20 22 3a 73 74 61 74 75 73 get-arg ":status
a6c0: 22 29 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ") (args:get-ar
a6d0: 67 20 22 3a 73 74 61 74 75 73 22 29 20 20 20 22 g ":status") "
a6e0: 25 22 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 %")).. (runname
a6f0: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
a700: 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d 65 22 29 -arg ":runname")
a710: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
a720: 3a 72 75 6e 6e 61 6d 65 22 29 20 20 22 25 22 29 :runname") "%")
a730: 29 0a 09 20 28 6b 65 79 73 74 72 20 28 73 74 72 ).. (keystr (str
a740: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
a750: 0a 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ... (map (lambd
a760: 61 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 a (key val)....
a770: 28 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 (conc "r." key "
a780: 20 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 27 22 like '" val "'"
a790: 29 29 0a 09 09 20 20 20 20 20 20 20 6b 65 79 6e ))... keyn
a7a0: 61 6d 65 73 20 0a 09 09 20 20 20 20 20 20 20 28 ames ... (
a7b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 string-split tar
a7c0: 67 65 74 20 22 2f 22 29 29 0a 09 09 20 20 22 20 get "/"))... "
a7d0: 41 4e 44 20 22 29 29 0a 09 20 28 71 72 79 73 74 AND ")).. (qryst
a7e0: 72 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 r (conc "SELECT
a7f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a800: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 69 t.i
a810: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
a820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e t.
a830: 72 75 6e 5f 69 64 20 20 20 20 20 0a 20 20 20 20 run_id .
a840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a850: 20 20 20 20 20 20 20 20 74 2e 74 65 73 74 6e 61 t.testna
a860: 6d 65 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 me .
a870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a880: 20 20 74 2e 68 6f 73 74 20 20 20 20 20 20 20 0a t.host .
a890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8a0: 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 63 70 t.cp
a8b0: 75 6c 6f 61 64 20 20 20 20 0a 20 20 20 20 20 20 uload .
a8c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a8d0: 20 20 20 20 20 20 74 2e 64 69 73 6b 66 72 65 65 t.diskfree
a8e0: 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .
a8f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a900: 74 2e 75 6e 61 6d 65 20 20 20 20 20 20 0a 20 20 t.uname .
a910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a920: 20 20 20 20 20 20 20 20 20 20 74 2e 72 75 6e 64 t.rund
a930: 69 72 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 ir .
a940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a950: 20 20 20 20 74 2e 73 68 6f 72 74 64 69 72 20 20 t.shortdir
a960: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e t.
a980: 69 74 65 6d 5f 70 61 74 68 20 20 0a 20 20 20 20 item_path .
a990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9a0: 20 20 20 20 20 20 20 20 74 2e 73 74 61 74 65 20 t.state
a9b0: 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 20 20 .
a9c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9d0: 20 20 74 2e 73 74 61 74 75 73 20 20 20 20 20 0a t.status .
a9e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a9f0: 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 61 74 t.at
aa00: 74 65 6d 70 74 6e 75 6d 20 0a 20 20 20 20 20 20 temptnum .
aa10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa20: 20 20 20 20 20 20 74 2e 66 69 6e 61 6c 5f 6c 6f t.final_lo
aa30: 67 66 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 gf .
aa40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa50: 74 2e 6c 6f 67 64 61 74 20 20 20 20 20 0a 20 20 t.logdat .
aa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa70: 20 20 20 20 20 20 20 20 20 20 74 2e 72 75 6e 5f t.run_
aa80: 64 75 72 61 74 69 6f 0a 20 20 20 20 20 20 20 20 duratio.
aa90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaa0: 20 20 20 20 74 2e 63 6f 6d 6d 65 6e 74 20 20 20 t.comment
aab0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 2e t.
aad0: 65 76 65 6e 74 5f 74 69 6d 65 20 0a 20 20 20 20 event_time .
aae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaf0: 20 20 20 20 20 20 20 20 74 2e 66 61 69 6c 5f 63 t.fail_c
ab00: 6f 75 6e 74 20 0a 20 20 20 20 20 20 20 20 20 20 ount .
ab10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab20: 20 20 74 2e 70 61 73 73 5f 63 6f 75 6e 74 20 0a t.pass_count .
ab30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab40: 20 20 20 20 20 20 20 20 20 20 20 20 74 2e 61 72 t.ar
ab50: 63 68 69 76 65 64 20 20 20 0a 0a 0a 0a 20 46 52 chived .... FR
ab60: 4f 4d 20 74 65 73 74 73 20 41 53 20 74 20 49 4e OM tests AS t IN
ab70: 4e 45 52 20 4a 4f 49 4e 20 72 75 6e 73 20 41 53 NER JOIN runs AS
ab80: 20 72 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 r ON t.run_id=r
ab90: 2e 69 64 20 57 48 45 52 45 20 22 0a 09 09 20 20 .id WHERE "...
aba0: 20 20 20 20 20 6b 65 79 73 74 72 20 22 20 41 4e keystr " AN
abb0: 44 20 72 2e 72 75 6e 6e 61 6d 65 20 4c 49 4b 45 D r.runname LIKE
abc0: 20 27 22 20 72 75 6e 6e 61 6d 65 20 22 27 20 41 '" runname "' A
abd0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 4c 49 4b ND item_path LIK
abe0: 45 20 27 22 20 69 74 65 6d 70 61 74 74 20 22 27 E '" itempatt "'
abf0: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 20 4c 49 AND testname LI
ac00: 4b 45 20 27 22 0a 09 09 20 20 20 20 20 20 20 74 KE '"... t
ac10: 65 73 74 70 61 74 74 20 22 27 20 41 4e 44 20 74 estpatt "' AND t
ac20: 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 22 20 73 .state LIKE '" s
ac30: 74 61 74 65 70 61 74 74 20 22 27 20 41 4e 44 20 tatepatt "' AND
ac40: 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 20 27 22 t.status LIKE '"
ac50: 20 73 74 61 74 75 73 70 61 74 74 20 0a 09 09 20 statuspatt ...
ac60: 20 20 20 20 20 20 22 27 4f 52 44 45 52 20 42 59 "'ORDER BY
ac70: 20 74 2e 65 76 65 6e 74 5f 74 69 6d 65 20 41 53 t.event_time AS
ac80: 43 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 C;"))). (debu
ac90: 67 3a 70 72 69 6e 74 20 33 20 22 71 72 79 73 74 g:print 3 "qryst
aca0: 72 3a 20 22 20 71 72 79 73 74 72 29 0a 20 20 20 r: " qrystr).
acb0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
acc0: 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 ch-row . (la
acd0: 6d 62 64 61 20 28 70 29 0a 20 20 20 20 20 20 20 mbda (p).
ace0: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
acf0: 70 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 p res))). db
ad00: 20 0a 20 20 20 20 20 71 72 79 73 74 72 29 0a 20 . qrystr).
ad10: 20 20 20 72 65 73 29 29 0a 0a 3b 3b 3d 3d 3d 3d res))..;;====
ad20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ad30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ad40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ad50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ad60: 3d 3d 0a 3b 3b 20 51 55 45 55 45 20 55 50 20 4d ==.;; QUEUE UP M
ad70: 45 54 41 2c 20 54 45 53 54 20 53 54 41 54 55 53 ETA, TEST STATUS
ad80: 20 41 4e 44 20 53 54 45 50 53 0a 3b 3b 3d 3d 3d AND STEPS.;;===
ad90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ada0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
adb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
adc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
add0: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 ===..(define (db
ade0: 3a 75 70 64 61 74 65 72 29 0a 20 20 28 64 65 62 :updater). (deb
adf0: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
ae00: 3a 20 53 74 61 72 74 69 6e 67 20 63 61 63 68 65 : Starting cache
ae10: 20 70 72 6f 63 65 73 73 69 6e 67 22 29 0a 20 20 processing").
ae20: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 73 74 61 72 (let loop ((star
ae30: 74 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 2d t-time (current-
ae40: 74 69 6d 65 29 29 29 0a 20 20 20 20 28 74 68 72 time))). (thr
ae50: 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 20 3b ead-sleep! 10) ;
ae60: 3b 20 6d 6f 76 65 20 73 61 76 65 20 74 69 6d 65 ; move save time
ae70: 20 61 72 6f 75 6e 64 20 74 6f 20 6d 69 6e 69 6d around to minim
ae80: 69 7a 65 20 72 65 67 75 6c 61 72 20 63 6f 6c 6c ize regular coll
ae90: 69 73 69 6f 6e 73 3f 0a 20 20 20 20 28 64 62 3a isions?. (db:
aea0: 77 72 69 74 65 2d 63 61 63 68 65 64 2d 64 61 74 write-cached-dat
aeb0: 61 29 0a 20 20 20 20 28 6c 6f 6f 70 20 73 74 61 a). (loop sta
aec0: 72 74 2d 74 69 6d 65 29 29 29 0a 0a 28 64 65 66 rt-time)))..(def
aed0: 69 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 73 65 ine (cdb:test-se
aee0: 74 2d 73 74 61 74 75 73 2d 73 74 61 74 65 20 74 t-status-state t
aef0: 65 73 74 2d 69 64 20 73 74 61 74 75 73 20 73 74 est-id status st
af00: 61 74 65 20 6d 73 67 29 0a 20 20 28 64 65 62 75 ate msg). (debu
af10: 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a g:print 4 "INFO:
af20: 20 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 cdb:test-set-st
af30: 61 74 75 73 2d 73 74 61 74 65 20 74 65 73 74 2d atus-state test-
af40: 69 64 3d 22 20 74 65 73 74 2d 69 64 20 22 2c 20 id=" test-id ",
af50: 73 74 61 74 75 73 3d 22 20 73 74 61 74 75 73 20 status=" status
af60: 22 2c 20 73 74 61 74 65 3d 22 20 73 74 61 74 65 ", state=" state
af70: 20 22 2c 20 6d 73 67 3d 22 20 6d 73 67 29 0a 20 ", msg=" msg).
af80: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 69 (mutex-lock! *i
af90: 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a ncoming-mutex*).
afa0: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 (set! *last-db
afb0: 2d 61 63 63 65 73 73 2a 20 28 63 75 72 72 65 6e -access* (curren
afc0: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 20 28 69 t-seconds)). (i
afd0: 66 20 6d 73 67 0a 20 20 20 20 20 20 28 73 65 74 f msg. (set
afe0: 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 ! *incoming-data
aff0: 2a 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 * (cons (vector
b000: 27 73 74 61 74 65 2d 73 74 61 74 75 73 2d 6d 73 'state-status-ms
b010: 67 0a 09 09 09 09 09 20 20 28 63 75 72 72 65 6e g...... (curren
b020: 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 0a t-milliseconds).
b030: 09 09 09 09 09 20 20 28 6c 69 73 74 20 73 74 61 ..... (list sta
b040: 74 65 20 73 74 61 74 75 73 20 6d 73 67 20 74 65 te status msg te
b050: 73 74 2d 69 64 29 29 0a 09 09 09 09 20 20 2a 69 st-id))..... *i
b060: 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 2a 29 29 0a ncoming-data*)).
b070: 20 20 20 20 20 20 28 73 65 74 21 20 2a 69 6e 63 (set! *inc
b080: 6f 6d 69 6e 67 2d 64 61 74 61 2a 20 28 63 6f 6e oming-data* (con
b090: 73 20 28 76 65 63 74 6f 72 20 27 73 74 61 74 65 s (vector 'state
b0a0: 2d 73 74 61 74 75 73 0a 09 09 09 09 09 20 20 28 -status...... (
b0b0: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
b0c0: 6f 6e 64 73 29 0a 09 09 09 09 09 20 20 28 6c 69 onds)...... (li
b0d0: 73 74 20 73 74 61 74 65 20 73 74 61 74 75 73 20 st state status
b0e0: 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 72 75 6e test-id)) ;; run
b0f0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
b100: 65 6d 2d 70 61 74 68 20 6d 69 6e 75 74 65 73 20 em-path minutes
b110: 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 cpuload diskfree
b120: 20 74 6d 70 66 72 65 65 29 20 0a 09 09 09 09 20 tmpfree) .....
b130: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 2a *incoming-data*
b140: 29 29 29 0a 20 20 28 6d 75 74 65 78 2d 75 6e 6c ))). (mutex-unl
b150: 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d ock! *incoming-m
b160: 75 74 65 78 2a 29 0a 20 20 28 69 66 20 2a 63 61 utex*). (if *ca
b170: 63 68 65 2d 6f 6e 2a 0a 20 20 20 20 20 20 28 64 che-on*. (d
b180: 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 49 4e ebug:print 6 "IN
b190: 46 4f 3a 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 69 FO: *cache-on* i
b1a0: 73 20 22 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 22 s " *cache-on* "
b1b0: 2c 20 73 6b 69 70 70 69 6e 67 20 63 61 63 68 65 , skipping cache
b1c0: 20 77 72 69 74 65 22 29 0a 20 20 20 20 20 20 28 write"). (
b1d0: 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 64 2d db:write-cached-
b1e0: 64 61 74 61 29 29 29 0a 20 20 0a 28 64 65 66 69 data))). .(defi
b1f0: 6e 65 20 28 63 64 62 3a 74 65 73 74 2d 72 6f 6c ne (cdb:test-rol
b200: 6c 75 70 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 lup-test_data-pa
b210: 73 73 2d 66 61 69 6c 20 74 65 73 74 2d 69 64 29 ss-fail test-id)
b220: 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
b230: 34 20 22 49 4e 46 4f 3a 20 41 64 64 69 6e 67 20 4 "INFO: Adding
b240: 22 20 74 65 73 74 2d 69 64 20 22 20 66 6f 72 20 " test-id " for
b250: 74 65 73 74 5f 64 61 74 61 20 72 6f 6c 6c 75 70 test_data rollup
b260: 20 74 6f 20 74 68 65 20 71 75 65 75 65 22 29 0a to the queue").
b270: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a (mutex-lock! *
b280: 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 incoming-mutex*)
b290: 0a 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 . (set! *last-d
b2a0: 62 2d 61 63 63 65 73 73 2a 20 28 63 75 72 72 65 b-access* (curre
b2b0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 20 28 nt-seconds)). (
b2c0: 73 65 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 set! *incoming-d
b2d0: 61 74 61 2a 20 28 63 6f 6e 73 20 28 76 65 63 74 ata* (cons (vect
b2e0: 6f 72 20 27 74 65 73 74 5f 64 61 74 61 2d 70 66 or 'test_data-pf
b2f0: 2d 72 6f 6c 6c 75 70 0a 09 09 09 09 20 20 20 20 -rollup.....
b300: 20 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 (current-milli
b310: 73 65 63 6f 6e 64 73 29 0a 09 09 09 09 20 20 20 seconds).....
b320: 20 20 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 (list test-id
b330: 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 test-id test-id
b340: 20 74 65 73 74 2d 69 64 29 29 0a 09 09 09 20 20 test-id))....
b350: 20 20 20 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 *incoming-da
b360: 74 61 2a 29 29 0a 20 20 28 6d 75 74 65 78 2d 75 ta*)). (mutex-u
b370: 6e 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 nlock! *incoming
b380: 2d 6d 75 74 65 78 2a 29 0a 20 20 28 69 66 20 2a -mutex*). (if *
b390: 63 61 63 68 65 2d 6f 6e 2a 0a 20 20 20 20 20 20 cache-on*.
b3a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 (debug:print 6 "
b3b0: 49 4e 46 4f 3a 20 2a 63 61 63 68 65 2d 6f 6e 2a INFO: *cache-on*
b3c0: 20 69 73 20 22 20 2a 63 61 63 68 65 2d 6f 6e 2a is " *cache-on*
b3d0: 20 22 2c 20 73 6b 69 70 70 69 6e 67 20 63 61 63 ", skipping cac
b3e0: 68 65 20 77 72 69 74 65 22 29 0a 20 20 20 20 20 he write").
b3f0: 20 28 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 (db:write-cache
b400: 64 2d 64 61 74 61 29 29 29 0a 0a 28 64 65 66 69 d-data)))..(defi
b410: 6e 65 20 28 63 64 62 3a 70 61 73 73 2d 66 61 69 ne (cdb:pass-fai
b420: 6c 2d 63 6f 75 6e 74 73 20 74 65 73 74 2d 69 64 l-counts test-id
b430: 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 fail-count pass
b440: 2d 63 6f 75 6e 74 29 0a 20 20 28 64 65 62 75 67 -count). (debug
b450: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
b460: 41 64 64 69 6e 67 20 22 20 74 65 73 74 2d 69 64 Adding " test-id
b470: 20 22 20 66 6f 72 20 73 65 74 74 69 6e 67 20 70 " for setting p
b480: 61 73 73 2f 66 61 69 6c 20 63 6f 75 6e 74 73 20 ass/fail counts
b490: 74 6f 20 74 68 65 20 71 75 65 75 65 22 29 0a 20 to the queue").
b4a0: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 69 (mutex-lock! *i
b4b0: 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a ncoming-mutex*).
b4c0: 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 64 62 (set! *last-db
b4d0: 2d 61 63 63 65 73 73 2a 20 28 63 75 72 72 65 6e -access* (curren
b4e0: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 20 28 73 t-seconds)). (s
b4f0: 65 74 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 et! *incoming-da
b500: 74 61 2a 20 28 63 6f 6e 73 20 28 76 65 63 74 6f ta* (cons (vecto
b510: 72 20 27 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 r 'pass-fail-cou
b520: 6e 74 73 0a 09 09 09 09 20 20 20 20 20 20 28 63 nts..... (c
b530: 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f urrent-milliseco
b540: 6e 64 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 nds)..... (
b550: 6c 69 73 74 20 66 61 69 6c 2d 63 6f 75 6e 74 20 list fail-count
b560: 70 61 73 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d pass-count test-
b570: 69 64 29 29 0a 09 09 09 20 20 20 20 20 20 2a 69 id)).... *i
b580: 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 2a 29 29 0a ncoming-data*)).
b590: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
b5a0: 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 *incoming-mutex
b5b0: 2a 29 0a 20 20 28 69 66 20 2a 63 61 63 68 65 2d *). (if *cache-
b5c0: 6f 6e 2a 0a 20 20 20 20 20 20 28 64 65 62 75 67 on*. (debug
b5d0: 3a 70 72 69 6e 74 20 36 20 22 49 4e 46 4f 3a 20 :print 6 "INFO:
b5e0: 2a 63 61 63 68 65 2d 6f 6e 2a 20 69 73 20 22 20 *cache-on* is "
b5f0: 2a 63 61 63 68 65 2d 6f 6e 2a 20 22 2c 20 73 6b *cache-on* ", sk
b600: 69 70 70 69 6e 67 20 63 61 63 68 65 20 77 72 69 ipping cache wri
b610: 74 65 22 29 0a 20 20 20 20 20 20 28 64 62 3a 77 te"). (db:w
b620: 72 69 74 65 2d 63 61 63 68 65 64 2d 64 61 74 61 rite-cached-data
b630: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 64 )))..(define (cd
b640: 62 3a 74 65 73 74 73 2d 72 65 67 69 73 74 65 72 b:tests-register
b650: 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 -test db run-id
b660: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
b670: 61 74 68 20 23 21 6b 65 79 20 28 66 6f 72 63 65 ath #!key (force
b680: 2d 77 72 69 74 65 20 23 66 29 29 0a 20 20 28 6c -write #f)). (l
b690: 65 74 20 28 28 69 74 65 6d 2d 70 61 74 68 73 20 et ((item-paths
b6a0: 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 6d (if (equal? item
b6b0: 2d 70 61 74 68 20 22 22 29 0a 09 09 09 28 6c 69 -path "")....(li
b6c0: 73 74 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 st item-path)...
b6d0: 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 74 68 .(list item-path
b6e0: 20 22 22 29 29 29 29 0a 20 20 20 20 28 64 65 62 "")))). (deb
b6f0: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
b700: 3a 20 41 64 64 69 6e 67 20 22 20 72 75 6e 2d 69 : Adding " run-i
b710: 64 20 22 2c 20 22 20 74 65 73 74 2d 6e 61 6d 65 d ", " test-name
b720: 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 20 22 "/" item-path "
b730: 20 66 6f 72 20 73 65 74 74 69 6e 67 20 70 61 73 for setting pas
b740: 73 2f 66 61 69 6c 20 63 6f 75 6e 74 73 20 74 6f s/fail counts to
b750: 20 74 68 65 20 71 75 65 75 65 22 29 0a 20 20 20 the queue").
b760: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 69 (mutex-lock! *i
b770: 6e 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a ncoming-mutex*).
b780: 20 20 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d (set! *last-
b790: 64 62 2d 61 63 63 65 73 73 2a 20 28 63 75 72 72 db-access* (curr
b7a0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 20 20 ent-seconds)).
b7b0: 20 20 28 73 65 74 21 20 2a 69 6e 63 6f 6d 69 6e (set! *incomin
b7c0: 67 2d 64 61 74 61 2a 20 28 63 6f 6e 73 20 28 76 g-data* (cons (v
b7d0: 65 63 74 6f 72 20 27 72 65 67 69 73 74 65 72 2d ector 'register-
b7e0: 74 65 73 74 0a 09 09 09 09 09 28 63 75 72 72 65 test......(curre
b7f0: 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 nt-milliseconds)
b800: 0a 09 09 09 09 09 28 6c 69 73 74 20 72 75 6e 2d ......(list run-
b810: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
b820: 6d 2d 70 61 74 68 29 29 20 3b 3b 20 66 61 69 6c m-path)) ;; fail
b830: 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e -count pass-coun
b840: 74 20 74 65 73 74 2d 69 64 29 29 0a 09 09 09 09 t test-id)).....
b850: 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 2a 29 *incoming-data*)
b860: 29 0a 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c ). (mutex-unl
b870: 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d ock! *incoming-m
b880: 75 74 65 78 2a 29 0a 20 20 20 20 28 69 66 20 28 utex*). (if (
b890: 61 6e 64 20 28 6e 6f 74 20 66 6f 72 63 65 2d 77 and (not force-w
b8a0: 72 69 74 65 29 20 2a 63 61 63 68 65 2d 6f 6e 2a rite) *cache-on*
b8b0: 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 )..(debug:print
b8c0: 36 20 22 49 4e 46 4f 3a 20 2a 63 61 63 68 65 2d 6 "INFO: *cache-
b8d0: 6f 6e 2a 20 69 73 20 22 20 2a 63 61 63 68 65 2d on* is " *cache-
b8e0: 6f 6e 2a 20 22 2c 20 73 6b 69 70 70 69 6e 67 20 on* ", skipping
b8f0: 63 61 63 68 65 20 77 72 69 74 65 22 29 0a 09 28 cache write")..(
b900: 64 62 3a 77 72 69 74 65 2d 63 61 63 68 65 64 2d db:write-cached-
b910: 64 61 74 61 29 29 29 29 0a 0a 3b 3b 20 54 68 65 data))))..;; The
b920: 20 71 75 65 75 65 20 69 73 20 61 20 6c 69 73 74 queue is a list
b930: 20 6f 66 20 76 65 63 74 6f 72 73 20 77 68 65 72 of vectors wher
b940: 65 20 74 68 65 20 7a 65 72 6f 74 68 20 73 6c 6f e the zeroth slo
b950: 74 20 69 6e 64 69 63 61 74 65 73 20 74 68 65 20 t indicates the
b960: 74 79 70 65 20 6f 66 20 71 75 65 72 79 20 74 6f type of query to
b970: 0a 3b 3b 20 61 70 70 6c 79 20 61 6e 64 20 74 68 .;; apply and th
b980: 65 20 73 65 63 6f 6e 64 20 73 6c 6f 74 20 69 73 e second slot is
b990: 20 74 68 65 20 74 69 6d 65 20 6f 66 20 74 68 65 the time of the
b9a0: 20 71 75 65 72 79 20 61 6e 64 20 74 68 65 20 74 query and the t
b9b0: 68 69 72 64 20 65 6e 74 72 79 20 69 73 20 61 20 hird entry is a
b9c0: 6c 69 73 74 20 6f 66 20 0a 3b 3b 20 76 61 6c 75 list of .;; valu
b9d0: 65 73 20 74 6f 20 62 65 20 61 70 70 6c 69 65 64 es to be applied
b9e0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a .;;.(define (db:
b9f0: 77 72 69 74 65 2d 63 61 63 68 65 64 2d 64 61 74 write-cached-dat
ba00: 61 29 0a 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 a). (open-run-c
ba10: 6c 6f 73 65 0a 20 20 20 28 6c 61 6d 62 64 61 20 lose. (lambda
ba20: 28 64 62 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 (db . params).
ba30: 20 20 20 28 6c 65 74 20 28 28 72 65 67 69 73 74 (let ((regist
ba40: 65 72 2d 74 65 73 74 2d 73 74 6d 74 20 20 20 20 er-test-stmt
ba50: 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 65 (sqlite3:prepare
ba60: 20 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 49 db "INSERT OR I
ba70: 47 4e 4f 52 45 20 49 4e 54 4f 20 74 65 73 74 73 GNORE INTO tests
ba80: 20 28 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d (run_id,testnam
ba90: 65 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 69 74 65 e,event_time,ite
baa0: 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 61 m_path,state,sta
bab0: 74 75 73 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f tus) VALUES (?,?
bac0: 2c 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 ,strftime('%s','
bad0: 6e 6f 77 27 29 2c 3f 2c 27 4e 4f 54 5f 53 54 41 now'),?,'NOT_STA
bae0: 52 54 45 44 27 2c 27 6e 2f 61 27 29 3b 22 29 29 RTED','n/a');"))
baf0: 0a 09 20 20 20 28 73 74 61 74 65 2d 73 74 61 74 .. (state-stat
bb00: 75 73 2d 73 74 6d 74 20 20 20 20 20 28 73 71 6c us-stmt (sql
bb10: 69 74 65 33 3a 70 72 65 70 61 72 65 20 64 62 20 ite3:prepare db
bb20: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
bb30: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 T state=?,status
bb40: 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 =? WHERE id=?;")
bb50: 29 0a 09 20 20 20 28 73 74 61 74 65 2d 73 74 61 ).. (state-sta
bb60: 74 75 73 2d 6d 73 67 2d 73 74 6d 74 20 28 73 71 tus-msg-stmt (sq
bb70: 6c 69 74 65 33 3a 70 72 65 70 61 72 65 20 64 62 lite3:prepare db
bb80: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
bb90: 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 ET state=?,statu
bba0: 73 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 s=?,comment=? WH
bbb0: 45 52 45 20 69 64 3d 3f 3b 22 29 29 0a 09 20 20 ERE id=?;"))..
bbc0: 20 28 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e (pass-fail-coun
bbd0: 74 73 2d 73 74 6d 74 20 28 73 71 6c 69 74 65 33 ts-stmt (sqlite3
bbe0: 3a 70 72 65 70 61 72 65 20 64 62 20 22 55 50 44 :prepare db "UPD
bbf0: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 66 61 ATE tests SET fa
bc00: 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 5f il_count=?,pass_
bc10: 63 6f 75 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 count=? WHERE id
bc20: 3d 3f 3b 22 29 29 0a 09 20 20 20 28 74 65 73 74 =?;")).. (test
bc30: 5f 64 61 74 61 2d 72 6f 6c 6c 75 70 2d 73 74 6d _data-rollup-stm
bc40: 74 20 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 t (sqlite3:prep
bc50: 61 72 65 20 64 62 20 22 55 50 44 41 54 45 20 74 are db "UPDATE t
bc60: 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 ests.
bc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc90: 20 20 53 45 54 20 73 74 61 74 75 73 3d 43 41 53 SET status=CAS
bca0: 45 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 66 E WHEN (SELECT f
bcb0: 61 69 6c 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74 ail_count FROM t
bcc0: 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 ests WHERE id=?)
bcd0: 20 3e 20 30 20 0a 20 20 20 20 20 20 20 20 20 20 > 0 .
bce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd00: 20 20 20 20 20 20 54 48 45 4e 20 27 46 41 49 4c THEN 'FAIL
bd10: 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 '.
bd20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 57 W
bd40: 48 45 4e 20 28 53 45 4c 45 43 54 20 70 61 73 73 HEN (SELECT pass
bd50: 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 _count FROM test
bd60: 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 s WHERE id=?) >
bd70: 30 20 41 4e 44 20 0a 20 20 20 20 20 20 20 20 20 0 AND .
bd80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bda0: 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 54 (SELECT
bdb0: 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65 73 status FROM tes
bdc0: 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 4e ts WHERE id=?) N
bdd0: 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c 27 46 OT IN ('WARN','F
bde0: 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 20 20 AIL').
bdf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be10: 20 20 20 54 48 45 4e 20 27 50 41 53 53 27 0a 20 THEN 'PASS'.
be20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be40: 20 20 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 ELSE
be50: 20 73 74 61 74 75 73 0a 20 20 20 20 20 20 20 20 status.
be60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be80: 20 45 4e 44 20 57 48 45 52 45 20 69 64 3d 3f 3b END WHERE id=?;
be90: 22 29 29 0a 09 20 20 20 28 64 61 74 61 20 20 20 ")).. (data
bea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
beb0: 66 29 0a 09 20 20 20 28 72 6f 6c 6c 75 70 73 20 f).. (rollups
bec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
bed0: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
bee0: 29 0a 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d ). (mutex-
bef0: 6c 6f 63 6b 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d lock! *incoming-
bf00: 6d 75 74 65 78 2a 29 0a 20 20 20 20 20 20 20 28 mutex*). (
bf10: 73 65 74 21 20 64 61 74 61 20 28 73 6f 72 74 20 set! data (sort
bf20: 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 2a 20 *incoming-data*
bf30: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3c 20 (lambda (a b)(<
bf40: 28 76 65 63 74 6f 72 2d 72 65 66 20 61 20 31 29 (vector-ref a 1)
bf50: 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 31 29 (vector-ref b 1)
bf60: 29 29 29 29 0a 20 20 20 20 20 20 20 28 73 65 74 )))). (set
bf70: 21 20 2a 69 6e 63 6f 6d 69 6e 67 2d 64 61 74 61 ! *incoming-data
bf80: 2a 20 27 28 29 29 0a 20 20 20 20 20 20 20 28 6d * '()). (m
bf90: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 69 6e utex-unlock! *in
bfa0: 63 6f 6d 69 6e 67 2d 6d 75 74 65 78 2a 29 0a 20 coming-mutex*).
bfb0: 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 (if (> (le
bfc0: 6e 67 74 68 20 64 61 74 61 29 20 30 29 0a 09 20 ngth data) 0)..
bfd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
bfe0: 20 22 49 4e 46 4f 3a 20 57 72 69 74 69 6e 67 20 "INFO: Writing
bff0: 63 61 63 68 65 64 20 64 61 74 61 20 22 20 64 61 cached data " da
c000: 74 61 29 29 0a 20 20 20 20 20 20 20 28 73 71 6c ta)). (sql
c010: 69 74 65 33 3a 77 69 74 68 2d 74 72 61 6e 73 61 ite3:with-transa
c020: 63 74 69 6f 6e 20 0a 09 64 62 0a 09 28 6c 61 6d ction ..db..(lam
c030: 62 64 61 20 28 29 0a 09 20 20 28 64 65 62 75 67 bda ().. (debug
c040: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
c050: 66 6c 75 73 68 69 6e 67 20 22 20 64 61 74 61 20 flushing " data
c060: 22 20 74 6f 20 64 62 22 29 0a 09 20 20 28 66 6f " to db").. (fo
c070: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
c080: 65 6e 74 72 79 29 0a 09 09 20 20 20 20 20 20 28 entry)... (
c090: 6c 65 74 20 28 28 70 61 72 61 6d 73 20 28 76 65 let ((params (ve
c0a0: 63 74 6f 72 2d 72 65 66 20 65 6e 74 72 79 20 32 ctor-ref entry 2
c0b0: 29 29 29 0a 09 09 09 28 64 65 62 75 67 3a 70 72 )))....(debug:pr
c0c0: 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 41 70 70 int 4 "INFO: App
c0d0: 6c 79 69 6e 67 20 22 20 65 6e 74 72 79 20 22 20 lying " entry "
c0e0: 74 6f 20 70 61 72 61 6d 73 20 22 20 70 61 72 61 to params " para
c0f0: 6d 73 29 0a 09 09 09 28 63 61 73 65 20 28 76 65 ms)....(case (ve
c100: 63 74 6f 72 2d 72 65 66 20 65 6e 74 72 79 20 30 ctor-ref entry 0
c110: 29 0a 09 09 09 20 20 28 28 73 74 61 74 65 2d 73 ).... ((state-s
c120: 74 61 74 75 73 29 0a 09 09 09 20 20 20 28 61 70 tatus).... (ap
c130: 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 63 ply sqlite3:exec
c140: 75 74 65 20 73 74 61 74 65 2d 73 74 61 74 75 73 ute state-status
c150: 2d 73 74 6d 74 20 20 20 20 20 70 61 72 61 6d 73 -stmt params
c160: 29 29 0a 09 09 09 20 20 28 28 73 74 61 74 65 2d )).... ((state-
c170: 73 74 61 74 75 73 2d 6d 73 67 29 0a 09 09 09 20 status-msg)....
c180: 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 (apply sqlite3
c190: 3a 65 78 65 63 75 74 65 20 73 74 61 74 65 2d 73 :execute state-s
c1a0: 74 61 74 75 73 2d 6d 73 67 2d 73 74 6d 74 20 70 tatus-msg-stmt p
c1b0: 61 72 61 6d 73 29 29 0a 09 09 09 20 20 28 28 74 arams)).... ((t
c1c0: 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c est_data-pf-roll
c1d0: 75 70 29 0a 09 09 09 20 20 20 3b 3b 20 28 68 61 up).... ;; (ha
c1e0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 6f sh-table-set! ro
c1f0: 6c 6c 75 70 73 20 28 63 61 72 20 70 61 72 61 6d llups (car param
c200: 73 29 20 70 61 72 61 6d 73 29 29 0a 09 09 09 20 s) params))....
c210: 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 (apply sqlite3
c220: 3a 65 78 65 63 75 74 65 20 74 65 73 74 5f 64 61 :execute test_da
c230: 74 61 2d 72 6f 6c 6c 75 70 2d 73 74 6d 74 20 20 ta-rollup-stmt
c240: 70 61 72 61 6d 73 29 29 0a 09 09 09 20 20 28 28 params)).... ((
c250: 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
c260: 29 0a 09 09 09 20 20 20 28 61 70 70 6c 79 20 73 ).... (apply s
c270: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 70 qlite3:execute p
c280: 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 2d ass-fail-counts-
c290: 73 74 6d 74 20 70 61 72 61 6d 73 29 29 0a 09 09 stmt params))...
c2a0: 09 20 20 28 28 72 65 67 69 73 74 65 72 2d 74 65 . ((register-te
c2b0: 73 74 29 0a 09 09 09 20 20 20 28 61 70 70 6c 79 st).... (apply
c2c0: 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 sqlite3:execute
c2d0: 20 72 65 67 69 73 74 65 72 2d 74 65 73 74 2d 73 register-test-s
c2e0: 74 6d 74 20 20 20 20 70 61 72 61 6d 73 29 29 0a tmt params)).
c2f0: 09 09 09 20 20 28 65 6c 73 65 0a 09 09 09 20 20 ... (else....
c300: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
c310: 22 45 52 52 4f 52 3a 20 51 75 65 75 65 64 20 65 "ERROR: Queued e
c320: 6e 74 72 79 20 6e 6f 74 20 72 65 63 6f 67 6e 69 ntry not recogni
c330: 73 65 64 20 22 20 65 6e 74 72 79 29 29 29 29 29 sed " entry)))))
c340: 0a 09 09 20 20 20 20 64 61 74 61 29 29 29 0a 20 ... data))).
c350: 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 64 6f 20 ;; now do
c360: 61 6e 79 20 72 6f 6c 6c 75 70 73 0a 20 20 20 20 any rollups.
c370: 20 20 20 3b 3b 20 28 66 6f 72 2d 65 61 63 68 0a ;; (for-each.
c380: 20 20 20 20 20 20 20 3b 3b 20 20 28 6c 61 6d 62 ;; (lamb
c390: 64 61 20 28 74 65 73 74 2d 69 64 29 0a 20 20 20 da (test-id).
c3a0: 20 20 20 20 3b 3b 20 20 20 20 28 61 70 70 6c 79 ;; (apply
c3b0: 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 sqlite3:execute
c3c0: 20 74 65 73 74 5f 64 61 74 61 2d 72 6f 6c 6c 75 test_data-rollu
c3d0: 70 2d 73 74 6d 74 20 28 68 61 73 68 2d 74 61 62 p-stmt (hash-tab
c3e0: 6c 65 2d 72 65 66 20 72 6f 6c 6c 75 70 73 20 74 le-ref rollups t
c3f0: 65 73 74 2d 69 64 29 29 29 0a 20 20 20 20 20 20 est-id))).
c400: 20 3b 3b 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ;; (hash-table
c410: 2d 6b 65 79 73 20 72 6f 6c 6c 75 70 73 29 29 0a -keys rollups)).
c420: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
c430: 66 69 6e 61 6c 69 7a 65 21 20 73 74 61 74 65 2d finalize! state-
c440: 73 74 61 74 75 73 2d 73 74 6d 74 29 0a 20 20 20 status-stmt).
c450: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
c460: 61 6c 69 7a 65 21 20 73 74 61 74 65 2d 73 74 61 alize! state-sta
c470: 74 75 73 2d 6d 73 67 2d 73 74 6d 74 29 0a 20 20 tus-msg-stmt).
c480: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 (sqlite3:fi
c490: 6e 61 6c 69 7a 65 21 20 74 65 73 74 5f 64 61 74 nalize! test_dat
c4a0: 61 2d 72 6f 6c 6c 75 70 2d 73 74 6d 74 29 0a 20 a-rollup-stmt).
c4b0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
c4c0: 69 6e 61 6c 69 7a 65 21 20 70 61 73 73 2d 66 61 inalize! pass-fa
c4d0: 69 6c 2d 63 6f 75 6e 74 73 2d 73 74 6d 74 29 0a il-counts-stmt).
c4e0: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
c4f0: 66 69 6e 61 6c 69 7a 65 21 20 72 65 67 69 73 74 finalize! regist
c500: 65 72 2d 74 65 73 74 2d 73 74 6d 74 29 0a 20 20 er-test-stmt).
c510: 20 20 20 20 20 28 6c 65 74 20 28 28 63 61 63 68 (let ((cach
c520: 65 2d 73 69 7a 65 20 28 6c 65 6e 67 74 68 20 64 e-size (length d
c530: 61 74 61 29 29 29 0a 09 20 28 69 66 20 28 3e 20 ata))).. (if (>
c540: 63 61 63 68 65 2d 73 69 7a 65 20 2a 6d 61 78 2d cache-size *max-
c550: 63 61 63 68 65 2d 73 69 7a 65 2a 29 0a 09 20 20 cache-size*)..
c560: 20 20 20 28 73 65 74 21 20 2a 6d 61 78 2d 63 61 (set! *max-ca
c570: 63 68 65 2d 73 69 7a 65 2a 20 63 61 63 68 65 2d che-size* cache-
c580: 73 69 7a 65 29 29 29 0a 20 20 20 20 20 20 20 29 size))). )
c590: 29 0a 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 ). #f))..(defi
c5a0: 6e 65 20 63 64 62 3a 66 6c 75 73 68 2d 71 75 65 ne cdb:flush-que
c5b0: 75 65 20 64 62 3a 77 72 69 74 65 2d 63 61 63 68 ue db:write-cach
c5c0: 65 64 2d 64 61 74 61 29 0a 0a 28 64 65 66 69 6e ed-data)..(defin
c5d0: 65 20 28 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 e (db:roll-up-pa
c5e0: 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 64 ss-fail-counts d
c5f0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
c600: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 me item-path sta
c610: 74 75 73 29 0a 20 20 28 72 64 62 3a 66 6c 75 73 tus). (rdb:flus
c620: 68 2d 71 75 65 75 65 29 0a 20 20 28 69 66 20 28 h-queue). (if (
c630: 61 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f and (not (equal?
c640: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a item-path "")).
c650: 09 20 20 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 . (or (equal?
c660: 73 74 61 74 75 73 20 22 50 41 53 53 22 29 0a 09 status "PASS")..
c670: 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 (equal? s
c680: 74 61 74 75 73 20 22 57 41 52 4e 22 29 0a 09 20 tatus "WARN")..
c690: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 (equal? st
c6a0: 61 74 75 73 20 22 46 41 49 4c 22 29 0a 09 20 20 atus "FAIL")..
c6b0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 (equal? sta
c6c0: 74 75 73 20 22 57 41 49 56 45 44 22 29 0a 09 20 tus "WAIVED")..
c6d0: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 (equal? st
c6e0: 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 29 atus "RUNNING"))
c6f0: 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ). (begin..
c700: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
c710: 20 0a 09 20 64 62 0a 09 20 22 55 50 44 41 54 45 .. db.. "UPDATE
c720: 20 74 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 tests .
c730: 20 20 20 20 20 53 45 54 20 66 61 69 6c 5f 63 6f SET fail_co
c740: 75 6e 74 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e unt=(SELECT coun
c750: 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 t(id) FROM tests
c760: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
c770: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
c780: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
c790: 27 27 20 41 4e 44 20 73 74 61 74 75 73 3d 27 46 '' AND status='F
c7a0: 41 49 4c 27 29 2c 0a 20 20 20 20 20 20 20 20 20 AIL'),.
c7b0: 20 20 20 20 20 20 20 20 70 61 73 73 5f 63 6f 75 pass_cou
c7c0: 6e 74 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 nt=(SELECT count
c7d0: 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 (id) FROM tests
c7e0: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
c7f0: 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e ND testname=? AN
c800: 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
c810: 27 20 41 4e 44 20 28 73 74 61 74 75 73 3d 27 50 ' AND (status='P
c820: 41 53 53 27 20 4f 52 20 73 74 61 74 75 73 3d 27 ASS' OR status='
c830: 57 41 52 4e 27 20 4f 52 20 73 74 61 74 75 73 3d WARN' OR status=
c840: 27 57 41 49 56 45 44 27 29 29 0a 20 20 20 20 20 'WAIVED')).
c850: 20 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 WHERE ru
c860: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
c870: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
c880: 61 74 68 3d 27 27 3b 22 0a 09 20 72 75 6e 2d 69 ath='';".. run-i
c890: 64 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d d test-name run-
c8a0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e id test-name run
c8b0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 -id test-name).
c8c0: 20 20 20 20 20 20 20 3b 3b 20 28 74 68 72 65 61 ;; (threa
c8d0: 64 2d 73 6c 65 65 70 21 20 30 2e 31 29 20 3b 3b d-sleep! 0.1) ;;
c8e0: 20 67 69 76 65 20 6f 74 68 65 72 20 70 72 6f 63 give other proc
c8f0: 65 73 73 65 73 20 61 20 63 68 61 6e 63 65 20 68 esses a chance h
c900: 65 72 65 2c 20 6e 6f 2c 20 62 65 74 74 65 72 20 ere, no, better
c910: 74 6f 20 62 65 20 64 6f 6e 65 20 41 53 41 50 3f to be done ASAP?
c920: 0a 09 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 ..(if (equal? st
c930: 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 20 atus "RUNNING")
c940: 3b 3b 20 72 75 6e 6e 69 6e 67 20 74 61 6b 65 73 ;; running takes
c950: 20 70 72 69 6f 72 69 74 79 20 6f 76 65 72 20 61 priority over a
c960: 6c 6c 20 6f 74 68 65 72 20 73 74 61 74 65 73 2c ll other states,
c970: 20 66 6f 72 63 65 20 74 68 65 20 74 65 73 74 20 force the test
c980: 73 74 61 74 65 20 74 6f 20 52 55 4e 4e 49 4e 47 state to RUNNING
c990: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 .. (sqlite3:e
c9a0: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
c9b0: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
c9c0: 65 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 e=? WHERE run_id
c9d0: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
c9e0: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
c9f0: 27 27 3b 22 20 22 52 55 4e 4e 49 4e 47 22 20 72 '';" "RUNNING" r
ca00: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 un-id test-name)
ca10: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 .. (sqlite3:e
ca20: 78 65 63 75 74 65 0a 09 20 20 20 20 20 64 62 0a xecute.. db.
ca30: 09 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 . "UPDATE te
ca40: 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 sts.
ca50: 20 20 20 20 20 20 20 20 20 20 20 53 45 54 20 73 SET s
ca60: 74 61 74 65 3d 43 41 53 45 20 57 48 45 4e 20 28 tate=CASE WHEN (
ca70: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
ca80: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
ca90: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
caa0: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
cab0: 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e em_path != '' AN
cac0: 44 20 73 74 61 74 65 20 69 6e 20 28 27 52 55 4e D state in ('RUN
cad0: 4e 49 4e 47 27 2c 27 4e 4f 54 5f 53 54 41 52 54 NING','NOT_START
cae0: 45 44 27 29 29 20 3e 20 30 20 54 48 45 4e 20 0a ED')) > 0 THEN .
caf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cb00: 20 20 20 20 20 20 20 20 20 20 27 52 55 4e 4e 49 'RUNNI
cb10: 4e 47 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 NG'.
cb20: 20 20 20 20 20 20 20 20 20 20 20 45 4c 53 45 20 ELSE
cb30: 27 43 4f 4d 50 4c 45 54 45 44 27 20 45 4e 44 2c 'COMPLETED' END,
cb40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
cb50: 20 20 20 20 20 20 20 20 20 20 20 73 74 61 74 75 statu
cb60: 73 3d 43 41 53 45 20 57 48 45 4e 20 66 61 69 6c s=CASE WHEN fail
cb70: 5f 63 6f 75 6e 74 20 3e 20 30 20 54 48 45 4e 20 _count > 0 THEN
cb80: 27 46 41 49 4c 27 20 57 48 45 4e 20 70 61 73 73 'FAIL' WHEN pass
cb90: 5f 63 6f 75 6e 74 20 3e 20 30 20 41 4e 44 20 66 _count > 0 AND f
cba0: 61 69 6c 5f 63 6f 75 6e 74 3d 30 20 54 48 45 4e ail_count=0 THEN
cbb0: 20 27 50 41 53 53 27 20 45 4c 53 45 20 27 55 4e 'PASS' ELSE 'UN
cbc0: 4b 4e 4f 57 4e 27 20 45 4e 44 0a 20 20 20 20 20 KNOWN' END.
cbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cbe0: 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f WHERE run_id=?
cbf0: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
cc00: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 AND item_path=''
cc10: 3b 22 0a 09 20 20 20 20 20 72 75 6e 2d 69 64 20 ;".. run-id
cc20: 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 test-name run-id
cc30: 20 74 65 73 74 2d 6e 61 6d 65 29 29 0a 09 23 66 test-name))..#f
cc40: 29 0a 20 20 20 20 20 20 23 66 29 29 0a 0a 3b 3b ). #f))..;;
cc50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cc60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cc70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cc80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cc90: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 73 20 ======.;; Tests
cca0: 6d 65 74 61 20 64 61 74 61 0a 3b 3b 3d 3d 3d 3d meta data.;;====
ccb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ccc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ccd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
cce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ccf0: 3d 3d 0a 0a 3b 3b 20 72 65 61 64 20 74 68 65 20 ==..;; read the
cd00: 72 65 63 6f 72 64 20 67 69 76 65 6e 20 61 20 74 record given a t
cd10: 65 73 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 estname.(define
cd20: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 65 74 (db:testmeta-get
cd30: 2d 72 65 63 6f 72 64 20 64 62 20 74 65 73 74 6e -record db testn
cd40: 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 72 65 ame). (let ((re
cd50: 73 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c 69 s #f)). (sqli
cd60: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
cd70: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 . (lambda (i
cd80: 64 20 74 65 73 74 6e 61 6d 65 20 61 75 74 68 6f d testname autho
cd90: 72 20 6f 77 6e 65 72 20 64 65 73 63 72 69 70 74 r owner descript
cda0: 69 6f 6e 20 72 65 76 69 65 77 65 64 20 69 74 65 ion reviewed ite
cdb0: 72 61 74 65 64 20 61 76 67 5f 72 75 6e 74 69 6d rated avg_runtim
cdc0: 65 20 61 76 67 5f 64 69 73 6b 20 74 61 67 73 29 e avg_disk tags)
cdd0: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
cde0: 73 20 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 s (vector id tes
cdf0: 74 6e 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e tname author own
ce00: 65 72 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 er description r
ce10: 65 76 69 65 77 65 64 20 69 74 65 72 61 74 65 64 eviewed iterated
ce20: 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 avg_runtime avg
ce30: 5f 64 69 73 6b 20 74 61 67 73 29 29 29 0a 20 20 _disk tags))).
ce40: 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 69 64 db "SELECT id
ce50: 2c 74 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f 72 ,testname,author
ce60: 2c 6f 77 6e 65 72 2c 64 65 73 63 72 69 70 74 69 ,owner,descripti
ce70: 6f 6e 2c 72 65 76 69 65 77 65 64 2c 69 74 65 72 on,reviewed,iter
ce80: 61 74 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d 65 ated,avg_runtime
ce90: 2c 61 76 67 5f 64 69 73 6b 2c 74 61 67 73 20 46 ,avg_disk,tags F
cea0: 52 4f 4d 20 74 65 73 74 5f 6d 65 74 61 20 57 48 ROM test_meta WH
ceb0: 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 3b 22 ERE testname=?;"
cec0: 0a 20 20 20 20 20 74 65 73 74 6e 61 6d 65 29 0a . testname).
ced0: 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 63 72 res))..;; cr
cee0: 65 61 74 65 20 61 20 6e 65 77 20 72 65 63 6f 72 eate a new recor
cef0: 64 20 66 6f 72 20 61 20 67 69 76 65 6e 20 74 65 d for a given te
cf00: 73 74 6e 61 6d 65 0a 28 64 65 66 69 6e 65 20 28 stname.(define (
cf10: 64 62 3a 74 65 73 74 6d 65 74 61 2d 61 64 64 2d db:testmeta-add-
cf20: 72 65 63 6f 72 64 20 64 62 20 74 65 73 74 6e 61 record db testna
cf30: 6d 65 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 me). (sqlite3:e
cf40: 78 65 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 xecute db "INSER
cf50: 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f T OR IGNORE INTO
cf60: 20 74 65 73 74 5f 6d 65 74 61 20 28 74 65 73 74 test_meta (test
cf70: 6e 61 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 name,author,owne
cf80: 72 2c 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 r,description,re
cf90: 76 69 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c viewed,iterated,
cfa0: 61 76 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f avg_runtime,avg_
cfb0: 64 69 73 6b 2c 74 61 67 73 29 20 56 41 4c 55 45 disk,tags) VALUE
cfc0: 53 20 28 3f 2c 27 27 2c 27 27 2c 27 27 2c 27 27 S (?,'','','',''
cfd0: 2c 27 27 2c 27 27 2c 27 27 2c 27 27 29 3b 22 20 ,'','','','');"
cfe0: 74 65 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b 20 75 testname))..;; u
cff0: 70 64 61 74 65 20 6f 6e 65 20 6f 66 20 74 68 65 pdate one of the
d000: 20 74 65 73 74 6d 65 74 61 20 66 69 65 6c 64 73 testmeta fields
d010: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 .(define (db:tes
d020: 74 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 tmeta-update-fie
d030: 6c 64 20 64 62 20 74 65 73 74 6e 61 6d 65 20 66 ld db testname f
d040: 69 65 6c 64 20 76 61 6c 75 65 29 0a 20 20 28 73 ield value). (s
d050: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
d060: 62 20 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 b (conc "UPDATE
d070: 74 65 73 74 5f 6d 65 74 61 20 53 45 54 20 22 20 test_meta SET "
d080: 66 69 65 6c 64 20 22 3d 3f 20 57 48 45 52 45 20 field "=? WHERE
d090: 74 65 73 74 6e 61 6d 65 3d 3f 3b 22 29 20 76 61 testname=?;") va
d0a0: 6c 75 65 20 74 65 73 74 6e 61 6d 65 29 29 0a 0a lue testname))..
d0b0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
d0c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d0d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d0e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d0f0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 20 45 20 ========.;; T E
d100: 53 20 54 20 20 20 44 20 41 20 54 20 41 20 0a 3b S T D A T A .;
d110: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
d120: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
d150: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
d160: 20 28 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 (db:csv->test-d
d170: 61 74 61 20 64 62 20 74 65 73 74 2d 69 64 20 63 ata db test-id c
d180: 73 76 64 61 74 61 29 0a 20 20 28 64 65 62 75 67 svdata). (debug
d190: 3a 70 72 69 6e 74 20 34 20 22 74 65 73 74 2d 69 :print 4 "test-i
d1a0: 64 20 22 20 74 65 73 74 2d 69 64 20 22 2c 20 63 d " test-id ", c
d1b0: 73 76 64 61 74 61 3a 20 22 20 63 73 76 64 61 74 svdata: " csvdat
d1c0: 61 29 0a 20 20 28 6c 65 74 20 28 28 74 64 62 20 a). (let ((tdb
d1d0: 20 20 20 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 (db:open-tes
d1e0: 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 64 20 t-db-by-test-id
d1f0: 64 62 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 db test-id))).
d200: 20 20 28 69 66 20 74 64 62 0a 09 28 6c 65 74 20 (if tdb..(let
d210: 28 28 63 73 76 6c 69 73 74 20 28 63 73 76 2d 3e ((csvlist (csv->
d220: 6c 69 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d 72 list (make-csv-r
d230: 65 61 64 65 72 0a 09 09 09 09 20 20 20 28 6f 70 eader..... (op
d240: 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 en-input-string
d250: 63 73 76 64 61 74 61 29 0a 09 09 09 09 20 20 20 csvdata).....
d260: 27 28 28 73 74 72 69 70 2d 6c 65 61 64 69 6e 67 '((strip-leading
d270: 2d 77 68 69 74 65 73 70 61 63 65 3f 20 23 74 29 -whitespace? #t)
d280: 0a 09 09 09 09 20 20 20 20 20 28 73 74 72 69 70 ..... (strip
d290: 2d 74 72 61 69 6c 69 6e 67 2d 77 68 69 74 65 73 -trailing-whites
d2a0: 70 61 63 65 3f 20 23 74 29 29 20 29 29 29 29 20 pace? #t)) ))))
d2b0: 3b 3b 20 28 63 73 76 2d 3e 6c 69 73 74 20 63 73 ;; (csv->list cs
d2c0: 76 64 61 74 61 29 29 29 0a 09 20 20 28 66 6f 72 vdata))).. (for
d2d0: 2d 65 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 -each .. (lamb
d2e0: 64 61 20 28 63 73 76 72 6f 77 29 0a 09 20 20 20 da (csvrow)..
d2f0: 20 20 28 6c 65 74 2a 20 28 28 70 61 64 64 65 64 (let* ((padded
d300: 2d 72 6f 77 20 20 28 74 61 6b 65 20 28 61 70 70 -row (take (app
d310: 65 6e 64 20 63 73 76 72 6f 77 20 28 6c 69 73 74 end csvrow (list
d320: 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 20 #f #f #f #f #f
d330: 23 66 20 23 66 20 23 66 20 23 66 29 29 20 39 29 #f #f #f #f)) 9)
d340: 29 0a 09 09 20 20 20 20 28 63 61 74 65 67 6f 72 )... (categor
d350: 79 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 y (list-ref p
d360: 61 64 64 65 64 2d 72 6f 77 20 30 29 29 0a 09 09 added-row 0))...
d370: 20 20 20 20 28 76 61 72 69 61 62 6c 65 20 20 20 (variable
d380: 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 65 (list-ref padde
d390: 64 2d 72 6f 77 20 31 29 29 0a 09 09 20 20 20 20 d-row 1))...
d3a0: 28 76 61 6c 75 65 20 20 20 20 20 20 20 28 61 6e (value (an
d3b0: 79 2d 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 y->number-if-pos
d3c0: 73 69 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 sible (list-ref
d3d0: 70 61 64 64 65 64 2d 72 6f 77 20 32 29 29 29 0a padded-row 2))).
d3e0: 09 09 20 20 20 20 28 65 78 70 65 63 74 65 64 20 .. (expected
d3f0: 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d (any->number-
d400: 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 if-possible (lis
d410: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
d420: 20 33 29 29 29 0a 09 09 20 20 20 20 28 74 6f 6c 3)))... (tol
d430: 20 20 20 20 20 20 20 20 20 28 61 6e 79 2d 3e 6e (any->n
d440: 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 69 62 6c umber-if-possibl
d450: 65 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 e (list-ref padd
d460: 65 64 2d 72 6f 77 20 34 29 29 29 20 3b 3b 20 3e ed-row 4))) ;; >
d470: 2c 20 3c 2c 20 3e 3d 2c 20 3c 3d 2c 20 6f 72 20 , <, >=, <=, or
d480: 61 20 6e 75 6d 62 65 72 0a 09 09 20 20 20 20 28 a number... (
d490: 75 6e 69 74 73 20 20 20 20 20 20 20 28 6c 69 73 units (lis
d4a0: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
d4b0: 20 35 29 29 0a 09 09 20 20 20 20 28 63 6f 6d 6d 5))... (comm
d4c0: 65 6e 74 20 20 20 20 20 28 6c 69 73 74 2d 72 65 ent (list-re
d4d0: 66 20 70 61 64 64 65 64 2d 72 6f 77 20 36 29 29 f padded-row 6))
d4e0: 0a 09 09 20 20 20 20 28 73 74 61 74 75 73 20 20 ... (status
d4f0: 20 20 20 20 28 6c 65 74 20 28 28 73 20 28 6c 69 (let ((s (li
d500: 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f st-ref padded-ro
d510: 77 20 37 29 29 29 0a 09 09 09 09 20 20 20 28 69 w 7)))..... (i
d520: 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 f (and (string?
d530: 73 29 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d 61 s)(or (string-ma
d540: 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 5c 5c tch (regexp "^\\
d550: 73 2a 24 22 29 20 73 29 0a 09 09 09 09 09 09 09 s*$") s)........
d560: 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 (string-match
d570: 20 28 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 22 (regexp "^n/a$"
d580: 29 20 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 ) s))).....
d590: 20 20 23 66 0a 09 09 09 09 20 20 20 20 20 20 20 #f.....
d5a0: 73 29 29 29 20 3b 3b 20 69 66 20 73 70 65 63 69 s))) ;; if speci
d5b0: 66 69 65 64 20 6f 6e 20 74 68 65 20 69 6e 70 75 fied on the inpu
d5c0: 74 20 74 68 65 6e 20 75 73 65 2c 20 65 6c 73 65 t then use, else
d5d0: 20 63 61 6c 63 75 6c 61 74 65 0a 09 09 20 20 20 calculate...
d5e0: 20 28 74 79 70 65 20 20 20 20 20 20 20 20 28 6c (type (l
d5f0: 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 ist-ref padded-r
d600: 6f 77 20 38 29 29 29 0a 09 20 20 20 20 20 20 20 ow 8)))..
d610: 3b 3b 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 63 ;; look up expec
d620: 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 72 ted,tol,units fr
d630: 6f 6d 20 70 72 65 76 69 6f 75 73 20 62 65 73 74 om previous best
d640: 20 66 69 74 20 74 65 73 74 20 69 66 20 74 68 65 fit test if the
d650: 79 20 61 72 65 20 61 6c 6c 20 65 69 74 68 65 72 y are all either
d660: 20 23 66 20 6f 72 20 27 27 0a 09 20 20 20 20 20 #f or ''..
d670: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
d680: 20 22 42 45 46 4f 52 45 3a 20 63 61 74 65 67 6f "BEFORE: catego
d690: 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 22 ry: " category "
d6a0: 20 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 72 variable: " var
d6b0: 69 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 22 iable " value: "
d6c0: 20 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 22 value .... "
d6d0: 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 78 , expected: " ex
d6e0: 70 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 20 pected " tol: "
d6f0: 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 75 tol " units: " u
d700: 6e 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 22 nits " status: "
d710: 20 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 6e status " commen
d720: 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 20 22 20 74 t: " comment " t
d730: 79 70 65 3a 20 22 20 74 79 70 65 29 0a 0a 09 20 ype: " type)...
d740: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
d750: 6f 72 20 28 6e 6f 74 20 65 78 70 65 63 74 65 64 or (not expected
d760: 29 28 65 71 75 61 6c 3f 20 65 78 70 65 63 74 65 )(equal? expecte
d770: 64 20 22 22 29 29 0a 09 09 09 28 6f 72 20 28 6e d ""))....(or (n
d780: 6f 74 20 74 6f 6c 29 20 20 20 20 20 28 65 71 75 ot tol) (equ
d790: 61 6c 3f 20 65 78 70 65 63 74 65 64 20 22 22 29 al? expected "")
d7a0: 29 0a 09 09 09 28 6f 72 20 28 6e 6f 74 20 75 6e )....(or (not un
d7b0: 69 74 73 29 20 20 20 28 65 71 75 61 6c 3f 20 65 its) (equal? e
d7c0: 78 70 65 63 74 65 64 20 22 22 29 29 29 0a 09 09 xpected "")))...
d7d0: 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 (let-values (
d7e0: 28 28 6e 65 77 2d 65 78 70 65 63 74 65 64 20 6e ((new-expected n
d7f0: 65 77 2d 74 6f 6c 20 6e 65 77 2d 75 6e 69 74 73 ew-tol new-units
d800: 29 28 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f )(db:get-prev-to
d810: 6c 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 l-for-test db te
d820: 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 st-id category v
d830: 61 72 69 61 62 6c 65 29 29 29 0a 09 09 09 20 20 ariable)))....
d840: 20 20 20 20 20 28 73 65 74 21 20 65 78 70 65 63 (set! expec
d850: 74 65 64 20 6e 65 77 2d 65 78 70 65 63 74 65 64 ted new-expected
d860: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
d870: 21 20 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d 74 ! tol new-t
d880: 6f 6c 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 ol).... (s
d890: 65 74 21 20 75 6e 69 74 73 20 20 20 20 6e 65 77 et! units new
d8a0: 2d 75 6e 69 74 73 29 29 29 0a 0a 09 20 20 20 20 -units)))...
d8b0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
d8c0: 34 20 22 41 46 54 45 52 3a 20 20 63 61 74 65 67 4 "AFTER: categ
d8d0: 6f 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 20 ory: " category
d8e0: 22 20 76 61 72 69 61 62 6c 65 3a 20 22 20 76 61 " variable: " va
d8f0: 72 69 61 62 6c 65 20 22 20 76 61 6c 75 65 3a 20 riable " value:
d900: 22 20 76 61 6c 75 65 20 0a 09 09 09 20 20 20 20 " value ....
d910: 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 ", expected: " e
d920: 78 70 65 63 74 65 64 20 22 20 74 6f 6c 3a 20 22 xpected " tol: "
d930: 20 74 6f 6c 20 22 20 75 6e 69 74 73 3a 20 22 20 tol " units: "
d940: 75 6e 69 74 73 20 22 20 73 74 61 74 75 73 3a 20 units " status:
d950: 22 20 73 74 61 74 75 73 20 22 20 63 6f 6d 6d 65 " status " comme
d960: 6e 74 3a 20 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 nt: " comment)..
d970: 20 20 20 20 20 20 20 3b 3b 20 63 61 6c 63 75 6c ;; calcul
d980: 61 74 65 20 73 74 61 74 75 73 20 69 66 20 4e 4f ate status if NO
d990: 54 20 73 70 65 63 69 66 69 65 64 0a 09 20 20 20 T specified..
d9a0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f (if (and (no
d9b0: 74 20 73 74 61 74 75 73 29 28 6e 75 6d 62 65 72 t status)(number
d9c0: 3f 20 65 78 70 65 63 74 65 64 29 28 6e 75 6d 62 ? expected)(numb
d9d0: 65 72 3f 20 76 61 6c 75 65 29 29 20 3b 3b 20 6e er? value)) ;; n
d9e0: 65 65 64 20 65 78 70 65 63 74 65 64 20 61 6e 64 eed expected and
d9f0: 20 76 61 6c 75 65 20 74 6f 20 62 65 20 6e 75 6d value to be num
da00: 62 65 72 73 0a 09 09 20 20 20 28 69 66 20 28 6e bers... (if (n
da10: 75 6d 62 65 72 3f 20 74 6f 6c 29 20 3b 3b 20 69 umber? tol) ;; i
da20: 66 20 74 6f 6c 20 69 73 20 61 20 6e 75 6d 62 65 f tol is a numbe
da30: 72 20 74 68 65 6e 20 77 65 20 64 6f 20 74 68 65 r then we do the
da40: 20 73 74 61 6e 64 61 72 64 20 63 6f 6d 70 61 72 standard compar
da50: 69 73 6f 6e 0a 09 09 20 20 20 20 20 20 20 28 6c ison... (l
da60: 65 74 2a 20 28 28 6d 61 78 2d 76 61 6c 20 28 2b et* ((max-val (+
da70: 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 29 0a expected tol)).
da80: 09 09 09 20 20 20 20 20 20 28 6d 69 6e 2d 76 61 ... (min-va
da90: 6c 20 28 2d 20 65 78 70 65 63 74 65 64 20 74 6f l (- expected to
daa0: 6c 29 29 0a 09 09 09 20 20 20 20 20 20 28 72 65 l)).... (re
dab0: 73 75 6c 74 20 20 28 61 6e 64 20 28 3e 3d 20 20 sult (and (>=
dac0: 76 61 6c 75 65 20 6d 69 6e 2d 76 61 6c 29 28 3c value min-val)(<
dad0: 3d 20 76 61 6c 75 65 20 6d 61 78 2d 76 61 6c 29 = value max-val)
dae0: 29 29 29 0a 09 09 09 20 28 64 65 62 75 67 3a 70 ))).... (debug:p
daf0: 72 69 6e 74 20 34 20 22 6d 61 78 2d 76 61 6c 3a rint 4 "max-val:
db00: 20 22 20 6d 61 78 2d 76 61 6c 20 22 20 6d 69 6e " max-val " min
db10: 2d 76 61 6c 3a 20 22 20 6d 69 6e 2d 76 61 6c 20 -val: " min-val
db20: 22 20 72 65 73 75 6c 74 3a 20 22 20 72 65 73 75 " result: " resu
db30: 6c 74 29 0a 09 09 09 20 28 73 65 74 21 20 73 74 lt).... (set! st
db40: 61 74 75 73 20 28 69 66 20 72 65 73 75 6c 74 20 atus (if result
db50: 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 29 29 "pass" "fail")))
db60: 0a 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
db70: 73 74 61 74 75 73 20 3b 3b 20 4e 42 2f 2f 20 6e status ;; NB// n
db80: 65 65 64 20 74 6f 20 61 73 73 65 73 73 20 65 61 eed to assess ea
db90: 63 68 20 6f 6e 65 20 28 69 2e 65 2e 20 6e 6f 74 ch one (i.e. not
dba0: 20 72 65 74 75 72 6e 20 6f 70 65 72 61 74 6f 72 return operator
dbb0: 20 73 69 6e 63 65 20 6e 65 65 64 20 74 6f 20 61 since need to a
dbc0: 63 74 20 69 66 20 6e 6f 74 20 76 61 6c 69 64 20 ct if not valid
dbd0: 6f 70 2e 0a 09 09 09 20 20 20 20 20 28 63 61 73 op..... (cas
dbe0: 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f e (string->symbo
dbf0: 6c 20 74 6f 6c 29 20 3b 3b 20 74 6f 6c 20 73 68 l tol) ;; tol sh
dc00: 6f 75 6c 64 20 62 65 20 3e 2c 20 3c 2c 20 3e 3d ould be >, <, >=
dc10: 2c 20 3c 3d 0a 09 09 09 20 20 20 20 20 20 20 28 , <=.... (
dc20: 28 3e 29 20 20 28 69 66 20 28 3e 20 20 76 61 6c (>) (if (> val
dc30: 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 61 ue expected) "pa
dc40: 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 ss" "fail"))....
dc50: 20 20 20 20 20 20 20 28 28 3c 29 20 20 28 69 66 ((<) (if
dc60: 20 28 3c 20 20 76 61 6c 75 65 20 65 78 70 65 63 (< value expec
dc70: 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 69 ted) "pass" "fai
dc80: 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 l")).... (
dc90: 28 3e 3d 29 20 28 69 66 20 28 3e 3d 20 76 61 6c (>=) (if (>= val
dca0: 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 61 ue expected) "pa
dcb0: 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 ss" "fail"))....
dcc0: 20 20 20 20 20 20 20 28 28 3c 3d 29 20 28 69 66 ((<=) (if
dcd0: 20 28 3c 3d 20 76 61 6c 75 65 20 65 78 70 65 63 (<= value expec
dce0: 74 65 64 29 20 22 70 61 73 73 22 20 22 66 61 69 ted) "pass" "fai
dcf0: 6c 22 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 l")).... (
dd00: 65 6c 73 65 20 28 63 6f 6e 63 20 22 45 52 52 4f else (conc "ERRO
dd10: 52 3a 20 62 61 64 20 74 6f 6c 20 63 6f 6d 70 61 R: bad tol compa
dd20: 72 61 74 6f 72 20 22 20 74 6f 6c 29 29 29 29 29 rator " tol)))))
dd30: 29 0a 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ).. (debug
dd40: 3a 70 72 69 6e 74 20 34 20 22 41 46 54 45 52 32 :print 4 "AFTER2
dd50: 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 : category: " ca
dd60: 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c tegory " variabl
dd70: 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 20 e: " variable "
dd80: 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a value: " value .
dd90: 09 09 09 20 20 20 20 22 2c 20 65 78 70 65 63 74 ... ", expect
dda0: 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 20 22 ed: " expected "
ddb0: 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e tol: " tol " un
ddc0: 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73 its: " units " s
ddd0: 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 tatus: " status
dde0: 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d " comment: " com
ddf0: 6d 65 6e 74 29 0a 09 20 20 20 20 20 20 20 28 73 ment).. (s
de00: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 74 qlite3:execute t
de10: 64 62 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 db "INSERT OR RE
de20: 50 4c 41 43 45 20 49 4e 54 4f 20 74 65 73 74 5f PLACE INTO test_
de30: 64 61 74 61 20 28 74 65 73 74 5f 69 64 2c 63 61 data (test_id,ca
de40: 74 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c tegory,variable,
de50: 76 61 6c 75 65 2c 65 78 70 65 63 74 65 64 2c 74 value,expected,t
de60: 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 ol,units,comment
de70: 2c 73 74 61 74 75 73 2c 74 79 70 65 29 20 56 41 ,status,type) VA
de80: 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c LUES (?,?,?,?,?,
de90: 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 09 09 ?,?,?,?,?);"....
dea0: 09 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 .test-id categor
deb0: 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 65 y variable value
dec0: 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 6e expected tol un
ded0: 69 74 73 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 its (if comment
dee0: 63 6f 6d 6d 65 6e 74 20 22 22 29 20 73 74 61 74 comment "") stat
def0: 75 73 20 74 79 70 65 29 0a 09 20 20 20 20 20 20 us type)..
df00: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
df10: 7a 65 21 20 74 64 62 29 29 29 0a 09 20 20 20 63 ze! tdb))).. c
df20: 73 76 6c 69 73 74 29 29 29 29 29 0a 0a 3b 3b 20 svlist)))))..;;
df30: 67 65 74 20 61 20 6c 69 73 74 20 6f 66 20 74 65 get a list of te
df40: 73 74 5f 64 61 74 61 20 72 65 63 6f 72 64 73 20 st_data records
df50: 6d 61 74 63 68 69 6e 67 20 63 61 74 65 67 6f 72 matching categor
df60: 79 70 61 74 74 0a 28 64 65 66 69 6e 65 20 28 64 ypatt.(define (d
df70: 62 3a 72 65 61 64 2d 74 65 73 74 2d 64 61 74 61 b:read-test-data
df80: 20 64 62 20 74 65 73 74 2d 69 64 20 63 61 74 65 db test-id cate
df90: 67 6f 72 79 70 61 74 74 29 0a 20 20 28 6c 65 74 gorypatt). (let
dfa0: 20 28 28 74 64 62 20 20 28 64 62 3a 6f 70 65 6e ((tdb (db:open
dfb0: 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 -test-db-by-test
dfc0: 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 -id db test-id))
dfd0: 29 0a 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 ). (if tdb..(
dfe0: 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a let ((res '())).
dff0: 09 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d . (sqlite3:for-
e000: 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c each-row .. (l
e010: 61 6d 62 64 61 20 28 69 64 20 74 65 73 74 5f 69 ambda (id test_i
e020: 64 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 d category varia
e030: 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 ble value expect
e040: 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 63 6f 6d ed tol units com
e050: 6d 65 6e 74 20 73 74 61 74 75 73 20 74 79 70 65 ment status type
e060: 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 72 65 ).. (set! re
e070: 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 s (cons (vector
e080: 69 64 20 74 65 73 74 5f 69 64 20 63 61 74 65 67 id test_id categ
e090: 6f 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c ory variable val
e0a0: 75 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 ue expected tol
e0b0: 75 6e 69 74 73 20 63 6f 6d 6d 65 6e 74 20 73 74 units comment st
e0c0: 61 74 75 73 20 74 79 70 65 29 20 72 65 73 29 29 atus type) res))
e0d0: 29 0a 09 20 20 20 74 64 62 0a 09 20 20 20 22 53 ).. tdb.. "S
e0e0: 45 4c 45 43 54 20 69 64 2c 74 65 73 74 5f 69 64 ELECT id,test_id
e0f0: 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 ,category,variab
e100: 6c 65 2c 76 61 6c 75 65 2c 65 78 70 65 63 74 65 le,value,expecte
e110: 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d 6d d,tol,units,comm
e120: 65 6e 74 2c 73 74 61 74 75 73 2c 74 79 70 65 20 ent,status,type
e130: 46 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 FROM test_data W
e140: 48 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 HERE test_id=? A
e150: 4e 44 20 63 61 74 65 67 6f 72 79 20 4c 49 4b 45 ND category LIKE
e160: 20 3f 20 4f 52 44 45 52 20 42 59 20 63 61 74 65 ? ORDER BY cate
e170: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 3b 22 20 gory,variable;"
e180: 74 65 73 74 2d 69 64 20 63 61 74 65 67 6f 72 79 test-id category
e190: 70 61 74 74 29 0a 09 20 20 28 73 71 6c 69 74 65 patt).. (sqlite
e1a0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 3:finalize! tdb)
e1b0: 0a 09 20 20 28 72 65 76 65 72 73 65 20 72 65 73 .. (reverse res
e1c0: 29 29 0a 09 27 28 29 29 29 29 0a 0a 28 64 65 66 ))..'())))..(def
e1d0: 69 6e 65 20 28 64 62 3a 6c 6f 61 64 2d 74 65 73 ine (db:load-tes
e1e0: 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d 69 t-data db test-i
e1f0: 64 29 0a 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 d). (let loop (
e200: 28 6c 69 6e 20 28 72 65 61 64 2d 6c 69 6e 65 29 (lin (read-line)
e210: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
e220: 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 6c 69 6e (eof-object? lin
e230: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
e240: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 6c 69 6e ebug:print 4 lin
e250: 29 0a 09 20 20 28 64 62 3a 63 73 76 2d 3e 74 65 ).. (db:csv->te
e260: 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 2d st-data db test-
e270: 69 64 20 6c 69 6e 29 0a 09 20 20 28 6c 6f 6f 70 id lin).. (loop
e280: 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 29 29 (read-line)))))
e290: 0a 20 20 3b 3b 20 72 6f 6c 6c 20 75 70 20 74 68 . ;; roll up th
e2a0: 65 20 63 75 72 72 65 6e 74 20 72 65 73 75 6c 74 e current result
e2b0: 73 2e 0a 20 20 3b 3b 20 46 49 58 4d 45 3a 20 41 s.. ;; FIXME: A
e2c0: 64 64 20 74 68 65 20 73 74 61 74 75 73 20 74 6f dd the status to
e2d0: 20 0a 20 20 28 64 62 3a 74 65 73 74 2d 64 61 74 . (db:test-dat
e2e0: 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 a-rollup db test
e2f0: 2d 69 64 20 23 66 29 29 0a 0a 3b 3b 20 57 41 52 -id #f))..;; WAR
e300: 4e 49 4e 47 3a 20 44 6f 20 4e 4f 54 20 63 61 6c NING: Do NOT cal
e310: 6c 20 74 68 69 73 20 66 6f 72 20 74 68 65 20 70 l this for the p
e320: 61 72 65 6e 74 20 74 65 73 74 20 6f 6e 20 61 6e arent test on an
e330: 20 69 74 65 72 61 74 65 64 20 74 65 73 74 0a 3b iterated test.;
e340: 3b 20 52 6f 6c 6c 20 75 70 20 74 65 73 74 5f 64 ; Roll up test_d
e350: 61 74 61 20 70 61 73 73 2f 66 61 69 6c 20 72 65 ata pass/fail re
e360: 73 75 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b 20 61 74 sults.;; look at
e370: 20 74 68 65 20 74 65 73 74 5f 64 61 74 61 20 73 the test_data s
e380: 74 61 74 75 73 20 66 69 65 6c 64 2c 20 0a 3b 3b tatus field, .;;
e390: 20 20 20 20 69 66 20 61 6c 6c 20 61 72 65 20 70 if all are p
e3a0: 61 73 73 20 28 61 6e 79 20 63 61 73 65 29 20 61 ass (any case) a
e3b0: 6e 64 20 74 68 65 20 74 65 73 74 20 73 74 61 74 nd the test stat
e3c0: 75 73 20 69 73 20 50 41 53 53 20 6f 72 20 4e 55 us is PASS or NU
e3d0: 4c 4c 20 6f 72 20 27 27 20 74 68 65 6e 20 73 65 LL or '' then se
e3e0: 74 20 74 65 73 74 20 73 74 61 74 75 73 20 74 6f t test status to
e3f0: 20 50 41 53 53 2e 0a 3b 3b 20 20 20 20 69 66 20 PASS..;; if
e400: 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 61 72 65 20 one or more are
e410: 66 61 69 6c 20 28 61 6e 79 20 63 61 73 65 29 20 fail (any case)
e420: 74 68 65 6e 20 73 65 74 20 74 65 73 74 20 73 74 then set test st
e430: 61 74 75 73 20 74 6f 20 50 41 53 53 2c 20 6e 6f atus to PASS, no
e440: 6e 20 22 70 61 73 73 22 20 6f 72 20 22 66 61 69 n "pass" or "fai
e450: 6c 22 20 61 72 65 20 69 67 6e 6f 72 65 64 0a 28 l" are ignored.(
e460: 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 2d define (db:test-
e470: 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 74 data-rollup db t
e480: 65 73 74 2d 69 64 20 73 74 61 74 75 73 29 0a 20 est-id status).
e490: 20 28 6c 65 74 20 28 28 74 64 62 20 28 6f 70 65 (let ((tdb (ope
e4a0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 6f n-run-close db:o
e4b0: 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 pen-test-db-by-t
e4c0: 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 est-id db test-i
e4d0: 64 29 29 0a 09 28 66 61 69 6c 2d 63 6f 75 6e 74 d))..(fail-count
e4e0: 20 30 29 0a 09 28 70 61 73 73 2d 63 6f 75 6e 74 0)..(pass-count
e4f0: 20 30 29 29 0a 20 20 20 20 28 69 66 20 74 64 62 0)). (if tdb
e500: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c ..(begin.. (sql
e510: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
e520: 77 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 66 w.. (lambda (f
e530: 63 6f 75 6e 74 20 70 63 6f 75 6e 74 29 0a 09 20 count pcount)..
e540: 20 20 20 20 28 73 65 74 21 20 66 61 69 6c 2d 63 (set! fail-c
e550: 6f 75 6e 74 20 66 63 6f 75 6e 74 29 0a 09 20 20 ount fcount)..
e560: 20 20 20 28 73 65 74 21 20 70 61 73 73 2d 63 6f (set! pass-co
e570: 75 6e 74 20 70 63 6f 75 6e 74 29 29 0a 09 20 20 unt pcount))..
e580: 20 74 64 62 20 0a 09 20 20 20 22 53 45 4c 45 43 tdb .. "SELEC
e590: 54 20 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 T (SELECT count(
e5a0: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 5f 64 61 id) FROM test_da
e5b0: 74 61 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 ta WHERE test_id
e5c0: 3d 3f 20 41 4e 44 20 73 74 61 74 75 73 20 6c 69 =? AND status li
e5d0: 6b 65 20 27 66 61 69 6c 27 29 20 41 53 20 66 61 ke 'fail') AS fa
e5e0: 69 6c 5f 63 6f 75 6e 74 2c 0a 20 20 20 20 20 20 il_count,.
e5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 53 45 (SE
e600: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
e610: 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 ROM test_data WH
e620: 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e ERE test_id=? AN
e630: 44 20 73 74 61 74 75 73 20 6c 69 6b 65 20 27 70 D status like 'p
e640: 61 73 73 27 29 20 41 53 20 70 61 73 73 5f 63 6f ass') AS pass_co
e650: 75 6e 74 3b 22 0a 09 20 20 20 74 65 73 74 2d 69 unt;".. test-i
e660: 64 20 74 65 73 74 2d 69 64 29 0a 09 20 20 28 73 d test-id).. (s
e670: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
e680: 20 74 64 62 29 0a 0a 09 20 20 3b 3b 20 4e 6f 77 tdb)... ;; Now
e690: 20 72 6f 6c 6c 75 70 20 74 68 65 20 63 6f 75 6e rollup the coun
e6a0: 74 73 20 74 6f 20 74 68 65 20 63 65 6e 74 72 61 ts to the centra
e6b0: 6c 20 6d 65 67 61 74 65 73 74 2e 64 62 0a 09 20 l megatest.db..
e6c0: 20 28 72 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d (rdb:pass-fail-
e6d0: 63 6f 75 6e 74 73 20 74 65 73 74 2d 69 64 20 66 counts test-id f
e6e0: 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 ail-count pass-c
e6f0: 6f 75 6e 74 29 0a 09 20 20 3b 3b 20 28 73 71 6c ount).. ;; (sql
e700: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
e710: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
e720: 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70 T fail_count=?,p
e730: 61 73 73 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 52 ass_count=? WHER
e740: 45 20 69 64 3d 3f 3b 22 20 0a 09 20 20 3b 3b 20 E id=?;" .. ;;
e750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e760: 20 20 20 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 fail-count p
e770: 61 73 73 2d 63 6f 75 6e 74 20 74 65 73 74 2d 69 ass-count test-i
e780: 64 29 0a 0a 09 20 20 28 74 68 72 65 61 64 2d 73 d)... (thread-s
e790: 6c 65 65 70 21 20 31 30 29 20 3b 3b 20 70 6c 61 leep! 10) ;; pla
e7a0: 79 20 6e 69 63 65 20 77 69 74 68 20 74 68 65 20 y nice with the
e7b0: 71 75 65 75 65 20 62 79 20 65 6e 73 75 72 69 6e queue by ensurin
e7c0: 67 20 74 68 65 20 72 6f 6c 6c 75 70 20 69 73 20 g the rollup is
e7d0: 61 74 20 6c 65 61 73 74 20 31 30 73 20 6c 61 74 at least 10s lat
e7e0: 65 72 20 74 68 61 6e 20 74 68 65 20 73 65 74 0a er than the set.
e7f0: 09 20 20 0a 09 20 20 3b 3b 20 69 66 20 74 68 65 . .. ;; if the
e800: 20 74 65 73 74 20 69 73 20 6e 6f 74 20 46 41 49 test is not FAI
e810: 4c 20 74 68 65 6e 20 73 65 74 20 73 74 61 74 75 L then set statu
e820: 73 20 62 61 73 65 64 20 6f 6e 20 74 68 65 20 66 s based on the f
e830: 61 69 6c 20 61 6e 64 20 70 61 73 73 20 63 6f 75 ail and pass cou
e840: 6e 74 73 2e 0a 09 20 20 28 72 64 62 3a 74 65 73 nts... (rdb:tes
e850: 74 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 t-rollup-test_da
e860: 74 61 2d 70 61 73 73 2d 66 61 69 6c 20 74 65 73 ta-pass-fail tes
e870: 74 2d 69 64 29 0a 09 20 20 3b 3b 20 28 73 71 6c t-id).. ;; (sql
e880: 69 74 65 33 3a 65 78 65 63 75 74 65 0a 09 20 20 ite3:execute..
e890: 3b 3b 20 20 64 62 20 20 20 3b 3b 3b 20 4e 4f 54 ;; db ;;; NOT
e8a0: 45 3a 20 53 68 6f 75 6c 64 20 74 68 69 73 20 62 E: Should this b
e8b0: 65 20 57 41 52 4e 2c 46 41 49 4c 3f 20 41 20 57 e WARN,FAIL? A W
e8c0: 41 52 4e 20 69 73 20 6e 6f 74 20 61 20 46 41 49 ARN is not a FAI
e8d0: 4c 3f 3f 3f 3f 3f 20 42 55 47 20 46 49 58 4d 45 L????? BUG FIXME
e8e0: 0a 09 20 20 3b 3b 20 20 22 55 50 44 41 54 45 20 .. ;; "UPDATE
e8f0: 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 tests.
e900: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 53 ;; S
e910: 45 54 20 73 74 61 74 75 73 3d 43 41 53 45 20 57 ET status=CASE W
e920: 48 45 4e 20 28 53 45 4c 45 43 54 20 66 61 69 6c HEN (SELECT fail
e930: 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 74 65 73 74 _count FROM test
e940: 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 3e 20 s WHERE id=?) >
e950: 30 20 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 0 . ;;
e960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54 T
e970: 48 45 4e 20 27 46 41 49 4c 27 0a 20 20 20 20 20 HEN 'FAIL'.
e980: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
e990: 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 WHEN (SELECT
e9a0: 20 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d pass_count FROM
e9b0: 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d tests WHERE id=
e9c0: 3f 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 ?) > 0 AND .
e9d0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
e9e0: 20 20 20 20 20 20 20 20 20 20 28 53 45 4c 45 43 (SELEC
e9f0: 54 20 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65 T status FROM te
ea00: 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f 29 20 sts WHERE id=?)
ea10: 4e 4f 54 20 49 4e 20 28 27 57 41 52 4e 27 2c 27 NOT IN ('WARN','
ea20: 46 41 49 4c 27 29 0a 20 20 20 20 20 20 20 20 20 FAIL').
ea30: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
ea40: 54 48 45 4e 20 27 50 41 53 53 27 0a 20 20 20 20 THEN 'PASS'.
ea50: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
ea60: 20 20 20 20 20 45 4c 53 45 20 73 74 61 74 75 73 ELSE status
ea70: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 . ;;
ea80: 20 20 20 20 20 20 45 4e 44 20 57 48 45 52 45 20 END WHERE
ea90: 69 64 3d 3f 3b 22 0a 09 20 20 3b 3b 20 20 74 65 id=?;".. ;; te
eaa0: 73 74 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 st-id test-id te
eab0: 73 74 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 st-id test-id)..
eac0: 20 20 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))..(define
ead0: 28 64 62 3a 67 65 74 2d 70 72 65 76 2d 74 6f 6c (db:get-prev-tol
eae0: 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 65 73 -for-test db tes
eaf0: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 t-id category va
eb00: 72 69 61 62 6c 65 29 0a 20 20 3b 3b 20 46 69 6e riable). ;; Fin
eb10: 69 73 68 20 6d 65 3f 0a 20 20 28 76 61 6c 75 65 ish me?. (value
eb20: 73 20 23 66 20 23 66 20 23 66 29 29 0a 0a 3b 3b s #f #f #f))..;;
eb30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eb70: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 54 20 45 20 ======.;; S T E
eb80: 50 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d P S .;;=========
eb90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ebc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
ebd0: 64 65 66 69 6e 65 20 28 64 62 3a 73 74 65 70 2d define (db:step-
ebe0: 67 65 74 2d 74 69 6d 65 2d 61 73 2d 73 74 72 69 get-time-as-stri
ebf0: 6e 67 20 76 65 63 29 0a 20 20 28 73 65 63 6f 6e ng vec). (secon
ec00: 64 73 2d 3e 74 69 6d 65 2d 73 74 72 69 6e 67 20 ds->time-string
ec10: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 (db:step-get-eve
ec20: 6e 74 5f 74 69 6d 65 20 76 65 63 29 29 29 0a 0a nt_time vec)))..
ec30: 3b 3b 20 64 62 2d 67 65 74 2d 74 65 73 74 2d 73 ;; db-get-test-s
ec40: 74 65 70 73 2d 66 6f 72 2d 72 75 6e 0a 28 64 65 teps-for-run.(de
ec50: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 65 fine (db:get-ste
ec60: 70 73 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 74 ps-for-test db t
ec70: 65 73 74 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 est-id). (let*
ec80: 28 28 74 64 62 20 28 64 62 3a 6f 70 65 6e 2d 74 ((tdb (db:open-t
ec90: 65 73 74 2d 64 62 2d 62 79 2d 74 65 73 74 2d 69 est-db-by-test-i
eca0: 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 d db test-id))..
ecb0: 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 (res '())).
ecc0: 28 69 66 20 74 64 62 0a 09 28 62 65 67 69 6e 0a (if tdb..(begin.
ecd0: 09 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d . (sqlite3:for-
ece0: 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c each-row .. (l
ecf0: 61 6d 62 64 61 20 28 69 64 20 74 65 73 74 2d 69 ambda (id test-i
ed00: 64 20 73 74 65 70 6e 61 6d 65 20 73 74 61 74 65 d stepname state
ed10: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
ed20: 6d 65 20 6c 6f 67 66 69 6c 65 29 0a 09 20 20 20 me logfile)..
ed30: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
ed40: 73 20 28 76 65 63 74 6f 72 20 69 64 20 74 65 73 s (vector id tes
ed50: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 73 74 t-id stepname st
ed60: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
ed70: 2d 74 69 6d 65 20 28 69 66 20 28 73 74 72 69 6e -time (if (strin
ed80: 67 3f 20 6c 6f 67 66 69 6c 65 29 20 6c 6f 67 66 g? logfile) logf
ed90: 69 6c 65 20 22 22 29 29 20 72 65 73 29 29 29 0a ile "")) res))).
eda0: 09 20 20 20 74 64 62 0a 09 20 20 20 22 53 45 4c . tdb.. "SEL
edb0: 45 43 54 20 69 64 2c 74 65 73 74 5f 69 64 2c 73 ECT id,test_id,s
edc0: 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 tepname,state,st
edd0: 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c atus,event_time,
ede0: 6c 6f 67 66 69 6c 65 20 46 52 4f 4d 20 74 65 73 logfile FROM tes
edf0: 74 5f 73 74 65 70 73 20 57 48 45 52 45 20 74 65 t_steps WHERE te
ee00: 73 74 5f 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 st_id=? ORDER BY
ee10: 20 69 64 20 41 53 43 3b 22 20 3b 3b 20 65 76 65 id ASC;" ;; eve
ee20: 6e 74 5f 74 69 6d 65 20 44 45 53 43 2c 69 64 20 nt_time DESC,id
ee30: 41 53 43 3b 0a 09 20 20 20 74 65 73 74 2d 69 64 ASC;.. test-id
ee40: 29 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 66 69 ).. (sqlite3:fi
ee50: 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 20 20 nalize! tdb)..
ee60: 28 72 65 76 65 72 73 65 20 72 65 73 29 29 0a 09 (reverse res))..
ee70: 27 28 29 29 29 29 0a 0a 3b 3b 20 67 65 74 20 61 '())))..;; get a
ee80: 20 70 72 65 74 74 79 20 74 61 62 6c 65 20 74 6f pretty table to
ee90: 20 73 75 6d 6d 61 72 69 7a 65 20 73 74 65 70 73 summarize steps
eea0: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a .;;.(define (db:
eeb0: 67 65 74 2d 73 74 65 70 73 2d 74 61 62 6c 65 20 get-steps-table
eec0: 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 28 6c db test-id). (l
eed0: 65 74 20 28 28 73 74 65 70 73 20 20 20 28 64 62 et ((steps (db
eee0: 3a 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 :get-steps-for-t
eef0: 65 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 29 est db test-id))
ef00: 29 0a 20 20 20 20 3b 3b 20 6f 72 67 61 6e 69 73 ). ;; organis
ef10: 65 20 74 68 65 20 73 74 65 70 73 20 66 6f 72 20 e the steps for
ef20: 62 65 74 74 65 72 20 72 65 61 64 61 62 69 6c 69 better readabili
ef30: 74 79 0a 20 20 20 20 28 6c 65 74 20 28 28 72 65 ty. (let ((re
ef40: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
ef50: 6c 65 29 29 29 0a 20 20 20 20 20 20 28 66 6f 72 le))). (for
ef60: 2d 65 61 63 68 20 0a 20 20 20 20 20 20 20 28 6c -each . (l
ef70: 61 6d 62 64 61 20 28 73 74 65 70 29 0a 09 20 28 ambda (step).. (
ef80: 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 22 73 debug:print 6 "s
ef90: 74 65 70 3d 22 20 73 74 65 70 29 0a 09 20 28 6c tep=" step).. (l
efa0: 65 74 20 28 28 72 65 63 6f 72 64 20 28 68 61 73 et ((record (has
efb0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
efc0: 75 6c 74 20 0a 09 09 09 72 65 73 20 0a 09 09 09 ult ....res ....
efd0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
efe0: 70 6e 61 6d 65 20 73 74 65 70 29 20 0a 09 09 09 pname step) ....
eff0: 3b 3b 20 20 20 20 20 20 20 20 73 74 65 70 6e 61 ;; stepna
f000: 6d 65 20 20 20 20 20 20 20 20 20 20 20 20 20 20 me
f010: 20 20 73 74 61 72 74 20 65 6e 64 20 73 74 61 74 start end stat
f020: 75 73 20 20 20 20 0a 09 09 09 28 76 65 63 74 6f us ....(vecto
f030: 72 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 r (db:step-get-s
f040: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 20 22 22 tepname step) ""
f050: 20 20 20 22 22 20 22 22 20 20 20 20 20 22 22 20 "" "" ""
f060: 22 22 29 29 29 29 0a 09 20 20 20 28 64 65 62 75 "")))).. (debu
f070: 67 3a 70 72 69 6e 74 20 36 20 22 72 65 63 6f 72 g:print 6 "recor
f080: 64 28 62 65 66 6f 72 65 29 20 3d 20 22 20 72 65 d(before) = " re
f090: 63 6f 72 64 20 0a 09 09 09 22 5c 6e 69 64 3a 20 cord ...."\nid:
f0a0: 20 20 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 " (db:step
f0b0: 2d 67 65 74 2d 69 64 20 73 74 65 70 29 0a 09 09 -get-id step)...
f0c0: 09 22 5c 6e 73 74 65 70 6e 61 6d 65 3a 20 22 20 ."\nstepname: "
f0d0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 (db:step-get-ste
f0e0: 70 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 22 pname step)...."
f0f0: 5c 6e 73 74 61 74 65 3a 20 20 20 20 22 20 28 64 \nstate: " (d
f100: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 b:step-get-state
f110: 20 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 step)...."\nsta
f120: 74 75 73 3a 20 20 20 22 20 28 64 62 3a 73 74 65 tus: " (db:ste
f130: 70 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 p-get-status ste
f140: 70 29 0a 09 09 09 22 5c 6e 74 69 6d 65 3a 20 20 p)...."\ntime:
f150: 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 " (db:step-ge
f160: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 t-event_time ste
f170: 70 29 29 0a 09 20 20 20 28 63 61 73 65 20 28 73 p)).. (case (s
f180: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 64 tring->symbol (d
f190: 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 b:step-get-state
f1a0: 20 73 74 65 70 29 29 0a 09 20 20 20 20 20 28 28 step)).. ((
f1b0: 73 74 61 72 74 29 28 76 65 63 74 6f 72 2d 73 65 start)(vector-se
f1c0: 74 21 20 72 65 63 6f 72 64 20 31 20 28 64 62 3a t! record 1 (db:
f1d0: 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 step-get-event_t
f1e0: 69 6d 65 20 73 74 65 70 29 29 0a 09 20 20 20 20 ime step))..
f1f0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
f200: 65 63 6f 72 64 20 33 20 28 69 66 20 28 65 71 75 ecord 3 (if (equ
f210: 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 al? (vector-ref
f220: 72 65 63 6f 72 64 20 33 29 20 22 22 29 0a 09 09 record 3) "")...
f230: 09 09 09 28 64 62 3a 73 74 65 70 2d 67 65 74 2d ...(db:step-get-
f240: 73 74 61 74 75 73 20 73 74 65 70 29 29 29 0a 09 status step)))..
f250: 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 73 74 (if (> (st
f260: 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 64 62 3a ring-length (db:
f270: 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 step-get-logfile
f280: 20 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 30 step))... 0
f290: 29 0a 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 )... (vector-se
f2a0: 74 21 20 72 65 63 6f 72 64 20 35 20 28 64 62 3a t! record 5 (db:
f2b0: 73 74 65 70 2d 67 65 74 2d 6c 6f 67 66 69 6c 65 step-get-logfile
f2c0: 20 73 74 65 70 29 29 29 29 0a 09 20 20 20 20 20 step))))..
f2d0: 28 28 65 6e 64 29 20 20 0a 09 20 20 20 20 20 20 ((end) ..
f2e0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 (vector-set! rec
f2f0: 6f 72 64 20 32 20 28 61 6e 79 2d 3e 6e 75 6d 62 ord 2 (any->numb
f300: 65 72 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d er (db:step-get-
f310: 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 29 event_time step)
f320: 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f )).. (vecto
f330: 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 20 r-set! record 3
f340: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 (db:step-get-sta
f350: 74 75 73 20 73 74 65 70 29 29 0a 09 20 20 20 20 tus step))..
f360: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
f370: 65 63 6f 72 64 20 34 20 28 6c 65 74 20 28 28 73 ecord 4 (let ((s
f380: 74 61 72 74 74 20 28 61 6e 79 2d 3e 6e 75 6d 62 tartt (any->numb
f390: 65 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 er (vector-ref r
f3a0: 65 63 6f 72 64 20 31 29 29 29 0a 09 09 09 09 09 ecord 1)))......
f3b0: 20 20 28 65 6e 64 74 20 20 20 28 61 6e 79 2d 3e (endt (any->
f3c0: 6e 75 6d 62 65 72 20 28 76 65 63 74 6f 72 2d 72 number (vector-r
f3d0: 65 66 20 72 65 63 6f 72 64 20 32 29 29 29 29 0a ef record 2)))).
f3e0: 09 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 .... (debug
f3f0: 3a 70 72 69 6e 74 20 34 20 22 72 65 63 6f 72 64 :print 4 "record
f400: 5b 31 5d 3d 22 20 28 76 65 63 74 6f 72 2d 72 65 [1]=" (vector-re
f410: 66 20 72 65 63 6f 72 64 20 31 29 20 0a 09 09 09 f record 1) ....
f420: 09 09 09 20 20 20 22 2c 20 73 74 61 72 74 74 3d ... ", startt=
f430: 22 20 73 74 61 72 74 74 20 22 2c 20 65 6e 64 74 " startt ", endt
f440: 3d 22 20 65 6e 64 74 0a 09 09 09 09 09 09 20 20 =" endt.......
f450: 20 22 2c 20 67 65 74 2d 73 74 61 74 75 73 3a 20 ", get-status:
f460: 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 " (db:step-get-s
f470: 74 61 74 75 73 20 73 74 65 70 29 29 0a 09 09 09 tatus step))....
f480: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
f490: 28 6e 75 6d 62 65 72 3f 20 73 74 61 72 74 74 29 (number? startt)
f4a0: 28 6e 75 6d 62 65 72 3f 20 65 6e 64 74 29 29 0a (number? endt)).
f4b0: 09 09 09 09 09 20 20 28 73 65 63 6f 6e 64 73 2d ..... (seconds-
f4c0: 3e 68 72 2d 6d 69 6e 2d 73 65 63 20 28 2d 20 65 >hr-min-sec (- e
f4d0: 6e 64 74 20 73 74 61 72 74 74 29 29 20 22 2d 31 ndt startt)) "-1
f4e0: 22 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 "))).. (if
f4f0: 28 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 (> (string-lengt
f500: 68 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 6c h (db:step-get-l
f510: 6f 67 66 69 6c 65 20 73 74 65 70 29 29 0a 09 09 ogfile step))...
f520: 20 20 20 20 20 30 29 0a 09 09 20 20 28 76 65 63 0)... (vec
f530: 74 6f 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 tor-set! record
f540: 35 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 6c 5 (db:step-get-l
f550: 6f 67 66 69 6c 65 20 73 74 65 70 29 29 29 29 0a ogfile step)))).
f560: 09 20 20 20 20 20 28 65 6c 73 65 0a 09 20 20 20 . (else..
f570: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
f580: 72 65 63 6f 72 64 20 32 20 28 64 62 3a 73 74 65 record 2 (db:ste
f590: 70 2d 67 65 74 2d 73 74 61 74 65 20 73 74 65 70 p-get-state step
f5a0: 29 29 0a 09 20 20 20 20 20 20 28 76 65 63 74 6f )).. (vecto
f5b0: 72 2d 73 65 74 21 20 72 65 63 6f 72 64 20 33 20 r-set! record 3
f5c0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 (db:step-get-sta
f5d0: 74 75 73 20 73 74 65 70 29 29 0a 09 20 20 20 20 tus step))..
f5e0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 (vector-set! r
f5f0: 65 63 6f 72 64 20 34 20 28 64 62 3a 73 74 65 70 ecord 4 (db:step
f600: 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 -get-event_time
f610: 73 74 65 70 29 29 29 29 0a 09 20 20 20 28 68 61 step)))).. (ha
f620: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 72 65 sh-table-set! re
f630: 73 20 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 s (db:step-get-s
f640: 74 65 70 6e 61 6d 65 20 73 74 65 70 29 20 72 65 tepname step) re
f650: 63 6f 72 64 29 0a 09 20 20 20 28 64 65 62 75 67 cord).. (debug
f660: 3a 70 72 69 6e 74 20 36 20 22 72 65 63 6f 72 64 :print 6 "record
f670: 28 61 66 74 65 72 29 20 20 3d 20 22 20 72 65 63 (after) = " rec
f680: 6f 72 64 20 0a 09 09 09 22 5c 6e 69 64 3a 20 20 ord ...."\nid:
f690: 20 20 20 20 20 22 20 28 64 62 3a 73 74 65 70 2d " (db:step-
f6a0: 67 65 74 2d 69 64 20 73 74 65 70 29 0a 09 09 09 get-id step)....
f6b0: 22 5c 6e 73 74 65 70 6e 61 6d 65 3a 20 22 20 28 "\nstepname: " (
f6c0: 64 62 3a 73 74 65 70 2d 67 65 74 2d 73 74 65 70 db:step-get-step
f6d0: 6e 61 6d 65 20 73 74 65 70 29 0a 09 09 09 22 5c name step)...."\
f6e0: 6e 73 74 61 74 65 3a 20 20 20 20 22 20 28 64 62 nstate: " (db
f6f0: 3a 73 74 65 70 2d 67 65 74 2d 73 74 61 74 65 20 :step-get-state
f700: 73 74 65 70 29 0a 09 09 09 22 5c 6e 73 74 61 74 step)...."\nstat
f710: 75 73 3a 20 20 20 22 20 28 64 62 3a 73 74 65 70 us: " (db:step
f720: 2d 67 65 74 2d 73 74 61 74 75 73 20 73 74 65 70 -get-status step
f730: 29 0a 09 09 09 22 5c 6e 74 69 6d 65 3a 20 20 20 )...."\ntime:
f740: 20 20 22 20 28 64 62 3a 73 74 65 70 2d 67 65 74 " (db:step-get
f750: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 65 70 -event_time step
f760: 29 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 )))). ;; (
f770: 65 6c 73 65 20 20 20 28 76 65 63 74 6f 72 2d 73 else (vector-s
f780: 65 74 21 20 72 65 63 6f 72 64 20 31 20 28 64 62 et! record 1 (db
f790: 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f :step-get-event_
f7a0: 74 69 6d 65 20 73 74 65 70 29 29 29 0a 20 20 20 time step))).
f7b0: 20 20 20 20 28 73 6f 72 74 20 73 74 65 70 73 20 (sort steps
f7c0: 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3c 20 (lambda (a b)(<
f7d0: 28 64 62 3a 73 74 65 70 2d 67 65 74 2d 65 76 65 (db:step-get-eve
f7e0: 6e 74 5f 74 69 6d 65 20 61 29 28 64 62 3a 73 74 nt_time a)(db:st
f7f0: 65 70 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d ep-get-event_tim
f800: 65 20 62 29 29 29 29 29 0a 20 20 20 20 20 20 72 e b))))). r
f810: 65 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d es)))..;;=======
f820: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
f860: 3b 3b 20 4d 20 49 20 53 20 43 20 20 20 4d 20 41 ;; M I S C M A
f870: 20 4e 20 41 20 47 20 45 20 4d 20 45 20 4e 20 54 N A G E M E N T
f880: 20 20 20 49 20 54 20 45 20 4d 20 53 20 0a 3b 3b I T E M S .;;
f890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
f8d0: 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 74 68 65 20 6e ======..;; the n
f8e0: 65 77 20 70 72 65 72 65 71 73 20 63 61 6c 63 75 ew prereqs calcu
f8f0: 6c 61 74 69 6f 6e 2c 20 6c 6f 6f 6b 73 20 61 6c lation, looks al
f900: 73 6f 20 61 74 20 69 74 65 6d 70 61 74 68 20 69 so at itempath i
f910: 66 20 73 70 65 63 69 66 69 65 64 0a 3b 3b 20 61 f specified.;; a
f920: 6c 6c 20 70 72 65 72 65 71 73 20 6d 75 73 74 20 ll prereqs must
f930: 62 65 20 6d 65 74 3a 0a 3b 3b 20 20 20 20 69 66 be met:.;; if
f940: 20 70 72 65 72 65 71 20 74 65 73 74 20 77 69 74 prereq test wit
f950: 68 20 69 74 65 6d 70 61 74 68 3d 27 27 20 69 73 h itempath='' is
f960: 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 50 COMPLETED and P
f970: 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b ASS, WARN, CHECK
f980: 2c 20 6f 72 20 57 41 49 56 45 44 20 74 68 65 6e , or WAIVED then
f990: 20 70 72 65 72 65 71 20 69 73 20 6d 65 74 0a 3b prereq is met.;
f9a0: 3b 20 20 20 20 69 66 20 70 72 65 72 65 71 20 74 ; if prereq t
f9b0: 65 73 74 20 77 69 74 68 20 69 74 65 6d 70 61 74 est with itempat
f9c0: 68 3d 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 h=ref-item-path
f9d0: 61 6e 64 20 43 4f 4d 50 4c 45 54 45 44 20 77 69 and COMPLETED wi
f9e0: 74 68 20 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 th PASS, WARN, C
f9f0: 48 45 43 4b 2c 20 6f 72 20 57 41 49 56 45 44 20 HECK, or WAIVED
fa00: 74 68 65 6e 20 70 72 65 72 65 71 20 69 73 20 6d then prereq is m
fa10: 65 74 0a 3b 3b 0a 3b 3b 20 4e 6f 74 65 3a 20 64 et.;;.;; Note: d
fa20: 6f 20 6e 6f 74 20 63 6f 6e 76 65 72 74 20 74 6f o not convert to
fa30: 20 72 65 6d 6f 74 65 20 61 73 20 69 74 20 63 61 remote as it ca
fa40: 6c 6c 73 20 72 65 6d 6f 74 65 20 75 6e 64 65 72 lls remote under
fa50: 20 74 68 65 20 68 6f 6f 64 0a 3b 3b 20 4e 6f 74 the hood.;; Not
fa60: 65 3a 20 6d 6f 64 65 20 27 6e 6f 72 6d 61 6c 20 e: mode 'normal
fa70: 6d 65 61 6e 73 20 74 68 61 74 20 74 65 73 74 73 means that tests
fa80: 20 6d 75 73 74 20 62 65 20 43 4f 4d 50 4c 45 54 must be COMPLET
fa90: 45 44 20 61 6e 64 20 6f 6b 20 28 69 2e 65 2e 20 ED and ok (i.e.
faa0: 50 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43 PASS, WARN, CHEC
fab0: 4b 20 6f 72 20 57 41 49 56 45 44 29 0a 3b 3b 20 K or WAIVED).;;
fac0: 20 20 20 20 20 20 6d 6f 64 65 20 27 74 6f 70 6c mode 'topl
fad0: 65 76 65 6c 20 6d 65 61 6e 73 20 74 68 61 74 20 evel means that
fae0: 74 65 73 74 73 20 6d 75 73 74 20 62 65 20 43 4f tests must be CO
faf0: 4d 50 4c 45 54 45 44 20 6f 6e 6c 79 0a 3b 3b 20 MPLETED only.;;
fb00: 20 20 20 20 20 20 6d 6f 64 65 20 27 69 74 65 6d mode 'item
fb10: 6d 61 74 63 68 20 6d 65 61 6e 73 20 74 68 61 74 match means that
fb20: 20 74 65 73 74 73 20 69 74 65 6d 73 20 6d 75 73 tests items mus
fb30: 74 20 62 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 t be COMPLETED a
fb40: 6e 64 20 28 50 41 53 53 7c 57 41 52 4e 7c 57 41 nd (PASS|WARN|WA
fb50: 49 56 45 44 7c 43 48 45 43 4b 29 20 5b 5b 20 4e IVED|CHECK) [[ N
fb60: 42 2f 2f 20 4e 4f 54 20 49 4d 50 4c 45 4d 45 4e B// NOT IMPLEMEN
fb70: 54 45 44 20 59 45 54 20 5d 5d 0a 3b 3b 20 0a 28 TED YET ]].;; .(
fb80: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 70 define (db:get-p
fb90: 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 64 rereqs-not-met d
fba0: 62 20 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e 73 b run-id waitons
fbb0: 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 23 ref-item-path #
fbc0: 21 6b 65 79 20 28 6d 6f 64 65 20 27 6e 6f 72 6d !key (mode 'norm
fbd0: 61 6c 29 29 0a 20 20 28 69 66 20 28 6f 72 20 28 al)). (if (or (
fbe0: 6e 6f 74 20 77 61 69 74 6f 6e 73 29 0a 09 20 20 not waitons)..
fbf0: 28 6e 75 6c 6c 3f 20 77 61 69 74 6f 6e 73 29 29 (null? waitons))
fc00: 0a 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 . '().
fc10: 20 28 6c 65 74 2a 20 28 28 75 6e 6d 65 74 2d 70 (let* ((unmet-p
fc20: 72 65 2d 72 65 71 73 20 27 28 29 29 0a 09 20 20 re-reqs '())..
fc30: 20 20 20 28 72 65 73 75 6c 74 20 20 20 20 20 20 (result
fc40: 20 20 20 27 28 29 29 29 0a 09 28 66 6f 72 2d 65 '()))..(for-e
fc50: 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 ach .. (lambda (
fc60: 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 29 waitontest-name)
fc70: 0a 09 20 20 20 3b 3b 20 62 79 20 67 65 74 74 69 .. ;; by getti
fc80: 6e 67 20 74 68 65 20 74 65 73 74 73 20 77 69 74 ng the tests wit
fc90: 68 20 6d 61 74 63 68 69 6e 67 20 6e 61 6d 65 20 h matching name
fca0: 77 65 20 61 72 65 20 6c 6f 6f 6b 69 6e 67 20 6f we are looking o
fcb0: 6e 6c 79 20 61 74 20 74 68 65 20 6d 61 74 63 68 nly at the match
fcc0: 69 6e 67 20 74 65 73 74 20 0a 09 20 20 20 3b 3b ing test .. ;;
fcd0: 20 61 6e 64 20 72 65 6c 61 74 65 64 20 73 75 62 and related sub
fce0: 20 69 74 65 6d 73 0a 09 20 20 20 28 6c 65 74 20 items.. (let
fcf0: 28 28 74 65 73 74 73 20 20 20 20 20 20 20 20 20 ((tests
fd00: 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 (db:get-test
fd10: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 72 75 6e s-for-run db run
fd20: 2d 69 64 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e -id waitontest-n
fd30: 61 6d 65 20 27 28 29 20 27 28 29 29 29 0a 09 09 ame '() '()))...
fd40: 20 28 65 76 65 72 2d 73 65 65 6e 20 20 20 20 20 (ever-seen
fd50: 20 20 20 20 23 66 29 0a 09 09 20 28 70 61 72 65 #f)... (pare
fd60: 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 23 66 nt-waiton-met #f
fd70: 29 0a 09 09 20 28 69 74 65 6d 2d 77 61 69 74 6f )... (item-waito
fd80: 6e 2d 6d 65 74 20 20 20 23 66 29 29 0a 09 20 20 n-met #f))..
fd90: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 (for-each ..
fda0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 (lambda (te
fdb0: 73 74 29 0a 09 09 3b 3b 20 28 69 66 20 28 65 71 st)...;; (if (eq
fdc0: 75 61 6c 3f 20 77 61 69 74 6f 6e 74 65 73 74 2d ual? waitontest-
fdd0: 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 name (db:test-ge
fde0: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 29 t-testname test)
fdf0: 29 20 3b 3b 20 62 79 20 64 65 66 69 6e 74 69 6f ) ;; by defintio
fe00: 6e 20 74 68 69 73 20 68 61 64 20 62 65 74 74 65 n this had bette
fe10: 72 20 62 65 20 74 72 75 65 20 2e 2e 2e 0a 09 09 r be true ......
fe20: 28 6c 65 74 2a 20 28 28 73 74 61 74 65 20 20 20 (let* ((state
fe30: 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 (db:te
fe40: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 st-get-state tes
fe50: 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 74 t))... (st
fe60: 61 74 75 73 20 20 20 20 20 20 20 20 20 20 20 20 atus
fe70: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
fe80: 74 75 73 20 74 65 73 74 29 29 0a 09 09 20 20 20 tus test))...
fe90: 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 20 (item-path
fea0: 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d (db:test-
feb0: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te
fec0: 73 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 st))... (i
fed0: 73 2d 63 6f 6d 70 6c 65 74 65 64 20 20 20 20 20 s-completed
fee0: 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 (equal? state "
fef0: 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 COMPLETED"))...
ff00: 20 20 20 20 20 20 28 69 73 2d 6f 6b 20 20 20 20 (is-ok
ff10: 20 20 20 20 20 20 20 20 20 28 6d 65 6d 62 65 72 (member
ff20: 20 73 74 61 74 75 73 20 27 28 22 50 41 53 53 22 status '("PASS"
ff30: 20 22 57 41 52 4e 22 20 22 43 48 45 43 4b 22 20 "WARN" "CHECK"
ff40: 22 57 41 49 56 45 44 22 29 29 29 0a 09 09 20 20 "WAIVED")))...
ff50: 20 20 20 20 20 28 73 61 6d 65 2d 69 74 65 6d 70 (same-itemp
ff60: 61 74 68 20 20 20 20 20 28 65 71 75 61 6c 3f 20 ath (equal?
ff70: 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 69 74 ref-item-path it
ff80: 65 6d 2d 70 61 74 68 29 29 29 0a 09 09 20 20 28 em-path)))... (
ff90: 73 65 74 21 20 65 76 65 72 2d 73 65 65 6e 20 23 set! ever-seen #
ffa0: 74 29 0a 09 09 20 20 28 63 6f 6e 64 0a 09 09 20 t)... (cond...
ffb0: 20 20 3b 3b 20 63 61 73 65 20 31 2c 20 6e 6f 6e ;; case 1, non
ffc0: 2d 69 74 65 6d 20 28 70 61 72 65 6e 74 20 74 65 -item (parent te
ffd0: 73 74 29 20 69 73 20 0a 09 09 20 20 20 28 28 61 st) is ... ((a
ffe0: 6e 64 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d nd (equal? item-
fff0: 70 61 74 68 20 22 22 29 20 3b 3b 20 74 68 69 73 path "") ;; this
10000 20 69 73 20 74 68 65 20 70 61 72 65 6e 74 20 74 is the parent t
10010 65 73 74 0a 09 09 09 20 69 73 2d 63 6f 6d 70 6c est.... is-compl
10020 65 74 65 64 0a 09 09 09 20 28 6f 72 20 69 73 2d eted.... (or is-
10030 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 20 27 74 6f ok (eq? mode 'to
10040 70 6c 65 76 65 6c 29 29 29 0a 09 09 20 20 20 20 plevel)))...
10050 28 73 65 74 21 20 70 61 72 65 6e 74 2d 77 61 69 (set! parent-wai
10060 74 6f 6e 2d 6d 65 74 20 23 74 29 29 0a 09 09 20 ton-met #t))...
10070 20 20 28 28 61 6e 64 20 73 61 6d 65 2d 69 74 65 ((and same-ite
10080 6d 70 61 74 68 0a 09 09 09 20 69 73 2d 63 6f 6d mpath.... is-com
10090 70 6c 65 74 65 64 0a 09 09 09 20 28 6f 72 20 69 pleted.... (or i
100a0 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f 64 65 20 27 s-ok (eq? mode '
100b0 74 6f 70 6c 65 76 65 6c 29 29 29 0a 09 09 20 20 toplevel)))...
100c0 20 20 28 73 65 74 21 20 69 74 65 6d 2d 77 61 69 (set! item-wai
100d0 74 6f 6e 2d 6d 65 74 20 23 74 29 29 29 29 29 0a ton-met #t))))).
100e0 09 20 20 20 20 20 20 74 65 73 74 73 29 0a 09 20 . tests)..
100f0 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 (if (not (or
10100 20 70 61 72 65 6e 74 2d 77 61 69 74 6f 6e 2d 6d parent-waiton-m
10110 65 74 20 69 74 65 6d 2d 77 61 69 74 6f 6e 2d 6d et item-waiton-m
10120 65 74 29 29 0a 09 09 20 28 73 65 74 21 20 72 65 et))... (set! re
10130 73 75 6c 74 20 28 61 70 70 65 6e 64 20 28 69 66 sult (append (if
10140 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 20 28 (null? tests) (
10150 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 73 74 2d list waitontest-
10160 6e 61 6d 65 29 20 74 65 73 74 73 29 20 72 65 73 name) tests) res
10170 75 6c 74 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 ult))).. ;;
10180 69 66 20 74 68 65 20 74 65 73 74 20 69 73 20 6e if the test is n
10190 6f 74 20 66 6f 75 6e 64 20 74 68 65 6e 20 63 6c ot found then cl
101a0 65 61 72 6c 79 20 74 68 65 20 77 61 69 74 6f 6e early the waiton
101b0 20 69 73 20 6e 6f 74 20 6d 65 74 2e 2e 2e 0a 09 is not met.....
101c0 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 ;; (if (not
101d0 20 65 76 65 72 2d 73 65 65 6e 29 28 73 65 74 21 ever-seen)(set!
101e0 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 20 77 61 result (cons wa
101f0 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 72 65 itontest-name re
10200 73 75 6c 74 29 29 29 29 29 0a 09 20 20 20 20 20 sult)))))..
10210 28 69 66 20 28 6e 6f 74 20 65 76 65 72 2d 73 65 (if (not ever-se
10220 65 6e 29 0a 09 09 20 28 73 65 74 21 20 72 65 73 en)... (set! res
10230 75 6c 74 20 28 61 70 70 65 6e 64 20 28 69 66 20 ult (append (if
10240 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 28 6c 69 (null? tests)(li
10250 73 74 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 st waitontest-na
10260 6d 65 29 20 74 65 73 74 73 29 20 72 65 73 75 6c me) tests) resul
10270 74 29 29 29 29 29 0a 09 20 77 61 69 74 6f 6e 73 t))))).. waitons
10280 29 0a 09 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 )..(delete-dupli
10290 63 61 74 65 73 20 72 65 73 75 6c 74 29 29 29 29 cates result))))
102a0 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ..(define (db:te
102b0 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
102c0 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 74 65 s! db test-id te
102d0 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 ststep-name stat
102e0 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 63 e-in status-in c
102f0 6f 6d 6d 65 6e 74 20 6c 6f 67 66 69 6c 65 29 0a omment logfile).
10300 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
10310 20 22 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 "test-id: " tes
10320 74 2d 69 64 20 22 20 74 65 73 74 73 74 65 70 2d t-id " teststep-
10330 6e 61 6d 65 3a 20 22 20 74 65 73 74 73 74 65 70 name: " teststep
10340 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 -name). (let* (
10350 28 74 64 62 20 20 20 20 20 20 20 28 64 62 3a 6f (tdb (db:o
10360 70 65 6e 2d 74 65 73 74 2d 64 62 2d 62 79 2d 74 pen-test-db-by-t
10370 65 73 74 2d 69 64 20 64 62 20 74 65 73 74 2d 69 est-id db test-i
10380 64 29 29 0a 09 20 28 73 74 61 74 65 20 20 20 20 d)).. (state
10390 20 28 63 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 (check-valid-it
103a0 65 6d 73 20 22 73 74 61 74 65 22 20 73 74 61 74 ems "state" stat
103b0 65 2d 69 6e 29 29 0a 09 20 28 73 74 61 74 75 73 e-in)).. (status
103c0 20 20 20 20 28 63 68 65 63 6b 2d 76 61 6c 69 64 (check-valid
103d0 2d 69 74 65 6d 73 20 22 73 74 61 74 75 73 22 20 -items "status"
103e0 73 74 61 74 75 73 2d 69 6e 29 29 29 0a 20 20 20 status-in))).
103f0 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 (if (or (not st
10400 61 74 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 ate)(not status)
10410 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 )..(debug:print
10420 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 61 0 "WARNING: Inva
10430 6c 69 64 20 22 20 28 69 66 20 73 74 61 74 75 73 lid " (if status
10440 20 22 73 74 61 74 75 73 22 20 22 73 74 61 74 65 "status" "state
10450 22 29 0a 09 09 20 20 20 20 20 22 20 76 61 6c 75 ")... " valu
10460 65 20 5c 22 22 20 28 69 66 20 73 74 61 74 75 73 e \"" (if status
10470 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 state-in status
10480 2d 69 6e 29 20 22 5c 22 2c 20 75 70 64 61 74 65 -in) "\", update
10490 20 79 6f 75 72 20 76 61 6c 69 64 76 61 6c 75 65 your validvalue
104a0 73 20 73 65 63 74 69 6f 6e 20 69 6e 20 6d 65 67 s section in meg
104b0 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 0a atest.config")).
104c0 20 20 20 20 28 69 66 20 74 64 62 0a 09 28 62 65 (if tdb..(be
104d0 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a gin.. (sqlite3:
104e0 65 78 65 63 75 74 65 20 0a 09 20 20 20 74 64 62 execute .. tdb
104f0 0a 09 20 20 20 22 49 4e 53 45 52 54 20 4f 52 20 .. "INSERT OR
10500 52 45 50 4c 41 43 45 20 69 6e 74 6f 20 74 65 73 REPLACE into tes
10510 74 5f 73 74 65 70 73 20 28 74 65 73 74 5f 69 64 t_steps (test_id
10520 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c ,stepname,state,
10530 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d status,event_tim
10540 65 2c 63 6f 6d 6d 65 6e 74 2c 6c 6f 67 66 69 6c e,comment,logfil
10550 65 29 20 56 41 4c 55 45 53 28 3f 2c 3f 2c 3f 2c e) VALUES(?,?,?,
10560 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a 09 20 20 20 74 ?,?,?,?);".. t
10570 65 73 74 2d 69 64 20 74 65 73 74 73 74 65 70 2d est-id teststep-
10580 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 74 name state-in st
10590 61 74 75 73 2d 69 6e 20 28 63 75 72 72 65 6e 74 atus-in (current
105a0 2d 73 65 63 6f 6e 64 73 29 20 28 69 66 20 63 6f -seconds) (if co
105b0 6d 6d 65 6e 74 20 63 6f 6d 6d 65 6e 74 20 22 22 mment comment ""
105c0 29 20 28 69 66 20 6c 6f 67 66 69 6c 65 20 6c 6f ) (if logfile lo
105d0 67 66 69 6c 65 20 22 22 29 29 0a 09 20 20 28 73 gfile "")).. (s
105e0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
105f0 20 74 64 62 29 0a 09 20 20 23 74 29 0a 09 23 66 tdb).. #t)..#f
10600 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
10610 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10620 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
10650 20 45 78 74 72 61 63 74 20 6f 64 73 20 66 69 6c Extract ods fil
10660 65 20 66 72 6f 6d 20 74 68 65 20 64 62 0a 3b 3b e from the db.;;
10670 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10680 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10690 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106a0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
106b0 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 75 6e 73 70 ======..;; runsp
106c0 61 74 74 20 69 73 20 61 20 63 6f 6d 6d 61 20 64 att is a comma d
106d0 65 6c 69 6d 69 74 65 64 20 6c 69 73 74 20 6f 66 elimited list of
106e0 20 72 75 6e 20 70 61 74 74 65 72 6e 73 0a 3b 3b run patterns.;;
106f0 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 20 6d keypatt-alist m
10700 75 73 74 20 63 6f 6e 74 61 69 6e 20 2a 61 6c 6c ust contain *all
10710 2a 20 6b 65 79 73 20 77 69 74 68 20 61 6e 20 61 * keys with an a
10720 73 73 6f 63 69 61 74 65 64 20 70 61 74 74 65 72 ssociated patter
10730 6e 3a 20 27 28 20 28 22 4b 45 59 31 22 20 22 25 n: '( ("KEY1" "%
10740 22 29 20 2e 2e 20 29 0a 28 64 65 66 69 6e 65 20 ") .. ).(define
10750 28 64 62 3a 65 78 74 72 61 63 74 2d 6f 64 73 2d (db:extract-ods-
10760 66 69 6c 65 20 64 62 20 6f 75 74 70 75 74 66 69 file db outputfi
10770 6c 65 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 le keypatt-alist
10780 20 72 75 6e 73 70 61 74 74 20 70 61 74 68 6d 6f runspatt pathmo
10790 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 d). (let* ((key
107a0 73 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e sstr (string-in
107b0 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c
107c0 61 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 ar keypatt-alist
107d0 29 20 22 2c 22 29 29 0a 09 20 28 6b 65 79 71 72 ) ",")).. (keyqr
107e0 79 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 y (string-inte
107f0 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 rsperse (map (la
10800 6d 62 64 61 20 28 70 29 28 63 6f 6e 63 20 28 63 mbda (p)(conc (c
10810 61 72 20 70 29 20 22 20 4c 49 4b 45 20 3f 20 22 ar p) " LIKE ? "
10820 29 29 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 )) keypatt-alist
10830 29 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6e ) " AND ")).. (n
10840 75 6d 6b 65 79 73 20 20 28 6c 65 6e 67 74 68 20 umkeys (length
10850 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 29 0a keypatt-alist)).
10860 09 20 28 74 65 73 74 2d 69 64 73 20 27 28 29 29 . (test-ids '())
10870 0a 09 20 28 77 69 6e 64 6f 77 73 20 20 28 61 6e .. (windows (an
10880 64 20 70 61 74 68 6d 6f 64 20 28 73 75 62 73 74 d pathmod (subst
10890 72 69 6e 67 2d 69 6e 64 65 78 20 22 5c 5c 22 20 ring-index "\\"
108a0 70 61 74 68 6d 6f 64 29 29 29 0a 09 20 28 74 65 pathmod))).. (te
108b0 6d 70 64 69 72 20 20 28 63 6f 6e 63 20 22 2f 74 mpdir (conc "/t
108c0 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 73 mp/" (current-us
108d0 65 72 2d 6e 61 6d 65 29 20 22 2f 22 20 72 75 6e er-name) "/" run
108e0 73 70 61 74 74 20 22 5f 22 20 28 72 61 6e 64 6f spatt "_" (rando
108f0 6d 20 31 30 30 30 30 29 20 22 5f 22 20 28 63 75 m 10000) "_" (cu
10900 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
10910 29 29 29 0a 09 20 28 72 75 6e 73 68 65 61 64 65 ))).. (runsheade
10920 72 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 r (append (list
10930 22 52 75 6e 20 49 64 22 20 22 52 75 6e 6e 61 6d "Run Id" "Runnam
10940 65 22 29 20 3b 20 30 20 31 0a 09 09 09 20 20 20 e") ; 0 1....
10950 20 20 28 6d 61 70 20 63 61 72 20 6b 65 79 70 61 (map car keypa
10960 74 74 2d 61 6c 69 73 74 29 20 20 20 3b 20 2b 20 tt-alist) ; +
10970 4e 20 3d 20 6c 65 6e 67 74 68 20 6b 65 79 70 61 N = length keypa
10980 74 74 2d 61 6c 69 73 74 0a 09 09 09 20 20 20 20 tt-alist....
10990 20 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d 65 (list "Testname
109a0 22 20 20 20 20 20 20 20 20 20 20 3b 20 32 0a 09 " ; 2..
109b0 09 09 09 20 20 20 22 49 74 65 6d 20 50 61 74 68 ... "Item Path
109c0 22 20 20 20 20 20 20 20 20 20 3b 20 33 20 0a 09 " ; 3 ..
109d0 09 09 09 20 20 20 22 44 65 73 63 72 69 70 74 69 ... "Descripti
109e0 6f 6e 22 20 20 20 20 20 20 20 3b 20 34 20 0a 09 on" ; 4 ..
109f0 09 09 09 20 20 20 22 53 74 61 74 65 22 20 20 20 ... "State"
10a00 20 20 20 20 20 20 20 20 20 20 3b 20 35 20 0a 09 ; 5 ..
10a10 09 09 09 20 20 20 22 53 74 61 74 75 73 22 20 20 ... "Status"
10a20 20 20 20 20 20 20 20 20 20 20 3b 20 36 20 20 0a ; 6 .
10a30 09 09 09 09 20 20 20 22 46 69 6e 61 6c 20 4c 6f .... "Final Lo
10a40 67 22 20 20 20 20 20 20 20 20 20 3b 20 37 20 0a g" ; 7 .
10a50 09 09 09 09 20 20 20 22 52 75 6e 20 44 75 72 61 .... "Run Dura
10a60 74 69 6f 6e 22 20 20 20 20 20 20 3b 20 38 20 0a tion" ; 8 .
10a70 09 09 09 09 20 20 20 22 57 68 65 6e 20 52 75 6e .... "When Run
10a80 22 20 20 20 20 20 20 20 20 20 20 3b 20 39 20 0a " ; 9 .
10a90 09 09 09 09 20 20 20 22 54 61 67 73 22 20 20 20 .... "Tags"
10aa0 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 30 0a ; 10.
10ab0 09 09 09 09 20 20 20 22 52 75 6e 20 4f 77 6e 65 .... "Run Owne
10ac0 72 22 20 20 20 20 20 20 20 20 20 3b 20 31 31 0a r" ; 11.
10ad0 09 09 09 09 20 20 20 22 43 6f 6d 6d 65 6e 74 22 .... "Comment"
10ae0 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 32 0a ; 12.
10af0 09 09 09 09 20 20 20 22 41 75 74 68 6f 72 22 20 .... "Author"
10b00 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 33 0a ; 13.
10b10 09 09 09 09 20 20 20 22 54 65 73 74 20 4f 77 6e .... "Test Own
10b20 65 72 22 20 20 20 20 20 20 20 20 3b 20 31 34 0a er" ; 14.
10b30 09 09 09 09 20 20 20 22 52 65 76 69 65 77 65 64 .... "Reviewed
10b40 22 20 20 20 20 20 20 20 20 20 20 3b 20 31 35 0a " ; 15.
10b50 09 09 09 09 20 20 20 22 44 69 73 6b 66 72 65 65 .... "Diskfree
10b60 22 20 20 20 20 20 20 20 20 20 20 3b 20 31 36 0a " ; 16.
10b70 09 09 09 09 20 20 20 22 55 6e 61 6d 65 22 20 20 .... "Uname"
10b80 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 37 0a ; 17.
10b90 09 09 09 09 20 20 20 22 52 75 6e 64 69 72 22 20 .... "Rundir"
10ba0 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 38 0a ; 18.
10bb0 09 09 09 09 20 20 20 22 48 6f 73 74 22 20 20 20 .... "Host"
10bc0 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 39 0a ; 19.
10bd0 09 09 09 09 20 20 20 22 43 70 75 20 4c 6f 61 64 .... "Cpu Load
10be0 22 20 20 20 20 20 20 20 20 20 20 3b 20 32 30 0a " ; 20.
10bf0 09 09 09 09 20 20 20 29 29 29 0a 09 20 28 72 65 .... ))).. (re
10c00 73 75 6c 74 73 20 28 6c 69 73 74 20 72 75 6e 73 sults (list runs
10c10 68 65 61 64 65 72 29 29 09 09 09 20 0a 09 20 28 header))... .. (
10c20 74 65 73 74 64 61 74 61 2d 68 65 61 64 65 72 20 testdata-header
10c30 28 6c 69 73 74 20 22 52 75 6e 20 49 64 22 20 22 (list "Run Id" "
10c40 54 65 73 74 6e 61 6d 65 22 20 22 49 74 65 6d 20 Testname" "Item
10c50 50 61 74 68 22 20 22 43 61 74 65 67 6f 72 79 22 Path" "Category"
10c60 20 22 56 61 72 69 61 62 6c 65 22 20 22 56 61 6c "Variable" "Val
10c70 75 65 22 20 22 45 78 70 65 63 74 65 64 22 20 22 ue" "Expected" "
10c80 54 6f 6c 22 20 22 55 6e 69 74 73 22 20 22 53 74 Tol" "Units" "St
10c90 61 74 75 73 22 20 22 43 6f 6d 6d 65 6e 74 22 29 atus" "Comment")
10ca0 29 0a 09 20 28 6d 61 69 6e 71 72 79 20 28 63 6f ).. (mainqry (co
10cb0 6e 63 20 22 53 45 4c 45 43 54 0a 20 20 20 20 20 nc "SELECT.
10cc0 20 20 20 20 20 20 20 20 20 74 2e 74 65 73 74 6e t.testn
10cd0 61 6d 65 2c 72 2e 69 64 2c 72 75 6e 6e 61 6d 65 ame,r.id,runname
10ce0 2c 22 20 6b 65 79 73 73 74 72 20 22 2c 74 2e 74 ," keysstr ",t.t
10cf0 65 73 74 6e 61 6d 65 2c 0a 20 20 20 20 20 20 20 estname,.
10d00 20 20 20 20 20 20 20 74 2e 69 74 65 6d 5f 70 61 t.item_pa
10d10 74 68 2c 74 6d 2e 64 65 73 63 72 69 70 74 69 6f th,tm.descriptio
10d20 6e 2c 74 2e 73 74 61 74 65 2c 74 2e 73 74 61 74 n,t.state,t.stat
10d30 75 73 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 us,.
10d40 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 2c 72 75 6e final_logf,run
10d50 5f 64 75 72 61 74 69 6f 6e 2c 20 0a 20 20 20 20 _duration, .
10d60 20 20 20 20 20 20 20 20 20 20 73 74 72 66 74 69 strfti
10d70 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 3a me('%m/%d/%Y %H:
10d80 25 4d 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 28 %M:%S',datetime(
10d90 74 2e 65 76 65 6e 74 5f 74 69 6d 65 2c 27 75 6e t.event_time,'un
10da0 69 78 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 6c ixepoch'),'local
10db0 74 69 6d 65 27 29 2c 0a 20 20 20 20 20 20 20 20 time'),.
10dc0 20 20 20 20 20 20 74 6d 2e 74 61 67 73 2c 72 2e tm.tags,r.
10dd0 6f 77 6e 65 72 2c 74 2e 63 6f 6d 6d 65 6e 74 2c owner,t.comment,
10de0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 . a
10df0 75 74 68 6f 72 2c 0a 20 20 20 20 20 20 20 20 20 uthor,.
10e00 20 20 20 20 20 74 6d 2e 6f 77 6e 65 72 2c 72 65 tm.owner,re
10e10 76 69 65 77 65 64 2c 0a 20 20 20 20 20 20 20 20 viewed,.
10e20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 2c 75 diskfree,u
10e30 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 0a 20 20 20 name,rundir,.
10e40 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 2c host,
10e50 63 70 75 6c 6f 61 64 0a 20 20 20 20 20 20 20 20 cpuload.
10e60 20 20 20 20 46 52 4f 4d 20 74 65 73 74 73 20 41 FROM tests A
10e70 53 20 74 20 4a 4f 49 4e 20 72 75 6e 73 20 41 53 S t JOIN runs AS
10e80 20 72 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 r ON t.run_id=r
10e90 2e 69 64 20 4a 4f 49 4e 20 74 65 73 74 5f 6d 65 .id JOIN test_me
10ea0 74 61 20 41 53 20 74 6d 20 4f 4e 20 74 6d 2e 74 ta AS tm ON tm.t
10eb0 65 73 74 6e 61 6d 65 3d 74 2e 74 65 73 74 6e 61 estname=t.testna
10ec0 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 57 me. W
10ed0 48 45 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 4b HERE runname LIK
10ee0 45 20 3f 20 41 4e 44 20 22 20 6b 65 79 71 72 79 E ? AND " keyqry
10ef0 20 22 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 ";"))). (deb
10f00 75 67 3a 70 72 69 6e 74 20 32 20 22 55 73 69 6e ug:print 2 "Usin
10f10 67 20 22 20 74 65 6d 70 64 69 72 20 22 20 66 6f g " tempdir " fo
10f20 72 20 63 6f 6e 73 74 72 75 63 74 69 6e 67 20 74 r constructing t
10f30 68 65 20 6f 64 73 20 66 69 6c 65 2e 20 6b 65 79 he ods file. key
10f40 71 72 79 3a 20 22 20 6b 65 79 71 72 79 20 22 20 qry: " keyqry "
10f50 6b 65 79 73 74 72 3a 20 22 20 6b 65 79 73 73 74 keystr: " keysst
10f60 72 20 22 20 77 69 74 68 20 6b 65 79 73 3a 20 22 r " with keys: "
10f70 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 70 61 (map cadr keypa
10f80 74 74 2d 61 6c 69 73 74 29 0a 09 09 20 22 5c 6e tt-alist)... "\n
10f90 20 20 20 20 20 20 6d 61 69 6e 71 72 79 3a 20 22 mainqry: "
10fa0 20 6d 61 69 6e 71 72 79 29 0a 20 20 20 20 3b 3b mainqry). ;;
10fb0 20 22 45 78 70 65 63 74 65 64 20 56 61 6c 75 65 "Expected Value
10fc0 22 0a 20 20 20 20 3b 3b 20 22 56 61 6c 75 65 20 ". ;; "Value
10fd0 46 6f 75 6e 64 22 0a 20 20 20 20 3b 3b 20 22 54 Found". ;; "T
10fe0 6f 6c 65 72 61 6e 63 65 22 0a 20 20 20 20 28 61 olerance". (a
10ff0 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 pply sqlite3:for
11000 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 6c -each-row.. (l
11010 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 20 2e ambda (test-id .
11020 20 62 29 0a 09 20 20 20 20 20 28 73 65 74 21 20 b).. (set!
11030 74 65 73 74 2d 69 64 73 20 28 63 6f 6e 73 20 74 test-ids (cons t
11040 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 73 29 est-id test-ids)
11050 29 20 20 20 3b 3b 20 74 65 73 74 2d 69 64 20 69 ) ;; test-id i
11060 73 20 6e 6f 77 20 74 65 73 74 6e 61 6d 65 0a 09 s now testname..
11070 20 20 20 20 20 28 73 65 74 21 20 72 65 73 75 6c (set! resul
11080 74 73 20 28 61 70 70 65 6e 64 20 72 65 73 75 6c ts (append resul
11090 74 73 20 3b 3b 20 6e 6f 74 65 2c 20 64 72 6f 70 ts ;; note, drop
110a0 20 74 68 65 20 74 65 73 74 2d 69 64 0a 09 09 09 the test-id....
110b0 09 20 20 20 28 6c 69 73 74 0a 09 09 09 09 20 20 . (list.....
110c0 20 20 28 69 66 20 70 61 74 68 6d 6f 64 0a 09 09 (if pathmod...
110d0 09 09 09 28 6c 65 74 2a 20 28 28 76 62 20 20 20 ...(let* ((vb
110e0 20 20 20 20 20 28 61 70 70 6c 79 20 76 65 63 74 (apply vect
110f0 6f 72 20 62 29 29 0a 09 09 09 09 09 20 20 20 20 or b))......
11100 20 20 20 28 6b 65 79 76 61 6c 73 20 20 20 28 6c (keyvals (l
11110 65 74 20 6c 6f 6f 70 20 28 28 69 20 20 20 20 30 et loop ((i 0
11120 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 )......... (
11130 72 65 73 20 27 28 29 29 29 0a 09 09 09 09 09 09 res '())).......
11140 09 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 6e . (if (>= i n
11150 75 6d 6b 65 79 73 29 0a 09 09 09 09 09 09 09 09 umkeys).........
11160 72 65 73 0a 09 09 09 09 09 09 09 09 28 6c 6f 6f res.........(loo
11170 70 20 28 2b 20 69 20 31 29 0a 09 09 09 09 09 09 p (+ i 1).......
11180 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 .. (append
11190 72 65 73 20 28 6c 69 73 74 20 28 76 65 63 74 6f res (list (vecto
111a0 72 2d 72 65 66 20 76 62 20 28 2b 20 69 20 32 29 r-ref vb (+ i 2)
111b0 29 29 29 29 29 29 29 0a 09 09 09 09 09 20 20 20 )))))))......
111c0 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 (runname (
111d0 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 31 29 vector-ref vb 1)
111e0 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 74 )...... (t
111f0 65 73 74 6e 61 6d 65 20 20 28 76 65 63 74 6f 72 estname (vector
11200 2d 72 65 66 20 76 62 20 28 2b 20 20 32 20 6e 75 -ref vb (+ 2 nu
11210 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 mkeys)))......
11220 20 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 20 (item-path
11230 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 (vector-ref vb (
11240 2b 20 20 33 20 6e 75 6d 6b 65 79 73 29 29 29 0a + 3 numkeys))).
11250 09 09 09 09 09 20 20 20 20 20 20 20 28 66 69 6e ..... (fin
11260 61 6c 2d 6c 6f 67 20 28 76 65 63 74 6f 72 2d 72 al-log (vector-r
11270 65 66 20 76 62 20 28 2b 20 20 37 20 6e 75 6d 6b ef vb (+ 7 numk
11280 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 eys)))......
11290 20 20 20 28 72 75 6e 2d 64 69 72 20 20 20 28 76 (run-dir (v
112a0 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 ector-ref vb (+
112b0 31 38 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 09 18 numkeys)))...
112c0 09 09 09 20 20 20 20 20 20 20 28 6c 6f 67 2d 66 ... (log-f
112d0 70 61 74 68 20 28 63 6f 6e 63 20 72 75 6e 2d 64 path (conc run-d
112e0 69 72 20 22 2f 22 20 20 66 69 6e 61 6c 2d 6c 6f ir "/" final-lo
112f0 67 29 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d g))) ;; (string-
11300 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 76 intersperse keyv
11310 61 6c 73 20 22 2f 22 29 20 22 2f 22 20 74 65 73 als "/") "/" tes
11320 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 tname "/" item-p
11330 61 74 68 20 22 2f 22 0a 09 09 09 09 09 20 20 28 ath "/"...... (
11340 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 6c debug:print 4 "l
11350 6f 67 3a 20 22 20 6c 6f 67 2d 66 70 61 74 68 20 og: " log-fpath
11360 22 20 65 78 69 73 74 73 3a 20 22 20 28 66 69 6c " exists: " (fil
11370 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 70 e-exists? log-fp
11380 61 74 68 29 29 0a 09 09 09 09 09 20 20 28 76 65 ath))...... (ve
11390 63 74 6f 72 2d 73 65 74 21 20 76 62 20 28 2b 20 ctor-set! vb (+
113a0 37 20 6e 75 6d 6b 65 79 73 29 20 28 69 66 20 28 7 numkeys) (if (
113b0 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 file-exists? log
113c0 2d 66 70 61 74 68 29 0a 09 09 09 09 09 09 09 09 -fpath).........
113d0 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 70 . (let ((newp
113e0 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 6d 6f ath (conc pathmo
113f0 64 20 22 2f 22 0a 09 09 09 09 09 09 09 09 09 09 d "/"...........
11400 09 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 .. (string-inter
11410 73 70 65 72 73 65 20 6b 65 79 76 61 6c 73 20 22 sperse keyvals "
11420 2f 22 29 0a 09 09 09 09 09 09 09 09 09 09 09 09 /").............
11430 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f 22 "/" runname "/"
11440 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 0a 09 09 testname "/"...
11450 09 09 09 09 09 09 09 09 09 09 20 28 69 66 20 28 .......... (if (
11460 73 74 72 69 6e 67 3d 3f 20 69 74 65 6d 2d 70 61 string=? item-pa
11470 74 68 20 22 22 29 20 22 22 20 28 63 6f 6e 63 20 th "") "" (conc
11480 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a "/" item-path)).
11490 09 09 09 09 09 09 09 09 09 09 09 09 20 66 69 6e ............ fin
114a0 61 6c 2d 6c 6f 67 29 29 29 0a 09 09 09 09 09 09 al-log))).......
114b0 09 09 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 ... ;; for
114c0 6e 6f 77 20 74 68 72 6f 77 20 61 77 61 79 20 6e now throw away n
114d0 65 77 70 61 74 68 20 61 6e 64 20 75 73 65 20 74 ewpath and use t
114e0 68 65 20 6c 6f 67 2d 66 70 61 74 68 20 63 6f 6e he log-fpath con
114f0 63 27 64 20 77 69 74 68 20 70 61 74 68 6d 6f 64 c'd with pathmod
11500 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
11510 28 73 65 74 21 20 6e 65 77 70 61 74 68 20 28 63 (set! newpath (c
11520 6f 6e 63 20 70 61 74 68 6d 6f 64 20 6c 6f 67 2d onc pathmod log-
11530 66 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 09 fpath)).........
11540 09 20 20 20 20 20 20 28 69 66 20 77 69 6e 64 6f . (if windo
11550 77 73 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 ws (string-trans
11560 6c 61 74 65 20 6e 65 77 70 61 74 68 20 22 2f 22 late newpath "/"
11570 20 22 5c 5c 22 29 20 6e 65 77 70 61 74 68 29 29 "\\") newpath))
11580 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 69 .......... (i
11590 66 20 28 3e 20 2a 76 65 72 62 6f 73 69 74 79 2a f (> *verbosity*
115a0 20 31 29 0a 09 09 09 09 09 09 09 09 09 09 28 63 1)...........(c
115b0 6f 6e 63 20 66 69 6e 61 6c 2d 6c 6f 67 20 22 20 onc final-log "
115c0 6e 6f 74 2d 66 6f 75 6e 64 22 29 0a 09 09 09 09 not-found").....
115d0 09 09 09 09 09 09 22 22 29 29 29 0a 09 09 09 09 ......""))).....
115e0 09 20 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 . (vector->list
115f0 20 76 62 29 29 0a 09 09 09 09 09 62 29 29 29 29 vb))......b))))
11600 29 0a 09 20 20 20 64 62 0a 09 20 20 20 6d 61 69 ).. db.. mai
11610 6e 71 72 79 0a 09 20 20 20 72 75 6e 73 70 61 74 nqry.. runspat
11620 74 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 70 t (map cadr keyp
11630 61 74 74 2d 61 6c 69 73 74 29 29 0a 20 20 20 20 att-alist)).
11640 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
11650 46 6f 75 6e 64 20 22 20 28 6c 65 6e 67 74 68 20 Found " (length
11660 74 65 73 74 2d 69 64 73 29 20 22 20 72 65 63 6f test-ids) " reco
11670 72 64 73 22 29 0a 20 20 20 20 28 73 65 74 21 20 rds"). (set!
11680 72 65 73 75 6c 74 73 20 28 6c 69 73 74 20 28 63 results (list (c
11690 6f 6e 73 20 22 52 75 6e 73 22 20 72 65 73 75 6c ons "Runs" resul
116a0 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 ts))). ;; now
116b0 2c 20 66 6f 72 20 65 61 63 68 20 74 65 73 74 2c , for each test,
116c0 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 74 65 73 collect the tes
116d0 74 5f 64 61 74 61 20 69 6e 66 6f 20 61 6e 64 20 t_data info and
116e0 61 64 64 20 61 20 6e 65 77 20 73 68 65 65 74 0a add a new sheet.
116f0 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
11700 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 (lambda (test
11710 2d 69 64 29 0a 20 20 20 20 20 20 20 28 6c 65 74 -id). (let
11720 20 28 28 74 65 73 74 2d 64 61 74 61 20 28 6c 69 ((test-data (li
11730 73 74 20 74 65 73 74 64 61 74 61 2d 68 65 61 64 st testdata-head
11740 65 72 29 29 0a 09 20 20 20 20 20 28 63 75 72 72 er)).. (curr
11750 2d 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 0a -test-name #f)).
11760 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 . (sqlite3:for-e
11770 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d 62 ach-row.. (lamb
11780 64 61 20 28 72 75 6e 2d 69 64 20 74 65 73 74 6e da (run-id testn
11790 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 63 61 ame item-path ca
117a0 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 20 tegory variable
117b0 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 74 value expected t
117c0 6f 6c 20 75 6e 69 74 73 20 73 74 61 74 75 73 20 ol units status
117d0 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 20 20 28 73 comment).. (s
117e0 65 74 21 20 63 75 72 72 2d 74 65 73 74 2d 6e 61 et! curr-test-na
117f0 6d 65 20 74 65 73 74 6e 61 6d 65 29 0a 09 20 20 me testname)..
11800 20 20 28 73 65 74 21 20 74 65 73 74 2d 64 61 74 (set! test-dat
11810 61 20 28 61 70 70 65 6e 64 20 74 65 73 74 2d 64 a (append test-d
11820 61 74 61 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ata (list (list
11830 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
11840 69 74 65 6d 2d 70 61 74 68 20 63 61 74 65 67 6f item-path catego
11850 72 79 20 76 61 72 69 61 62 6c 65 20 76 61 6c 75 ry variable valu
11860 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 20 75 e expected tol u
11870 6e 69 74 73 20 73 74 61 74 75 73 20 63 6f 6d 6d nits status comm
11880 65 6e 74 29 29 29 29 29 0a 09 20 20 64 62 20 0a ent))))).. db .
11890 09 20 20 3b 3b 20 22 53 45 4c 45 43 54 20 72 75 . ;; "SELECT ru
118a0 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 n_id,testname,it
118b0 65 6d 5f 70 61 74 68 2c 63 61 74 65 67 6f 72 79 em_path,category
118c0 2c 76 61 72 69 61 62 6c 65 2c 74 64 2e 76 61 6c ,variable,td.val
118d0 75 65 20 41 53 20 76 61 6c 75 65 2c 65 78 70 65 ue AS value,expe
118e0 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 2c 74 cted,tol,units,t
118f0 64 2e 73 74 61 74 75 73 20 41 53 20 73 74 61 74 d.status AS stat
11900 75 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 us,td.comment AS
11910 20 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 comment FROM te
11920 73 74 5f 64 61 74 61 20 41 53 20 74 64 20 49 4e st_data AS td IN
11930 4e 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f NER JOIN tests O
11940 4e 20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 N tests.id=td.te
11950 73 74 5f 69 64 20 57 48 45 52 45 20 74 65 73 74 st_id WHERE test
11960 5f 69 64 3d 3f 3b 22 0a 09 20 20 22 53 45 4c 45 _id=?;".. "SELE
11970 43 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 CT run_id,testna
11980 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 63 61 74 me,item_path,cat
11990 65 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 74 egory,variable,t
119a0 64 2e 76 61 6c 75 65 20 41 53 20 76 61 6c 75 65 d.value AS value
119b0 2c 74 64 2e 65 78 70 65 63 74 65 64 2c 74 64 2e ,td.expected,td.
119c0 74 6f 6c 2c 74 64 2e 75 6e 69 74 73 2c 74 64 2e tol,td.units,td.
119d0 73 74 61 74 75 73 20 41 53 20 73 74 61 74 75 73 status AS status
119e0 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 41 53 20 63 ,td.comment AS c
119f0 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 omment FROM test
11a00 5f 64 61 74 61 20 41 53 20 74 64 20 49 4e 4e 45 _data AS td INNE
11a10 52 20 4a 4f 49 4e 20 74 65 73 74 73 20 4f 4e 20 R JOIN tests ON
11a20 74 65 73 74 73 2e 69 64 3d 74 64 2e 74 65 73 74 tests.id=td.test
11a30 5f 69 64 20 57 48 45 52 45 20 74 65 73 74 6e 61 _id WHERE testna
11a40 6d 65 3d 3f 3b 22 0a 09 20 20 74 65 73 74 2d 69 me=?;".. test-i
11a50 64 29 0a 09 20 28 69 66 20 63 75 72 72 2d 74 65 d).. (if curr-te
11a60 73 74 2d 6e 61 6d 65 0a 09 20 20 20 20 20 28 73 st-name.. (s
11a70 65 74 21 20 72 65 73 75 6c 74 73 20 28 61 70 70 et! results (app
11a80 65 6e 64 20 72 65 73 75 6c 74 73 20 28 6c 69 73 end results (lis
11a90 74 20 28 63 6f 6e 73 20 63 75 72 72 2d 74 65 73 t (cons curr-tes
11aa0 74 2d 6e 61 6d 65 20 74 65 73 74 2d 64 61 74 61 t-name test-data
11ab0 29 29 29 29 29 0a 09 20 29 29 0a 20 20 20 20 20 ))))).. )).
11ac0 28 73 6f 72 74 20 28 64 65 6c 65 74 65 2d 64 75 (sort (delete-du
11ad0 70 6c 69 63 61 74 65 73 20 74 65 73 74 2d 69 64 plicates test-id
11ae0 73 29 20 73 74 72 69 6e 67 3c 3d 29 29 0a 20 20 s) string<=)).
11af0 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
11b00 22 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 6d 70 "mkdir -p " temp
11b10 64 69 72 29 29 0a 20 20 20 20 3b 3b 20 28 70 70 dir)). ;; (pp
11b20 20 72 65 73 75 6c 74 73 29 0a 20 20 20 20 28 6f results). (o
11b30 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 20 0a 20 20 ds:list->ods .
11b40 20 20 20 74 65 6d 70 64 69 72 0a 20 20 20 20 20 tempdir.
11b50 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
11b60 68 20 28 72 65 67 65 78 70 20 22 5e 5b 2f 7e 5d h (regexp "^[/~]
11b70 2b 2e 2a 22 29 20 6f 75 74 70 75 74 66 69 6c 65 +.*") outputfile
11b80 29 20 3b 3b 20 66 75 6c 6c 20 70 61 74 68 3f 0a ) ;; full path?.
11b90 09 20 6f 75 74 70 75 74 66 69 6c 65 0a 09 20 28 . outputfile.. (
11ba0 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 begin.. (debug
11bb0 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
11bc0 47 3a 20 70 61 74 68 20 67 69 76 65 6e 2c 20 22 G: path given, "
11bd0 20 6f 75 74 70 75 74 66 69 6c 65 20 22 20 69 73 outputfile " is
11be0 20 72 65 6c 61 74 69 76 65 2c 20 70 72 65 66 69 relative, prefi
11bf0 78 69 6e 67 20 77 69 74 68 20 63 75 72 72 65 6e xing with curren
11c00 74 20 64 69 72 65 63 74 6f 72 79 22 29 0a 09 20 t directory")..
11c10 20 20 28 63 6f 6e 63 20 28 63 75 72 72 65 6e 74 (conc (current
11c20 2d 64 69 72 65 63 74 6f 72 79 29 20 22 2f 22 20 -directory) "/"
11c30 6f 75 74 70 75 74 66 69 6c 65 29 29 29 0a 20 20 outputfile))).
11c40 20 20 20 72 65 73 75 6c 74 73 29 0a 20 20 20 20 results).
11c50 3b 3b 20 62 72 75 74 61 6c 20 63 6c 65 61 6e 20 ;; brutal clean
11c60 75 70 0a 20 20 20 20 28 73 79 73 74 65 6d 20 22 up. (system "
11c70 72 6d 20 2d 72 66 20 74 65 6d 70 64 69 72 22 29 rm -rf tempdir")
11c80 29 29 0a 0a 3b 3b 20 28 64 62 3a 65 78 74 72 61 ))..;; (db:extra
11c90 63 74 2d 6f 64 73 2d 66 69 6c 65 20 64 62 20 22 ct-ods-file db "
11ca0 6f 75 74 70 75 74 66 69 6c 65 2e 6f 64 73 22 20 outputfile.ods"
11cb0 27 28 28 22 73 79 73 6e 61 6d 65 22 20 22 25 22 '(("sysname" "%"
11cc0 29 28 22 66 73 6e 61 6d 65 22 20 22 25 22 29 28 )("fsname" "%")(
11cd0 22 64 61 74 61 70 61 74 68 22 20 22 25 22 29 29 "datapath" "%"))
11ce0 20 22 25 22 29 0a 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d "%")...;;======
11cf0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d00 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d10 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d30 0a 3b 3b 20 52 45 4d 4f 54 45 20 44 42 20 41 43 .;; REMOTE DB AC
11d40 43 45 53 53 20 56 49 41 20 52 50 43 0a 3b 3b 3d CESS VIA RPC.;;=
11d50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11d70 3d 3d 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 0a 0a 28 64 65 66 69 6e 65 20 28 =====..(define (
11da0 72 64 62 3a 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f rdb:open-run-clo
11db0 73 65 20 70 72 6f 63 6e 61 6d 65 20 2e 20 72 65 se procname . re
11dc0 6d 61 72 67 73 29 0a 20 20 28 69 66 20 2a 72 75 margs). (if *ru
11dd0 6e 72 65 6d 6f 74 65 2a 0a 20 20 20 20 20 20 28 nremote*. (
11de0 6c 65 74 20 28 28 68 6f 73 74 20 28 76 65 63 74 let ((host (vect
11df0 6f 72 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 or-ref *runremot
11e00 65 2a 20 30 29 29 0a 09 20 20 20 20 28 70 6f 72 e* 0)).. (por
11e10 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 t (vector-ref *r
11e20 75 6e 72 65 6d 6f 74 65 2a 20 31 29 29 29 0a 09 unremote* 1)))..
11e30 28 61 70 70 6c 79 20 28 72 70 63 3a 70 72 6f 63 (apply (rpc:proc
11e40 65 64 75 72 65 20 27 72 64 62 3a 6f 70 65 6e 2d edure 'rdb:open-
11e50 72 75 6e 2d 63 6c 6f 73 65 20 68 6f 73 74 20 70 run-close host p
11e60 6f 72 74 29 20 70 72 6f 63 6e 61 6d 65 20 72 65 ort) procname re
11e70 6d 61 72 67 73 29 29 0a 20 20 20 20 20 20 28 61 margs)). (a
11e80 70 70 6c 79 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c pply open-run-cl
11e90 6f 73 65 20 28 65 76 61 6c 20 70 72 6f 63 6e 61 ose (eval procna
11ea0 6d 65 29 20 72 65 6d 61 72 67 73 29 29 29 0a 0a me) remargs)))..
11eb0 28 64 65 66 69 6e 65 20 28 72 64 62 3a 74 65 73 (define (rdb:tes
11ec0 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 61 t-set-status-sta
11ed0 74 65 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 te test-id statu
11ee0 73 20 73 74 61 74 65 20 6d 73 67 29 0a 20 20 28 s state msg). (
11ef0 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 20 if *runremote*.
11f00 20 20 20 20 20 28 6c 65 74 20 28 28 68 6f 73 74 (let ((host
11f10 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 75 (vector-ref *ru
11f20 6e 72 65 6d 6f 74 65 2a 20 30 29 29 0a 09 20 20 nremote* 0))..
11f30 20 20 28 70 6f 72 74 20 28 76 65 63 74 6f 72 2d (port (vector-
11f40 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 ref *runremote*
11f50 31 29 29 29 0a 09 28 68 61 6e 64 6c 65 2d 65 78 1)))..(handle-ex
11f60 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 ceptions.. exn..
11f70 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 (begin.. (deb
11f80 75 67 3a 70 72 69 6e 74 20 30 20 22 45 58 43 45 ug:print 0 "EXCE
11f90 50 54 49 4f 4e 3a 20 72 70 63 20 63 61 6c 6c 20 PTION: rpc call
11fa0 66 61 69 6c 65 64 3f 22 29 0a 09 20 20 20 28 64 failed?").. (d
11fb0 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 20 20 ebug:print 0 "
11fc0 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
11fd0 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
11fe0 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
11ff0 78 6e 29 29 0a 09 20 20 20 28 70 72 69 6e 74 2d xn)).. (print-
12000 63 61 6c 6c 2d 63 68 61 69 6e 29 0a 09 20 20 20 call-chain)..
12010 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (cdb:test-set-st
12020 61 74 75 73 2d 73 74 61 74 65 20 74 65 73 74 2d atus-state test-
12030 69 64 20 73 74 61 74 75 73 20 73 74 61 74 65 20 id status state
12040 6d 73 67 29 29 0a 09 20 28 28 72 70 63 3a 70 72 msg)).. ((rpc:pr
12050 6f 63 65 64 75 72 65 20 27 63 64 62 3a 74 65 73 ocedure 'cdb:tes
12060 74 2d 73 65 74 2d 73 74 61 74 75 73 2d 73 74 61 t-set-status-sta
12070 74 65 20 68 6f 73 74 20 70 6f 72 74 29 20 74 65 te host port) te
12080 73 74 2d 69 64 20 73 74 61 74 75 73 20 73 74 61 st-id status sta
12090 74 65 20 6d 73 67 29 29 29 0a 20 20 20 20 20 20 te msg))).
120a0 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (cdb:test-set-st
120b0 61 74 75 73 2d 73 74 61 74 65 20 74 65 73 74 2d atus-state test-
120c0 69 64 20 73 74 61 74 75 73 20 73 74 61 74 65 20 id status state
120d0 6d 73 67 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 msg)))..(define
120e0 28 72 64 62 3a 74 65 73 74 2d 72 6f 6c 6c 75 70 (rdb:test-rollup
120f0 2d 74 65 73 74 5f 64 61 74 61 2d 70 61 73 73 2d -test_data-pass-
12100 66 61 69 6c 20 74 65 73 74 2d 69 64 29 0a 20 20 fail test-id).
12110 28 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a (if *runremote*.
12120 20 20 20 20 20 20 28 6c 65 74 20 28 28 68 6f 73 (let ((hos
12130 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 t (vector-ref *r
12140 75 6e 72 65 6d 6f 74 65 2a 20 30 29 29 0a 09 20 unremote* 0))..
12150 20 20 20 28 70 6f 72 74 20 28 76 65 63 74 6f 72 (port (vector
12160 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a -ref *runremote*
12170 20 31 29 29 29 0a 09 28 28 72 70 63 3a 70 72 6f 1)))..((rpc:pro
12180 63 65 64 75 72 65 20 27 63 64 62 3a 74 65 73 74 cedure 'cdb:test
12190 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 -rollup-test_dat
121a0 61 2d 70 61 73 73 2d 66 61 69 6c 20 68 6f 73 74 a-pass-fail host
121b0 20 70 6f 72 74 29 20 74 65 73 74 2d 69 64 29 29 port) test-id))
121c0 0a 20 20 20 20 20 20 28 63 64 62 3a 74 65 73 74 . (cdb:test
121d0 2d 72 6f 6c 6c 75 70 2d 74 65 73 74 5f 64 61 74 -rollup-test_dat
121e0 61 2d 70 61 73 73 2d 66 61 69 6c 20 74 65 73 74 a-pass-fail test
121f0 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
12200 28 72 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 (rdb:pass-fail-c
12210 6f 75 6e 74 73 20 74 65 73 74 2d 69 64 20 66 61 ounts test-id fa
12220 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
12230 75 6e 74 29 0a 20 20 28 69 66 20 2a 72 75 6e 72 unt). (if *runr
12240 65 6d 6f 74 65 2a 0a 20 20 20 20 20 20 28 6c 65 emote*. (le
12250 74 20 28 28 68 6f 73 74 20 28 76 65 63 74 6f 72 t ((host (vector
12260 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a -ref *runremote*
12270 20 30 29 29 0a 09 20 20 20 20 28 70 6f 72 74 20 0)).. (port
12280 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 75 6e (vector-ref *run
12290 72 65 6d 6f 74 65 2a 20 31 29 29 29 0a 09 28 28 remote* 1)))..((
122a0 72 70 63 3a 70 72 6f 63 65 64 75 72 65 20 27 63 rpc:procedure 'c
122b0 64 62 3a 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 db:pass-fail-cou
122c0 6e 74 73 20 68 6f 73 74 20 70 6f 72 74 29 20 74 nts host port) t
122d0 65 73 74 2d 69 64 20 66 61 69 6c 2d 63 6f 75 6e est-id fail-coun
122e0 74 20 70 61 73 73 2d 63 6f 75 6e 74 29 29 0a 20 t pass-count)).
122f0 20 20 20 20 20 28 63 64 62 3a 70 61 73 73 2d 66 (cdb:pass-f
12300 61 69 6c 2d 63 6f 75 6e 74 73 20 74 65 73 74 2d ail-counts test-
12310 69 64 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 61 id fail-count pa
12320 73 73 2d 63 6f 75 6e 74 29 29 29 0a 0a 3b 3b 20 ss-count)))..;;
12330 63 75 72 72 65 6e 74 6c 79 20 66 6f 72 63 65 73 currently forces
12340 20 61 20 66 6c 75 73 68 20 6f 66 20 74 68 65 20 a flush of the
12350 71 75 65 75 65 0a 28 64 65 66 69 6e 65 20 28 72 queue.(define (r
12360 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 74 65 db:tests-registe
12370 72 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 r-test db run-id
12380 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
12390 70 61 74 68 29 0a 20 20 28 69 66 20 2a 72 75 6e path). (if *run
123a0 72 65 6d 6f 74 65 2a 0a 20 20 20 20 20 20 28 6c remote*. (l
123b0 65 74 20 28 28 68 6f 73 74 20 28 76 65 63 74 6f et ((host (vecto
123c0 72 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 r-ref *runremote
123d0 2a 20 30 29 29 0a 09 20 20 20 20 28 70 6f 72 74 * 0)).. (port
123e0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 75 (vector-ref *ru
123f0 6e 72 65 6d 6f 74 65 2a 20 31 29 29 29 0a 09 28 nremote* 1)))..(
12400 28 72 70 63 3a 70 72 6f 63 65 64 75 72 65 20 27 (rpc:procedure '
12410 63 64 62 3a 74 65 73 74 73 2d 72 65 67 69 73 74 cdb:tests-regist
12420 65 72 2d 74 65 73 74 20 68 6f 73 74 20 70 6f 72 er-test host por
12430 74 29 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 t) db run-id tes
12440 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
12450 20 66 6f 72 63 65 2d 77 72 69 74 65 3a 20 23 74 force-write: #t
12460 29 29 0a 20 20 20 20 20 20 28 63 64 62 3a 74 65 )). (cdb:te
12470 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 65 73 sts-register-tes
12480 74 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 t db run-id test
12490 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
124a0 66 6f 72 63 65 2d 77 72 69 74 65 3a 20 23 74 29 force-write: #t)
124b0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 64 62 ))..(define (rdb
124c0 3a 66 6c 75 73 68 2d 71 75 65 75 65 29 0a 20 20 :flush-queue).
124d0 28 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a (if *runremote*.
124e0 20 20 20 20 20 20 28 6c 65 74 20 28 28 68 6f 73 (let ((hos
124f0 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 t (vector-ref *r
12500 75 6e 72 65 6d 6f 74 65 2a 20 30 29 29 0a 09 20 unremote* 0))..
12510 20 20 20 28 70 6f 72 74 20 28 76 65 63 74 6f 72 (port (vector
12520 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a -ref *runremote*
12530 20 31 29 29 29 0a 09 28 28 72 70 63 3a 70 72 6f 1)))..((rpc:pro
12540 63 65 64 75 72 65 20 27 63 64 62 3a 66 6c 75 73 cedure 'cdb:flus
12550 68 2d 71 75 65 75 65 20 68 6f 73 74 20 70 6f 72 h-queue host por
12560 74 29 29 29 0a 20 20 20 20 20 20 28 63 64 62 3a t))). (cdb:
12570 66 6c 75 73 68 2d 71 75 65 75 65 29 29 29 0a 0a flush-queue)))..