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 33 2c right 2006-2013,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 44 61 74 61 62 61 73 65 ====.;; Database
0230: 20 61 63 63 65 73 73 0a 3b 3b 3d 3d 3d 3d 3d 3d access.;;======
0240: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0280: 0a 0a 28 72 65 71 75 69 72 65 2d 65 78 74 65 6e ..(require-exten
0290: 73 69 6f 6e 20 28 73 72 66 69 20 31 38 29 20 65 sion (srfi 18) e
02a0: 78 74 72 61 73 20 74 63 70 29 20 3b 3b 20 20 72 xtras tcp) ;; r
02b0: 70 63 29 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 28 pc).;; (import (
02c0: 70 72 65 66 69 78 20 72 70 63 20 72 70 63 3a 29 prefix rpc rpc:)
02d0: 29 0a 0a 28 75 73 65 20 73 71 6c 69 74 65 33 20 )..(use sqlite3
02e0: 73 72 66 69 2d 31 20 70 6f 73 69 78 20 72 65 67 srfi-1 posix reg
02f0: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 73 72 ex regex-case sr
0300: 66 69 2d 36 39 20 63 73 76 2d 78 6d 6c 20 73 31 fi-69 csv-xml s1
0310: 31 6e 20 6d 64 35 20 6d 65 73 73 61 67 65 2d 64 1n md5 message-d
0320: 69 67 65 73 74 20 62 61 73 65 36 34 20 66 6f 72 igest base64 for
0330: 6d 61 74 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 mat).(import (pr
0340: 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 71 6c efix sqlite3 sql
0350: 69 74 65 33 3a 29 29 0a 28 69 6d 70 6f 72 74 20 ite3:)).(import
0360: 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 62 (prefix base64 b
0370: 61 73 65 36 34 3a 29 29 0a 0a 3b 3b 20 4e 6f 74 ase64:))..;; Not
0380: 65 2c 20 74 72 79 20 74 6f 20 72 65 6d 6f 76 65 e, try to remove
0390: 20 74 68 69 73 20 64 65 70 65 6e 64 65 6e 63 79 this dependency
03a0: 20 0a 3b 3b 20 28 75 73 65 20 7a 6d 71 29 0a 0a .;; (use zmq)..
03b0: 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 64 (declare (unit d
03c0: 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 b)).(declare (us
03d0: 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 es common)).(dec
03e0: 6c 61 72 65 20 28 75 73 65 73 20 6b 65 79 73 29 lare (uses keys)
03f0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0400: 20 6f 64 73 29 29 0a 28 64 65 63 6c 61 72 65 20 ods)).(declare
0410: 28 75 73 65 73 20 66 73 2d 74 72 61 6e 73 70 6f (uses fs-transpo
0420: 72 74 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 rt)).(declare (u
0430: 73 65 73 20 63 6c 69 65 6e 74 29 29 0a 28 64 65 ses client)).(de
0440: 63 6c 61 72 65 20 28 75 73 65 73 20 6d 74 29 29 clare (uses mt))
0450: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0460: 66 69 6c 65 64 62 29 29 0a 0a 28 69 6e 63 6c 75 filedb))..(inclu
0470: 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 de "common_recor
0480: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
0490: 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 e "db_records.sc
04a0: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 m").(include "ke
04b0: 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a y_records.scm").
04c0: 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 (include "run_re
04d0: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 20 cords.scm")..;;
04e0: 74 69 6d 65 73 74 61 6d 70 20 74 79 70 65 20 28 timestamp type (
04f0: 76 61 6c 31 20 76 61 6c 32 20 2e 2e 2e 29 0a 3b val1 val2 ...).;
0500: 3b 20 74 79 70 65 3a 20 6d 65 74 61 2d 69 6e 66 ; type: meta-inf
0510: 6f 2c 20 73 74 65 70 0a 28 64 65 66 69 6e 65 20 o, step.(define
0520: 2a 69 6e 63 6f 6d 69 6e 67 2d 77 72 69 74 65 73 *incoming-writes
0530: 2a 20 20 20 20 20 20 27 28 29 29 0a 28 64 65 66 * '()).(def
0540: 69 6e 65 20 2a 63 6f 6d 70 6c 65 74 65 64 2d 77 ine *completed-w
0550: 72 69 74 65 73 2a 20 20 20 28 6d 61 6b 65 2d 68 rites* (make-h
0560: 61 73 68 2d 74 61 62 6c 65 29 29 0a 28 64 65 66 ash-table)).(def
0570: 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6c 61 ine *incoming-la
0580: 73 74 2d 74 69 6d 65 2a 20 28 63 75 72 72 65 6e st-time* (curren
0590: 74 2d 73 65 63 6f 6e 64 73 29 29 0a 28 64 65 66 t-seconds)).(def
05a0: 69 6e 65 20 2a 69 6e 63 6f 6d 69 6e 67 2d 6d 75 ine *incoming-mu
05b0: 74 65 78 2a 20 20 20 20 20 28 6d 61 6b 65 2d 6d tex* (make-m
05c0: 75 74 65 78 29 29 0a 28 64 65 66 69 6e 65 20 2a utex)).(define *
05d0: 63 6f 6d 70 6c 65 74 65 64 2d 6d 75 74 65 78 2a completed-mutex*
05e0: 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 (make-mutex)
05f0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 )..(define (db:g
0600: 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 72 et-db dbstruct r
0610: 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 un-id). (let ((
0620: 64 62 20 28 69 66 20 72 75 6e 2d 69 64 0a 09 09 db (if run-id...
0630: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
0640: 64 65 66 61 75 6c 74 20 28 76 65 63 74 6f 72 2d default (vector-
0650: 72 65 66 20 64 62 73 74 72 75 63 74 20 31 29 20 ref dbstruct 1)
0660: 72 75 6e 2d 69 64 20 23 66 29 0a 09 09 28 76 65 run-id #f)...(ve
0670: 63 74 6f 72 2d 72 65 66 20 64 62 73 74 72 75 63 ctor-ref dbstruc
0680: 74 20 30 29 29 29 29 0a 20 20 20 20 28 69 66 20 t 0)))). (if
0690: 64 62 0a 09 64 62 0a 09 28 6c 65 74 20 28 28 64 db..db..(let ((d
06a0: 62 20 28 6f 70 65 6e 2d 64 62 20 72 75 6e 2d 69 b (open-db run-i
06b0: 64 29 29 29 0a 09 20 20 28 69 66 20 72 75 6e 2d d))).. (if run-
06c0: 69 64 0a 09 20 20 20 20 20 20 28 68 61 73 68 2d id.. (hash-
06d0: 74 61 62 6c 65 2d 73 65 74 21 20 28 76 65 63 74 table-set! (vect
06e0: 6f 72 2d 72 65 66 20 64 62 73 74 72 75 63 74 20 or-ref dbstruct
06f0: 31 29 20 72 75 6e 2d 69 64 20 64 62 29 0a 09 20 1) run-id db)..
0700: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
0710: 21 20 64 62 73 74 72 75 63 74 20 30 20 64 62 29 ! dbstruct 0 db)
0720: 29 0a 09 20 20 64 62 29 29 29 29 0a 0a 28 64 65 ).. db))))..(de
0730: 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 73 79 6e fine (db:set-syn
0740: 63 20 64 62 29 0a 20 20 28 6c 65 74 2a 20 28 28 c db). (let* ((
0750: 73 79 6e 63 76 61 6c 20 20 28 63 6f 6e 66 69 67 syncval (config
0760: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
0770: 61 74 2a 20 22 73 65 74 75 70 22 20 20 20 20 20 at* "setup"
0780: 22 73 79 6e 63 68 72 6f 6e 6f 75 73 22 29 29 0a "synchronous")).
0790: 09 20 28 76 61 6c 20 20 20 20 20 20 28 63 6f 6e . (val (con
07a0: 64 20 20 20 3b 3b 20 30 20 7c 20 4f 46 46 20 7c d ;; 0 | OFF |
07b0: 20 31 20 7c 20 4e 4f 52 4d 41 4c 20 7c 20 32 20 1 | NORMAL | 2
07c0: 7c 20 46 55 4c 4c 3b 0a 09 09 20 20 20 20 28 28 | FULL;... ((
07d0: 6e 6f 74 20 73 79 6e 63 76 61 6c 29 20 23 66 29 not syncval) #f)
07e0: 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e 67 2d ... ((string-
07f0: 3e 6e 75 6d 62 65 72 20 73 79 6e 63 76 61 6c 29 >number syncval)
0800: 0a 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 ... (let ((v
0810: 61 6c 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 al (string->numb
0820: 65 72 20 73 79 6e 63 76 61 6c 29 29 29 0a 09 09 er syncval)))...
0830: 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 (if (memb
0840: 65 72 20 76 61 6c 20 27 28 30 20 31 20 32 29 29 er val '(0 1 2))
0850: 20 76 61 6c 20 23 66 29 29 29 0a 09 09 20 20 20 val #f)))...
0860: 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 ((string-match
0870: 28 72 65 67 65 78 70 20 22 79 65 73 22 20 23 74 (regexp "yes" #t
0880: 29 20 73 79 6e 63 76 61 6c 29 20 31 29 0a 09 09 ) syncval) 1)...
0890: 20 20 20 20 28 28 73 74 72 69 6e 67 2d 6d 61 74 ((string-mat
08a0: 63 68 20 28 72 65 67 65 78 70 20 22 6e 6f 22 20 ch (regexp "no"
08b0: 20 23 74 29 20 73 79 6e 63 76 61 6c 29 20 30 29 #t) syncval) 0)
08c0: 0a 09 09 20 20 20 20 28 28 73 74 72 69 6e 67 2d ... ((string-
08d0: 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 28 match (regexp "(
08e0: 6f 66 66 7c 6e 6f 72 6d 61 6c 7c 66 75 6c 6c 29 off|normal|full)
08f0: 22 20 23 74 29 20 73 79 6e 63 76 61 6c 29 20 73 " #t) syncval) s
0900: 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 20 28 65 yncval)... (e
0910: 6c 73 65 20 0a 09 09 20 20 20 20 20 28 64 65 62 lse ... (deb
0920: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
0930: 52 3a 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 6d R: synchronous m
0940: 75 73 74 20 62 65 20 30 2c 31 2c 32 2c 4f 46 46 ust be 0,1,2,OFF
0950: 2c 4e 4f 52 4d 41 4c 20 6f 72 20 46 55 4c 4c 2c ,NORMAL or FULL,
0960: 20 79 6f 75 20 70 72 6f 76 69 64 65 64 3a 20 22 you provided: "
0970: 20 73 79 6e 63 76 61 6c 29 0a 09 09 20 20 20 20 syncval)...
0980: 20 23 66 29 29 29 29 0a 20 20 20 20 28 69 66 20 #f)))). (if
0990: 76 61 6c 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 val..(begin.. (
09a0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
09b0: 20 39 20 22 64 62 3a 73 65 74 2d 73 79 6e 63 2c 9 "db:set-sync,
09c0: 20 73 65 74 74 69 6e 67 20 70 72 61 67 6d 61 20 setting pragma
09d0: 73 79 6e 63 68 72 6f 6e 6f 75 73 20 74 6f 20 22 synchronous to "
09e0: 20 76 61 6c 29 0a 09 20 20 28 73 71 6c 69 74 65 val).. (sqlite
09f0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 3:execute db (co
0a00: 6e 63 20 22 50 52 41 47 4d 41 20 73 79 6e 63 68 nc "PRAGMA synch
0a10: 72 6f 6e 6f 75 73 20 3d 20 27 22 20 76 61 6c 20 ronous = '" val
0a20: 22 27 3b 22 29 29 29 29 29 29 0a 0a 3b 3b 3d 3d "';"))))))..;;==
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a70: 3d 3d 3d 3d 0a 3b 3b 20 4b 20 45 20 45 20 50 20 ====.;; K E E P
0a80: 20 20 46 20 49 20 4c 20 45 20 44 20 42 20 20 20 F I L E D B
0a90: 49 20 4e 20 20 20 64 62 73 74 72 75 63 74 0a 3b I N dbstruct.;
0aa0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
0ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ae0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
0af0: 20 28 64 62 3a 67 65 74 2d 66 69 6c 65 64 62 20 (db:get-filedb
0b00: 64 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 74 dbstruct). (let
0b10: 20 28 28 64 62 20 28 76 65 63 74 6f 72 2d 72 65 ((db (vector-re
0b20: 66 20 64 62 73 74 72 75 63 74 20 32 29 29 29 0a f dbstruct 2))).
0b30: 20 20 20 20 28 69 66 20 64 62 0a 09 64 62 0a 09 (if db..db..
0b40: 28 6c 65 74 20 28 28 66 64 62 20 28 66 69 6c 65 (let ((fdb (file
0b50: 64 62 3a 6f 70 65 6e 2d 64 62 20 28 63 6f 6e 63 db:open-db (conc
0b60: 20 2a 74 6f 70 6c 65 76 65 6c 2a 20 22 2f 64 62 *toplevel* "/db
0b70: 2f 66 69 6c 65 73 2e 64 62 22 29 29 29 29 0a 09 /files.db"))))..
0b80: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 64 (vector-set! d
0b90: 62 73 74 72 75 63 74 20 32 20 66 64 62 29 0a 09 bstruct 2 fdb)..
0ba0: 20 20 66 64 62 29 29 29 29 0a 0a 3b 3b 20 43 61 fdb))))..;; Ca
0bb0: 6e 20 61 6c 73 6f 20 62 65 20 75 73 65 64 20 74 n also be used t
0bc0: 6f 20 73 61 76 65 20 61 72 62 69 74 72 61 72 79 o save arbitrary
0bd0: 20 73 74 72 69 6e 67 73 0a 3b 3b 0a 28 64 65 66 strings.;;.(def
0be0: 69 6e 65 20 28 64 62 3a 73 61 76 65 2d 70 61 74 ine (db:save-pat
0bf0: 68 20 64 62 73 74 72 75 63 74 20 70 61 74 68 29 h dbstruct path)
0c00: 0a 20 20 28 6c 65 74 20 28 28 66 64 62 20 28 64 . (let ((fdb (d
0c10: 62 3a 67 65 74 2d 66 69 6c 65 64 62 20 64 62 73 b:get-filedb dbs
0c20: 74 72 75 63 74 29 29 29 0a 20 20 20 20 28 66 69 truct))). (fi
0c30: 6c 65 64 62 3a 72 65 67 69 73 74 65 72 2d 70 61 ledb:register-pa
0c40: 74 68 20 66 64 62 20 70 61 74 68 29 29 29 0a 0a th fdb path)))..
0c50: 3b 3b 20 55 73 65 20 74 6f 20 67 65 74 20 61 20 ;; Use to get a
0c60: 70 61 74 68 2e 20 54 6f 20 67 65 74 20 61 6e 20 path. To get an
0c70: 61 72 62 69 74 72 61 72 79 20 73 74 72 69 6e 67 arbitrary string
0c80: 20 73 65 65 20 6e 65 78 74 20 64 65 66 69 6e 65 see next define
0c90: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a .;;.(define (db:
0ca0: 67 65 74 2d 70 61 74 68 20 64 62 73 74 72 75 63 get-path dbstruc
0cb0: 74 20 69 64 29 0a 20 20 28 6c 65 74 20 28 28 66 t id). (let ((f
0cc0: 64 62 20 28 64 62 3a 67 65 74 2d 66 69 6c 65 64 db (db:get-filed
0cd0: 62 20 64 62 73 74 72 75 63 74 29 29 29 0a 20 20 b dbstruct))).
0ce0: 20 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 (filedb:get-pa
0cf0: 74 68 20 64 62 20 69 64 29 29 29 0a 0a 3b 3b 3d th db id)))..;;=
0d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d40: 3d 3d 3d 3d 3d 0a 3b 3b 20 55 20 53 20 45 20 20 =====.;; U S E
0d50: 20 46 20 49 20 4c 20 45 20 20 20 44 20 42 20 20 F I L E D B
0d60: 20 54 20 4f 20 20 20 53 20 54 20 4f 20 52 20 45 T O S T O R E
0d70: 20 20 20 53 20 54 20 52 20 49 20 4e 20 47 20 53 S T R I N G S
0d80: 20 0a 3b 3b 0a 3b 3b 20 4e 20 4f 20 54 20 45 20 .;;.;; N O T E
0d90: 21 20 21 20 20 20 54 20 48 20 49 20 53 20 20 20 ! ! T H I S
0da0: 43 20 4c 20 4f 20 42 20 42 20 45 20 52 20 53 20 C L O B B E R S
0db0: 20 20 4d 20 55 20 4c 20 54 20 49 20 50 20 4c 20 M U L T I P L
0dc0: 45 20 20 2f 2f 2f 2f 20 20 54 20 4f 20 20 2f 0a E //// T O /.
0dd0: 3b 3b 0a 3b 3b 20 52 65 70 6c 61 63 65 20 77 69 ;;.;; Replace wi
0de0: 74 68 20 73 6f 6d 65 74 68 69 6e 67 20 70 72 6f th something pro
0df0: 70 65 72 21 0a 3b 3b 0a 3b 3b 3d 3d 3d 3d 3d 3d per!.;;.;;======
0e00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0e40: 0a 0a 3b 3b 20 55 73 65 20 74 6f 20 73 61 76 65 ..;; Use to save
0e50: 20 61 20 73 74 6f 72 65 64 20 73 74 72 69 6e 67 a stored string
0e60: 2c 20 70 61 64 20 77 69 74 68 20 5f 20 74 6f 20 , pad with _ to
0e70: 64 65 61 6c 20 77 69 74 68 20 74 72 69 6d 6d 69 deal with trimmi
0e80: 6e 67 20 74 68 65 20 70 72 65 70 65 6e 64 69 6e ng the prependin
0e90: 67 20 6f 66 20 2f 0a 3b 3b 20 0a 28 64 65 66 69 g of /.;; .(defi
0ea0: 6e 65 20 28 64 62 3a 73 61 76 65 2d 73 74 72 69 ne (db:save-stri
0eb0: 6e 67 20 64 62 73 74 72 75 63 74 20 73 74 72 29 ng dbstruct str)
0ec0: 0a 20 20 28 6c 65 74 20 28 28 66 64 62 20 28 64 . (let ((fdb (d
0ed0: 62 3a 67 65 74 2d 66 69 6c 65 64 62 20 64 62 73 b:get-filedb dbs
0ee0: 74 72 75 63 74 29 29 29 0a 20 20 20 20 28 66 69 truct))). (fi
0ef0: 6c 65 64 62 3a 72 65 67 69 73 74 65 72 2d 70 61 ledb:register-pa
0f00: 74 68 20 66 64 62 20 28 63 6f 6e 63 20 22 5f 22 th fdb (conc "_"
0f10: 20 73 74 72 29 29 29 29 0a 0a 3b 3b 20 55 73 65 str))))..;; Use
0f20: 20 74 6f 20 67 65 74 20 61 20 73 74 6f 72 65 64 to get a stored
0f30: 20 73 74 72 69 6e 67 0a 3b 3b 0a 28 64 65 66 69 string.;;.(defi
0f40: 6e 65 20 28 64 62 3a 67 65 74 2d 73 74 72 69 6e ne (db:get-strin
0f50: 67 20 64 62 73 74 72 75 63 74 20 69 64 29 0a 20 g dbstruct id).
0f60: 20 28 6c 65 74 20 28 28 66 64 62 20 28 64 62 3a (let ((fdb (db:
0f70: 67 65 74 2d 66 69 6c 65 64 62 20 64 62 73 74 72 get-filedb dbstr
0f80: 75 63 74 29 29 29 0a 20 20 20 20 28 73 74 72 69 uct))). (stri
0f90: 6e 67 2d 64 72 6f 70 20 28 66 69 6c 65 64 62 3a ng-drop (filedb:
0fa0: 67 65 74 2d 70 61 74 68 20 66 64 62 20 69 64 29 get-path fdb id)
0fb0: 20 32 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 72 2)))..;; This r
0fc0: 6f 75 74 69 6e 65 20 63 72 65 61 74 65 73 20 74 outine creates t
0fd0: 68 65 20 64 62 2e 20 49 74 20 69 73 20 6f 6e 6c he db. It is onl
0fe0: 79 20 63 61 6c 6c 65 64 20 69 66 20 74 68 65 20 y called if the
0ff0: 64 62 20 69 73 20 6e 6f 74 20 61 6c 72 65 61 64 db is not alread
1000: 79 20 6f 70 65 6e 65 64 0a 3b 3b 0a 28 64 65 66 y opened.;;.(def
1010: 69 6e 65 20 28 6f 70 65 6e 2d 64 62 20 64 62 73 ine (open-db dbs
1020: 74 72 75 63 74 20 72 75 6e 2d 69 64 29 20 3b 3b truct run-id) ;;
1030: 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 (conc *toppath
1040: 2a 20 22 2f 6d 65 67 61 74 65 73 74 2e 64 62 22 * "/megatest.db"
1050: 29 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e ) (car *configin
1060: 66 6f 2a 29 29 29 0a 20 20 28 69 66 20 28 6e 6f fo*))). (if (no
1070: 74 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 t *toppath*).
1080: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 (if (not (set
1090: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
10a0: 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 65 62 (begin.. (deb
10b0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
10c0: 52 3a 20 41 74 74 65 6d 70 74 65 64 20 74 6f 20 R: Attempted to
10d0: 6f 70 65 6e 20 64 62 20 77 68 65 6e 20 6e 6f 74 open db when not
10e0: 20 69 6e 20 6d 65 67 61 74 65 73 74 20 61 72 65 in megatest are
10f0: 61 2e 20 45 78 69 74 69 6e 67 2e 22 29 0a 09 20 a. Exiting.")..
1100: 20 20 20 28 65 78 69 74 29 29 29 29 0a 20 20 28 (exit)))). (
1110: 6c 65 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 let* ((dbpath
1120: 20 20 20 20 28 69 66 20 72 75 6e 2d 69 64 20 0a (if run-id .
1130: 09 09 09 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 ... (conc *top
1140: 70 61 74 68 2a 20 22 2f 64 62 2f 22 20 72 75 6e path* "/db/" run
1150: 2d 69 64 20 22 2e 64 62 22 29 0a 09 09 09 20 20 -id ".db")....
1160: 20 28 6c 65 74 20 28 28 64 62 64 69 72 20 28 63 (let ((dbdir (c
1170: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
1180: 64 62 22 29 29 29 20 3b 3b 20 75 73 65 20 74 68 db"))) ;; use th
1190: 69 73 20 6f 70 70 6f 72 74 75 6e 69 74 79 20 74 is opportunity t
11a0: 6f 20 63 72 65 61 74 65 20 6f 75 72 20 64 62 20 o create our db
11b0: 64 69 72 0a 09 09 09 20 20 20 20 20 28 69 66 20 dir.... (if
11c0: 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d (not (directory-
11d0: 65 78 69 73 74 73 3f 20 64 62 64 69 72 29 29 0a exists? dbdir)).
11e0: 09 09 09 09 20 28 63 72 65 61 74 65 2d 64 69 72 .... (create-dir
11f0: 65 63 6f 72 79 20 64 62 64 69 72 29 29 0a 09 09 ecory dbdir))...
1200: 09 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 . (conc *top
1210: 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 74 path* "/megatest
1220: 2e 64 62 22 29 29 29 29 0a 09 20 28 64 62 65 78 .db")))).. (dbex
1230: 69 73 74 73 20 20 28 66 69 6c 65 2d 65 78 69 73 ists (file-exis
1240: 74 73 3f 20 64 62 70 61 74 68 29 29 0a 09 20 28 ts? dbpath)).. (
1250: 64 62 20 20 20 20 20 20 20 20 28 73 71 6c 69 74 db (sqlit
1260: 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 e3:open-database
1270: 20 64 62 70 61 74 68 29 29 20 3b 3b 20 28 6e 65 dbpath)) ;; (ne
1280: 76 65 72 2d 67 69 76 65 2d 75 70 2d 6f 70 65 6e ver-give-up-open
1290: 2d 64 62 20 64 62 70 61 74 68 29 29 0a 09 20 28 -db dbpath)).. (
12a0: 77 72 69 74 65 2d 61 63 63 65 73 73 20 28 66 69 write-access (fi
12b0: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
12c0: 20 64 62 70 61 74 68 29 29 0a 09 20 28 68 61 6e dbpath)).. (han
12d0: 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 dler (make-bus
12e0: 79 2d 74 69 6d 65 6f 75 74 20 28 69 66 20 28 61 y-timeout (if (a
12f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 rgs:get-arg "-ov
1300: 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 erride-timeout")
1310: 0a 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 ...... (string
1320: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
1330: 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 et-arg "-overrid
1340: 65 2d 74 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 e-timeout"))....
1350: 09 09 20 20 20 31 33 36 30 30 30 29 29 29 29 20 .. 136000))))
1360: 3b 3b 20 31 33 36 30 30 30 29 29 29 20 3b 3b 20 ;; 136000))) ;;
1370: 31 33 36 30 30 30 20 3d 20 32 2e 32 20 6d 69 6e 136000 = 2.2 min
1380: 75 74 65 73 0a 20 20 20 20 28 69 66 20 28 61 6e utes. (if (an
1390: 64 20 64 62 65 78 69 73 74 73 0a 09 20 20 20 20 d dbexists..
13a0: 20 28 6e 6f 74 20 77 72 69 74 65 2d 61 63 63 65 (not write-acce
13b0: 73 73 29 29 0a 09 28 73 65 74 21 20 2a 64 62 2d ss))..(set! *db-
13c0: 77 72 69 74 65 2d 61 63 63 65 73 73 2a 20 77 72 write-access* wr
13d0: 69 74 65 2d 61 63 63 65 73 73 29 29 20 3b 3b 20 ite-access)) ;;
13e0: 6f 6e 6c 79 20 75 6e 73 65 74 20 73 6f 20 6f 74 only unset so ot
13f0: 68 65 72 20 64 62 27 73 20 61 6c 73 6f 20 63 61 her db's also ca
1400: 6e 20 75 73 65 20 74 68 69 73 20 63 6f 6e 74 72 n use this contr
1410: 6f 6c 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 ol. (debug:pr
1420: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 65 int-info 11 "ope
1430: 6e 2d 64 62 2c 20 64 62 70 61 74 68 3d 22 20 64 n-db, dbpath=" d
1440: 62 70 61 74 68 20 22 20 61 72 67 76 3d 22 20 28 bpath " argv=" (
1450: 61 72 67 76 29 29 0a 20 20 20 20 28 69 66 20 77 argv)). (if w
1460: 72 69 74 65 2d 61 63 63 65 73 73 20 28 73 71 6c rite-access (sql
1470: 69 74 65 33 3a 73 65 74 2d 62 75 73 79 2d 68 61 ite3:set-busy-ha
1480: 6e 64 6c 65 72 21 20 64 62 20 68 61 6e 64 6c 65 ndler! db handle
1490: 72 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 r)). (if (not
14a0: 20 64 62 65 78 69 73 74 73 29 0a 09 28 69 66 20 dbexists)..(if
14b0: 28 6e 6f 74 20 72 75 6e 2d 69 64 29 20 3b 3b 20 (not run-id) ;;
14c0: 64 6f 20 74 68 65 20 6d 65 67 61 74 65 73 74 2e do the megatest.
14d0: 64 62 0a 09 20 20 20 20 28 64 62 3a 69 6e 69 74 db.. (db:init
14e0: 69 61 6c 69 7a 65 2d 6d 65 67 61 74 65 73 74 2d ialize-megatest-
14f0: 64 62 20 64 62 29 0a 09 20 20 20 20 28 64 62 3a db db).. (db:
1500: 69 6e 69 74 69 61 6c 69 7a 65 2d 72 75 6e 2d 69 initialize-run-i
1510: 64 2d 64 62 20 20 20 64 62 20 72 75 6e 2d 69 64 d-db db run-id
1520: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ))). (sqlite3
1530: 3a 65 78 65 63 75 74 65 20 64 62 20 22 50 52 41 :execute db "PRA
1540: 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 GMA synchronous
1550: 3d 20 30 3b 22 29 0a 20 20 20 20 64 62 29 29 0a = 0;"). db)).
1560: 0a 3b 3b 20 63 6c 6f 73 65 20 61 6c 6c 20 6f 70 .;; close all op
1570: 65 6e 65 64 20 72 75 6e 2d 69 64 20 64 62 73 0a ened run-id dbs.
1580: 28 64 65 66 69 6e 65 20 28 64 62 3a 63 6c 6f 73 (define (db:clos
1590: 65 2d 61 6c 6c 2d 64 62 29 0a 20 20 28 66 6f 72 e-all-db). (for
15a0: 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d 62 64 61 -each. (lambda
15b0: 20 28 64 62 29 0a 20 20 20 20 20 28 66 69 6e 61 (db). (fina
15c0: 6c 69 7a 65 21 20 64 62 29 29 0a 20 20 20 28 68 lize! db)). (h
15d0: 61 73 68 2d 74 61 62 6c 65 2d 76 61 6c 75 65 73 ash-table-values
15e0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 6f 70 (vector-ref *op
15f0: 65 6e 2d 64 62 73 2a 20 31 29 29 29 0a 20 20 28 en-dbs* 1))). (
1600: 66 69 6e 61 6c 69 7a 65 21 20 28 76 65 63 74 6f finalize! (vecto
1610: 72 2d 72 65 66 20 2a 6f 70 65 6e 2d 64 62 73 2a r-ref *open-dbs*
1620: 20 30 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 0)))..(define (
1630: 6f 70 65 6e 2d 69 6e 2d 6d 65 6d 2d 64 62 29 0a open-in-mem-db).
1640: 20 20 28 6c 65 74 2a 20 28 28 70 61 74 68 20 20 (let* ((path
1650: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
1660: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
1670: 74 75 70 22 20 22 74 6d 70 64 62 22 29 29 0a 09 tup" "tmpdb"))..
1680: 20 28 66 6e 61 6d 65 20 20 28 69 66 20 70 61 74 (fname (if pat
1690: 68 20 28 63 6f 6e 63 20 70 61 74 68 20 22 2f 74 h (conc path "/t
16a0: 65 6d 70 2d 6d 65 67 61 74 65 73 74 2e 64 62 22 emp-megatest.db"
16b0: 29 20 23 66 29 29 0a 09 20 28 65 78 69 73 74 73 ) #f)).. (exists
16c0: 20 28 61 6e 64 20 70 61 74 68 20 28 66 69 6c 65 (and path (file
16d0: 2d 65 78 69 73 74 73 3f 20 66 6e 61 6d 65 29 29 -exists? fname))
16e0: 29 0a 09 20 28 64 62 20 20 20 20 20 28 69 66 20 ).. (db (if
16f0: 70 61 74 68 0a 09 09 20 20 20 20 20 28 62 65 67 path... (beg
1700: 69 6e 0a 09 09 20 20 20 20 20 20 20 28 63 72 65 in... (cre
1710: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 70 61 ate-directory pa
1720: 74 68 20 23 74 29 0a 09 09 20 20 20 20 20 20 20 th #t)...
1730: 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d 64 61 (sqlite3:open-da
1740: 74 61 62 61 73 65 20 66 6e 61 6d 65 29 29 0a 09 tabase fname))..
1750: 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 6f . (sqlite3:o
1760: 70 65 6e 2d 64 61 74 61 62 61 73 65 20 22 3a 6d pen-database ":m
1770: 65 6d 6f 72 79 3a 22 29 29 29 0a 09 20 28 68 61 emory:"))).. (ha
1780: 6e 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d 62 75 ndler (make-bu
1790: 73 79 2d 74 69 6d 65 6f 75 74 20 33 36 30 30 29 sy-timeout 3600)
17a0: 29 29 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 )). (if (or (
17b0: 6e 6f 74 20 70 61 74 68 29 0a 09 20 20 20 20 28 not path).. (
17c0: 6e 6f 74 20 65 78 69 73 74 73 29 29 0a 09 28 64 not exists))..(d
17d0: 62 3a 69 6e 69 74 69 61 6c 69 7a 65 20 64 62 29 b:initialize db)
17e0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 73 ). (sqlite3:s
17f0: 65 74 2d 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 et-busy-handler!
1800: 20 64 62 20 68 61 6e 64 6c 65 72 29 0a 20 20 20 db handler).
1810: 20 64 62 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e db))..;; (defin
1820: 65 20 28 64 62 3a 73 79 6e 63 2d 74 61 62 6c 65 e (db:sync-table
1830: 20 74 62 6c 6e 61 6d 65 20 66 69 65 6c 64 73 20 tblname fields
1840: 66 72 6f 6d 64 62 20 74 6f 64 62 29 0a 0a 28 64 fromdb todb)..(d
1850: 65 66 69 6e 65 20 28 64 62 3a 74 62 6c 73 20 64 efine (db:tbls d
1860: 62 29 0a 20 20 28 6c 65 74 20 28 28 6b 65 79 73 b). (let ((keys
1870: 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 (db:get-keys d
1880: 62 29 29 29 0a 20 20 20 20 28 6c 69 73 74 0a 20 b))). (list.
1890: 20 20 20 20 28 6c 69 73 74 20 22 6b 65 79 73 22 (list "keys"
18a0: 0a 09 20 20 20 27 28 22 69 64 22 20 20 20 20 20 .. '("id"
18b0: 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 66 69 #f).. '("fi
18c0: 65 6c 64 6e 61 6d 65 22 20 23 66 29 0a 09 20 20 eldname" #f)..
18d0: 20 27 28 22 66 69 65 6c 64 74 79 70 65 22 20 23 '("fieldtype" #
18e0: 66 29 29 0a 20 20 20 20 20 28 6c 69 73 74 20 22 f)). (list "
18f0: 6d 65 74 61 64 61 74 22 20 27 28 22 76 61 72 22 metadat" '("var"
1900: 20 23 66 29 20 27 28 22 76 61 6c 22 20 23 66 29 #f) '("val" #f)
1910: 29 0a 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 ). (append (
1920: 6c 69 73 74 20 22 72 75 6e 73 22 20 0a 09 09 20 list "runs" ...
1930: 20 20 27 28 22 69 64 22 20 20 23 66 29 29 0a 09 '("id" #f))..
1940: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd
1950: 61 20 28 6b 29 28 6c 69 73 74 20 6b 20 23 66 29 a (k)(list k #f)
1960: 29 0a 09 09 20 20 28 61 70 70 65 6e 64 20 6b 65 )... (append ke
1970: 79 73 0a 09 09 09 20 20 28 6c 69 73 74 20 22 72 ys.... (list "r
1980: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
1990: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
19a0: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 20 22 63 "event_time" "c
19b0: 6f 6d 6d 65 6e 74 22 20 22 66 61 69 6c 5f 63 6f omment" "fail_co
19c0: 75 6e 74 22 20 22 70 61 73 73 5f 63 6f 75 6e 74 unt" "pass_count
19d0: 22 29 29 29 29 0a 20 20 20 20 20 28 6c 69 73 74 ")))). (list
19e0: 20 22 74 65 73 74 73 22 20 0a 09 20 20 20 27 28 "tests" .. '(
19f0: 22 69 64 22 20 20 20 20 20 20 20 20 20 20 20 20 "id"
1a00: 20 23 66 29 0a 09 20 20 20 27 28 22 72 75 6e 5f #f).. '("run_
1a10: 69 64 22 20 20 20 20 20 20 20 20 20 23 66 29 0a id" #f).
1a20: 09 20 20 20 27 28 22 74 65 73 74 6e 61 6d 65 22 . '("testname"
1a30: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 27 #f).. '
1a40: 28 22 68 6f 73 74 22 20 20 20 20 20 20 20 20 20 ("host"
1a50: 20 20 23 66 29 0a 09 20 20 20 27 28 22 63 70 75 #f).. '("cpu
1a60: 6c 6f 61 64 22 20 20 20 20 20 20 20 20 23 66 29 load" #f)
1a70: 0a 09 20 20 20 27 28 22 64 69 73 6b 66 72 65 65 .. '("diskfree
1a80: 22 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 " #f)..
1a90: 27 28 22 75 6e 61 6d 65 22 20 20 20 20 20 20 20 '("uname"
1aa0: 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 72 75 #f).. '("ru
1ab0: 6e 64 69 72 22 20 20 20 20 20 20 20 20 20 23 66 ndir" #f
1ac0: 29 0a 09 20 20 20 27 28 22 73 68 6f 72 74 64 69 ).. '("shortdi
1ad0: 72 22 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 r" #f)..
1ae0: 20 27 28 22 69 74 65 6d 5f 70 61 74 68 22 20 20 '("item_path"
1af0: 20 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 73 #f).. '("s
1b00: 74 61 74 65 22 20 20 20 20 20 20 20 20 20 20 23 tate" #
1b10: 66 29 0a 09 20 20 20 27 28 22 73 74 61 74 75 73 f).. '("status
1b20: 22 20 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 " #f)..
1b30: 20 20 27 28 22 61 74 74 65 6d 70 74 6e 75 6d 22 '("attemptnum"
1b40: 20 20 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 #f).. '("
1b50: 66 69 6e 61 6c 5f 6c 6f 67 66 22 20 20 20 20 20 final_logf"
1b60: 23 66 29 0a 09 20 20 20 27 28 22 6c 6f 67 64 61 #f).. '("logda
1b70: 74 22 20 20 20 20 20 20 20 20 20 23 66 29 0a 09 t" #f)..
1b80: 20 20 20 27 28 22 72 75 6e 5f 64 75 72 61 74 69 '("run_durati
1b90: 6f 6e 22 20 20 20 23 66 29 0a 09 20 20 20 27 28 on" #f).. '(
1ba0: 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 20 20 "comment"
1bb0: 20 23 66 29 0a 09 20 20 20 27 28 22 65 76 65 6e #f).. '("even
1bc0: 74 5f 74 69 6d 65 22 20 20 20 20 20 23 66 29 0a t_time" #f).
1bd0: 09 20 20 20 27 28 22 66 61 69 6c 5f 63 6f 75 6e . '("fail_coun
1be0: 74 22 20 20 20 20 20 23 66 29 0a 09 20 20 20 27 t" #f).. '
1bf0: 28 22 70 61 73 73 5f 63 6f 75 6e 74 22 20 20 20 ("pass_count"
1c00: 20 20 23 66 29 0a 09 20 20 20 27 28 22 61 72 63 #f).. '("arc
1c10: 68 69 76 65 64 22 20 20 20 20 20 20 20 23 66 29 hived" #f)
1c20: 29 0a 20 20 20 20 20 28 6c 69 73 74 20 22 74 65 ). (list "te
1c30: 73 74 5f 73 74 65 70 73 22 0a 09 20 20 20 27 28 st_steps".. '(
1c40: 22 69 64 22 20 20 20 20 20 20 20 20 20 20 20 20 "id"
1c50: 20 23 66 29 0a 09 20 20 20 27 28 22 74 65 73 74 #f).. '("test
1c60: 5f 69 64 22 20 20 20 20 20 20 20 20 23 66 29 0a _id" #f).
1c70: 09 20 20 20 27 28 22 73 74 65 70 6e 61 6d 65 22 . '("stepname"
1c80: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 27 #f).. '
1c90: 28 22 73 74 61 74 65 22 20 20 20 20 20 20 20 20 ("state"
1ca0: 20 20 23 66 29 0a 09 20 20 20 27 28 22 73 74 61 #f).. '("sta
1cb0: 74 75 73 22 20 20 20 20 20 20 20 20 20 23 66 29 tus" #f)
1cc0: 0a 09 20 20 20 27 28 22 65 76 65 6e 74 5f 74 69 .. '("event_ti
1cd0: 6d 65 22 20 20 20 20 20 23 66 29 0a 09 20 20 20 me" #f)..
1ce0: 27 28 22 63 6f 6d 6d 65 6e 74 22 20 20 20 20 20 '("comment"
1cf0: 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 6c 6f #f).. '("lo
1d00: 67 66 69 6c 65 22 20 20 20 20 20 20 20 20 23 66 gfile" #f
1d10: 29 29 0a 20 20 20 20 20 28 6c 69 73 74 20 22 74 )). (list "t
1d20: 65 73 74 5f 6d 65 74 61 22 0a 09 20 20 20 27 28 est_meta".. '(
1d30: 22 69 64 22 20 20 20 20 20 20 20 20 20 20 20 20 "id"
1d40: 20 23 66 29 0a 09 20 20 20 27 28 22 74 65 73 74 #f).. '("test
1d50: 6e 61 6d 65 22 20 20 20 20 20 20 20 23 66 29 0a name" #f).
1d60: 09 20 20 20 27 28 22 6f 77 6e 65 72 22 20 20 20 . '("owner"
1d70: 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 27 #f).. '
1d80: 28 22 64 65 73 63 72 69 70 74 69 6f 6e 22 20 20 ("description"
1d90: 20 20 23 66 29 0a 09 20 20 20 27 28 22 72 65 76 #f).. '("rev
1da0: 69 65 77 65 64 22 20 20 20 20 20 20 20 23 66 29 iewed" #f)
1db0: 0a 09 20 20 20 27 28 22 69 74 65 72 61 74 65 64 .. '("iterated
1dc0: 22 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 " #f)..
1dd0: 27 28 22 61 76 67 5f 72 75 6e 74 69 6d 65 22 20 '("avg_runtime"
1de0: 20 20 20 23 66 29 0a 09 20 20 20 27 28 22 61 76 #f).. '("av
1df0: 67 5f 64 69 73 6b 22 20 20 20 20 20 20 20 23 66 g_disk" #f
1e00: 29 0a 09 20 20 20 27 28 22 74 61 67 73 22 20 20 ).. '("tags"
1e10: 20 20 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 #f)..
1e20: 20 27 28 22 6a 6f 62 67 72 6f 75 70 22 20 20 20 '("jobgroup"
1e30: 20 20 20 20 23 66 29 29 29 29 29 0a 20 20 20 20 #f))))).
1e40: 0a 3b 3b 20 74 62 6c 73 20 69 73 20 28 20 28 22 .;; tbls is ( ("
1e50: 74 61 62 6c 65 6e 61 6d 65 22 20 28 20 22 66 69 tablename" ( "fi
1e60: 65 6c 64 31 22 20 5b 23 66 7c 70 72 6f 63 31 5d eld1" [#f|proc1]
1e70: 20 29 20 28 20 22 66 69 65 6c 64 32 22 20 5b 23 ) ( "field2" [#
1e80: 66 7c 70 72 6f 63 32 5d 20 29 20 2e 2e 2e 2e 20 f|proc2] ) ....
1e90: 29 20 29 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ) ).(define (db:
1ea0: 73 79 6e 63 2d 74 61 62 6c 65 73 20 74 62 6c 73 sync-tables tbls
1eb0: 20 66 72 6f 6d 64 62 20 74 6f 64 62 29 0a 20 20 fromdb todb).
1ec0: 28 6c 65 74 20 28 28 73 74 6d 74 73 20 20 20 20 (let ((stmts
1ed0: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
1ee0: 62 6c 65 29 29 20 3b 3b 20 74 61 62 6c 65 2d 66 ble)) ;; table-f
1ef0: 69 65 6c 64 20 3d 3e 20 73 74 6d 74 0a 09 28 61 ield => stmt..(a
1f00: 6c 6c 2d 73 74 6d 74 73 20 20 20 27 28 29 29 20 ll-stmts '())
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1f20: 28 20 28 20 73 74 6d 74 31 20 76 61 6c 75 65 31 ( ( stmt1 value1
1f30: 20 29 20 28 20 73 74 6d 6c 32 20 76 61 6c 75 65 ) ( stml2 value
1f40: 32 20 29 29 0a 09 28 6e 75 6d 72 65 63 73 20 20 2 ))..(numrecs
1f50: 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 (make-hash-ta
1f60: 62 6c 65 29 29 0a 09 28 73 74 61 72 74 2d 74 69 ble))..(start-ti
1f70: 6d 65 20 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c me (current-mil
1f80: 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a 20 20 20 liseconds))).
1f90: 20 28 66 6f 72 2d 65 61 63 68 20 3b 3b 20 74 61 (for-each ;; ta
1fa0: 62 6c 65 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ble. (lambda
1fb0: 20 28 74 61 62 6c 65 64 61 74 29 0a 20 20 20 20 (tabledat).
1fc0: 20 20 20 28 6c 65 74 2a 20 28 28 74 61 62 6c 65 (let* ((table
1fd0: 6e 61 6d 65 20 20 28 63 61 72 20 74 61 62 6c 65 name (car table
1fe0: 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 66 69 dat)).. (fi
1ff0: 65 6c 64 73 20 20 20 20 20 28 63 64 72 20 74 61 elds (cdr ta
2000: 62 6c 65 64 61 74 29 29 0a 09 20 20 20 20 20 20 bledat))..
2010: 28 6e 75 6d 2d 66 69 65 6c 64 73 20 28 6c 65 6e (num-fields (len
2020: 67 74 68 20 66 69 65 6c 64 73 29 29 0a 09 20 20 gth fields))..
2030: 20 20 20 20 28 66 69 65 6c 64 2d 3e 6e 75 6d 20 (field->num
2040: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
2050: 29 29 0a 09 20 20 20 20 20 20 28 6e 75 6d 2d 3e )).. (num->
2060: 66 69 65 6c 64 20 28 61 70 70 6c 79 20 76 65 63 field (apply vec
2070: 74 6f 72 20 28 6d 61 70 20 63 61 72 20 66 69 65 tor (map car fie
2080: 6c 64 73 29 29 29 0a 09 20 20 20 20 20 20 28 66 lds))).. (f
2090: 75 6c 6c 2d 73 65 6c 20 20 20 28 63 6f 6e 63 20 ull-sel (conc
20a0: 22 53 45 4c 45 43 54 20 22 20 28 73 74 72 69 6e "SELECT " (strin
20b0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
20c0: 61 70 20 63 61 72 20 66 69 65 6c 64 73 29 20 22 ap car fields) "
20d0: 2c 22 29 20 0a 09 09 09 09 22 20 46 52 4f 4d 20 ,") ....." FROM
20e0: 22 20 74 61 62 6c 65 6e 61 6d 65 20 22 3b 22 29 " tablename ";")
20f0: 29 0a 09 20 20 20 20 20 20 28 66 75 6c 6c 2d 69 ).. (full-i
2100: 6e 73 20 20 20 28 63 6f 6e 63 20 22 49 4e 53 45 ns (conc "INSE
2110: 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e RT OR REPLACE IN
2120: 54 4f 20 22 20 74 61 62 6c 65 6e 61 6d 65 20 22 TO " tablename "
2130: 20 28 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 ( " (string-int
2140: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 ersperse (map ca
2150: 72 20 66 69 65 6c 64 73 29 20 22 2c 22 29 20 22 r fields) ",") "
2160: 20 29 20 22 0a 09 09 09 09 22 20 56 41 4c 55 45 ) "....." VALUE
2170: 53 20 28 20 22 20 28 73 74 72 69 6e 67 2d 69 6e S ( " (string-in
2180: 74 65 72 73 70 65 72 73 65 20 28 6d 61 6b 65 2d tersperse (make-
2190: 6c 69 73 74 20 6e 75 6d 2d 66 69 65 6c 64 73 20 list num-fields
21a0: 22 3f 22 29 20 22 2c 22 29 20 22 20 29 3b 22 29 "?") ",") " );")
21b0: 29 0a 09 20 20 20 20 20 20 28 66 72 6f 6d 64 61 ).. (fromda
21c0: 74 20 20 20 20 27 28 29 29 0a 09 20 20 20 20 20 t '())..
21d0: 20 28 74 6f 64 61 74 20 20 20 20 20 20 28 6d 61 (todat (ma
21e0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
21f0: 09 20 20 20 20 20 20 28 63 6f 75 6e 74 20 20 20 . (count
2200: 20 20 20 30 29 29 0a 0a 09 20 3b 3b 20 73 65 74 0))... ;; set
2210: 20 75 70 20 74 68 65 20 66 69 65 6c 64 2d 3e 6e up the field->n
2220: 75 6d 20 74 61 62 6c 65 0a 09 20 28 66 6f 72 2d um table.. (for-
2230: 65 61 63 68 0a 09 20 20 28 6c 61 6d 62 64 61 20 each.. (lambda
2240: 28 66 69 65 6c 64 29 0a 09 20 20 20 20 28 68 61 (field).. (ha
2250: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 66 69 sh-table-set! fi
2260: 65 6c 64 2d 3e 6e 75 6d 20 66 69 65 6c 64 20 63 eld->num field c
2270: 6f 75 6e 74 29 0a 09 20 20 20 20 28 73 65 74 21 ount).. (set!
2280: 20 63 6f 75 6e 74 20 28 2b 20 63 6f 75 6e 74 20 count (+ count
2290: 31 29 29 29 0a 09 20 20 66 69 65 6c 64 73 29 0a 1))).. fields).
22a0: 0a 09 20 3b 3b 20 72 65 61 64 20 74 68 65 20 73 .. ;; read the s
22b0: 6f 75 72 63 65 20 74 61 62 6c 65 0a 09 20 28 73 ource table.. (s
22c0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
22d0: 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 row.. (lambda (
22e0: 61 20 2e 20 62 29 0a 09 20 20 20 20 28 73 65 74 a . b).. (set
22f0: 21 20 66 72 6f 6d 64 61 74 20 28 63 6f 6e 73 20 ! fromdat (cons
2300: 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 (apply vector a
2310: 62 29 20 66 72 6f 6d 64 61 74 29 29 29 0a 09 20 b) fromdat)))..
2320: 20 66 72 6f 6d 64 62 0a 09 20 20 66 75 6c 6c 2d fromdb.. full-
2330: 73 65 6c 29 0a 0a 09 20 3b 3b 20 72 65 61 64 20 sel)... ;; read
2340: 74 68 65 20 74 61 72 67 65 74 20 74 61 62 6c 65 the target table
2350: 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d .. (sqlite3:for-
2360: 65 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d each-row.. (lam
2370: 62 64 61 20 28 61 20 2e 20 62 29 0a 09 20 20 20 bda (a . b)..
2380: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2390: 21 20 74 6f 64 61 74 20 61 20 28 61 70 70 6c 79 ! todat a (apply
23a0: 20 76 65 63 74 6f 72 20 61 20 62 29 29 29 0a 09 vector a b)))..
23b0: 20 20 74 6f 64 62 0a 09 20 20 66 75 6c 6c 2d 73 todb.. full-s
23c0: 65 6c 29 0a 0a 09 20 3b 3b 20 66 69 72 73 74 20 el)... ;; first
23d0: 70 61 73 73 20 69 6d 70 6c 65 6d 65 6e 74 61 74 pass implementat
23e0: 69 6f 6e 2c 20 6a 75 73 74 20 69 6e 73 65 72 74 ion, just insert
23f0: 20 61 6c 6c 20 63 68 61 6e 67 65 64 20 72 6f 77 all changed row
2400: 73 0a 09 20 28 6c 65 74 20 28 28 73 74 6d 74 68 s.. (let ((stmth
2410: 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 (sqlite3:prepar
2420: 65 20 74 6f 64 62 20 66 75 6c 6c 2d 69 6e 73 29 e todb full-ins)
2430: 29 29 0a 09 20 20 20 28 73 71 6c 69 74 65 33 3a )).. (sqlite3:
2440: 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e with-transaction
2450: 0a 09 20 20 20 20 74 6f 64 62 0a 09 20 20 20 20 .. todb..
2460: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
2470: 20 20 28 66 6f 72 2d 65 61 63 68 20 3b 3b 20 0a (for-each ;; .
2480: 09 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
2490: 28 66 72 6f 6d 72 6f 77 29 0a 09 09 20 28 6c 65 (fromrow)... (le
24a0: 74 2a 20 28 28 61 20 20 20 20 28 76 65 63 74 6f t* ((a (vecto
24b0: 72 2d 72 65 66 20 66 72 6f 6d 72 6f 77 20 30 29 r-ref fromrow 0)
24c0: 29 0a 09 09 09 28 63 75 72 72 20 28 68 61 73 68 )....(curr (hash
24d0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
24e0: 6c 74 20 74 6f 64 61 74 20 61 20 23 66 29 29 0a lt todat a #f)).
24f0: 09 09 09 28 73 61 6d 65 20 23 74 29 29 0a 09 09 ...(same #t))...
2500: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 (let loop ((i
2510: 20 30 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 0))... (if
2520: 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 29 0a 09 (or (not curr)..
2530: 09 09 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 .. (not (equ
2540: 61 6c 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 al? (vector-ref
2550: 66 72 6f 6d 72 6f 77 20 69 29 28 76 65 63 74 6f fromrow i)(vecto
2560: 72 2d 72 65 66 20 63 75 72 72 20 69 29 29 29 29 r-ref curr i))))
2570: 0a 09 09 09 20 28 73 65 74 21 20 73 61 6d 65 20 .... (set! same
2580: 23 66 29 29 0a 09 09 20 20 20 20 20 28 69 66 20 #f))... (if
2590: 28 61 6e 64 20 73 61 6d 65 0a 09 09 09 20 20 20 (and same....
25a0: 20 20 20 28 3c 20 69 20 28 2d 20 6e 75 6d 2d 66 (< i (- num-f
25b0: 69 65 6c 64 73 20 31 29 29 29 0a 09 09 09 20 28 ields 1))).... (
25c0: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 0a loop (+ i 1)))).
25d0: 09 09 20 20 20 28 69 66 20 28 6e 6f 74 20 73 61 .. (if (not sa
25e0: 6d 65 29 0a 09 09 20 20 20 20 20 20 20 28 62 65 me)... (be
25f0: 67 69 6e 0a 09 09 09 20 28 61 70 70 6c 79 20 73 gin.... (apply s
2600: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 73 qlite3:execute s
2610: 74 6d 74 68 20 28 76 65 63 74 6f 72 2d 3e 6c 69 tmth (vector->li
2620: 73 74 20 66 72 6f 6d 72 6f 77 29 29 0a 09 09 09 st fromrow))....
2630: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
2640: 21 20 6e 75 6d 72 65 63 73 20 74 61 62 6c 65 6e ! numrecs tablen
2650: 61 6d 65 20 28 2b 20 31 20 28 68 61 73 68 2d 74 ame (+ 1 (hash-t
2660: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
2670: 20 6e 75 6d 72 65 63 73 20 74 61 62 6c 65 6e 61 numrecs tablena
2680: 6d 65 20 30 29 29 29 29 29 29 29 0a 09 20 20 20 me 0)))))))..
2690: 20 20 20 20 66 72 6f 6d 64 61 74 29 29 29 0a 09 fromdat)))..
26a0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
26b0: 6c 69 7a 65 21 20 73 74 6d 74 68 29 29 29 29 0a lize! stmth)))).
26c0: 20 20 20 20 20 74 62 6c 73 29 0a 20 20 20 20 28 tbls). (
26d0: 6c 65 74 20 28 28 72 75 6e 74 69 6d 65 20 28 2d let ((runtime (-
26e0: 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 (current-millis
26f0: 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d 74 69 econds) start-ti
2700: 6d 65 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 me))). (deb
2710: 75 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 4f ug:print 0 "INFO
2720: 3a 20 64 62 20 73 79 6e 63 2c 20 74 6f 74 61 6c : db sync, total
2730: 20 72 75 6e 20 74 69 6d 65 20 22 20 72 75 6e 74 run time " runt
2740: 69 6d 65 20 22 20 6d 73 22 29 0a 20 20 20 20 20 ime " ms").
2750: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 (for-each .
2760: 20 20 20 28 6c 61 6d 62 64 61 20 28 64 61 74 29 (lambda (dat)
2770: 0a 09 20 28 6c 65 74 20 28 28 74 62 6c 6e 61 6d .. (let ((tblnam
2780: 65 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 20 e (car dat))..
2790: 20 20 20 20 20 28 63 6f 75 6e 74 20 20 20 28 63 (count (c
27a0: 64 72 20 64 61 74 29 29 29 0a 09 20 20 20 28 69 dr dat))).. (i
27b0: 66 20 28 3e 20 63 6f 75 6e 74 20 30 29 0a 09 20 f (> count 0)..
27c0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
27d0: 6e 74 20 30 20 28 66 6f 72 6d 61 74 20 23 66 20 nt 0 (format #f
27e0: 22 20 20 20 20 7e 31 30 61 20 7e 35 61 22 20 74 " ~10a ~5a" t
27f0: 62 6c 6e 61 6d 65 20 63 6f 75 6e 74 29 29 29 29 blname count))))
2800: 29 0a 20 20 20 20 20 20 20 28 73 6f 72 74 20 28 ). (sort (
2810: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
2820: 74 20 6e 75 6d 72 65 63 73 29 28 6c 61 6d 62 64 t numrecs)(lambd
2830: 61 20 28 61 20 62 29 28 3e 20 28 63 64 72 20 61 a (a b)(> (cdr a
2840: 29 28 63 64 72 20 62 29 29 29 29 29 29 29 29 0a )(cdr b)))))))).
2850: 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 64 62 3a .;; (define (db:
2860: 73 79 6e 63 2d 74 6f 20 66 72 6f 6d 64 62 20 74 sync-to fromdb t
2870: 6f 64 62 29 0a 3b 3b 20 20 20 3b 3b 20 73 74 72 odb).;; ;; str
2880: 61 74 65 67 79 0a 3b 3b 20 20 20 3b 3b 20 20 31 ategy.;; ;; 1
2890: 2e 20 47 65 74 20 61 6c 6c 20 72 75 6e 2d 69 64 . Get all run-id
28a0: 73 0a 3b 3b 20 20 20 3b 3b 20 20 32 2e 20 46 6f s.;; ;; 2. Fo
28b0: 72 20 65 61 63 68 20 72 75 6e 2d 69 64 20 0a 3b r each run-id .;
28c0: 3b 20 20 20 3b 3b 20 20 20 20 20 61 2e 20 53 79 ; ;; a. Sy
28d0: 6e 63 20 74 68 61 74 20 72 75 6e 20 69 6e 20 61 nc that run in a
28e0: 20 74 72 61 6e 73 61 63 74 69 6f 6e 0a 3b 3b 20 transaction.;;
28f0: 20 20 28 6c 65 74 20 28 28 74 72 65 63 63 68 67 (let ((trecchg
2900: 64 20 20 20 20 30 29 0a 3b 3b 20 09 28 72 72 65 d 0).;; .(rre
2910: 63 63 68 67 64 20 20 20 20 30 29 0a 3b 3b 20 09 cchgd 0).;; .
2920: 28 74 6d 72 65 63 63 68 67 64 20 20 20 30 29 29 (tmrecchgd 0))
2930: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b 3b 20 46 .;; .;; ;; F
2940: 69 72 73 74 20 73 79 6e 63 20 74 65 73 74 5f 6d irst sync test_m
2950: 65 74 61 20 64 61 74 61 0a 3b 3b 20 20 20 20 20 eta data.;;
2960: 28 6c 65 74 20 28 28 74 6d 67 65 74 73 74 6d 74 (let ((tmgetstmt
2970: 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 (sqlite3:prepar
2980: 65 20 74 6f 64 62 20 22 53 45 4c 45 43 54 20 69 e todb "SELECT i
2990: 64 2c 74 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f d,testname,autho
29a0: 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 69 70 74 r,owner,descript
29b0: 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c 69 74 65 ion,reviewed,ite
29c0: 72 61 74 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d rated,avg_runtim
29d0: 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 67 73 2c e,avg_disk,tags,
29e0: 6a 6f 62 67 72 6f 75 70 20 46 52 4f 4d 20 74 65 jobgroup FROM te
29f0: 73 74 5f 6d 65 74 61 20 57 48 45 52 45 20 69 64 st_meta WHERE id
2a00: 3d 3f 3b 22 29 29 0a 3b 3b 20 09 20 20 28 74 6d =?;")).;; . (tm
2a10: 70 75 74 73 74 6d 74 20 28 73 71 6c 69 74 65 33 putstmt (sqlite3
2a20: 3a 70 72 65 70 61 72 65 20 74 6f 64 62 20 22 49 :prepare todb "I
2a30: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
2a40: 20 49 4e 54 4f 20 74 65 73 74 5f 6d 65 74 61 20 INTO test_meta
2a50: 28 69 64 2c 74 65 73 74 6e 61 6d 65 2c 61 75 74 (id,testname,aut
2a60: 68 6f 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 69 hor,owner,descri
2a70: 70 74 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c 69 ption,reviewed,i
2a80: 74 65 72 61 74 65 64 2c 61 76 67 5f 72 75 6e 74 terated,avg_runt
2a90: 69 6d 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 67 ime,avg_disk,tag
2aa0: 73 2c 6a 6f 62 67 72 6f 75 70 29 20 0a 3b 3b 20 s,jobgroup) .;;
2ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 20 20 20 56 41 4c 55 45 53 20 28 3f 2c VALUES (?,
2b00: 20 3f 2c 20 20 20 20 20 20 20 3f 2c 20 20 20 20 ?, ?,
2b10: 20 3f 2c 20 20 20 20 3f 2c 20 20 20 20 20 20 20 ?, ?,
2b20: 20 20 20 3f 2c 20 20 20 20 20 20 20 3f 2c 20 20 ?, ?,
2b30: 20 20 20 20 20 3f 2c 20 20 20 20 20 20 20 20 20 ?,
2b40: 20 3f 2c 20 20 20 20 20 20 20 3f 2c 20 20 20 3f ?, ?, ?
2b50: 29 3b 22 29 29 0a 3b 3b 20 09 20 20 28 74 6d 64 );")).;; . (tmd
2b60: 61 74 73 20 20 20 20 28 64 62 3a 74 65 73 74 6d ats (db:testm
2b70: 65 74 61 2d 67 65 74 2d 61 6c 6c 20 66 72 6f 6d eta-get-all from
2b80: 64 62 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 3b db))).;; ;
2b90: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 37 ; (debug:print 7
2ba0: 20 22 55 70 64 61 74 69 6e 67 20 61 73 20 6d 61 "Updating as ma
2bb0: 6e 79 20 61 73 20 22 20 28 6c 65 6e 67 74 68 20 ny as " (length
2bc0: 74 64 61 74 73 29 20 22 20 72 65 63 6f 72 64 73 tdats) " records
2bd0: 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e 2d 69 for run " run-i
2be0: 64 29 0a 3b 3b 20 20 20 20 20 20 20 28 66 6f 72 d).;; (for
2bf0: 2d 65 61 63 68 0a 3b 3b 20 20 20 20 20 20 20 20 -each.;;
2c00: 28 6c 61 6d 62 64 61 20 28 74 6d 64 61 74 29 20 (lambda (tmdat)
2c10: 3b 3b 20 69 74 65 72 61 74 65 20 6f 76 65 72 20 ;; iterate over
2c20: 74 65 73 74 73 0a 3b 3b 20 09 20 28 6c 65 74 20 tests.;; . (let
2c30: 28 28 74 65 73 74 6d 2d 69 64 20 28 76 65 63 74 ((testm-id (vect
2c40: 6f 72 2d 72 65 66 20 74 6d 64 61 74 20 30 29 29 or-ref tmdat 0))
2c50: 29 0a 3b 3b 20 09 20 20 20 28 73 71 6c 69 74 65 ).;; . (sqlite
2c60: 33 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 3:with-transacti
2c70: 6f 6e 0a 3b 3b 20 09 20 20 20 20 74 6f 64 62 0a on.;; . todb.
2c80: 3b 3b 20 09 20 20 20 20 28 6c 61 6d 62 64 61 20 ;; . (lambda
2c90: 28 29 0a 3b 3b 20 09 20 20 20 20 20 20 28 6c 65 ().;; . (le
2ca0: 74 20 28 28 63 75 72 72 2d 74 6d 64 61 74 20 23 t ((curr-tmdat #
2cb0: 66 29 29 0a 3b 3b 20 09 09 28 73 71 6c 69 74 65 f)).;; ..(sqlite
2cc0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3:for-each-row.;
2cd0: 3b 20 09 09 20 28 6c 61 6d 62 64 61 20 28 61 20 ; .. (lambda (a
2ce0: 2e 20 62 29 0a 3b 3b 20 09 09 20 20 20 28 73 65 . b).;; .. (se
2cf0: 74 21 20 63 75 72 72 2d 74 6d 64 61 74 20 28 61 t! curr-tmdat (a
2d00: 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 62 29 pply vector a b)
2d10: 29 29 0a 3b 3b 20 09 09 20 74 6d 67 65 74 73 74 )).;; .. tmgetst
2d20: 6d 74 20 74 65 73 74 6d 2d 69 64 29 0a 3b 3b 20 mt testm-id).;;
2d30: 09 09 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 ..(if (not (equa
2d40: 6c 3f 20 63 75 72 72 2d 74 6d 64 61 74 20 74 6d l? curr-tmdat tm
2d50: 64 61 74 29 29 20 3b 3b 20 73 6f 6d 65 74 68 69 dat)) ;; somethi
2d60: 6e 67 20 63 68 61 6e 67 65 64 0a 3b 3b 20 09 09 ng changed.;; ..
2d70: 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b 20 09 09 (begin.;; ..
2d80: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2d90: 6e 74 20 30 20 22 20 20 74 65 73 74 2d 69 64 3a nt 0 " test-id:
2da0: 20 22 20 74 65 73 74 6d 2d 69 64 0a 3b 3b 20 09 " testm-id.;; .
2db0: 09 09 09 20 20 20 22 5c 6e 63 75 72 72 2d 74 64 ... "\ncurr-td
2dc0: 61 74 3a 20 22 20 63 75 72 72 2d 74 6d 64 61 74 at: " curr-tmdat
2dd0: 0a 3b 3b 20 09 09 09 09 20 20 20 22 5c 6e 20 20 .;; .... "\n
2de0: 20 20 20 74 64 61 74 3a 20 22 20 74 6d 64 61 74 tdat: " tmdat
2df0: 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 28 61 70 ).;; .. (ap
2e00: 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 65 63 ply sqlite3:exec
2e10: 75 74 65 20 74 6d 70 75 74 73 74 6d 74 20 28 76 ute tmputstmt (v
2e20: 65 63 74 6f 72 2d 3e 6c 69 73 74 20 74 6d 64 61 ector->list tmda
2e30: 74 29 29 0a 3b 3b 20 09 09 20 20 20 20 20 20 28 t)).;; .. (
2e40: 73 65 74 21 20 74 6d 72 65 63 63 68 67 64 20 28 set! tmrecchgd (
2e50: 2b 20 74 6d 72 65 63 63 68 67 64 20 31 29 29 29 + tmrecchgd 1)))
2e60: 29 29 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 )))))).;;
2e70: 20 74 6d 64 61 74 73 29 0a 3b 3b 20 20 20 20 20 tmdats).;;
2e80: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
2e90: 69 7a 65 21 20 74 6d 67 65 74 73 74 6d 74 29 0a ize! tmgetstmt).
2ea0: 3b 3b 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ;; (sqlite
2eb0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 6d 70 75 3:finalize! tmpu
2ec0: 74 73 74 6d 74 29 29 0a 3b 3b 20 0a 3b 3b 20 20 tstmt)).;; .;;
2ed0: 20 20 20 3b 3b 20 46 69 72 73 74 20 73 79 6e 63 ;; First sync
2ee0: 20 74 65 73 74 73 20 64 61 74 61 0a 3b 3b 20 20 tests data.;;
2ef0: 20 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 (let ((run-id
2f00: 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d 61 6c s (db:get-al
2f10: 6c 2d 72 75 6e 2d 69 64 73 20 66 72 6f 6d 64 62 l-run-ids fromdb
2f20: 29 29 0a 3b 3b 20 09 20 20 28 74 67 65 74 73 74 )).;; . (tgetst
2f30: 6d 74 20 20 20 20 28 73 71 6c 69 74 65 33 3a 70 mt (sqlite3:p
2f40: 72 65 70 61 72 65 20 74 6f 64 62 20 22 53 45 4c repare todb "SEL
2f50: 45 43 54 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 ECT id,run_id,te
2f60: 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 stname,state,sta
2f70: 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 tus,event_time,h
2f80: 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b ost,cpuload,disk
2f90: 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 free,uname,rundi
2fa0: 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f r,item_path,run_
2fb0: 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c duration,final_l
2fc0: 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d ogf,comment FROM
2fd0: 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d tests WHERE id=
2fe0: 3f 3b 22 29 29 0a 3b 3b 20 09 20 20 28 74 70 75 ?;")).;; . (tpu
2ff0: 74 73 74 6d 74 20 20 20 20 28 73 71 6c 69 74 65 tstmt (sqlite
3000: 33 3a 70 72 65 70 61 72 65 20 74 6f 64 62 20 22 3:prepare todb "
3010: 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 INSERT OR REPLAC
3020: 45 20 49 4e 54 4f 20 74 65 73 74 73 20 20 28 69 E INTO tests (i
3030: 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d d,run_id,testnam
3040: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 e,state,status,e
3050: 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 vent_time,host,c
3060: 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c puload,diskfree,
3070: 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 uname,rundir,ite
3080: 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 m_path,run_durat
3090: 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 ion,final_logf,c
30a0: 6f 6d 6d 65 6e 74 29 0a 3b 3b 20 20 20 20 20 20 omment).;;
30b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
30e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56 V
30f0: 41 4c 55 45 53 20 28 3f 2c 20 3f 2c 20 20 20 20 ALUES (?, ?,
3100: 20 3f 2c 20 20 20 20 20 20 20 3f 2c 20 20 20 20 ?, ?,
3110: 3f 2c 20 20 20 20 20 3f 2c 20 20 20 20 20 20 20 ?, ?,
3120: 20 20 3f 2c 20 20 20 3f 2c 20 20 20 20 20 20 3f ?, ?, ?
3130: 2c 20 20 20 20 20 20 20 3f 2c 20 20 20 20 3f 2c , ?, ?,
3140: 20 20 20 20 20 3f 2c 20 20 20 20 20 20 20 20 3f ?, ?
3150: 2c 20 20 20 20 20 20 20 20 20 20 20 3f 2c 20 20 , ?,
3160: 20 20 20 20 20 20 20 3f 20 20 20 20 20 29 3b 22 ? );"
3170: 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 28 66 6f ))).;; (fo
3180: 72 2d 65 61 63 68 0a 3b 3b 20 20 20 20 20 20 20 r-each.;;
3190: 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 (lambda (run-id
31a0: 29 0a 3b 3b 20 09 20 28 6c 65 74 20 28 28 74 64 ).;; . (let ((td
31b0: 61 74 73 20 20 20 20 20 28 64 62 3a 67 65 74 2d ats (db:get-
31c0: 61 6c 6c 2d 74 65 73 74 73 2d 69 6e 66 6f 2d 62 all-tests-info-b
31d0: 79 2d 72 75 6e 2d 69 64 20 66 72 6f 6d 64 62 20 y-run-id fromdb
31e0: 72 75 6e 2d 69 64 29 29 29 0a 3b 3b 20 09 20 20 run-id))).;; .
31f0: 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
3200: 20 37 20 22 55 70 64 61 74 69 6e 67 20 61 73 20 7 "Updating as
3210: 6d 61 6e 79 20 61 73 20 22 20 28 6c 65 6e 67 74 many as " (lengt
3220: 68 20 74 64 61 74 73 29 20 22 20 72 65 63 6f 72 h tdats) " recor
3230: 64 73 20 66 6f 72 20 72 75 6e 20 22 20 72 75 6e ds for run " run
3240: 2d 69 64 29 0a 3b 3b 20 09 20 20 20 28 66 6f 72 -id).;; . (for
3250: 2d 65 61 63 68 0a 3b 3b 20 09 20 20 20 20 28 6c -each.;; . (l
3260: 61 6d 62 64 61 20 28 74 64 61 74 29 20 3b 3b 20 ambda (tdat) ;;
3270: 69 74 65 72 61 74 65 20 6f 76 65 72 20 74 65 73 iterate over tes
3280: 74 73 0a 3b 3b 20 09 20 20 20 20 20 20 28 6c 65 ts.;; . (le
3290: 74 20 28 28 74 65 73 74 2d 69 64 20 28 76 65 63 t ((test-id (vec
32a0: 74 6f 72 2d 72 65 66 20 74 64 61 74 20 30 29 29 tor-ref tdat 0))
32b0: 29 0a 3b 3b 20 09 09 28 73 71 6c 69 74 65 33 3a ).;; ..(sqlite3:
32c0: 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e with-transaction
32d0: 0a 3b 3b 20 09 09 20 74 6f 64 62 0a 3b 3b 20 09 .;; .. todb.;; .
32e0: 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 3b 3b 20 . (lambda ().;;
32f0: 09 09 20 20 20 28 6c 65 74 20 28 28 63 75 72 72 .. (let ((curr
3300: 2d 74 64 61 74 20 23 66 29 29 0a 3b 3b 20 09 09 -tdat #f)).;; ..
3310: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f (sqlite3:fo
3320: 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b 20 09 09 r-each-row.;; ..
3330: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 (lambda (a
3340: 20 2e 20 62 29 0a 3b 3b 20 09 09 09 28 73 65 74 . b).;; ...(set
3350: 21 20 63 75 72 72 2d 74 64 61 74 20 28 61 70 70 ! curr-tdat (app
3360: 6c 79 20 76 65 63 74 6f 72 20 61 20 62 29 29 29 ly vector a b)))
3370: 0a 3b 3b 20 09 09 20 20 20 20 20 20 74 67 65 74 .;; .. tget
3380: 73 74 6d 74 0a 3b 3b 20 09 09 20 20 20 20 20 20 stmt.;; ..
3390: 74 65 73 74 2d 69 64 29 0a 3b 3b 20 09 09 20 20 test-id).;; ..
33a0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 (if (not (equ
33b0: 61 6c 3f 20 63 75 72 72 2d 74 64 61 74 20 74 64 al? curr-tdat td
33c0: 61 74 29 29 20 3b 3b 20 73 6f 6d 65 74 68 69 6e at)) ;; somethin
33d0: 67 20 63 68 61 6e 67 65 64 0a 3b 3b 20 09 09 09 g changed.;; ...
33e0: 20 28 62 65 67 69 6e 0a 3b 3b 20 09 09 09 20 20 (begin.;; ...
33f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
3400: 22 20 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 " test-id: " te
3410: 73 74 2d 69 64 0a 3b 3b 20 09 09 09 09 09 22 5c st-id.;; ....."\
3420: 6e 63 75 72 72 2d 74 64 61 74 3a 20 22 20 63 75 ncurr-tdat: " cu
3430: 72 72 2d 74 64 61 74 0a 3b 3b 20 09 09 09 09 09 rr-tdat.;; .....
3440: 22 5c 6e 20 20 20 20 20 74 64 61 74 3a 20 22 20 "\n tdat: "
3450: 74 64 61 74 29 0a 3b 3b 20 09 09 09 20 20 20 28 tdat).;; ... (
3460: 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 apply sqlite3:ex
3470: 65 63 75 74 65 20 74 70 75 74 73 74 6d 74 20 28 ecute tputstmt (
3480: 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 74 64 61 vector->list tda
3490: 74 29 29 0a 3b 3b 20 09 09 09 20 20 20 28 73 65 t)).;; ... (se
34a0: 74 21 20 74 72 65 63 63 68 67 64 20 28 2b 20 74 t! trecchgd (+ t
34b0: 72 65 63 63 68 67 64 20 31 29 29 29 29 29 29 29 recchgd 1)))))))
34c0: 29 29 0a 3b 3b 20 09 20 20 20 20 74 64 61 74 73 )).;; . tdats
34d0: 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 72 75 ))).;; ru
34e0: 6e 2d 69 64 73 29 0a 3b 3b 20 20 20 20 20 20 20 n-ids).;;
34f0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
3500: 65 21 20 74 67 65 74 73 74 6d 74 29 0a 3b 3b 20 e! tgetstmt).;;
3510: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
3520: 69 6e 61 6c 69 7a 65 21 20 74 70 75 74 73 74 6d inalize! tputstm
3530: 74 29 29 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 3b t)).;; .;; ;
3540: 3b 20 4e 65 78 74 20 73 79 6e 63 20 72 75 6e 73 ; Next sync runs
3550: 20 74 61 62 6c 65 0a 3b 3b 20 20 20 20 20 28 6c table.;; (l
3560: 65 74 2a 20 28 28 72 64 61 74 73 20 20 20 20 20 et* ((rdats
3570: 20 20 27 28 29 29 0a 3b 3b 20 09 20 20 20 28 6b '()).;; . (k
3580: 65 79 73 20 20 20 20 20 20 20 20 28 64 62 3a 67 eys (db:g
3590: 65 74 2d 6b 65 79 73 20 66 72 6f 6d 64 62 29 29 et-keys fromdb))
35a0: 0a 3b 3b 20 09 20 20 20 28 72 73 74 64 66 69 65 .;; . (rstdfie
35b0: 6c 64 73 20 20 28 63 6f 6e 63 20 22 69 64 2c 22 lds (conc "id,"
35c0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
35d0: 65 72 73 65 20 6b 65 79 73 20 22 2c 22 29 20 22 erse keys ",") "
35e0: 2c 72 75 6e 6e 61 6d 65 2c 73 74 61 74 65 2c 73 ,runname,state,s
35f0: 74 61 74 75 73 2c 6f 77 6e 65 72 2c 65 76 65 6e tatus,owner,even
3600: 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 6e 74 2c 66 t_time,comment,f
3610: 61 69 6c 5f 63 6f 75 6e 74 2c 70 61 73 73 5f 63 ail_count,pass_c
3620: 6f 75 6e 74 22 29 29 0a 3b 3b 20 09 20 20 20 28 ount")).;; . (
3630: 72 6e 75 6d 66 69 65 6c 64 73 20 20 28 6c 65 6e rnumfields (len
3640: 67 74 68 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 gth (string-spli
3650: 74 20 72 73 74 64 66 69 65 6c 64 73 20 22 2c 22 t rstdfields ","
3660: 29 29 29 0a 3b 3b 20 09 20 20 20 28 72 75 6e 73 ))).;; . (runs
3670: 6c 6f 74 73 20 20 20 20 28 73 74 72 69 6e 67 2d lots (string-
3680: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 6b intersperse (mak
3690: 65 2d 6c 69 73 74 20 72 6e 75 6d 66 69 65 6c 64 e-list rnumfield
36a0: 73 20 22 3f 22 29 20 22 2c 22 29 29 0a 3b 3b 20 s "?") ",")).;;
36b0: 09 20 20 20 28 72 67 65 74 73 74 6d 74 20 20 20 . (rgetstmt
36c0: 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 72 (sqlite3:prepar
36d0: 65 20 74 6f 64 62 20 28 63 6f 6e 63 20 22 53 45 e todb (conc "SE
36e0: 4c 45 43 54 20 22 20 72 73 74 64 66 69 65 6c 64 LECT " rstdfield
36f0: 73 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 s " FROM runs WH
3700: 45 52 45 20 69 64 3d 3f 3b 22 29 29 29 0a 3b 3b ERE id=?;"))).;;
3710: 20 09 20 20 20 28 72 70 75 74 73 74 6d 74 20 20 . (rputstmt
3720: 20 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 (sqlite3:prepa
3730: 72 65 20 74 6f 64 62 20 28 63 6f 6e 63 20 22 49 re todb (conc "I
3740: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
3750: 20 49 4e 54 4f 20 72 75 6e 73 20 28 22 20 72 73 INTO runs (" rs
3760: 74 64 66 69 65 6c 64 73 20 22 29 20 56 41 4c 55 tdfields ") VALU
3770: 45 53 20 28 20 22 20 72 75 6e 73 6c 6f 74 73 20 ES ( " runslots
3780: 22 20 29 3b 22 29 29 29 29 0a 3b 3b 20 20 20 20 " );")))).;;
3790: 20 20 20 3b 3b 20 66 69 72 73 74 20 63 6f 6c 6c ;; first coll
37a0: 65 63 74 20 61 6c 6c 20 74 68 65 20 73 6f 75 72 ect all the sour
37b0: 63 65 20 72 75 6e 20 64 61 74 61 0a 3b 3b 20 20 ce run data.;;
37c0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f (sqlite3:fo
37d0: 72 2d 65 61 63 68 2d 72 6f 77 0a 3b 3b 20 20 20 r-each-row.;;
37e0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 (lambda (a
37f0: 2e 20 62 29 0a 3b 3b 20 09 20 28 73 65 74 21 20 . b).;; . (set!
3800: 72 64 61 74 73 20 28 63 6f 6e 73 20 28 61 70 70 rdats (cons (app
3810: 6c 79 20 76 65 63 74 6f 72 20 61 20 62 29 20 72 ly vector a b) r
3820: 64 61 74 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 dats))).;;
3830: 20 20 66 72 6f 6d 64 62 0a 3b 3b 20 20 20 20 20 fromdb.;;
3840: 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 (conc "SELECT
3850: 20 22 20 72 73 74 64 66 69 65 6c 64 73 20 22 20 " rstdfields "
3860: 46 52 4f 4d 20 72 75 6e 73 3b 22 29 29 0a 3b 3b FROM runs;")).;;
3870: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
3880: 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e with-transaction
3890: 0a 3b 3b 20 20 20 20 20 20 20 20 74 6f 64 62 0a .;; todb.
38a0: 3b 3b 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 ;; (lambd
38b0: 61 20 28 29 0a 3b 3b 20 09 20 28 66 6f 72 2d 65 a ().;; . (for-e
38c0: 61 63 68 20 0a 3b 3b 20 09 20 20 28 6c 61 6d 62 ach .;; . (lamb
38d0: 64 61 20 28 72 64 61 74 29 0a 3b 3b 20 09 20 20 da (rdat).;; .
38e0: 20 20 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 (let ((run-id
38f0: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
3900: 64 61 74 20 30 29 29 0a 3b 3b 20 09 09 20 20 28 dat 0)).;; .. (
3910: 63 75 72 72 2d 72 64 61 74 20 23 66 29 29 0a 3b curr-rdat #f)).;
3920: 3b 20 09 20 20 20 20 20 20 3b 3b 20 66 69 72 73 ; . ;; firs
3930: 74 20 67 65 74 20 74 68 65 20 63 75 72 72 65 6e t get the curren
3940: 74 20 76 61 6c 75 65 20 6f 66 20 74 68 65 20 65 t value of the e
3950: 71 75 69 76 61 6c 65 6e 74 20 72 6f 77 20 66 72 quivalent row fr
3960: 6f 6d 20 74 68 65 20 74 61 72 67 65 74 0a 3b 3b om the target.;;
3970: 20 09 20 20 20 20 20 20 3b 3b 20 72 65 61 64 2c . ;; read,
3980: 20 74 68 65 6e 20 69 6e 73 65 72 74 2f 6f 76 65 then insert/ove
3990: 72 77 72 69 74 65 20 69 66 20 64 69 66 66 65 72 rwrite if differ
39a0: 65 6e 74 0a 3b 3b 20 09 20 20 20 20 20 20 28 73 ent.;; . (s
39b0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
39c0: 72 6f 77 20 0a 3b 3b 20 09 20 20 20 20 20 20 20 row .;; .
39d0: 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 0a (lambda (a . b).
39e0: 3b 3b 20 09 09 20 28 73 65 74 21 20 63 75 72 72 ;; .. (set! curr
39f0: 2d 72 64 61 74 20 28 61 70 70 6c 79 20 76 65 63 -rdat (apply vec
3a00: 74 6f 72 20 61 20 62 29 29 29 0a 3b 3b 20 09 20 tor a b))).;; .
3a10: 20 20 20 20 20 20 72 67 65 74 73 74 6d 74 0a 3b rgetstmt.;
3a20: 3b 20 09 20 20 20 20 20 20 20 72 75 6e 2d 69 64 ; . run-id
3a30: 29 0a 3b 3b 20 09 20 20 20 20 20 20 28 69 66 20 ).;; . (if
3a40: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 63 75 72 (not (equal? cur
3a50: 72 2d 72 64 61 74 20 72 64 61 74 29 29 0a 3b 3b r-rdat rdat)).;;
3a60: 20 09 09 20 20 28 62 65 67 69 6e 0a 3b 3b 20 09 .. (begin.;; .
3a70: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3a80: 74 20 30 20 22 20 20 20 72 75 6e 2d 69 64 3a 20 t 0 " run-id:
3a90: 22 20 72 75 6e 2d 69 64 0a 3b 3b 20 09 09 09 09 " run-id.;; ....
3aa0: 20 22 5c 6e 63 75 72 72 2d 72 64 61 74 3a 20 22 "\ncurr-rdat: "
3ab0: 20 63 75 72 72 2d 72 64 61 74 0a 3b 3b 20 09 09 curr-rdat.;; ..
3ac0: 09 09 20 22 5c 6e 20 20 20 20 20 72 64 61 74 3a .. "\n rdat:
3ad0: 20 22 20 72 64 61 74 29 0a 3b 3b 20 09 09 20 20 " rdat).;; ..
3ae0: 20 20 28 73 65 74 21 20 72 72 65 63 63 68 67 64 (set! rrecchgd
3af0: 20 28 2b 20 72 72 65 63 63 68 67 64 20 31 29 29 (+ rrecchgd 1))
3b00: 0a 3b 3b 20 09 09 20 20 20 20 28 61 70 70 6c 79 .;; .. (apply
3b10: 20 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 sqlite3:execute
3b20: 20 72 70 75 74 73 74 6d 74 20 28 76 65 63 74 6f rputstmt (vecto
3b30: 72 2d 3e 6c 69 73 74 20 72 64 61 74 29 29 29 29 r->list rdat))))
3b40: 29 29 0a 3b 3b 20 09 20 20 72 64 61 74 73 29 29 )).;; . rdats))
3b50: 29 0a 3b 3b 20 20 20 20 20 20 20 28 73 71 6c 69 ).;; (sqli
3b60: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 72 67 te3:finalize! rg
3b70: 65 74 73 74 6d 74 29 0a 3b 3b 20 20 20 20 20 20 etstmt).;;
3b80: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
3b90: 7a 65 21 20 72 70 75 74 73 74 6d 74 29 29 0a 3b ze! rputstmt)).;
3ba0: 3b 20 0a 3b 3b 20 20 20 20 20 28 69 66 20 28 3e ; .;; (if (>
3bb0: 20 72 72 65 63 63 68 67 64 20 30 29 20 20 28 64 rrecchgd 0) (d
3bc0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 73 79 ebug:print 0 "sy
3bd0: 6e 63 65 64 20 22 20 72 72 65 63 63 68 67 64 20 nced " rrecchgd
3be0: 22 20 63 68 61 6e 67 65 64 20 72 65 63 6f 72 64 " changed record
3bf0: 73 20 69 6e 20 72 75 6e 73 20 20 74 61 62 6c 65 s in runs table
3c00: 22 29 29 0a 3b 3b 20 20 20 20 20 28 69 66 20 28 ")).;; (if (
3c10: 3e 20 74 72 65 63 63 68 67 64 20 30 29 20 20 28 > trecchgd 0) (
3c20: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 73 debug:print 0 "s
3c30: 79 6e 63 65 64 20 22 20 74 72 65 63 63 68 67 64 ynced " trecchgd
3c40: 20 22 20 63 68 61 6e 67 65 64 20 72 65 63 6f 72 " changed recor
3c50: 64 73 20 69 6e 20 74 65 73 74 73 20 74 61 62 6c ds in tests tabl
3c60: 65 22 29 29 0a 3b 3b 20 20 20 20 20 28 69 66 20 e")).;; (if
3c70: 28 3e 20 74 6d 72 65 63 63 68 67 64 20 30 29 20 (> tmrecchgd 0)
3c80: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
3c90: 73 79 6e 63 27 64 20 22 20 74 6d 72 65 63 63 68 sync'd " tmrecch
3ca0: 67 64 20 22 20 63 68 61 6e 67 65 64 20 72 65 63 gd " changed rec
3cb0: 6f 72 64 73 20 69 6e 20 74 65 73 74 5f 6d 65 74 ords in test_met
3cc0: 61 20 74 61 62 6c 65 22 29 29 0a 3b 3b 20 20 20 a table")).;;
3cd0: 20 20 28 2b 20 72 72 65 63 63 68 67 64 20 74 72 (+ rrecchgd tr
3ce0: 65 63 63 68 67 64 20 74 6d 72 65 63 63 68 67 64 ecchgd tmrecchgd
3cf0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 )))..(define (db
3d00: 3a 73 79 6e 63 2d 62 61 63 6b 29 0a 20 20 28 64 :sync-back). (d
3d10: 62 3a 73 79 6e 63 2d 74 61 62 6c 65 73 20 28 64 b:sync-tables (d
3d20: 62 3a 74 62 6c 73 20 2a 69 6e 6d 65 6d 64 62 2a b:tbls *inmemdb*
3d30: 29 20 2a 69 6e 6d 65 6d 64 62 2a 20 2a 64 62 2a ) *inmemdb* *db*
3d40: 29 29 20 3b 3b 20 28 64 62 3a 73 79 6e 63 2d 74 )) ;; (db:sync-t
3d50: 6f 20 2a 69 6e 6d 65 6d 64 62 2a 20 2a 64 62 2a o *inmemdb* *db*
3d60: 29 29 0a 0a 3b 3b 20 6b 65 65 70 69 6e 67 20 69 ))..;; keeping i
3d70: 74 20 61 72 6f 75 6e 64 20 66 6f 72 20 64 65 62 t around for deb
3d80: 75 67 67 69 6e 67 20 70 75 72 70 6f 73 65 73 20 ugging purposes
3d90: 6f 6e 6c 79 0a 28 64 65 66 69 6e 65 20 28 6f 70 only.(define (op
3da0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d en-run-close-no-
3db0: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 exception-handli
3dc0: 6e 67 20 20 70 72 6f 63 20 69 64 62 20 2e 20 70 ng proc idb . p
3dd0: 61 72 61 6d 73 29 0a 20 20 28 64 65 62 75 67 3a arams). (debug:
3de0: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f print-info 11 "o
3df0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f pen-run-close-no
3e00: 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c -exception-handl
3e10: 69 6e 67 20 53 54 41 52 54 20 67 69 76 65 6e 20 ing START given
3e20: 61 20 64 62 3d 22 20 28 69 66 20 69 64 62 20 22 a db=" (if idb "
3e30: 79 65 73 20 22 20 22 6e 6f 20 22 29 20 22 2c 20 yes " "no ") ",
3e40: 70 61 72 61 6d 73 3d 22 20 70 61 72 61 6d 73 29 params=" params)
3e50: 0a 20 20 28 69 66 20 28 6f 72 20 2a 64 62 2d 77 . (if (or *db-w
3e60: 72 69 74 65 2d 61 63 63 65 73 73 2a 0a 09 20 20 rite-access*..
3e70: 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 70 72 6f (not (member pro
3e80: 63 20 2a 64 62 3a 61 6c 6c 2d 77 72 69 74 65 2d c *db:all-write-
3e90: 70 72 6f 63 73 2a 29 29 29 0a 20 20 20 20 20 20 procs*))).
3ea0: 28 6c 65 74 2a 20 28 28 64 62 20 20 20 28 63 6f (let* ((db (co
3eb0: 6e 64 0a 09 09 20 20 20 20 28 28 73 71 6c 69 74 nd... ((sqlit
3ec0: 65 33 3a 64 61 74 61 62 61 73 65 3f 20 69 64 62 e3:database? idb
3ed0: 29 20 69 64 62 29 0a 09 09 20 20 20 20 28 28 6e ) idb)... ((n
3ee0: 6f 74 20 69 64 62 29 20 20 20 20 20 20 20 20 20 ot idb)
3ef0: 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 (open-db))
3f00: 0a 09 09 20 20 20 20 28 28 70 72 6f 63 65 64 75 ... ((procedu
3f10: 72 65 3f 20 69 64 62 29 20 20 20 20 20 20 20 28 re? idb) (
3f20: 69 64 62 29 29 0a 09 09 20 20 20 20 28 65 6c 73 idb))... (els
3f30: 65 20 20 20 09 20 20 20 20 20 20 20 20 20 20 20 e .
3f40: 20 28 6f 70 65 6e 2d 64 62 29 29 29 29 0a 09 20 (open-db))))..
3f50: 20 20 20 20 28 72 65 73 20 23 66 29 29 0a 09 28 (res #f))..(
3f60: 73 65 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 set! res (apply
3f70: 70 72 6f 63 20 64 62 20 70 61 72 61 6d 73 29 29 proc db params))
3f80: 0a 09 28 69 66 20 28 6e 6f 74 20 69 64 62 29 28 ..(if (not idb)(
3f90: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
3fa0: 21 20 64 62 29 29 0a 09 28 64 65 62 75 67 3a 70 ! db))..(debug:p
3fb0: 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 6f 70 rint-info 11 "op
3fc0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d en-run-close-no-
3fd0: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 exception-handli
3fe0: 6e 67 20 45 4e 44 22 20 29 0a 09 72 65 73 29 0a ng END" )..res).
3ff0: 20 20 20 20 20 20 23 66 29 29 0a 0a 28 64 65 66 #f))..(def
4000: 69 6e 65 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c ine (open-run-cl
4010: 6f 73 65 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 ose-exception-ha
4020: 6e 64 6c 69 6e 67 20 70 72 6f 63 20 69 64 62 20 ndling proc idb
4030: 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 68 61 6e . params). (han
4040: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 20 dle-exceptions.
4050: 20 20 65 78 6e 0a 20 20 20 28 62 65 67 69 6e 0a exn. (begin.
4060: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
4070: 74 20 30 20 22 45 58 43 45 50 54 49 4f 4e 3a 20 t 0 "EXCEPTION:
4080: 64 61 74 61 62 61 73 65 20 70 72 6f 62 61 62 6c database probabl
4090: 79 20 6f 76 65 72 6c 6f 61 64 65 64 20 6f 72 20 y overloaded or
40a0: 75 6e 72 65 61 64 61 62 6c 65 2e 22 29 0a 20 20 unreadable.").
40b0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
40c0: 30 20 22 20 20 22 20 28 28 63 6f 6e 64 69 74 69 0 " " ((conditi
40d0: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
40e0: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
40f0: 67 65 29 20 65 78 6e 29 29 0a 20 20 20 20 20 28 ge) exn)). (
4100: 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e print-call-chain
4110: 29 0a 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 ). (thread-s
4120: 6c 65 65 70 21 20 28 72 61 6e 64 6f 6d 20 31 32 leep! (random 12
4130: 30 29 29 0a 20 20 20 20 20 28 64 65 62 75 67 3a 0)). (debug:
4140: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 74 72 print-info 0 "tr
4150: 79 69 6e 67 20 64 62 20 63 61 6c 6c 20 6f 6e 65 ying db call one
4160: 20 6d 6f 72 65 20 74 69 6d 65 2e 2e 2e 2e 22 29 more time....")
4170: 0a 20 20 20 20 20 28 61 70 70 6c 79 20 6f 70 65 . (apply ope
4180: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 n-run-close-no-e
4190: 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 6e xception-handlin
41a0: 67 20 70 72 6f 63 20 69 64 62 20 70 61 72 61 6d g proc idb param
41b0: 73 29 29 0a 20 20 20 28 61 70 70 6c 79 20 6f 70 s)). (apply op
41c0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 2d 6e 6f 2d en-run-close-no-
41d0: 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 6c 69 exception-handli
41e0: 6e 67 20 70 72 6f 63 20 69 64 62 20 70 61 72 61 ng proc idb para
41f0: 6d 73 29 29 29 0a 0a 3b 3b 20 28 64 65 66 69 6e ms)))..;; (defin
4200: 65 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 e open-run-close
4210: 20 0a 28 64 65 66 69 6e 65 20 6f 70 65 6e 2d 72 .(define open-r
4220: 75 6e 2d 63 6c 6f 73 65 20 28 69 66 20 28 64 65 un-close (if (de
4230: 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 32 bug:debug-mode 2
4240: 29 0a 09 09 09 20 20 20 6f 70 65 6e 2d 72 75 6e ).... open-run
4250: 2d 63 6c 6f 73 65 2d 6e 6f 2d 65 78 63 65 70 74 -close-no-except
4260: 69 6f 6e 2d 68 61 6e 64 6c 69 6e 67 0a 09 09 09 ion-handling....
4270: 20 20 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 open-run-clos
4280: 65 2d 65 78 63 65 70 74 69 6f 6e 2d 68 61 6e 64 e-exception-hand
4290: 6c 69 6e 67 29 29 0a 0a 28 64 65 66 69 6e 65 20 ling))..(define
42a0: 28 64 62 3a 69 6e 69 74 69 61 6c 69 7a 65 2d 6d (db:initialize-m
42b0: 65 67 61 74 65 73 74 2d 64 62 20 64 62 29 0a 20 egatest-db db).
42c0: 20 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 64 (let* ((configd
42d0: 61 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 at (car *configi
42e0: 6e 66 6f 2a 29 29 20 20 3b 3b 20 74 75 74 20 74 nfo*)) ;; tut t
42f0: 75 74 2c 20 67 6c 6f 62 61 6c 20 77 61 72 6e 69 ut, global warni
4300: 6e 67 2e 2e 2e 0a 09 20 28 6b 65 79 73 20 20 20 ng..... (keys
4310: 20 20 28 6b 65 79 73 3a 63 6f 6e 66 69 67 71 2d (keys:configq-
4320: 67 65 74 2d 66 69 65 6c 64 73 20 63 6f 6e 66 69 get-fields confi
4330: 67 64 61 74 29 29 0a 09 20 28 68 61 76 65 6b 65 gdat)).. (haveke
4340: 79 73 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b 65 ys (> (length ke
4350: 79 73 29 20 30 29 29 0a 09 20 28 6b 65 79 73 74 ys) 0)).. (keyst
4360: 72 20 20 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 r (keys->keyst
4370: 72 20 6b 65 79 73 29 29 0a 09 20 28 66 69 65 6c r keys)).. (fiel
4380: 64 73 74 72 20 28 6b 65 79 73 2d 3e 6b 65 79 2f dstr (keys->key/
4390: 66 69 65 6c 64 20 6b 65 79 73 29 29 29 0a 20 20 field keys))).
43a0: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
43b0: 62 64 61 20 28 6b 65 79 29 0a 09 09 28 6c 65 74 bda (key)...(let
43c0: 20 28 28 6b 65 79 6e 20 6b 65 79 29 29 0a 09 09 ((keyn key))...
43d0: 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 28 73 (if (member (s
43e0: 74 72 69 6e 67 2d 64 6f 77 6e 63 61 73 65 20 6b tring-downcase k
43f0: 65 79 6e 29 0a 09 09 09 20 20 20 20 20 20 28 6c eyn).... (l
4400: 69 73 74 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 ist "runname" "s
4410: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
4420: 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 owner" "event_ti
4430: 6d 65 22 20 22 63 6f 6d 6d 65 6e 74 22 20 22 66 me" "comment" "f
4440: 61 69 6c 5f 63 6f 75 6e 74 22 0a 09 09 09 09 20 ail_count".....
4450: 20 20 20 22 70 61 73 73 5f 63 6f 75 6e 74 22 29 "pass_count")
4460: 29 0a 09 09 20 20 20 20 20 20 28 62 65 67 69 6e )... (begin
4470: 0a 09 09 09 28 70 72 69 6e 74 20 22 45 52 52 4f ....(print "ERRO
4480: 52 3a 20 79 6f 75 72 20 6b 65 79 20 63 61 6e 6e R: your key cann
4490: 6f 74 20 62 65 20 6e 61 6d 65 64 20 22 20 6b 65 ot be named " ke
44a0: 79 6e 20 22 20 61 73 20 74 68 69 73 20 63 6f 6e yn " as this con
44b0: 66 6c 69 63 74 73 20 77 69 74 68 20 74 68 65 20 flicts with the
44c0: 73 61 6d 65 20 6e 61 6d 65 64 20 66 69 65 6c 64 same named field
44d0: 20 69 6e 20 74 68 65 20 72 75 6e 73 20 74 61 62 in the runs tab
44e0: 6c 65 22 29 0a 09 09 09 28 73 79 73 74 65 6d 20 le")....(system
44f0: 28 63 6f 6e 63 20 22 72 6d 20 2d 66 20 22 20 64 (conc "rm -f " d
4500: 62 70 61 74 68 29 29 0a 09 09 09 28 65 78 69 74 bpath))....(exit
4510: 20 31 29 29 29 29 29 0a 09 20 20 20 20 20 20 6b 1))))).. k
4520: 65 79 73 29 0a 20 20 20 20 28 73 71 6c 69 74 65 eys). (sqlite
4530: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
4540: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
4550: 54 20 45 58 49 53 54 53 20 6b 65 79 73 20 28 69 T EXISTS keys (i
4560: 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 d INTEGER PRIMAR
4570: 59 20 4b 45 59 2c 20 66 69 65 6c 64 6e 61 6d 65 Y KEY, fieldname
4580: 20 54 45 58 54 2c 20 66 69 65 6c 64 74 79 70 65 TEXT, fieldtype
4590: 20 54 45 58 54 2c 20 43 4f 4e 53 54 52 41 49 4e TEXT, CONSTRAIN
45a0: 54 20 6b 65 79 63 6f 6e 73 74 72 61 69 6e 74 20 T keyconstraint
45b0: 55 4e 49 51 55 45 20 28 66 69 65 6c 64 6e 61 6d UNIQUE (fieldnam
45c0: 65 29 29 3b 22 29 0a 20 20 20 20 28 66 6f 72 2d e));"). (for-
45d0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
45e0: 79 29 0a 09 09 28 73 71 6c 69 74 65 33 3a 65 78 y)...(sqlite3:ex
45f0: 65 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 ecute db "INSERT
4600: 20 49 4e 54 4f 20 6b 65 79 73 20 28 66 69 65 6c INTO keys (fiel
4610: 64 6e 61 6d 65 2c 66 69 65 6c 64 74 79 70 65 29 dname,fieldtype)
4620: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 29 3b 22 20 VALUES (?,?);"
4630: 6b 65 79 20 22 54 45 58 54 22 29 29 0a 09 20 20 key "TEXT"))..
4640: 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 73 keys). (s
4650: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
4660: 62 20 28 63 6f 6e 63 20 0a 09 09 09 20 22 43 52 b (conc .... "CR
4670: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
4680: 54 20 45 58 49 53 54 53 20 72 75 6e 73 20 28 69 T EXISTS runs (i
4690: 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 d INTEGER PRIMAR
46a0: 59 20 4b 45 59 2c 20 22 20 0a 09 09 09 20 66 69 Y KEY, " .... fi
46b0: 65 6c 64 73 74 72 20 28 69 66 20 68 61 76 65 6b eldstr (if havek
46c0: 65 79 73 20 22 2c 22 20 22 22 29 0a 09 09 09 20 eys "," "")....
46d0: 22 72 75 6e 6e 61 6d 65 20 20 20 20 54 45 58 54 "runname TEXT
46e0: 20 44 45 46 41 55 4c 54 20 27 6e 6f 72 75 6e 27 DEFAULT 'norun'
46f0: 2c 22 0a 09 09 09 20 22 73 74 61 74 65 20 20 20 ,".... "state
4700: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
4710: 27 27 2c 22 0a 09 09 09 20 22 73 74 61 74 75 73 '',".... "status
4720: 20 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c TEXT DEFAUL
4730: 54 20 27 27 2c 22 0a 09 09 09 20 22 6f 77 6e 65 T '',".... "owne
4740: 72 20 20 20 20 20 20 54 45 58 54 20 44 45 46 41 r TEXT DEFA
4750: 55 4c 54 20 27 27 2c 22 0a 09 09 09 20 22 65 76 ULT '',".... "ev
4760: 65 6e 74 5f 74 69 6d 65 20 54 49 4d 45 53 54 41 ent_time TIMESTA
4770: 4d 50 20 44 45 46 41 55 4c 54 20 28 73 74 72 66 MP DEFAULT (strf
4780: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
4790: 29 2c 22 0a 09 09 09 20 22 63 6f 6d 6d 65 6e 74 ),".... "comment
47a0: 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 TEXT DEFAULT
47b0: 20 27 27 2c 22 0a 09 09 09 20 22 66 61 69 6c 5f '',".... "fail_
47c0: 63 6f 75 6e 74 20 49 4e 54 45 47 45 52 20 44 45 count INTEGER DE
47d0: 46 41 55 4c 54 20 30 2c 22 0a 09 09 09 20 22 70 FAULT 0,".... "p
47e0: 61 73 73 5f 63 6f 75 6e 74 20 49 4e 54 45 47 45 ass_count INTEGE
47f0: 52 20 44 45 46 41 55 4c 54 20 30 2c 22 0a 09 09 R DEFAULT 0,"...
4800: 09 20 22 43 4f 4e 53 54 52 41 49 4e 54 20 72 75 . "CONSTRAINT ru
4810: 6e 73 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 nsconstraint UNI
4820: 51 55 45 20 28 72 75 6e 6e 61 6d 65 22 20 28 69 QUE (runname" (i
4830: 66 20 68 61 76 65 6b 65 79 73 20 22 2c 22 20 22 f havekeys "," "
4840: 22 29 20 6b 65 79 73 74 72 20 22 29 29 3b 22 29 ") keystr "));")
4850: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
4860: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
4870: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
4880: 58 49 53 54 53 20 74 65 73 74 5f 6d 65 74 61 20 XISTS test_meta
4890: 28 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 (.
48a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48b0: 20 20 20 20 20 20 20 69 64 20 20 20 20 20 20 20 id
48c0: 20 20 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 INTEGER PRIMA
48d0: 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 RY KEY,.
48e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
48f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 tes
4900: 74 6e 61 6d 65 20 20 20 20 54 45 58 54 20 44 45 tname TEXT DE
4910: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
4920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
4940: 75 74 68 6f 72 20 20 20 20 20 20 54 45 58 54 20 uthor TEXT
4950: 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 DEFAULT '',.
4960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4980: 20 6f 77 6e 65 72 20 20 20 20 20 20 20 54 45 58 owner TEX
4990: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
49a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49c0: 20 20 20 64 65 73 63 72 69 70 74 69 6f 6e 20 54 description T
49d0: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a00: 20 20 20 20 20 72 65 76 69 65 77 65 64 20 20 20 reviewed
4a10: 20 54 49 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 TIMESTAMP,.
4a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a40: 20 69 74 65 72 61 74 65 64 20 20 20 20 54 45 58 iterated TEX
4a50: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
4a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4a80: 20 20 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 avg_runtime R
4a90: 45 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 EAL,.
4aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ab0: 20 20 20 20 20 20 20 20 20 20 61 76 67 5f 64 69 avg_di
4ac0: 73 6b 20 20 20 20 52 45 41 4c 2c 0a 20 20 20 20 sk REAL,.
4ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4af0: 20 74 61 67 73 20 20 20 20 20 20 20 20 54 45 58 tags TEX
4b00: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
4b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b30: 20 20 20 6a 6f 62 67 72 6f 75 70 20 20 20 20 54 jobgroup T
4b40: 45 58 54 20 44 45 46 41 55 4c 54 20 27 64 65 66 EXT DEFAULT 'def
4b50: 61 75 6c 74 27 2c 0a 20 20 20 20 20 20 20 20 20 ault',.
4b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b70: 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e CONSTRAIN
4b80: 54 20 74 65 73 74 5f 6d 65 74 61 5f 63 6f 6e 73 T test_meta_cons
4b90: 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 74 traint UNIQUE (t
4ba0: 65 73 74 6e 61 6d 65 29 29 3b 22 29 0a 20 20 20 estname));").
4bb0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4bc0: 65 20 64 62 20 28 63 6f 6e 63 20 22 43 52 45 41 e db (conc "CREA
4bd0: 54 45 20 49 4e 44 45 58 20 72 75 6e 73 5f 69 6e TE INDEX runs_in
4be0: 64 65 78 20 4f 4e 20 72 75 6e 73 20 28 72 75 6e dex ON runs (run
4bf0: 6e 61 6d 65 22 20 28 69 66 20 68 61 76 65 6b 65 name" (if haveke
4c00: 79 73 20 22 2c 22 20 22 22 29 20 6b 65 79 73 74 ys "," "") keyst
4c10: 72 20 22 29 3b 22 29 29 0a 20 20 20 20 3b 3b 20 r ");")). ;;
4c20: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
4c30: 20 64 62 20 22 43 52 45 41 54 45 20 56 49 45 57 db "CREATE VIEW
4c40: 20 72 75 6e 73 5f 74 65 73 74 73 20 41 53 20 53 runs_tests AS S
4c50: 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 72 75 6e ELECT * FROM run
4c60: 73 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 s INNER JOIN tes
4c70: 74 73 20 4f 4e 20 72 75 6e 73 2e 69 64 3d 74 65 ts ON runs.id=te
4c80: 73 74 73 2e 72 75 6e 5f 69 64 3b 22 29 0a 20 20 sts.run_id;").
4c90: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
4ca0: 74 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 te db "CREATE TA
4cb0: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
4cc0: 53 20 65 78 74 72 61 64 61 74 20 28 69 64 20 49 S extradat (id I
4cd0: 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b NTEGER PRIMARY K
4ce0: 45 59 2c 20 72 75 6e 5f 69 64 20 49 4e 54 45 47 EY, run_id INTEG
4cf0: 45 52 2c 20 6b 65 79 20 54 45 58 54 2c 20 76 61 ER, key TEXT, va
4d00: 6c 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 28 l TEXT);"). (
4d10: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
4d20: 64 62 20 22 43 52 45 41 54 45 20 54 41 42 4c 45 db "CREATE TABLE
4d30: 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 6d IF NOT EXISTS m
4d40: 65 74 61 64 61 74 20 28 69 64 20 49 4e 54 45 47 etadat (id INTEG
4d50: 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 ER PRIMARY KEY,
4d60: 76 61 72 20 54 45 58 54 2c 20 76 61 6c 20 54 45 var TEXT, val TE
4d70: 58 54 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 XT,.
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d90: 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 CONSTRAINT
4da0: 20 6d 65 74 61 64 61 74 5f 63 6f 6e 73 74 72 61 metadat_constra
4db0: 69 6e 74 20 55 4e 49 51 55 45 20 28 76 61 72 29 int UNIQUE (var)
4dc0: 29 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 );"). (sqlite
4dd0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 52 3:execute db "CR
4de0: 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f EATE TABLE IF NO
4df0: 54 20 45 58 49 53 54 53 20 61 63 63 65 73 73 5f T EXISTS access_
4e00: 6c 6f 67 20 28 69 64 20 49 4e 54 45 47 45 52 20 log (id INTEGER
4e10: 50 52 49 4d 41 52 59 20 4b 45 59 2c 20 75 73 65 PRIMARY KEY, use
4e20: 72 20 54 45 58 54 2c 20 61 63 63 65 73 73 65 64 r TEXT, accessed
4e30: 20 54 49 4d 45 53 54 41 4d 50 2c 20 61 72 67 73 TIMESTAMP, args
4e40: 20 54 45 58 54 29 3b 22 29 0a 20 20 20 20 3b 3b TEXT);"). ;;
4e50: 20 4d 75 73 74 20 64 6f 20 74 68 69 73 20 2a 61 Must do this *a
4e60: 66 74 65 72 2a 20 72 75 6e 6e 69 6e 67 20 70 61 fter* running pa
4e70: 74 63 68 20 64 62 20 21 21 20 4e 6f 20 6d 6f 72 tch db !! No mor
4e80: 65 2e 20 0a 20 20 20 20 28 64 62 3a 73 65 74 2d e. . (db:set-
4e90: 76 61 72 20 64 62 20 22 4d 45 47 41 54 45 53 54 var db "MEGATEST
4ea0: 5f 56 45 52 53 49 4f 4e 22 20 6d 65 67 61 74 65 _VERSION" megate
4eb0: 73 74 2d 76 65 72 73 69 6f 6e 29 0a 20 20 20 20 st-version).
4ec0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
4ed0: 6f 20 31 31 20 22 64 62 3a 69 6e 69 74 69 61 6c o 11 "db:initial
4ee0: 69 7a 65 20 45 4e 44 22 29 29 29 0a 0a 3b 3b 3d ize END")))..;;=
4ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f30: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 20 55 20 4e 20 20 =====.;; R U N
4f40: 20 53 20 50 20 45 20 43 20 49 20 46 20 49 20 43 S P E C I F I C
4f50: 20 20 20 44 20 42 20 0a 3b 3b 3d 3d 3d 3d 3d 3d D B .;;======
4f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4fa0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 69 6e ..(define (db:in
4fb0: 69 74 69 61 6c 69 7a 65 64 2d 72 75 6e 2d 69 64 itialized-run-id
4fc0: 2d 64 62 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 -db db run-id).
4fd0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4fe0: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
4ff0: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
5000: 20 74 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 tests .
5010: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 64 20 (id
5020: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
5030: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 KEY,.
5040: 20 20 20 20 20 20 20 20 20 20 72 75 6e 5f 69 64 run_id
5050: 20 20 20 20 20 20 20 49 4e 54 45 47 45 52 20 20 INTEGER
5060: 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 20 DEFAULT -1,.
5070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5080: 20 20 74 65 73 74 6e 61 6d 65 20 20 20 20 20 54 testname T
5090: 45 58 54 20 20 20 20 20 20 44 45 46 41 55 4c 54 EXT DEFAULT
50a0: 20 27 6e 6f 6e 61 6d 65 27 2c 0a 20 20 20 20 20 'noname',.
50b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50c0: 68 6f 73 74 20 20 20 20 20 20 20 20 20 54 45 58 host TEX
50d0: 54 20 20 20 20 20 20 44 45 46 41 55 4c 54 20 27 T DEFAULT '
50e0: 6e 2f 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 n/a',.
50f0: 20 20 20 20 20 20 20 20 20 20 20 63 70 75 6c 6f cpulo
5100: 61 64 20 20 20 20 20 20 52 45 41 4c 20 20 20 20 ad REAL
5110: 20 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a 20 20 DEFAULT -1,.
5120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5130: 20 20 20 64 69 73 6b 66 72 65 65 20 20 20 20 20 diskfree
5140: 49 4e 54 45 47 45 52 20 20 20 44 45 46 41 55 4c INTEGER DEFAUL
5150: 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 T -1,.
5160: 20 20 20 20 20 20 20 20 20 20 20 75 6e 61 6d 65 uname
5170: 20 20 20 20 20 20 20 20 54 45 58 54 20 20 20 20 TEXT
5180: 20 20 44 45 46 41 55 4c 54 20 27 6e 2f 61 27 2c DEFAULT 'n/a',
5190: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
51a0: 20 20 20 20 20 20 20 72 75 6e 64 69 72 20 20 20 rundir
51b0: 20 20 20 20 54 45 58 54 20 20 20 20 20 20 44 45 TEXT DE
51c0: 46 41 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 FAULT 'n/a',.
51d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51e0: 20 20 73 68 6f 72 74 64 69 72 20 20 20 20 20 54 shortdir T
51f0: 45 58 54 20 20 20 20 20 20 44 45 46 41 55 4c 54 EXT DEFAULT
5200: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
5210: 20 20 20 20 20 20 20 20 20 20 69 74 65 6d 5f 70 item_p
5220: 61 74 68 20 20 20 20 54 45 58 54 20 20 20 20 20 ath TEXT
5230: 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 DEFAULT '',.
5240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5250: 20 20 73 74 61 74 65 20 20 20 20 20 20 20 20 54 state T
5260: 45 58 54 20 20 20 20 20 20 44 45 46 41 55 4c 54 EXT DEFAULT
5270: 20 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 0a 'NOT_STARTED',.
5280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5290: 20 20 20 20 20 73 74 61 74 75 73 20 20 20 20 20 status
52a0: 20 20 54 45 58 54 20 20 20 20 20 20 44 45 46 41 TEXT DEFA
52b0: 55 4c 54 20 27 46 41 49 4c 27 2c 0a 20 20 20 20 ULT 'FAIL',.
52c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52d0: 20 61 74 74 65 6d 70 74 6e 75 6d 20 20 20 49 4e attemptnum IN
52e0: 54 45 47 45 52 20 20 20 44 45 46 41 55 4c 54 20 TEGER DEFAULT
52f0: 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0,.
5300: 20 20 20 20 20 20 20 20 66 69 6e 61 6c 5f 6c 6f final_lo
5310: 67 66 20 20 20 54 45 58 54 20 20 20 20 20 20 44 gf TEXT D
5320: 45 46 41 55 4c 54 20 27 6c 6f 67 73 2f 66 69 6e EFAULT 'logs/fin
5330: 61 6c 2e 6c 6f 67 27 2c 0a 20 20 20 20 20 20 20 al.log',.
5340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f lo
5350: 67 64 61 74 20 20 20 20 20 20 20 54 45 58 54 20 gdat TEXT
5360: 20 20 20 20 20 44 45 46 41 55 4c 54 20 27 27 2c DEFAULT '',
5370: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5380: 20 20 20 20 20 20 20 72 75 6e 5f 64 75 72 61 74 run_durat
5390: 69 6f 6e 20 49 4e 54 45 47 45 52 20 20 20 44 45 ion INTEGER DE
53a0: 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 20 20 FAULT 0,.
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f co
53c0: 6d 6d 65 6e 74 20 20 20 20 20 20 54 45 58 54 20 mment TEXT
53d0: 20 20 20 20 20 44 45 46 41 55 4c 54 20 27 27 2c DEFAULT '',
53e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
53f0: 20 20 20 20 20 20 65 76 65 6e 74 5f 74 69 6d 65 event_time
5400: 20 20 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 TIMESTAMP DEF
5410: 41 55 4c 54 20 28 73 74 72 66 74 69 6d 65 28 27 AULT (strftime('
5420: 25 73 27 2c 27 6e 6f 77 27 29 29 2c 0a 20 20 20 %s','now')),.
5430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5440: 20 20 66 61 69 6c 5f 63 6f 75 6e 74 20 20 20 49 fail_count I
5450: 4e 54 45 47 45 52 20 20 20 44 45 46 41 55 4c 54 NTEGER DEFAULT
5460: 20 30 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 0,.
5470: 20 20 20 20 20 20 20 20 20 70 61 73 73 5f 63 6f pass_co
5480: 75 6e 74 20 20 20 49 4e 54 45 47 45 52 20 20 20 unt INTEGER
5490: 44 45 46 41 55 4c 54 20 30 2c 0a 20 20 20 20 20 DEFAULT 0,.
54a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54b0: 61 72 63 68 69 76 65 64 20 20 20 20 20 49 4e 54 archived INT
54c0: 45 47 45 52 20 20 20 44 45 46 41 55 4c 54 20 30 EGER DEFAULT 0
54d0: 2c 20 2d 2d 20 30 3d 6e 6f 2c 20 31 3d 69 6e 20 , -- 0=no, 1=in
54e0: 70 72 6f 67 72 65 73 73 2c 20 32 3d 79 65 73 0a progress, 2=yes.
54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5500: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 CONSTRAI
5510: 4e 54 20 74 65 73 74 73 63 6f 6e 73 74 72 61 69 NT testsconstrai
5520: 6e 74 20 55 4e 49 51 55 45 20 28 72 75 6e 5f 69 nt UNIQUE (run_i
5530: 64 2c 20 74 65 73 74 6e 61 6d 65 2c 20 69 74 65 d, testname, ite
5540: 6d 5f 70 61 74 68 29 29 3b 22 29 0a 20 20 20 20 m_path));").
5550: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
5560: 20 64 62 20 22 43 52 45 41 54 45 20 49 4e 44 45 db "CREATE INDE
5570: 58 20 74 65 73 74 73 5f 69 6e 64 65 78 20 4f 4e X tests_index ON
5580: 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 20 tests (run_id,
5590: 74 65 73 74 6e 61 6d 65 2c 20 69 74 65 6d 5f 70 testname, item_p
55a0: 61 74 68 29 3b 22 29 0a 20 20 20 20 28 73 71 6c ath);"). (sql
55b0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
55c0: 22 43 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 "CREATE TABLE IF
55d0: 20 4e 4f 54 20 45 58 49 53 54 53 20 74 65 73 74 NOT EXISTS test
55e0: 5f 73 74 65 70 73 20 0a 20 20 20 20 20 20 20 20 _steps .
55f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5600: 20 20 20 20 20 20 28 69 64 20 49 4e 54 45 47 45 (id INTEGE
5610: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
5620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 te
5640: 73 74 5f 69 64 20 49 4e 54 45 47 45 52 2c 20 0a st_id INTEGER, .
5650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
5670: 74 65 70 6e 61 6d 65 20 54 45 58 54 2c 20 0a 20 tepname TEXT, .
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 st
56a0: 61 74 65 20 54 45 58 54 20 44 45 46 41 55 4c 54 ate TEXT DEFAULT
56b0: 20 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 20 'NOT_STARTED',
56c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56e0: 73 74 61 74 75 73 20 54 45 58 54 20 44 45 46 41 status TEXT DEFA
56f0: 55 4c 54 20 27 6e 2f 61 27 2c 0a 20 20 20 20 20 ULT 'n/a',.
5700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5710: 20 20 20 20 20 20 20 20 20 20 65 76 65 6e 74 5f event_
5720: 74 69 6d 65 20 54 49 4d 45 53 54 41 4d 50 2c 0a time TIMESTAMP,.
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
5750: 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 41 omment TEXT DEFA
5760: 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 20 ULT '',.
5770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5780: 20 20 20 20 20 20 20 6c 6f 67 66 69 6c 65 20 54 logfile T
5790: 45 58 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a EXT DEFAULT '',.
57a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 43 C
57c0: 4f 4e 53 54 52 41 49 4e 54 20 74 65 73 74 5f 73 ONSTRAINT test_s
57d0: 74 65 70 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 teps_constraint
57e0: 55 4e 49 51 55 45 20 28 74 65 73 74 5f 69 64 2c UNIQUE (test_id,
57f0: 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 29 29 stepname,state))
5800: 3b 22 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 ;"). (sqlite3:e
5810: 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 54 xecute db "CREAT
5820: 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 E TABLE IF NOT E
5830: 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 20 XISTS test_data
5840: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5860: 69 64 20 20 20 20 20 20 20 20 20 20 49 4e 54 45 id INTE
5870: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
5880: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58a0: 20 20 20 20 20 20 72 65 76 69 65 77 65 64 20 20 reviewed
58b0: 20 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 TIMESTAMP DEFA
58c0: 55 4c 54 20 28 73 74 72 66 74 69 6d 65 28 27 25 ULT (strftime('%
58d0: 73 27 2c 27 6e 6f 77 27 29 29 2c 0a 20 20 20 20 s','now')),.
58e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5900: 20 69 74 65 72 61 74 65 64 20 20 20 20 54 45 58 iterated TEX
5910: 54 20 44 45 46 41 55 4c 54 20 27 27 2c 0a 20 20 T DEFAULT '',.
5920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 61 76 67 5f 72 75 6e 74 69 6d 65 20 52 avg_runtime R
5950: 45 41 4c 20 44 45 46 41 55 4c 54 20 2d 31 2c 0a EAL DEFAULT -1,.
5960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5980: 20 20 20 20 20 61 76 67 5f 64 69 73 6b 20 20 20 avg_disk
5990: 20 52 45 41 4c 20 44 45 46 41 55 4c 54 20 2d 31 REAL DEFAULT -1
59a0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59c0: 20 20 20 20 20 20 20 74 61 67 73 20 20 20 20 20 tags
59d0: 20 20 20 54 45 58 54 20 44 45 46 41 55 4c 54 20 TEXT DEFAULT
59e0: 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '',.
59f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a00: 20 20 20 20 20 20 20 20 20 6a 6f 62 67 72 6f 75 jobgrou
5a10: 70 20 20 20 20 54 45 58 54 20 44 45 46 41 55 4c p TEXT DEFAUL
5a20: 54 20 27 64 65 66 61 75 6c 74 27 2c 0a 20 20 20 T 'default',.
5a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 43 4f 4e CON
5a50: 53 54 52 41 49 4e 54 20 74 65 73 74 5f 6d 65 74 STRAINT test_met
5a60: 61 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 a_constraint UNI
5a70: 51 55 45 20 28 74 65 73 74 6e 61 6d 65 29 29 3b QUE (testname));
5a80: 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a "). (sqlite3:
5a90: 65 78 65 63 75 74 65 20 64 62 20 22 43 52 45 41 execute db "CREA
5aa0: 54 45 20 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 TE TABLE IF NOT
5ab0: 45 58 49 53 54 53 20 74 65 73 74 5f 64 61 74 61 EXISTS test_data
5ac0: 20 28 69 64 20 49 4e 54 45 47 45 52 20 50 52 49 (id INTEGER PRI
5ad0: 4d 41 52 59 20 4b 45 59 2c 0a 20 20 20 20 20 20 MARY KEY,.
5ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5af0: 20 20 20 20 20 20 20 20 20 20 74 65 73 74 5f 69 test_i
5b00: 64 20 49 4e 54 45 47 45 52 2c 0a 20 20 20 20 20 d INTEGER,.
5b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b20: 20 20 20 20 20 20 20 20 20 20 20 63 61 74 65 67 categ
5b30: 6f 72 79 20 54 45 58 54 20 44 45 46 41 55 4c 54 ory TEXT DEFAULT
5b40: 20 27 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 '',.
5b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b60: 20 20 20 20 20 76 61 72 69 61 62 6c 65 20 54 45 variable TE
5b70: 58 54 2c 0a 09 20 20 20 20 20 20 20 20 20 20 20 XT,..
5b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 6c val
5b90: 75 65 20 52 45 41 4c 2c 0a 09 20 20 20 20 20 20 ue REAL,..
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bb0: 20 20 65 78 70 65 63 74 65 64 20 52 45 41 4c 2c expected REAL,
5bc0: 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
5bd0: 20 20 20 20 20 20 20 20 20 20 74 6f 6c 20 52 45 tol RE
5be0: 41 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 AL,.
5bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c00: 20 20 20 20 75 6e 69 74 73 20 54 45 58 54 2c 0a units TEXT,.
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c30: 63 6f 6d 6d 65 6e 74 20 54 45 58 54 20 44 45 46 comment TEXT DEF
5c40: 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 20 AULT '',.
5c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c60: 20 20 20 20 20 20 20 20 20 73 74 61 74 75 73 20 status
5c70: 54 45 58 54 20 44 45 46 41 55 4c 54 20 27 6e 2f TEXT DEFAULT 'n/
5c80: 61 27 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 a',.
5c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ca0: 20 20 20 20 74 79 70 65 20 54 45 58 54 20 44 45 type TEXT DE
5cb0: 46 41 55 4c 54 20 27 27 2c 0a 20 20 20 20 20 20 FAULT '',.
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cd0: 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 49 CONSTRAI
5ce0: 4e 54 20 74 65 73 74 5f 64 61 74 61 5f 63 6f 6e NT test_data_con
5cf0: 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 20 28 straint UNIQUE (
5d00: 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 test_id,category
5d10: 2c 76 61 72 69 61 62 6c 65 29 29 3b 22 29 0a 20 ,variable));").
5d20: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
5d30: 65 20 64 62 20 22 43 52 45 41 54 45 20 54 41 42 e db "CREATE TAB
5d40: 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 LE IF NOT EXISTS
5d50: 20 74 65 73 74 5f 72 75 6e 64 61 74 20 28 0a 20 test_rundat (.
5d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 64 20 id
5d80: 20 20 20 20 20 20 20 20 20 20 49 4e 54 45 47 45 INTEGE
5d90: 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c 0a 20 R PRIMARY KEY,.
5da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 tes
5dc0: 74 5f 69 64 20 20 20 20 20 20 49 4e 54 45 47 45 t_id INTEGE
5dd0: 52 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 R,.
5de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5df0: 20 75 70 64 61 74 65 5f 74 69 6d 65 20 20 54 49 update_time TI
5e00: 4d 45 53 54 41 4d 50 2c 0a 20 20 20 20 20 20 20 MESTAMP,.
5e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e20: 20 20 20 20 20 20 20 63 70 75 6c 6f 61 64 20 20 cpuload
5e30: 20 20 20 20 49 4e 54 45 47 45 52 20 44 45 46 41 INTEGER DEFA
5e40: 55 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 ULT -1,.
5e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e60: 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 20 20 diskfree
5e70: 20 20 20 49 4e 54 45 47 45 52 20 44 45 46 41 55 INTEGER DEFAU
5e80: 4c 54 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 LT -1,.
5e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ea0: 20 20 20 20 20 64 69 73 6b 75 73 61 67 65 20 20 diskusage
5eb0: 20 20 49 4e 54 47 45 52 20 44 45 46 41 55 4c 54 INTGER DEFAULT
5ec0: 20 2d 31 2c 0a 20 20 20 20 20 20 20 20 20 20 20 -1,.
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 20 20 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 run_duration
5ef0: 49 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 INTEGER DEFAULT
5f00: 30 29 3b 22 29 0a 20 20 64 62 29 0a 0a 3b 3b 3d 0);"). db)..;;=
5f10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f50: 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 20 4f 20 47 20 47 =====.;; L O G G
5f60: 20 49 20 4e 20 47 20 20 20 20 44 20 42 20 0a 3b I N G D B .;
5f70: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
5f80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
5fb0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
5fc0: 20 28 6f 70 65 6e 2d 6c 6f 67 67 69 6e 67 2d 64 (open-logging-d
5fd0: 62 29 20 3b 3b 20 20 28 63 6f 6e 63 20 2a 74 6f b) ;; (conc *to
5fe0: 70 70 61 74 68 2a 20 22 2f 6d 65 67 61 74 65 73 ppath* "/megates
5ff0: 74 2e 64 62 22 29 20 28 63 61 72 20 2a 63 6f 6e t.db") (car *con
6000: 66 69 67 69 6e 66 6f 2a 29 29 29 0a 20 20 28 6c figinfo*))). (l
6010: 65 74 2a 20 28 28 64 62 70 61 74 68 20 20 20 20 et* ((dbpath
6020: 28 63 6f 6e 63 20 28 69 66 20 2a 74 6f 70 70 61 (conc (if *toppa
6030: 74 68 2a 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 th* (conc *toppa
6040: 74 68 2a 20 22 2f 22 29 20 22 22 29 20 22 6c 6f th* "/") "") "lo
6050: 67 67 69 6e 67 2e 64 62 22 29 29 20 3b 3b 20 66 gging.db")) ;; f
6060: 6e 61 6d 65 29 0a 09 20 28 64 62 65 78 69 73 74 name).. (dbexist
6070: 73 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f s (file-exists?
6080: 20 64 62 70 61 74 68 29 29 0a 09 20 28 64 62 20 dbpath)).. (db
6090: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
60a0: 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 20 64 62 open-database db
60b0: 70 61 74 68 29 29 20 3b 3b 20 28 6e 65 76 65 72 path)) ;; (never
60c0: 2d 67 69 76 65 2d 75 70 2d 6f 70 65 6e 2d 64 62 -give-up-open-db
60d0: 20 64 62 70 61 74 68 29 29 0a 09 20 28 68 61 6e dbpath)).. (han
60e0: 64 6c 65 72 20 20 20 28 6d 61 6b 65 2d 62 75 73 dler (make-bus
60f0: 79 2d 74 69 6d 65 6f 75 74 20 28 69 66 20 28 61 y-timeout (if (a
6100: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6f 76 rgs:get-arg "-ov
6110: 65 72 72 69 64 65 2d 74 69 6d 65 6f 75 74 22 29 erride-timeout")
6120: 0a 09 09 09 09 09 20 20 20 28 73 74 72 69 6e 67 ...... (string
6130: 2d 3e 6e 75 6d 62 65 72 20 28 61 72 67 73 3a 67 ->number (args:g
6140: 65 74 2d 61 72 67 20 22 2d 6f 76 65 72 72 69 64 et-arg "-overrid
6150: 65 2d 74 69 6d 65 6f 75 74 22 29 29 0a 09 09 09 e-timeout"))....
6160: 09 09 20 20 20 31 33 36 30 30 30 29 29 29 29 20 .. 136000))))
6170: 3b 3b 20 31 33 36 30 30 30 29 29 29 0a 20 20 20 ;; 136000))).
6180: 20 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 (sqlite3:set-bu
6190: 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 sy-handler! db h
61a0: 61 6e 64 6c 65 72 29 0a 20 20 20 20 28 69 66 20 andler). (if
61b0: 28 6e 6f 74 20 64 62 65 78 69 73 74 73 29 0a 09 (not dbexists)..
61c0: 28 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 (begin.. (sqlit
61d0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 43 e3:execute db "C
61e0: 52 45 41 54 45 20 54 41 42 4c 45 20 49 46 20 4e REATE TABLE IF N
61f0: 4f 54 20 45 58 49 53 54 53 20 6c 6f 67 20 28 69 OT EXISTS log (i
6200: 64 20 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 d INTEGER PRIMAR
6210: 59 20 4b 45 59 2c 65 76 65 6e 74 5f 74 69 6d 65 Y KEY,event_time
6220: 20 54 49 4d 45 53 54 41 4d 50 20 44 45 46 41 55 TIMESTAMP DEFAU
6230: 4c 54 20 28 73 74 72 66 74 69 6d 65 28 27 25 73 LT (strftime('%s
6240: 27 2c 27 6e 6f 77 27 29 29 2c 6c 6f 67 6c 69 6e ','now')),loglin
6250: 65 20 54 45 58 54 2c 70 77 64 20 54 45 58 54 2c e TEXT,pwd TEXT,
6260: 63 6d 64 6c 69 6e 65 20 54 45 58 54 2c 70 69 64 cmdline TEXT,pid
6270: 20 49 4e 54 45 47 45 52 29 3b 22 29 0a 09 20 20 INTEGER);")..
6280: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
6290: 20 64 62 20 28 63 6f 6e 63 20 22 50 52 41 47 4d db (conc "PRAGM
62a0: 41 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 3d 20 A synchronous =
62b0: 30 3b 22 29 29 29 29 0a 20 20 20 20 64 62 29 29 0;")))). db))
62c0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 6c 6f ..(define (db:lo
62d0: 67 2d 6c 6f 63 61 6c 2d 65 76 65 6e 74 20 2e 20 g-local-event .
62e0: 6c 6f 67 6c 73 74 29 0a 20 20 28 6c 65 74 20 28 loglst). (let (
62f0: 28 6c 6f 67 6c 69 6e 65 20 28 61 70 70 6c 79 20 (logline (apply
6300: 63 6f 6e 63 20 6c 6f 67 6c 73 74 29 29 29 0a 20 conc loglst))).
6310: 20 20 20 28 64 62 3a 6c 6f 67 2d 65 76 65 6e 74 (db:log-event
6320: 20 6c 6f 67 6c 69 6e 65 29 29 29 0a 0a 28 64 65 logline)))..(de
6330: 66 69 6e 65 20 28 64 62 3a 6c 6f 67 2d 65 76 65 fine (db:log-eve
6340: 6e 74 20 6c 6f 67 6c 69 6e 65 29 0a 20 20 28 6c nt logline). (l
6350: 65 74 20 28 28 64 62 20 28 6f 70 65 6e 2d 6c 6f et ((db (open-lo
6360: 67 67 69 6e 67 2d 64 62 29 29 29 0a 20 20 20 20 gging-db))).
6370: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
6380: 20 64 62 20 22 49 4e 53 45 52 54 20 49 4e 54 4f db "INSERT INTO
6390: 20 6c 6f 67 20 28 6c 6f 67 6c 69 6e 65 2c 70 77 log (logline,pw
63a0: 64 2c 63 6d 64 6c 69 6e 65 2c 70 69 64 29 20 56 d,cmdline,pid) V
63b0: 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 29 3b ALUES (?,?,?,?);
63c0: 22 0a 09 09 20 20 20 20 20 6c 6f 67 6c 69 6e 65 "... logline
63d0: 0a 09 09 20 20 20 20 20 28 63 75 72 72 65 6e 74 ... (current
63e0: 2d 64 69 72 65 63 74 6f 72 79 29 0a 09 09 20 20 -directory)...
63f0: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
6400: 73 70 65 72 73 65 20 28 61 72 67 76 29 20 22 20 sperse (argv) "
6410: 22 29 0a 09 09 20 20 20 20 20 28 63 75 72 72 65 ")... (curre
6420: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 29 0a nt-process-id)).
6430: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
6440: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 6c alize! db). l
6450: 6f 67 6c 69 6e 65 29 29 0a 0a 3b 3b 3d 3d 3d 3d ogline))..;;====
6460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64a0: 3d 3d 0a 3b 3b 20 44 20 42 20 20 20 55 20 54 20 ==.;; D B U T
64b0: 49 20 4c 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d I L S.;;========
64c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
64f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
6500: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
6510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6540: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 41 20 ========.;; M A
6550: 49 20 4e 20 54 20 45 20 4e 20 41 20 4e 20 43 20 I N T E N A N C
6560: 45 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d E.;;============
6570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
65a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 20 ==========..;;
65b0: 73 65 6c 65 63 74 20 65 6e 64 5f 74 69 6d 65 2d select end_time-
65c0: 6e 6f 77 20 66 72 6f 6d 0a 3b 3b 20 20 20 20 20 now from.;;
65d0: 20 28 73 65 6c 65 63 74 20 74 65 73 74 6e 61 6d (select testnam
65e0: 65 2c 69 74 65 6d 5f 70 61 74 68 2c 65 76 65 6e e,item_path,even
65f0: 74 5f 74 69 6d 65 2b 72 75 6e 5f 64 75 72 61 74 t_time+run_durat
6600: 69 6f 6e 20 61 73 0a 3b 3b 20 20 20 20 20 20 20 ion as.;;
6610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6620: 20 20 20 65 6e 64 5f 74 69 6d 65 2c 73 74 72 66 end_time,strf
6630: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
6640: 20 61 73 20 6e 6f 77 20 66 72 6f 6d 20 74 65 73 as now from tes
6650: 74 73 20 77 68 65 72 65 20 73 74 61 74 65 20 69 ts where state i
6660: 6e 0a 3b 3b 20 20 20 20 20 20 28 27 52 55 4e 4e n.;; ('RUNN
6670: 49 4e 47 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 ING','REMOTEHOST
6680: 53 54 41 52 54 27 2c 27 4c 41 55 4e 43 45 44 27 START','LAUNCED'
6690: 29 29 3b 0a 0a 0a 28 64 65 66 69 6e 65 20 28 64 ));...(define (d
66a0: 62 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d b:find-and-mark-
66b0: 69 6e 63 6f 6d 70 6c 65 74 65 20 64 62 20 23 21 incomplete db #!
66c0: 6b 65 79 20 28 6f 76 72 2d 64 65 61 64 74 69 6d key (ovr-deadtim
66d0: 65 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 e #f)). (let* (
66e0: 28 69 6e 63 6f 6d 70 6c 65 74 65 64 20 27 28 29 (incompleted '()
66f0: 29 0a 09 20 28 64 65 61 64 74 69 6d 65 2d 73 74 ).. (deadtime-st
6700: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
6710: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
6720: 65 74 75 70 22 20 22 64 65 61 64 74 69 6d 65 22 etup" "deadtime"
6730: 29 29 0a 09 20 28 64 65 61 64 74 69 6d 65 20 20 )).. (deadtime
6740: 20 20 20 28 69 66 20 28 61 6e 64 20 64 65 61 64 (if (and dead
6750: 74 69 6d 65 2d 73 74 72 0a 09 09 09 09 28 73 74 time-str.....(st
6760: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 64 65 61 ring->number dea
6770: 64 74 69 6d 65 2d 73 74 72 29 29 0a 09 09 09 20 dtime-str))....
6780: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
6790: 72 20 64 65 61 64 74 69 6d 65 2d 73 74 72 29 0a r deadtime-str).
67a0: 09 09 09 20 20 20 37 32 30 30 29 29 20 3b 3b 20 ... 7200)) ;;
67b0: 74 77 6f 20 68 6f 75 72 73 0a 09 20 28 72 75 6e two hours.. (run
67c0: 2d 69 64 73 20 20 20 20 20 20 28 64 62 3a 67 65 -ids (db:ge
67d0: 74 2d 72 75 6e 2d 69 64 73 20 64 62 29 29 29 20 t-run-ids db)))
67e0: 3b 3b 20 69 74 65 72 61 74 65 20 6f 76 65 72 20 ;; iterate over
67f0: 72 75 6e 73 20 74 6f 20 64 69 76 79 20 75 70 20 runs to divy up
6800: 74 68 65 20 63 61 6c 6c 73 0a 20 20 20 20 28 69 the calls. (i
6810: 66 20 28 6e 75 6d 62 65 72 3f 20 6f 76 72 2d 64 f (number? ovr-d
6820: 65 61 64 74 69 6d 65 29 28 73 65 74 21 20 64 65 eadtime)(set! de
6830: 61 64 74 69 6d 65 20 6f 76 72 2d 64 65 61 64 74 adtime ovr-deadt
6840: 69 6d 65 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 ime)). (for-e
6850: 61 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ach. (lambda
6860: 20 28 72 75 6e 2d 69 64 29 0a 0a 20 20 20 20 20 (run-id)..
6870: 20 20 3b 3b 20 69 6e 20 52 55 4e 4e 49 4e 47 20 ;; in RUNNING
6880: 6f 72 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 or REMOTEHOSTSTA
6890: 52 54 20 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e RT for more than
68a0: 20 31 30 20 6d 69 6e 75 74 65 73 0a 20 20 20 20 10 minutes.
68b0: 20 20 20 3b 3b 0a 20 20 20 20 20 20 20 3b 3b 20 ;;. ;;
68c0: 54 48 49 53 20 43 41 4e 4e 4f 54 20 57 4f 52 4b THIS CANNOT WORK
68d0: 2e 20 54 68 65 20 72 75 6e 5f 64 75 72 61 74 69 . The run_durati
68e0: 6f 6e 20 69 73 20 6e 6f 74 20 75 70 64 61 74 65 on is not update
68f0: 64 20 69 6e 20 74 68 65 20 63 65 6e 74 72 61 6c d in the central
6900: 20 64 62 20 64 75 65 20 74 6f 20 70 65 72 66 6f db due to perfo
6910: 72 6d 61 6e 63 65 20 63 6f 6e 63 65 72 6e 73 2e rmance concerns.
6920: 0a 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 . ;;
6930: 20 20 20 20 20 20 20 20 20 20 20 20 20 54 68 65 The
6940: 20 74 65 73 74 64 61 74 2e 64 62 20 66 69 6c 65 testdat.db file
6950: 20 6d 75 73 74 20 62 65 20 63 6f 6e 73 75 6c 74 must be consult
6960: 65 64 2e 0a 20 20 20 20 20 20 20 3b 3b 0a 20 20 ed.. ;;.
6970: 20 20 20 20 20 3b 3b 20 48 4f 57 45 56 45 52 3a ;; HOWEVER:
6980: 20 74 68 69 73 20 63 6f 64 65 20 69 6e 20 72 75 this code in ru
6990: 6e 3a 74 65 73 74 20 73 65 65 6d 73 20 74 6f 20 n:test seems to
69a0: 77 6f 72 6b 20 66 69 6e 65 0a 20 20 20 20 20 20 work fine.
69b0: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
69c0: 20 28 3e 20 28 2d 20 28 63 75 72 72 65 6e 74 2d (> (- (current-
69d0: 73 65 63 6f 6e 64 73 29 28 2b 20 28 64 62 3a 74 seconds)(+ (db:t
69e0: 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 est-get-event_ti
69f0: 6d 65 20 74 65 73 74 64 61 74 29 0a 20 20 20 20 me testdat).
6a00: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
6a10: 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 (db:te
6a20: 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 74 st-get-run_durat
6a30: 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 0a 20 ion testdat))).
6a40: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
6a50: 20 20 20 20 20 20 20 20 20 20 20 20 36 30 30 29 600)
6a60: 20 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 . (sqlite
6a70: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
6a80: 09 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 .(lambda (test-i
6a90: 64 29 0a 09 20 20 28 73 65 74 21 20 69 6e 63 6f d).. (set! inco
6aa0: 6d 70 6c 65 74 65 64 20 28 63 6f 6e 73 20 74 65 mpleted (cons te
6ab0: 73 74 2d 69 64 20 69 6e 63 6f 6d 70 6c 65 74 65 st-id incomplete
6ac0: 64 29 29 29 0a 09 64 62 0a 09 22 53 45 4c 45 43 d)))..db.."SELEC
6ad0: 54 20 69 64 20 46 52 4f 4d 20 74 65 73 74 73 20 T id FROM tests
6ae0: 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 WHERE run_id=? A
6af0: 4e 44 20 28 73 74 72 66 74 69 6d 65 28 27 25 73 ND (strftime('%s
6b00: 27 2c 27 6e 6f 77 27 29 20 2d 20 65 76 65 6e 74 ','now') - event
6b10: 5f 74 69 6d 65 20 2d 20 72 75 6e 5f 64 75 72 61 _time - run_dura
6b20: 74 69 6f 6e 29 20 3e 20 3f 20 41 4e 44 20 73 74 tion) > ? AND st
6b30: 61 74 65 20 49 4e 20 28 27 52 55 4e 4e 49 4e 47 ate IN ('RUNNING
6b40: 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 ','REMOTEHOSTSTA
6b50: 52 54 27 29 3b 22 0a 09 72 75 6e 2d 69 64 20 64 RT');"..run-id d
6b60: 65 61 64 74 69 6d 65 29 0a 0a 20 20 20 20 20 20 eadtime)..
6b70: 20 3b 3b 20 69 6e 20 4c 41 55 4e 43 48 45 44 20 ;; in LAUNCHED
6b80: 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e for more than on
6b90: 65 20 64 61 79 2e 20 43 6f 75 6c 64 20 62 65 20 e day. Could be
6ba0: 6c 6f 6e 67 20 64 75 65 20 74 6f 20 6a 6f 62 20 long due to job
6bb0: 71 75 65 75 65 73 20 54 4f 44 4f 2f 42 55 47 3a queues TODO/BUG:
6bc0: 20 4e 65 65 64 20 6f 76 65 72 72 69 64 65 20 66 Need override f
6bd0: 6f 72 20 74 68 69 73 20 69 6e 20 63 6f 6e 66 69 or this in confi
6be0: 67 0a 20 20 20 20 20 20 20 3b 3b 0a 20 20 20 20 g. ;;.
6bf0: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
6c00: 65 61 63 68 2d 72 6f 77 0a 09 28 6c 61 6d 62 64 each-row..(lambd
6c10: 61 20 28 74 65 73 74 2d 69 64 29 0a 09 20 20 28 a (test-id).. (
6c20: 73 65 74 21 20 69 6e 63 6f 6d 70 6c 65 74 65 64 set! incompleted
6c30: 20 28 63 6f 6e 73 20 74 65 73 74 2d 69 64 20 69 (cons test-id i
6c40: 6e 63 6f 6d 70 6c 65 74 65 64 29 29 29 0a 09 64 ncompleted)))..d
6c50: 62 0a 09 22 53 45 4c 45 43 54 20 69 64 20 46 52 b.."SELECT id FR
6c60: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 OM tests WHERE r
6c70: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 28 73 74 72 un_id=? AND (str
6c80: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
6c90: 29 20 2d 20 65 76 65 6e 74 5f 74 69 6d 65 20 2d ) - event_time -
6ca0: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 29 20 3e run_duration) >
6cb0: 20 3f 20 41 4e 44 20 73 74 61 74 65 20 49 4e 20 ? AND state IN
6cc0: 28 27 4c 41 55 4e 43 48 45 44 27 29 3b 22 0a 09 ('LAUNCHED');"..
6cd0: 72 75 6e 2d 69 64 20 28 2a 20 36 30 20 36 30 20 run-id (* 60 60
6ce0: 32 34 29 29 29 0a 20 20 20 20 20 72 75 6e 2d 69 24))). run-i
6cf0: 64 73 29 0a 20 20 20 20 20 20 20 0a 20 20 20 20 ds). .
6d00: 3b 3b 20 54 68 65 73 65 20 61 72 65 20 64 65 66 ;; These are def
6d10: 75 6e 63 74 20 74 65 73 74 73 2c 20 64 6f 20 6e unct tests, do n
6d20: 6f 74 20 64 6f 20 61 6c 6c 20 74 68 65 20 6f 76 ot do all the ov
6d30: 65 72 68 65 61 64 20 6f 66 20 73 65 74 2d 73 74 erhead of set-st
6d40: 61 74 65 2d 73 74 61 74 75 73 2e 20 46 6f 72 63 ate-status. Forc
6d50: 65 20 74 68 65 6d 20 74 6f 20 49 4e 43 4f 4d 50 e them to INCOMP
6d60: 4c 45 54 45 2e 0a 20 20 20 20 3b 3b 0a 20 20 20 LETE.. ;;.
6d70: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
6d80: 69 6e 63 6f 6d 70 6c 65 74 65 64 29 20 30 29 0a incompleted) 0).
6d90: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
6da0: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
6db0: 4e 47 3a 20 4d 61 72 6b 69 6e 67 20 74 65 73 74 NG: Marking test
6dc0: 28 73 29 3b 20 22 20 28 73 74 72 69 6e 67 2d 69 (s); " (string-i
6dd0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
6de0: 63 6f 6e 63 20 69 6e 63 6f 6d 70 6c 65 74 65 64 conc incompleted
6df0: 29 20 22 2c 20 22 29 20 22 20 61 73 20 49 4e 43 ) ", ") " as INC
6e00: 4f 4d 50 4c 45 54 45 22 29 0a 09 20 20 28 73 71 OMPLETE").. (sq
6e10: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a 09 lite3:execute ..
6e20: 20 20 20 64 62 0a 09 20 20 20 28 63 6f 6e 63 20 db.. (conc
6e30: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
6e40: 54 20 73 74 61 74 65 3d 27 49 4e 43 4f 4d 50 4c T state='INCOMPL
6e50: 45 54 45 27 20 57 48 45 52 45 20 69 64 20 49 4e ETE' WHERE id IN
6e60: 20 28 22 20 0a 09 09 20 28 73 74 72 69 6e 67 2d (" ... (string-
6e70: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
6e80: 20 63 6f 6e 63 20 69 6e 63 6f 6d 70 6c 65 74 65 conc incomplete
6e90: 64 29 20 22 2c 22 29 0a 09 09 20 22 29 3b 22 29 d) ",")... ");")
6ea0: 29 29 29 29 29 0a 09 09 20 20 20 20 20 0a 3b 3b )))))... .;;
6eb0: 20 43 6c 65 61 6e 20 6f 75 74 20 6f 6c 64 20 6a Clean out old j
6ec0: 75 6e 6b 20 61 6e 64 20 76 61 63 75 75 6d 20 74 unk and vacuum t
6ed0: 68 65 20 64 61 74 61 62 61 73 65 0a 3b 3b 0a 3b he database.;;.;
6ee0: 3b 20 55 6c 74 69 6d 61 74 65 6c 79 20 64 6f 20 ; Ultimately do
6ef0: 73 6f 6d 65 74 68 69 6e 67 20 6c 69 6b 65 20 74 something like t
6f00: 68 69 73 3a 0a 3b 3b 0a 3b 3b 20 31 2e 20 4c 6f his:.;;.;; 1. Lo
6f10: 6f 6b 20 61 74 20 74 65 73 74 20 72 65 63 6f 72 ok at test recor
6f20: 64 73 20 65 69 74 68 65 72 20 64 65 6c 65 74 65 ds either delete
6f30: 64 20 6f 72 20 70 61 72 74 20 6f 66 20 64 65 6c d or part of del
6f40: 65 74 65 64 20 72 75 6e 3a 0a 3b 3b 20 20 20 20 eted run:.;;
6f50: 61 2e 20 49 66 20 74 65 73 74 20 64 69 72 20 65 a. If test dir e
6f60: 78 69 73 74 73 2c 20 73 65 74 20 74 68 65 20 74 xists, set the t
6f70: 68 65 20 74 65 73 74 20 74 6f 20 73 74 61 74 65 he test to state
6f80: 3d 27 55 4e 4b 4e 4f 57 4e 27 2c 20 53 65 74 20 ='UNKNOWN', Set
6f90: 74 68 65 20 72 75 6e 20 74 6f 20 27 75 6e 6b 6e the run to 'unkn
6fa0: 6f 77 6e 27 0a 3b 3b 20 20 20 20 62 2e 20 49 66 own'.;; b. If
6fb0: 20 74 65 73 74 20 64 69 72 20 67 6f 6e 65 2c 20 test dir gone,
6fc0: 64 65 6c 65 74 65 20 74 68 65 20 74 65 73 74 20 delete the test
6fd0: 72 65 63 6f 72 64 0a 3b 3b 20 32 2e 20 4c 6f 6f record.;; 2. Loo
6fe0: 6b 20 61 74 20 72 75 6e 20 72 65 63 6f 72 64 73 k at run records
6ff0: 0a 3b 3b 20 20 20 20 61 2e 20 49 66 20 68 61 76 .;; a. If hav
7000: 65 20 74 65 73 74 73 20 74 68 61 74 20 61 72 65 e tests that are
7010: 20 6e 6f 74 20 64 65 6c 65 74 65 64 2c 20 73 65 not deleted, se
7020: 74 20 73 74 61 74 65 3d 27 75 6e 6b 6e 6f 77 6e t state='unknown
7030: 27 0a 3b 3b 20 20 20 20 62 2e 20 2e 2e 2e 2e 0a '.;; b. .....
7040: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 63 ;;.(define (db:c
7050: 6c 65 61 6e 2d 75 70 20 64 62 73 74 72 75 63 74 lean-up dbstruct
7060: 29 0a 0a 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
7070: 74 20 30 20 22 45 52 52 4f 52 3a 20 64 62 20 63 t 0 "ERROR: db c
7080: 6c 65 61 6e 20 75 70 20 6e 6f 74 20 70 6f 72 74 lean up not port
7090: 65 64 20 79 65 74 22 29 0a 0a 20 20 28 6c 65 74 ed yet").. (let
70a0: 2a 20 28 28 64 62 20 20 20 20 20 20 20 20 20 28 * ((db (
70b0: 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 db:get-db dbstru
70c0: 63 74 20 23 66 29 29 0a 09 20 28 63 6f 75 6e 74 ct #f)).. (count
70d0: 2d 73 74 6d 74 20 28 73 71 6c 69 74 65 33 3a 70 -stmt (sqlite3:p
70e0: 72 65 70 61 72 65 20 64 62 20 22 53 45 4c 45 43 repare db "SELEC
70f0: 54 20 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 T (SELECT count(
7100: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 29 2b id) FROM tests)+
7110: 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
7120: 29 20 46 52 4f 4d 20 72 75 6e 73 29 3b 22 29 29 ) FROM runs);"))
7130: 0a 09 28 73 74 61 74 65 6d 65 6e 74 73 0a 09 20 ..(statements..
7140: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 73 74 (map (lambda (st
7150: 6d 74 29 0a 09 09 28 73 71 6c 69 74 65 33 3a 70 mt)...(sqlite3:p
7160: 72 65 70 61 72 65 20 64 62 20 73 74 6d 74 29 29 repare db stmt))
7170: 0a 09 20 20 20 20 20 20 28 6c 69 73 74 0a 09 20 .. (list..
7180: 20 20 20 20 20 20 3b 3b 20 64 65 6c 65 74 65 20 ;; delete
7190: 61 6c 6c 20 74 65 73 74 73 20 74 68 61 74 20 62 all tests that b
71a0: 65 6c 6f 6e 67 20 74 6f 20 72 75 6e 73 20 74 68 elong to runs th
71b0: 61 74 20 61 72 65 20 27 64 65 6c 65 74 65 64 27 at are 'deleted'
71c0: 0a 09 20 20 20 20 20 20 20 22 44 45 4c 45 54 45 .. "DELETE
71d0: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
71e0: 45 20 72 75 6e 5f 69 64 20 69 6e 20 28 53 45 4c E run_id in (SEL
71f0: 45 43 54 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 ECT id FROM runs
7200: 20 57 48 45 52 45 20 73 74 61 74 65 3d 27 64 65 WHERE state='de
7210: 6c 65 74 65 64 27 29 3b 22 0a 09 20 20 20 20 20 leted');"..
7220: 20 20 3b 3b 20 64 65 6c 65 74 65 20 61 6c 6c 20 ;; delete all
7230: 74 65 73 74 73 20 74 68 61 74 20 61 72 65 20 27 tests that are '
7240: 44 45 4c 45 54 45 44 27 0a 09 20 20 20 20 20 20 DELETED'..
7250: 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 "DELETE FROM te
7260: 73 74 73 20 57 48 45 52 45 20 73 74 61 74 65 3d sts WHERE state=
7270: 27 44 45 4c 45 54 45 44 27 3b 22 0a 09 20 20 20 'DELETED';"..
7280: 20 20 20 20 3b 3b 20 64 65 6c 65 74 65 20 61 6c ;; delete al
7290: 6c 20 74 65 73 74 73 20 74 68 61 74 20 68 61 76 l tests that hav
72a0: 65 20 6e 6f 20 72 75 6e 0a 09 20 20 20 20 20 20 e no run..
72b0: 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 74 65 "DELETE FROM te
72c0: 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 sts WHERE run_id
72d0: 20 4e 4f 54 20 49 4e 20 28 53 45 4c 45 43 54 20 NOT IN (SELECT
72e0: 44 49 53 54 49 4e 43 54 20 69 64 20 46 52 4f 4d DISTINCT id FROM
72f0: 20 72 75 6e 73 29 3b 22 0a 09 20 20 20 20 20 20 runs);"..
7300: 20 3b 3b 20 64 65 6c 65 74 65 20 61 6c 6c 20 72 ;; delete all r
7310: 75 6e 73 20 74 68 61 74 20 61 72 65 20 73 74 61 uns that are sta
7320: 74 65 3d 27 64 65 6c 65 74 65 64 27 0a 09 20 20 te='deleted'..
7330: 20 20 20 20 20 22 44 45 4c 45 54 45 20 46 52 4f "DELETE FRO
7340: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 73 74 61 M runs WHERE sta
7350: 74 65 3d 27 64 65 6c 65 74 65 64 27 3b 22 0a 09 te='deleted';"..
7360: 20 20 20 20 20 20 20 3b 3b 20 64 65 6c 65 74 65 ;; delete
7370: 20 65 6d 70 74 79 20 72 75 6e 73 0a 09 20 20 20 empty runs..
7380: 20 20 20 20 22 44 45 4c 45 54 45 20 46 52 4f 4d "DELETE FROM
7390: 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 20 4e runs WHERE id N
73a0: 4f 54 20 49 4e 20 28 53 45 4c 45 43 54 20 44 49 OT IN (SELECT DI
73b0: 53 54 49 4e 43 54 20 72 2e 69 64 20 46 52 4f 4d STINCT r.id FROM
73c0: 20 72 75 6e 73 20 41 53 20 72 20 49 4e 4e 45 52 runs AS r INNER
73d0: 20 4a 4f 49 4e 20 74 65 73 74 73 20 41 53 20 74 JOIN tests AS t
73e0: 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d 72 2e 69 ON t.run_id=r.i
73f0: 64 29 3b 22 0a 09 20 20 20 20 20 20 20 29 29 29 d);".. )))
7400: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 77 ). (sqlite3:w
7410: 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e 20 ith-transaction
7420: 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 28 6c . db. (l
7430: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
7440: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
7450: 68 2d 72 6f 77 20 28 6c 61 6d 62 64 61 20 28 74 h-row (lambda (t
7460: 6f 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 ot).... (d
7470: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
7480: 30 20 22 52 65 63 6f 72 64 73 20 63 6f 75 6e 74 0 "Records count
7490: 20 62 65 66 6f 72 65 20 63 6c 65 61 6e 3a 20 22 before clean: "
74a0: 20 74 6f 74 29 29 0a 09 09 09 20 20 20 20 20 63 tot)).... c
74b0: 6f 75 6e 74 2d 73 74 6d 74 29 0a 20 20 20 20 20 ount-stmt).
74c0: 20 20 28 6d 61 70 20 73 71 6c 69 74 65 33 3a 65 (map sqlite3:e
74d0: 78 65 63 75 74 65 20 73 74 61 74 65 6d 65 6e 74 xecute statement
74e0: 73 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 s). (sqlit
74f0: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
7500: 28 6c 61 6d 62 64 61 20 28 74 6f 74 29 0a 09 09 (lambda (tot)...
7510: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
7520: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 52 65 63 rint-info 0 "Rec
7530: 6f 72 64 73 20 63 6f 75 6e 74 20 61 66 74 65 72 ords count after
7540: 20 20 63 6c 65 61 6e 3a 20 22 20 74 6f 74 29 29 clean: " tot))
7550: 0a 09 09 09 20 20 20 20 20 63 6f 75 6e 74 2d 73 .... count-s
7560: 74 6d 74 29 29 29 0a 20 20 20 20 28 6d 61 70 20 tmt))). (map
7570: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
7580: 21 20 73 74 61 74 65 6d 65 6e 74 73 29 0a 20 20 ! statements).
7590: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
75a0: 69 7a 65 21 20 63 6f 75 6e 74 2d 73 74 6d 74 29 ize! count-stmt)
75b0: 0a 20 20 20 20 28 64 62 3a 66 69 6e 64 2d 61 6e . (db:find-an
75c0: 64 2d 6d 61 72 6b 2d 69 6e 63 6f 6d 70 6c 65 74 d-mark-incomplet
75d0: 65 20 64 62 29 0a 20 20 20 20 28 73 71 6c 69 74 e db). (sqlit
75e0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 56 e3:execute db "V
75f0: 41 43 55 55 4d 3b 22 29 29 29 0a 0a 3b 3b 3d 3d ACUUM;")))..;;==
7600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7640: 3d 3d 3d 3d 0a 3b 3b 20 4d 20 45 20 54 20 41 20 ====.;; M E T A
7650: 20 20 47 20 45 20 54 20 20 20 41 20 4e 20 44 20 G E T A N D
7660: 20 20 53 20 45 20 54 20 20 20 56 20 41 20 52 20 S E T V A R
7670: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
7680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
76b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 ==========..;; r
76c0: 65 74 75 72 6e 73 20 6e 75 6d 62 65 72 20 69 66 eturns number if
76d0: 20 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 string->number
76e0: 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 73 is successful, s
76f0: 74 72 69 6e 67 20 6f 74 68 65 72 77 69 73 65 0a tring otherwise.
7700: 3b 3b 20 61 6c 73 6f 20 75 70 64 61 74 65 73 20 ;; also updates
7710: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 0a 3b *global-delta*.;
7720: 3b 0a 3b 3b 20 4f 70 65 72 61 74 65 73 20 6f 6e ;.;; Operates on
7730: 20 6d 65 67 61 74 65 73 74 64 62 0a 3b 3b 0a 28 megatestdb.;;.(
7740: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 76 define (db:get-v
7750: 61 72 20 64 62 73 74 72 75 63 74 20 76 61 72 29 ar dbstruct var)
7760: 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 . (let* ((start
7770: 2d 6d 73 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c -ms (current-mil
7780: 6c 69 73 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 liseconds)).
7790: 20 20 20 20 20 28 74 68 72 6f 74 74 6c 65 20 28 (throttle (
77a0: 6c 65 74 20 28 28 74 20 20 28 63 6f 6e 66 69 67 let ((t (config
77b0: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
77c0: 61 74 2a 20 22 73 65 74 75 70 22 20 22 74 68 72 at* "setup" "thr
77d0: 6f 74 74 6c 65 22 29 29 29 0a 09 09 20 20 20 20 ottle")))...
77e0: 20 28 69 66 20 74 20 28 73 74 72 69 6e 67 2d 3e (if t (string->
77f0: 6e 75 6d 62 65 72 20 74 29 20 74 29 29 29 0a 09 number t) t)))..
7800: 20 28 72 65 73 20 20 20 20 20 20 23 66 29 29 0a (res #f)).
7810: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
7820: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
7830: 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a 20 20 20 lambda (val).
7840: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 76 61 (set! res va
7850: 6c 29 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 l)). (db:get
7860: 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 29 -db dbstruct #f)
7870: 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 76 61 . "SELECT va
7880: 6c 20 46 52 4f 4d 20 6d 65 74 61 64 61 74 20 57 l FROM metadat W
7890: 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 76 61 72 HERE var=?;" var
78a0: 29 0a 20 20 20 20 3b 3b 20 63 6f 6e 76 65 72 74 ). ;; convert
78b0: 20 74 6f 20 6e 75 6d 62 65 72 20 69 66 20 63 61 to number if ca
78c0: 6e 0a 20 20 20 20 28 69 66 20 28 73 74 72 69 6e n. (if (strin
78d0: 67 3f 20 72 65 73 29 0a 09 28 6c 65 74 20 28 28 g? res)..(let ((
78e0: 76 61 6c 6e 75 6d 20 28 73 74 72 69 6e 67 2d 3e valnum (string->
78f0: 6e 75 6d 62 65 72 20 72 65 73 29 29 29 0a 09 20 number res)))..
7900: 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 73 65 74 (if valnum (set
7910: 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 29 29 29 ! res valnum))))
7920: 0a 20 20 20 20 3b 3b 20 73 63 61 6c 65 20 62 79 . ;; scale by
7930: 20 31 30 2c 20 61 76 65 72 61 67 65 20 77 69 74 10, average wit
7940: 68 20 63 75 72 72 65 6e 74 20 76 61 6c 75 65 2e h current value.
7950: 0a 20 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 . (set! *glob
7960: 61 6c 2d 64 65 6c 74 61 2a 20 28 2f 20 28 2b 20 al-delta* (/ (+
7970: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 20 28 *global-delta* (
7980: 2a 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 * (- (current-mi
7990: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
79a0: 74 2d 6d 73 29 0a 09 09 09 09 09 09 20 28 69 66 t-ms)....... (if
79b0: 20 74 68 72 6f 74 74 6c 65 20 74 68 72 6f 74 74 throttle thrott
79c0: 6c 65 20 30 2e 30 31 29 29 29 0a 09 09 09 20 20 le 0.01)))....
79d0: 20 20 32 29 29 0a 20 20 20 20 28 69 66 20 28 3e 2)). (if (>
79e0: 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 74 2d 67 (abs (- *last-g
79f0: 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 72 69 6e lobal-delta-prin
7a00: 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c ted* *global-del
7a10: 74 61 2a 29 29 20 30 2e 30 38 29 20 3b 3b 20 64 ta*)) 0.08) ;; d
7a20: 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c 6c 20 74 on't print all t
7a30: 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 20 69 66 he time, only if
7a40: 20 69 74 20 63 68 61 6e 67 65 73 20 61 20 62 69 it changes a bi
7a50: 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 t..(begin.. (de
7a60: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
7a70: 20 22 6c 61 75 6e 63 68 20 74 68 72 6f 74 74 6c "launch throttl
7a80: 65 20 66 61 63 74 6f 72 3d 22 20 2a 67 6c 6f 62 e factor=" *glob
7a90: 61 6c 2d 64 65 6c 74 61 2a 29 0a 09 20 20 28 73 al-delta*).. (s
7aa0: 65 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c et! *last-global
7ab0: 2d 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 -delta-printed*
7ac0: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 *global-delta*))
7ad0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 ). res))..(de
7ae0: 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 76 61 72 fine (db:set-var
7af0: 20 64 62 73 74 72 75 63 74 20 76 61 72 20 76 61 dbstruct var va
7b00: 6c 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 l). (sqlite3:ex
7b10: 65 63 75 74 65 20 28 64 62 3a 67 65 74 2d 64 62 ecute (db:get-db
7b20: 20 64 62 73 74 72 75 63 74 20 23 66 29 20 22 49 dbstruct #f) "I
7b30: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
7b40: 20 49 4e 54 4f 20 6d 65 74 61 64 61 74 20 28 76 INTO metadat (v
7b50: 61 72 2c 76 61 6c 29 20 56 41 4c 55 45 53 20 28 ar,val) VALUES (
7b60: 3f 2c 3f 29 3b 22 20 76 61 72 20 76 61 6c 29 29 ?,?);" var val))
7b70: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 65 ..(define (db:de
7b80: 6c 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 76 l-var dbstruct v
7b90: 61 72 29 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 ar). (sqlite3:e
7ba0: 78 65 63 75 74 65 20 28 64 62 3a 67 65 74 2d 64 xecute (db:get-d
7bb0: 62 20 64 62 73 74 72 75 63 74 20 23 66 29 20 22 b dbstruct #f) "
7bc0: 44 45 4c 45 54 45 20 46 52 4f 4d 20 6d 65 74 61 DELETE FROM meta
7bd0: 64 61 74 20 57 48 45 52 45 20 76 61 72 3d 3f 3b dat WHERE var=?;
7be0: 22 20 76 61 72 29 29 0a 0a 3b 3b 20 75 73 65 20 " var))..;; use
7bf0: 61 20 67 6c 6f 62 61 6c 20 66 6f 72 20 73 6f 6d a global for som
7c00: 65 20 70 72 69 6d 69 74 69 76 65 20 63 61 63 68 e primitive cach
7c10: 69 6e 67 2c 20 69 74 20 69 73 20 6a 75 73 74 20 ing, it is just
7c20: 73 69 6c 6c 79 20 74 6f 0a 3b 3b 20 72 65 2d 72 silly to.;; re-r
7c30: 65 61 64 20 74 68 65 20 64 62 20 6f 76 65 72 20 ead the db over
7c40: 61 6e 64 20 6f 76 65 72 20 61 67 61 69 6e 20 66 and over again f
7c50: 6f 72 20 74 68 65 20 6b 65 79 73 20 73 69 6e 63 or the keys sinc
7c60: 65 20 74 68 65 79 20 6e 65 76 65 72 0a 3b 3b 20 e they never.;;
7c70: 63 68 61 6e 67 65 0a 0a 3b 3b 20 77 68 79 20 67 change..;; why g
7c80: 65 74 20 74 68 65 20 6b 65 79 73 20 66 72 6f 6d et the keys from
7c90: 20 74 68 65 20 64 62 3f 20 77 68 79 20 6e 6f 74 the db? why not
7ca0: 20 67 65 74 20 66 72 6f 6d 20 74 68 65 20 2a 63 get from the *c
7cb0: 6f 6e 66 69 67 64 61 74 2a 0a 3b 3b 20 75 73 69 onfigdat*.;; usi
7cc0: 6e 67 20 6b 65 79 73 3a 63 6f 6e 66 69 67 2d 67 ng keys:config-g
7cd0: 65 74 2d 66 69 65 6c 64 73 3f 0a 0a 28 64 65 66 et-fields?..(def
7ce0: 69 6e 65 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 ine (db:get-keys
7cf0: 20 64 62 73 74 72 75 63 74 29 0a 20 20 28 69 66 dbstruct). (if
7d00: 20 2a 64 62 2d 6b 65 79 73 2a 20 2a 64 62 2d 6b *db-keys* *db-k
7d10: 65 79 73 2a 20 0a 20 20 20 20 20 20 28 6c 65 74 eys* . (let
7d20: 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 28 73 ((res '()))..(s
7d30: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
7d40: 72 6f 77 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 row .. (lambda (
7d50: 6b 65 79 29 0a 09 20 20 20 28 73 65 74 21 20 72 key).. (set! r
7d60: 65 73 20 28 63 6f 6e 73 20 6b 65 79 20 72 65 73 es (cons key res
7d70: 29 29 29 0a 09 20 28 64 62 3a 67 65 74 2d 64 62 ))).. (db:get-db
7d80: 20 64 62 73 74 72 75 63 74 20 23 66 29 0a 09 20 dbstruct #f)..
7d90: 22 53 45 4c 45 43 54 20 66 69 65 6c 64 6e 61 6d "SELECT fieldnam
7da0: 65 20 46 52 4f 4d 20 6b 65 79 73 20 4f 52 44 45 e FROM keys ORDE
7db0: 52 20 42 59 20 69 64 20 44 45 53 43 3b 22 29 0a R BY id DESC;").
7dc0: 09 28 73 65 74 21 20 2a 64 62 2d 6b 65 79 73 2a .(set! *db-keys*
7dd0: 20 72 65 73 29 0a 09 72 65 73 29 29 29 0a 0a 3b res)..res)))..;
7de0: 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 ; .(define (db:g
7df0: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
7e00: 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 66 69 er row header fi
7e10: 65 6c 64 29 0a 20 20 28 64 65 62 75 67 3a 70 72 eld). (debug:pr
7e20: 69 6e 74 2d 69 6e 66 6f 20 34 20 22 64 62 3a 67 int-info 4 "db:g
7e30: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
7e40: 65 72 20 72 6f 77 3a 20 22 20 72 6f 77 20 22 20 er row: " row "
7e50: 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 header: " header
7e60: 20 22 20 66 69 65 6c 64 3a 20 22 20 66 69 65 6c " field: " fiel
7e70: 64 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 d). (if (null?
7e80: 68 65 61 64 65 72 29 20 23 66 0a 20 20 20 20 20 header) #f.
7e90: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
7ea0: 20 28 63 61 72 20 68 65 61 64 65 72 29 29 0a 09 (car header))..
7eb0: 09 20 28 74 61 6c 20 28 63 64 72 20 68 65 61 64 . (tal (cdr head
7ec0: 65 72 29 29 0a 09 09 20 28 6e 20 20 20 30 29 29 er))... (n 0))
7ed0: 0a 09 28 69 66 20 28 65 71 75 61 6c 3f 20 68 65 ..(if (equal? he
7ee0: 64 20 66 69 65 6c 64 29 0a 09 20 20 20 20 28 76 d field).. (v
7ef0: 65 63 74 6f 72 2d 72 65 66 20 72 6f 77 20 6e 29 ector-ref row n)
7f00: 0a 09 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f .. (if (null?
7f10: 20 74 61 6c 29 20 23 66 20 28 6c 6f 6f 70 20 28 tal) #f (loop (
7f20: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
7f30: 29 28 2b 20 6e 20 31 29 29 29 29 29 29 29 0a 0a )(+ n 1)))))))..
7f40: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
7f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 52 20 55 ========.;; R U
7f90: 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d N S.;;=========
7fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 =============..(
7fe0: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 define (db:get-r
7ff0: 75 6e 2d 6e 61 6d 65 2d 66 72 6f 6d 2d 69 64 20 un-name-from-id
8000: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 dbstruct run-id)
8010: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 . (let ((res #f
8020: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
8030: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
8040: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 6e 61 (lambda (runna
8050: 6d 65 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 me). (set!
8060: 20 72 65 73 20 72 75 6e 6e 61 6d 65 29 29 0a 20 res runname)).
8070: 20 20 20 20 28 64 62 3a 67 65 74 2d 64 62 20 64 (db:get-db d
8080: 62 73 74 72 75 63 74 20 23 66 29 0a 20 20 20 20 bstruct #f).
8090: 20 22 53 45 4c 45 43 54 20 72 75 6e 6e 61 6d 65 "SELECT runname
80a0: 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 FROM runs WHERE
80b0: 20 69 64 3d 3f 3b 22 0a 20 20 20 20 20 72 75 6e id=?;". run
80c0: 2d 69 64 29 0a 20 20 20 20 72 65 73 29 29 0a 0a -id). res))..
80d0: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
80e0: 72 75 6e 2d 6b 65 79 2d 76 61 6c 20 64 62 73 74 run-key-val dbst
80f0: 72 75 63 74 20 72 75 6e 2d 69 64 20 6b 65 79 29 ruct run-id key)
8100: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 . (let ((res #f
8110: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
8120: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
8130: 20 20 28 6c 61 6d 62 64 61 20 28 76 61 6c 29 0a (lambda (val).
8140: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
8150: 20 76 61 6c 29 29 0a 20 20 20 20 20 28 64 62 3a val)). (db:
8160: 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 get-db dbstruct
8170: 23 66 29 20 0a 20 20 20 20 20 28 63 6f 6e 63 20 #f) . (conc
8180: 22 53 45 4c 45 43 54 20 22 20 6b 65 79 20 22 20 "SELECT " key "
8190: 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 FROM runs WHERE
81a0: 69 64 3d 3f 3b 22 29 0a 20 20 20 20 20 72 75 6e id=?;"). run
81b0: 2d 69 64 29 0a 20 20 20 20 72 65 73 29 29 0a 0a -id). res))..
81c0: 3b 3b 20 6b 65 79 73 20 6c 69 73 74 20 74 6f 20 ;; keys list to
81d0: 6b 65 79 31 2c 6b 65 79 32 2c 6b 65 79 33 20 2e key1,key2,key3 .
81e0: 2e 2e 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 73 ...(define (runs
81f0: 3a 67 65 74 2d 73 74 64 2d 72 75 6e 2d 66 69 65 :get-std-run-fie
8200: 6c 64 73 20 6b 65 79 73 20 72 65 6d 66 69 65 6c lds keys remfiel
8210: 64 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 68 65 ds). (let* ((he
8220: 61 64 65 72 20 20 20 20 28 61 70 70 65 6e 64 20 ader (append
8230: 6b 65 79 73 20 72 65 6d 66 69 65 6c 64 73 29 29 keys remfields))
8240: 0a 09 20 28 6b 65 79 73 74 72 20 20 20 20 28 63 .. (keystr (c
8250: 6f 6e 63 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 onc (keys->keyst
8260: 72 20 6b 65 79 73 29 20 22 2c 22 0a 09 09 09 20 r keys) ","....
8270: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
8280: 65 72 73 65 20 72 65 6d 66 69 65 6c 64 73 20 22 erse remfields "
8290: 2c 22 29 29 29 29 0a 20 20 20 20 28 6c 69 73 74 ,")))). (list
82a0: 20 6b 65 79 73 74 72 20 68 65 61 64 65 72 29 29 keystr header))
82b0: 29 0a 0a 3b 3b 20 6d 61 6b 65 20 61 20 71 75 65 )..;; make a que
82c0: 72 79 20 28 66 69 65 6c 64 6e 61 6d 65 20 6c 69 ry (fieldname li
82d0: 6b 65 20 27 70 61 74 74 31 27 20 4f 52 20 66 69 ke 'patt1' OR fi
82e0: 65 6c 64 6e 61 6d 65 20 0a 28 64 65 66 69 6e 65 eldname .(define
82f0: 20 28 64 62 3a 70 61 74 74 2d 3e 6c 69 6b 65 20 (db:patt->like
8300: 66 69 65 6c 64 6e 61 6d 65 20 70 61 74 74 73 74 fieldname pattst
8310: 72 20 23 21 6b 65 79 20 28 63 6f 6d 70 61 72 61 r #!key (compara
8320: 74 6f 72 20 22 20 4f 52 20 22 29 29 0a 20 20 28 tor " OR ")). (
8330: 6c 65 74 20 28 28 70 61 74 74 73 20 28 69 66 20 let ((patts (if
8340: 28 73 74 72 69 6e 67 3f 20 70 61 74 74 73 74 72 (string? pattstr
8350: 29 0a 09 09 20 20 20 28 73 74 72 69 6e 67 2d 73 )... (string-s
8360: 70 6c 69 74 20 70 61 74 74 73 74 72 20 22 2c 22 plit pattstr ","
8370: 29 0a 09 09 20 20 20 27 28 22 25 22 29 29 29 29 )... '("%"))))
8380: 0a 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 . (string-int
8390: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
83a0: 61 6d 62 64 61 20 28 70 61 74 74 29 0a 09 09 09 ambda (patt)....
83b0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 77 69 (let ((wi
83c0: 6c 64 74 79 70 65 20 28 69 66 20 28 73 75 62 73 ldtype (if (subs
83d0: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 25 22 20 tring-index "%"
83e0: 70 61 74 74 29 20 22 4c 49 4b 45 22 20 22 47 4c patt) "LIKE" "GL
83f0: 4f 42 22 29 29 29 0a 09 09 09 09 20 28 63 6f 6e OB")))..... (con
8400: 63 20 66 69 65 6c 64 6e 61 6d 65 20 22 20 22 20 c fieldname " "
8410: 77 69 6c 64 74 79 70 65 20 22 20 27 22 20 70 61 wildtype " '" pa
8420: 74 74 20 22 27 22 29 29 29 0a 09 09 09 20 20 20 tt "'")))....
8430: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 74 (if (null? pat
8440: 74 73 29 0a 09 09 09 09 20 27 28 22 22 29 0a 09 ts)..... '("")..
8450: 09 09 09 20 70 61 74 74 73 29 29 0a 09 09 09 63 ... patts))....c
8460: 6f 6d 70 61 72 61 74 6f 72 29 29 29 0a 0a 0a 3b omparator)))...;
8470: 3b 20 72 65 67 69 73 74 65 72 20 61 20 74 65 73 ; register a tes
8480: 74 20 72 75 6e 20 77 69 74 68 20 74 68 65 20 64 t run with the d
8490: 62 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 72 65 b.(define (db:re
84a0: 67 69 73 74 65 72 2d 72 75 6e 20 64 62 73 74 72 gister-run dbstr
84b0: 75 63 74 20 6b 65 79 76 61 6c 73 20 72 75 6e 6e uct keyvals runn
84c0: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
84d0: 20 75 73 65 72 29 0a 20 20 28 64 65 62 75 67 3a user). (debug:
84e0: 70 72 69 6e 74 20 33 20 22 72 75 6e 73 3a 72 65 print 3 "runs:re
84f0: 67 69 73 74 65 72 2d 72 75 6e 20 72 75 6e 6e 61 gister-run runna
8500: 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 me: " runname "
8510: 73 74 61 74 65 3a 20 22 20 73 74 61 74 65 20 22 state: " state "
8520: 20 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 status: " statu
8530: 73 20 22 20 75 73 65 72 3a 20 22 20 75 73 65 72 s " user: " user
8540: 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 62 20 20 ). (let* ((db
8550: 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 64 62 (db:get-db
8560: 20 64 62 73 74 72 75 63 74 20 23 66 29 29 0a 09 dbstruct #f))..
8570: 20 28 6b 65 79 73 20 20 20 20 20 20 28 6d 61 70 (keys (map
8580: 20 63 61 72 20 6b 65 79 76 61 6c 73 29 29 0a 09 car keyvals))..
8590: 20 28 6b 65 79 73 74 72 20 20 20 20 28 6b 65 79 (keystr (key
85a0: 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 29 s->keystr keys))
85b0: 09 20 0a 09 20 28 63 6f 6d 6d 61 20 20 20 20 20 . .. (comma
85c0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b (if (> (length k
85d0: 65 79 73 29 20 30 29 20 22 2c 22 20 22 22 29 29 eys) 0) "," ""))
85e0: 0a 09 20 28 61 6e 64 73 74 72 20 20 20 20 28 69 .. (andstr (i
85f0: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 6b 65 79 f (> (length key
8600: 73 29 20 30 29 20 22 20 41 4e 44 20 22 20 22 22 s) 0) " AND " ""
8610: 29 29 0a 09 20 28 76 61 6c 73 6c 6f 74 73 20 20 )).. (valslots
8620: 28 6b 65 79 73 2d 3e 76 61 6c 73 6c 6f 74 73 20 (keys->valslots
8630: 6b 65 79 73 29 29 20 3b 3b 20 3f 2c 3f 2c 3f 20 keys)) ;; ?,?,?
8640: 2e 2e 2e 0a 09 20 28 61 6c 6c 76 61 6c 73 20 20 ..... (allvals
8650: 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 (append (list r
8660: 75 6e 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 unname state sta
8670: 74 75 73 20 75 73 65 72 29 20 28 6d 61 70 20 63 tus user) (map c
8680: 61 64 72 20 6b 65 79 76 61 6c 73 29 29 29 0a 09 adr keyvals)))..
8690: 20 28 71 72 79 76 61 6c 73 20 20 20 28 61 70 70 (qryvals (app
86a0: 65 6e 64 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d end (list runnam
86b0: 65 29 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 e) (map cadr key
86c0: 76 61 6c 73 29 29 29 0a 09 20 28 6b 65 79 3d 3f vals))).. (key=?
86d0: 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 str (string-int
86e0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
86f0: 61 6d 62 64 61 20 28 6b 29 28 63 6f 6e 63 20 6b ambda (k)(conc k
8700: 20 22 3d 3f 22 29 29 20 6b 65 79 73 29 20 22 20 "=?")) keys) "
8710: 41 4e 44 20 22 29 29 29 0a 20 20 20 20 28 64 65 AND "))). (de
8720: 62 75 67 3a 70 72 69 6e 74 20 33 20 22 6b 65 79 bug:print 3 "key
8730: 73 3a 20 22 20 6b 65 79 73 20 22 20 61 6c 6c 76 s: " keys " allv
8740: 61 6c 73 3a 20 22 20 61 6c 6c 76 61 6c 73 20 22 als: " allvals "
8750: 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 76 keyvals: " keyv
8760: 61 6c 73 20 22 20 6b 65 79 3d 3f 73 74 72 20 69 als " key=?str i
8770: 73 20 22 20 6b 65 79 3d 3f 73 74 72 29 0a 20 20 s " key=?str).
8780: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
8790: 20 22 4e 4f 54 45 3a 20 75 73 69 6e 67 20 74 61 "NOTE: using ta
87a0: 72 67 65 74 20 22 20 28 73 74 72 69 6e 67 2d 69 rget " (string-i
87b0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
87c0: 63 61 64 72 20 6b 65 79 76 61 6c 73 29 20 22 2f cadr keyvals) "/
87d0: 22 29 20 22 20 66 6f 72 20 74 68 69 73 20 72 75 ") " for this ru
87e0: 6e 22 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 n"). (if (and
87f0: 20 72 75 6e 6e 61 6d 65 20 28 6e 75 6c 6c 3f 20 runname (null?
8800: 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 20 (filter (lambda
8810: 28 78 29 28 6e 6f 74 20 78 29 29 20 6b 65 79 76 (x)(not x)) keyv
8820: 61 6c 73 29 29 29 20 3b 3b 20 74 68 65 72 65 20 als))) ;; there
8830: 6d 75 73 74 20 62 65 20 61 20 62 65 74 74 65 72 must be a better
8840: 20 77 61 79 20 74 6f 20 22 61 70 70 6c 79 20 61 way to "apply a
8850: 6e 64 22 0a 09 28 6c 65 74 20 28 28 72 65 73 20 nd"..(let ((res
8860: 23 66 29 29 0a 09 20 20 28 61 70 70 6c 79 20 73 #f)).. (apply s
8870: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
8880: 62 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 54 20 b (conc "INSERT
8890: 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 72 OR IGNORE INTO r
88a0: 75 6e 73 20 28 72 75 6e 6e 61 6d 65 2c 73 74 61 uns (runname,sta
88b0: 74 65 2c 73 74 61 74 75 73 2c 6f 77 6e 65 72 2c te,status,owner,
88c0: 65 76 65 6e 74 5f 74 69 6d 65 22 20 63 6f 6d 6d event_time" comm
88d0: 61 20 6b 65 79 73 74 72 20 22 29 20 56 41 4c 55 a keystr ") VALU
88e0: 45 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 ES (?,?,?,?,strf
88f0: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
8900: 22 20 63 6f 6d 6d 61 20 76 61 6c 73 6c 6f 74 73 " comma valslots
8910: 20 22 29 3b 22 29 0a 09 09 20 61 6c 6c 76 61 6c ");")... allval
8920: 73 29 0a 09 20 20 28 61 70 70 6c 79 20 73 71 6c s).. (apply sql
8930: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
8940: 77 20 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 69 w ... (lambda (i
8950: 64 29 0a 09 09 20 20 20 28 73 65 74 21 20 72 65 d)... (set! re
8960: 73 20 69 64 29 29 0a 09 09 20 64 62 0a 09 09 20 s id))... db...
8970: 28 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 (let ((qry (conc
8980: 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d "SELECT id FROM
8990: 20 72 75 6e 73 20 57 48 45 52 45 20 28 72 75 6e runs WHERE (run
89a0: 6e 61 6d 65 3d 3f 20 22 20 61 6e 64 73 74 72 20 name=? " andstr
89b0: 6b 65 79 3d 3f 73 74 72 20 22 29 3b 22 29 29 29 key=?str ");")))
89c0: 0a 09 09 09 09 09 3b 28 64 65 62 75 67 3a 70 72 ......;(debug:pr
89d0: 69 6e 74 20 34 20 22 71 72 79 3a 20 22 20 71 72 int 4 "qry: " qr
89e0: 79 29 20 0a 09 09 20 20 20 71 72 79 29 0a 09 09 y) ... qry)...
89f0: 20 71 72 79 76 61 6c 73 29 0a 09 20 20 28 73 71 qryvals).. (sq
8a00: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
8a10: 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 "UPDATE runs SE
8a20: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 T state=?,status
8a30: 3d 3f 2c 65 76 65 6e 74 5f 74 69 6d 65 3d 73 74 =?,event_time=st
8a40: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
8a50: 27 29 20 57 48 45 52 45 20 69 64 3d 3f 20 41 4e ') WHERE id=? AN
8a60: 44 20 73 74 61 74 65 3d 27 64 65 6c 65 74 65 64 D state='deleted
8a70: 27 3b 22 20 73 74 61 74 65 20 73 74 61 74 75 73 ';" state status
8a80: 20 72 65 73 29 0a 09 20 20 72 65 73 29 20 0a 09 res).. res) ..
8a90: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
8aa0: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
8ab0: 20 43 61 6c 6c 65 64 20 77 69 74 68 6f 75 74 20 Called without
8ac0: 61 6c 6c 20 6e 65 63 65 73 73 61 72 79 20 6b 65 all necessary ke
8ad0: 79 73 22 29 0a 09 20 20 23 66 29 29 29 29 0a 0a ys").. #f))))..
8ae0: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
8af0: 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 64 62 29 0a all-run-ids db).
8b00: 20 20 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 (let ((res '()
8b10: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
8b20: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
8b30: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 (lambda (run-i
8b40: 64 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 d). (set!
8b50: 72 65 73 20 28 63 6f 6e 73 20 72 75 6e 2d 69 64 res (cons run-id
8b60: 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 res))). db
8b70: 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 44 49 . "SELECT DI
8b80: 53 54 49 4e 43 54 20 72 75 6e 5f 69 64 20 46 52 STINCT run_id FR
8b90: 4f 4d 20 74 65 73 74 73 3b 22 29 0a 20 20 20 20 OM tests;").
8ba0: 72 65 73 29 29 0a 0a 3b 3b 20 72 65 70 6c 61 63 res))..;; replac
8bb0: 65 20 68 65 61 64 65 72 20 61 6e 64 20 6b 65 79 e header and key
8bc0: 73 74 72 20 77 69 74 68 20 61 20 63 61 6c 6c 20 str with a call
8bd0: 74 6f 20 72 75 6e 73 3a 67 65 74 2d 73 74 64 2d to runs:get-std-
8be0: 72 75 6e 2d 66 69 65 6c 64 73 0a 3b 3b 0a 3b 3b run-fields.;;.;;
8bf0: 20 6b 65 79 70 61 74 74 73 3a 20 28 20 28 4b 45 keypatts: ( (KE
8c00: 59 31 20 22 61 62 63 25 64 65 66 22 29 28 4b 45 Y1 "abc%def")(KE
8c10: 59 32 20 22 25 22 29 20 29 0a 3b 3b 20 72 75 6e Y2 "%") ).;; run
8c20: 70 61 74 74 73 3a 20 70 61 74 74 31 2c 70 61 74 patts: patt1,pat
8c30: 74 32 20 2e 2e 2e 0a 3b 3b 0a 28 64 65 66 69 6e t2 ....;;.(defin
8c40: 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 20 64 e (db:get-runs d
8c50: 62 20 72 75 6e 70 61 74 74 20 63 6f 75 6e 74 20 b runpatt count
8c60: 6f 66 66 73 65 74 20 6b 65 79 70 61 74 74 73 29 offset keypatts)
8c70: 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 . (let* ((res
8c80: 20 20 20 20 20 27 28 29 29 0a 09 20 28 6b 65 79 '()).. (key
8c90: 73 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d s (db:get-
8ca0: 6b 65 79 73 20 64 62 29 29 0a 09 20 28 72 75 6e keys db)).. (run
8cb0: 70 61 74 74 73 74 72 20 28 64 62 3a 70 61 74 74 pattstr (db:patt
8cc0: 2d 3e 6c 69 6b 65 20 22 72 75 6e 6e 61 6d 65 22 ->like "runname"
8cd0: 20 72 75 6e 70 61 74 74 29 29 0a 09 20 28 72 65 runpatt)).. (re
8ce0: 6d 66 69 65 6c 64 73 20 20 28 6c 69 73 74 20 22 mfields (list "
8cf0: 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 id" "runname" "s
8d00: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
8d10: 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 owner" "event_ti
8d20: 6d 65 22 29 29 0a 09 20 28 68 65 61 64 65 72 20 me")).. (header
8d30: 20 20 20 20 28 61 70 70 65 6e 64 20 6b 65 79 73 (append keys
8d40: 20 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 20 28 remfields)).. (
8d50: 6b 65 79 73 74 72 20 20 20 20 20 28 63 6f 6e 63 keystr (conc
8d60: 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 6b (keys->keystr k
8d70: 65 79 73 29 20 22 2c 22 0a 09 09 20 20 20 20 20 eys) ","...
8d80: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
8d90: 74 65 72 73 70 65 72 73 65 20 72 65 6d 66 69 65 tersperse remfie
8da0: 6c 64 73 20 22 2c 22 29 29 29 0a 09 20 28 71 72 lds ","))).. (qr
8db0: 79 73 74 72 20 20 20 20 20 28 63 6f 6e 63 20 22 ystr (conc "
8dc0: 53 45 4c 45 43 54 20 22 20 6b 65 79 73 74 72 20 SELECT " keystr
8dd0: 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 " FROM runs WHER
8de0: 45 20 28 22 20 72 75 6e 70 61 74 74 73 74 72 20 E (" runpattstr
8df0: 22 29 20 22 20 3b 3b 20 72 75 6e 6e 61 6d 65 20 ") " ;; runname
8e00: 4c 49 4b 45 20 3f 20 22 0a 09 09 20 20 20 20 20 LIKE ? "...
8e10: 20 20 20 20 20 20 3b 3b 20 47 65 6e 65 72 61 74 ;; Generat
8e20: 65 3a 20 22 20 41 4e 44 20 78 20 4c 49 4b 45 20 e: " AND x LIKE
8e30: 27 6b 65 79 70 61 74 74 27 20 2e 2e 2e 22 0a 09 'keypatt' ..."..
8e40: 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 . (if
8e50: 28 6e 75 6c 6c 3f 20 6b 65 79 70 61 74 74 73 29 (null? keypatts)
8e60: 20 22 22 0a 09 09 20 20 20 20 20 20 20 20 20 20 ""...
8e70: 20 20 20 20 20 28 63 6f 6e 63 20 22 20 41 4e 44 (conc " AND
8e80: 20 22 0a 09 09 09 09 20 20 20 20 20 28 73 74 72 "..... (str
8e90: 69 6e 67 2d 6a 6f 69 6e 20 0a 09 09 09 09 20 20 ing-join .....
8ea0: 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 (map (lambda
8eb0: 20 28 6b 65 79 70 61 74 74 29 0a 09 09 09 09 09 (keypatt)......
8ec0: 20 20 20 20 20 28 6c 65 74 20 28 28 6b 65 79 20 (let ((key
8ed0: 20 28 63 61 72 20 6b 65 79 70 61 74 74 29 29 0a (car keypatt)).
8ee0: 09 09 09 09 09 09 20 20 20 28 70 61 74 74 20 28 ...... (patt (
8ef0: 63 61 64 72 20 6b 65 79 70 61 74 74 29 29 29 0a cadr keypatt))).
8f00: 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 3a ..... (db:
8f10: 70 61 74 74 2d 3e 6c 69 6b 65 20 6b 65 79 20 70 patt->like key p
8f20: 61 74 74 29 29 29 0a 09 09 09 09 09 20 20 20 6b att)))...... k
8f30: 65 79 70 61 74 74 73 29 0a 09 09 09 09 20 20 20 eypatts).....
8f40: 20 20 20 22 20 41 4e 44 20 22 29 29 29 0a 09 09 " AND ")))...
8f50: 20 20 20 20 20 20 20 20 20 20 20 22 20 41 4e 44 " AND
8f60: 20 73 74 61 74 65 20 21 3d 20 27 64 65 6c 65 74 state != 'delet
8f70: 65 64 27 20 4f 52 44 45 52 20 42 59 20 65 76 65 ed' ORDER BY eve
8f80: 6e 74 5f 74 69 6d 65 20 44 45 53 43 20 22 0a 09 nt_time DESC "..
8f90: 09 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 . (if
8fa0: 28 6e 75 6d 62 65 72 3f 20 63 6f 75 6e 74 29 0a (number? count).
8fb0: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
8fc0: 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 22 (conc " LIMIT "
8fd0: 20 63 6f 75 6e 74 29 0a 09 09 20 20 20 20 20 20 count)...
8fe0: 20 20 20 20 20 20 20 20 20 22 22 29 0a 09 09 20 "")...
8ff0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
9000: 75 6d 62 65 72 3f 20 6f 66 66 73 65 74 29 0a 09 umber? offset)..
9010: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9020: 28 63 6f 6e 63 20 22 20 4f 46 46 53 45 54 20 22 (conc " OFFSET "
9030: 20 6f 66 66 73 65 74 29 0a 09 09 20 20 20 20 20 offset)...
9040: 20 20 20 20 20 20 20 20 20 20 22 22 29 29 29 29 ""))))
9050: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
9060: 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 t-info 11 "db:ge
9070: 74 2d 72 75 6e 73 20 53 54 41 52 54 20 71 72 79 t-runs START qry
9080: 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 20 str: " qrystr "
9090: 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 79 70 keypatts: " keyp
90a0: 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a 20 22 atts " offset: "
90b0: 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 74 3a offset " limit:
90c0: 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 28 73 " count). (s
90d0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
90e0: 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 row. (lambda
90f0: 20 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 20 (a . x).
9100: 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 (set! res (cons
9110: 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 (apply vector a
9120: 78 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 x) res))). d
9130: 62 0a 20 20 20 20 20 71 72 79 73 74 72 0a 20 20 b. qrystr.
9140: 20 20 20 29 0a 20 20 20 20 28 64 65 62 75 67 3a ). (debug:
9150: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 print-info 11 "d
9160: 62 3a 67 65 74 2d 72 75 6e 73 20 45 4e 44 20 71 b:get-runs END q
9170: 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 rystr: " qrystr
9180: 22 20 6b 65 79 70 61 74 74 73 3a 20 22 20 6b 65 " keypatts: " ke
9190: 79 70 61 74 74 73 20 22 20 6f 66 66 73 65 74 3a ypatts " offset:
91a0: 20 22 20 6f 66 66 73 65 74 20 22 20 6c 69 6d 69 " offset " limi
91b0: 74 3a 20 22 20 63 6f 75 6e 74 29 0a 20 20 20 20 t: " count).
91c0: 28 76 65 63 74 6f 72 20 68 65 61 64 65 72 20 72 (vector header r
91d0: 65 73 29 29 29 0a 0a 3b 3b 20 47 65 74 20 61 6c es)))..;; Get al
91e0: 6c 20 74 61 72 67 65 74 73 20 66 72 6f 6d 20 74 l targets from t
91f0: 68 65 20 64 62 0a 3b 3b 0a 28 64 65 66 69 6e 65 he db.;;.(define
9200: 20 28 64 62 3a 67 65 74 2d 74 61 72 67 65 74 73 (db:get-targets
9210: 20 64 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 dbstruct). (le
9220: 74 2a 20 28 28 72 65 73 20 20 20 20 20 20 20 27 t* ((res '
9230: 28 29 29 0a 09 20 28 6b 65 79 73 20 20 20 20 20 ()).. (keys
9240: 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 (db:get-keys d
9250: 62 73 74 72 75 63 74 29 29 0a 09 20 28 68 65 61 bstruct)).. (hea
9260: 64 65 72 20 20 20 20 20 6b 65 79 73 29 20 3b 3b der keys) ;;
9270: 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 69 (map key:get-fi
9280: 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a 09 eldname keys))..
9290: 20 28 6b 65 79 73 74 72 20 20 20 20 20 28 6b 65 (keystr (ke
92a0: 79 73 2d 3e 6b 65 79 73 74 72 20 6b 65 79 73 29 ys->keystr keys)
92b0: 29 0a 09 20 28 71 72 79 73 74 72 20 20 20 20 20 ).. (qrystr
92c0: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 (conc "SELECT "
92d0: 6b 65 79 73 74 72 20 22 20 46 52 4f 4d 20 72 75 keystr " FROM ru
92e0: 6e 73 3b 22 29 29 0a 09 20 28 73 65 65 6e 20 20 ns;")).. (seen
92f0: 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d (make-hash-
9300: 74 61 62 6c 65 29 29 29 0a 20 20 20 20 28 73 71 table))). (sq
9310: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
9320: 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ow. (lambda
9330: 28 61 20 2e 20 78 29 0a 20 20 20 20 20 20 20 28 (a . x). (
9340: 6c 65 74 20 28 28 74 61 72 67 20 28 63 6f 6e 73 let ((targ (cons
9350: 20 61 20 78 29 29 29 0a 09 20 28 69 66 20 28 6e a x))).. (if (n
9360: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ot (hash-table-r
9370: 65 66 2f 64 65 66 61 75 6c 74 20 73 65 65 6e 20 ef/default seen
9380: 74 61 72 67 20 23 66 29 29 0a 09 20 20 20 20 20 targ #f))..
9390: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 28 (begin.. (
93a0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
93b0: 73 65 65 6e 20 74 61 72 67 20 23 74 29 0a 09 20 seen targ #t)..
93c0: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
93d0: 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 (cons (apply vec
93e0: 74 6f 72 20 74 61 72 67 29 20 72 65 73 29 29 29 tor targ) res)))
93f0: 29 29 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 ))). (db:get
9400: 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 29 -db dbstruct #f)
9410: 0a 20 20 20 20 20 71 72 79 73 74 72 29 0a 20 20 . qrystr).
9420: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
9430: 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 2d 74 nfo 11 "db:get-t
9440: 61 72 67 65 74 73 20 45 4e 44 20 71 72 79 73 74 argets END qryst
9450: 72 3a 20 22 20 71 72 79 73 74 72 20 29 0a 20 20 r: " qrystr ).
9460: 20 20 28 76 65 63 74 6f 72 20 68 65 61 64 65 72 (vector header
9470: 20 72 65 73 29 29 29 0a 0a 3b 3b 20 6a 75 73 74 res)))..;; just
9480: 20 67 65 74 20 63 6f 75 6e 74 20 6f 66 20 72 75 get count of ru
9490: 6e 73 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 ns.(define (db:g
94a0: 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 64 62 73 74 et-num-runs dbst
94b0: 72 75 63 74 20 72 75 6e 70 61 74 74 29 0a 20 20 ruct runpatt).
94c0: 28 6c 65 74 20 28 28 6e 75 6d 72 75 6e 73 20 30 (let ((numruns 0
94d0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
94e0: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
94f0: 67 65 74 2d 6e 75 6d 2d 72 75 6e 73 20 53 54 41 get-num-runs STA
9500: 52 54 20 22 20 72 75 6e 70 61 74 74 29 0a 20 20 RT " runpatt).
9510: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
9520: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c ach-row . (l
9530: 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 20 20 ambda (count).
9540: 20 20 20 20 20 28 73 65 74 21 20 6e 75 6d 72 75 (set! numru
9550: 6e 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 ns count)).
9560: 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 (db:get-db dbstr
9570: 75 63 74 20 23 66 29 0a 20 20 20 20 20 22 53 45 uct #f). "SE
9580: 4c 45 43 54 20 43 4f 55 4e 54 28 69 64 29 20 46 LECT COUNT(id) F
9590: 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 72 ROM runs WHERE r
95a0: 75 6e 6e 61 6d 65 20 4c 49 4b 45 20 3f 20 41 4e unname LIKE ? AN
95b0: 44 20 73 74 61 74 65 20 21 3d 20 27 64 65 6c 65 D state != 'dele
95c0: 74 65 64 27 3b 22 20 72 75 6e 70 61 74 74 29 0a ted';" runpatt).
95d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
95e0: 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a 67 65 74 -info 11 "db:get
95f0: 2d 6e 75 6d 2d 72 75 6e 73 20 45 4e 44 20 22 20 -num-runs END "
9600: 72 75 6e 70 61 74 74 29 0a 20 20 20 20 6e 75 6d runpatt). num
9610: 72 75 6e 73 29 29 0a 0a 3b 3b 20 67 65 74 20 73 runs))..;; get s
9620: 6f 6d 65 20 62 61 73 69 63 20 72 75 6e 20 73 74 ome basic run st
9630: 61 74 73 0a 3b 3b 0a 3b 3b 20 28 20 28 72 75 6e ats.;;.;; ( (run
9640: 6e 61 6d 65 20 28 28 20 73 74 61 74 65 20 20 63 name (( state c
9650: 6f 75 6e 74 20 29 20 2e 2e 2e 20 29 29 0a 3b 3b ount ) ... )).;;
9660: 20 20 20 28 20 20 20 2e 2e 2e 20 20 0a 28 64 65 ( ... .(de
9670: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 72 75 6e fine (db:get-run
9680: 2d 73 74 61 74 73 20 64 62 73 74 72 75 63 74 29 -stats dbstruct)
9690: 0a 20 20 28 6c 65 74 20 28 28 74 6f 74 61 6c 73 . (let ((totals
96a0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 (make-has
96b0: 68 2d 74 61 62 6c 65 29 29 0a 09 28 72 65 73 20 h-table))..(res
96c0: 20 20 20 20 20 20 20 20 20 27 28 29 29 0a 09 28 '())..(
96d0: 72 75 6e 73 2d 69 6e 66 6f 20 20 20 20 27 28 29 runs-info '()
96e0: 29 29 0a 20 20 20 20 3b 3b 20 46 69 72 73 74 20 )). ;; First
96f0: 67 65 74 20 61 6c 6c 20 74 68 65 20 72 75 6e 6e get all the runn
9700: 61 6d 65 2f 72 75 6e 2d 69 64 73 0a 20 20 20 20 ame/run-ids.
9710: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
9720: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 h-row. (lamb
9730: 64 61 20 28 72 75 6e 2d 69 64 20 72 75 6e 6e 61 da (run-id runna
9740: 6d 65 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 me). (set!
9750: 20 72 75 6e 73 2d 69 6e 66 6f 20 28 63 6f 6e 73 runs-info (cons
9760: 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 20 72 (list runname r
9770: 75 6e 2d 69 64 29 20 72 75 6e 73 2d 69 6e 66 6f un-id) runs-info
9780: 29 29 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 ))). (db:get
9790: 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 29 -db dbstruct #f)
97a0: 0a 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 . "SELECT id
97b0: 2c 72 75 6e 6e 61 6d 65 20 46 52 4f 4d 20 72 75 ,runname FROM ru
97c0: 6e 73 3b 22 29 0a 20 20 20 20 3b 3b 20 66 6f 72 ns;"). ;; for
97d0: 20 65 61 63 68 20 72 75 6e 20 67 65 74 20 73 74 each run get st
97e0: 61 74 73 20 64 61 74 61 0a 20 20 20 20 28 66 6f ats data. (fo
97f0: 72 2d 65 61 63 68 0a 20 20 20 20 20 28 6c 61 6d r-each. (lam
9800: 62 64 61 20 28 72 75 6e 2d 69 6e 66 6f 29 0a 20 bda (run-info).
9810: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e (let ((run
9820: 2d 6e 61 6d 65 20 28 63 61 64 72 20 72 75 6e 2d -name (cadr run-
9830: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 28 72 75 info)).. (ru
9840: 6e 2d 69 64 20 20 20 28 63 61 72 20 20 72 75 6e n-id (car run
9850: 2d 69 6e 66 6f 29 29 29 0a 09 20 28 73 71 6c 69 -info))).. (sqli
9860: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
9870: 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 73 74 61 .. (lambda (sta
9880: 74 65 20 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 te count).
9890: 20 28 6c 65 74 2a 20 28 28 73 74 61 74 65 70 61 (let* ((statepa
98a0: 72 74 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 rts (string-spli
98b0: 74 20 73 74 61 74 65 20 22 7c 22 29 29 0a 09 20 t state "|"))..
98c0: 20 20 20 20 20 28 6e 65 77 73 74 61 74 65 20 20 (newstate
98d0: 20 28 63 6f 6e 63 20 28 63 61 72 20 73 74 61 74 (conc (car stat
98e0: 65 70 61 72 74 73 29 20 22 5c 6e 22 20 28 63 61 eparts) "\n" (ca
98f0: 64 72 20 73 74 61 74 65 70 61 72 74 73 29 29 29 dr stateparts)))
9900: 29 0a 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ).. (hash-table-
9910: 73 65 74 21 20 74 6f 74 61 6c 73 20 6e 65 77 73 set! totals news
9920: 74 61 74 65 20 28 2b 20 28 68 61 73 68 2d 74 61 tate (+ (hash-ta
9930: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
9940: 74 6f 74 61 6c 73 20 6e 65 77 73 74 61 74 65 20 totals newstate
9950: 30 29 20 63 6f 75 6e 74 29 29 0a 09 20 28 73 65 0) count)).. (se
9960: 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 t! res (cons (li
9970: 73 74 20 72 75 6e 6e 61 6d 65 20 6e 65 77 73 74 st runname newst
9980: 61 74 65 20 63 6f 75 6e 74 29 20 72 65 73 29 29 ate count) res))
9990: 29 29 0a 09 20 20 28 64 62 3a 67 65 74 2d 64 62 )).. (db:get-db
99a0: 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 dbstruct run-id
99b0: 29 0a 09 20 20 22 53 45 4c 45 43 54 20 73 74 61 ).. "SELECT sta
99c0: 74 65 7c 7c 27 7c 27 7c 7c 73 74 61 74 75 73 20 te||'|'||status
99d0: 41 53 20 73 2c 63 6f 75 6e 74 28 69 64 29 20 46 AS s,count(id) F
99e0: 52 4f 4d 20 74 65 73 74 73 20 41 53 20 74 20 4f ROM tests AS t O
99f0: 4e 20 4f 52 44 45 52 20 42 59 20 73 20 44 45 53 N ORDER BY s DES
9a00: 43 3b 22 20 29 0a 20 20 20 20 3b 3b 20 28 73 65 C;" ). ;; (se
9a10: 74 21 20 72 65 73 20 28 72 65 76 65 72 73 65 20 t! res (reverse
9a20: 72 65 73 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 res)). (for-e
9a30: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 73 74 61 ach (lambda (sta
9a40: 74 65 29 0a 09 09 28 73 65 74 21 20 72 65 73 20 te)...(set! res
9a50: 28 63 6f 6e 73 20 28 6c 69 73 74 20 22 54 6f 74 (cons (list "Tot
9a60: 61 6c 73 22 20 73 74 61 74 65 20 28 68 61 73 68 als" state (hash
9a70: 2d 74 61 62 6c 65 2d 72 65 66 20 74 6f 74 61 6c -table-ref total
9a80: 73 20 73 74 61 74 65 29 29 20 72 65 73 29 29 29 s state)) res)))
9a90: 0a 09 09 20 20 20 28 73 6f 72 74 20 28 68 61 73 ... (sort (has
9aa0: 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 6f 74 h-table-keys tot
9ab0: 61 6c 73 29 20 73 74 72 69 6e 67 3e 3d 29 29 29 als) string>=)))
9ac0: 29 0a 20 20 20 20 20 72 75 6e 73 2d 69 6e 66 6f ). runs-info
9ad0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
9ae0: 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 db:get-runs-by-p
9af0: 61 74 74 0a 3b 3b 20 67 65 74 20 72 75 6e 73 20 att.;; get runs
9b00: 62 79 20 6c 69 73 74 20 6f 66 20 63 72 69 74 65 by list of crite
9b10: 72 69 61 0a 3b 3b 20 72 65 67 69 73 74 65 72 20 ria.;; register
9b20: 61 20 74 65 73 74 20 72 75 6e 20 77 69 74 68 20 a test run with
9b30: 74 68 65 20 64 62 0a 3b 3b 0a 3b 3b 20 55 73 65 the db.;;.;; Use
9b40: 3a 20 28 64 62 2d 67 65 74 2d 76 61 6c 75 65 2d : (db-get-value-
9b50: 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a 67 65 by-header (db:ge
9b60: 74 2d 68 65 61 64 65 72 20 72 75 6e 69 6e 66 6f t-header runinfo
9b70: 29 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e )(db:get-row run
9b80: 69 6e 66 6f 29 29 0a 3b 3b 20 20 74 6f 20 65 78 info)).;; to ex
9b90: 74 72 61 63 74 20 69 6e 66 6f 20 66 72 6f 6d 20 tract info from
9ba0: 74 68 65 20 73 74 72 75 63 74 75 72 65 20 72 65 the structure re
9bb0: 74 75 72 6e 65 64 0a 3b 3b 0a 28 64 65 66 69 6e turned.;;.(defin
9bc0: 65 20 28 64 62 3a 67 65 74 2d 72 75 6e 73 2d 62 e (db:get-runs-b
9bd0: 79 2d 70 61 74 74 20 64 62 73 74 72 75 63 74 20 y-patt dbstruct
9be0: 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 keys runnamepatt
9bf0: 20 74 61 72 67 70 61 74 74 20 6f 66 66 73 65 74 targpatt offset
9c00: 20 6c 69 6d 69 74 29 20 3b 3b 20 74 65 73 74 2d limit) ;; test-
9c10: 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 name). (let* ((
9c20: 74 6d 70 20 20 20 20 20 20 28 72 75 6e 73 3a 67 tmp (runs:g
9c30: 65 74 2d 73 74 64 2d 72 75 6e 2d 66 69 65 6c 64 et-std-run-field
9c40: 73 20 6b 65 79 73 20 27 28 22 69 64 22 20 22 72 s keys '("id" "r
9c50: 75 6e 6e 61 6d 65 22 20 22 73 74 61 74 65 22 20 unname" "state"
9c60: 22 73 74 61 74 75 73 22 20 22 6f 77 6e 65 72 22 "status" "owner"
9c70: 20 22 65 76 65 6e 74 5f 74 69 6d 65 22 29 29 29 "event_time")))
9c80: 0a 09 20 28 6b 65 79 73 74 72 20 20 20 28 63 61 .. (keystr (ca
9c90: 72 20 74 6d 70 29 29 0a 09 20 28 68 65 61 64 65 r tmp)).. (heade
9ca0: 72 20 20 20 28 63 61 64 72 20 74 6d 70 29 29 0a r (cadr tmp)).
9cb0: 09 20 28 72 65 73 20 20 20 20 20 27 28 29 29 0a . (res '()).
9cc0: 09 20 28 6b 65 79 2d 70 61 74 74 20 22 22 29 0a . (key-patt "").
9cd0: 09 20 28 72 75 6e 77 69 6c 64 74 79 70 65 20 28 . (runwildtype (
9ce0: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
9cf0: 64 65 78 20 22 25 22 20 72 75 6e 6e 61 6d 65 70 dex "%" runnamep
9d00: 61 74 74 29 20 22 6c 69 6b 65 22 20 22 67 6c 6f att) "like" "glo
9d10: 62 22 29 29 0a 09 20 28 71 72 79 2d 73 74 72 20 b")).. (qry-str
9d20: 20 23 66 29 0a 09 20 28 6b 65 79 76 61 6c 73 20 #f).. (keyvals
9d30: 20 28 69 66 20 74 61 72 67 70 61 74 74 20 28 6b (if targpatt (k
9d40: 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 eys:target->keyv
9d50: 61 6c 20 6b 65 79 73 20 74 61 72 67 70 61 74 74 al keys targpatt
9d60: 29 20 27 28 29 29 29 29 0a 20 20 20 20 28 66 6f ) '()))). (fo
9d70: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
9d80: 6b 65 79 76 61 6c 29 0a 09 09 28 6c 65 74 2a 20 keyval)...(let*
9d90: 28 28 6b 65 79 20 20 20 20 28 63 61 72 20 6b 65 ((key (car ke
9da0: 79 76 61 6c 29 29 0a 09 09 20 20 20 20 20 20 20 yval))...
9db0: 28 70 61 74 74 20 20 20 28 63 61 64 72 20 6b 65 (patt (cadr ke
9dc0: 79 76 61 6c 29 29 0a 09 09 20 20 20 20 20 20 20 yval))...
9dd0: 28 66 75 6c 6b 65 79 20 28 63 6f 6e 63 20 22 3a (fulkey (conc ":
9de0: 22 20 6b 65 79 29 29 0a 09 09 20 20 20 20 20 20 " key))...
9df0: 20 28 77 69 6c 64 74 79 70 65 20 28 69 66 20 28 (wildtype (if (
9e00: 73 75 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 substring-index
9e10: 22 25 22 20 70 61 74 74 29 20 22 6c 69 6b 65 22 "%" patt) "like"
9e20: 20 22 67 6c 6f 62 22 29 29 29 0a 09 09 20 20 28 "glob")))... (
9e30: 69 66 20 70 61 74 74 0a 09 09 20 20 20 20 20 20 if patt...
9e40: 28 73 65 74 21 20 6b 65 79 2d 70 61 74 74 20 28 (set! key-patt (
9e50: 63 6f 6e 63 20 6b 65 79 2d 70 61 74 74 20 22 20 conc key-patt "
9e60: 41 4e 44 20 22 20 6b 65 79 20 22 20 22 20 77 69 AND " key " " wi
9e70: 6c 64 74 79 70 65 20 22 20 27 22 20 70 61 74 74 ldtype " '" patt
9e80: 20 22 27 22 29 29 0a 09 09 20 20 20 20 20 20 28 "'"))... (
9e90: 62 65 67 69 6e 0a 09 09 09 28 64 65 62 75 67 3a begin....(debug:
9ea0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
9eb0: 73 65 61 72 63 68 69 6e 67 20 66 6f 72 20 72 75 searching for ru
9ec0: 6e 73 20 77 69 74 68 20 6e 6f 20 70 61 74 74 65 ns with no patte
9ed0: 72 6e 20 73 65 74 20 66 6f 72 20 22 20 66 75 6c rn set for " ful
9ee0: 6b 65 79 29 0a 09 09 09 28 65 78 69 74 20 36 29 key)....(exit 6)
9ef0: 29 29 29 29 0a 09 20 20 20 20 20 20 6b 65 79 76 )))).. keyv
9f00: 61 6c 73 29 0a 20 20 20 20 28 73 65 74 21 20 71 als). (set! q
9f10: 72 79 2d 73 74 72 20 28 63 6f 6e 63 20 22 53 45 ry-str (conc "SE
9f20: 4c 45 43 54 20 22 20 6b 65 79 73 74 72 20 22 20 LECT " keystr "
9f30: 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 FROM runs WHERE
9f40: 73 74 61 74 65 20 21 3d 20 27 64 65 6c 65 74 65 state != 'delete
9f50: 64 27 20 41 4e 44 20 72 75 6e 6e 61 6d 65 20 22 d' AND runname "
9f60: 20 72 75 6e 77 69 6c 64 74 79 70 65 20 22 20 3f runwildtype " ?
9f70: 20 22 20 6b 65 79 2d 70 61 74 74 20 22 20 4f 52 " key-patt " OR
9f80: 44 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d DER BY event_tim
9f90: 65 20 22 0a 09 09 09 28 69 66 20 6c 69 6d 69 74 e "....(if limit
9fa0: 20 20 28 63 6f 6e 63 20 22 20 4c 49 4d 49 54 20 (conc " LIMIT
9fb0: 22 20 6c 69 6d 69 74 29 20 20 20 22 22 29 0a 09 " limit) "")..
9fc0: 09 09 28 69 66 20 6f 66 66 73 65 74 20 28 63 6f ..(if offset (co
9fd0: 6e 63 20 22 20 4f 46 46 53 45 54 20 22 20 6f 66 nc " OFFSET " of
9fe0: 66 73 65 74 29 20 22 22 29 0a 09 09 09 22 3b 22 fset) "")....";"
9ff0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
a000: 69 6e 74 2d 69 6e 66 6f 20 34 20 22 72 75 6e 73 int-info 4 "runs
a010: 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 :get-runs-by-pat
a020: 74 20 71 72 79 3d 22 20 71 72 79 2d 73 74 72 20 t qry=" qry-str
a030: 22 20 22 20 72 75 6e 6e 61 6d 65 70 61 74 74 29 " " runnamepatt)
a040: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
a050: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
a060: 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 72 29 (lambda (a . r)
a070: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
a080: 73 20 28 63 6f 6e 73 20 28 6c 69 73 74 2d 3e 76 s (cons (list->v
a090: 65 63 74 6f 72 20 28 63 6f 6e 73 20 61 20 72 29 ector (cons a r)
a0a0: 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 28 64 ) res))). (d
a0b0: 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 b:get-db dbstruc
a0c0: 74 20 23 66 29 0a 20 20 20 20 20 71 72 79 2d 73 t #f). qry-s
a0d0: 74 72 0a 20 20 20 20 20 72 75 6e 6e 61 6d 65 70 tr. runnamep
a0e0: 61 74 74 29 0a 20 20 20 20 28 76 65 63 74 6f 72 att). (vector
a0f0: 20 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 0a header res)))..
a100: 3b 3b 20 75 73 65 20 28 67 65 74 2d 76 61 6c 75 ;; use (get-valu
a110: 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a e-by-header (db:
a120: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 69 6e get-header runin
a130: 66 6f 29 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 fo)(db:get-row r
a140: 75 6e 69 6e 66 6f 29 29 0a 28 64 65 66 69 6e 65 uninfo)).(define
a150: 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 (db:get-run-inf
a160: 6f 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 o dbstruct run-i
a170: 64 29 0a 20 20 3b 3b 28 69 66 20 28 68 61 73 68 d). ;;(if (hash
a180: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
a190: 6c 74 20 2a 72 75 6e 2d 69 6e 66 6f 2d 63 61 63 lt *run-info-cac
a1a0: 68 65 2a 20 72 75 6e 2d 69 64 20 23 66 29 0a 20 he* run-id #f).
a1b0: 20 3b 3b 20 20 20 20 28 68 61 73 68 2d 74 61 62 ;; (hash-tab
a1c0: 6c 65 2d 72 65 66 20 2a 72 75 6e 2d 69 6e 66 6f le-ref *run-info
a1d0: 2d 63 61 63 68 65 2a 20 72 75 6e 2d 69 64 29 0a -cache* run-id).
a1e0: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 (let* ((res
a1f0: 20 20 20 20 28 76 65 63 74 6f 72 20 23 66 20 23 (vector #f #
a200: 66 20 23 66 20 23 66 29 29 0a 09 20 28 6b 65 79 f #f #f)).. (key
a210: 73 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 6b s (db:get-k
a220: 65 79 73 20 64 62 73 74 72 75 63 74 29 29 0a 09 eys dbstruct))..
a230: 20 28 72 65 6d 66 69 65 6c 64 73 20 28 6c 69 73 (remfields (lis
a240: 74 20 22 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 t "id" "runname"
a250: 20 22 73 74 61 74 65 22 20 22 73 74 61 74 75 73 "state" "status
a260: 22 20 22 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 " "owner" "event
a270: 5f 74 69 6d 65 22 29 29 0a 09 20 28 68 65 61 64 _time")).. (head
a280: 65 72 20 20 20 20 28 61 70 70 65 6e 64 20 6b 65 er (append ke
a290: 79 73 20 72 65 6d 66 69 65 6c 64 73 29 29 0a 09 ys remfields))..
a2a0: 20 28 6b 65 79 73 74 72 20 20 20 20 28 63 6f 6e (keystr (con
a2b0: 63 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 72 20 c (keys->keystr
a2c0: 6b 65 79 73 29 20 22 2c 22 0a 09 09 09 20 20 28 keys) ",".... (
a2d0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
a2e0: 73 65 20 72 65 6d 66 69 65 6c 64 73 20 22 2c 22 se remfields ","
a2f0: 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a )))). (debug:
a300: 70 72 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 print-info 11 "d
a310: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 b:get-run-info r
a320: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 un-id: " run-id
a330: 22 20 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 " header: " head
a340: 65 72 20 22 20 6b 65 79 73 74 72 3a 20 22 20 6b er " keystr: " k
a350: 65 79 73 74 72 29 0a 20 20 20 20 28 73 71 6c 69 eystr). (sqli
a360: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
a370: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 . (lambda (a
a380: 20 2e 20 78 29 0a 20 20 20 20 20 20 20 28 73 65 . x). (se
a390: 74 21 20 72 65 73 20 28 61 70 70 6c 79 20 76 65 t! res (apply ve
a3a0: 63 74 6f 72 20 61 20 78 29 29 29 0a 20 20 20 20 ctor a x))).
a3b0: 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 (db:get-db dbst
a3c0: 72 75 63 74 20 23 66 29 0a 20 20 20 20 20 28 63 ruct #f). (c
a3d0: 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 onc "SELECT " ke
a3e0: 79 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 ystr " FROM runs
a3f0: 20 57 48 45 52 45 20 69 64 3d 3f 20 41 4e 44 20 WHERE id=? AND
a400: 73 74 61 74 65 20 21 3d 20 27 64 65 6c 65 74 65 state != 'delete
a410: 64 27 3b 22 29 0a 20 20 20 20 20 72 75 6e 2d 69 d';"). run-i
a420: 64 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 d). (debug:pr
a430: 69 6e 74 2d 69 6e 66 6f 20 31 31 20 22 64 62 3a int-info 11 "db:
a440: 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 72 75 6e get-run-info run
a450: 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 -id: " run-id "
a460: 68 65 61 64 65 72 3a 20 22 20 68 65 61 64 65 72 header: " header
a470: 20 22 20 6b 65 79 73 74 72 3a 20 22 20 6b 65 79 " keystr: " key
a480: 73 74 72 29 0a 20 20 20 20 28 6c 65 74 20 28 28 str). (let ((
a490: 66 69 6e 61 6c 72 65 73 20 28 76 65 63 74 6f 72 finalres (vector
a4a0: 20 68 65 61 64 65 72 20 72 65 73 29 29 29 0a 20 header res))).
a4b0: 20 20 20 20 20 3b 3b 20 28 68 61 73 68 2d 74 61 ;; (hash-ta
a4c0: 62 6c 65 2d 73 65 74 21 20 2a 72 75 6e 2d 69 6e ble-set! *run-in
a4d0: 66 6f 2d 63 61 63 68 65 2a 20 72 75 6e 2d 69 64 fo-cache* run-id
a4e0: 20 66 69 6e 61 6c 72 65 73 29 0a 20 20 20 20 20 finalres).
a4f0: 20 66 69 6e 61 6c 72 65 73 29 29 29 0a 0a 28 64 finalres)))..(d
a500: 65 66 69 6e 65 20 28 64 62 3a 73 65 74 2d 63 6f efine (db:set-co
a510: 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 64 62 mment-for-run db
a520: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 63 6f struct run-id co
a530: 6d 6d 65 6e 74 29 0a 20 20 28 73 71 6c 69 74 65 mment). (sqlite
a540: 33 3a 65 78 65 63 75 74 65 20 28 64 62 3a 67 65 3:execute (db:ge
a550: 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 t-db dbstruct #f
a560: 29 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 53 ) "UPDATE runs S
a570: 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 ET comment=? WHE
a580: 52 45 20 69 64 3d 3f 3b 22 20 63 6f 6d 6d 65 6e RE id=?;" commen
a590: 74 20 72 75 6e 2d 69 64 29 29 0a 0a 3b 3b 20 64 t run-id))..;; d
a5a0: 6f 65 73 20 6e 6f 74 20 28 6f 62 76 69 6f 75 73 oes not (obvious
a5b0: 6c 79 21 29 20 72 65 6d 6f 76 65 64 20 64 65 70 ly!) removed dep
a5c0: 65 6e 64 65 6e 74 20 64 61 74 61 2e 20 42 75 74 endent data. But
a5d0: 20 77 68 79 20 6e 6f 74 21 21 3f 0a 28 64 65 66 why not!!?.(def
a5e0: 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 72 ine (db:delete-r
a5f0: 75 6e 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d un dbstruct run-
a600: 69 64 29 0a 20 20 3b 3b 20 46 69 72 73 74 20 73 id). ;; First s
a610: 65 74 20 61 6e 79 20 72 65 6c 61 74 65 64 20 74 et any related t
a620: 65 73 74 73 20 74 6f 20 44 45 4c 45 54 45 44 0a ests to DELETED.
a630: 20 20 28 6c 65 74 20 28 28 64 62 20 28 64 62 3a (let ((db (db:
a640: 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 get-db dbstruct
a650: 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 28 73 run-id))). (s
a660: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
a670: 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 b "UPDATE tests
a680: 53 45 54 20 73 74 61 74 65 3d 27 44 45 4c 45 54 SET state='DELET
a690: 45 44 27 2c 63 6f 6d 6d 65 6e 74 3d 27 27 3b 22 ED',comment='';"
a6a0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
a6b0: 78 65 63 75 74 65 20 64 62 20 22 44 45 4c 45 54 xecute db "DELET
a6c0: 45 20 46 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 E FROM test_step
a6d0: 73 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 74 65 s;"). (sqlite
a6e0: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 44 45 3:execute db "DE
a6f0: 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 5f 64 LETE FROM test_d
a700: 61 74 61 3b 22 29 0a 20 20 20 20 28 73 71 6c 69 ata;"). (sqli
a710: 74 65 33 3a 65 78 65 63 75 74 65 20 28 64 62 3a te3:execute (db:
a720: 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 get-db dbstruct
a730: 23 66 29 20 22 55 50 44 41 54 45 20 72 75 6e 73 #f) "UPDATE runs
a740: 20 53 45 54 20 73 74 61 74 65 3d 27 64 65 6c 65 SET state='dele
a750: 74 65 64 27 2c 63 6f 6d 6d 65 6e 74 3d 27 27 20 ted',comment=''
a760: 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 72 75 6e WHERE id=?;" run
a770: 2d 69 64 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 -id)))..(define
a780: 28 64 62 3a 75 70 64 61 74 65 2d 72 75 6e 2d 65 (db:update-run-e
a790: 76 65 6e 74 5f 74 69 6d 65 20 64 62 73 74 72 75 vent_time dbstru
a7a0: 63 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 73 71 ct run-id). (sq
a7b0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 28 64 lite3:execute (d
a7c0: 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 b:get-db dbstruc
a7d0: 74 20 23 66 29 20 22 55 50 44 41 54 45 20 72 75 t #f) "UPDATE ru
a7e0: 6e 73 20 53 45 54 20 65 76 65 6e 74 5f 74 69 6d ns SET event_tim
a7f0: 65 3d 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c e=strftime('%s',
a800: 27 6e 6f 77 27 29 20 57 48 45 52 45 20 69 64 3d 'now') WHERE id=
a810: 3f 3b 22 20 72 75 6e 2d 69 64 29 29 0a 0a 28 64 ?;" run-id))..(d
a820: 65 66 69 6e 65 20 28 64 62 3a 6c 6f 63 6b 2f 75 efine (db:lock/u
a830: 6e 6c 6f 63 6b 2d 72 75 6e 20 64 62 73 74 72 75 nlock-run dbstru
a840: 63 74 20 72 75 6e 2d 69 64 20 6c 6f 63 6b 20 75 ct run-id lock u
a850: 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 20 28 6c nlock user). (l
a860: 65 74 20 28 28 6e 65 77 6c 6f 63 6b 76 61 6c 20 et ((newlockval
a870: 28 69 66 20 6c 6f 63 6b 20 22 6c 6f 63 6b 65 64 (if lock "locked
a880: 22 0a 09 09 09 28 69 66 20 75 6e 6c 6f 63 6b 0a "....(if unlock.
a890: 09 09 09 20 20 20 20 22 75 6e 6c 6f 63 6b 65 64 ... "unlocked
a8a0: 22 0a 09 09 09 20 20 20 20 22 6c 6f 63 6b 65 64 ".... "locked
a8b0: 22 29 29 29 29 20 3b 3b 20 73 65 6d 69 2d 66 61 ")))) ;; semi-fa
a8c0: 69 6c 73 61 66 65 0a 20 20 20 20 28 73 71 6c 69 ilsafe. (sqli
a8d0: 74 65 33 3a 65 78 65 63 75 74 65 20 28 64 62 3a te3:execute (db:
a8e0: 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 get-db dbstruct
a8f0: 23 66 29 20 22 55 50 44 41 54 45 20 72 75 6e 73 #f) "UPDATE runs
a900: 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 45 SET state=? WHE
a910: 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 6c 6f 63 RE id=?;" newloc
a920: 6b 76 61 6c 20 72 75 6e 2d 69 64 29 0a 20 20 20 kval run-id).
a930: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
a940: 65 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 e (db:get-db dbs
a950: 74 72 75 63 74 20 23 66 29 20 22 49 4e 53 45 52 truct #f) "INSER
a960: 54 20 49 4e 54 4f 20 61 63 63 65 73 73 5f 6c 6f T INTO access_lo
a970: 67 20 28 75 73 65 72 2c 61 63 63 65 73 73 65 64 g (user,accessed
a980: 2c 61 72 67 73 29 20 56 41 4c 55 45 53 28 3f 2c ,args) VALUES(?,
a990: 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e strftime('%s','n
a9a0: 6f 77 27 29 2c 3f 29 3b 22 0a 09 09 20 20 20 20 ow'),?);"...
a9b0: 20 75 73 65 72 20 28 63 6f 6e 63 20 6e 65 77 6c user (conc newl
a9c0: 6f 63 6b 76 61 6c 20 22 20 22 20 72 75 6e 2d 69 ockval " " run-i
a9d0: 64 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 d)). (debug:p
a9e0: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 22 20 6e rint-info 1 "" n
a9f0: 65 77 6c 6f 63 6b 76 61 6c 20 22 20 72 75 6e 20 ewlockval " run
aa00: 6e 75 6d 62 65 72 20 22 20 72 75 6e 2d 69 64 29 number " run-id)
aa10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
aa20: 67 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 get-all-run-ids
aa30: 64 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 74 dbstruct). (let
aa40: 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 ((res '())).
aa50: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
aa60: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d ch-row. (lam
aa70: 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 20 20 20 bda (run-id).
aa80: 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
aa90: 6f 6e 73 20 72 75 6e 2d 69 64 20 72 65 73 29 29 ons run-id res))
aaa0: 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 2d 64 ). (db:get-d
aab0: 62 20 64 62 73 74 72 75 63 74 20 23 66 29 0a 20 b dbstruct #f).
aac0: 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 20 46 "SELECT id F
aad0: 52 4f 4d 20 72 75 6e 73 3b 22 29 0a 20 20 20 20 ROM runs;").
aae0: 28 72 65 76 65 72 73 65 20 72 65 73 29 29 29 0a (reverse res))).
aaf0: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
ab00: 2d 72 75 6e 2d 69 64 73 20 64 62 29 0a 20 20 28 -run-ids db). (
ab10: 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a let ((res '())).
ab20: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
ab30: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
ab40: 6c 61 6d 62 64 61 20 28 69 64 29 0a 20 20 20 20 lambda (id).
ab50: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
ab60: 6e 73 20 69 64 20 72 65 73 29 29 29 0a 20 20 20 ns id res))).
ab70: 20 20 64 62 20 0a 20 20 20 20 20 22 53 45 4c 45 db . "SELE
ab80: 43 54 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 3b CT id FROM runs;
ab90: 22 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ")))..;;========
aba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
abd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.;
abe0: 3b 20 4b 20 45 20 59 20 53 0a 3b 3b 3d 3d 3d 3d ; K E Y S.;;====
abf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ac30: 3d 3d 0a 0a 3b 3b 20 67 65 74 20 6b 65 79 20 76 ==..;; get key v
ac40: 61 6c 20 70 61 69 72 73 20 66 6f 72 20 61 20 67 al pairs for a g
ac50: 69 76 65 6e 20 72 75 6e 2d 69 64 0a 3b 3b 20 28 iven run-id.;; (
ac60: 20 28 46 49 45 4c 44 4e 41 4d 45 31 20 6b 65 79 (FIELDNAME1 key
ac70: 76 61 6c 31 29 20 28 46 49 45 4c 44 4e 41 4d 45 val1) (FIELDNAME
ac80: 32 20 6b 65 79 76 61 6c 32 29 20 2e 2e 2e 20 29 2 keyval2) ... )
ac90: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
aca0: 2d 6b 65 79 2d 76 61 6c 2d 70 61 69 72 73 20 64 -key-val-pairs d
acb0: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a bstruct run-id).
acc0: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 28 (let* ((keys (
acd0: 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 73 74 db:get-keys dbst
ace0: 72 75 63 74 29 29 0a 09 20 28 72 65 73 20 20 27 ruct)).. (res '
acf0: 28 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 ())). (for-ea
ad00: 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 ch . (lambda
ad10: 20 28 6b 65 79 29 0a 20 20 20 20 20 20 20 28 6c (key). (l
ad20: 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 et ((qry (conc "
ad30: 53 45 4c 45 43 54 20 22 20 6b 65 79 20 22 20 46 SELECT " key " F
ad40: 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 ROM runs WHERE i
ad50: 64 3d 3f 3b 22 29 29 29 0a 09 20 3b 3b 20 28 64 d=?;"))).. ;; (d
ad60: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 71 72 ebug:print 0 "qr
ad70: 79 3a 20 22 20 71 72 79 29 0a 09 20 28 73 71 6c y: " qry).. (sql
ad80: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
ad90: 77 20 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 6b w .. (lambda (k
ada0: 65 79 2d 76 61 6c 29 0a 09 20 20 20 20 28 73 65 ey-val).. (se
adb0: 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 t! res (cons (li
adc0: 73 74 20 6b 65 79 20 6b 65 79 2d 76 61 6c 29 20 st key key-val)
add0: 72 65 73 29 29 29 0a 09 20 20 28 64 62 3a 67 65 res))).. (db:ge
ade0: 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 t-db dbstruct #f
adf0: 29 20 71 72 79 20 72 75 6e 2d 69 64 29 29 29 0a ) qry run-id))).
ae00: 20 20 20 20 20 6b 65 79 73 29 0a 20 20 20 20 28 keys). (
ae10: 72 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 0a reverse res)))..
ae20: 3b 3b 20 67 65 74 20 6b 65 79 20 76 61 6c 73 20 ;; get key vals
ae30: 66 6f 72 20 61 20 67 69 76 65 6e 20 72 75 6e 2d for a given run-
ae40: 69 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 id.(define (db:g
ae50: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 73 74 et-key-vals dbst
ae60: 72 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 20 28 ruct run-id). (
ae70: 6c 65 74 20 28 28 6d 79 6b 65 79 76 61 6c 73 20 let ((mykeyvals
ae80: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
ae90: 64 65 66 61 75 6c 74 20 2a 6b 65 79 76 61 6c 73 default *keyvals
aea0: 2a 20 72 75 6e 2d 69 64 20 23 66 29 29 29 0a 20 * run-id #f))).
aeb0: 20 20 20 28 69 66 20 6d 79 6b 65 79 76 61 6c 73 (if mykeyvals
aec0: 20 0a 09 6d 79 6b 65 79 76 61 6c 73 0a 09 28 6c ..mykeyvals..(l
aed0: 65 74 2a 20 28 28 6b 65 79 73 20 28 64 62 3a 67 et* ((keys (db:g
aee0: 65 74 2d 6b 65 79 73 20 64 62 73 74 72 75 63 74 et-keys dbstruct
aef0: 29 29 0a 09 20 20 20 20 20 20 20 28 72 65 73 20 )).. (res
af00: 20 27 28 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 '())).. (for-e
af10: 61 63 68 20 0a 09 20 20 20 28 6c 61 6d 62 64 61 ach .. (lambda
af20: 20 28 6b 65 79 29 0a 09 20 20 20 20 20 28 6c 65 (key).. (le
af30: 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 22 53 t ((qry (conc "S
af40: 45 4c 45 43 54 20 22 20 6b 65 79 20 22 20 46 52 ELECT " key " FR
af50: 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 OM runs WHERE id
af60: 3d 3f 3b 22 29 29 29 0a 09 20 20 20 20 20 20 20 =?;")))..
af70: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
af80: 68 2d 72 6f 77 20 0a 09 09 28 6c 61 6d 62 64 61 h-row ...(lambda
af90: 20 28 6b 65 79 2d 76 61 6c 29 0a 09 09 20 20 28 (key-val)... (
afa0: 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 6b set! res (cons k
afb0: 65 79 2d 76 61 6c 20 72 65 73 29 29 29 0a 09 09 ey-val res)))...
afc0: 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 (db:get-db dbstr
afd0: 75 63 74 20 23 66 29 20 71 72 79 20 72 75 6e 2d uct #f) qry run-
afe0: 69 64 29 29 29 0a 09 20 20 20 6b 65 79 73 29 0a id))).. keys).
aff0: 09 20 20 28 6c 65 74 20 28 28 66 69 6e 61 6c 2d . (let ((final-
b000: 72 65 73 20 28 72 65 76 65 72 73 65 20 72 65 73 res (reverse res
b010: 29 29 29 0a 09 20 20 20 20 28 68 61 73 68 2d 74 ))).. (hash-t
b020: 61 62 6c 65 2d 73 65 74 21 20 2a 6b 65 79 76 61 able-set! *keyva
b030: 6c 73 2a 20 72 75 6e 2d 69 64 20 66 69 6e 61 6c ls* run-id final
b040: 2d 72 65 73 29 0a 09 20 20 20 20 66 69 6e 61 6c -res).. final
b050: 2d 72 65 73 29 29 29 29 29 0a 0a 3b 3b 20 54 68 -res)))))..;; Th
b060: 65 20 74 61 72 67 65 74 20 69 73 20 6b 65 79 76 e target is keyv
b070: 61 6c 31 2f 6b 65 79 76 61 6c 32 2e 2e 2e 2c 20 al1/keyval2...,
b080: 63 61 63 68 65 64 20 69 6e 20 2a 74 61 72 67 65 cached in *targe
b090: 74 2a 20 61 73 20 69 74 20 69 73 20 75 73 65 64 t* as it is used
b0a0: 20 6f 66 74 65 6e 0a 28 64 65 66 69 6e 65 20 28 often.(define (
b0b0: 64 62 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 db:get-target db
b0c0: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 struct run-id).
b0d0: 20 28 6c 65 74 20 28 28 6d 79 74 61 72 67 20 28 (let ((mytarg (
b0e0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
b0f0: 65 66 61 75 6c 74 20 2a 74 61 72 67 65 74 2a 20 efault *target*
b100: 72 75 6e 2d 69 64 20 23 66 29 29 29 0a 20 20 20 run-id #f))).
b110: 20 28 69 66 20 6d 79 74 61 72 67 0a 09 6d 79 74 (if mytarg..myt
b120: 61 72 67 0a 09 28 6c 65 74 2a 20 28 28 6b 65 79 arg..(let* ((key
b130: 76 61 6c 73 20 28 64 62 3a 67 65 74 2d 6b 65 79 vals (db:get-key
b140: 2d 76 61 6c 73 20 64 62 73 74 72 75 63 74 20 72 -vals dbstruct r
b150: 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 20 20 20 un-id))..
b160: 28 74 68 65 6b 65 79 20 20 28 73 74 72 69 6e 67 (thekey (string
b170: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
b180: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 69 66 p (lambda (x)(if
b190: 20 78 20 78 20 22 2d 6e 61 2d 22 29 29 20 6b 65 x x "-na-")) ke
b1a0: 79 76 61 6c 73 29 20 22 2f 22 29 29 29 0a 09 20 yvals) "/")))..
b1b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
b1c0: 21 20 2a 74 61 72 67 65 74 2a 20 72 75 6e 2d 69 ! *target* run-i
b1d0: 64 20 74 68 65 6b 65 79 29 0a 09 20 20 74 68 65 d thekey).. the
b1e0: 6b 65 79 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d key))))..;;=====
b1f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b230: 3d 0a 3b 3b 20 20 54 20 45 20 53 20 54 20 53 0a =.;; T E S T S.
b240: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
b250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
b280: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 73 74 61 ========..;; sta
b290: 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 tes and statuses
b2a0: 20 61 72 65 20 6c 69 73 74 73 2c 20 74 75 72 6e are lists, turn
b2b0: 20 74 68 65 6d 20 69 6e 74 6f 20 28 22 50 41 53 them into ("PAS
b2c0: 53 22 2c 22 46 41 49 4c 22 2e 2e 2e 29 20 61 6e S","FAIL"...) an
b2d0: 64 20 75 73 65 20 4e 4f 54 20 49 4e 0a 3b 3b 20 d use NOT IN.;;
b2e0: 69 2e 65 2e 20 74 68 65 73 65 20 6c 69 73 74 73 i.e. these lists
b2f0: 20 64 65 66 69 6e 65 20 77 68 61 74 20 74 6f 20 define what to
b300: 4e 4f 54 20 73 68 6f 77 2e 0a 3b 3b 20 73 74 61 NOT show..;; sta
b310: 74 65 73 20 61 6e 64 20 73 74 61 74 75 73 65 73 tes and statuses
b320: 20 61 72 65 20 72 65 71 75 69 72 65 64 20 74 6f are required to
b330: 20 62 65 20 6c 69 73 74 73 2c 20 65 6d 70 74 79 be lists, empty
b340: 20 69 73 20 6f 6b 0a 3b 3b 20 6e 6f 74 2d 69 6e is ok.;; not-in
b350: 20 23 74 20 3d 20 61 62 6f 76 65 20 62 65 68 61 #t = above beha
b360: 76 69 6f 75 72 2c 20 23 66 20 3d 20 6d 75 73 74 viour, #f = must
b370: 20 6d 61 74 63 68 0a 28 64 65 66 69 6e 65 20 28 match.(define (
b380: 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db:get-tests-for
b390: 2d 72 75 6e 20 64 62 20 72 75 6e 2d 69 64 20 74 -run db run-id t
b3a0: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
b3b0: 74 61 74 75 73 65 73 20 6f 66 66 73 65 74 20 6c tatuses offset l
b3c0: 69 6d 69 74 20 6e 6f 74 2d 69 6e 20 73 6f 72 74 imit not-in sort
b3d0: 2d 62 79 20 73 6f 72 74 2d 6f 72 64 65 72 20 71 -by sort-order q
b3e0: 72 79 76 61 6c 73 29 0a 20 20 28 6c 65 74 2a 20 ryvals). (let*
b3f0: 28 28 71 72 79 76 61 6c 73 74 72 20 20 20 20 20 ((qryvalstr
b400: 20 20 28 63 61 73 65 20 71 72 79 76 61 6c 73 0a (case qryvals.
b410: 09 09 09 20 20 20 20 28 28 73 68 6f 72 74 6c 69 ... ((shortli
b420: 73 74 29 20 22 69 64 2c 72 75 6e 5f 69 64 2c 74 st) "id,run_id,t
b430: 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 estname,item_pat
b440: 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 22 29 h,state,status")
b450: 0a 09 09 09 20 20 20 20 28 28 23 66 29 20 20 20 .... ((#f)
b460: 20 20 20 20 20 22 69 64 2c 72 75 6e 5f 69 64 2c "id,run_id,
b470: 74 65 73 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 testname,state,s
b480: 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 tatus,event_time
b490: 2c 68 6f 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 ,host,cpuload,di
b4a0: 73 6b 66 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e skfree,uname,run
b4b0: 64 69 72 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 dir,item_path,ru
b4c0: 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c n_duration,final
b4d0: 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 22 29 0a _logf,comment").
b4e0: 09 09 09 20 20 20 20 28 65 6c 73 65 20 20 20 20 ... (else
b4f0: 20 20 20 20 71 72 79 76 61 6c 73 29 29 29 0a 09 qryvals)))..
b500: 20 28 72 65 73 20 20 20 20 20 20 20 20 20 20 20 (res
b510: 20 27 28 29 29 0a 09 20 3b 3b 20 69 66 20 73 74 '()).. ;; if st
b520: 61 74 65 73 20 6f 72 20 73 74 61 74 75 73 65 73 ates or statuses
b530: 20 61 72 65 20 6e 75 6c 6c 20 74 68 65 6e 20 61 are null then a
b540: 73 73 75 6d 65 20 6d 61 74 63 68 20 61 6c 6c 20 ssume match all
b550: 77 68 65 6e 20 6e 6f 74 2d 69 6e 20 69 73 20 66 when not-in is f
b560: 61 6c 73 65 0a 09 20 28 73 74 61 74 65 73 2d 71 alse.. (states-q
b570: 72 79 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c ry (if (nul
b580: 6c 3f 20 73 74 61 74 65 73 29 20 0a 09 09 09 20 l? states) ....
b590: 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 #f....
b5a0: 20 28 63 6f 6e 63 20 22 20 73 74 61 74 65 20 22 (conc " state "
b5b0: 20 20 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e ..... (if n
b5c0: 6f 74 2d 69 6e 0a 09 09 09 09 09 22 20 4e 4f 54 ot-in......" NOT
b5d0: 20 49 4e 20 28 27 22 0a 09 09 09 09 09 22 20 49 IN ('"......" I
b5e0: 4e 20 28 27 22 29 20 0a 09 09 09 09 20 20 20 20 N ('") .....
b5f0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
b600: 72 73 65 20 73 74 61 74 65 73 20 20 20 22 27 2c rse states "',
b610: 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29 22 '")..... "')"
b620: 29 29 29 0a 09 20 28 73 74 61 74 75 73 65 73 2d ))).. (statuses-
b630: 71 72 79 20 20 20 20 28 69 66 20 28 6e 75 6c 6c qry (if (null
b640: 3f 20 73 74 61 74 75 73 65 73 29 0a 09 09 09 20 ? statuses)....
b650: 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 #f....
b660: 20 28 63 6f 6e 63 20 22 20 73 74 61 74 75 73 20 (conc " status
b670: 22 0a 09 09 09 09 20 20 20 20 28 69 66 20 6e 6f "..... (if no
b680: 74 2d 69 6e 20 0a 09 09 09 09 09 22 20 4e 4f 54 t-in ......" NOT
b690: 20 49 4e 20 28 27 22 0a 09 09 09 09 09 22 20 49 IN ('"......" I
b6a0: 4e 20 28 27 22 29 20 0a 09 09 09 09 20 20 20 20 N ('") .....
b6b0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
b6c0: 72 73 65 20 73 74 61 74 75 73 65 73 20 22 27 2c rse statuses "',
b6d0: 27 22 29 0a 09 09 09 09 20 20 20 20 22 27 29 22 '")..... "')"
b6e0: 29 29 29 0a 09 20 28 73 74 61 74 65 73 2d 73 74 ))).. (states-st
b6f0: 61 74 75 73 65 73 2d 71 72 79 20 0a 09 20 20 28 atuses-qry .. (
b700: 63 6f 6e 64 20 0a 09 20 20 20 28 28 61 6e 64 20 cond .. ((and
b710: 73 74 61 74 65 73 2d 71 72 79 20 73 74 61 74 75 states-qry statu
b720: 73 65 73 2d 71 72 79 29 0a 09 20 20 20 20 28 63 ses-qry).. (c
b730: 6f 6e 63 20 22 20 41 4e 44 20 28 20 22 20 73 74 onc " AND ( " st
b740: 61 74 65 73 2d 71 72 79 20 22 20 41 4e 44 20 22 ates-qry " AND "
b750: 20 73 74 61 74 75 73 65 73 2d 71 72 79 20 22 20 statuses-qry "
b760: 29 20 22 29 29 0a 09 20 20 20 28 73 74 61 74 65 ) ")).. (state
b770: 73 2d 71 72 79 20 20 0a 09 20 20 20 20 28 63 6f s-qry .. (co
b780: 6e 63 20 22 20 41 4e 44 20 22 20 73 74 61 74 65 nc " AND " state
b790: 73 2d 71 72 79 29 29 0a 09 20 20 20 28 73 74 61 s-qry)).. (sta
b7a0: 74 75 73 65 73 2d 71 72 79 20 0a 09 20 20 20 20 tuses-qry ..
b7b0: 28 63 6f 6e 63 20 22 20 41 4e 44 20 22 20 73 74 (conc " AND " st
b7c0: 61 74 75 73 65 73 2d 71 72 79 29 29 0a 09 20 20 atuses-qry))..
b7d0: 20 28 65 6c 73 65 20 22 22 29 29 29 0a 09 20 28 (else ""))).. (
b7e0: 74 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 tests-match-qry
b7f0: 28 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 71 (tests:match->sq
b800: 6c 71 72 79 20 74 65 73 74 70 61 74 74 29 29 0a lqry testpatt)).
b810: 09 20 28 71 72 79 20 20 20 20 20 20 20 20 20 20 . (qry
b820: 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 (conc "SELECT
b830: 20 22 20 71 72 79 76 61 6c 73 74 72 0a 09 09 09 " qryvalstr....
b840: 09 22 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 ." FROM tests WH
b850: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
b860: 20 73 74 61 74 65 20 21 3d 20 27 44 45 4c 45 54 state != 'DELET
b870: 45 44 27 20 22 0a 09 09 09 09 73 74 61 74 65 73 ED' ".....states
b880: 2d 73 74 61 74 75 73 65 73 2d 71 72 79 0a 09 09 -statuses-qry...
b890: 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 74 63 ..(if tests-matc
b8a0: 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 41 4e h-qry (conc " AN
b8b0: 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 63 68 D (" tests-match
b8c0: 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 0a 09 -qry ") ") "")..
b8d0: 09 09 09 28 63 61 73 65 20 73 6f 72 74 2d 62 79 ...(case sort-by
b8e0: 0a 09 09 09 09 20 20 28 28 72 75 6e 64 69 72 29 ..... ((rundir)
b8f0: 20 20 20 20 20 20 22 20 4f 52 44 45 52 20 42 59 " ORDER BY
b900: 20 6c 65 6e 67 74 68 28 72 75 6e 64 69 72 29 20 length(rundir)
b910: 22 29 0a 09 09 09 09 20 20 28 28 74 65 73 74 6e ")..... ((testn
b920: 61 6d 65 29 20 20 20 20 28 63 6f 6e 63 20 22 20 ame) (conc "
b930: 4f 52 44 45 52 20 42 59 20 74 65 73 74 6e 61 6d ORDER BY testnam
b940: 65 20 22 20 28 69 66 20 73 6f 72 74 2d 6f 72 64 e " (if sort-ord
b950: 65 72 20 28 63 6f 6e 63 20 73 6f 72 74 2d 6f 72 er (conc sort-or
b960: 64 65 72 20 22 2c 22 29 20 22 22 29 20 22 20 69 der ",") "") " i
b970: 74 65 6d 5f 70 61 74 68 20 22 29 29 0a 09 09 09 tem_path "))....
b980: 09 20 20 28 28 73 74 61 74 65 73 74 61 74 75 73 . ((statestatus
b990: 29 20 28 63 6f 6e 63 20 22 20 4f 52 44 45 52 20 ) (conc " ORDER
b9a0: 42 59 20 73 74 61 74 65 20 22 20 28 69 66 20 20 BY state " (if
b9b0: 73 6f 72 74 2d 6f 72 64 65 72 20 28 63 6f 6e 63 sort-order (conc
b9c0: 20 73 6f 72 74 2d 6f 72 64 65 72 20 22 2c 22 29 sort-order ",")
b9d0: 20 22 22 29 20 22 20 73 74 61 74 75 73 20 22 29 "") " status ")
b9e0: 29 0a 09 09 09 09 20 20 28 28 65 76 65 6e 74 5f )..... ((event_
b9f0: 74 69 6d 65 29 20 20 22 20 4f 52 44 45 52 20 42 time) " ORDER B
ba00: 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 22 29 0a Y event_time ").
ba10: 09 09 09 09 20 20 28 65 6c 73 65 20 20 20 20 20 .... (else
ba20: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
ba30: 3f 20 73 6f 72 74 2d 62 79 29 0a 09 09 09 09 09 ? sort-by)......
ba40: 09 20 20 20 20 20 28 63 6f 6e 63 20 22 20 4f 52 . (conc " OR
ba50: 44 45 52 20 42 59 20 22 20 73 6f 72 74 2d 62 79 DER BY " sort-by
ba60: 20 22 20 22 29 0a 09 09 09 09 09 09 20 20 20 20 " ").......
ba70: 20 22 20 22 29 29 29 0a 09 09 09 09 28 69 66 20 " "))).....(if
ba80: 73 6f 72 74 2d 6f 72 64 65 72 20 73 6f 72 74 2d sort-order sort-
ba90: 6f 72 64 65 72 20 22 20 22 29 0a 09 09 09 09 28 order " ").....(
baa0: 69 66 20 6c 69 6d 69 74 20 20 28 63 6f 6e 63 20 if limit (conc
bab0: 22 20 4c 49 4d 49 54 20 22 20 6c 69 6d 69 74 29 " LIMIT " limit)
bac0: 20 20 20 22 20 22 29 0a 09 09 09 09 28 69 66 20 " ").....(if
bad0: 6f 66 66 73 65 74 20 28 63 6f 6e 63 20 22 20 4f offset (conc " O
bae0: 46 46 53 45 54 20 22 20 6f 66 66 73 65 74 29 20 FFSET " offset)
baf0: 22 20 22 29 0a 09 09 09 09 22 3b 22 0a 09 09 09 " ").....";"....
bb00: 09 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a .))). (debug:
bb10: 70 72 69 6e 74 2d 69 6e 66 6f 20 38 20 22 64 62 print-info 8 "db
bb20: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
bb30: 75 6e 20 71 72 79 3d 22 20 71 72 79 29 0a 20 20 un qry=" qry).
bb40: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
bb50: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c ach-row . (l
bb60: 61 6d 62 64 61 20 28 61 20 2e 20 62 29 20 3b 3b ambda (a . b) ;;
bb70: 20 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 6e id run-id testn
bb80: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
bb90: 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 event-time host
bba0: 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 cpuload diskfre
bbb0: 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 e uname rundir i
bbc0: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 tem-path run-dur
bbd0: 61 74 69 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66 ation final-logf
bbe0: 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 20 20 comment).
bbf0: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
bc00: 20 28 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 (apply vector a
bc10: 20 62 29 20 72 65 73 29 29 29 20 3b 3b 20 69 64 b) res))) ;; id
bc20: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
bc30: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
bc40: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
bc50: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
bc60: 6e 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d name rundir item
bc70: 2d 70 61 74 68 20 72 75 6e 2d 64 75 72 61 74 69 -path run-durati
bc80: 6f 6e 20 66 69 6e 61 6c 2d 6c 6f 67 66 20 63 6f on final-logf co
bc90: 6d 6d 65 6e 74 29 20 72 65 73 29 29 29 0a 20 20 mment) res))).
bca0: 20 20 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 (db:get-db db
bcb0: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 struct run-id).
bcc0: 20 20 20 20 71 72 79 0a 20 20 20 20 20 72 75 6e qry. run
bcd0: 2d 69 64 0a 20 20 20 20 20 29 0a 20 20 20 20 28 -id. ). (
bce0: 63 61 73 65 20 71 72 79 76 61 6c 73 0a 20 20 20 case qryvals.
bcf0: 20 20 20 28 28 73 68 6f 72 74 6c 69 73 74 29 28 ((shortlist)(
bd00: 6d 61 70 20 64 62 3a 74 65 73 74 2d 73 68 6f 72 map db:test-shor
bd10: 74 2d 72 65 63 6f 72 64 2d 3e 6e 6f 72 6d 20 72 t-record->norm r
bd20: 65 73 29 29 0a 20 20 20 20 20 20 28 28 23 66 29 es)). ((#f)
bd30: 20 20 20 20 20 20 20 72 65 73 29 0a 20 20 20 20 res).
bd40: 20 20 28 65 6c 73 65 20 20 20 20 20 20 20 72 65 (else re
bd50: 73 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 s))))..(define (
bd60: 64 62 3a 74 65 73 74 2d 73 68 6f 72 74 2d 72 65 db:test-short-re
bd70: 63 6f 72 64 2d 3e 6e 6f 72 6d 20 69 6e 72 65 63 cord->norm inrec
bd80: 29 0a 20 20 3b 3b 20 20 22 69 64 2c 72 75 6e 5f ). ;; "id,run_
bd90: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d id,testname,item
bda0: 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 61 74 _path,state,stat
bdb0: 75 73 22 0a 20 20 3b 3b 20 20 22 69 64 2c 72 75 us". ;; "id,ru
bdc0: 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 73 74 n_id,testname,st
bdd0: 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 ate,status,event
bde0: 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 6c 6f _time,host,cpulo
bdf0: 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e 61 6d ad,diskfree,unam
be00: 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d 5f 70 61 e,rundir,item_pa
be10: 74 68 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 2c th,run_duration,
be20: 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 final_logf,comme
be30: 6e 74 0a 20 20 28 76 65 63 74 6f 72 20 28 76 65 nt. (vector (ve
be40: 63 74 6f 72 2d 72 65 66 20 69 6e 72 65 63 20 30 ctor-ref inrec 0
be50: 29 20 3b 3b 20 69 64 0a 09 20 20 28 76 65 63 74 ) ;; id.. (vect
be60: 6f 72 2d 72 65 66 20 69 6e 72 65 63 20 31 29 20 or-ref inrec 1)
be70: 3b 3b 20 72 75 6e 5f 69 64 0a 09 20 20 28 76 65 ;; run_id.. (ve
be80: 63 74 6f 72 2d 72 65 66 20 69 6e 72 65 63 20 32 ctor-ref inrec 2
be90: 29 20 3b 3b 20 74 65 73 74 6e 61 6d 65 0a 09 20 ) ;; testname..
bea0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 6e 72 (vector-ref inr
beb0: 65 63 20 34 29 20 3b 3b 20 73 74 61 74 65 0a 09 ec 4) ;; state..
bec0: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 69 6e (vector-ref in
bed0: 72 65 63 20 35 29 20 3b 3b 20 73 74 61 74 75 73 rec 5) ;; status
bee0: 0a 09 20 20 2d 31 20 22 22 20 2d 31 20 2d 31 20 .. -1 "" -1 -1
bef0: 22 22 20 22 2d 22 20 0a 09 20 20 28 76 65 63 74 "" "-" .. (vect
bf00: 6f 72 2d 72 65 66 20 69 6e 72 65 63 20 33 29 20 or-ref inrec 3)
bf10: 3b 3b 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 20 ;; item-path..
bf20: 2d 31 20 22 2d 22 20 22 2d 22 29 29 0a 0a 0a 28 -1 "-" "-"))...(
bf30: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
bf40: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 ests-for-run-sta
bf50: 74 65 2d 73 74 61 74 75 73 20 64 62 20 72 75 6e te-status db run
bf60: 2d 69 64 20 74 65 73 74 70 61 74 74 29 0a 20 20 -id testpatt).
bf70: 28 6c 65 74 2a 20 28 28 72 65 73 20 20 20 20 20 (let* ((res
bf80: 20 20 20 20 20 20 20 27 28 29 29 0a 09 20 28 74 '()).. (t
bf90: 65 73 74 73 2d 6d 61 74 63 68 2d 71 72 79 20 28 ests-match-qry (
bfa0: 74 65 73 74 73 3a 6d 61 74 63 68 2d 3e 73 71 6c tests:match->sql
bfb0: 71 72 79 20 74 65 73 74 70 61 74 74 29 29 0a 09 qry testpatt))..
bfc0: 20 28 71 72 79 20 20 20 20 20 20 20 20 20 20 20 (qry
bfd0: 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 (conc "SELECT
bfe0: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d id,testname,item
bff0: 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 74 61 74 _path,state,stat
c000: 75 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 us FROM tests WH
c010: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 22 20 0a ERE run_id=? " .
c020: 09 09 09 09 28 69 66 20 74 65 73 74 73 2d 6d 61 ....(if tests-ma
c030: 74 63 68 2d 71 72 79 20 28 63 6f 6e 63 20 22 20 tch-qry (conc "
c040: 41 4e 44 20 28 22 20 74 65 73 74 73 2d 6d 61 74 AND (" tests-mat
c050: 63 68 2d 71 72 79 20 22 29 20 22 29 20 22 22 29 ch-qry ") ") "")
c060: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
c070: 72 69 6e 74 2d 69 6e 66 6f 20 38 20 22 64 62 3a rint-info 8 "db:
c080: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
c090: 6e 20 71 72 79 3d 22 20 71 72 79 29 0a 20 20 20 n qry=" qry).
c0a0: 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 (sqlite3:for-ea
c0b0: 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d ch-row. (lam
c0c0: 62 64 61 20 28 69 64 20 74 65 73 74 6e 61 6d 65 bda (id testname
c0d0: 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 65 item-path state
c0e0: 20 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 20 status).
c0f0: 3b 3b 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 ;; id,run_id,tes
c100: 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 tname,state,stat
c110: 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f us,event_time,ho
c120: 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 st,cpuload,diskf
c130: 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 ree,uname,rundir
c140: 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 ,item_path,run_d
c150: 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f uration,final_lo
c160: 67 66 2c 63 6f 6d 6d 65 6e 74 0a 20 20 20 20 20 gf,comment.
c170: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
c180: 73 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e s (vector id run
c190: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 -id testname sta
c1a0: 74 65 20 73 74 61 74 75 73 20 2d 31 20 22 22 20 te status -1 ""
c1b0: 2d 31 20 2d 31 20 22 22 20 22 2d 22 20 69 74 65 -1 -1 "" "-" ite
c1c0: 6d 2d 70 61 74 68 20 2d 31 20 22 2d 22 20 22 2d m-path -1 "-" "-
c1d0: 22 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 64 ") res))). d
c1e0: 62 20 0a 20 20 20 20 20 71 72 79 0a 20 20 20 20 b . qry.
c1f0: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 65 73 run-id). res
c200: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
c210: 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 get-testinfo-sta
c220: 74 65 2d 73 74 61 74 75 73 20 64 62 20 74 65 73 te-status db tes
c230: 74 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 28 72 t-id). (let ((r
c240: 65 73 20 20 20 20 20 20 20 20 20 20 20 20 23 66 es #f
c250: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
c260: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 for-each-row.
c270: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 (lambda (run-i
c280: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
c290: 70 61 74 68 20 73 74 61 74 65 20 73 74 61 74 75 path state statu
c2a0: 73 29 0a 20 20 20 20 20 20 20 3b 3b 20 69 64 2c s). ;; id,
c2b0: 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c run_id,testname,
c2c0: 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 state,status,eve
c2d0: 6e 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 nt_time,host,cpu
c2e0: 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e load,diskfree,un
c2f0: 61 6d 65 2c 72 75 6e 64 69 72 2c 69 74 65 6d 5f ame,rundir,item_
c300: 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 69 6f path,run_duratio
c310: 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f 6d n,final_logf,com
c320: 6d 65 6e 74 0a 20 20 20 20 20 20 20 28 73 65 74 ment. (set
c330: 21 20 72 65 73 20 28 76 65 63 74 6f 72 20 74 65 ! res (vector te
c340: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 st-id run-id tes
c350: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
c360: 75 73 20 2d 31 20 22 22 20 2d 31 20 2d 31 20 22 us -1 "" -1 -1 "
c370: 22 20 22 2d 22 20 69 74 65 6d 2d 70 61 74 68 20 " "-" item-path
c380: 2d 31 20 22 2d 22 20 22 2d 22 29 29 29 0a 20 20 -1 "-" "-"))).
c390: 20 20 20 64 62 20 0a 20 20 20 20 20 22 53 45 4c db . "SEL
c3a0: 45 43 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e ECT run_id,testn
c3b0: 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 ame,item_path,st
c3c0: 61 74 65 2c 73 74 61 74 75 73 20 46 52 4f 4d 20 ate,status FROM
c3d0: 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f tests WHERE id=?
c3e0: 3b 22 20 0a 20 20 20 20 20 74 65 73 74 2d 69 64 ;" . test-id
c3f0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 ). res))..;;
c400: 67 65 74 20 61 20 75 73 65 66 75 6c 20 73 75 62 get a useful sub
c410: 73 65 74 20 6f 66 20 74 68 65 20 74 65 73 74 73 set of the tests
c420: 20 64 61 74 61 20 28 75 73 65 64 20 69 6e 20 64 data (used in d
c430: 61 73 68 62 6f 61 72 64 0a 3b 3b 20 75 73 65 20 ashboard.;; use
c440: 64 62 3a 6d 69 6e 74 65 73 74 73 2d 67 65 74 2d db:mintests-get-
c450: 7b 69 64 20 2c 72 75 6e 5f 69 64 2c 74 65 73 74 {id ,run_id,test
c460: 6e 61 6d 65 20 2e 2e 2e 7d 0a 28 64 65 66 69 6e name ...}.(defin
c470: 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d e (db:get-tests-
c480: 66 6f 72 2d 72 75 6e 73 2d 6d 69 6e 64 61 74 61 for-runs-mindata
c490: 20 64 62 20 72 75 6e 2d 69 64 73 20 74 65 73 74 db run-ids test
c4a0: 70 61 74 74 20 73 74 61 74 65 73 20 73 74 61 74 patt states stat
c4b0: 75 73 20 6e 6f 74 2d 69 6e 29 0a 20 20 28 64 62 us not-in). (db
c4c0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
c4d0: 75 6e 73 20 64 62 20 72 75 6e 2d 69 64 73 20 74 uns db run-ids t
c4e0: 65 73 74 70 61 74 74 20 73 74 61 74 65 73 20 73 estpatt states s
c4f0: 74 61 74 75 73 20 6e 6f 74 2d 69 6e 3a 20 6e 6f tatus not-in: no
c500: 74 2d 69 6e 20 71 72 79 76 61 6c 73 3a 20 22 69 t-in qryvals: "i
c510: 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d d,run_id,testnam
c520: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 e,state,status,e
c530: 76 65 6e 74 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 vent_time,item_p
c540: 61 74 68 22 29 29 0a 0a 3b 3b 20 43 6f 6e 76 65 ath"))..;; Conve
c550: 72 74 20 63 61 6c 6c 69 6e 67 20 72 6f 75 74 69 rt calling routi
c560: 6e 65 73 20 74 6f 20 67 65 74 20 6c 69 73 74 20 nes to get list
c570: 6f 66 20 72 75 6e 2d 69 64 73 20 61 6e 64 20 6c of run-ids and l
c580: 6f 6f 70 2c 20 64 6f 20 6e 6f 74 20 75 73 65 20 oop, do not use
c590: 74 68 65 20 67 65 74 2d 74 65 73 74 73 2d 66 6f the get-tests-fo
c5a0: 72 2d 72 75 6e 73 0a 3b 3b 0a 0a 28 64 65 66 69 r-runs.;;..(defi
c5b0: 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 ne (db:delete-te
c5c0: 73 74 2d 72 65 63 6f 72 64 73 20 64 62 73 74 72 st-records dbstr
c5d0: 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d uct run-id test-
c5e0: 69 64 29 0a 20 20 28 6c 65 74 20 28 28 64 62 20 id). (let ((db
c5f0: 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 (db:get-db dbstr
c600: 75 63 74 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 uct run-id))).
c610: 20 20 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 61 (db:general-ca
c620: 6c 6c 20 64 62 20 27 64 65 6c 65 74 65 2d 74 65 ll db 'delete-te
c630: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 st-step-records
c640: 28 6c 69 73 74 20 74 65 73 74 2d 69 64 29 29 0a (list test-id)).
c650: 20 20 20 20 28 64 62 3a 67 65 6e 65 72 61 6c 2d (db:general-
c660: 63 61 6c 6c 20 64 62 20 27 64 65 6c 65 74 65 2d call db 'delete-
c670: 74 65 73 74 2d 64 61 74 61 2d 72 65 63 6f 72 64 test-data-record
c680: 73 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 29 s (list test-id)
c690: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 ). (sqlite3:e
c6a0: 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 xecute db "UPDAT
c6b0: 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
c6c0: 65 3d 27 44 45 4c 45 54 45 44 27 2c 73 74 61 74 e='DELETED',stat
c6d0: 75 73 3d 27 6e 2f 61 27 2c 63 6f 6d 6d 65 6e 74 us='n/a',comment
c6e0: 3d 27 27 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 ='' WHERE id=?;"
c6f0: 20 74 65 73 74 2d 69 64 29 29 29 0a 0a 28 64 65 test-id)))..(de
c700: 66 69 6e 65 20 28 64 62 3a 64 65 6c 65 74 65 2d fine (db:delete-
c710: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 tests-for-run db
c720: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 dbstruct run-id)
c730: 0a 20 20 28 6c 65 74 20 28 28 64 62 20 28 64 62 . (let ((db (db
c740: 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
c750: 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 20 run-id))).
c760: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
c770: 20 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d db "DELETE FROM
c780: 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e tests WHERE run
c790: 5f 69 64 3d 3f 3b 22 20 72 75 6e 2d 69 64 29 29 _id=?;" run-id))
c7a0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 64 )..(define (db:d
c7b0: 65 6c 65 74 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 elete-old-delete
c7c0: 64 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 20 64 d-test-records d
c7d0: 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 74 20 bstruct). (let
c7e0: 28 28 72 75 6e 2d 69 64 73 20 20 28 64 62 3a 67 ((run-ids (db:g
c7f0: 65 74 2d 61 6c 6c 2d 72 75 6e 2d 69 64 73 20 64 et-all-run-ids d
c800: 62 73 74 72 75 63 74 29 29 0a 09 28 74 61 72 67 bstruct))..(targ
c810: 74 69 6d 65 20 28 2d 20 28 63 75 72 72 65 6e 74 time (- (current
c820: 2d 73 65 63 6f 6e 64 73 29 28 2a 20 33 30 20 32 -seconds)(* 30 2
c830: 34 20 36 30 20 36 30 29 29 29 29 20 3b 3b 20 6f 4 60 60)))) ;; o
c840: 6e 65 20 6d 6f 6e 74 68 20 69 6e 20 74 68 65 20 ne month in the
c850: 70 61 73 74 0a 20 20 20 20 28 66 6f 72 2d 65 61 past. (for-ea
c860: 63 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ch. (lambda
c870: 28 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 20 20 (run-id).
c880: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
c890: 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 (db:get-db dbst
c8a0: 72 75 63 74 20 72 75 6e 2d 69 64 29 20 22 44 45 ruct run-id) "DE
c8b0: 4c 45 54 45 20 46 52 4f 4d 20 74 65 73 74 73 20 LETE FROM tests
c8c0: 57 48 45 52 45 20 73 74 61 74 65 3d 27 44 45 4c WHERE state='DEL
c8d0: 45 54 45 44 27 20 41 4e 44 20 65 76 65 6e 74 5f ETED' AND event_
c8e0: 74 69 6d 65 3c 3f 3b 22 20 74 61 72 67 74 69 6d time<?;" targtim
c8f0: 65 29 29 0a 20 20 20 20 20 72 75 6e 2d 69 64 73 e)). run-ids
c900: 29 29 29 0a 0a 3b 3b 20 73 65 74 20 74 65 73 74 )))..;; set test
c910: 73 20 77 69 74 68 20 73 74 61 74 65 20 63 75 72 s with state cur
c920: 72 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 rstate and statu
c930: 73 20 63 75 72 72 73 74 61 74 75 73 20 74 6f 20 s currstatus to
c940: 6e 65 77 73 74 61 74 65 20 61 6e 64 20 6e 65 77 newstate and new
c950: 73 74 61 74 75 73 0a 3b 3b 20 75 73 65 20 63 75 status.;; use cu
c960: 72 72 73 74 61 74 65 20 3d 20 23 66 20 61 6e 64 rrstate = #f and
c970: 20 6f 72 20 63 75 72 72 73 74 61 74 75 73 20 3d or currstatus =
c980: 20 23 66 20 74 6f 20 61 70 70 6c 79 20 74 6f 20 #f to apply to
c990: 61 6e 79 20 73 74 61 74 65 20 6f 72 20 73 74 61 any state or sta
c9a0: 74 75 73 20 72 65 73 70 65 63 74 69 76 65 6c 79 tus respectively
c9b0: 0a 3b 3b 20 57 41 52 4e 49 4e 47 3a 20 53 51 4c .;; WARNING: SQL
c9c0: 20 69 6e 6a 65 63 74 69 6f 6e 20 72 69 73 6b 2e injection risk.
c9d0: 20 4e 42 2f 2f 20 53 65 65 20 6e 65 77 20 62 75 NB// See new bu
c9e0: 74 20 6e 6f 74 20 79 65 74 20 75 73 65 64 20 22 t not yet used "
c9f0: 66 61 73 74 65 72 22 20 76 65 72 73 69 6f 6e 20 faster" version
ca00: 62 65 6c 6f 77 0a 3b 3b 0a 28 64 65 66 69 6e 65 below.;;.(define
ca10: 20 28 64 62 3a 73 65 74 2d 74 65 73 74 73 2d 73 (db:set-tests-s
ca20: 74 61 74 65 2d 73 74 61 74 75 73 20 64 62 73 74 tate-status dbst
ca30: 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 ruct run-id test
ca40: 6e 61 6d 65 73 20 63 75 72 72 73 74 61 74 65 20 names currstate
ca50: 63 75 72 72 73 74 61 74 75 73 20 6e 65 77 73 74 currstatus newst
ca60: 61 74 65 20 6e 65 77 73 74 61 74 75 73 29 0a 20 ate newstatus).
ca70: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
ca80: 64 61 20 28 74 65 73 74 6e 61 6d 65 29 0a 09 20 da (testname)..
ca90: 20 20 20 20 20 28 6c 65 74 20 28 28 71 72 79 20 (let ((qry
caa0: 28 63 6f 6e 63 20 22 55 50 44 41 54 45 20 74 65 (conc "UPDATE te
cab0: 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c sts SET state=?,
cac0: 73 74 61 74 75 73 3d 3f 20 57 48 45 52 45 20 22 status=? WHERE "
cad0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 63 .... (if c
cae0: 75 72 72 73 74 61 74 65 20 20 28 63 6f 6e 63 20 urrstate (conc
caf0: 22 73 74 61 74 65 3d 27 22 20 63 75 72 72 73 74 "state='" currst
cb00: 61 74 65 20 22 27 20 41 4e 44 20 22 29 20 22 22 ate "' AND ") ""
cb10: 29 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ).... (if
cb20: 63 75 72 72 73 74 61 74 75 73 20 28 63 6f 6e 63 currstatus (conc
cb30: 20 22 73 74 61 74 75 73 3d 27 22 20 63 75 72 72 "status='" curr
cb40: 73 74 61 74 75 73 20 22 27 20 41 4e 44 20 22 29 status "' AND ")
cb50: 20 22 22 29 0a 09 09 09 20 20 20 20 20 20 20 22 "").... "
cb60: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
cb70: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 4e 4f 54 stname=? AND NOT
cb80: 20 28 69 74 65 6d 5f 70 61 74 68 3d 27 27 20 41 (item_path='' A
cb90: 4e 44 20 74 65 73 74 6e 61 6d 65 20 69 6e 20 28 ND testname in (
cba0: 53 45 4c 45 43 54 20 44 49 53 54 49 4e 43 54 20 SELECT DISTINCT
cbb0: 74 65 73 74 6e 61 6d 65 20 46 52 4f 4d 20 74 65 testname FROM te
cbc0: 73 74 73 20 57 48 45 52 45 20 74 65 73 74 6e 61 sts WHERE testna
cbd0: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
cbe0: 74 68 20 21 3d 20 27 27 29 29 3b 22 29 29 29 0a th != ''));"))).
cbf0: 09 09 3b 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 ..;;(debug:print
cc00: 20 30 20 22 51 52 59 3a 20 22 20 71 72 79 29 0a 0 "QRY: " qry).
cc10: 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ..(sqlite3:execu
cc20: 74 65 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 te (db:get-db db
cc30: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 20 71 struct run-id) q
cc40: 72 79 20 72 75 6e 2d 69 64 20 6e 65 77 73 74 61 ry run-id newsta
cc50: 74 65 20 6e 65 77 73 74 61 74 75 73 20 74 65 73 te newstatus tes
cc60: 74 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 29 tname testname))
cc70: 29 0a 09 20 20 20 20 74 65 73 74 6e 61 6d 65 73 ).. testnames
cc80: 29 29 0a 0a 3b 3b 20 73 70 65 65 64 20 75 70 20 ))..;; speed up
cc90: 66 6f 72 20 63 6f 6d 6d 6f 6e 20 63 61 73 65 73 for common cases
cca0: 20 77 69 74 68 20 61 20 6c 69 74 74 6c 65 20 6c with a little l
ccb0: 6f 67 69 63 0a 3b 3b 20 4e 42 2f 2f 20 55 6c 74 ogic.;; NB// Ult
ccc0: 69 6d 61 74 65 6c 79 20 74 68 69 73 20 77 69 6c imately this wil
ccd0: 6c 20 62 65 20 64 65 70 72 65 63 61 74 65 64 20 l be deprecated
cce0: 69 6e 20 64 65 66 65 72 65 6e 63 65 20 74 6f 20 in deference to
ccf0: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 mt:test-set-stat
cd00: 65 2d 73 74 61 74 75 73 2d 62 79 2d 69 64 0a 3b e-status-by-id.;
cd10: 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ;.(define (db:te
cd20: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
cd30: 74 75 73 2d 62 79 2d 69 64 20 64 62 73 74 72 75 tus-by-id dbstru
cd40: 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ct run-id test-i
cd50: 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 d newstate newst
cd60: 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 atus newcomment)
cd70: 0a 20 20 28 6c 65 74 20 28 28 64 62 20 28 64 62 . (let ((db (db
cd80: 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
cd90: 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 28 run-id))). (
cda0: 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 6e 64 20 cond. ((and
cdb0: 6e 65 77 73 74 61 74 65 20 6e 65 77 73 74 61 74 newstate newstat
cdc0: 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 29 0a 20 us newcomment).
cdd0: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
cde0: 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
cdf0: 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 tests SET state
ce00: 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c 63 6f 6d 6d =?,status=?,comm
ce10: 65 6e 74 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f ent=? WHERE id=?
ce20: 3b 22 20 6e 65 77 73 74 61 74 65 20 6e 65 77 73 ;" newstate news
ce30: 74 61 74 75 73 20 6e 65 77 63 6f 6d 6d 65 6e 74 tatus newcomment
ce40: 20 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 20 test-id)).
ce50: 28 28 61 6e 64 20 6e 65 77 73 74 61 74 65 20 6e ((and newstate n
ce60: 65 77 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 ewstatus).
ce70: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
ce80: 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 db "UPDATE test
ce90: 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 s SET state=?,st
cea0: 61 74 75 73 3d 3f 20 57 48 45 52 45 20 69 64 3d atus=? WHERE id=
ceb0: 3f 3b 22 20 6e 65 77 73 74 61 74 65 20 6e 65 77 ?;" newstate new
cec0: 73 74 61 74 75 73 20 74 65 73 74 2d 69 64 29 29 status test-id))
ced0: 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 . (else.
cee0: 20 20 28 69 66 20 6e 65 77 73 74 61 74 65 20 20 (if newstate
cef0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
cf00: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
cf10: 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 20 20 ts SET state=?
cf20: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 WHERE id=?;" ne
cf30: 77 73 74 61 74 65 20 20 20 74 65 73 74 2d 69 64 wstate test-id
cf40: 29 29 0a 20 20 20 20 20 20 28 69 66 20 6e 65 77 )). (if new
cf50: 73 74 61 74 75 73 20 20 28 73 71 6c 69 74 65 33 status (sqlite3
cf60: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
cf70: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 ATE tests SET st
cf80: 61 74 75 73 3d 3f 20 20 57 48 45 52 45 20 69 64 atus=? WHERE id
cf90: 3d 3f 3b 22 20 6e 65 77 73 74 61 74 75 73 20 20 =?;" newstatus
cfa0: 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 20 20 test-id)).
cfb0: 28 69 66 20 6e 65 77 63 6f 6d 6d 65 6e 74 20 28 (if newcomment (
cfc0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
cfd0: 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 db "UPDATE tests
cfe0: 20 53 45 54 20 63 6f 6d 6d 65 6e 74 3d 3f 20 57 SET comment=? W
cff0: 48 45 52 45 20 69 64 3d 3f 3b 22 20 6e 65 77 63 HERE id=?;" newc
d000: 6f 6d 6d 65 6e 74 20 74 65 73 74 2d 69 64 29 29 omment test-id))
d010: 29 29 0a 20 20 20 20 28 6d 74 3a 70 72 6f 63 65 )). (mt:proce
d020: 73 73 2d 74 72 69 67 67 65 72 73 20 74 65 73 74 ss-triggers test
d030: 2d 69 64 20 6e 65 77 73 74 61 74 65 20 6e 65 77 -id newstate new
d040: 73 74 61 74 75 73 29 29 29 0a 0a 3b 3b 20 4e 65 status)))..;; Ne
d050: 76 65 72 20 75 73 65 64 2c 20 62 75 74 20 73 68 ver used, but sh
d060: 6f 75 6c 64 20 62 65 3f 0a 28 64 65 66 69 6e 65 ould be?.(define
d070: 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 (db:test-set-st
d080: 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 72 75 ate-status-by-ru
d090: 6e 2d 69 64 2d 74 65 73 74 6e 61 6d 65 20 64 62 n-id-testname db
d0a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
d0b0: 65 20 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 e item-path stat
d0c0: 75 73 20 73 74 61 74 65 29 0a 20 20 28 73 71 6c us state). (sql
d0d0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
d0e0: 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 "UPDATE tests SE
d0f0: 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 T state=?,status
d100: 3d 3f 2c 65 76 65 6e 74 5f 74 69 6d 65 3d 73 74 =?,event_time=st
d110: 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 rftime('%s','now
d120: 27 29 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d ') WHERE run_id=
d130: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f ? AND testname=?
d140: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f AND item_path=?
d150: 3b 22 20 0a 20 09 09 20 20 20 73 74 61 74 65 20 ;" . .. state
d160: 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 status run-id te
d170: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
d180: 68 29 29 0a 0a 3b 3b 20 4e 45 57 20 42 45 48 41 h))..;; NEW BEHA
d190: 56 49 4f 52 3a 20 43 6f 75 6e 74 20 74 65 73 74 VIOR: Count test
d1a0: 73 20 72 75 6e 6e 69 6e 67 20 69 6e 20 6f 6e 6c s running in onl
d1b0: 79 20 6f 6e 65 20 72 75 6e 21 0a 3b 3b 0a 28 64 y one run!.;;.(d
d1c0: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 63 6f efine (db:get-co
d1d0: 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e 69 6e unt-tests-runnin
d1e0: 67 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 g dbstruct run-i
d1f0: 64 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 d). (let ((res
d200: 30 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 0)). (sqlite3
d210: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
d220: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e (lambda (coun
d230: 74 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 t). (set!
d240: 72 65 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 res count)).
d250: 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 (db:get-db dbst
d260: 72 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 20 20 ruct run-id).
d270: 20 20 22 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 "SELECT count(
d280: 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 id) FROM tests W
d290: 48 45 52 45 20 73 74 61 74 65 20 69 6e 20 28 27 HERE state in ('
d2a0: 52 55 4e 4e 49 4e 47 27 2c 27 4c 41 55 4e 43 48 RUNNING','LAUNCH
d2b0: 45 44 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 ED','REMOTEHOSTS
d2c0: 54 41 52 54 27 29 3b 22 29 0a 20 20 20 20 72 65 TART');"). re
d2d0: 73 29 29 0a 0a 3b 3b 20 4e 45 57 20 42 45 48 41 s))..;; NEW BEHA
d2e0: 56 49 4f 52 3a 20 4c 6f 6f 6b 20 6f 6e 6c 79 20 VIOR: Look only
d2f0: 61 74 20 73 69 6e 67 6c 65 20 72 75 6e 20 77 69 at single run wi
d300: 74 68 20 72 75 6e 2d 69 64 0a 3b 3b 20 0a 3b 3b th run-id.;; .;;
d310: 20 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 (define (db:get
d320: 2d 72 75 6e 6e 69 6e 67 2d 73 74 61 74 73 20 64 -running-stats d
d330: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a bstruct run-id).
d340: 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d (define (db:get-
d350: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
d360: 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d 69 64 20 64 ing-for-run-id d
d370: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a bstruct run-id).
d380: 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 29 (let ((res 0))
d390: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
d3a0: 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
d3b0: 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a (lambda (count).
d3c0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
d3d0: 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 28 64 count)). (d
d3e0: 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 b:get-db dbstruc
d3f0: 74 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 22 t run-id). "
d400: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
d410: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
d420: 45 20 73 74 61 74 65 20 69 6e 20 28 27 52 55 4e E state in ('RUN
d430: 4e 49 4e 47 27 2c 27 4c 41 55 4e 43 48 45 44 27 NING','LAUNCHED'
d440: 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 ,'REMOTEHOSTSTAR
d450: 54 27 29 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f T') AND run_id=?
d460: 3b 22 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 72 ;" run-id). r
d470: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 es))..(define (d
d480: 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 b:get-count-test
d490: 73 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 s-running-in-job
d4a0: 67 72 6f 75 70 20 64 62 73 74 72 75 63 74 20 72 group dbstruct r
d4b0: 75 6e 2d 69 64 20 6a 6f 62 67 72 6f 75 70 29 0a un-id jobgroup).
d4c0: 20 20 28 69 66 20 28 6e 6f 74 20 6a 6f 62 67 72 (if (not jobgr
d4d0: 6f 75 70 29 0a 20 20 20 20 20 20 30 20 3b 3b 20 oup). 0 ;;
d4e0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 . (let ((re
d4f0: 73 20 30 29 29 0a 09 28 73 71 6c 69 74 65 33 3a s 0))..(sqlite3:
d500: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 28 for-each-row.. (
d510: 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 0a 09 lambda (count)..
d520: 20 20 20 28 73 65 74 21 20 72 65 73 20 63 6f 75 (set! res cou
d530: 6e 74 29 29 0a 09 20 28 64 62 3a 67 65 74 2d 64 nt)).. (db:get-d
d540: 62 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 b dbstruct run-i
d550: 64 29 0a 09 20 22 53 45 4c 45 43 54 20 63 6f 75 d).. "SELECT cou
d560: 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 nt(id) FROM test
d570: 73 20 57 48 45 52 45 20 73 74 61 74 65 20 3d 20 s WHERE state =
d580: 27 52 55 4e 4e 49 4e 47 27 20 4f 52 20 73 74 61 'RUNNING' OR sta
d590: 74 65 20 3d 20 27 4c 41 55 4e 43 48 45 44 27 20 te = 'LAUNCHED'
d5a0: 4f 52 20 73 74 61 74 65 20 3d 20 27 52 45 4d 4f OR state = 'REMO
d5b0: 54 45 48 4f 53 54 53 54 41 52 54 27 0a 20 20 20 TEHOSTSTART'.
d5c0: 20 20 20 20 20 20 20 20 20 20 41 4e 44 20 74 65 AND te
d5d0: 73 74 6e 61 6d 65 20 69 6e 20 28 53 45 4c 45 43 stname in (SELEC
d5e0: 54 20 74 65 73 74 6e 61 6d 65 20 46 52 4f 4d 20 T testname FROM
d5f0: 74 65 73 74 5f 6d 65 74 61 20 57 48 45 52 45 20 test_meta WHERE
d600: 6a 6f 62 67 72 6f 75 70 3d 3f 29 3b 22 0a 09 20 jobgroup=?);"..
d610: 6a 6f 62 67 72 6f 75 70 29 0a 09 72 65 73 29 29 jobgroup)..res))
d620: 29 0a 0a 3b 3b 20 64 6f 6e 65 20 77 69 74 68 20 )..;; done with
d630: 72 75 6e 20 77 68 65 6e 3a 0a 3b 3b 20 20 20 30 run when:.;; 0
d640: 20 74 65 73 74 73 20 69 6e 20 4c 41 55 4e 43 48 tests in LAUNCH
d650: 45 44 2c 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c ED, NOT_STARTED,
d660: 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 REMOTEHOSTSTART
d670: 2c 20 52 55 4e 4e 49 4e 47 0a 28 64 65 66 69 6e , RUNNING.(defin
d680: 65 20 28 64 62 3a 65 73 74 69 6d 61 74 65 64 2d e (db:estimated-
d690: 74 65 73 74 73 2d 72 65 6d 61 69 6e 69 6e 67 20 tests-remaining
d6a0: 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 dbstruct run-id)
d6b0: 0a 20 20 28 6c 65 74 20 28 28 72 65 73 20 30 29 . (let ((res 0)
d6c0: 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 ). (sqlite3:f
d6d0: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
d6e0: 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e 74 29 (lambda (count)
d6f0: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
d700: 73 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 28 s count)). (
d710: 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 db:get-db dbstru
d720: 63 74 20 72 75 6e 2d 69 64 29 20 3b 3b 20 4e 42 ct run-id) ;; NB
d730: 2f 2f 20 4b 49 4c 4c 52 45 51 20 6d 65 61 6e 73 // KILLREQ means
d740: 20 74 68 65 20 6a 6f 62 73 20 69 73 20 73 74 69 the jobs is sti
d750: 6c 6c 20 70 72 6f 62 61 62 6c 79 20 72 75 6e 6e ll probably runn
d760: 69 6e 67 0a 20 20 20 20 20 22 53 45 4c 45 43 54 ing. "SELECT
d770: 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 count(id) FROM
d780: 74 65 73 74 73 20 57 48 45 52 45 20 73 74 61 74 tests WHERE stat
d790: 65 20 69 6e 20 28 27 4c 41 55 4e 43 48 45 44 27 e in ('LAUNCHED'
d7a0: 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 ,'NOT_STARTED','
d7b0: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 27 REMOTEHOSTSTART'
d7c0: 2c 27 52 55 4e 4e 49 4e 47 27 2c 27 4b 49 4c 4c ,'RUNNING','KILL
d7d0: 52 45 51 27 29 3b 22 29 0a 20 20 20 20 72 65 73 REQ');"). res
d7e0: 29 29 0a 0a 3b 3b 20 6d 61 70 20 72 75 6e 2d 69 ))..;; map run-i
d7f0: 64 2c 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d d, testname item
d800: 2d 70 61 74 68 20 74 6f 20 74 65 73 74 2d 69 64 -path to test-id
d810: 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 .(define (db:get
d820: 2d 74 65 73 74 2d 69 64 20 64 62 73 74 72 75 63 -test-id dbstruc
d830: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d t run-id testnam
d840: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
d850: 6c 65 74 2a 20 28 28 72 65 73 20 23 66 29 29 0a let* ((res #f)).
d860: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
d870: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
d880: 6c 61 6d 62 64 61 20 28 69 64 29 20 3b 3b 20 20 lambda (id) ;;
d890: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
d8a0: 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 state status eve
d8b0: 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 75 nt-time host cpu
d8c0: 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e load diskfree un
d8d0: 61 6d 65 20 72 75 6e 64 69 72 20 69 74 65 6d 2d ame rundir item-
d8e0: 70 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f path run_duratio
d8f0: 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d n final_logf com
d900: 6d 65 6e 74 20 29 0a 20 20 20 20 20 20 20 28 73 ment ). (s
d910: 65 74 21 20 72 65 73 20 69 64 29 29 20 3b 3b 20 et! res id)) ;;
d920: 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 (vector id run-i
d930: 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 65 d testname state
d940: 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 69 status event-ti
d950: 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 me host cpuload
d960: 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 diskfree uname r
d970: 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 20 undir item-path
d980: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
d990: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 al_logf comment
d9a0: 29 29 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 ))). (db:get
d9b0: 2d 64 62 20 64 62 73 74 72 75 63 74 20 72 75 6e -db dbstruct run
d9c0: 2d 69 64 29 0a 20 20 20 20 20 22 53 45 4c 45 43 -id). "SELEC
d9d0: 54 20 69 64 20 46 52 4f 4d 20 74 65 73 74 73 20 T id FROM tests
d9e0: 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f WHERE testname=?
d9f0: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f AND item_path=?
da00: 3b 22 0a 20 20 20 20 20 74 65 73 74 6e 61 6d 65 ;". testname
da10: 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 20 20 item-path).
da20: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 64 res))..(define d
da30: 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 71 72 b:test-record-qr
da40: 79 2d 73 65 6c 65 63 74 6f 72 20 22 69 64 2c 72 y-selector "id,r
da50: 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 73 un_id,testname,s
da60: 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e tate,status,even
da70: 74 5f 74 69 6d 65 2c 68 6f 73 74 2c 63 70 75 6c t_time,host,cpul
da80: 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e 61 oad,diskfree,una
da90: 6d 65 2c 72 75 6e 64 69 72 5f 69 64 2c 69 74 65 me,rundir_id,ite
daa0: 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 72 61 74 m_path,run_durat
dab0: 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 ion,final_logf,c
dac0: 6f 6d 6d 65 6e 74 2c 72 65 61 6c 64 69 72 5f 69 omment,realdir_i
dad0: 64 22 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 55 73 d")..;; NOTE: Us
dae0: 65 20 64 62 3a 74 65 73 74 2d 67 65 74 2a 20 74 e db:test-get* t
daf0: 6f 20 61 63 63 65 73 73 20 72 65 63 6f 72 64 73 o access records
db00: 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 69 73 20 6e .;; NOTE: This n
db10: 65 65 64 73 20 72 75 6e 64 69 72 5f 69 64 20 64 eeds rundir_id d
db20: 65 63 6f 64 69 6e 67 3f 20 44 65 63 69 64 65 2c ecoding? Decide,
db30: 20 64 65 63 6f 64 65 20 68 65 72 65 20 6f 72 20 decode here or
db40: 77 68 65 72 65 20 75 73 65 64 3f 20 46 6f 72 20 where used? For
db50: 74 68 65 20 6d 6f 6d 65 6e 74 20 64 65 63 6f 64 the moment decod
db60: 65 20 77 68 65 72 65 20 75 73 65 64 2e 0a 28 64 e where used..(d
db70: 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 61 6c efine (db:get-al
db80: 6c 2d 74 65 73 74 73 2d 69 6e 66 6f 2d 62 79 2d l-tests-info-by-
db90: 72 75 6e 2d 69 64 20 64 62 73 74 72 75 63 74 20 run-id dbstruct
dba0: 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 20 28 run-id). (let (
dbb0: 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 (res '())). (
dbc0: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
dbd0: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
dbe0: 61 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73 a (id run-id tes
dbf0: 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 tname state stat
dc00: 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 6f us event-time ho
dc10: 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 st cpuload diskf
dc20: 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 72 ree uname rundir
dc30: 20 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 item-path run_d
dc40: 75 72 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f uration final_lo
dc50: 67 66 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 20 20 gf comment).
dc60: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
dc70: 20 20 20 20 20 20 30 20 20 20 20 31 20 20 20 20 0 1
dc80: 20 20 20 32 20 20 20 20 20 20 33 20 20 20 20 20 2 3
dc90: 20 34 20 20 20 20 20 20 20 20 35 20 20 20 20 20 4 5
dca0: 20 20 36 20 20 20 20 20 20 37 20 20 20 20 20 20 6 7
dcb0: 20 20 38 20 20 20 20 20 39 20 20 20 20 20 31 30 8 9 10
dcc0: 20 20 20 20 20 20 31 31 20 20 20 20 20 20 20 20 11
dcd0: 20 20 31 32 20 20 20 20 20 20 20 20 20 20 31 33 12 13
dce0: 20 20 20 20 20 20 20 31 34 0a 20 20 20 20 20 20 14.
dcf0: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
dd00: 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d (vector id run-
dd10: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
dd20: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
dd30: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
dd40: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
dd50: 72 75 6e 64 69 72 20 69 74 65 6d 2d 70 61 74 68 rundir item-path
dd60: 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 run_duration fi
dd70: 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 nal_logf comment
dd80: 29 0a 09 09 20 20 20 20 20 20 20 72 65 73 29 29 )... res))
dd90: 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 2d 64 ). (db:get-d
dda0: 62 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 b dbstruct run-i
ddb0: 64 29 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 53 d). (conc "S
ddc0: 45 4c 45 43 54 20 22 20 64 62 3a 74 65 73 74 2d ELECT " db:test-
ddd0: 72 65 63 6f 72 64 2d 71 72 79 2d 73 65 6c 65 63 record-qry-selec
dde0: 74 6f 72 20 22 20 46 52 4f 4d 20 74 65 73 74 73 tor " FROM tests
ddf0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 3b WHERE run_id=?;
de00: 22 29 0a 20 20 20 20 20 72 75 6e 2d 69 64 29 0a "). run-id).
de10: 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 20 47 65 res))..;; Ge
de20: 74 20 74 65 73 74 20 64 61 74 61 20 75 73 69 6e t test data usin
de30: 67 20 74 65 73 74 5f 69 64 0a 28 64 65 66 69 6e g test_id.(defin
de40: 65 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 e (db:get-test-i
de50: 6e 66 6f 2d 62 79 2d 69 64 20 64 62 73 74 72 75 nfo-by-id dbstru
de60: 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ct run-id test-i
de70: 64 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 d). (let ((
de80: 72 65 73 20 23 66 29 29 0a 09 28 73 71 6c 69 74 res #f))..(sqlit
de90: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a e3:for-each-row.
dea0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 (lambda (id
deb0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
dec0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 state status ev
ded0: 65 6e 74 2d 74 69 6d 65 20 68 6f 73 74 20 63 70 ent-time host cp
dee0: 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 uload diskfree u
def0: 6e 61 6d 65 20 72 75 6e 64 69 72 2d 69 64 20 69 name rundir-id i
df00: 74 65 6d 2d 70 61 74 68 20 72 75 6e 5f 64 75 72 tem-path run_dur
df10: 61 74 69 6f 6e 20 66 69 6e 61 6c 5f 6c 6f 67 66 ation final_logf
df20: 20 63 6f 6d 6d 65 6e 74 20 72 65 61 6c 64 69 72 comment realdir
df30: 2d 69 64 29 0a 09 20 20 20 3b 3b 20 20 20 20 20 -id).. ;;
df40: 20 20 20 20 20 20 20 20 20 20 20 20 30 20 20 20 0
df50: 20 31 20 20 20 20 20 20 20 32 20 20 20 20 20 20 1 2
df60: 33 20 20 20 20 20 20 34 20 20 20 20 20 20 20 20 3 4
df70: 35 20 20 20 20 20 20 20 36 20 20 20 20 20 20 37 5 6 7
df80: 20 20 20 20 20 20 20 20 38 20 20 20 20 20 39 20 8 9
df90: 20 20 20 20 31 30 20 20 20 20 20 20 31 31 20 20 10 11
dfa0: 20 20 20 20 20 20 20 20 31 32 20 20 20 20 20 20 12
dfb0: 20 20 20 20 31 33 20 20 20 20 20 20 20 31 34 0a 13 14.
dfc0: 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 (set! res
dfd0: 20 28 76 65 63 74 6f 72 20 69 64 20 72 75 6e 2d (vector id run-
dfe0: 69 64 20 74 65 73 74 6e 61 6d 65 20 73 74 61 74 id testname stat
dff0: 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 2d 74 e status event-t
e000: 69 6d 65 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 ime host cpuload
e010: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
e020: 72 75 6e 64 69 72 2d 69 64 20 69 74 65 6d 2d 70 rundir-id item-p
e030: 61 74 68 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e ath run_duration
e040: 20 66 69 6e 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d final_logf comm
e050: 65 6e 74 20 72 65 61 6c 64 69 72 2d 69 64 29 29 ent realdir-id))
e060: 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 2d 64 ). (db:get-d
e070: 62 20 64 62 73 74 72 75 63 74 20 72 75 6e 2d 69 b dbstruct run-i
e080: 64 29 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 53 d). (conc "S
e090: 45 4c 45 43 54 20 22 20 64 62 3a 74 65 73 74 2d ELECT " db:test-
e0a0: 72 65 63 6f 72 64 2d 71 72 79 2d 73 65 6c 65 63 record-qry-selec
e0b0: 74 6f 72 20 22 20 46 52 4f 4d 20 74 65 73 74 73 tor " FROM tests
e0c0: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 WHERE id=?;")..
e0d0: 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 72 65 test-id). re
e0e0: 73 29 29 0a 0a 3b 3b 20 55 73 65 20 64 62 3a 74 s))..;; Use db:t
e0f0: 65 73 74 2d 67 65 74 2a 20 74 6f 20 61 63 63 65 est-get* to acce
e100: 73 73 0a 3b 3b 20 47 65 74 20 74 65 73 74 20 64 ss.;; Get test d
e110: 61 74 61 20 75 73 69 6e 67 20 74 65 73 74 5f 69 ata using test_i
e120: 64 73 2e 20 4e 42 2f 2f 20 4f 6e 6c 79 20 77 6f ds. NB// Only wo
e130: 72 6b 73 20 77 69 74 68 69 6e 20 61 20 73 69 6e rks within a sin
e140: 67 6c 65 20 72 75 6e 21 21 0a 3b 3b 0a 28 64 65 gle run!!.;;.(de
e150: 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 65 73 fine (db:get-tes
e160: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 73 20 64 62 t-info-by-ids db
e170: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 struct run-id te
e180: 73 74 2d 69 64 73 29 0a 20 20 20 20 20 20 28 6c st-ids). (l
e190: 65 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 09 et ((res '()))..
e1a0: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
e1b0: 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 h-row. (lamb
e1c0: 64 61 20 28 69 64 20 72 75 6e 2d 69 64 20 74 65 da (id run-id te
e1d0: 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 stname state sta
e1e0: 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 68 tus event-time h
e1f0: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
e200: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 69 free uname rundi
e210: 72 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 72 r-id item-path r
e220: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e 61 un_duration fina
e230: 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 72 l_logf comment r
e240: 65 61 6c 64 69 72 2d 69 64 29 0a 09 20 20 20 3b ealdir-id).. ;
e250: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
e260: 20 20 30 20 20 20 20 31 20 20 20 20 20 20 20 32 0 1 2
e270: 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20 20 3 4
e280: 20 20 20 20 20 20 35 20 20 20 20 20 20 20 36 20 5 6
e290: 20 20 20 20 20 37 20 20 20 20 20 20 20 20 38 20 7 8
e2a0: 20 20 20 20 39 20 20 20 20 20 31 30 20 20 20 20 9 10
e2b0: 20 20 31 31 20 20 20 20 20 20 20 20 20 20 31 32 11 12
e2c0: 20 20 20 20 20 20 20 20 20 20 31 33 20 20 20 20 13
e2d0: 20 20 20 31 34 0a 20 20 20 20 20 20 20 28 73 65 14. (se
e2e0: 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 76 65 t! res (cons (ve
e2f0: 63 74 6f 72 20 69 64 20 72 75 6e 2d 69 64 20 74 ctor id run-id t
e300: 65 73 74 6e 61 6d 65 20 73 74 61 74 65 20 73 74 estname state st
e310: 61 74 75 73 20 65 76 65 6e 74 2d 74 69 6d 65 20 atus event-time
e320: 68 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 host cpuload dis
e330: 6b 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 64 kfree uname rund
e340: 69 72 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 ir-id item-path
e350: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 66 69 6e run_duration fin
e360: 61 6c 5f 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 20 al_logf comment
e370: 72 65 61 6c 64 69 72 2d 69 64 29 0a 09 09 09 20 realdir-id)....
e380: 20 20 72 65 73 29 29 29 0a 20 20 20 20 20 28 64 res))). (d
e390: 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 b:get-db dbstruc
e3a0: 74 20 72 75 6e 2d 69 64 29 20 0a 20 20 20 20 20 t run-id) .
e3b0: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 (conc "SELECT "
e3c0: 64 62 3a 74 65 73 74 2d 72 65 63 6f 72 64 2d 71 db:test-record-q
e3d0: 72 79 2d 73 65 6c 65 63 74 6f 72 20 22 20 46 52 ry-selector " FR
e3e0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 OM tests WHERE i
e3f0: 64 20 69 6e 20 28 22 0a 09 20 20 20 20 20 20 20 d in ("..
e400: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
e410: 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 74 65 rse (map conc te
e420: 73 74 2d 69 64 73 29 20 22 2c 22 29 20 22 29 3b st-ids) ",") ");
e430: 22 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 ")). res))..(
e440: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
e450: 65 73 74 2d 69 6e 66 6f 20 64 62 73 74 72 75 63 est-info dbstruc
e460: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d t run-id testnam
e470: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
e480: 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a 20 let ((res #f)).
e490: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
e4a0: 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c each-row. (l
e4b0: 61 6d 62 64 61 20 28 61 20 2e 20 62 29 0a 20 20 ambda (a . b).
e4c0: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
e4d0: 61 70 70 6c 79 20 76 65 63 74 6f 72 20 61 20 62 apply vector a b
e4e0: 29 29 29 0a 20 20 20 20 20 28 64 62 3a 67 65 74 ))). (db:get
e4f0: 2d 64 62 20 64 62 73 74 72 75 63 74 20 72 75 6e -db dbstruct run
e500: 2d 69 64 29 0a 20 20 20 20 20 28 63 6f 6e 63 20 -id). (conc
e510: 22 53 45 4c 45 43 54 20 22 20 64 62 3a 74 65 73 "SELECT " db:tes
e520: 74 2d 72 65 63 6f 72 64 2d 71 72 79 2d 73 65 6c t-record-qry-sel
e530: 65 63 74 6f 72 20 22 20 46 52 4f 4d 20 74 65 73 ector " FROM tes
e540: 74 73 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d ts WHERE testnam
e550: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
e560: 68 3d 3f 3b 22 29 0a 20 20 20 20 20 74 65 73 74 h=?;"). test
e570: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
e580: 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 66 . res))..(def
e590: 69 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ine (db:test-get
e5a0: 2d 72 75 6e 64 69 72 2d 66 72 6f 6d 2d 74 65 73 -rundir-from-tes
e5b0: 74 2d 69 64 20 64 62 73 74 72 75 63 74 20 72 75 t-id dbstruct ru
e5c0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 n-id test-id).
e5d0: 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a (let ((res #f)).
e5e0: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
e5f0: 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 -each-row. (
e600: 6c 61 6d 62 64 61 20 28 74 70 61 74 68 29 0a 20 lambda (tpath).
e610: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
e620: 74 70 61 74 68 29 29 0a 20 20 20 20 20 28 64 62 tpath)). (db
e630: 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
e640: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 20 22 53 run-id). "S
e650: 45 4c 45 43 54 20 72 75 6e 64 69 72 20 46 52 4f ELECT rundir FRO
e660: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 69 64 M tests WHERE id
e670: 3d 3f 3b 22 0a 20 20 20 20 20 74 65 73 74 2d 69 =?;". test-i
e680: 64 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b d). res))..;;
e690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e6d0: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 20 54 20 45 20 ======.;; S T E
e6e0: 50 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d P S.;;==========
e6f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
e720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 ============..(d
e730: 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 73 74 efine (db:testst
e740: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 ep-set-status! d
e750: 62 20 74 65 73 74 2d 69 64 20 74 65 73 74 73 74 b test-id testst
e760: 65 70 2d 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e ep-name state-in
e770: 20 73 74 61 74 75 73 2d 69 6e 20 63 6f 6d 6d 65 status-in comme
e780: 6e 74 20 6c 6f 67 66 69 6c 65 29 0a 20 20 20 28 nt logfile). (
e790: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
e7a0: 0a 20 20 20 20 64 62 0a 20 20 20 20 22 49 4e 53 . db. "INS
e7b0: 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 69 ERT OR REPLACE i
e7c0: 6e 74 6f 20 74 65 73 74 5f 73 74 65 70 73 20 28 nto test_steps (
e7d0: 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 test_id,stepname
e7e0: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 ,state,status,ev
e7f0: 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 6e 74 ent_time,comment
e800: 2c 6c 6f 67 66 69 6c 65 29 20 56 41 4c 55 45 53 ,logfile) VALUES
e810: 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b (?,?,?,?,?,?,?);
e820: 22 0a 20 20 20 20 74 65 73 74 2d 69 64 20 74 65 ". test-id te
e830: 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 74 ststep-name stat
e840: 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 28 e-in status-in (
e850: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
e860: 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f 6d (if comment com
e870: 6d 65 6e 74 20 22 22 29 20 28 69 66 20 6c 6f 67 ment "") (if log
e880: 66 69 6c 65 20 6c 6f 67 66 69 6c 65 20 22 22 29 file logfile "")
e890: 29 29 0a 20 20 20 0a 3b 3b 20 64 62 2d 67 65 74 )). .;; db-get
e8a0: 2d 74 65 73 74 2d 73 74 65 70 73 2d 66 6f 72 2d -test-steps-for-
e8b0: 72 75 6e 0a 28 64 65 66 69 6e 65 20 28 64 62 3a run.(define (db:
e8c0: 67 65 74 2d 73 74 65 70 73 2d 66 6f 72 2d 74 65 get-steps-for-te
e8d0: 73 74 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 st db test-id).
e8e0: 20 28 6c 65 74 2a 20 28 28 72 65 73 20 27 28 29 (let* ((res '()
e8f0: 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a )). (sqlite3:
e900: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 for-each-row .
e910: 20 20 20 28 6c 61 6d 62 64 61 20 28 69 64 20 74 (lambda (id t
e920: 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 est-id stepname
e930: 73 74 61 74 65 20 73 74 61 74 75 73 20 65 76 65 state status eve
e940: 6e 74 2d 74 69 6d 65 20 6c 6f 67 66 69 6c 65 29 nt-time logfile)
e950: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 65 . (set! re
e960: 73 20 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 s (cons (vector
e970: 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e id test-id stepn
e980: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
e990: 20 65 76 65 6e 74 2d 74 69 6d 65 20 28 69 66 20 event-time (if
e9a0: 28 73 74 72 69 6e 67 3f 20 6c 6f 67 66 69 6c 65 (string? logfile
e9b0: 29 20 6c 6f 67 66 69 6c 65 20 22 22 29 29 20 72 ) logfile "")) r
e9c0: 65 73 29 29 29 0a 20 20 20 20 20 64 62 0a 20 20 es))). db.
e9d0: 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 74 65 "SELECT id,te
e9e0: 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 st_id,stepname,s
e9f0: 74 61 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e tate,status,even
ea00: 74 5f 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 20 46 t_time,logfile F
ea10: 52 4f 4d 20 74 65 73 74 5f 73 74 65 70 73 20 57 ROM test_steps W
ea20: 48 45 52 45 20 73 74 61 74 75 73 20 21 3d 20 27 HERE status != '
ea30: 44 45 4c 45 54 45 44 27 20 41 4e 44 20 74 65 73 DELETED' AND tes
ea40: 74 5f 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 20 t_id=? ORDER BY
ea50: 69 64 20 41 53 43 3b 22 20 3b 3b 20 65 76 65 6e id ASC;" ;; even
ea60: 74 5f 74 69 6d 65 20 44 45 53 43 2c 69 64 20 41 t_time DESC,id A
ea70: 53 43 3b 0a 20 20 20 20 20 74 65 73 74 2d 69 64 SC;. test-id
ea80: 29 0a 20 20 20 20 28 72 65 76 65 72 73 65 20 72 ). (reverse r
ea90: 65 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 es)))..(define (
eaa0: 64 62 3a 67 65 74 2d 73 74 65 70 73 2d 64 61 74 db:get-steps-dat
eab0: 61 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 a db test-id).
eac0: 28 6c 65 74 20 28 28 72 65 73 20 27 28 29 29 29 (let ((res '()))
ead0: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
eae0: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
eaf0: 20 28 6c 61 6d 62 64 61 20 28 69 64 20 74 65 73 (lambda (id tes
eb00: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 73 74 t-id stepname st
eb10: 61 74 65 20 73 74 61 74 75 73 20 65 76 65 6e 74 ate status event
eb20: 2d 74 69 6d 65 20 6c 6f 67 66 69 6c 65 29 0a 20 -time logfile).
eb30: 20 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 (set! res
eb40: 28 63 6f 6e 73 20 28 76 65 63 74 6f 72 20 69 64 (cons (vector id
eb50: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
eb60: 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 65 e state status e
eb70: 76 65 6e 74 2d 74 69 6d 65 20 28 69 66 20 28 73 vent-time (if (s
eb80: 74 72 69 6e 67 3f 20 6c 6f 67 66 69 6c 65 29 20 tring? logfile)
eb90: 6c 6f 67 66 69 6c 65 20 22 22 29 29 20 72 65 73 logfile "")) res
eba0: 29 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 ))). db.
ebb0: 20 22 53 45 4c 45 43 54 20 69 64 2c 74 65 73 74 "SELECT id,test
ebc0: 5f 69 64 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 _id,stepname,sta
ebd0: 74 65 2c 73 74 61 74 75 73 2c 65 76 65 6e 74 5f te,status,event_
ebe0: 74 69 6d 65 2c 6c 6f 67 66 69 6c 65 20 46 52 4f time,logfile FRO
ebf0: 4d 20 74 65 73 74 5f 73 74 65 70 73 20 57 48 45 M test_steps WHE
ec00: 52 45 20 73 74 61 74 75 73 20 21 3d 20 27 44 45 RE status != 'DE
ec10: 4c 45 54 45 44 27 20 41 4e 44 20 74 65 73 74 5f LETED' AND test_
ec20: 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 20 69 64 id=? ORDER BY id
ec30: 20 41 53 43 3b 22 20 3b 3b 20 65 76 65 6e 74 5f ASC;" ;; event_
ec40: 74 69 6d 65 20 44 45 53 43 2c 69 64 20 41 53 43 time DESC,id ASC
ec50: 3b 0a 20 20 20 20 20 74 65 73 74 2d 69 64 29 0a ;. test-id).
ec60: 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 73 (reverse res
ec70: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
ec80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ec90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
eca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ecb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
ecc0: 20 54 20 45 20 53 20 54 20 20 44 20 41 20 54 20 T E S T D A T
ecd0: 41 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d A .;;===========
ece0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ecf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ed10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
ed20: 57 41 52 4e 49 4e 47 3a 20 44 6f 20 4e 4f 54 20 WARNING: Do NOT
ed30: 63 61 6c 6c 20 74 68 69 73 20 66 6f 72 20 74 68 call this for th
ed40: 65 20 70 61 72 65 6e 74 20 74 65 73 74 20 6f 6e e parent test on
ed50: 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 an iterated tes
ed60: 74 0a 3b 3b 20 52 6f 6c 6c 20 75 70 20 74 65 73 t.;; Roll up tes
ed70: 74 5f 64 61 74 61 20 70 61 73 73 2f 66 61 69 6c t_data pass/fail
ed80: 20 72 65 73 75 6c 74 73 0a 3b 3b 20 6c 6f 6f 6b results.;; look
ed90: 20 61 74 20 74 68 65 20 74 65 73 74 5f 64 61 74 at the test_dat
eda0: 61 20 73 74 61 74 75 73 20 66 69 65 6c 64 2c 20 a status field,
edb0: 0a 3b 3b 20 20 20 20 69 66 20 61 6c 6c 20 61 72 .;; if all ar
edc0: 65 20 70 61 73 73 20 28 61 6e 79 20 63 61 73 65 e pass (any case
edd0: 29 20 61 6e 64 20 74 68 65 20 74 65 73 74 20 73 ) and the test s
ede0: 74 61 74 75 73 20 69 73 20 50 41 53 53 20 6f 72 tatus is PASS or
edf0: 20 4e 55 4c 4c 20 6f 72 20 27 27 20 74 68 65 6e NULL or '' then
ee00: 20 73 65 74 20 74 65 73 74 20 73 74 61 74 75 73 set test status
ee10: 20 74 6f 20 50 41 53 53 2e 0a 3b 3b 20 20 20 20 to PASS..;;
ee20: 69 66 20 6f 6e 65 20 6f 72 20 6d 6f 72 65 20 61 if one or more a
ee30: 72 65 20 66 61 69 6c 20 28 61 6e 79 20 63 61 73 re fail (any cas
ee40: 65 29 20 74 68 65 6e 20 73 65 74 20 74 65 73 74 e) then set test
ee50: 20 73 74 61 74 75 73 20 74 6f 20 50 41 53 53 2c status to PASS,
ee60: 20 6e 6f 6e 20 22 70 61 73 73 22 20 6f 72 20 22 non "pass" or "
ee70: 66 61 69 6c 22 20 61 72 65 20 69 67 6e 6f 72 65 fail" are ignore
ee80: 64 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 d.(define (db:te
ee90: 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 st-data-rollup d
eea0: 62 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 b test-id status
eeb0: 29 0a 20 20 28 6c 65 74 20 28 28 66 61 69 6c 2d ). (let ((fail-
eec0: 63 6f 75 6e 74 20 30 29 0a 09 28 70 61 73 73 2d count 0)..(pass-
eed0: 63 6f 75 6e 74 20 30 29 29 0a 20 20 20 20 28 73 count 0)). (s
eee0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
eef0: 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 row. (lambda
ef00: 20 28 66 63 6f 75 6e 74 20 70 63 6f 75 6e 74 29 (fcount pcount)
ef10: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 66 61 . (set! fa
ef20: 69 6c 2d 63 6f 75 6e 74 20 66 63 6f 75 6e 74 29 il-count fcount)
ef30: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 70 61 . (set! pa
ef40: 73 73 2d 63 6f 75 6e 74 20 70 63 6f 75 6e 74 29 ss-count pcount)
ef50: 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 20 20 ). db .
ef60: 22 53 45 4c 45 43 54 20 28 53 45 4c 45 43 54 20 "SELECT (SELECT
ef70: 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 count(id) FROM t
ef80: 65 73 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 est_data WHERE t
ef90: 65 73 74 5f 69 64 3d 3f 20 41 4e 44 20 73 74 61 est_id=? AND sta
efa0: 74 75 73 20 6c 69 6b 65 20 27 66 61 69 6c 27 29 tus like 'fail')
efb0: 20 41 53 20 66 61 69 6c 5f 63 6f 75 6e 74 2c 0a AS fail_count,.
efc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 53 45 (SE
efd0: 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 LECT count(id) F
efe0: 52 4f 4d 20 74 65 73 74 5f 64 61 74 61 20 57 48 ROM test_data WH
eff0: 45 52 45 20 74 65 73 74 5f 69 64 3d 3f 20 41 4e ERE test_id=? AN
f000: 44 20 73 74 61 74 75 73 20 6c 69 6b 65 20 27 70 D status like 'p
f010: 61 73 73 27 29 20 41 53 20 70 61 73 73 5f 63 6f ass') AS pass_co
f020: 75 6e 74 3b 22 0a 20 20 20 20 20 74 65 73 74 2d unt;". test-
f030: 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 id test-id).
f040: 3b 3b 20 4e 6f 77 20 72 6f 6c 6c 75 70 20 74 68 ;; Now rollup th
f050: 65 20 63 6f 75 6e 74 73 20 74 6f 20 74 68 65 20 e counts to the
f060: 63 65 6e 74 72 61 6c 20 6d 65 67 61 74 65 73 74 central megatest
f070: 2e 64 62 0a 20 20 20 20 28 64 62 3a 67 65 6e 65 .db. (db:gene
f080: 72 61 6c 2d 63 61 6c 6c 20 64 62 20 27 70 61 73 ral-call db 'pas
f090: 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 28 6c s-fail-counts (l
f0a0: 69 73 74 20 70 61 73 73 2d 63 6f 75 6e 74 20 66 ist pass-count f
f0b0: 61 69 6c 2d 63 6f 75 6e 74 20 74 65 73 74 2d 69 ail-count test-i
f0c0: 64 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 74 68 d)). ;; if th
f0d0: 65 20 74 65 73 74 20 69 73 20 6e 6f 74 20 46 41 e test is not FA
f0e0: 49 4c 20 74 68 65 6e 20 73 65 74 20 73 74 61 74 IL then set stat
f0f0: 75 73 20 62 61 73 65 64 20 6f 6e 20 74 68 65 20 us based on the
f100: 66 61 69 6c 20 61 6e 64 20 70 61 73 73 20 63 6f fail and pass co
f110: 75 6e 74 73 2e 0a 20 20 20 20 28 64 62 3a 67 65 unts.. (db:ge
f120: 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 62 20 27 74 neral-call db 't
f130: 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c est_data-pf-roll
f140: 75 70 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 up (list test-id
f150: 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 test-id test-id
f160: 20 74 65 73 74 2d 69 64 29 29 29 29 0a 0a 28 64 test-id))))..(d
f170: 65 66 69 6e 65 20 28 64 62 3a 63 73 76 2d 3e 74 efine (db:csv->t
f180: 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 74 est-data db test
f190: 2d 69 64 20 63 73 76 64 61 74 61 29 0a 20 20 28 -id csvdata). (
f1a0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 74 debug:print 4 "t
f1b0: 65 73 74 2d 69 64 20 22 20 74 65 73 74 2d 69 64 est-id " test-id
f1c0: 20 22 2c 20 63 73 76 64 61 74 61 3a 20 22 20 63 ", csvdata: " c
f1d0: 73 76 64 61 74 61 29 0a 20 20 28 6c 65 74 20 28 svdata). (let (
f1e0: 28 63 73 76 6c 69 73 74 20 28 63 73 76 2d 3e 6c (csvlist (csv->l
f1f0: 69 73 74 20 28 6d 61 6b 65 2d 63 73 76 2d 72 65 ist (make-csv-re
f200: 61 64 65 72 0a 09 09 09 20 20 20 20 20 28 6f 70 ader.... (op
f210: 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 en-input-string
f220: 63 73 76 64 61 74 61 29 0a 09 09 09 20 20 20 20 csvdata)....
f230: 20 27 28 28 73 74 72 69 70 2d 6c 65 61 64 69 6e '((strip-leadin
f240: 67 2d 77 68 69 74 65 73 70 61 63 65 3f 20 23 74 g-whitespace? #t
f250: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 74 72 ).... (str
f260: 69 70 2d 74 72 61 69 6c 69 6e 67 2d 77 68 69 74 ip-trailing-whit
f270: 65 73 70 61 63 65 3f 20 23 74 29 29 20 29 29 29 espace? #t)) )))
f280: 29 20 3b 3b 20 28 63 73 76 2d 3e 6c 69 73 74 20 ) ;; (csv->list
f290: 63 73 76 64 61 74 61 29 29 29 0a 20 20 20 20 28 csvdata))). (
f2a0: 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 for-each . (
f2b0: 6c 61 6d 62 64 61 20 28 63 73 76 72 6f 77 29 0a lambda (csvrow).
f2c0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 (let* ((p
f2d0: 61 64 64 65 64 2d 72 6f 77 20 20 28 74 61 6b 65 added-row (take
f2e0: 20 28 61 70 70 65 6e 64 20 63 73 76 72 6f 77 20 (append csvrow
f2f0: 28 6c 69 73 74 20 23 66 20 23 66 20 23 66 20 23 (list #f #f #f #
f300: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
f310: 29 29 20 39 29 29 0a 09 20 20 20 20 20 20 28 63 )) 9)).. (c
f320: 61 74 65 67 6f 72 79 20 20 20 20 28 6c 69 73 74 ategory (list
f330: 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 -ref padded-row
f340: 30 29 29 0a 09 20 20 20 20 20 20 28 76 61 72 69 0)).. (vari
f350: 61 62 6c 65 20 20 20 20 28 6c 69 73 74 2d 72 65 able (list-re
f360: 66 20 70 61 64 64 65 64 2d 72 6f 77 20 31 29 29 f padded-row 1))
f370: 0a 09 20 20 20 20 20 20 28 76 61 6c 75 65 20 20 .. (value
f380: 20 20 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 (any->numbe
f390: 72 2d 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 6c r-if-possible (l
f3a0: 69 73 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 ist-ref padded-r
f3b0: 6f 77 20 32 29 29 29 0a 09 20 20 20 20 20 20 28 ow 2))).. (
f3c0: 65 78 70 65 63 74 65 64 20 20 20 20 28 61 6e 79 expected (any
f3d0: 2d 3e 6e 75 6d 62 65 72 2d 69 66 2d 70 6f 73 73 ->number-if-poss
f3e0: 69 62 6c 65 20 28 6c 69 73 74 2d 72 65 66 20 70 ible (list-ref p
f3f0: 61 64 64 65 64 2d 72 6f 77 20 33 29 29 29 0a 09 added-row 3)))..
f400: 20 20 20 20 20 20 28 74 6f 6c 20 20 20 20 20 20 (tol
f410: 20 20 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 2d (any->number-
f420: 69 66 2d 70 6f 73 73 69 62 6c 65 20 28 6c 69 73 if-possible (lis
f430: 74 2d 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 t-ref padded-row
f440: 20 34 29 29 29 20 3b 3b 20 3e 2c 20 3c 2c 20 3e 4))) ;; >, <, >
f450: 3d 2c 20 3c 3d 2c 20 6f 72 20 61 20 6e 75 6d 62 =, <=, or a numb
f460: 65 72 0a 09 20 20 20 20 20 20 28 75 6e 69 74 73 er.. (units
f470: 20 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 (list-ref
f480: 20 70 61 64 64 65 64 2d 72 6f 77 20 35 29 29 0a padded-row 5)).
f490: 09 20 20 20 20 20 20 28 63 6f 6d 6d 65 6e 74 20 . (comment
f4a0: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 (list-ref pa
f4b0: 64 64 65 64 2d 72 6f 77 20 36 29 29 0a 09 20 20 dded-row 6))..
f4c0: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 (status
f4d0: 20 28 6c 65 74 20 28 28 73 20 28 6c 69 73 74 2d (let ((s (list-
f4e0: 72 65 66 20 70 61 64 64 65 64 2d 72 6f 77 20 37 ref padded-row 7
f4f0: 29 29 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 ))).... (if
f500: 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 73 29 (and (string? s)
f510: 28 6f 72 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (or (string-matc
f520: 68 20 28 72 65 67 65 78 70 20 22 5e 5c 5c 73 2a h (regexp "^\\s*
f530: 24 22 29 20 73 29 0a 09 09 09 09 09 09 20 20 20 $") s).......
f540: 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 (string-match
f550: 28 72 65 67 65 78 70 20 22 5e 6e 2f 61 24 22 29 (regexp "^n/a$")
f560: 20 73 29 29 29 0a 09 09 09 09 20 23 66 0a 09 09 s)))..... #f...
f570: 09 09 20 73 29 29 29 20 3b 3b 20 69 66 20 73 70 .. s))) ;; if sp
f580: 65 63 69 66 69 65 64 20 6f 6e 20 74 68 65 20 69 ecified on the i
f590: 6e 70 75 74 20 74 68 65 6e 20 75 73 65 2c 20 65 nput then use, e
f5a0: 6c 73 65 20 63 61 6c 63 75 6c 61 74 65 0a 09 20 lse calculate..
f5b0: 20 20 20 20 20 28 74 79 70 65 20 20 20 20 20 20 (type
f5c0: 20 20 28 6c 69 73 74 2d 72 65 66 20 70 61 64 64 (list-ref padd
f5d0: 65 64 2d 72 6f 77 20 38 29 29 29 0a 09 20 3b 3b ed-row 8))).. ;;
f5e0: 20 6c 6f 6f 6b 20 75 70 20 65 78 70 65 63 74 65 look up expecte
f5f0: 64 2c 74 6f 6c 2c 75 6e 69 74 73 20 66 72 6f 6d d,tol,units from
f600: 20 70 72 65 76 69 6f 75 73 20 62 65 73 74 20 66 previous best f
f610: 69 74 20 74 65 73 74 20 69 66 20 74 68 65 79 20 it test if they
f620: 61 72 65 20 61 6c 6c 20 65 69 74 68 65 72 20 23 are all either #
f630: 66 20 6f 72 20 27 27 0a 09 20 28 64 65 62 75 67 f or ''.. (debug
f640: 3a 70 72 69 6e 74 20 34 20 22 42 45 46 4f 52 45 :print 4 "BEFORE
f650: 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 : category: " ca
f660: 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62 6c tegory " variabl
f670: 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 20 e: " variable "
f680: 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 0a value: " value .
f690: 09 09 20 20 20 20 20 20 22 2c 20 65 78 70 65 63 .. ", expec
f6a0: 74 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 20 ted: " expected
f6b0: 22 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 " tol: " tol " u
f6c0: 6e 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 20 nits: " units "
f6d0: 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 73 status: " status
f6e0: 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f " comment: " co
f6f0: 6d 6d 65 6e 74 20 22 20 74 79 70 65 3a 20 22 20 mment " type: "
f700: 74 79 70 65 29 0a 09 20 0a 09 20 28 69 66 20 28 type).. .. (if (
f710: 61 6e 64 20 28 6f 72 20 28 6e 6f 74 20 65 78 70 and (or (not exp
f720: 65 63 74 65 64 29 28 65 71 75 61 6c 3f 20 65 78 ected)(equal? ex
f730: 70 65 63 74 65 64 20 22 22 29 29 0a 09 09 20 20 pected ""))...
f740: 28 6f 72 20 28 6e 6f 74 20 74 6f 6c 29 20 20 20 (or (not tol)
f750: 20 20 28 65 71 75 61 6c 3f 20 65 78 70 65 63 74 (equal? expect
f760: 65 64 20 22 22 29 29 0a 09 09 20 20 28 6f 72 20 ed ""))... (or
f770: 28 6e 6f 74 20 75 6e 69 74 73 29 20 20 20 28 65 (not units) (e
f780: 71 75 61 6c 3f 20 65 78 70 65 63 74 65 64 20 22 qual? expected "
f790: 22 29 29 29 0a 09 20 20 20 20 20 28 6c 65 74 2d "))).. (let-
f7a0: 76 61 6c 75 65 73 20 28 28 28 6e 65 77 2d 65 78 values (((new-ex
f7b0: 70 65 63 74 65 64 20 6e 65 77 2d 74 6f 6c 20 6e pected new-tol n
f7c0: 65 77 2d 75 6e 69 74 73 29 28 74 64 62 3a 67 65 ew-units)(tdb:ge
f7d0: 74 2d 70 72 65 76 2d 74 6f 6c 2d 66 6f 72 2d 74 t-prev-tol-for-t
f7e0: 65 73 74 20 74 64 62 20 74 65 73 74 2d 69 64 20 est tdb test-id
f7f0: 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c category variabl
f800: 65 29 29 29 0a 09 09 09 20 28 73 65 74 21 20 65 e))).... (set! e
f810: 78 70 65 63 74 65 64 20 6e 65 77 2d 65 78 70 65 xpected new-expe
f820: 63 74 65 64 29 0a 09 09 09 20 28 73 65 74 21 20 cted).... (set!
f830: 74 6f 6c 20 20 20 20 20 20 6e 65 77 2d 74 6f 6c tol new-tol
f840: 29 0a 09 09 09 20 28 73 65 74 21 20 75 6e 69 74 ).... (set! unit
f850: 73 20 20 20 20 6e 65 77 2d 75 6e 69 74 73 29 29 s new-units))
f860: 29 0a 09 20 0a 09 20 28 64 65 62 75 67 3a 70 72 ).. .. (debug:pr
f870: 69 6e 74 20 34 20 22 41 46 54 45 52 3a 20 20 63 int 4 "AFTER: c
f880: 61 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 67 ategory: " categ
f890: 6f 72 79 20 22 20 76 61 72 69 61 62 6c 65 3a 20 ory " variable:
f8a0: 22 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 6c " variable " val
f8b0: 75 65 3a 20 22 20 76 61 6c 75 65 20 0a 09 09 20 ue: " value ...
f8c0: 20 20 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 ", expected
f8d0: 3a 20 22 20 65 78 70 65 63 74 65 64 20 22 20 74 : " expected " t
f8e0: 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 75 6e 69 74 ol: " tol " unit
f8f0: 73 3a 20 22 20 75 6e 69 74 73 20 22 20 73 74 61 s: " units " sta
f900: 74 75 73 3a 20 22 20 73 74 61 74 75 73 20 22 20 tus: " status "
f910: 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 6f 6d 6d 65 comment: " comme
f920: 6e 74 29 0a 09 20 3b 3b 20 63 61 6c 63 75 6c 61 nt).. ;; calcula
f930: 74 65 20 73 74 61 74 75 73 20 69 66 20 4e 4f 54 te status if NOT
f940: 20 73 70 65 63 69 66 69 65 64 0a 09 20 28 69 66 specified.. (if
f950: 20 28 61 6e 64 20 28 6e 6f 74 20 73 74 61 74 75 (and (not statu
f960: 73 29 28 6e 75 6d 62 65 72 3f 20 65 78 70 65 63 s)(number? expec
f970: 74 65 64 29 28 6e 75 6d 62 65 72 3f 20 76 61 6c ted)(number? val
f980: 75 65 29 29 20 3b 3b 20 6e 65 65 64 20 65 78 70 ue)) ;; need exp
f990: 65 63 74 65 64 20 61 6e 64 20 76 61 6c 75 65 20 ected and value
f9a0: 74 6f 20 62 65 20 6e 75 6d 62 65 72 73 0a 09 20 to be numbers..
f9b0: 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f (if (number?
f9c0: 20 74 6f 6c 29 20 3b 3b 20 69 66 20 74 6f 6c 20 tol) ;; if tol
f9d0: 69 73 20 61 20 6e 75 6d 62 65 72 20 74 68 65 6e is a number then
f9e0: 20 77 65 20 64 6f 20 74 68 65 20 73 74 61 6e 64 we do the stand
f9f0: 61 72 64 20 63 6f 6d 70 61 72 69 73 6f 6e 0a 09 ard comparison..
fa00: 09 20 28 6c 65 74 2a 20 28 28 6d 61 78 2d 76 61 . (let* ((max-va
fa10: 6c 20 28 2b 20 65 78 70 65 63 74 65 64 20 74 6f l (+ expected to
fa20: 6c 29 29 0a 09 09 09 28 6d 69 6e 2d 76 61 6c 20 l))....(min-val
fa30: 28 2d 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 (- expected tol)
fa40: 29 0a 09 09 09 28 72 65 73 75 6c 74 20 20 28 61 )....(result (a
fa50: 6e 64 20 28 3e 3d 20 20 76 61 6c 75 65 20 6d 69 nd (>= value mi
fa60: 6e 2d 76 61 6c 29 28 3c 3d 20 76 61 6c 75 65 20 n-val)(<= value
fa70: 6d 61 78 2d 76 61 6c 29 29 29 29 0a 09 09 20 20 max-val))))...
fa80: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
fa90: 22 6d 61 78 2d 76 61 6c 3a 20 22 20 6d 61 78 2d "max-val: " max-
faa0: 76 61 6c 20 22 20 6d 69 6e 2d 76 61 6c 3a 20 22 val " min-val: "
fab0: 20 6d 69 6e 2d 76 61 6c 20 22 20 72 65 73 75 6c min-val " resul
fac0: 74 3a 20 22 20 72 65 73 75 6c 74 29 0a 09 09 20 t: " result)...
fad0: 20 20 28 73 65 74 21 20 73 74 61 74 75 73 20 28 (set! status (
fae0: 69 66 20 72 65 73 75 6c 74 20 22 70 61 73 73 22 if result "pass"
faf0: 20 22 66 61 69 6c 22 29 29 29 0a 09 09 20 28 73 "fail")))... (s
fb00: 65 74 21 20 73 74 61 74 75 73 20 3b 3b 20 4e 42 et! status ;; NB
fb10: 2f 2f 20 6e 65 65 64 20 74 6f 20 61 73 73 65 73 // need to asses
fb20: 73 20 65 61 63 68 20 6f 6e 65 20 28 69 2e 65 2e s each one (i.e.
fb30: 20 6e 6f 74 20 72 65 74 75 72 6e 20 6f 70 65 72 not return oper
fb40: 61 74 6f 72 20 73 69 6e 63 65 20 6e 65 65 64 20 ator since need
fb50: 74 6f 20 61 63 74 20 69 66 20 6e 6f 74 20 76 61 to act if not va
fb60: 6c 69 64 20 6f 70 2e 0a 09 09 20 20 20 20 20 20 lid op....
fb70: 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e (case (string->
fb80: 73 79 6d 62 6f 6c 20 74 6f 6c 29 20 3b 3b 20 74 symbol tol) ;; t
fb90: 6f 6c 20 73 68 6f 75 6c 64 20 62 65 20 3e 2c 20 ol should be >,
fba0: 3c 2c 20 3e 3d 2c 20 3c 3d 0a 09 09 09 20 28 28 <, >=, <=.... ((
fbb0: 3e 29 20 20 28 69 66 20 28 3e 20 20 76 61 6c 75 >) (if (> valu
fbc0: 65 20 65 78 70 65 63 74 65 64 29 20 22 70 61 73 e expected) "pas
fbd0: 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 09 20 s" "fail"))....
fbe0: 28 28 3c 29 20 20 28 69 66 20 28 3c 20 20 76 61 ((<) (if (< va
fbf0: 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 22 70 lue expected) "p
fc00: 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a 09 09 ass" "fail"))...
fc10: 09 20 28 28 3e 3d 29 20 28 69 66 20 28 3e 3d 20 . ((>=) (if (>=
fc20: 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 29 20 value expected)
fc30: 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 29 0a "pass" "fail")).
fc40: 09 09 09 20 28 28 3c 3d 29 20 28 69 66 20 28 3c ... ((<=) (if (<
fc50: 3d 20 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 = value expected
fc60: 29 20 22 70 61 73 73 22 20 22 66 61 69 6c 22 29 ) "pass" "fail")
fc70: 29 0a 09 09 09 20 28 65 6c 73 65 20 28 63 6f 6e ).... (else (con
fc80: 63 20 22 45 52 52 4f 52 3a 20 62 61 64 20 74 6f c "ERROR: bad to
fc90: 6c 20 63 6f 6d 70 61 72 61 74 6f 72 20 22 20 74 l comparator " t
fca0: 6f 6c 29 29 29 29 29 29 0a 09 20 28 64 65 62 75 ol)))))).. (debu
fcb0: 67 3a 70 72 69 6e 74 20 34 20 22 41 46 54 45 52 g:print 4 "AFTER
fcc0: 32 3a 20 63 61 74 65 67 6f 72 79 3a 20 22 20 63 2: category: " c
fcd0: 61 74 65 67 6f 72 79 20 22 20 76 61 72 69 61 62 ategory " variab
fce0: 6c 65 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 le: " variable "
fcf0: 20 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 20 value: " value
fd00: 0a 09 09 20 20 20 20 20 20 22 2c 20 65 78 70 65 ... ", expe
fd10: 63 74 65 64 3a 20 22 20 65 78 70 65 63 74 65 64 cted: " expected
fd20: 20 22 20 74 6f 6c 3a 20 22 20 74 6f 6c 20 22 20 " tol: " tol "
fd30: 75 6e 69 74 73 3a 20 22 20 75 6e 69 74 73 20 22 units: " units "
fd40: 20 73 74 61 74 75 73 3a 20 22 20 73 74 61 74 75 status: " statu
fd50: 73 20 22 20 63 6f 6d 6d 65 6e 74 3a 20 22 20 63 s " comment: " c
fd60: 6f 6d 6d 65 6e 74 29 0a 09 20 28 73 71 6c 69 74 omment).. (sqlit
fd70: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 e3:execute db "I
fd80: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
fd90: 20 49 4e 54 4f 20 74 65 73 74 5f 64 61 74 61 20 INTO test_data
fda0: 28 74 65 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 (test_id,categor
fdb0: 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 y,variable,value
fdc0: 2c 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e ,expected,tol,un
fdd0: 69 74 73 2c 63 6f 6d 6d 65 6e 74 2c 73 74 61 74 its,comment,stat
fde0: 75 73 2c 74 79 70 65 29 20 56 41 4c 55 45 53 20 us,type) VALUES
fdf0: 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f (?,?,?,?,?,?,?,?
fe00: 2c 3f 2c 3f 29 3b 22 0a 09 09 09 20 20 74 65 73 ,?,?);".... tes
fe10: 74 2d 69 64 20 63 61 74 65 67 6f 72 79 20 76 61 t-id category va
fe20: 72 69 61 62 6c 65 20 76 61 6c 75 65 20 65 78 70 riable value exp
fe30: 65 63 74 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 ected tol units
fe40: 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f 6d 6d (if comment comm
fe50: 65 6e 74 20 22 22 29 20 73 74 61 74 75 73 20 74 ent "") status t
fe60: 79 70 65 29 29 29 0a 20 20 20 20 20 63 73 76 6c ype))). csvl
fe70: 69 73 74 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ist)))..;;======
fe80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fe90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
feb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
fec0: 0a 3b 3b 20 4d 69 73 63 2e 20 74 65 73 74 20 72 .;; Misc. test r
fed0: 65 6c 61 74 65 64 20 71 75 65 72 69 65 73 0a 3b elated queries.;
fee0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
fef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
ff20: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4d 55 53 54 =======..;; MUST
ff30: 20 42 45 20 43 41 4c 4c 45 44 20 6c 6f 63 61 6c BE CALLED local
ff40: 21 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 !.;;.(define (db
ff50: 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
ff60: 6d 61 74 63 68 69 6e 67 20 64 62 73 74 72 75 63 matching dbstruc
ff70: 74 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 67 65 t keynames targe
ff80: 74 20 66 6e 61 6d 65 70 61 74 74 20 23 21 6b 65 t fnamepatt #!ke
ff90: 79 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 3b y (res '())). ;
ffa0: 3b 20 42 55 47 3a 20 4d 6f 76 65 20 74 68 65 20 ; BUG: Move the
ffb0: 76 61 6c 75 65 73 20 64 65 72 69 76 65 64 20 66 values derived f
ffc0: 72 6f 6d 20 61 72 67 73 20 74 6f 20 70 61 72 61 rom args to para
ffd0: 6d 65 74 65 72 73 20 61 6e 64 20 70 75 73 68 20 meters and push
ffe0: 74 6f 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 0a to megatest.scm.
fff0: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 70 61 (let* ((testpa
10000 74 74 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 tt (if (args:g
10010 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 et-arg "-testpat
10020 74 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 t")(args:get-arg
10030 20 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 25 "-testpatt") "%
10040 22 29 29 0a 09 20 28 73 74 61 74 65 70 61 74 74 ")).. (statepatt
10050 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
10060 61 72 67 20 22 3a 73 74 61 74 65 22 29 20 20 20 arg ":state")
10070 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
10080 73 74 61 74 65 22 29 20 20 20 20 22 25 22 29 29 state") "%"))
10090 0a 09 20 28 73 74 61 74 75 73 70 61 74 74 20 28 .. (statuspatt (
100a0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
100b0 20 22 3a 73 74 61 74 75 73 22 29 20 20 28 61 72 ":status") (ar
100c0 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 73 74 61 gs:get-arg ":sta
100d0 74 75 73 22 29 20 20 20 22 25 22 29 29 0a 09 20 tus") "%"))..
100e0 28 72 75 6e 6e 61 6d 65 20 20 20 20 28 69 66 20 (runname (if
100f0 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
10100 72 75 6e 6e 61 6d 65 22 29 20 28 61 72 67 73 3a runname") (args:
10110 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 6d get-arg ":runnam
10120 65 22 29 20 20 22 25 22 29 29 0a 09 20 28 70 61 e") "%")).. (pa
10130 74 68 73 2d 66 72 6f 6d 2d 64 62 20 28 72 6d 74 ths-from-db (rmt
10140 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 68 73 2d :test-get-paths-
10150 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 matching-keyname
10160 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 6b 65 79 s-target-new key
10170 6e 61 6d 65 73 20 74 61 72 67 65 74 20 72 65 73 names target res
10180 0a 09 09 09 09 09 74 65 73 74 70 61 74 74 0a 09 ......testpatt..
10190 09 09 09 09 73 74 61 74 65 70 61 74 74 0a 09 09 ....statepatt...
101a0 09 09 09 73 74 61 74 75 73 70 61 74 74 0a 09 09 ...statuspatt...
101b0 09 09 09 72 75 6e 6e 61 6d 65 29 29 29 0a 20 20 ...runname))).
101c0 20 20 28 69 66 20 66 6e 61 6d 65 70 61 74 74 0a (if fnamepatt.
101d0 09 28 61 70 70 6c 79 20 61 70 70 65 6e 64 20 0a .(apply append .
101e0 09 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 . (map (la
101f0 6d 62 64 61 20 28 70 29 0a 09 09 20 20 20 20 20 mbda (p)...
10200 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d (if (directory-
10210 65 78 69 73 74 73 3f 20 70 29 0a 09 09 09 20 20 exists? p)....
10220 28 67 6c 6f 62 20 28 63 6f 6e 63 20 70 20 22 2f (glob (conc p "/
10230 22 20 66 6e 61 6d 65 70 61 74 74 29 29 0a 09 09 " fnamepatt))...
10240 09 20 20 27 28 29 29 29 0a 09 09 20 20 20 20 70 . '()))... p
10250 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 0a 09 aths-from-db))..
10260 70 61 74 68 73 2d 66 72 6f 6d 2d 64 62 29 29 29 paths-from-db)))
10270 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ..(define (db:te
10280 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
10290 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 ching-keynames-t
102a0 61 72 67 65 74 20 64 62 20 6b 65 79 6e 61 6d 65 arget db keyname
102b0 73 20 74 61 72 67 65 74 20 72 65 73 20 0a 09 09 s target res ...
102c0 09 09 09 09 20 20 20 20 23 21 6b 65 79 0a 09 09 .... #!key...
102d0 09 09 09 09 20 20 20 20 28 74 65 73 74 70 61 74 .... (testpat
102e0 74 20 20 20 22 25 22 29 0a 09 09 09 09 09 09 20 t "%").......
102f0 20 20 20 28 73 74 61 74 65 70 61 74 74 20 20 22 (statepatt "
10300 25 22 29 0a 09 09 09 09 09 09 20 20 20 20 28 73 %")....... (s
10310 74 61 74 75 73 70 61 74 74 20 22 25 22 29 0a 09 tatuspatt "%")..
10320 09 09 09 09 09 20 20 20 20 28 72 75 6e 6e 61 6d ..... (runnam
10330 65 20 20 20 20 22 25 22 29 29 0a 20 20 28 6c 65 e "%")). (le
10340 74 2a 20 28 28 6b 65 79 73 74 72 20 28 73 74 72 t* ((keystr (str
10350 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
10360 0a 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ... (map (lambd
10370 61 20 28 6b 65 79 20 76 61 6c 29 0a 09 09 09 20 a (key val)....
10380 28 63 6f 6e 63 20 22 72 2e 22 20 6b 65 79 20 22 (conc "r." key "
10390 20 6c 69 6b 65 20 27 22 20 76 61 6c 20 22 27 22 like '" val "'"
103a0 29 29 0a 09 09 20 20 20 20 20 20 20 6b 65 79 6e ))... keyn
103b0 61 6d 65 73 20 0a 09 09 20 20 20 20 20 20 20 28 ames ... (
103c0 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 61 72 string-split tar
103d0 67 65 74 20 22 2f 22 29 29 0a 09 09 20 20 22 20 get "/"))... "
103e0 41 4e 44 20 22 29 29 0a 09 20 28 74 65 73 74 71 AND ")).. (testq
103f0 72 79 20 28 74 65 73 74 73 3a 6d 61 74 63 68 2d ry (tests:match-
10400 3e 73 71 6c 71 72 79 20 74 65 73 74 70 61 74 74 >sqlqry testpatt
10410 29 29 0a 09 20 28 71 72 79 73 74 72 20 28 63 6f )).. (qrystr (co
10420 6e 63 20 22 53 45 4c 45 43 54 20 74 2e 72 75 6e nc "SELECT t.run
10430 64 69 72 20 46 52 4f 4d 20 74 65 73 74 73 20 41 dir FROM tests A
10440 53 20 74 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 72 S t INNER JOIN r
10450 75 6e 73 20 41 53 20 72 20 4f 4e 20 74 2e 72 75 uns AS r ON t.ru
10460 6e 5f 69 64 3d 72 2e 69 64 20 57 48 45 52 45 20 n_id=r.id WHERE
10470 22 0a 09 09 20 20 20 20 20 20 20 6b 65 79 73 74 "... keyst
10480 72 20 22 20 41 4e 44 20 72 2e 72 75 6e 6e 61 6d r " AND r.runnam
10490 65 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d e LIKE '" runnam
104a0 65 20 22 27 20 41 4e 44 20 22 20 74 65 73 74 71 e "' AND " testq
104b0 72 79 0a 09 09 20 20 20 20 20 20 20 22 20 41 4e ry... " AN
104c0 44 20 74 2e 73 74 61 74 65 20 4c 49 4b 45 20 27 D t.state LIKE '
104d0 22 20 73 74 61 74 65 70 61 74 74 20 22 27 20 41 " statepatt "' A
104e0 4e 44 20 74 2e 73 74 61 74 75 73 20 4c 49 4b 45 ND t.status LIKE
104f0 20 27 22 20 73 74 61 74 75 73 70 61 74 74 20 0a '" statuspatt .
10500 09 09 20 20 20 20 20 20 20 22 27 20 4f 52 44 45 .. "' ORDE
10510 52 20 42 59 20 74 2e 65 76 65 6e 74 5f 74 69 6d R BY t.event_tim
10520 65 20 41 53 43 3b 22 29 29 29 0a 20 20 20 20 28 e ASC;"))). (
10530 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
10540 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 -row . (lamb
10550 64 61 20 28 70 29 0a 20 20 20 20 20 20 20 28 73 da (p). (s
10560 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 70 20 et! res (cons p
10570 72 65 73 29 29 29 0a 20 20 20 20 20 64 62 20 0a res))). db .
10580 20 20 20 20 20 71 72 79 73 74 72 29 0a 20 20 20 qrystr).
10590 20 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 res))..(define
105a0 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 61 74 (db:test-get-pat
105b0 68 73 2d 6d 61 74 63 68 69 6e 67 2d 6b 65 79 6e hs-matching-keyn
105c0 61 6d 65 73 2d 74 61 72 67 65 74 2d 6e 65 77 20 ames-target-new
105d0 64 62 73 74 72 75 63 74 20 6b 65 79 6e 61 6d 65 dbstruct keyname
105e0 73 20 74 61 72 67 65 74 20 72 65 73 20 74 65 73 s target res tes
105f0 74 70 61 74 74 20 73 74 61 74 65 70 61 74 74 20 tpatt statepatt
10600 73 74 61 74 75 73 70 61 74 74 20 72 75 6e 6e 61 statuspatt runna
10610 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 6f me). (let* ((ro
10620 77 2d 69 64 73 20 27 28 29 29 0a 09 20 28 6b 65 w-ids '()).. (ke
10630 79 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 ystr (string-int
10640 65 72 73 70 65 72 73 65 20 0a 09 09 20 20 28 6d ersperse ... (m
10650 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 20 ap (lambda (key
10660 76 61 6c 29 0a 09 09 09 20 28 63 6f 6e 63 20 6b val).... (conc k
10670 65 79 20 22 20 6c 69 6b 65 20 27 22 20 76 61 6c ey " like '" val
10680 20 22 27 22 29 29 0a 09 09 20 20 20 20 20 20 20 "'"))...
10690 6b 65 79 6e 61 6d 65 73 20 0a 09 09 20 20 20 20 keynames ...
106a0 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
106b0 20 74 61 72 67 65 74 20 22 2f 22 29 29 0a 09 09 target "/"))...
106c0 20 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 74 " AND ")).. (t
106d0 65 73 74 71 72 79 20 28 74 65 73 74 73 3a 6d 61 estqry (tests:ma
106e0 74 63 68 2d 3e 73 71 6c 71 72 79 20 74 65 73 74 tch->sqlqry test
106f0 70 61 74 74 29 29 0a 09 20 28 72 75 6e 73 71 72 patt)).. (runsqr
10700 79 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 y (sqlite3:prepa
10710 72 65 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 re (db:get-db db
10720 73 74 72 75 63 74 20 23 66 29 28 63 6f 6e 63 20 struct #f)(conc
10730 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 "SELECT id FROM
10740 72 75 6e 73 20 57 48 45 52 45 20 22 20 6b 65 79 runs WHERE " key
10750 73 74 72 20 22 20 41 4e 44 20 72 75 6e 6e 61 6d str " AND runnam
10760 65 20 4c 49 4b 45 20 27 22 20 72 75 6e 6e 61 6d e LIKE '" runnam
10770 65 20 22 27 3b 22 29 29 29 0a 09 20 28 74 73 74 e "';"))).. (tst
10780 73 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c 45 sqry (conc "SELE
10790 43 54 20 72 75 6e 64 69 72 5f 69 64 20 46 52 4f CT rundir_id FRO
107a0 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 22 20 M tests WHERE "
107b0 74 65 73 74 71 72 79 20 22 20 41 4e 44 20 73 74 testqry " AND st
107c0 61 74 65 20 4c 49 4b 45 20 27 22 20 73 74 61 74 ate LIKE '" stat
107d0 65 70 61 74 74 20 22 27 20 41 4e 44 20 73 74 61 epatt "' AND sta
107e0 74 75 73 20 4c 49 4b 45 20 27 22 20 73 74 61 74 tus LIKE '" stat
107f0 75 73 70 61 74 74 20 22 27 20 4f 52 44 45 52 20 uspatt "' ORDER
10800 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 41 53 BY event_time AS
10810 43 3b 22 29 29 29 0a 20 20 20 20 28 64 65 62 75 C;"))). (debu
10820 67 3a 70 72 69 6e 74 20 38 20 22 64 62 3a 74 65 g:print 8 "db:te
10830 73 74 2d 67 65 74 2d 70 61 74 68 73 2d 6d 61 74 st-get-paths-mat
10840 63 68 69 6e 67 2d 6b 65 79 6e 61 6d 65 73 2d 74 ching-keynames-t
10850 61 72 67 65 74 2d 6e 65 77 5c 6e 20 20 72 75 6e arget-new\n run
10860 73 71 72 79 3d 22 20 72 75 6e 73 71 72 79 20 22 sqry=" runsqry "
10870 5c 6e 20 20 74 73 74 71 72 79 3d 22 20 74 73 74 \n tstqry=" tst
10880 71 72 79 29 0a 20 20 20 20 28 73 71 6c 69 74 65 qry). (sqlite
10890 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 3:for-each-row.
108a0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 69 64 (lambda (rid
108b0 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 72 ). (set! r
108c0 6f 77 2d 69 64 73 20 28 63 6f 6e 73 20 72 69 64 ow-ids (cons rid
108d0 20 72 6f 77 2d 69 64 73 29 29 29 0a 20 20 20 20 row-ids))).
108e0 20 72 75 6e 73 71 72 79 29 0a 20 20 20 20 28 73 runsqry). (s
108f0 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
10900 20 72 75 6e 73 71 72 79 29 0a 20 20 20 20 28 66 runsqry). (f
10910 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
10920 28 72 69 64 29 0a 09 09 28 73 71 6c 69 74 65 33 (rid)...(sqlite3
10930 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 :for-each-row ..
10940 09 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 . (lambda (p)...
10950 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
10960 6e 73 20 70 20 72 65 73 29 29 29 0a 09 09 20 28 ns p res)))... (
10970 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 db:get-db dbstru
10980 63 74 20 72 69 64 29 0a 09 09 20 74 73 74 73 71 ct rid)... tstsq
10990 72 79 29 29 0a 09 20 20 20 20 20 20 72 6f 77 2d ry)).. row-
109a0 69 64 73 29 0a 20 20 20 20 72 65 73 29 29 0a 0a ids). res))..
109b0 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
109c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
109f0 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 51 55 45 55 ========.;; QUEU
10a00 45 20 55 50 20 4d 45 54 41 2c 20 54 45 53 54 20 E UP META, TEST
10a10 53 54 41 54 55 53 20 41 4e 44 20 53 54 45 50 53 STATUS AND STEPS
10a20 20 52 45 4d 4f 54 45 20 41 43 43 45 53 53 0a 3b REMOTE ACCESS.;
10a30 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
10a40 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a50 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a60 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
10a70 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 =======..;; NOTE
10a80 3a 20 43 61 6e 20 72 65 6d 6f 76 65 20 74 68 65 : Can remove the
10a90 20 72 65 67 65 78 20 61 6e 64 20 62 61 73 65 36 regex and base6
10aa0 34 20 65 6e 63 6f 64 69 6e 67 20 66 6f 72 20 7a 4 encoding for z
10ab0 6d 71 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 6f mq.(define (db:o
10ac0 62 6a 2d 3e 73 74 72 69 6e 67 20 6f 62 6a 29 0a bj->string obj).
10ad0 20 20 28 63 61 73 65 20 2a 74 72 61 6e 73 70 6f (case *transpo
10ae0 72 74 2d 74 79 70 65 2a 0a 20 20 20 20 3b 3b 20 rt-type*. ;;
10af0 28 28 66 73 29 20 6f 62 6a 29 0a 20 20 20 20 28 ((fs) obj). (
10b00 28 68 74 74 70 20 66 73 29 0a 20 20 20 20 20 28 (http fs). (
10b10 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 string-substitut
10b20 65 0a 20 20 20 20 20 20 28 72 65 67 65 78 70 20 e. (regexp
10b30 22 3d 22 29 20 22 5f 22 0a 20 20 20 20 20 20 28 "=") "_". (
10b40 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e base64:base64-en
10b50 63 6f 64 65 20 28 77 69 74 68 2d 6f 75 74 70 75 code (with-outpu
10b60 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d t-to-string (lam
10b70 62 64 61 20 28 29 28 73 65 72 69 61 6c 69 7a 65 bda ()(serialize
10b80 20 6f 62 6a 29 29 29 29 0a 20 20 20 20 20 20 23 obj)))). #
10b90 74 29 29 0a 20 20 20 20 28 28 7a 6d 71 29 28 77 t)). ((zmq)(w
10ba0 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 ith-output-to-st
10bb0 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 28 ring (lambda ()(
10bc0 73 65 72 69 61 6c 69 7a 65 20 6f 62 6a 29 29 29 serialize obj)))
10bd0 29 0a 20 20 20 20 28 65 6c 73 65 20 6f 62 6a 29 ). (else obj)
10be0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
10bf0 73 74 72 69 6e 67 2d 3e 6f 62 6a 20 6d 73 67 29 string->obj msg)
10c00 0a 20 20 28 63 61 73 65 20 2a 74 72 61 6e 73 70 . (case *transp
10c10 6f 72 74 2d 74 79 70 65 2a 0a 20 20 20 20 3b 3b ort-type*. ;;
10c20 20 28 28 66 73 29 20 6d 73 67 29 0a 20 20 20 20 ((fs) msg).
10c30 28 28 68 74 74 70 20 66 73 29 0a 20 20 20 20 20 ((http fs).
10c40 28 69 66 20 28 73 74 72 69 6e 67 3f 20 6d 73 67 (if (string? msg
10c50 29 0a 09 20 28 77 69 74 68 2d 69 6e 70 75 74 2d ).. (with-input-
10c60 66 72 6f 6d 2d 73 74 72 69 6e 67 20 0a 09 20 20 from-string ..
10c70 20 20 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 (base64:base6
10c80 34 2d 64 65 63 6f 64 65 0a 09 20 20 20 20 20 20 4-decode..
10c90 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 (string-substitu
10ca0 74 65 20 0a 09 20 20 20 20 20 20 20 28 72 65 67 te .. (reg
10cb0 65 78 70 20 22 5f 22 29 20 22 3d 22 20 6d 73 67 exp "_") "=" msg
10cc0 20 23 74 29 29 0a 09 20 20 20 28 6c 61 6d 62 64 #t)).. (lambd
10cd0 61 20 28 29 28 64 65 73 65 72 69 61 6c 69 7a 65 a ()(deserialize
10ce0 29 29 29 0a 09 20 28 76 65 63 74 6f 72 20 23 66 ))).. (vector #f
10cf0 20 23 66 20 23 66 29 29 29 20 3b 3b 20 63 72 75 #f #f))) ;; cru
10d00 64 65 20 72 65 70 6c 79 20 66 6f 72 20 77 68 65 de reply for whe
10d10 6e 20 74 68 69 6e 67 73 20 67 6f 20 61 77 72 79 n things go awry
10d20 0a 20 20 20 20 28 28 7a 6d 71 29 28 77 69 74 68 . ((zmq)(with
10d30 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 73 74 72 69 -input-from-stri
10d40 6e 67 20 6d 73 67 20 28 6c 61 6d 62 64 61 20 28 ng msg (lambda (
10d50 29 28 64 65 73 65 72 69 61 6c 69 7a 65 29 29 29 )(deserialize)))
10d60 29 0a 20 20 20 20 28 65 6c 73 65 20 6d 73 67 29 ). (else msg)
10d70 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
10d80 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 2d test-set-status-
10d90 73 74 61 74 65 20 64 62 73 74 72 75 63 74 20 72 state dbstruct r
10da0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
10db0 61 74 75 73 20 73 74 61 74 65 20 6d 73 67 29 0a atus state msg).
10dc0 20 20 28 6c 65 74 20 28 28 64 62 20 20 28 64 62 (let ((db (db
10dd0 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
10de0 20 72 69 64 29 29 29 0a 20 20 28 69 66 20 28 6d rid))). (if (m
10df0 65 6d 62 65 72 20 73 74 61 74 65 20 27 28 22 4c ember state '("L
10e00 41 55 4e 43 48 45 44 22 20 22 52 45 4d 4f 54 45 AUNCHED" "REMOTE
10e10 48 4f 53 54 53 54 41 52 54 22 29 29 0a 20 20 20 HOSTSTART")).
10e20 20 20 20 28 64 62 3a 67 65 6e 65 72 61 6c 2d 63 (db:general-c
10e30 61 6c 6c 20 64 62 20 27 73 65 74 2d 74 65 73 74 all db 'set-test
10e40 2d 73 74 61 72 74 2d 74 69 6d 65 20 28 6c 69 73 -start-time (lis
10e50 74 20 74 65 73 74 2d 69 64 29 29 29 0a 20 20 28 t test-id))). (
10e60 69 66 20 6d 73 67 0a 20 20 20 20 20 20 28 64 62 if msg. (db
10e70 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 62 :general-call db
10e80 20 27 73 74 61 74 65 2d 73 74 61 74 75 73 2d 6d 'state-status-m
10e90 73 67 20 28 6c 69 73 74 20 73 74 61 74 65 20 73 sg (list state s
10ea0 74 61 74 75 73 20 6d 73 67 20 74 65 73 74 2d 69 tatus msg test-i
10eb0 64 29 29 0a 09 28 64 62 3a 67 65 6e 65 72 61 6c d))..(db:general
10ec0 2d 63 61 6c 6c 20 64 62 20 27 73 74 61 74 65 2d -call db 'state-
10ed0 73 74 61 74 75 73 20 20 20 20 20 28 6c 69 73 74 status (list
10ee0 20 73 74 61 74 65 20 73 74 61 74 75 73 20 74 65 state status te
10ef0 73 74 2d 69 64 29 29 29 29 29 0a 0a 28 64 65 66 st-id)))))..(def
10f00 69 6e 65 20 28 64 62 3a 72 6f 6c 6c 2d 75 70 2d ine (db:roll-up-
10f10 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
10f20 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
10f30 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 73 name item-path s
10f40 74 61 74 75 73 29 0a 20 20 28 69 66 20 28 61 6e tatus). (if (an
10f50 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 d (not (equal? i
10f60 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 20 tem-path ""))..
10f70 20 20 28 6d 65 6d 62 65 72 20 73 74 61 74 75 73 (member status
10f80 20 27 28 22 50 41 53 53 22 20 22 57 41 52 4e 22 '("PASS" "WARN"
10f90 20 22 46 41 49 4c 22 20 22 57 41 49 56 45 44 22 "FAIL" "WAIVED"
10fa0 20 22 52 55 4e 4e 49 4e 47 22 20 22 43 48 45 43 "RUNNING" "CHEC
10fb0 4b 22 20 22 53 4b 49 50 22 29 29 29 0a 20 20 20 K" "SKIP"))).
10fc0 20 20 20 28 6c 65 74 20 28 28 64 62 20 28 64 62 (let ((db (db
10fd0 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
10fe0 20 72 69 64 29 29 29 0a 09 28 64 62 3a 67 65 6e rid)))..(db:gen
10ff0 65 72 61 6c 2d 63 61 6c 6c 20 64 62 20 27 75 70 eral-call db 'up
11000 64 61 74 65 2d 70 61 73 73 2d 66 61 69 6c 2d 63 date-pass-fail-c
11010 6f 75 6e 74 73 20 28 6c 69 73 74 20 72 75 6e 2d ounts (list run-
11020 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e id test-name run
11030 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 -id test-name ru
11040 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 29 n-id test-name))
11050 0a 09 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 ..(if (equal? st
11060 61 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 0a atus "RUNNING").
11070 09 20 20 20 20 28 64 62 3a 67 65 6e 65 72 61 6c . (db:general
11080 2d 63 61 6c 6c 20 64 62 20 27 74 6f 70 2d 74 65 -call db 'top-te
11090 73 74 2d 73 65 74 2d 72 75 6e 6e 69 6e 67 20 28 st-set-running (
110a0 6c 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 list run-id test
110b0 2d 6e 61 6d 65 29 29 0a 09 20 20 20 20 28 64 62 -name)).. (db
110c0 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 64 62 :general-call db
110d0 20 27 74 6f 70 2d 74 65 73 74 2d 73 65 74 2d 70 'top-test-set-p
110e0 65 72 2d 70 66 2d 63 6f 75 6e 74 73 20 28 6c 69 er-pf-counts (li
110f0 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e st run-id test-n
11100 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ame run-id test-
11110 6e 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 name run-id test
11120 2d 6e 61 6d 65 29 29 29 0a 09 23 66 29 0a 20 20 -name)))..#f).
11130 20 20 20 20 23 66 29 29 0a 0a 28 64 65 66 69 6e #f))..(defin
11140 65 20 28 64 62 3a 74 65 73 74 73 2d 72 65 67 69 e (db:tests-regi
11150 73 74 65 72 2d 74 65 73 74 20 64 62 73 74 72 75 ster-test dbstru
11160 63 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ct run-id test-n
11170 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 ame item-path).
11180 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
11190 65 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 e (db:get-db dbs
111a0 74 72 75 63 74 20 72 75 6e 2d 69 64 29 20 27 72 truct run-id) 'r
111b0 65 67 69 73 74 65 72 2d 74 65 73 74 20 72 75 6e egister-test run
111c0 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
111d0 65 6d 2d 70 61 74 68 29 29 0a 0a 28 64 65 66 69 em-path))..(defi
111e0 6e 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ne (db:test-get-
111f0 6c 6f 67 66 69 6c 65 2d 69 6e 66 6f 20 64 62 73 logfile-info dbs
11200 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 73 truct run-id tes
11210 74 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 28 t-name). (let (
11220 28 72 65 73 20 23 66 29 29 0a 20 20 20 20 28 73 (res #f)). (s
11230 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
11240 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 row . (lambd
11250 61 20 28 70 61 74 68 2d 69 64 20 66 69 6e 61 6c a (path-id final
11260 5f 6c 6f 67 66 2d 69 64 29 0a 20 20 20 20 20 20 _logf-id).
11270 20 28 6c 65 74 20 28 28 70 61 74 68 20 20 20 20 (let ((path
11280 20 20 20 28 64 62 3a 67 65 74 2d 70 61 74 68 20 (db:get-path
11290 20 20 64 62 73 74 72 75 63 74 20 70 61 74 68 2d dbstruct path-
112a0 69 64 29 29 0a 09 20 20 20 20 20 28 66 69 6e 61 id)).. (fina
112b0 6c 5f 6c 6f 67 66 20 28 64 62 3a 67 65 74 2d 73 l_logf (db:get-s
112c0 74 72 69 6e 67 20 64 62 73 74 72 75 63 74 20 66 tring dbstruct f
112d0 69 6e 61 6c 5f 6c 6f 67 66 2d 69 64 29 29 29 0a inal_logf-id))).
112e0 20 20 20 20 20 20 20 28 73 65 74 21 20 6c 6f 67 (set! log
112f0 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 f final_logf).
11300 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 (set! res (
11310 6c 69 73 74 20 70 61 74 68 20 66 69 6e 61 6c 5f list path final_
11320 6c 6f 67 66 29 29 0a 20 20 20 20 20 20 20 28 69 logf)). (i
11330 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 70 61 f (directory? pa
11340 74 68 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 th).. (debug:p
11350 72 69 6e 74 20 32 20 22 46 6f 75 6e 64 20 70 61 rint 2 "Found pa
11360 74 68 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20 th: " path)..
11370 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
11380 20 22 4e 6f 20 73 75 63 68 20 70 61 74 68 3a 20 "No such path:
11390 22 20 70 61 74 68 29 29 29 29 0a 20 20 20 20 20 " path)))).
113a0 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 72 (db:get-db dbstr
113b0 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 uct run-id).
113c0 20 22 53 45 4c 45 43 54 20 72 75 6e 64 69 72 5f "SELECT rundir_
113d0 69 64 2c 66 69 6e 61 6c 5f 6c 6f 67 66 5f 69 64 id,final_logf_id
113e0 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
113f0 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 E testname=? AND
11400 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a item_path='';".
11410 20 20 20 20 20 74 65 73 74 2d 6e 61 6d 65 29 0a test-name).
11420 20 20 20 20 72 65 73 29 29 0a 0a 3b 3b 3d 3d 3d res))..;;===
11430 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11440 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11450 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11460 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
11470 3d 3d 3d 0a 3b 3b 20 41 20 47 20 52 20 45 20 47 ===.;; A G R E G
11480 20 41 20 54 20 45 20 44 20 20 20 54 20 52 20 41 A T E D T R A
11490 20 4e 20 53 20 41 20 43 20 54 20 49 20 4f 20 4e N S A C T I O N
114a0 20 20 20 44 20 42 20 20 20 57 20 52 20 49 20 54 D B W R I T
114b0 20 45 20 53 20 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d E S .;;========
114c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
114d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
114e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
114f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
11500 28 64 65 66 69 6e 65 20 64 62 3a 71 75 65 72 69 (define db:queri
11510 65 73 20 0a 20 20 28 6c 69 73 74 20 27 28 75 70 es . (list '(up
11520 64 61 74 65 2d 72 75 6e 2d 64 75 72 61 74 69 6f date-run-duratio
11530 6e 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 n "UPDATE te
11540 73 74 73 20 53 45 54 20 72 75 6e 5f 64 75 72 61 sts SET run_dura
11550 74 69 6f 6e 3d 3f 20 57 48 45 52 45 20 69 64 3d tion=? WHERE id=
11560 3f 3b 22 29 0a 0a 09 3b 3b 20 54 45 53 54 53 0a ?;")...;; TESTS.
11570 09 27 28 72 65 67 69 73 74 65 72 2d 74 65 73 74 .'(register-test
11580 20 20 20 20 20 20 20 20 20 20 22 49 4e 53 45 52 "INSER
11590 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f T OR IGNORE INTO
115a0 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 tests (run_id,t
115b0 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 69 estname,event_ti
115c0 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 me,item_path,sta
115d0 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 45 te,status) VALUE
115e0 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 S (?,?,strftime(
115f0 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 4e '%s','now'),?,'N
11600 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 2f 61 OT_STARTED','n/a
11610 27 29 3b 22 29 0a 09 3b 3b 20 54 65 73 74 20 73 ');")..;; Test s
11620 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 0a tate and status.
11630 09 27 28 73 65 74 2d 74 65 73 74 2d 73 74 61 74 .'(set-test-stat
11640 65 20 20 20 20 20 20 20 20 20 22 55 50 44 41 54 e "UPDAT
11650 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 E tests SET stat
11660 65 3d 3f 20 20 20 57 48 45 52 45 20 69 64 3d 3f e=? WHERE id=?
11670 3b 22 29 0a 09 27 28 73 65 74 2d 74 65 73 74 2d ;")..'(set-test-
11680 73 74 61 74 75 73 20 20 20 20 20 20 20 20 22 55 status "U
11690 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
116a0 73 74 61 74 65 3d 3f 20 20 20 57 48 45 52 45 20 state=? WHERE
116b0 69 64 3d 3f 3b 22 29 0a 09 27 28 73 74 61 74 65 id=?;")..'(state
116c0 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 20 20 -status
116d0 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
116e0 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 SET state=?,stat
116f0 75 73 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b us=? WHERE id=?;
11700 22 29 20 3b 3b 20 44 4f 4e 45 0a 09 27 28 73 74 ") ;; DONE..'(st
11710 61 74 65 2d 73 74 61 74 75 73 2d 6d 73 67 20 20 ate-status-msg
11720 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 73 "UPDATE tes
11730 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 ts SET state=?,s
11740 74 61 74 75 73 3d 3f 2c 63 6f 6d 6d 65 6e 74 5f tatus=?,comment_
11750 69 64 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b id=? WHERE id=?;
11760 22 29 20 3b 3b 20 44 4f 4e 45 0a 09 3b 3b 20 54 ") ;; DONE..;; T
11770 65 73 74 20 63 6f 6d 6d 65 6e 74 0a 09 27 28 73 est comment..'(s
11780 65 74 2d 74 65 73 74 2d 63 6f 6d 6d 65 6e 74 20 et-test-comment
11790 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 "UPDATE te
117a0 73 74 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 5f sts SET comment_
117b0 69 64 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b id=? WHERE id=?;
117c0 22 29 0a 09 27 28 73 65 74 2d 74 65 73 74 2d 73 ")..'(set-test-s
117d0 74 61 72 74 2d 74 69 6d 65 20 20 20 20 22 55 50 tart-time "UP
117e0 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 65 DATE tests SET e
117f0 76 65 6e 74 5f 74 69 6d 65 3d 73 74 72 66 74 69 vent_time=strfti
11800 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 57 me('%s','now') W
11810 48 45 52 45 20 69 64 3d 3f 3b 22 29 20 3b 3b 20 HERE id=?;") ;;
11820 44 4f 4e 45 0a 09 27 28 70 61 73 73 2d 66 61 69 DONE..'(pass-fai
11830 6c 2d 63 6f 75 6e 74 73 20 20 20 20 20 20 20 22 l-counts "
11840 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
11850 20 70 61 73 73 5f 63 6f 75 6e 74 3d 3f 2c 66 61 pass_count=?,fa
11860 69 6c 5f 63 6f 75 6e 74 3d 3f 20 57 48 45 52 45 il_count=? WHERE
11870 20 69 64 3d 3f 3b 22 29 0a 09 3b 3b 20 74 65 73 id=?;")..;; tes
11880 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c 6c 75 70 t_data-pf-rollup
11890 20 69 73 20 75 73 65 64 20 74 6f 20 73 65 74 20 is used to set
118a0 61 20 74 65 73 74 73 20 50 41 53 53 2f 46 41 49 a tests PASS/FAI
118b0 4c 20 62 61 73 65 64 20 6f 6e 20 74 68 65 20 70 L based on the p
118c0 61 73 73 2f 66 61 69 6c 20 69 6e 66 6f 20 66 72 ass/fail info fr
118d0 6f 6d 20 74 68 65 20 73 74 65 70 73 0a 09 27 28 om the steps..'(
118e0 74 65 73 74 5f 64 61 74 61 2d 70 66 2d 72 6f 6c test_data-pf-rol
118f0 6c 75 70 20 20 20 20 22 55 50 44 41 54 45 20 74 lup "UPDATE t
11900 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 ests.
11910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11920 20 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 SET sta
11930 74 75 73 3d 43 41 53 45 20 57 48 45 4e 20 28 53 tus=CASE WHEN (S
11940 45 4c 45 43 54 20 66 61 69 6c 5f 63 6f 75 6e 74 ELECT fail_count
11950 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
11960 45 20 69 64 3d 3f 29 20 3e 20 30 20 0a 20 20 20 E id=?) > 0 .
11970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11990 20 20 20 54 48 45 4e 20 27 46 41 49 4c 27 0a 20 THEN 'FAIL'.
119a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119c0 20 20 20 57 48 45 4e 20 28 53 45 4c 45 43 54 20 WHEN (SELECT
119d0 70 61 73 73 5f 63 6f 75 6e 74 20 46 52 4f 4d 20 pass_count FROM
119e0 74 65 73 74 73 20 57 48 45 52 45 20 69 64 3d 3f tests WHERE id=?
119f0 29 20 3e 20 30 20 41 4e 44 20 0a 20 20 20 20 20 ) > 0 AND .
11a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a20 20 28 53 45 4c 45 43 54 20 73 74 61 74 75 73 20 (SELECT status
11a30 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
11a40 20 69 64 3d 3f 29 20 4e 4f 54 20 49 4e 20 28 27 id=?) NOT IN ('
11a50 57 41 52 4e 27 2c 27 46 41 49 4c 27 29 0a 20 20 WARN','FAIL').
11a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a80 20 20 54 48 45 4e 20 27 50 41 53 53 27 0a 20 20 THEN 'PASS'.
11a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ab0 20 20 45 4c 53 45 20 73 74 61 74 75 73 0a 20 20 ELSE status.
11ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ae0 20 20 45 4e 44 20 57 48 45 52 45 20 69 64 3d 3f END WHERE id=?
11af0 3b 22 29 20 3b 3b 20 44 4f 4e 45 0a 09 27 28 74 ;") ;; DONE..'(t
11b00 65 73 74 2d 73 65 74 2d 6c 6f 67 20 20 20 20 20 est-set-log
11b10 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 "UPDATE t
11b20 65 73 74 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c ests SET final_l
11b30 6f 67 66 5f 69 64 3d 3f 20 57 48 45 52 45 20 69 ogf_id=? WHERE i
11b40 64 3d 3f 3b 22 29 20 20 20 20 20 20 3b 3b 20 44 d=?;") ;; D
11b50 4f 4e 45 0a 09 27 28 74 65 73 74 2d 73 65 74 2d ONE..'(test-set-
11b60 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 74 2d 69 rundir-by-test-i
11b70 64 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 d "UPDATE tests
11b80 53 45 54 20 72 75 6e 64 69 72 5f 69 64 3d 3f 20 SET rundir_id=?
11b90 57 48 45 52 45 20 69 64 3d 3f 22 29 20 20 20 20 WHERE id=?")
11ba0 20 20 20 20 3b 3b 20 44 4f 4e 45 0a 09 27 28 74 ;; DONE..'(t
11bb0 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 20 20 est-set-rundir
11bc0 20 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 "UPDATE t
11bd0 65 73 74 73 20 53 45 54 20 72 75 6e 64 69 72 5f ests SET rundir_
11be0 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
11bf0 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
11c00 68 3d 3f 3b 22 29 20 3b 3b 20 44 4f 4e 45 0a 09 h=?;") ;; DONE..
11c10 27 28 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 '(delete-tests-i
11c20 6e 2d 73 74 61 74 65 20 20 20 22 44 45 4c 45 54 n-state "DELET
11c30 45 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 E FROM tests WHE
11c40 52 45 20 73 74 61 74 65 3d 3f 3b 22 29 20 20 20 RE state=?;")
11c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
11c60 3b 20 44 4f 4e 45 0a 09 27 28 74 65 73 74 73 3a ; DONE..'(tests:
11c70 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 20 test-set-toplog
11c80 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
11c90 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f SET final_logf=?
11ca0 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
11cb0 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
11cc0 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b ND item_path='';
11cd0 22 29 0a 09 27 28 75 70 64 61 74 65 2d 63 70 75 ")..'(update-cpu
11ce0 6c 6f 61 64 2d 64 69 73 6b 66 72 65 65 20 22 55 load-diskfree "U
11cf0 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
11d00 63 70 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 cpuload=?,diskfr
11d10 65 65 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b ee=? WHERE id=?;
11d20 22 29 20 3b 3b 20 44 4f 4e 45 0a 09 27 28 75 70 ") ;; DONE..'(up
11d30 64 61 74 65 2d 75 6e 61 6d 65 2d 68 6f 73 74 20 date-uname-host
11d40 20 20 20 20 20 20 22 55 50 44 41 54 45 20 74 65 "UPDATE te
11d50 73 74 73 20 53 45 54 20 75 6e 61 6d 65 3d 3f 2c sts SET uname=?,
11d60 68 6f 73 74 3d 3f 20 57 48 45 52 45 20 69 64 3d host=? WHERE id=
11d70 3f 3b 22 29 20 20 20 20 20 20 20 3b 3b 20 44 4f ?;") ;; DO
11d80 4e 45 0a 09 27 28 75 70 64 61 74 65 2d 74 65 73 NE..'(update-tes
11d90 74 2d 73 74 61 74 65 20 20 20 20 20 20 20 22 55 t-state "U
11da0 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
11db0 73 74 61 74 65 3d 3f 20 57 48 45 52 45 20 73 74 state=? WHERE st
11dc0 61 74 65 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 64 ate=? AND run_id
11dd0 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
11de0 3f 20 41 4e 44 20 4e 4f 54 20 28 69 74 65 6d 5f ? AND NOT (item_
11df0 70 61 74 68 3d 27 27 20 41 4e 44 20 74 65 73 74 path='' AND test
11e00 6e 61 6d 65 20 49 4e 20 28 53 45 4c 45 43 54 20 name IN (SELECT
11e10 44 49 53 54 49 4e 43 54 20 74 65 73 74 6e 61 6d DISTINCT testnam
11e20 65 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 e FROM tests WHE
11e30 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e RE testname=? AN
11e40 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 D item_path != '
11e50 27 29 29 3b 22 29 0a 09 27 28 75 70 64 61 74 65 '));")..'(update
11e60 2d 74 65 73 74 2d 73 74 61 74 75 73 20 20 20 20 -test-status
11e70 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 "UPDATE tests
11e80 53 45 54 20 73 74 61 74 75 73 3d 3f 20 57 48 45 SET status=? WHE
11e90 52 45 20 73 74 61 74 75 73 20 6c 69 6b 65 20 3f RE status like ?
11ea0 20 41 4e 44 20 72 75 6e 5f 69 64 3d 3f 20 41 4e AND run_id=? AN
11eb0 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
11ec0 20 4e 4f 54 20 28 69 74 65 6d 5f 70 61 74 68 3d NOT (item_path=
11ed0 27 27 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 20 '' AND testname
11ee0 49 4e 20 28 53 45 4c 45 43 54 20 44 49 53 54 49 IN (SELECT DISTI
11ef0 4e 43 54 20 74 65 73 74 6e 61 6d 65 20 46 52 4f NCT testname FRO
11f00 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 74 65 M tests WHERE te
11f10 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
11f20 6d 5f 70 61 74 68 20 21 3d 20 27 27 29 29 3b 22 m_path != ''));"
11f30 29 0a 09 3b 3b 20 73 74 75 66 66 20 66 6f 72 20 )..;; stuff for
11f40 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 roll-up-pass-fai
11f50 6c 2d 63 6f 75 6e 74 73 0a 09 27 28 75 70 64 61 l-counts..'(upda
11f60 74 65 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 te-pass-fail-cou
11f70 6e 74 73 20 22 55 50 44 41 54 45 20 74 65 73 74 nts "UPDATE test
11f80 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s .
11f90 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 28 SET fail_count=(
11fa0 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
11fb0 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
11fc0 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 E testname=? AND
11fd0 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 item_path != ''
11fe0 20 41 4e 44 20 73 74 61 74 75 73 20 49 4e 20 28 AND status IN (
11ff0 27 46 41 49 4c 27 2c 27 43 48 45 43 4b 27 29 29 'FAIL','CHECK'))
12000 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
12010 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d 28 53 pass_count=(S
12020 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 ELECT count(id)
12030 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
12040 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
12050 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 item_path != ''
12060 41 4e 44 20 73 74 61 74 75 73 20 49 4e 20 28 27 AND status IN ('
12070 50 41 53 53 27 2c 27 57 41 52 4e 27 2c 27 57 41 PASS','WARN','WA
12080 49 56 45 44 27 29 29 0a 20 20 20 20 20 20 20 20 IVED')).
12090 20 20 20 20 20 57 48 45 52 45 20 74 65 73 74 6e WHERE testn
120a0 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
120b0 61 74 68 3d 27 27 3b 22 29 20 3b 3b 20 44 4f 4e ath='';") ;; DON
120c0 45 0a 09 27 28 74 6f 70 2d 74 65 73 74 2d 73 65 E..'(top-test-se
120d0 74 2d 72 75 6e 6e 69 6e 67 20 20 22 55 50 44 41 t-running "UPDA
120e0 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
120f0 74 65 3d 27 52 55 4e 4e 49 4e 47 27 20 57 48 45 te='RUNNING' WHE
12100 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e RE testname=? AN
12110 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 D item_path='';"
12120 29 20 3b 3b 20 44 4f 4e 45 0a 09 27 28 74 6f 70 ) ;; DONE..'(top
12130 2d 74 65 73 74 2d 73 65 74 2d 70 65 72 2d 70 66 -test-set-per-pf
12140 2d 63 6f 75 6e 74 73 20 22 55 50 44 41 54 45 20 -counts "UPDATE
12150 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 tests.
12160 20 20 20 20 20 20 20 20 20 20 20 20 20 53 45 54 SET
12170 20 73 74 61 74 65 3d 43 41 53 45 20 0a 20 20 20 state=CASE .
12180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12190 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121a0 57 48 45 4e 20 28 53 45 4c 45 43 54 20 63 6f 75 WHEN (SELECT cou
121b0 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 nt(id) FROM test
121c0 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s .
121d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121f0 20 20 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d WHERE testnam
12200 65 3d 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 e=?.
12210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12230 20 20 20 20 20 20 20 20 20 41 4e 44 20 69 74 65 AND ite
12240 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 0a 20 20 m_path != '' .
12250 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12280 20 20 20 41 4e 44 20 73 74 61 74 65 20 69 6e 20 AND state in
12290 28 27 52 55 4e 4e 49 4e 47 27 2c 27 4e 4f 54 5f ('RUNNING','NOT_
122a0 53 54 41 52 54 45 44 27 2c 27 4c 41 55 4e 43 48 STARTED','LAUNCH
122b0 45 44 27 2c 27 52 45 4d 4f 54 45 48 4f 53 54 53 ED','REMOTEHOSTS
122c0 54 41 52 54 27 29 29 20 3e 20 30 20 54 48 45 4e TART')) > 0 THEN
122d0 20 27 52 55 4e 4e 49 4e 47 27 0a 20 20 20 20 20 'RUNNING'.
122e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
122f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 45 4c EL
12300 53 45 20 27 43 4f 4d 50 4c 45 54 45 44 27 20 45 SE 'COMPLETED' E
12310 4e 44 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 ND,.
12320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12330 73 74 61 74 75 73 3d 43 41 53 45 20 0a 20 20 20 status=CASE .
12340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 57 W
12360 48 45 4e 20 66 61 69 6c 5f 63 6f 75 6e 74 20 3e HEN fail_count >
12370 20 30 20 54 48 45 4e 20 27 46 41 49 4c 27 20 0a 0 THEN 'FAIL' .
12380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
123a0 20 20 57 48 45 4e 20 70 61 73 73 5f 63 6f 75 6e WHEN pass_coun
123b0 74 20 3e 20 30 20 41 4e 44 20 66 61 69 6c 5f 63 t > 0 AND fail_c
123c0 6f 75 6e 74 3d 30 20 54 48 45 4e 20 27 50 41 53 ount=0 THEN 'PAS
123d0 53 27 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 S' .
123e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
123f0 20 20 20 20 20 20 57 48 45 4e 20 28 53 45 4c 45 WHEN (SELE
12400 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f CT count(id) FRO
12410 4d 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 M tests.
12420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12440 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d WHERE testname=
12450 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ?.
12460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12480 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d AND item_path !=
12490 20 27 27 0a 20 20 20 20 20 20 20 20 20 20 20 20 ''.
124a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
124b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
124c0 20 20 41 4e 44 20 73 74 61 74 75 73 20 3d 20 27 AND status = '
124d0 53 4b 49 50 27 29 20 3e 20 30 20 54 48 45 4e 20 SKIP') > 0 THEN
124e0 27 53 4b 49 50 27 0a 20 20 20 20 20 20 20 20 20 'SKIP'.
124f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12500 20 20 20 20 20 20 20 20 20 45 4c 53 45 20 27 55 ELSE 'U
12510 4e 4b 4e 4f 57 4e 27 20 45 4e 44 0a 20 20 20 20 NKNOWN' END.
12520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12530 20 20 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d WHERE testnam
12540 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
12550 68 3d 27 27 3b 22 29 20 3b 3b 20 44 4f 4e 45 0a h='';") ;; DONE.
12560 0a 09 3b 3b 20 53 54 45 50 53 0a 09 27 28 64 65 ..;; STEPS..'(de
12570 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 lete-test-step-r
12580 65 63 6f 72 64 73 20 22 55 50 44 41 54 45 20 74 ecords "UPDATE t
12590 65 73 74 5f 73 74 65 70 73 20 53 45 54 20 73 74 est_steps SET st
125a0 61 74 75 73 3d 27 44 45 4c 45 54 45 44 27 20 57 atus='DELETED' W
125b0 48 45 52 45 20 69 64 3d 3f 3b 22 29 0a 09 27 28 HERE id=?;")..'(
125c0 64 65 6c 65 74 65 2d 74 65 73 74 2d 64 61 74 61 delete-test-data
125d0 2d 72 65 63 6f 72 64 73 20 22 55 50 44 41 54 45 -records "UPDATE
125e0 20 74 65 73 74 5f 64 61 74 61 20 20 53 45 54 20 test_data SET
125f0 73 74 61 74 75 73 3d 27 44 45 4c 45 54 45 44 27 status='DELETED'
12600 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 29 20 3b WHERE id=?;") ;
12610 3b 20 75 73 69 6e 67 20 73 74 61 74 75 73 20 73 ; using status s
12620 69 6e 63 65 20 6e 6f 20 73 74 61 74 65 20 66 69 ince no state fi
12630 65 6c 64 0a 09 29 29 0a 0a 28 64 65 66 69 6e 65 eld..))..(define
12640 20 28 64 62 3a 6c 6f 6f 6b 75 70 2d 71 75 65 72 (db:lookup-quer
12650 79 20 71 72 79 2d 6e 61 6d 65 29 0a 20 20 28 6c y qry-name). (l
12660 65 74 20 28 28 71 20 28 61 6c 69 73 74 2d 72 65 et ((q (alist-re
12670 66 20 71 72 79 2d 6e 61 6d 65 20 64 62 3a 71 75 f qry-name db:qu
12680 65 72 69 65 73 29 29 29 0a 20 20 20 20 28 69 66 eries))). (if
12690 20 71 20 28 63 61 72 20 71 29 20 23 66 29 29 29 q (car q) #f)))
126a0 0a 0a 3b 3b 20 64 6f 20 6e 6f 74 20 72 75 6e 20 ..;; do not run
126b0 74 68 65 73 65 20 61 73 20 70 61 72 74 20 6f 66 these as part of
126c0 20 74 68 65 20 74 72 61 6e 73 61 63 74 69 6f 6e the transaction
126d0 0a 28 64 65 66 69 6e 65 20 64 62 3a 73 70 65 63 .(define db:spec
126e0 69 61 6c 2d 71 75 65 72 69 65 73 20 20 20 27 28 ial-queries '(
126f0 72 6f 6c 6c 75 70 2d 74 65 73 74 73 2d 70 61 73 rollup-tests-pas
12700 73 2d 66 61 69 6c 0a 09 09 09 20 20 20 20 20 20 s-fail....
12710 20 3b 3b 20 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 ;; db:roll-up-p
12720 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 ass-fail-counts
12730 20 3b 3b 20 57 48 59 20 4e 4f 54 21 3f 0a 09 09 ;; WHY NOT!?...
12740 09 20 20 20 20 20 20 20 6c 6f 67 69 6e 0a 09 09 . login...
12750 09 20 20 20 20 20 20 20 69 6d 6d 65 64 69 61 74 . immediat
12760 65 0a 09 09 09 20 20 20 20 20 20 20 66 6c 75 73 e.... flus
12770 68 0a 09 09 09 20 20 20 20 20 20 20 73 79 6e 63 h.... sync
12780 0a 09 09 09 20 20 20 20 20 20 20 73 65 74 2d 76 .... set-v
12790 65 72 62 6f 73 69 74 79 0a 09 09 09 20 20 20 20 erbosity....
127a0 20 20 20 6b 69 6c 6c 73 65 72 76 65 72 0a 09 09 killserver...
127b0 09 20 20 20 20 20 20 20 29 29 0a 0a 28 64 65 66 . ))..(def
127c0 69 6e 65 20 28 64 62 3a 6c 6f 67 69 6e 20 64 62 ine (db:login db
127d0 20 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 63 61 calling-path ca
127e0 6c 6c 69 6e 67 2d 76 65 72 73 69 6f 6e 20 63 6c lling-version cl
127f0 69 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 29 0a ient-signature).
12800 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 (if (and (equa
12810 6c 3f 20 63 61 6c 6c 69 6e 67 2d 70 61 74 68 20 l? calling-path
12820 2a 74 6f 70 70 61 74 68 2a 29 0a 09 20 20 20 28 *toppath*).. (
12830 65 71 75 61 6c 3f 20 6d 65 67 61 74 65 73 74 2d equal? megatest-
12840 76 65 72 73 69 6f 6e 20 63 61 6c 6c 69 6e 67 2d version calling-
12850 76 65 72 73 69 6f 6e 29 29 0a 20 20 20 20 20 20 version)).
12860 28 62 65 67 69 6e 0a 09 28 68 61 73 68 2d 74 61 (begin..(hash-ta
12870 62 6c 65 2d 73 65 74 21 20 2a 6c 6f 67 67 65 64 ble-set! *logged
12880 2d 69 6e 2d 63 6c 69 65 6e 74 73 2a 20 63 6c 69 -in-clients* cli
12890 65 6e 74 2d 73 69 67 6e 61 74 75 72 65 20 28 63 ent-signature (c
128a0 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
128b0 0a 09 27 28 23 74 20 22 73 75 63 63 65 73 73 66 ..'(#t "successf
128c0 75 6c 20 6c 6f 67 69 6e 22 29 29 20 20 20 20 20 ul login"))
128d0 20 3b 3b 20 70 61 74 68 20 6d 61 74 63 68 65 73 ;; path matches
128e0 20 2d 20 70 61 73 73 21 20 53 68 6f 75 6c 64 20 - pass! Should
128f0 76 65 74 20 74 68 65 20 63 61 6c 6c 65 72 20 61 vet the caller a
12900 74 20 74 68 69 73 20 74 69 6d 65 20 2e 2e 2e 0a t this time ....
12910 20 20 20 20 20 20 28 6c 69 73 74 20 23 66 20 28 (list #f (
12920 63 6f 6e 63 20 22 4c 6f 67 69 6e 20 66 61 69 6c conc "Login fail
12930 65 64 20 64 75 65 20 74 6f 20 6d 69 73 6d 61 74 ed due to mismat
12940 63 68 20 70 61 74 68 73 3a 20 22 20 63 61 6c 6c ch paths: " call
12950 69 6e 67 2d 70 61 74 68 20 22 2c 20 22 20 2a 74 ing-path ", " *t
12960 6f 70 70 61 74 68 2a 29 29 29 29 0a 0a 28 64 65 oppath*))))..(de
12970 66 69 6e 65 20 28 64 62 3a 70 72 6f 63 65 73 73 fine (db:process
12980 2d 77 72 69 74 65 20 64 62 20 72 65 71 75 65 73 -write db reques
12990 74 2d 69 74 65 6d 29 0a 20 20 28 6c 65 74 20 28 t-item). (let (
129a0 28 73 74 6d 74 2d 6b 65 79 20 28 76 65 63 74 6f (stmt-key (vecto
129b0 72 2d 72 65 66 20 72 65 71 75 65 73 74 2d 69 74 r-ref request-it
129c0 65 6d 20 30 29 29 0a 09 28 71 75 65 72 79 20 20 em 0))..(query
129d0 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 (vector-ref re
129e0 71 75 65 73 74 2d 69 74 65 6d 20 31 29 29 0a 09 quest-item 1))..
129f0 28 70 61 72 61 6d 73 20 20 20 28 76 65 63 74 6f (params (vecto
12a00 72 2d 72 65 66 20 72 65 71 75 65 73 74 2d 69 74 r-ref request-it
12a10 65 6d 20 32 29 29 0a 09 28 71 75 65 72 79 68 20 em 2))..(queryh
12a20 20 20 28 73 71 6c 69 74 65 33 3a 70 72 65 70 61 (sqlite3:prepa
12a30 72 65 20 64 62 20 71 75 65 72 79 29 29 29 0a 20 re db query))).
12a40 20 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 (apply sqlite
12a50 33 3a 65 78 65 63 75 74 65 20 73 74 6d 74 20 70 3:execute stmt p
12a60 61 72 61 6d 73 29 0a 20 20 20 20 23 66 29 29 0a arams). #f)).
12a70 3b 3b 20 44 49 53 41 42 4c 49 4e 47 20 46 4f 52 ;; DISABLING FOR
12a80 20 4e 4f 57 20 0a 3b 3b 20 44 49 53 41 42 4c 49 NOW .;; DISABLI
12a90 4e 47 20 46 4f 52 20 4e 4f 57 20 28 64 65 66 69 NG FOR NOW (defi
12aa0 6e 65 20 2a 6e 75 6d 62 65 72 2d 6f 66 2d 77 72 ne *number-of-wr
12ab0 69 74 65 73 2a 20 20 20 20 20 20 20 20 20 30 29 ites* 0)
12ac0 0a 3b 3b 20 44 49 53 41 42 4c 49 4e 47 20 46 4f .;; DISABLING FO
12ad0 52 20 4e 4f 57 20 28 64 65 66 69 6e 65 20 2a 77 R NOW (define *w
12ae0 72 69 74 65 73 2d 74 6f 74 61 6c 2d 64 65 6c 61 rites-total-dela
12af0 79 2a 20 20 20 20 20 20 20 30 29 0a 3b 3b 20 44 y* 0).;; D
12b00 49 53 41 42 4c 49 4e 47 20 46 4f 52 20 4e 4f 57 ISABLING FOR NOW
12b10 20 28 64 65 66 69 6e 65 20 2a 74 6f 74 61 6c 2d (define *total-
12b20 6e 6f 6e 2d 77 72 69 74 65 2d 64 65 6c 61 79 2a non-write-delay*
12b30 20 20 20 20 30 29 0a 3b 3b 20 44 49 53 41 42 4c 0).;; DISABL
12b40 49 4e 47 20 46 4f 52 20 4e 4f 57 20 28 64 65 66 ING FOR NOW (def
12b50 69 6e 65 20 2a 6e 75 6d 62 65 72 2d 6e 6f 6e 2d ine *number-non-
12b60 77 72 69 74 65 2d 71 75 65 72 69 65 73 2a 20 30 write-queries* 0
12b70 29 0a 3b 3b 20 44 49 53 41 42 4c 49 4e 47 20 46 ).;; DISABLING F
12b80 4f 52 20 4e 4f 57 20 0a 3b 3b 20 44 49 53 41 42 OR NOW .;; DISAB
12b90 4c 49 4e 47 20 46 4f 52 20 4e 4f 57 20 3b 3b 20 LING FOR NOW ;;
12ba0 54 68 65 20 71 75 65 75 65 20 69 73 20 61 20 6c The queue is a l
12bb0 69 73 74 20 6f 66 20 76 65 63 74 6f 72 73 20 77 ist of vectors w
12bc0 68 65 72 65 20 74 68 65 20 7a 65 72 6f 74 68 20 here the zeroth
12bd0 73 6c 6f 74 20 69 6e 64 69 63 61 74 65 73 20 74 slot indicates t
12be0 68 65 20 74 79 70 65 20 6f 66 20 71 75 65 72 79 he type of query
12bf0 20 74 6f 0a 3b 3b 20 44 49 53 41 42 4c 49 4e 47 to.;; DISABLING
12c00 20 46 4f 52 20 4e 4f 57 20 3b 3b 20 61 70 70 6c FOR NOW ;; appl
12c10 79 20 61 6e 64 20 74 68 65 20 73 65 63 6f 6e 64 y and the second
12c20 20 73 6c 6f 74 20 69 73 20 74 68 65 20 74 69 6d slot is the tim
12c30 65 20 6f 66 20 74 68 65 20 71 75 65 72 79 20 61 e of the query a
12c40 6e 64 20 74 68 65 20 74 68 69 72 64 20 65 6e 74 nd the third ent
12c50 72 79 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 ry is a list of
12c60 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 67 65 6e .(define (db:gen
12c70 65 72 61 6c 2d 63 61 6c 6c 20 64 62 20 73 74 6d eral-call db stm
12c80 74 6e 61 6d 65 20 70 61 72 61 6d 73 29 0a 20 20 tname params).
12c90 28 6c 65 74 20 28 28 71 75 65 72 79 20 28 6c 65 (let ((query (le
12ca0 74 20 28 28 71 20 28 61 6c 69 73 74 2d 72 65 66 t ((q (alist-ref
12cb0 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 74 (if (string? st
12cc0 6d 74 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 mtname).....
12cd0 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 (string->symb
12ce0 6f 6c 20 73 74 6d 74 6e 61 6d 65 29 0a 09 09 09 ol stmtname)....
12cf0 09 20 20 20 20 20 20 20 73 74 6d 74 6e 61 6d 65 . stmtname
12d00 29 0a 09 09 09 09 20 20 20 64 62 3a 71 75 65 72 )..... db:quer
12d10 69 65 73 29 29 29 0a 09 09 20 28 69 66 20 71 20 ies)))... (if q
12d20 28 63 61 72 20 71 29 20 23 66 29 29 29 29 0a 20 (car q) #f)))).
12d30 20 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 (apply sqlite
12d40 33 3a 65 78 65 63 75 74 65 20 64 62 20 71 75 65 3:execute db que
12d50 72 79 20 70 61 72 61 6d 73 29 0a 20 20 20 20 23 ry params). #
12d60 74 29 29 0a 0a 3b 3b 20 67 65 74 20 74 68 65 20 t))..;; get the
12d70 70 72 65 76 69 6f 75 73 20 72 65 63 6f 72 64 20 previous record
12d80 66 6f 72 20 77 68 65 6e 20 74 68 69 73 20 74 65 for when this te
12d90 73 74 20 77 61 73 20 72 75 6e 20 77 68 65 72 65 st was run where
12da0 20 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 68 20 all keys match
12db0 62 75 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 72 but runname.;; r
12dc0 65 74 75 72 6e 73 20 23 66 20 69 66 20 6e 6f 20 eturns #f if no
12dd0 73 75 63 68 20 74 65 73 74 20 66 6f 75 6e 64 2c such test found,
12de0 20 72 65 74 75 72 6e 73 20 61 20 73 69 6e 67 6c returns a singl
12df0 65 20 74 65 73 74 20 72 65 63 6f 72 64 20 69 66 e test record if
12e00 20 66 6f 75 6e 64 0a 3b 3b 20 0a 3b 3b 20 52 75 found.;; .;; Ru
12e10 6e 20 74 68 69 73 20 73 65 72 76 65 72 2d 73 69 n this server-si
12e20 64 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 de.;;.(define (d
12e30 62 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 b:get-previous-t
12e40 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 64 est-run-record d
12e50 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
12e60 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 me item-path).
12e70 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 (let* ((keys
12e80 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 (db:get-keys db)
12e90 29 0a 09 20 28 73 65 6c 73 74 72 20 20 28 73 74 ).. (selstr (st
12ea0 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
12eb0 20 20 6b 65 79 73 20 22 2c 22 29 29 0a 09 20 28 keys ",")).. (
12ec0 71 72 79 73 74 72 20 20 28 73 74 72 69 6e 67 2d qrystr (string-
12ed0 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
12ee0 20 28 6c 61 6d 62 64 61 20 28 78 29 28 63 6f 6e (lambda (x)(con
12ef0 63 20 78 20 22 3d 3f 22 29 29 20 6b 65 79 73 29 c x "=?")) keys)
12f00 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6b 65 " AND ")).. (ke
12f10 79 76 61 6c 73 20 23 66 29 29 0a 20 20 20 20 3b yvals #f)). ;
12f20 3b 20 66 69 72 73 74 20 6c 6f 6f 6b 20 75 70 20 ; first look up
12f30 74 68 65 20 6b 65 79 20 76 61 6c 75 65 73 20 66 the key values f
12f40 72 6f 6d 20 74 68 65 20 72 75 6e 20 73 65 6c 65 rom the run sele
12f50 63 74 65 64 20 62 79 20 72 75 6e 2d 69 64 0a 20 cted by run-id.
12f60 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d (sqlite3:for-
12f70 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 each-row . (
12f80 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 0a 20 lambda (a . b).
12f90 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 76 (set! keyv
12fa0 61 6c 73 20 28 63 6f 6e 73 20 61 20 62 29 29 29 als (cons a b)))
12fb0 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 28 63 . db. (c
12fc0 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 73 65 onc "SELECT " se
12fd0 6c 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 lstr " FROM runs
12fe0 20 57 48 45 52 45 20 69 64 3d 3f 20 4f 52 44 45 WHERE id=? ORDE
12ff0 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 R BY event_time
13000 44 45 53 43 3b 22 29 20 72 75 6e 2d 69 64 29 0a DESC;") run-id).
13010 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b 65 79 (if (not key
13020 76 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 74 20 vals)..#f..(let
13030 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 27 ((prev-run-ids '
13040 28 29 29 29 0a 09 20 20 28 61 70 70 6c 79 20 73 ())).. (apply s
13050 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
13060 72 6f 77 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 row... (lambda (
13070 69 64 29 0a 09 09 20 20 20 28 73 65 74 21 20 70 id)... (set! p
13080 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 63 6f 6e rev-run-ids (con
13090 73 20 69 64 20 70 72 65 76 2d 72 75 6e 2d 69 64 s id prev-run-id
130a0 73 29 29 29 0a 09 09 20 64 62 0a 09 09 20 28 63 s)))... db... (c
130b0 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 20 46 onc "SELECT id F
130c0 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 22 ROM runs WHERE "
130d0 20 71 72 79 73 74 72 20 22 20 41 4e 44 20 69 64 qrystr " AND id
130e0 20 21 3d 20 3f 3b 22 29 20 28 61 70 70 65 6e 64 != ?;") (append
130f0 20 6b 65 79 76 61 6c 73 20 28 6c 69 73 74 20 72 keyvals (list r
13100 75 6e 2d 69 64 29 29 29 0a 09 20 20 3b 3b 20 66 un-id))).. ;; f
13110 6f 72 20 65 61 63 68 20 72 75 6e 20 73 74 61 72 or each run star
13120 74 69 6e 67 20 77 69 74 68 20 74 68 65 20 6d 6f ting with the mo
13130 73 74 20 72 65 63 65 6e 74 20 6c 6f 6f 6b 20 74 st recent look t
13140 6f 20 73 65 65 20 69 66 20 74 68 65 72 65 20 69 o see if there i
13150 73 20 61 20 6d 61 74 63 68 69 6e 67 20 74 65 73 s a matching tes
13160 74 0a 09 20 20 3b 3b 20 69 66 20 66 6f 75 6e 64 t.. ;; if found
13170 20 74 68 65 6e 20 72 65 74 75 72 6e 20 74 68 61 then return tha
13180 74 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 20 t matching test
13190 72 65 63 6f 72 64 0a 09 20 20 28 64 65 62 75 67 record.. (debug
131a0 3a 70 72 69 6e 74 20 34 20 22 73 65 6c 73 74 72 :print 4 "selstr
131b0 3a 20 22 20 73 65 6c 73 74 72 20 22 2c 20 71 72 : " selstr ", qr
131c0 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
131d0 2c 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 , keyvals: " key
131e0 76 61 6c 73 20 22 2c 20 70 72 65 76 69 6f 75 73 vals ", previous
131f0 20 72 75 6e 20 69 64 73 20 66 6f 75 6e 64 3a 20 run ids found:
13200 22 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 0a " prev-run-ids).
13210 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 72 . (if (null? pr
13220 65 76 2d 72 75 6e 2d 69 64 73 29 20 23 66 0a 09 ev-run-ids) #f..
13230 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
13240 28 28 68 65 64 20 28 63 61 72 20 70 72 65 76 2d ((hed (car prev-
13250 72 75 6e 2d 69 64 73 29 29 0a 09 09 09 20 28 74 run-ids)).... (t
13260 61 6c 20 28 63 64 72 20 70 72 65 76 2d 72 75 6e al (cdr prev-run
13270 2d 69 64 73 29 29 29 0a 09 09 28 6c 65 74 20 28 -ids)))...(let (
13280 28 72 65 73 75 6c 74 73 20 28 64 62 3a 67 65 74 (results (db:get
13290 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 -tests-for-run d
132a0 62 20 68 65 64 20 28 63 6f 6e 63 20 74 65 73 74 b hed (conc test
132b0 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 -name "/" item-p
132c0 61 74 68 29 20 27 28 29 20 27 28 29 20 23 66 20 ath) '() '() #f
132d0 23 66 20 23 66 20 23 66 20 23 66 20 23 66 29 29 #f #f #f #f #f))
132e0 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 )... (debug:pri
132f0 6e 74 20 34 20 22 47 6f 74 20 74 65 73 74 73 20 nt 4 "Got tests
13300 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 6e for run-id " run
13310 2d 69 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d 65 -id ", test-name
13320 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 2c 20 " test-name ",
13330 69 74 65 6d 2d 70 61 74 68 20 22 20 69 74 65 6d item-path " item
13340 2d 70 61 74 68 20 22 3a 20 22 20 72 65 73 75 6c -path ": " resul
13350 74 73 29 0a 09 09 20 20 28 69 66 20 28 61 6e 64 ts)... (if (and
13360 20 28 6e 75 6c 6c 3f 20 72 65 73 75 6c 74 73 29 (null? results)
13370 0a 09 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 6c .... (not (nul
13380 6c 3f 20 74 61 6c 29 29 29 0a 09 09 20 20 20 20 l? tal)))...
13390 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
133a0 29 28 63 64 72 20 74 61 6c 29 29 0a 09 09 20 20 )(cdr tal))...
133b0 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
133c0 65 73 75 6c 74 73 29 20 23 66 0a 09 09 09 20 20 esults) #f....
133d0 28 63 61 72 20 72 65 73 75 6c 74 73 29 29 29 29 (car results))))
133e0 29 29 29 29 29 29 0a 0a 3b 3b 20 67 65 74 20 74 ))))))..;; get t
133f0 68 65 20 70 72 65 76 69 6f 75 73 20 72 65 63 6f he previous reco
13400 72 64 73 20 66 6f 72 20 77 68 65 6e 20 74 68 65 rds for when the
13410 73 65 20 74 65 73 74 73 20 77 65 72 65 20 72 75 se tests were ru
13420 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 n where all keys
13430 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e 6e 61 match but runna
13440 6d 65 0a 3b 3b 20 4e 42 2f 2f 20 4d 65 72 67 65 me.;; NB// Merge
13450 20 74 68 69 73 20 77 69 74 68 20 74 65 73 74 3a this with test:
13460 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 get-previous-tes
13470 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 3f 20 54 t-run-records? T
13480 68 69 73 20 6f 6e 65 20 6c 6f 6f 6b 73 20 66 6f his one looks fo
13490 72 20 61 6c 6c 20 6d 61 74 63 68 69 6e 67 20 74 r all matching t
134a0 65 73 74 73 0a 3b 3b 20 63 61 6e 20 75 73 65 20 ests.;; can use
134b0 77 69 6c 64 63 61 72 64 73 2e 20 41 6c 73 6f 20 wildcards. Also
134c0 63 61 6e 20 6c 69 6b 65 6c 79 20 62 65 20 66 61 can likely be fa
134d0 63 74 6f 72 65 64 20 69 6e 20 77 69 74 68 20 67 ctored in with g
134e0 65 74 20 74 65 73 74 20 70 61 74 68 73 3f 0a 3b et test paths?.;
134f0 3b 0a 3b 3b 20 52 75 6e 20 74 68 69 73 20 72 65 ;.;; Run this re
13500 6d 6f 74 65 6c 79 21 21 0a 3b 3b 0a 28 64 65 66 motely!!.;;.(def
13510 69 6e 65 20 28 64 62 3a 67 65 74 2d 6d 61 74 63 ine (db:get-matc
13520 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 hing-previous-te
13530 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 64 st-run-records d
13540 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
13550 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 me item-path).
13560 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 (let* ((keys
13570 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 (db:get-keys db)
13580 29 0a 09 20 28 73 65 6c 73 74 72 20 20 28 73 74 ).. (selstr (st
13590 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
135a0 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 (map (lambda (x
135b0 29 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 )(vector-ref x 0
135c0 29 29 20 6b 65 79 73 29 20 22 2c 22 29 29 0a 09 )) keys) ","))..
135d0 20 28 71 72 79 73 74 72 20 20 28 73 74 72 69 6e (qrystr (strin
135e0 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
135f0 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 63 ap (lambda (x)(c
13600 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 onc (vector-ref
13610 78 20 30 29 20 22 3d 3f 22 29 29 20 6b 65 79 73 x 0) "=?")) keys
13620 29 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6b ) " AND ")).. (k
13630 65 79 76 61 6c 73 20 23 66 29 0a 09 20 28 74 65 eyvals #f).. (te
13640 73 74 73 2d 68 61 73 68 20 28 6d 61 6b 65 2d 68 sts-hash (make-h
13650 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 ash-table))).
13660 20 3b 3b 20 66 69 72 73 74 20 6c 6f 6f 6b 20 75 ;; first look u
13670 70 20 74 68 65 20 6b 65 79 20 76 61 6c 75 65 73 p the key values
13680 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 20 73 65 from the run se
13690 6c 65 63 74 65 64 20 62 79 20 72 75 6e 2d 69 64 lected by run-id
136a0 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
136b0 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
136c0 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 (lambda (a . b)
136d0 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 . (set! ke
136e0 79 76 61 6c 73 20 28 63 6f 6e 73 20 61 20 62 29 yvals (cons a b)
136f0 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 )). db.
13700 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 (conc "SELECT "
13710 73 65 6c 73 74 72 20 22 20 46 52 4f 4d 20 72 75 selstr " FROM ru
13720 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 20 4f 52 ns WHERE id=? OR
13730 44 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d DER BY event_tim
13740 65 20 44 45 53 43 3b 22 29 20 72 75 6e 2d 69 64 e DESC;") run-id
13750 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b ). (if (not k
13760 65 79 76 61 6c 73 29 0a 09 27 28 29 0a 09 28 6c eyvals)..'()..(l
13770 65 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 et ((prev-run-id
13780 73 20 27 28 29 29 29 0a 09 20 20 28 61 70 70 6c s '())).. (appl
13790 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 y sqlite3:for-ea
137a0 63 68 2d 72 6f 77 0a 09 09 20 28 6c 61 6d 62 64 ch-row... (lambd
137b0 61 20 28 69 64 29 0a 09 09 20 20 20 28 73 65 74 a (id)... (set
137c0 21 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 ! prev-run-ids (
137d0 63 6f 6e 73 20 69 64 20 70 72 65 76 2d 72 75 6e cons id prev-run
137e0 2d 69 64 73 29 29 29 0a 09 09 20 64 62 0a 09 09 -ids)))... db...
137f0 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 (conc "SELECT i
13800 64 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 d FROM runs WHER
13810 45 20 22 20 71 72 79 73 74 72 20 22 20 41 4e 44 E " qrystr " AND
13820 20 69 64 20 21 3d 20 3f 3b 22 29 20 28 61 70 70 id != ?;") (app
13830 65 6e 64 20 6b 65 79 76 61 6c 73 20 28 6c 69 73 end keyvals (lis
13840 74 20 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 3b t run-id))).. ;
13850 3b 20 63 6f 6c 6c 65 63 74 20 61 6c 6c 20 6d 61 ; collect all ma
13860 74 63 68 69 6e 67 20 74 65 73 74 73 20 66 6f 72 tching tests for
13870 20 74 68 65 20 72 75 6e 73 20 74 68 65 6e 0a 09 the runs then..
13880 20 20 3b 3b 20 65 78 74 72 61 63 74 20 74 68 65 ;; extract the
13890 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 most recent tes
138a0 74 20 61 6e 64 20 72 65 74 75 72 6e 20 74 68 61 t and return tha
138b0 74 2e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 t... (debug:pri
138c0 6e 74 20 34 20 22 73 65 6c 73 74 72 3a 20 22 20 nt 4 "selstr: "
138d0 73 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 selstr ", qrystr
138e0 3a 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 : " qrystr ", ke
138f0 79 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 yvals: " keyvals
13900 20 0a 09 09 20 20 20 20 20 20 20 22 2c 20 70 72 ... ", pr
13910 65 76 69 6f 75 73 20 72 75 6e 20 69 64 73 20 66 evious run ids f
13920 6f 75 6e 64 3a 20 22 20 70 72 65 76 2d 72 75 6e ound: " prev-run
13930 2d 69 64 73 29 0a 09 20 20 28 69 66 20 28 6e 75 -ids).. (if (nu
13940 6c 6c 3f 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 ll? prev-run-ids
13950 29 20 27 28 29 20 20 3b 3b 20 6e 6f 20 70 72 65 ) '() ;; no pre
13960 76 69 6f 75 73 20 72 75 6e 73 3f 20 72 65 74 75 vious runs? retu
13970 72 6e 20 6e 75 6c 6c 0a 09 20 20 20 20 20 20 28 rn null.. (
13980 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
13990 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 car prev-run-ids
139a0 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 64 72 )).... (tal (cdr
139b0 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 prev-run-ids)))
139c0 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 6c 74 ...(let ((result
139d0 73 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d s (db:get-tests-
139e0 66 6f 72 2d 72 75 6e 20 64 62 20 68 65 64 20 28 for-run db hed (
139f0 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 conc test-name "
13a00 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 20 27 28 /" item-path) '(
13a10 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 23 ) '() #f #f #f #
13a20 66 20 23 66 20 23 66 29 29 29 0a 09 09 20 20 28 f #f #f)))... (
13a30 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 47 debug:print 4 "G
13a40 6f 74 20 74 65 73 74 73 20 66 6f 72 20 72 75 6e ot tests for run
13a50 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 -id " run-id ",
13a60 74 65 73 74 2d 6e 61 6d 65 20 22 20 74 65 73 74 test-name " test
13a70 2d 6e 61 6d 65 20 0a 09 09 09 20 20 20 20 20 20 -name ....
13a80 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 ", item-path "
13a90 69 74 65 6d 2d 70 61 74 68 20 22 20 72 65 73 75 item-path " resu
13aa0 6c 74 73 3a 20 22 20 28 69 6e 74 65 72 73 70 65 lts: " (interspe
13ab0 72 73 65 20 72 65 73 75 6c 74 73 20 22 5c 6e 22 rse results "\n"
13ac0 29 29 0a 09 09 20 20 3b 3b 20 4b 65 65 70 20 6f ))... ;; Keep o
13ad0 6e 6c 79 20 74 68 65 20 79 6f 75 6e 67 65 73 74 nly the youngest
13ae0 20 6f 66 20 61 6e 79 20 74 65 73 74 2f 69 74 65 of any test/ite
13af0 6d 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 0a 09 09 m combination...
13b00 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 (for-each ...
13b10 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 (lambda (testd
13b20 61 74 29 0a 09 09 20 20 20 20 20 28 6c 65 74 2a at)... (let*
13b30 20 28 28 66 75 6c 6c 2d 74 65 73 74 6e 61 6d 65 ((full-testname
13b40 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d (conc (db:test-
13b50 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 get-testname tes
13b60 74 64 61 74 29 20 22 2f 22 20 28 64 62 3a 74 65 tdat) "/" (db:te
13b70 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 st-get-item-path
13b80 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 09 20 testdat)))....
13b90 20 20 20 28 73 74 6f 72 65 64 2d 74 65 73 74 20 (stored-test
13ba0 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
13bb0 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d f/default tests-
13bc0 68 61 73 68 20 66 75 6c 6c 2d 74 65 73 74 6e 61 hash full-testna
13bd0 6d 65 20 23 66 29 29 29 0a 09 09 20 20 20 20 20 me #f)))...
13be0 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 (if (or (not s
13bf0 74 6f 72 65 64 2d 74 65 73 74 29 0a 09 09 09 20 tored-test)....
13c00 20 20 20 20 20 20 28 61 6e 64 20 73 74 6f 72 65 (and store
13c10 64 2d 74 65 73 74 0a 09 09 09 09 20 20 20 20 28 d-test..... (
13c20 3e 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 > (db:test-get-e
13c30 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 64 61 vent_time testda
13c40 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 t)(db:test-get-e
13c50 76 65 6e 74 5f 74 69 6d 65 20 73 74 6f 72 65 64 vent_time stored
13c60 2d 74 65 73 74 29 29 29 29 0a 09 09 09 20 20 20 -test))))....
13c70 3b 3b 20 74 68 69 73 20 74 65 73 74 20 69 73 20 ;; this test is
13c80 79 6f 75 6e 67 65 72 2c 20 73 74 6f 72 65 20 69 younger, store i
13c90 74 20 69 6e 20 74 68 65 20 68 61 73 68 0a 09 09 t in the hash...
13ca0 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
13cb0 73 65 74 21 20 74 65 73 74 73 2d 68 61 73 68 20 set! tests-hash
13cc0 66 75 6c 6c 2d 74 65 73 74 6e 61 6d 65 20 74 65 full-testname te
13cd0 73 74 64 61 74 29 29 29 29 0a 09 09 20 20 20 72 stdat))))... r
13ce0 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 esults)... (if
13cf0 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 (null? tal)...
13d00 20 20 20 20 28 6d 61 70 20 63 64 72 20 28 68 61 (map cdr (ha
13d10 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 sh-table->alist
13d20 74 65 73 74 73 2d 68 61 73 68 29 29 20 3b 3b 20 tests-hash)) ;;
13d30 72 65 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 return a list of
13d40 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 the most recent
13d50 20 74 65 73 74 73 0a 09 09 20 20 20 20 20 20 28 tests... (
13d60 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
13d70 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 29 29 dr tal))))))))))
13d80 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 ..(define (db:te
13d90 73 74 2d 67 65 74 2d 72 65 63 6f 72 64 73 2d 66 st-get-records-f
13da0 6f 72 2d 69 6e 64 65 78 2d 66 69 6c 65 20 64 62 or-index-file db
13db0 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 74 65 struct run-id te
13dc0 73 74 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 20 st-name). (let
13dd0 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 ((res '())).
13de0 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
13df0 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d h-row . (lam
13e00 62 64 61 20 28 69 64 20 69 74 65 6d 70 61 74 68 bda (id itempath
13e10 20 73 74 61 74 65 20 73 74 61 74 75 73 20 72 75 state status ru
13e20 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66 2d n_duration logf-
13e30 69 64 20 63 6f 6d 6d 65 6e 74 2d 69 64 29 0a 20 id comment-id).
13e40 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 6f 67 (let ((log
13e50 66 20 20 20 20 28 64 62 3a 67 65 74 2d 73 74 72 f (db:get-str
13e60 69 6e 67 20 64 62 73 74 72 75 63 74 20 6c 6f 67 ing dbstruct log
13e70 66 2d 69 64 29 29 0a 09 20 20 20 20 20 28 63 6f f-id)).. (co
13e80 6d 6d 65 6e 74 20 28 64 62 3a 67 65 74 2d 73 74 mment (db:get-st
13e90 72 69 6e 67 20 64 62 73 74 72 75 63 74 20 63 6f ring dbstruct co
13ea0 6d 6d 65 6e 74 2d 69 64 29 29 29 0a 20 20 20 20 mment-id))).
13eb0 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
13ec0 6e 73 20 28 76 65 63 74 6f 72 20 69 64 20 69 74 ns (vector id it
13ed0 65 6d 70 61 74 68 20 73 74 61 74 65 20 73 74 61 empath state sta
13ee0 74 75 73 20 72 75 6e 5f 64 75 72 61 74 69 6f 6e tus run_duration
13ef0 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 29 20 72 logf comment) r
13f00 65 73 29 29 29 0a 20 20 20 20 20 28 64 62 3a 67 es))). (db:g
13f10 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 20 72 et-db dbstruct r
13f20 75 6e 2d 69 64 29 0a 20 20 20 20 20 22 53 45 4c un-id). "SEL
13f30 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 68 ECT id,item_path
13f40 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 72 75 ,state,status,ru
13f50 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c n_duration,final
13f60 5f 6c 6f 67 66 5f 69 64 2c 63 6f 6d 6d 65 6e 74 _logf_id,comment
13f70 5f 69 64 20 46 52 4f 4d 20 74 65 73 74 73 20 57 _id FROM tests W
13f80 48 45 52 45 20 74 65 73 74 6e 61 6d 65 3d 3f 20 HERE testname=?
13f90 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d AND item_path !=
13fa0 20 27 27 3b 22 0a 20 20 20 20 20 74 65 73 74 2d '';". test-
13fb0 6e 61 6d 65 29 0a 20 20 20 20 72 65 73 29 29 29 name). res)))
13fc0 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
13fd0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13fe0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
13ff0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14000 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 54 65 ==========.;; Te
14010 73 74 73 20 6d 65 74 61 20 64 61 74 61 0a 3b 3b sts meta data.;;
14020 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14030 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14040 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14050 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14060 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 72 65 61 64 20 ======..;; read
14070 74 68 65 20 72 65 63 6f 72 64 20 67 69 76 65 6e the record given
14080 20 61 20 74 65 73 74 6e 61 6d 65 0a 28 64 65 66 a testname.(def
14090 69 6e 65 20 28 64 62 3a 74 65 73 74 6d 65 74 61 ine (db:testmeta
140a0 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 73 74 -get-record dbst
140b0 72 75 63 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 ruct testname).
140c0 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 (let ((res #f))
140d0 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
140e0 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 r-each-row.
140f0 28 6c 61 6d 62 64 61 20 28 69 64 20 74 65 73 74 (lambda (id test
14100 6e 61 6d 65 20 61 75 74 68 6f 72 20 6f 77 6e 65 name author owne
14110 72 20 64 65 73 63 72 69 70 74 69 6f 6e 20 72 65 r description re
14120 76 69 65 77 65 64 20 69 74 65 72 61 74 65 64 20 viewed iterated
14130 61 76 67 5f 72 75 6e 74 69 6d 65 20 61 76 67 5f avg_runtime avg_
14140 64 69 73 6b 20 74 61 67 73 29 0a 20 20 20 20 20 disk tags).
14150 20 20 28 73 65 74 21 20 72 65 73 20 28 76 65 63 (set! res (vec
14160 74 6f 72 20 69 64 20 74 65 73 74 6e 61 6d 65 20 tor id testname
14170 61 75 74 68 6f 72 20 6f 77 6e 65 72 20 64 65 73 author owner des
14180 63 72 69 70 74 69 6f 6e 20 72 65 76 69 65 77 65 cription reviewe
14190 64 20 69 74 65 72 61 74 65 64 20 61 76 67 5f 72 d iterated avg_r
141a0 75 6e 74 69 6d 65 20 61 76 67 5f 64 69 73 6b 20 untime avg_disk
141b0 74 61 67 73 29 29 29 0a 20 20 20 20 20 28 64 62 tags))). (db
141c0 3a 67 65 74 2d 64 62 20 64 62 73 74 72 75 63 74 :get-db dbstruct
141d0 20 23 66 29 0a 20 20 20 20 20 22 53 45 4c 45 43 #f). "SELEC
141e0 54 20 69 64 2c 74 65 73 74 6e 61 6d 65 2c 61 75 T id,testname,au
141f0 74 68 6f 72 2c 6f 77 6e 65 72 2c 64 65 73 63 72 thor,owner,descr
14200 69 70 74 69 6f 6e 2c 72 65 76 69 65 77 65 64 2c iption,reviewed,
14210 69 74 65 72 61 74 65 64 2c 61 76 67 5f 72 75 6e iterated,avg_run
14220 74 69 6d 65 2c 61 76 67 5f 64 69 73 6b 2c 74 61 time,avg_disk,ta
14230 67 73 20 46 52 4f 4d 20 74 65 73 74 5f 6d 65 74 gs FROM test_met
14240 61 20 57 48 45 52 45 20 74 65 73 74 6e 61 6d 65 a WHERE testname
14250 3d 3f 3b 22 0a 20 20 20 20 20 74 65 73 74 6e 61 =?;". testna
14260 6d 65 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b me). res))..;
14270 3b 20 63 72 65 61 74 65 20 61 20 6e 65 77 20 72 ; create a new r
14280 65 63 6f 72 64 20 66 6f 72 20 61 20 67 69 76 65 ecord for a give
14290 6e 20 74 65 73 74 6e 61 6d 65 0a 28 64 65 66 69 n testname.(defi
142a0 6e 65 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d ne (db:testmeta-
142b0 61 64 64 2d 72 65 63 6f 72 64 20 64 62 73 74 72 add-record dbstr
142c0 75 63 74 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 uct testname).
142d0 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
142e0 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 74 (db:get-db dbst
142f0 72 75 63 74 20 23 66 29 20 22 49 4e 53 45 52 54 ruct #f) "INSERT
14300 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 OR IGNORE INTO
14310 74 65 73 74 5f 6d 65 74 61 20 28 74 65 73 74 6e test_meta (testn
14320 61 6d 65 2c 61 75 74 68 6f 72 2c 6f 77 6e 65 72 ame,author,owner
14330 2c 64 65 73 63 72 69 70 74 69 6f 6e 2c 72 65 76 ,description,rev
14340 69 65 77 65 64 2c 69 74 65 72 61 74 65 64 2c 61 iewed,iterated,a
14350 76 67 5f 72 75 6e 74 69 6d 65 2c 61 76 67 5f 64 vg_runtime,avg_d
14360 69 73 6b 2c 74 61 67 73 29 20 56 41 4c 55 45 53 isk,tags) VALUES
14370 20 28 3f 2c 27 27 2c 27 27 2c 27 27 2c 27 27 2c (?,'','','','',
14380 27 27 2c 27 27 2c 27 27 2c 27 27 29 3b 22 20 74 '','','','');" t
14390 65 73 74 6e 61 6d 65 29 29 0a 0a 3b 3b 20 75 70 estname))..;; up
143a0 64 61 74 65 20 6f 6e 65 20 6f 66 20 74 68 65 20 date one of the
143b0 74 65 73 74 6d 65 74 61 20 66 69 65 6c 64 73 0a testmeta fields.
143c0 28 64 65 66 69 6e 65 20 28 64 62 3a 74 65 73 74 (define (db:test
143d0 6d 65 74 61 2d 75 70 64 61 74 65 2d 66 69 65 6c meta-update-fiel
143e0 64 20 64 62 73 74 72 75 63 74 20 74 65 73 74 6e d dbstruct testn
143f0 61 6d 65 20 66 69 65 6c 64 20 76 61 6c 75 65 29 ame field value)
14400 0a 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 . (sqlite3:exec
14410 75 74 65 20 28 64 62 3a 67 65 74 2d 64 62 20 64 ute (db:get-db d
14420 62 73 74 72 75 63 74 20 23 66 29 20 28 63 6f 6e bstruct #f) (con
14430 63 20 22 55 50 44 41 54 45 20 74 65 73 74 5f 6d c "UPDATE test_m
14440 65 74 61 20 53 45 54 20 22 20 66 69 65 6c 64 20 eta SET " field
14450 22 3d 3f 20 57 48 45 52 45 20 74 65 73 74 6e 61 "=? WHERE testna
14460 6d 65 3d 3f 3b 22 29 20 76 61 6c 75 65 20 74 65 me=?;") value te
14470 73 74 6e 61 6d 65 29 29 0a 0a 28 64 65 66 69 6e stname))..(defin
14480 65 20 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 67 e (db:testmeta-g
14490 65 74 2d 61 6c 6c 20 64 62 29 0a 20 20 28 6c 65 et-all db). (le
144a0 74 20 28 28 72 65 73 20 27 28 29 29 29 0a 20 20 t ((res '())).
144b0 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
144c0 61 63 68 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 ach-row. (la
144d0 6d 62 64 61 20 28 61 20 2e 20 62 29 0a 20 20 20 mbda (a . b).
144e0 20 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 (set! res (c
144f0 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 63 74 6f ons (apply vecto
14500 72 20 61 20 62 29 20 72 65 73 29 29 29 0a 20 20 r a b) res))).
14510 20 20 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 (db:get-db db
14520 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a 20 struct run-id).
14530 20 20 20 20 22 53 45 4c 45 43 54 20 69 64 2c 74 "SELECT id,t
14540 65 73 74 6e 61 6d 65 2c 61 75 74 68 6f 72 2c 6f estname,author,o
14550 77 6e 65 72 2c 64 65 73 63 72 69 70 74 69 6f 6e wner,description
14560 2c 72 65 76 69 65 77 65 64 2c 69 74 65 72 61 74 ,reviewed,iterat
14570 65 64 2c 61 76 67 5f 72 75 6e 74 69 6d 65 2c 61 ed,avg_runtime,a
14580 76 67 5f 64 69 73 6b 2c 74 61 67 73 2c 6a 6f 62 vg_disk,tags,job
14590 67 72 6f 75 70 20 46 52 4f 4d 20 74 65 73 74 5f group FROM test_
145a0 6d 65 74 61 3b 22 29 0a 20 20 20 20 72 65 73 29 meta;"). res)
145b0 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
145c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
145f0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d ===========.;; M
14600 20 49 20 53 20 43 20 20 20 4d 20 41 20 4e 20 41 I S C M A N A
14610 20 47 20 45 20 4d 20 45 20 4e 20 54 20 20 20 49 G E M E N T I
14620 20 54 20 45 20 4d 20 53 20 0a 3b 3b 3d 3d 3d 3d T E M S .;;====
14630 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14640 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14650 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14660 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
14670 3d 3d 0a 0a 3b 3b 20 74 68 65 20 6e 65 77 20 70 ==..;; the new p
14680 72 65 72 65 71 73 20 63 61 6c 63 75 6c 61 74 69 rereqs calculati
14690 6f 6e 2c 20 6c 6f 6f 6b 73 20 61 6c 73 6f 20 61 on, looks also a
146a0 74 20 69 74 65 6d 70 61 74 68 20 69 66 20 73 70 t itempath if sp
146b0 65 63 69 66 69 65 64 0a 3b 3b 20 61 6c 6c 20 70 ecified.;; all p
146c0 72 65 72 65 71 73 20 6d 75 73 74 20 62 65 20 6d rereqs must be m
146d0 65 74 3a 0a 3b 3b 20 20 20 20 69 66 20 70 72 65 et:.;; if pre
146e0 72 65 71 20 74 65 73 74 20 77 69 74 68 20 69 74 req test with it
146f0 65 6d 70 61 74 68 3d 27 27 20 69 73 20 43 4f 4d empath='' is COM
14700 50 4c 45 54 45 44 20 61 6e 64 20 50 41 53 53 2c PLETED and PASS,
14710 20 57 41 52 4e 2c 20 43 48 45 43 4b 2c 20 6f 72 WARN, CHECK, or
14720 20 57 41 49 56 45 44 20 74 68 65 6e 20 70 72 65 WAIVED then pre
14730 72 65 71 20 69 73 20 6d 65 74 0a 3b 3b 20 20 20 req is met.;;
14740 20 69 66 20 70 72 65 72 65 71 20 74 65 73 74 20 if prereq test
14750 77 69 74 68 20 69 74 65 6d 70 61 74 68 3d 72 65 with itempath=re
14760 66 2d 69 74 65 6d 2d 70 61 74 68 20 61 6e 64 20 f-item-path and
14770 43 4f 4d 50 4c 45 54 45 44 20 77 69 74 68 20 50 COMPLETED with P
14780 41 53 53 2c 20 57 41 52 4e 2c 20 43 48 45 43 4b ASS, WARN, CHECK
14790 2c 20 6f 72 20 57 41 49 56 45 44 20 74 68 65 6e , or WAIVED then
147a0 20 70 72 65 72 65 71 20 69 73 20 6d 65 74 0a 3b prereq is met.;
147b0 3b 0a 3b 3b 20 4e 6f 74 65 3a 20 6d 6f 64 65 20 ;.;; Note: mode
147c0 27 6e 6f 72 6d 61 6c 20 6d 65 61 6e 73 20 74 68 'normal means th
147d0 61 74 20 74 65 73 74 73 20 6d 75 73 74 20 62 65 at tests must be
147e0 20 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 6f COMPLETED and o
147f0 6b 20 28 69 2e 65 2e 20 50 41 53 53 2c 20 57 41 k (i.e. PASS, WA
14800 52 4e 2c 20 43 48 45 43 4b 2c 20 53 4b 49 50 20 RN, CHECK, SKIP
14810 6f 72 20 57 41 49 56 45 44 29 0a 3b 3b 20 20 20 or WAIVED).;;
14820 20 20 20 20 6d 6f 64 65 20 27 74 6f 70 6c 65 76 mode 'toplev
14830 65 6c 20 6d 65 61 6e 73 20 74 68 61 74 20 74 65 el means that te
14840 73 74 73 20 6d 75 73 74 20 62 65 20 43 4f 4d 50 sts must be COMP
14850 4c 45 54 45 44 20 6f 6e 6c 79 0a 3b 3b 20 20 20 LETED only.;;
14860 20 20 20 20 6d 6f 64 65 20 27 69 74 65 6d 6d 61 mode 'itemma
14870 74 63 68 20 6f 72 20 27 69 74 65 6d 77 61 69 74 tch or 'itemwait
14880 20 6d 65 61 6e 73 20 74 68 61 74 20 74 65 73 74 means that test
14890 73 20 69 74 65 6d 73 20 6d 75 73 74 20 62 65 20 s items must be
148a0 43 4f 4d 50 4c 45 54 45 44 20 61 6e 64 20 28 50 COMPLETED and (P
148b0 41 53 53 7c 57 41 52 4e 7c 57 41 49 56 45 44 7c ASS|WARN|WAIVED|
148c0 43 48 45 43 4b 29 20 5b 5b 20 4e 42 2f 2f 20 4e CHECK) [[ NB// N
148d0 4f 54 20 49 4d 50 4c 45 4d 45 4e 54 45 44 20 59 OT IMPLEMENTED Y
148e0 45 54 20 5d 5d 0a 3b 3b 20 0a 28 64 65 66 69 6e ET ]].;; .(defin
148f0 65 20 28 64 62 3a 67 65 74 2d 70 72 65 72 65 71 e (db:get-prereq
14900 73 2d 6e 6f 74 2d 6d 65 74 20 64 62 73 74 72 75 s-not-met dbstru
14910 63 74 20 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e ct run-id waiton
14920 73 20 72 65 66 2d 69 74 65 6d 2d 70 61 74 68 20 s ref-item-path
14930 6d 6f 64 65 29 0a 20 20 28 69 66 20 28 6f 72 20 mode). (if (or
14940 28 6e 6f 74 20 77 61 69 74 6f 6e 73 29 0a 09 20 (not waitons)..
14950 20 28 6e 75 6c 6c 3f 20 77 61 69 74 6f 6e 73 29 (null? waitons)
14960 29 0a 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 ). '().
14970 20 20 28 6c 65 74 2a 20 28 28 75 6e 6d 65 74 2d (let* ((unmet-
14980 70 72 65 2d 72 65 71 73 20 27 28 29 29 0a 09 20 pre-reqs '())..
14990 20 20 20 20 28 72 65 73 75 6c 74 20 20 20 20 20 (result
149a0 20 20 20 20 27 28 29 29 29 0a 09 28 66 6f 72 2d '()))..(for-
149b0 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 each .. (lambda
149c0 28 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 (waitontest-name
149d0 29 0a 09 20 20 20 3b 3b 20 62 79 20 67 65 74 74 ).. ;; by gett
149e0 69 6e 67 20 74 68 65 20 74 65 73 74 73 20 77 69 ing the tests wi
149f0 74 68 20 6d 61 74 63 68 69 6e 67 20 6e 61 6d 65 th matching name
14a00 20 77 65 20 61 72 65 20 6c 6f 6f 6b 69 6e 67 20 we are looking
14a10 6f 6e 6c 79 20 61 74 20 74 68 65 20 6d 61 74 63 only at the matc
14a20 68 69 6e 67 20 74 65 73 74 20 0a 09 20 20 20 3b hing test .. ;
14a30 3b 20 61 6e 64 20 72 65 6c 61 74 65 64 20 73 75 ; and related su
14a40 62 20 69 74 65 6d 73 0a 09 20 20 20 3b 3b 20 6e b items.. ;; n
14a50 65 78 74 20 73 68 6f 75 6c 64 20 62 65 20 75 73 ext should be us
14a60 69 6e 67 20 6d 74 3a 67 65 74 2d 74 65 73 74 73 ing mt:get-tests
14a70 2d 66 6f 72 2d 72 75 6e 3f 0a 09 20 20 20 28 6c -for-run?.. (l
14a80 65 74 20 28 28 74 65 73 74 73 20 20 20 20 20 20 et ((tests
14a90 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 (db:get-t
14aa0 65 73 74 73 2d 66 6f 72 2d 72 75 6e 2d 73 74 61 ests-for-run-sta
14ab0 74 65 2d 73 74 61 74 75 73 20 64 62 20 72 75 6e te-status db run
14ac0 2d 69 64 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e -id waitontest-n
14ad0 61 6d 65 29 29 0a 09 09 20 28 65 76 65 72 2d 73 ame))... (ever-s
14ae0 65 65 6e 20 20 20 20 20 20 20 20 20 23 66 29 0a een #f).
14af0 09 09 20 28 70 61 72 65 6e 74 2d 77 61 69 74 6f .. (parent-waito
14b00 6e 2d 6d 65 74 20 23 66 29 0a 09 09 20 28 69 74 n-met #f)... (it
14b10 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 20 20 em-waiton-met
14b20 23 66 29 29 0a 09 20 20 20 20 20 28 66 6f 72 2d #f)).. (for-
14b30 65 61 63 68 20 0a 09 20 20 20 20 20 20 28 6c 61 each .. (la
14b40 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 3b 3b mbda (test)...;;
14b50 20 28 69 66 20 28 65 71 75 61 6c 3f 20 77 61 69 (if (equal? wai
14b60 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 20 28 64 62 tontest-name (db
14b70 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 :test-get-testna
14b80 6d 65 20 74 65 73 74 29 29 20 3b 3b 20 62 79 20 me test)) ;; by
14b90 64 65 66 69 6e 74 69 6f 6e 20 74 68 69 73 20 68 defintion this h
14ba0 61 64 20 62 65 74 74 65 72 20 62 65 20 74 72 75 ad better be tru
14bb0 65 20 2e 2e 2e 0a 09 09 28 6c 65 74 2a 20 28 28 e ......(let* ((
14bc0 73 74 61 74 65 20 20 20 20 20 20 20 20 20 20 20 state
14bd0 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
14be0 74 61 74 65 20 74 65 73 74 29 29 0a 09 09 20 20 tate test))...
14bf0 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
14c00 20 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 74 (db:test
14c10 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
14c20 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 74 65 ))... (ite
14c30 6d 2d 70 61 74 68 20 20 20 20 20 20 20 20 20 28 m-path (
14c40 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d db:test-get-item
14c50 2d 70 61 74 68 20 74 65 73 74 29 29 0a 09 09 20 -path test))...
14c60 20 20 20 20 20 20 28 69 73 2d 63 6f 6d 70 6c 65 (is-comple
14c70 74 65 64 20 20 20 20 20 20 28 65 71 75 61 6c 3f ted (equal?
14c80 20 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 state "COMPLETE
14c90 44 22 29 29 0a 09 09 20 20 20 20 20 20 20 28 69 D"))... (i
14ca0 73 2d 72 75 6e 6e 69 6e 67 20 20 20 20 20 20 20 s-running
14cb0 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 22 (equal? state "
14cc0 52 55 4e 4e 49 4e 47 22 29 29 0a 09 09 20 20 20 RUNNING"))...
14cd0 20 20 20 20 28 69 73 2d 6b 69 6c 6c 65 64 20 20 (is-killed
14ce0 20 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 (equal? s
14cf0 74 61 74 65 20 22 4b 49 4c 4c 45 44 22 29 29 0a tate "KILLED")).
14d00 09 09 20 20 20 20 20 20 20 28 69 73 2d 6f 6b 20 .. (is-ok
14d10 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 65 6d (mem
14d20 62 65 72 20 73 74 61 74 75 73 20 27 28 22 50 41 ber status '("PA
14d30 53 53 22 20 22 57 41 52 4e 22 20 22 43 48 45 43 SS" "WARN" "CHEC
14d40 4b 22 20 22 57 41 49 56 45 44 22 20 22 53 4b 49 K" "WAIVED" "SKI
14d50 50 22 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 P")))... (
14d60 73 61 6d 65 2d 69 74 65 6d 70 61 74 68 20 20 20 same-itempath
14d70 20 20 28 65 71 75 61 6c 3f 20 72 65 66 2d 69 74 (equal? ref-it
14d80 65 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 em-path item-pat
14d90 68 29 29 29 0a 09 09 20 20 28 73 65 74 21 20 65 h)))... (set! e
14da0 76 65 72 2d 73 65 65 6e 20 23 74 29 0a 09 09 20 ver-seen #t)...
14db0 20 28 63 6f 6e 64 0a 09 09 20 20 20 3b 3b 20 63 (cond... ;; c
14dc0 61 73 65 20 31 2c 20 6e 6f 6e 2d 69 74 65 6d 20 ase 1, non-item
14dd0 28 70 61 72 65 6e 74 20 74 65 73 74 29 20 69 73 (parent test) is
14de0 20 0a 09 09 20 20 20 28 28 61 6e 64 20 28 65 71 ... ((and (eq
14df0 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
14e00 22 29 20 3b 3b 20 74 68 69 73 20 69 73 20 74 68 ") ;; this is th
14e10 65 20 70 61 72 65 6e 74 20 74 65 73 74 0a 09 09 e parent test...
14e20 09 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 . is-completed..
14e30 09 09 20 28 6f 72 20 69 73 2d 6f 6b 20 28 6d 65 .. (or is-ok (me
14e40 6d 62 65 72 20 6d 6f 64 65 20 27 28 74 6f 70 6c mber mode '(topl
14e50 65 76 65 6c 20 69 74 65 6d 6d 61 74 63 68 20 69 evel itemmatch i
14e60 74 65 6d 77 61 69 74 29 29 29 29 0a 09 09 20 20 temwait))))...
14e70 20 20 28 73 65 74 21 20 70 61 72 65 6e 74 2d 77 (set! parent-w
14e80 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 0a 09 aiton-met #t))..
14e90 09 20 20 20 3b 3b 20 53 70 65 63 69 61 6c 20 63 . ;; Special c
14ea0 61 73 65 20 66 6f 72 20 74 6f 70 6c 65 76 65 6c ase for toplevel
14eb0 20 61 6e 64 20 4b 49 4c 4c 45 44 0a 09 09 20 20 and KILLED...
14ec0 20 28 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 69 ((and (equal? i
14ed0 74 65 6d 2d 70 61 74 68 20 22 22 29 20 3b 3b 20 tem-path "") ;;
14ee0 74 68 69 73 20 69 73 20 74 68 65 20 70 61 72 65 this is the pare
14ef0 6e 74 20 74 65 73 74 0a 09 09 09 20 69 73 2d 6b nt test.... is-k
14f00 69 6c 6c 65 64 0a 09 09 09 20 28 65 71 3f 20 6d illed.... (eq? m
14f10 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 29 0a ode 'toplevel)).
14f20 09 09 20 20 20 20 28 73 65 74 21 20 70 61 72 65 .. (set! pare
14f30 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 23 74 nt-waiton-met #t
14f40 29 29 0a 09 09 20 20 20 3b 3b 20 46 6f 72 20 69 ))... ;; For i
14f50 74 65 6d 77 61 69 74 20 6d 6f 64 65 20 49 46 46 temwait mode IFF
14f60 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 6d 61 the previous ma
14f70 74 63 68 69 6e 67 20 69 74 65 6d 20 69 73 20 67 tching item is g
14f80 6f 6f 64 20 74 68 65 20 73 65 74 20 70 61 72 65 ood the set pare
14f90 6e 74 2d 77 61 69 74 6f 6e 2d 6d 65 74 0a 09 09 nt-waiton-met...
14fa0 20 20 20 28 28 61 6e 64 20 28 6d 65 6d 62 65 72 ((and (member
14fb0 20 6d 6f 64 65 20 27 28 69 74 65 6d 6d 61 74 63 mode '(itemmatc
14fc0 68 20 69 74 65 6d 77 61 69 74 29 29 0a 09 09 09 h itemwait))....
14fd0 20 3b 3b 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f ;; (not (equal?
14fe0 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 20 item-path ""))
14ff0 3b 3b 20 74 68 69 73 20 61 70 70 6c 69 65 73 20 ;; this applies
15000 74 6f 20 62 6f 74 68 20 74 6f 70 20 6c 65 76 65 to both top leve
15010 6c 20 28 74 6f 20 61 6c 6c 6f 77 20 6c 61 75 6e l (to allow laun
15020 63 68 69 6e 67 20 6f 66 20 6e 65 78 74 20 62 61 ching of next ba
15030 74 63 68 29 20 61 6e 64 20 69 74 65 6d 73 0a 09 tch) and items..
15040 09 09 20 73 61 6d 65 2d 69 74 65 6d 70 61 74 68 .. same-itempath
15050 29 0a 09 09 20 20 20 20 28 69 66 20 28 61 6e 64 )... (if (and
15060 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 20 69 73 is-completed is
15070 2d 6f 6b 29 0a 09 09 09 28 73 65 74 21 20 69 74 -ok)....(set! it
15080 65 6d 2d 77 61 69 74 6f 6e 2d 6d 65 74 20 23 74 em-waiton-met #t
15090 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 61 6e ))... (if (an
150a0 64 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 d (equal? item-p
150b0 61 74 68 20 22 22 29 0a 09 09 09 20 20 20 20 20 ath "")....
150c0 28 6f 72 20 69 73 2d 63 6f 6d 70 6c 65 74 65 64 (or is-completed
150d0 20 69 73 2d 72 75 6e 6e 69 6e 67 29 29 3b 3b 20 is-running));;
150e0 74 68 69 73 20 69 73 20 74 68 65 20 70 61 72 65 this is the pare
150f0 6e 74 2c 20 73 65 74 20 69 74 20 74 6f 20 72 75 nt, set it to ru
15100 6e 20 69 66 20 63 6f 6d 70 6c 65 74 65 64 20 6f n if completed o
15110 72 20 72 75 6e 6e 69 6e 67 0a 09 09 09 28 73 65 r running....(se
15120 74 21 20 70 61 72 65 6e 74 2d 77 61 69 74 6f 6e t! parent-waiton
15130 2d 6d 65 74 20 23 74 29 29 29 0a 09 09 20 20 20 -met #t)))...
15140 3b 3b 20 6e 6f 72 6d 61 6c 20 63 68 65 63 6b 69 ;; normal checki
15150 6e 67 20 6f 66 20 70 61 72 65 6e 74 20 69 74 65 ng of parent ite
15160 6d 73 2c 20 61 6e 79 20 70 61 72 65 6e 74 20 6f ms, any parent o
15170 72 20 70 61 72 65 6e 74 20 69 74 65 6d 20 6e 6f r parent item no
15180 74 20 6f 6b 20 62 6c 6f 63 6b 73 20 72 75 6e 6e t ok blocks runn
15190 69 6e 67 0a 09 09 20 20 20 28 28 61 6e 64 20 69 ing... ((and i
151a0 73 2d 63 6f 6d 70 6c 65 74 65 64 0a 09 09 09 20 s-completed....
151b0 28 6f 72 20 69 73 2d 6f 6b 20 0a 09 09 09 20 20 (or is-ok ....
151c0 20 20 20 28 65 71 3f 20 6d 6f 64 65 20 27 74 6f (eq? mode 'to
151d0 70 6c 65 76 65 6c 29 29 20 20 20 20 20 20 20 20 plevel))
151e0 20 20 20 20 20 20 3b 3b 20 74 6f 70 6c 65 76 65 ;; topleve
151f0 6c 20 64 6f 65 73 20 6e 6f 74 20 62 6c 6f 63 6b l does not block
15200 20 6f 6e 20 46 41 49 4c 0a 09 09 09 20 28 61 6e on FAIL.... (an
15210 64 20 69 73 2d 6f 6b 20 28 65 71 3f 20 6d 6f 64 d is-ok (eq? mod
15220 65 20 27 69 74 65 6d 6d 61 74 63 68 29 29 29 20 e 'itemmatch)))
15230 3b 3b 20 69 74 65 6d 6d 61 74 63 68 20 62 6c 6f ;; itemmatch blo
15240 63 6b 73 20 6f 6e 20 6e 6f 74 20 6f 6b 0a 09 09 cks on not ok...
15250 20 20 20 20 28 73 65 74 21 20 69 74 65 6d 2d 77 (set! item-w
15260 61 69 74 6f 6e 2d 6d 65 74 20 23 74 29 29 29 29 aiton-met #t))))
15270 29 0a 09 20 20 20 20 20 20 74 65 73 74 73 29 0a ).. tests).
15280 09 20 20 20 20 20 3b 3b 20 62 6f 74 68 20 72 65 . ;; both re
15290 71 75 69 72 65 6d 65 6e 74 73 2c 20 70 61 72 65 quirements, pare
152a0 6e 74 20 61 6e 64 20 69 74 65 6d 2d 77 61 69 74 nt and item-wait
152b0 6f 6e 20 6d 75 73 74 20 62 65 20 6d 65 74 20 74 on must be met t
152c0 6f 20 4e 4f 54 20 61 64 64 20 69 74 65 6d 20 74 o NOT add item t
152d0 6f 0a 09 20 20 20 20 20 3b 3b 20 70 72 65 72 65 o.. ;; prere
152e0 71 27 73 20 6e 6f 74 20 6d 65 74 20 6c 69 73 74 q's not met list
152f0 0a 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 .. (if (not
15300 28 6f 72 20 70 61 72 65 6e 74 2d 77 61 69 74 6f (or parent-waito
15310 6e 2d 6d 65 74 20 69 74 65 6d 2d 77 61 69 74 6f n-met item-waito
15320 6e 2d 6d 65 74 29 29 0a 09 09 20 28 73 65 74 21 n-met))... (set!
15330 20 72 65 73 75 6c 74 20 28 61 70 70 65 6e 64 20 result (append
15340 28 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 (if (null? tests
15350 29 20 28 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 ) (list waitonte
15360 73 74 2d 6e 61 6d 65 29 20 74 65 73 74 73 29 20 st-name) tests)
15370 72 65 73 75 6c 74 29 29 29 0a 09 20 20 20 20 20 result)))..
15380 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 69 ;; if the test i
15390 73 20 6e 6f 74 20 66 6f 75 6e 64 20 74 68 65 6e s not found then
153a0 20 63 6c 65 61 72 6c 79 20 74 68 65 20 77 61 69 clearly the wai
153b0 74 6f 6e 20 69 73 20 6e 6f 74 20 6d 65 74 2e 2e ton is not met..
153c0 2e 0a 09 20 20 20 20 20 3b 3b 20 28 69 66 20 28 ... ;; (if (
153d0 6e 6f 74 20 65 76 65 72 2d 73 65 65 6e 29 28 73 not ever-seen)(s
153e0 65 74 21 20 72 65 73 75 6c 74 20 28 63 6f 6e 73 et! result (cons
153f0 20 77 61 69 74 6f 6e 74 65 73 74 2d 6e 61 6d 65 waitontest-name
15400 20 72 65 73 75 6c 74 29 29 29 29 29 0a 09 20 20 result)))))..
15410 20 20 20 28 69 66 20 28 6e 6f 74 20 65 76 65 72 (if (not ever
15420 2d 73 65 65 6e 29 0a 09 09 20 28 73 65 74 21 20 -seen)... (set!
15430 72 65 73 75 6c 74 20 28 61 70 70 65 6e 64 20 28 result (append (
15440 69 66 20 28 6e 75 6c 6c 3f 20 74 65 73 74 73 29 if (null? tests)
15450 28 6c 69 73 74 20 77 61 69 74 6f 6e 74 65 73 74 (list waitontest
15460 2d 6e 61 6d 65 29 20 74 65 73 74 73 29 20 72 65 -name) tests) re
15470 73 75 6c 74 29 29 29 29 29 0a 09 20 77 61 69 74 sult))))).. wait
15480 6f 6e 73 29 0a 09 28 64 65 6c 65 74 65 2d 64 75 ons)..(delete-du
15490 70 6c 69 63 61 74 65 73 20 72 65 73 75 6c 74 29 plicates result)
154a0 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
154b0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
154c0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
154d0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
154e0 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
154f0 20 45 78 74 72 61 63 74 20 6f 64 73 20 66 69 6c Extract ods fil
15500 65 20 66 72 6f 6d 20 74 68 65 20 64 62 0a 3b 3b e from the db.;;
15510 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15520 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15530 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15540 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
15550 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 20 52 ======..;; NOT R
15560 45 57 52 49 54 54 45 4e 20 59 45 54 21 21 21 21 EWRITTEN YET!!!!
15570 21 0a 0a 3b 3b 20 72 75 6e 73 70 61 74 74 20 69 !..;; runspatt i
15580 73 20 61 20 63 6f 6d 6d 61 20 64 65 6c 69 6d 69 s a comma delimi
15590 74 65 64 20 6c 69 73 74 20 6f 66 20 72 75 6e 20 ted list of run
155a0 70 61 74 74 65 72 6e 73 0a 3b 3b 20 6b 65 79 70 patterns.;; keyp
155b0 61 74 74 2d 61 6c 69 73 74 20 6d 75 73 74 20 63 att-alist must c
155c0 6f 6e 74 61 69 6e 20 2a 61 6c 6c 2a 20 6b 65 79 ontain *all* key
155d0 73 20 77 69 74 68 20 61 6e 20 61 73 73 6f 63 69 s with an associ
155e0 61 74 65 64 20 70 61 74 74 65 72 6e 3a 20 27 28 ated pattern: '(
155f0 20 28 22 4b 45 59 31 22 20 22 25 22 29 20 2e 2e ("KEY1" "%") ..
15600 20 29 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 65 ).(define (db:e
15610 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 xtract-ods-file
15620 64 62 73 74 72 75 63 74 20 6f 75 74 70 75 74 66 dbstruct outputf
15630 69 6c 65 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 ile keypatt-alis
15640 74 20 72 75 6e 73 70 61 74 74 20 70 61 74 68 6d t runspatt pathm
15650 6f 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 od). (let* ((ke
15660 79 73 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 ysstr (string-i
15670 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
15680 63 61 72 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 car keypatt-alis
15690 74 29 20 22 2c 22 29 29 0a 09 20 28 6b 65 79 71 t) ",")).. (keyq
156a0 72 79 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 ry (string-int
156b0 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
156c0 61 6d 62 64 61 20 28 70 29 28 63 6f 6e 63 20 28 ambda (p)(conc (
156d0 63 61 72 20 70 29 20 22 20 4c 49 4b 45 20 3f 20 car p) " LIKE ?
156e0 22 29 29 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 ")) keypatt-alis
156f0 74 29 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 t) " AND ")).. (
15700 6e 75 6d 6b 65 79 73 20 20 28 6c 65 6e 67 74 68 numkeys (length
15710 20 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 29 keypatt-alist))
15720 0a 09 20 28 74 65 73 74 2d 69 64 73 20 27 28 29 .. (test-ids '()
15730 29 0a 09 20 28 77 69 6e 64 6f 77 73 20 20 28 61 ).. (windows (a
15740 6e 64 20 70 61 74 68 6d 6f 64 20 28 73 75 62 73 nd pathmod (subs
15750 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 5c 5c 22 tring-index "\\"
15760 20 70 61 74 68 6d 6f 64 29 29 29 0a 09 20 28 74 pathmod))).. (t
15770 65 6d 70 64 69 72 20 20 28 63 6f 6e 63 20 22 2f empdir (conc "/
15780 74 6d 70 2f 22 20 28 63 75 72 72 65 6e 74 2d 75 tmp/" (current-u
15790 73 65 72 2d 6e 61 6d 65 29 20 22 2f 22 20 72 75 ser-name) "/" ru
157a0 6e 73 70 61 74 74 20 22 5f 22 20 28 72 61 6e 64 nspatt "_" (rand
157b0 6f 6d 20 31 30 30 30 30 29 20 22 5f 22 20 28 63 om 10000) "_" (c
157c0 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
157d0 64 29 29 29 0a 09 20 28 72 75 6e 73 68 65 61 64 d))).. (runshead
157e0 65 72 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 er (append (list
157f0 20 22 52 75 6e 20 49 64 22 20 22 52 75 6e 6e 61 "Run Id" "Runna
15800 6d 65 22 29 20 3b 20 30 20 31 0a 09 09 09 20 20 me") ; 0 1....
15810 20 20 20 28 6d 61 70 20 63 61 72 20 6b 65 79 70 (map car keyp
15820 61 74 74 2d 61 6c 69 73 74 29 20 20 20 3b 20 2b att-alist) ; +
15830 20 4e 20 3d 20 6c 65 6e 67 74 68 20 6b 65 79 70 N = length keyp
15840 61 74 74 2d 61 6c 69 73 74 0a 09 09 09 20 20 20 att-alist....
15850 20 20 28 6c 69 73 74 20 22 54 65 73 74 6e 61 6d (list "Testnam
15860 65 22 20 20 20 20 20 20 20 20 20 20 3b 20 32 0a e" ; 2.
15870 09 09 09 09 20 20 20 22 49 74 65 6d 20 50 61 74 .... "Item Pat
15880 68 22 20 20 20 20 20 20 20 20 20 3b 20 33 20 0a h" ; 3 .
15890 09 09 09 09 20 20 20 22 44 65 73 63 72 69 70 74 .... "Descript
158a0 69 6f 6e 22 20 20 20 20 20 20 20 3b 20 34 20 0a ion" ; 4 .
158b0 09 09 09 09 20 20 20 22 53 74 61 74 65 22 20 20 .... "State"
158c0 20 20 20 20 20 20 20 20 20 20 20 3b 20 35 20 0a ; 5 .
158d0 09 09 09 09 20 20 20 22 53 74 61 74 75 73 22 20 .... "Status"
158e0 20 20 20 20 20 20 20 20 20 20 20 3b 20 36 20 20 ; 6
158f0 0a 09 09 09 09 20 20 20 22 46 69 6e 61 6c 20 4c ..... "Final L
15900 6f 67 22 20 20 20 20 20 20 20 20 20 3b 20 37 20 og" ; 7
15910 0a 09 09 09 09 20 20 20 22 52 75 6e 20 44 75 72 ..... "Run Dur
15920 61 74 69 6f 6e 22 20 20 20 20 20 20 3b 20 38 20 ation" ; 8
15930 0a 09 09 09 09 20 20 20 22 57 68 65 6e 20 52 75 ..... "When Ru
15940 6e 22 20 20 20 20 20 20 20 20 20 20 3b 20 39 20 n" ; 9
15950 0a 09 09 09 09 20 20 20 22 54 61 67 73 22 20 20 ..... "Tags"
15960 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 30 ; 10
15970 0a 09 09 09 09 20 20 20 22 52 75 6e 20 4f 77 6e ..... "Run Own
15980 65 72 22 20 20 20 20 20 20 20 20 20 3b 20 31 31 er" ; 11
15990 0a 09 09 09 09 20 20 20 22 43 6f 6d 6d 65 6e 74 ..... "Comment
159a0 22 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 32 " ; 12
159b0 0a 09 09 09 09 20 20 20 22 41 75 74 68 6f 72 22 ..... "Author"
159c0 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 33 ; 13
159d0 0a 09 09 09 09 20 20 20 22 54 65 73 74 20 4f 77 ..... "Test Ow
159e0 6e 65 72 22 20 20 20 20 20 20 20 20 3b 20 31 34 ner" ; 14
159f0 0a 09 09 09 09 20 20 20 22 52 65 76 69 65 77 65 ..... "Reviewe
15a00 64 22 20 20 20 20 20 20 20 20 20 20 3b 20 31 35 d" ; 15
15a10 0a 09 09 09 09 20 20 20 22 44 69 73 6b 66 72 65 ..... "Diskfre
15a20 65 22 20 20 20 20 20 20 20 20 20 20 3b 20 31 36 e" ; 16
15a30 0a 09 09 09 09 20 20 20 22 55 6e 61 6d 65 22 20 ..... "Uname"
15a40 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 37 ; 17
15a50 0a 09 09 09 09 20 20 20 22 52 75 6e 64 69 72 22 ..... "Rundir"
15a60 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 38 ; 18
15a70 0a 09 09 09 09 20 20 20 22 48 6f 73 74 22 20 20 ..... "Host"
15a80 20 20 20 20 20 20 20 20 20 20 20 20 3b 20 31 39 ; 19
15a90 0a 09 09 09 09 20 20 20 22 43 70 75 20 4c 6f 61 ..... "Cpu Loa
15aa0 64 22 20 20 20 20 20 20 20 20 20 20 3b 20 32 30 d" ; 20
15ab0 0a 09 09 09 09 20 20 20 29 29 29 0a 09 20 28 72 ..... ))).. (r
15ac0 65 73 75 6c 74 73 20 28 6c 69 73 74 20 72 75 6e esults (list run
15ad0 73 68 65 61 64 65 72 29 29 09 09 09 20 0a 09 20 sheader))... ..
15ae0 28 74 65 73 74 64 61 74 61 2d 68 65 61 64 65 72 (testdata-header
15af0 20 28 6c 69 73 74 20 22 52 75 6e 20 49 64 22 20 (list "Run Id"
15b00 22 54 65 73 74 6e 61 6d 65 22 20 22 49 74 65 6d "Testname" "Item
15b10 20 50 61 74 68 22 20 22 43 61 74 65 67 6f 72 79 Path" "Category
15b20 22 20 22 56 61 72 69 61 62 6c 65 22 20 22 56 61 " "Variable" "Va
15b30 6c 75 65 22 20 22 45 78 70 65 63 74 65 64 22 20 lue" "Expected"
15b40 22 54 6f 6c 22 20 22 55 6e 69 74 73 22 20 22 53 "Tol" "Units" "S
15b50 74 61 74 75 73 22 20 22 43 6f 6d 6d 65 6e 74 22 tatus" "Comment"
15b60 29 29 0a 09 20 28 6d 61 69 6e 71 72 79 20 28 63 )).. (mainqry (c
15b70 6f 6e 63 20 22 53 45 4c 45 43 54 0a 20 20 20 20 onc "SELECT.
15b80 20 20 20 20 20 20 20 20 20 20 74 2e 74 65 73 74 t.test
15b90 6e 61 6d 65 2c 72 2e 69 64 2c 72 75 6e 6e 61 6d name,r.id,runnam
15ba0 65 2c 22 20 6b 65 79 73 73 74 72 20 22 2c 74 2e e," keysstr ",t.
15bb0 74 65 73 74 6e 61 6d 65 2c 0a 20 20 20 20 20 20 testname,.
15bc0 20 20 20 20 20 20 20 20 74 2e 69 74 65 6d 5f 70 t.item_p
15bd0 61 74 68 2c 74 6d 2e 64 65 73 63 72 69 70 74 69 ath,tm.descripti
15be0 6f 6e 2c 74 2e 73 74 61 74 65 2c 74 2e 73 74 61 on,t.state,t.sta
15bf0 74 75 73 2c 0a 20 20 20 20 20 20 20 20 20 20 20 tus,.
15c00 20 20 20 66 69 6e 61 6c 5f 6c 6f 67 66 2c 72 75 final_logf,ru
15c10 6e 5f 64 75 72 61 74 69 6f 6e 2c 20 0a 20 20 20 n_duration, .
15c20 20 20 20 20 20 20 20 20 20 20 20 73 74 72 66 74 strft
15c30 69 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 25 48 ime('%m/%d/%Y %H
15c40 3a 25 4d 3a 25 53 27 2c 64 61 74 65 74 69 6d 65 :%M:%S',datetime
15c50 28 74 2e 65 76 65 6e 74 5f 74 69 6d 65 2c 27 75 (t.event_time,'u
15c60 6e 69 78 65 70 6f 63 68 27 29 2c 27 6c 6f 63 61 nixepoch'),'loca
15c70 6c 74 69 6d 65 27 29 2c 0a 20 20 20 20 20 20 20 ltime'),.
15c80 20 20 20 20 20 20 20 74 6d 2e 74 61 67 73 2c 72 tm.tags,r
15c90 2e 6f 77 6e 65 72 2c 74 2e 63 6f 6d 6d 65 6e 74 .owner,t.comment
15ca0 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
15cb0 61 75 74 68 6f 72 2c 0a 20 20 20 20 20 20 20 20 author,.
15cc0 20 20 20 20 20 20 74 6d 2e 6f 77 6e 65 72 2c 72 tm.owner,r
15cd0 65 76 69 65 77 65 64 2c 0a 20 20 20 20 20 20 20 eviewed,.
15ce0 20 20 20 20 20 20 20 64 69 73 6b 66 72 65 65 2c diskfree,
15cf0 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 0a 20 20 uname,rundir,.
15d00 20 20 20 20 20 20 20 20 20 20 20 20 68 6f 73 74 host
15d10 2c 63 70 75 6c 6f 61 64 0a 20 20 20 20 20 20 20 ,cpuload.
15d20 20 20 20 20 20 46 52 4f 4d 20 74 65 73 74 73 20 FROM tests
15d30 41 53 20 74 20 4a 4f 49 4e 20 72 75 6e 73 20 41 AS t JOIN runs A
15d40 53 20 72 20 4f 4e 20 74 2e 72 75 6e 5f 69 64 3d S r ON t.run_id=
15d50 72 2e 69 64 20 4a 4f 49 4e 20 74 65 73 74 5f 6d r.id JOIN test_m
15d60 65 74 61 20 41 53 20 74 6d 20 4f 4e 20 74 6d 2e eta AS tm ON tm.
15d70 74 65 73 74 6e 61 6d 65 3d 74 2e 74 65 73 74 6e testname=t.testn
15d80 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ame.
15d90 57 48 45 52 45 20 72 75 6e 6e 61 6d 65 20 4c 49 WHERE runname LI
15da0 4b 45 20 3f 20 41 4e 44 20 22 20 6b 65 79 71 72 KE ? AND " keyqr
15db0 79 20 22 3b 22 29 29 29 0a 20 20 20 20 28 64 65 y ";"))). (de
15dc0 62 75 67 3a 70 72 69 6e 74 20 32 20 22 55 73 69 bug:print 2 "Usi
15dd0 6e 67 20 22 20 74 65 6d 70 64 69 72 20 22 20 66 ng " tempdir " f
15de0 6f 72 20 63 6f 6e 73 74 72 75 63 74 69 6e 67 20 or constructing
15df0 74 68 65 20 6f 64 73 20 66 69 6c 65 2e 20 6b 65 the ods file. ke
15e00 79 71 72 79 3a 20 22 20 6b 65 79 71 72 79 20 22 yqry: " keyqry "
15e10 20 6b 65 79 73 74 72 3a 20 22 20 6b 65 79 73 73 keystr: " keyss
15e20 74 72 20 22 20 77 69 74 68 20 6b 65 79 73 3a 20 tr " with keys:
15e30 22 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 70 " (map cadr keyp
15e40 61 74 74 2d 61 6c 69 73 74 29 0a 09 09 20 22 5c att-alist)... "\
15e50 6e 20 20 20 20 20 20 6d 61 69 6e 71 72 79 3a 20 n mainqry:
15e60 22 20 6d 61 69 6e 71 72 79 29 0a 20 20 20 20 3b " mainqry). ;
15e70 3b 20 22 45 78 70 65 63 74 65 64 20 56 61 6c 75 ; "Expected Valu
15e80 65 22 0a 20 20 20 20 3b 3b 20 22 56 61 6c 75 65 e". ;; "Value
15e90 20 46 6f 75 6e 64 22 0a 20 20 20 20 3b 3b 20 22 Found". ;; "
15ea0 54 6f 6c 65 72 61 6e 63 65 22 0a 20 20 20 20 28 Tolerance". (
15eb0 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f apply sqlite3:fo
15ec0 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 20 28 r-each-row.. (
15ed0 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 20 lambda (test-id
15ee0 2e 20 62 29 0a 09 20 20 20 20 20 28 73 65 74 21 . b).. (set!
15ef0 20 74 65 73 74 2d 69 64 73 20 28 63 6f 6e 73 20 test-ids (cons
15f00 74 65 73 74 2d 69 64 20 74 65 73 74 2d 69 64 73 test-id test-ids
15f10 29 29 20 20 20 3b 3b 20 74 65 73 74 2d 69 64 20 )) ;; test-id
15f20 69 73 20 6e 6f 77 20 74 65 73 74 6e 61 6d 65 0a is now testname.
15f30 09 20 20 20 20 20 28 73 65 74 21 20 72 65 73 75 . (set! resu
15f40 6c 74 73 20 28 61 70 70 65 6e 64 20 72 65 73 75 lts (append resu
15f50 6c 74 73 20 3b 3b 20 6e 6f 74 65 2c 20 64 72 6f lts ;; note, dro
15f60 70 20 74 68 65 20 74 65 73 74 2d 69 64 0a 09 09 p the test-id...
15f70 09 09 20 20 20 28 6c 69 73 74 0a 09 09 09 09 20 .. (list.....
15f80 20 20 20 28 69 66 20 70 61 74 68 6d 6f 64 0a 09 (if pathmod..
15f90 09 09 09 09 28 6c 65 74 2a 20 28 28 76 62 20 20 ....(let* ((vb
15fa0 20 20 20 20 20 20 28 61 70 70 6c 79 20 76 65 63 (apply vec
15fb0 74 6f 72 20 62 29 29 0a 09 09 09 09 09 20 20 20 tor b))......
15fc0 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 20 28 (keyvals (
15fd0 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 20 20 20 let loop ((i
15fe0 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 0).........
15ff0 28 72 65 73 20 27 28 29 29 29 0a 09 09 09 09 09 (res '()))......
16000 09 09 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 .. (if (>= i
16010 6e 75 6d 6b 65 79 73 29 0a 09 09 09 09 09 09 09 numkeys)........
16020 09 72 65 73 0a 09 09 09 09 09 09 09 09 28 6c 6f .res.........(lo
16030 6f 70 20 28 2b 20 69 20 31 29 0a 09 09 09 09 09 op (+ i 1)......
16040 09 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 ... (append
16050 20 72 65 73 20 28 6c 69 73 74 20 28 76 65 63 74 res (list (vect
16060 6f 72 2d 72 65 66 20 76 62 20 28 2b 20 69 20 32 or-ref vb (+ i 2
16070 29 29 29 29 29 29 29 29 0a 09 09 09 09 09 20 20 ))))))))......
16080 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 (runname
16090 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 31 (vector-ref vb 1
160a0 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
160b0 74 65 73 74 6e 61 6d 65 20 20 28 76 65 63 74 6f testname (vecto
160c0 72 2d 72 65 66 20 76 62 20 28 2b 20 20 32 20 6e r-ref vb (+ 2 n
160d0 75 6d 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 umkeys)))......
160e0 20 20 20 20 20 20 28 69 74 65 6d 2d 70 61 74 68 (item-path
160f0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 (vector-ref vb
16100 28 2b 20 20 33 20 6e 75 6d 6b 65 79 73 29 29 29 (+ 3 numkeys)))
16110 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 66 69 ...... (fi
16120 6e 61 6c 2d 6c 6f 67 20 28 76 65 63 74 6f 72 2d nal-log (vector-
16130 72 65 66 20 76 62 20 28 2b 20 20 37 20 6e 75 6d ref vb (+ 7 num
16140 6b 65 79 73 29 29 29 0a 09 09 09 09 09 20 20 20 keys)))......
16150 20 20 20 20 28 72 75 6e 2d 64 69 72 20 20 20 28 (run-dir (
16160 76 65 63 74 6f 72 2d 72 65 66 20 76 62 20 28 2b vector-ref vb (+
16170 20 31 38 20 6e 75 6d 6b 65 79 73 29 29 29 0a 09 18 numkeys)))..
16180 09 09 09 09 20 20 20 20 20 20 20 28 6c 6f 67 2d .... (log-
16190 66 70 61 74 68 20 28 63 6f 6e 63 20 72 75 6e 2d fpath (conc run-
161a0 64 69 72 20 22 2f 22 20 20 66 69 6e 61 6c 2d 6c dir "/" final-l
161b0 6f 67 29 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 og))) ;; (string
161c0 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
161d0 76 61 6c 73 20 22 2f 22 29 20 22 2f 22 20 74 65 vals "/") "/" te
161e0 73 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d stname "/" item-
161f0 70 61 74 68 20 22 2f 22 0a 09 09 09 09 09 20 20 path "/"......
16200 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
16210 6c 6f 67 3a 20 22 20 6c 6f 67 2d 66 70 61 74 68 log: " log-fpath
16220 20 22 20 65 78 69 73 74 73 3a 20 22 20 28 66 69 " exists: " (fi
16230 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f 67 2d 66 le-exists? log-f
16240 70 61 74 68 29 29 0a 09 09 09 09 09 20 20 28 76 path))...... (v
16250 65 63 74 6f 72 2d 73 65 74 21 20 76 62 20 28 2b ector-set! vb (+
16260 20 37 20 6e 75 6d 6b 65 79 73 29 20 28 69 66 20 7 numkeys) (if
16270 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6f (file-exists? lo
16280 67 2d 66 70 61 74 68 29 0a 09 09 09 09 09 09 09 g-fpath)........
16290 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 .. (let ((new
162a0 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 6d path (conc pathm
162b0 6f 64 20 22 2f 22 0a 09 09 09 09 09 09 09 09 09 od "/"..........
162c0 09 09 09 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 ... (string-inte
162d0 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c 73 20 rsperse keyvals
162e0 22 2f 22 29 0a 09 09 09 09 09 09 09 09 09 09 09 "/")............
162f0 09 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f . "/" runname "/
16300 22 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 0a 09 " testname "/"..
16310 09 09 09 09 09 09 09 09 09 09 09 20 28 69 66 20 ........... (if
16320 28 73 74 72 69 6e 67 3d 3f 20 69 74 65 6d 2d 70 (string=? item-p
16330 61 74 68 20 22 22 29 20 22 22 20 28 63 6f 6e 63 ath "") "" (conc
16340 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 "/" item-path))
16350 0a 09 09 09 09 09 09 09 09 09 09 09 09 20 66 69 ............. fi
16360 6e 61 6c 2d 6c 6f 67 29 29 29 0a 09 09 09 09 09 nal-log)))......
16370 09 09 09 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 .... ;; for
16380 20 6e 6f 77 20 74 68 72 6f 77 20 61 77 61 79 20 now throw away
16390 6e 65 77 70 61 74 68 20 61 6e 64 20 75 73 65 20 newpath and use
163a0 74 68 65 20 6c 6f 67 2d 66 70 61 74 68 20 63 6f the log-fpath co
163b0 6e 63 27 64 20 77 69 74 68 20 70 61 74 68 6d 6f nc'd with pathmo
163c0 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 d..........
163d0 20 28 73 65 74 21 20 6e 65 77 70 61 74 68 20 28 (set! newpath (
163e0 63 6f 6e 63 20 70 61 74 68 6d 6f 64 20 6c 6f 67 conc pathmod log
163f0 2d 66 70 61 74 68 29 29 0a 09 09 09 09 09 09 09 -fpath))........
16400 09 09 20 20 20 20 20 20 28 69 66 20 77 69 6e 64 .. (if wind
16410 6f 77 73 20 28 73 74 72 69 6e 67 2d 74 72 61 6e ows (string-tran
16420 73 6c 61 74 65 20 6e 65 77 70 61 74 68 20 22 2f slate newpath "/
16430 22 20 22 5c 5c 22 29 20 6e 65 77 70 61 74 68 29 " "\\") newpath)
16440 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 28 ).......... (
16450 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d if (debug:debug-
16460 6d 6f 64 65 20 31 29 0a 09 09 09 09 09 09 09 09 mode 1).........
16470 09 09 28 63 6f 6e 63 20 66 69 6e 61 6c 2d 6c 6f ..(conc final-lo
16480 67 20 22 20 6e 6f 74 2d 66 6f 75 6e 64 22 29 0a g " not-found").
16490 09 09 09 09 09 09 09 09 09 09 22 22 29 29 29 0a ..........""))).
164a0 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 3e ..... (vector->
164b0 6c 69 73 74 20 76 62 29 29 0a 09 09 09 09 09 62 list vb))......b
164c0 29 29 29 29 29 0a 09 20 20 20 64 62 0a 09 20 20 ))))).. db..
164d0 20 6d 61 69 6e 71 72 79 0a 09 20 20 20 72 75 6e mainqry.. run
164e0 73 70 61 74 74 20 28 6d 61 70 20 63 61 64 72 20 spatt (map cadr
164f0 6b 65 79 70 61 74 74 2d 61 6c 69 73 74 29 29 0a keypatt-alist)).
16500 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
16510 20 32 20 22 46 6f 75 6e 64 20 22 20 28 6c 65 6e 2 "Found " (len
16520 67 74 68 20 74 65 73 74 2d 69 64 73 29 20 22 20 gth test-ids) "
16530 72 65 63 6f 72 64 73 22 29 0a 20 20 20 20 28 73 records"). (s
16540 65 74 21 20 72 65 73 75 6c 74 73 20 28 6c 69 73 et! results (lis
16550 74 20 28 63 6f 6e 73 20 22 52 75 6e 73 22 20 72 t (cons "Runs" r
16560 65 73 75 6c 74 73 29 29 29 0a 20 20 20 20 3b 3b esults))). ;;
16570 20 6e 6f 77 2c 20 66 6f 72 20 65 61 63 68 20 74 now, for each t
16580 65 73 74 2c 20 63 6f 6c 6c 65 63 74 20 74 68 65 est, collect the
16590 20 74 65 73 74 5f 64 61 74 61 20 69 6e 66 6f 20 test_data info
165a0 61 6e 64 20 61 64 64 20 61 20 6e 65 77 20 73 68 and add a new sh
165b0 65 65 74 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 eet. (for-eac
165c0 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
165d0 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20 20 20 test-id).
165e0 28 6c 65 74 20 28 28 74 65 73 74 2d 64 61 74 61 (let ((test-data
165f0 20 28 6c 69 73 74 20 74 65 73 74 64 61 74 61 2d (list testdata-
16600 68 65 61 64 65 72 29 29 0a 09 20 20 20 20 20 28 header)).. (
16610 63 75 72 72 2d 74 65 73 74 2d 6e 61 6d 65 20 23 curr-test-name #
16620 66 29 29 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 f)).. (sqlite3:f
16630 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 28 or-each-row.. (
16640 6c 61 6d 62 64 61 20 28 72 75 6e 2d 69 64 20 74 lambda (run-id t
16650 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
16660 68 20 63 61 74 65 67 6f 72 79 20 76 61 72 69 61 h category varia
16670 62 6c 65 20 76 61 6c 75 65 20 65 78 70 65 63 74 ble value expect
16680 65 64 20 74 6f 6c 20 75 6e 69 74 73 20 73 74 61 ed tol units sta
16690 74 75 73 20 63 6f 6d 6d 65 6e 74 29 0a 09 20 20 tus comment)..
166a0 20 20 28 73 65 74 21 20 63 75 72 72 2d 74 65 73 (set! curr-tes
166b0 74 2d 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 29 t-name testname)
166c0 0a 09 20 20 20 20 28 73 65 74 21 20 74 65 73 74 .. (set! test
166d0 2d 64 61 74 61 20 28 61 70 70 65 6e 64 20 74 65 -data (append te
166e0 73 74 2d 64 61 74 61 20 28 6c 69 73 74 20 28 6c st-data (list (l
166f0 69 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 6e ist run-id testn
16700 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 63 61 ame item-path ca
16710 74 65 67 6f 72 79 20 76 61 72 69 61 62 6c 65 20 tegory variable
16720 76 61 6c 75 65 20 65 78 70 65 63 74 65 64 20 74 value expected t
16730 6f 6c 20 75 6e 69 74 73 20 73 74 61 74 75 73 20 ol units status
16740 63 6f 6d 6d 65 6e 74 29 29 29 29 29 0a 09 20 20 comment)))))..
16750 64 62 20 0a 09 20 20 3b 3b 20 22 53 45 4c 45 43 db .. ;; "SELEC
16760 54 20 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 6d T run_id,testnam
16770 65 2c 69 74 65 6d 5f 70 61 74 68 2c 63 61 74 65 e,item_path,cate
16780 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 74 64 gory,variable,td
16790 2e 76 61 6c 75 65 20 41 53 20 76 61 6c 75 65 2c .value AS value,
167a0 65 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 expected,tol,uni
167b0 74 73 2c 74 64 2e 73 74 61 74 75 73 20 41 53 20 ts,td.status AS
167c0 73 74 61 74 75 73 2c 74 64 2e 63 6f 6d 6d 65 6e status,td.commen
167d0 74 20 41 53 20 63 6f 6d 6d 65 6e 74 20 46 52 4f t AS comment FRO
167e0 4d 20 74 65 73 74 5f 64 61 74 61 20 41 53 20 74 M test_data AS t
167f0 64 20 49 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 d INNER JOIN tes
16800 74 73 20 4f 4e 20 74 65 73 74 73 2e 69 64 3d 74 ts ON tests.id=t
16810 64 2e 74 65 73 74 5f 69 64 20 57 48 45 52 45 20 d.test_id WHERE
16820 74 65 73 74 5f 69 64 3d 3f 3b 22 0a 09 20 20 22 test_id=?;".. "
16830 53 45 4c 45 43 54 20 72 75 6e 5f 69 64 2c 74 65 SELECT run_id,te
16840 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 68 stname,item_path
16850 2c 63 61 74 65 67 6f 72 79 2c 76 61 72 69 61 62 ,category,variab
16860 6c 65 2c 74 64 2e 76 61 6c 75 65 20 41 53 20 76 le,td.value AS v
16870 61 6c 75 65 2c 74 64 2e 65 78 70 65 63 74 65 64 alue,td.expected
16880 2c 74 64 2e 74 6f 6c 2c 74 64 2e 75 6e 69 74 73 ,td.tol,td.units
16890 2c 74 64 2e 73 74 61 74 75 73 20 41 53 20 73 74 ,td.status AS st
168a0 61 74 75 73 2c 74 64 2e 63 6f 6d 6d 65 6e 74 20 atus,td.comment
168b0 41 53 20 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 AS comment FROM
168c0 74 65 73 74 5f 64 61 74 61 20 41 53 20 74 64 20 test_data AS td
168d0 49 4e 4e 45 52 20 4a 4f 49 4e 20 74 65 73 74 73 INNER JOIN tests
168e0 20 4f 4e 20 74 65 73 74 73 2e 69 64 3d 74 64 2e ON tests.id=td.
168f0 74 65 73 74 5f 69 64 20 57 48 45 52 45 20 74 65 test_id WHERE te
16900 73 74 6e 61 6d 65 3d 3f 3b 22 0a 09 20 20 74 65 stname=?;".. te
16910 73 74 2d 69 64 29 0a 09 20 28 69 66 20 63 75 72 st-id).. (if cur
16920 72 2d 74 65 73 74 2d 6e 61 6d 65 0a 09 20 20 20 r-test-name..
16930 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 73 20 (set! results
16940 28 61 70 70 65 6e 64 20 72 65 73 75 6c 74 73 20 (append results
16950 28 6c 69 73 74 20 28 63 6f 6e 73 20 63 75 72 72 (list (cons curr
16960 2d 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d -test-name test-
16970 64 61 74 61 29 29 29 29 29 0a 09 20 29 29 0a 20 data))))).. )).
16980 20 20 20 20 28 73 6f 72 74 20 28 64 65 6c 65 74 (sort (delet
16990 65 2d 64 75 70 6c 69 63 61 74 65 73 20 74 65 73 e-duplicates tes
169a0 74 2d 69 64 73 29 20 73 74 72 69 6e 67 3c 3d 29 t-ids) string<=)
169b0 29 0a 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 ). (system (c
169c0 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 onc "mkdir -p "
169d0 74 65 6d 70 64 69 72 29 29 0a 20 20 20 20 3b 3b tempdir)). ;;
169e0 20 28 70 70 20 72 65 73 75 6c 74 73 29 0a 20 20 (pp results).
169f0 20 20 28 6f 64 73 3a 6c 69 73 74 2d 3e 6f 64 73 (ods:list->ods
16a00 20 0a 20 20 20 20 20 74 65 6d 70 64 69 72 0a 20 . tempdir.
16a10 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 2d (if (string-
16a20 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 5e match (regexp "^
16a30 5b 2f 7e 5d 2b 2e 2a 22 29 20 6f 75 74 70 75 74 [/~]+.*") output
16a40 66 69 6c 65 29 20 3b 3b 20 66 75 6c 6c 20 70 61 file) ;; full pa
16a50 74 68 3f 0a 09 20 6f 75 74 70 75 74 66 69 6c 65 th?.. outputfile
16a60 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 .. (begin.. (d
16a70 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
16a80 52 4e 49 4e 47 3a 20 70 61 74 68 20 67 69 76 65 RNING: path give
16a90 6e 2c 20 22 20 6f 75 74 70 75 74 66 69 6c 65 20 n, " outputfile
16aa0 22 20 69 73 20 72 65 6c 61 74 69 76 65 2c 20 70 " is relative, p
16ab0 72 65 66 69 78 69 6e 67 20 77 69 74 68 20 63 75 refixing with cu
16ac0 72 72 65 6e 74 20 64 69 72 65 63 74 6f 72 79 22 rrent directory"
16ad0 29 0a 09 20 20 20 28 63 6f 6e 63 20 28 63 75 72 ).. (conc (cur
16ae0 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 20 rent-directory)
16af0 22 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 29 29 "/" outputfile))
16b00 29 0a 20 20 20 20 20 72 65 73 75 6c 74 73 29 0a ). results).
16b10 20 20 20 20 3b 3b 20 62 72 75 74 61 6c 20 63 6c ;; brutal cl
16b20 65 61 6e 20 75 70 0a 20 20 20 20 28 73 79 73 74 ean up. (syst
16b30 65 6d 20 22 72 6d 20 2d 72 66 20 74 65 6d 70 64 em "rm -rf tempd
16b40 69 72 22 29 29 29 0a 0a 3b 3b 20 28 64 62 3a 65 ir")))..;; (db:e
16b50 78 74 72 61 63 74 2d 6f 64 73 2d 66 69 6c 65 20 xtract-ods-file
16b60 64 62 20 22 6f 75 74 70 75 74 66 69 6c 65 2e 6f db "outputfile.o
16b70 64 73 22 20 27 28 28 22 73 79 73 6e 61 6d 65 22 ds" '(("sysname"
16b80 20 22 25 22 29 28 22 66 73 6e 61 6d 65 22 20 22 "%")("fsname" "
16b90 25 22 29 28 22 64 61 74 61 70 61 74 68 22 20 22 %")("datapath" "
16ba0 25 22 29 29 20 22 25 22 29 0a 0a 3b 3b 20 54 68 %")) "%")..;; Th
16bb0 69 73 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 is is a list of
16bc0 61 6c 6c 20 70 72 6f 63 73 20 74 68 61 74 20 77 all procs that w
16bd0 72 69 74 65 20 74 6f 20 74 68 65 20 64 62 0a 3b rite to the db.;
16be0 3b 0a 3b 3b 20 28 64 65 66 69 6e 65 20 2a 64 62 ;.;; (define *db
16bf0 3a 61 6c 6c 2d 77 72 69 74 65 2d 70 72 6f 63 73 :all-write-procs
16c00 2a 0a 3b 3b 20 20 20 28 6c 69 73 74 20 0a 3b 3b *.;; (list .;;
16c10 20 20 20 20 64 62 3a 73 65 74 2d 76 61 72 20 0a db:set-var .
16c20 3b 3b 20 20 20 20 64 62 3a 64 65 6c 2d 76 61 72 ;; db:del-var
16c30 0a 3b 3b 20 20 20 20 64 62 3a 72 65 67 69 73 74 .;; db:regist
16c40 65 72 2d 72 75 6e 0a 3b 3b 20 20 20 20 64 62 3a er-run.;; db:
16c50 73 65 74 2d 63 6f 6d 6d 65 6e 74 2d 66 6f 72 2d set-comment-for-
16c60 72 75 6e 0a 3b 3b 20 20 20 20 64 62 3a 64 65 6c run.;; db:del
16c70 65 74 65 2d 72 75 6e 0a 3b 3b 20 20 20 20 64 62 ete-run.;; db
16c80 3a 75 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e :update-run-even
16c90 74 5f 74 69 6d 65 0a 3b 3b 20 20 20 20 64 62 3a t_time.;; db:
16ca0 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 lock/unlock-run
16cb0 0a 3b 3b 20 20 20 20 64 62 3a 64 65 6c 65 74 65 .;; db:delete
16cc0 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 -test-step-recor
16cd0 64 73 0a 3b 3b 20 20 20 20 64 62 3a 64 65 6c 65 ds.;; db:dele
16ce0 74 65 2d 74 65 73 74 2d 72 65 63 6f 72 64 73 0a te-test-records.
16cf0 3b 3b 20 20 20 20 64 62 3a 64 65 6c 65 74 65 2d ;; db:delete-
16d00 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 0a 3b 3b tests-for-run.;;
16d10 20 20 20 20 64 62 3a 64 65 6c 65 74 65 2d 6f 6c db:delete-ol
16d20 64 2d 64 65 6c 65 74 65 64 2d 74 65 73 74 2d 72 d-deleted-test-r
16d30 65 63 6f 72 64 73 0a 3b 3b 20 20 20 20 64 62 3a ecords.;; db:
16d40 73 65 74 2d 74 65 73 74 73 2d 73 74 61 74 65 2d set-tests-state-
16d50 73 74 61 74 75 73 0a 3b 3b 20 20 20 20 64 62 3a status.;; db:
16d60 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 test-set-state-s
16d70 74 61 74 75 73 2d 62 79 2d 69 64 0a 3b 3b 20 20 tatus-by-id.;;
16d80 20 20 64 62 3a 74 65 73 74 2d 73 65 74 2d 73 74 db:test-set-st
16d90 61 74 65 2d 73 74 61 74 75 73 2d 62 79 2d 72 75 ate-status-by-ru
16da0 6e 2d 69 64 2d 74 65 73 74 6e 61 6d 65 0a 3b 3b n-id-testname.;;
16db0 20 20 20 20 64 62 3a 74 65 73 74 6d 65 74 61 2d db:testmeta-
16dc0 61 64 64 2d 72 65 63 6f 72 64 0a 3b 3b 20 20 20 add-record.;;
16dd0 20 64 62 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 db:csv->test-da
16de0 74 61 0a 3b 3b 20 20 20 20 29 29 0a 0a ta.;; ))..