0000: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d 3d ==========..;;==
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 0a 3b 3b 20 54 65 73 74 73 0a 3b 3b ====.;; Tests.;;
0230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 28 75 73 65 20 73 71 6c ======..(use sql
0280: 69 74 65 33 20 73 72 66 69 2d 31 20 70 6f 73 69 ite3 srfi-1 posi
0290: 78 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 61 x regex regex-ca
02a0: 73 65 20 73 72 66 69 2d 36 39 20 64 6f 74 2d 6c se srfi-69 dot-l
02b0: 6f 63 6b 69 6e 67 20 74 63 70 20 72 70 63 29 0a ocking tcp rpc).
02c0: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
02d0: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
02e0: 29 29 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 )).(import (pref
02f0: 69 78 20 72 70 63 20 72 70 63 3a 29 29 0a 0a 28 ix rpc rpc:))..(
0300: 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 74 65 declare (unit te
0310: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
0320: 75 73 65 73 20 64 62 29 29 0a 28 64 65 63 6c 61 uses db)).(decla
0330: 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 re (uses common)
0340: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0350: 20 69 74 65 6d 73 29 29 0a 28 64 65 63 6c 61 72 items)).(declar
0360: 65 20 28 75 73 65 73 20 72 75 6e 63 6f 6e 66 69 e (uses runconfi
0370: 67 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 g))..(include "c
0380: 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 ommon_records.sc
0390: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 m").(include "ke
03a0: 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a y_records.scm").
03b0: 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 (include "db_rec
03c0: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
03d0: 75 64 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 ude "run_records
03e0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
03f0: 22 74 65 73 74 5f 72 65 63 6f 72 64 73 2e 73 63 "test_records.sc
0400: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 m")..(define (te
0410: 73 74 73 3a 72 65 67 69 73 74 65 72 2d 74 65 73 sts:register-tes
0420: 74 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 t db run-id test
0430: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
0440: 0a 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d 70 . (let ((item-p
0450: 61 74 68 73 20 28 69 66 20 28 65 71 75 61 6c 3f aths (if (equal?
0460: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 item-path "")..
0470: 09 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 74 ..(list item-pat
0480: 68 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d h)....(list item
0490: 2d 70 61 74 68 20 22 22 29 29 29 29 0a 20 20 20 -path "")))).
04a0: 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 (for-each .
04b0: 20 28 6c 61 6d 62 64 61 20 28 70 74 68 29 0a 20 (lambda (pth).
04c0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 (sqlite3:e
04d0: 78 65 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 xecute db "INSER
04e0: 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f T OR IGNORE INTO
04f0: 20 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 tests (run_id,t
0500: 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 69 estname,event_ti
0510: 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 me,item_path,sta
0520: 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 45 te,status) VALUE
0530: 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 S (?,?,strftime(
0540: 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 4e '%s','now'),?,'N
0550: 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 2f 61 OT_STARTED','n/a
0560: 27 29 3b 22 20 0a 09 09 09 72 75 6e 2d 69 64 20 ');" ....run-id
0570: 0a 09 09 09 74 65 73 74 2d 6e 61 6d 65 0a 09 09 ....test-name...
0580: 09 70 74 68 29 29 0a 20 20 20 20 20 69 74 65 6d .pth)). item
0590: 2d 70 61 74 68 73 20 29 29 29 0a 0a 3b 3b 20 67 -paths )))..;; g
05a0: 65 74 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 et the previous
05b0: 72 65 63 6f 72 64 20 66 6f 72 20 77 68 65 6e 20 record for when
05c0: 74 68 69 73 20 74 65 73 74 20 77 61 73 20 72 75 this test was ru
05d0: 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 n where all keys
05e0: 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e 6e 61 match but runna
05f0: 6d 65 0a 3b 3b 20 72 65 74 75 72 6e 73 20 23 66 me.;; returns #f
0600: 20 69 66 20 6e 6f 20 73 75 63 68 20 74 65 73 74 if no such test
0610: 20 66 6f 75 6e 64 2c 20 72 65 74 75 72 6e 73 20 found, returns
0620: 61 20 73 69 6e 67 6c 65 20 74 65 73 74 20 72 65 a single test re
0630: 63 6f 72 64 20 69 66 20 66 6f 75 6e 64 0a 28 64 cord if found.(d
0640: 65 66 69 6e 65 20 28 74 65 73 74 3a 67 65 74 2d efine (test:get-
0650: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
0660: 6e 2d 72 65 63 6f 72 64 20 64 62 20 72 75 6e 2d n-record db run-
0670: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
0680: 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 m-path). (let*
0690: 28 28 6b 65 79 73 20 20 20 20 28 64 62 3a 67 65 ((keys (db:ge
06a0: 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 73 t-keys db)).. (s
06b0: 65 6c 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 elstr (string-i
06c0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
06d0: 28 6c 61 6d 62 64 61 20 28 78 29 28 76 65 63 74 (lambda (x)(vect
06e0: 6f 72 2d 72 65 66 20 78 20 30 29 29 20 6b 65 79 or-ref x 0)) key
06f0: 73 29 20 22 2c 22 29 29 0a 09 20 28 71 72 79 73 s) ",")).. (qrys
0700: 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 tr (string-inte
0710: 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 rsperse (map (la
0720: 6d 62 64 61 20 28 78 29 28 63 6f 6e 63 20 28 76 mbda (x)(conc (v
0730: 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 20 22 ector-ref x 0) "
0740: 3d 3f 22 29 29 20 6b 65 79 73 29 20 22 20 41 4e =?")) keys) " AN
0750: 44 20 22 29 29 0a 09 20 28 6b 65 79 76 61 6c 73 D ")).. (keyvals
0760: 20 23 66 29 29 0a 20 20 20 20 3b 3b 20 66 69 72 #f)). ;; fir
0770: 73 74 20 6c 6f 6f 6b 20 75 70 20 74 68 65 20 6b st look up the k
0780: 65 79 20 76 61 6c 75 65 73 20 66 72 6f 6d 20 74 ey values from t
0790: 68 65 20 72 75 6e 20 73 65 6c 65 63 74 65 64 20 he run selected
07a0: 62 79 20 72 75 6e 2d 69 64 0a 20 20 20 20 28 73 by run-id. (s
07b0: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
07c0: 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 row . (lambd
07d0: 61 20 28 61 20 2e 20 62 29 0a 20 20 20 20 20 20 a (a . b).
07e0: 20 28 73 65 74 21 20 6b 65 79 76 61 6c 73 20 28 (set! keyvals (
07f0: 63 6f 6e 73 20 61 20 62 29 29 29 0a 20 20 20 20 cons a b))).
0800: 20 64 62 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 db. (conc "
0810: 53 45 4c 45 43 54 20 22 20 73 65 6c 73 74 72 20 SELECT " selstr
0820: 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 " FROM runs WHER
0830: 45 20 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 20 E id=? ORDER BY
0840: 65 76 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 3b event_time DESC;
0850: 22 29 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 ") run-id). (
0860: 69 66 20 28 6e 6f 74 20 6b 65 79 76 61 6c 73 29 if (not keyvals)
0870: 0a 09 23 66 0a 09 28 6c 65 74 20 28 28 70 72 65 ..#f..(let ((pre
0880: 76 2d 72 75 6e 2d 69 64 73 20 27 28 29 29 29 0a v-run-ids '())).
0890: 09 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 . (apply sqlite
08a0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 3:for-each-row..
08b0: 09 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 . (lambda (id)..
08c0: 09 20 20 20 28 73 65 74 21 20 70 72 65 76 2d 72 . (set! prev-r
08d0: 75 6e 2d 69 64 73 20 28 63 6f 6e 73 20 69 64 20 un-ids (cons id
08e0: 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a prev-run-ids))).
08f0: 09 09 20 64 62 0a 09 09 20 28 63 6f 6e 63 20 22 .. db... (conc "
0900: 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 72 SELECT id FROM r
0910: 75 6e 73 20 57 48 45 52 45 20 22 20 71 72 79 73 uns WHERE " qrys
0920: 74 72 20 22 20 41 4e 44 20 69 64 20 21 3d 20 3f tr " AND id != ?
0930: 3b 22 29 20 28 61 70 70 65 6e 64 20 6b 65 79 76 ;") (append keyv
0940: 61 6c 73 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 als (list run-id
0950: 29 29 29 0a 09 20 20 3b 3b 20 66 6f 72 20 65 61 ))).. ;; for ea
0960: 63 68 20 72 75 6e 20 73 74 61 72 74 69 6e 67 20 ch run starting
0970: 77 69 74 68 20 74 68 65 20 6d 6f 73 74 20 72 65 with the most re
0980: 63 65 6e 74 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 cent look to see
0990: 20 69 66 20 74 68 65 72 65 20 69 73 20 61 20 6d if there is a m
09a0: 61 74 63 68 69 6e 67 20 74 65 73 74 0a 09 20 20 atching test..
09b0: 3b 3b 20 69 66 20 66 6f 75 6e 64 20 74 68 65 6e ;; if found then
09c0: 20 72 65 74 75 72 6e 20 74 68 61 74 20 6d 61 74 return that mat
09d0: 63 68 69 6e 67 20 74 65 73 74 20 72 65 63 6f 72 ching test recor
09e0: 64 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e d.. (debug:prin
09f0: 74 20 34 20 22 73 65 6c 73 74 72 3a 20 22 20 73 t 4 "selstr: " s
0a00: 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a elstr ", qrystr:
0a10: 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 " qrystr ", key
0a20: 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 vals: " keyvals
0a30: 22 2c 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 ", previous run
0a40: 69 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 ids found: " pre
0a50: 76 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 v-run-ids).. (i
0a60: 66 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 f (null? prev-ru
0a70: 6e 2d 69 64 73 29 20 23 66 0a 09 20 20 20 20 20 n-ids) #f..
0a80: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
0a90: 20 28 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 (car prev-run-i
0aa0: 64 73 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 ds)).... (tal (c
0ab0: 64 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 dr prev-run-ids)
0ac0: 29 29 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 ))...(let ((resu
0ad0: 6c 74 73 20 28 64 62 3a 67 65 74 2d 74 65 73 74 lts (db:get-test
0ae0: 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 68 65 64 s-for-run db hed
0af0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
0b00: 70 61 74 68 20 27 28 29 20 27 28 29 29 29 29 0a path '() '()))).
0b10: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
0b20: 20 34 20 22 47 6f 74 20 74 65 73 74 73 20 66 6f 4 "Got tests fo
0b30: 72 20 72 75 6e 2d 69 64 20 22 20 72 75 6e 2d 69 r run-id " run-i
0b40: 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d 65 20 22 d ", test-name "
0b50: 20 74 65 73 74 2d 6e 61 6d 65 20 22 2c 20 69 74 test-name ", it
0b60: 65 6d 2d 70 61 74 68 20 22 20 69 74 65 6d 2d 70 em-path " item-p
0b70: 61 74 68 20 22 3a 20 22 20 72 65 73 75 6c 74 73 ath ": " results
0b80: 29 0a 09 09 20 20 28 69 66 20 28 61 6e 64 20 28 )... (if (and (
0b90: 6e 75 6c 6c 3f 20 72 65 73 75 6c 74 73 29 0a 09 null? results)..
0ba0: 09 09 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f .. (not (null?
0bb0: 20 74 61 6c 29 29 29 0a 09 09 20 20 20 20 20 20 tal)))...
0bc0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
0bd0: 63 64 72 20 74 61 6c 29 29 0a 09 09 20 20 20 20 cdr tal))...
0be0: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 (if (null? res
0bf0: 75 6c 74 73 29 20 23 66 0a 09 09 09 20 20 28 63 ults) #f.... (c
0c00: 61 72 20 72 65 73 75 6c 74 73 29 29 29 29 29 29 ar results))))))
0c10: 29 29 29 29 0a 20 20 20 20 0a 3b 3b 20 67 65 74 )))). .;; get
0c20: 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 72 65 the previous re
0c30: 63 6f 72 64 73 20 66 6f 72 20 77 68 65 6e 20 74 cords for when t
0c40: 68 65 73 65 20 74 65 73 74 73 20 77 65 72 65 20 hese tests were
0c50: 72 75 6e 20 77 68 65 72 65 20 61 6c 6c 20 6b 65 run where all ke
0c60: 79 73 20 6d 61 74 63 68 20 62 75 74 20 72 75 6e ys match but run
0c70: 6e 61 6d 65 0a 3b 3b 20 4e 42 2f 2f 20 4d 65 72 name.;; NB// Mer
0c80: 67 65 20 74 68 69 73 20 77 69 74 68 20 74 65 73 ge this with tes
0c90: 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 t:get-previous-t
0ca0: 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 3f est-run-records?
0cb0: 20 54 68 69 73 20 6f 6e 65 20 6c 6f 6f 6b 73 20 This one looks
0cc0: 66 6f 72 20 61 6c 6c 20 6d 61 74 63 68 69 6e 67 for all matching
0cd0: 20 74 65 73 74 73 0a 3b 3b 20 63 61 6e 20 75 73 tests.;; can us
0ce0: 65 20 77 69 6c 64 63 61 72 64 73 2e 20 0a 28 64 e wildcards. .(d
0cf0: 65 66 69 6e 65 20 28 74 65 73 74 3a 67 65 74 2d efine (test:get-
0d00: 6d 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 matching-previou
0d10: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
0d20: 64 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ds db run-id tes
0d30: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
0d40: 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 ). (let* ((keys
0d50: 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 (db:get-keys
0d60: 20 64 62 29 29 0a 09 20 28 73 65 6c 73 74 72 20 db)).. (selstr
0d70: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
0d80: 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 erse (map (lambd
0d90: 61 20 28 78 29 28 76 65 63 74 6f 72 2d 72 65 66 a (x)(vector-ref
0da0: 20 78 20 30 29 29 20 6b 65 79 73 29 20 22 2c 22 x 0)) keys) ","
0db0: 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 28 73 )).. (qrystr (s
0dc0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0dd0: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
0de0: 78 29 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d x)(conc (vector-
0df0: 72 65 66 20 78 20 30 29 20 22 3d 3f 22 29 29 20 ref x 0) "=?"))
0e00: 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 29 0a keys) " AND ")).
0e10: 09 20 28 6b 65 79 76 61 6c 73 20 23 66 29 0a 09 . (keyvals #f)..
0e20: 20 28 74 65 73 74 73 2d 68 61 73 68 20 28 6d 61 (tests-hash (ma
0e30: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 ke-hash-table)))
0e40: 0a 20 20 20 20 3b 3b 20 66 69 72 73 74 20 6c 6f . ;; first lo
0e50: 6f 6b 20 75 70 20 74 68 65 20 6b 65 79 20 76 61 ok up the key va
0e60: 6c 75 65 73 20 66 72 6f 6d 20 74 68 65 20 72 75 lues from the ru
0e70: 6e 20 73 65 6c 65 63 74 65 64 20 62 79 20 72 75 n selected by ru
0e80: 6e 2d 69 64 0a 20 20 20 20 28 73 71 6c 69 74 65 n-id. (sqlite
0e90: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
0ea0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 (lambda (a
0eb0: 2e 20 62 29 0a 20 20 20 20 20 20 20 28 73 65 74 . b). (set
0ec0: 21 20 6b 65 79 76 61 6c 73 20 28 63 6f 6e 73 20 ! keyvals (cons
0ed0: 61 20 62 29 29 29 0a 20 20 20 20 20 64 62 0a 20 a b))). db.
0ee0: 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 (conc "SELEC
0ef0: 54 20 22 20 73 65 6c 73 74 72 20 22 20 46 52 4f T " selstr " FRO
0f00: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d M runs WHERE id=
0f10: 3f 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e 74 ? ORDER BY event
0f20: 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 20 72 75 _time DESC;") ru
0f30: 6e 2d 69 64 29 0a 20 20 20 20 28 69 66 20 28 6e n-id). (if (n
0f40: 6f 74 20 6b 65 79 76 61 6c 73 29 0a 09 27 28 29 ot keyvals)..'()
0f50: 0a 09 28 6c 65 74 20 28 28 70 72 65 76 2d 72 75 ..(let ((prev-ru
0f60: 6e 2d 69 64 73 20 27 28 29 29 29 0a 09 20 20 28 n-ids '())).. (
0f70: 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f apply sqlite3:fo
0f80: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 09 20 28 6c r-each-row... (l
0f90: 61 6d 62 64 61 20 28 69 64 29 0a 09 09 20 20 20 ambda (id)...
0fa0: 28 73 65 74 21 20 70 72 65 76 2d 72 75 6e 2d 69 (set! prev-run-i
0fb0: 64 73 20 28 63 6f 6e 73 20 69 64 20 70 72 65 76 ds (cons id prev
0fc0: 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 20 64 -run-ids)))... d
0fd0: 62 0a 09 09 20 28 63 6f 6e 63 20 22 53 45 4c 45 b... (conc "SELE
0fe0: 43 54 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 20 CT id FROM runs
0ff0: 57 48 45 52 45 20 22 20 71 72 79 73 74 72 20 22 WHERE " qrystr "
1000: 20 41 4e 44 20 69 64 20 21 3d 20 3f 3b 22 29 20 AND id != ?;")
1010: 28 61 70 70 65 6e 64 20 6b 65 79 76 61 6c 73 20 (append keyvals
1020: 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a (list run-id))).
1030: 09 20 20 3b 3b 20 63 6f 6c 6c 65 63 74 20 61 6c . ;; collect al
1040: 6c 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 73 l matching tests
1050: 20 66 6f 72 20 74 68 65 20 72 75 6e 73 20 74 68 for the runs th
1060: 65 6e 0a 09 20 20 3b 3b 20 65 78 74 72 61 63 74 en.. ;; extract
1070: 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 the most recent
1080: 20 74 65 73 74 20 61 6e 64 20 72 65 74 75 72 6e test and return
1090: 20 74 68 61 74 2e 0a 09 20 20 28 64 65 62 75 67 that... (debug
10a0: 3a 70 72 69 6e 74 20 34 20 22 73 65 6c 73 74 72 :print 4 "selstr
10b0: 3a 20 22 20 73 65 6c 73 74 72 20 22 2c 20 71 72 : " selstr ", qr
10c0: 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 20 22 ystr: " qrystr "
10d0: 2c 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b 65 79 , keyvals: " key
10e0: 76 61 6c 73 20 0a 09 09 20 20 20 20 20 20 20 22 vals ... "
10f0: 2c 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 , previous run i
1100: 64 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 76 ds found: " prev
1110: 2d 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 66 -run-ids).. (if
1120: 20 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 6e (null? prev-run
1130: 2d 69 64 73 29 20 27 28 29 20 20 3b 3b 20 6e 6f -ids) '() ;; no
1140: 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73 3f 20 previous runs?
1150: 72 65 74 75 72 6e 20 6e 75 6c 6c 0a 09 20 20 20 return null..
1160: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
1170: 65 64 20 28 63 61 72 20 70 72 65 76 2d 72 75 6e ed (car prev-run
1180: 2d 69 64 73 29 29 0a 09 09 09 20 28 74 61 6c 20 -ids)).... (tal
1190: 28 63 64 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 (cdr prev-run-id
11a0: 73 29 29 29 0a 09 09 28 6c 65 74 20 28 28 72 65 s)))...(let ((re
11b0: 73 75 6c 74 73 20 28 72 64 62 3a 67 65 74 2d 74 sults (rdb:get-t
11c0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 ests-for-run db
11d0: 68 65 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 hed test-name it
11e0: 65 6d 2d 70 61 74 68 20 27 28 29 20 27 28 29 29 em-path '() '())
11f0: 29 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 ))... (debug:pr
1200: 69 6e 74 20 34 20 22 47 6f 74 20 74 65 73 74 73 int 4 "Got tests
1210: 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 for run-id " ru
1220: 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d n-id ", test-nam
1230: 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 0a 09 e " test-name ..
1240: 09 09 20 20 20 20 20 20 20 22 2c 20 69 74 65 6d .. ", item
1250: 2d 70 61 74 68 20 22 20 69 74 65 6d 2d 70 61 74 -path " item-pat
1260: 68 20 22 20 72 65 73 75 6c 74 73 3a 20 22 20 28 h " results: " (
1270: 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 75 intersperse resu
1280: 6c 74 73 20 22 5c 6e 22 29 29 0a 09 09 20 20 3b lts "\n"))... ;
1290: 3b 20 4b 65 65 70 20 6f 6e 6c 79 20 74 68 65 20 ; Keep only the
12a0: 79 6f 75 6e 67 65 73 74 20 6f 66 20 61 6e 79 20 youngest of any
12b0: 74 65 73 74 2f 69 74 65 6d 20 63 6f 6d 62 69 6e test/item combin
12c0: 61 74 69 6f 6e 0a 09 09 20 20 28 66 6f 72 2d 65 ation... (for-e
12d0: 61 63 68 20 0a 09 09 20 20 20 28 6c 61 6d 62 64 ach ... (lambd
12e0: 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 20 20 a (testdat)...
12f0: 20 20 20 28 6c 65 74 2a 20 28 28 66 75 6c 6c 2d (let* ((full-
1300: 74 65 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 28 testname (conc (
1310: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
1320: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22 2f name testdat) "/
1330: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i
1340: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 tem-path testdat
1350: 29 29 29 0a 09 09 09 20 20 20 20 28 73 74 6f 72 ))).... (stor
1360: 65 64 2d 74 65 73 74 20 20 20 28 68 61 73 68 2d ed-test (hash-
1370: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
1380: 74 20 74 65 73 74 73 2d 68 61 73 68 20 66 75 6c t tests-hash ful
1390: 6c 2d 74 65 73 74 6e 61 6d 65 20 23 66 29 29 29 l-testname #f)))
13a0: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6f ... (if (o
13b0: 72 20 28 6e 6f 74 20 73 74 6f 72 65 64 2d 74 65 r (not stored-te
13c0: 73 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 61 st).... (a
13d0: 6e 64 20 73 74 6f 72 65 64 2d 74 65 73 74 0a 09 nd stored-test..
13e0: 09 09 09 20 20 20 20 28 3e 20 28 64 62 3a 74 65 ... (> (db:te
13f0: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
1400: 65 20 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 e testdat)(db:te
1410: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
1420: 65 20 73 74 6f 72 65 64 2d 74 65 73 74 29 29 29 e stored-test)))
1430: 29 0a 09 09 09 20 20 20 3b 3b 20 74 68 69 73 20 ).... ;; this
1440: 74 65 73 74 20 69 73 20 79 6f 75 6e 67 65 72 2c test is younger,
1450: 20 73 74 6f 72 65 20 69 74 20 69 6e 20 74 68 65 store it in the
1460: 20 68 61 73 68 0a 09 09 09 20 20 20 28 68 61 73 hash.... (has
1470: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
1480: 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 74 65 73 ts-hash full-tes
1490: 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 tname testdat)))
14a0: 29 0a 09 09 20 20 20 72 65 73 75 6c 74 73 29 0a )... results).
14b0: 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
14c0: 61 6c 29 0a 09 09 20 20 20 20 20 20 28 6d 61 70 al)... (map
14d0: 20 63 64 72 20 28 68 61 73 68 2d 74 61 62 6c 65 cdr (hash-table
14e0: 2d 3e 61 6c 69 73 74 20 74 65 73 74 73 2d 68 61 ->alist tests-ha
14f0: 73 68 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 61 sh)) ;; return a
1500: 20 6c 69 73 74 20 6f 66 20 74 68 65 20 6d 6f 73 list of the mos
1510: 74 20 72 65 63 65 6e 74 20 74 65 73 74 73 0a 09 t recent tests..
1520: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
1530: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 r tal)(cdr tal))
1540: 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 0a 28 64 ))))))))..;; .(d
1550: 65 66 69 6e 65 20 28 74 65 73 74 2d 73 65 74 2d efine (test-set-
1560: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
1570: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 id state status
1580: 63 6f 6d 6d 65 6e 74 20 64 61 74 29 0a 20 20 28 comment dat). (
1590: 6c 65 74 2a 20 28 28 72 65 61 6c 2d 73 74 61 74 let* ((real-stat
15a0: 75 73 20 73 74 61 74 75 73 29 0a 09 20 28 6f 74 us status).. (ot
15b0: 68 65 72 64 61 74 20 20 20 20 28 69 66 20 64 61 herdat (if da
15c0: 74 20 64 61 74 20 28 6d 61 6b 65 2d 68 61 73 68 t dat (make-hash
15d0: 2d 74 61 62 6c 65 29 29 29 0a 09 20 28 74 65 73 -table))).. (tes
15e0: 74 64 61 74 20 20 20 20 20 28 64 62 3a 67 65 74 tdat (db:get
15f0: 2d 74 65 73 74 2d 64 61 74 61 2d 62 79 2d 69 64 -test-data-by-id
1600: 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 db test-id))..
1610: 28 72 75 6e 2d 69 64 20 20 20 20 20 20 28 64 62 (run-id (db
1620: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 64 :test-get-run_id
1630: 20 74 65 73 74 64 61 74 29 29 0a 09 20 28 74 65 testdat)).. (te
1640: 73 74 2d 6e 61 6d 65 20 20 20 28 64 62 3a 74 65 st-name (db:te
1650: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
1660: 20 20 74 65 73 74 64 61 74 29 29 0a 09 20 28 69 testdat)).. (i
1670: 74 65 6d 2d 70 61 74 68 20 20 20 28 64 62 3a 74 tem-path (db:t
1680: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
1690: 68 20 74 65 73 74 64 61 74 29 29 0a 09 20 3b 3b h testdat)).. ;;
16a0: 20 62 65 66 6f 72 65 20 70 72 6f 63 65 65 64 69 before proceedi
16b0: 6e 67 20 77 65 20 6d 75 73 74 20 66 69 6e 64 20 ng we must find
16c0: 6f 75 74 20 69 66 20 74 68 65 20 70 72 65 76 69 out if the previ
16d0: 6f 75 73 20 74 65 73 74 20 28 77 68 65 72 65 20 ous test (where
16e0: 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 68 65 64 all keys matched
16f0: 20 65 78 63 65 70 74 20 72 75 6e 6e 61 6d 65 29 except runname)
1700: 0a 09 20 3b 3b 20 77 61 73 20 57 41 49 56 45 44 .. ;; was WAIVED
1710: 20 69 66 20 74 68 69 73 20 74 65 73 74 20 69 73 if this test is
1720: 20 46 41 49 4c 0a 09 20 28 77 61 69 76 65 64 20 FAIL.. (waived
1730: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 (if (equal? st
1740: 61 74 75 73 20 22 46 41 49 4c 22 29 0a 09 09 20 atus "FAIL")...
1750: 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 65 (let ((pre
1760: 76 2d 74 65 73 74 20 28 74 65 73 74 3a 67 65 74 v-test (test:get
1770: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
1780: 75 6e 2d 72 65 63 6f 72 64 20 64 62 20 72 75 6e un-record db run
1790: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
17a0: 65 6d 2d 70 61 74 68 29 29 29 0a 09 09 09 20 28 em-path))).... (
17b0: 69 66 20 70 72 65 76 2d 74 65 73 74 20 3b 3b 20 if prev-test ;;
17c0: 74 72 75 65 20 69 66 20 77 65 20 66 6f 75 6e 64 true if we found
17d0: 20 61 20 70 72 65 76 69 6f 75 73 20 74 65 73 74 a previous test
17e0: 20 69 6e 20 74 68 69 73 20 72 75 6e 20 73 65 72 in this run ser
17f0: 69 65 73 0a 09 09 09 20 20 20 20 20 28 6c 65 74 ies.... (let
1800: 20 28 28 70 72 65 76 2d 73 74 61 74 75 73 20 28 ((prev-status (
1810: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
1820: 75 73 20 20 20 70 72 65 76 2d 74 65 73 74 29 29 us prev-test))
1830: 0a 09 09 09 09 20 20 20 28 70 72 65 76 2d 73 74 ..... (prev-st
1840: 61 74 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 ate (db:test-ge
1850: 74 2d 73 74 61 74 65 20 20 20 20 70 72 65 76 2d t-state prev-
1860: 74 65 73 74 29 29 0a 09 09 09 09 20 20 20 28 70 test))..... (p
1870: 72 65 76 2d 63 6f 6d 6d 65 6e 74 20 28 64 62 3a rev-comment (db:
1880: 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 test-get-comment
1890: 20 70 72 65 76 2d 74 65 73 74 29 29 29 0a 09 09 prev-test)))...
18a0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
18b0: 72 69 6e 74 20 34 20 22 70 72 65 76 2d 73 74 61 rint 4 "prev-sta
18c0: 74 75 73 20 22 20 70 72 65 76 2d 73 74 61 74 75 tus " prev-statu
18d0: 73 20 22 2c 20 70 72 65 76 2d 73 74 61 74 65 20 s ", prev-state
18e0: 22 20 70 72 65 76 2d 73 74 61 74 65 20 22 2c 20 " prev-state ",
18f0: 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 20 22 20 70 prev-comment " p
1900: 72 65 76 2d 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 rev-comment)....
1910: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
1920: 28 65 71 75 61 6c 3f 20 70 72 65 76 2d 73 74 61 (equal? prev-sta
1930: 74 65 20 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 te "COMPLETED")
1940: 0a 09 09 09 09 09 28 65 71 75 61 6c 3f 20 70 72 ......(equal? pr
1950: 65 76 2d 73 74 61 74 75 73 20 22 57 41 49 56 45 ev-status "WAIVE
1960: 44 22 29 29 0a 09 09 09 09 20 20 20 70 72 65 76 D"))..... prev
1970: 2d 63 6f 6d 6d 65 6e 74 20 3b 3b 20 77 61 69 76 -comment ;; waiv
1980: 65 64 20 69 73 20 65 69 74 68 65 72 20 74 68 65 ed is either the
1990: 20 63 6f 6d 6d 65 6e 74 20 6f 72 20 23 66 0a 09 comment or #f..
19a0: 09 09 09 20 20 20 23 66 29 29 0a 09 09 09 20 20 ... #f))....
19b0: 20 20 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 #f))...
19c0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 77 #f))). (if w
19d0: 61 69 76 65 64 20 28 73 65 74 21 20 72 65 61 6c aived (set! real
19e0: 2d 73 74 61 74 75 73 20 22 57 41 49 56 45 44 22 -status "WAIVED"
19f0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
1a00: 69 6e 74 20 34 20 22 72 65 61 6c 2d 73 74 61 74 int 4 "real-stat
1a10: 75 73 20 22 20 72 65 61 6c 2d 73 74 61 74 75 73 us " real-status
1a20: 20 22 2c 20 77 61 69 76 65 64 20 22 20 77 61 69 ", waived " wai
1a30: 76 65 64 20 22 2c 20 73 74 61 74 75 73 20 22 20 ved ", status "
1a40: 73 74 61 74 75 73 29 0a 0a 20 20 20 20 3b 3b 20 status).. ;;
1a50: 75 70 64 61 74 65 20 74 68 65 20 70 72 69 6d 61 update the prima
1a60: 72 79 20 72 65 63 6f 72 64 20 49 46 20 73 74 61 ry record IF sta
1a70: 74 65 20 41 4e 44 20 73 74 61 74 75 73 20 61 72 te AND status ar
1a80: 65 20 64 65 66 69 6e 65 64 0a 20 20 20 20 28 69 e defined. (i
1a90: 66 20 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 f (and state sta
1aa0: 74 75 73 29 0a 09 28 72 64 62 3a 74 65 73 74 2d tus)..(rdb:test-
1ab0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
1ac0: 2d 62 79 2d 72 75 6e 2d 69 64 2d 74 65 73 74 6e -by-run-id-testn
1ad0: 61 6d 65 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ame db run-id te
1ae0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
1af0: 68 20 72 65 61 6c 2d 73 74 61 74 75 73 20 73 74 h real-status st
1b00: 61 74 65 29 29 0a 0a 20 20 20 20 3b 3b 20 69 66 ate)).. ;; if
1b10: 20 73 74 61 74 75 73 20 69 73 20 22 41 55 54 4f status is "AUTO
1b20: 22 20 74 68 65 6e 20 63 61 6c 6c 20 72 6f 6c 6c " then call roll
1b30: 75 70 20 28 6e 6f 74 65 2c 20 74 68 69 73 20 6f up (note, this o
1b40: 6e 65 20 6d 6f 64 69 66 69 65 73 20 64 61 74 61 ne modifies data
1b50: 20 69 6e 20 74 65 73 74 0a 20 20 20 20 3b 3b 20 in test. ;;
1b60: 72 75 6e 20 61 72 65 61 2c 20 64 6f 20 6e 6f 74 run area, do not
1b70: 20 72 70 63 20 69 74 20 28 79 65 74 29 0a 20 20 rpc it (yet).
1b80: 20 20 28 69 66 20 28 61 6e 64 20 74 65 73 74 2d (if (and test-
1b90: 69 64 20 73 74 61 74 65 20 73 74 61 74 75 73 20 id state status
1ba0: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
1bb0: 41 55 54 4f 22 29 29 20 0a 09 28 64 62 3a 74 65 AUTO")) ..(db:te
1bc0: 73 74 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 st-data-rollup d
1bd0: 62 20 74 65 73 74 2d 69 64 20 73 74 61 74 75 73 b test-id status
1be0: 29 29 0a 0a 20 20 20 20 3b 3b 20 61 64 64 20 6d )).. ;; add m
1bf0: 65 74 61 64 61 74 61 20 28 6e 65 65 64 20 74 6f etadata (need to
1c00: 20 64 6f 20 74 68 69 73 20 77 61 79 20 74 6f 20 do this way to
1c10: 61 76 6f 69 64 20 53 51 4c 20 69 6e 6a 65 63 74 avoid SQL inject
1c20: 69 6f 6e 20 69 73 73 75 65 73 29 0a 0a 20 20 20 ion issues)..
1c30: 20 3b 3b 20 3a 66 69 72 73 74 5f 65 72 72 0a 20 ;; :first_err.
1c40: 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 76 61 6c ;; (let ((val
1c50: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1c60: 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 /default otherda
1c70: 74 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 23 t ":first_err" #
1c80: 66 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 69 f))). ;; (i
1c90: 66 20 76 61 6c 0a 20 20 20 20 3b 3b 20 20 20 20 f val. ;;
1ca0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
1cb0: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
1cc0: 65 73 74 73 20 53 45 54 20 66 69 72 73 74 5f 65 ests SET first_e
1cd0: 72 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 rr=? WHERE run_i
1ce0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
1cf0: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
1d00: 3d 3f 3b 22 20 76 61 6c 20 72 75 6e 2d 69 64 20 =?;" val run-id
1d10: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
1d20: 61 74 68 29 29 29 0a 20 20 20 20 3b 3b 20 0a 20 ath))). ;; .
1d30: 20 20 20 3b 3b 20 3b 3b 20 3a 66 69 72 73 74 5f ;; ;; :first_
1d40: 77 61 72 6e 0a 20 20 20 20 3b 3b 20 28 6c 65 74 warn. ;; (let
1d50: 20 28 28 76 61 6c 20 28 68 61 73 68 2d 74 61 62 ((val (hash-tab
1d60: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f le-ref/default o
1d70: 74 68 65 72 64 61 74 20 22 3a 66 69 72 73 74 5f therdat ":first_
1d80: 77 61 72 6e 22 20 23 66 29 29 29 0a 20 20 20 20 warn" #f))).
1d90: 3b 3b 20 20 20 28 69 66 20 76 61 6c 0a 20 20 20 ;; (if val.
1da0: 20 3b 3b 20 20 20 20 20 20 20 28 73 71 6c 69 74 ;; (sqlit
1db0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
1dc0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
1dd0: 66 69 72 73 74 5f 77 61 72 6e 3d 3f 20 57 48 45 first_warn=? WHE
1de0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
1df0: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
1e00: 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 76 61 6c tem_path=?;" val
1e10: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
1e20: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a e item-path)))..
1e30: 20 20 20 20 28 6c 65 74 20 28 28 63 61 74 65 67 (let ((categ
1e40: 6f 72 79 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ory (hash-table-
1e50: 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 ref/default othe
1e60: 72 64 61 74 20 22 3a 63 61 74 65 67 6f 72 79 22 rdat ":category"
1e70: 20 22 22 29 29 0a 09 20 20 28 76 61 72 69 61 62 "")).. (variab
1e80: 6c 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 le (hash-table-r
1e90: 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 ef/default other
1ea0: 64 61 74 20 22 3a 76 61 72 69 61 62 6c 65 22 20 dat ":variable"
1eb0: 22 22 29 29 0a 09 20 20 28 76 61 6c 75 65 20 20 "")).. (value
1ec0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1ed0: 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 f/default otherd
1ee0: 61 74 20 22 3a 76 61 6c 75 65 22 20 20 20 20 23 at ":value" #
1ef0: 66 29 29 0a 09 20 20 28 65 78 70 65 63 74 65 64 f)).. (expected
1f00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1f10: 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 /default otherda
1f20: 74 20 22 3a 65 78 70 65 63 74 65 64 22 20 23 66 t ":expected" #f
1f30: 29 29 0a 09 20 20 28 74 6f 6c 20 20 20 20 20 20 )).. (tol
1f40: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1f50: 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 74 default otherdat
1f60: 20 22 3a 74 6f 6c 22 20 20 20 20 20 20 23 66 29 ":tol" #f)
1f70: 29 0a 09 20 20 28 75 6e 69 74 73 20 20 20 20 28 ).. (units (
1f80: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1f90: 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 74 20 efault otherdat
1fa0: 22 3a 75 6e 69 74 73 22 20 20 20 20 22 22 29 29 ":units" ""))
1fb0: 0a 09 20 20 28 74 79 70 65 20 20 20 20 20 28 68 .. (type (h
1fc0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1fd0: 66 61 75 6c 74 20 6f 74 68 65 72 64 61 74 20 22 fault otherdat "
1fe0: 3a 74 79 70 65 22 20 20 20 20 20 22 22 29 29 0a :type" "")).
1ff0: 09 20 20 28 64 63 6f 6d 6d 65 6e 74 20 28 68 61 . (dcomment (ha
2000: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
2010: 61 75 6c 74 20 6f 74 68 65 72 64 61 74 20 22 3a ault otherdat ":
2020: 63 6f 6d 6d 65 6e 74 22 20 20 22 22 29 29 29 0a comment" ""))).
2030: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2040: 6e 74 20 34 20 0a 09 09 20 20 20 22 63 61 74 65 nt 4 ... "cate
2050: 67 6f 72 79 3a 20 22 20 63 61 74 65 67 6f 72 79 gory: " category
2060: 20 22 2c 20 76 61 72 69 61 62 6c 65 3a 20 22 20 ", variable: "
2070: 76 61 72 69 61 62 6c 65 20 22 2c 20 76 61 6c 75 variable ", valu
2080: 65 3a 20 22 20 76 61 6c 75 65 0a 09 09 20 20 20 e: " value...
2090: 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 20 65 ", expected: " e
20a0: 78 70 65 63 74 65 64 20 22 2c 20 74 6f 6c 3a 20 xpected ", tol:
20b0: 22 20 74 6f 6c 20 22 2c 20 75 6e 69 74 73 3a 20 " tol ", units:
20c0: 22 20 75 6e 69 74 73 29 0a 20 20 20 20 20 20 28 " units). (
20d0: 69 66 20 28 61 6e 64 20 76 61 6c 75 65 20 65 78 if (and value ex
20e0: 70 65 63 74 65 64 20 74 6f 6c 29 20 3b 3b 20 61 pected tol) ;; a
20f0: 6c 6c 20 74 68 72 65 65 20 72 65 71 75 69 72 65 ll three require
2100: 64 0a 09 20 20 28 6c 65 74 20 28 28 64 61 74 20 d.. (let ((dat
2110: 28 63 6f 6e 63 20 63 61 74 65 67 6f 72 79 20 22 (conc category "
2120: 2c 22 0a 09 09 09 20 20 20 76 61 72 69 61 62 6c ,".... variabl
2130: 65 20 22 2c 22 0a 09 09 09 20 20 20 76 61 6c 75 e ",".... valu
2140: 65 20 20 20 20 22 2c 22 0a 09 09 09 20 20 20 65 e ",".... e
2150: 78 70 65 63 74 65 64 20 22 2c 22 0a 09 09 09 20 xpected ","....
2160: 20 20 74 6f 6c 20 20 20 20 20 20 22 2c 22 0a 09 tol ","..
2170: 09 09 20 20 20 75 6e 69 74 73 20 20 20 20 22 2c .. units ",
2180: 22 0a 09 09 09 20 20 20 64 63 6f 6d 6d 65 6e 74 ".... dcomment
2190: 20 22 2c 2c 22 20 3b 3b 20 65 78 74 72 61 20 63 ",," ;; extra c
21a0: 6f 6d 6d 61 20 66 6f 72 20 73 74 61 74 75 73 0a omma for status.
21b0: 09 09 09 20 20 20 74 79 70 65 20 20 20 20 20 29 ... type )
21c0: 29 29 0a 09 20 20 20 20 28 72 64 62 3a 63 73 76 )).. (rdb:csv
21d0: 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 ->test-data db t
21e0: 65 73 74 2d 69 64 0a 09 09 09 09 64 61 74 29 29 est-id.....dat))
21f0: 29 29 0a 20 20 20 20 20 20 0a 20 20 20 20 3b 3b )). . ;;
2200: 20 6e 65 65 64 20 74 6f 20 75 70 64 61 74 65 20 need to update
2210: 74 68 65 20 74 6f 70 20 74 65 73 74 20 72 65 63 the top test rec
2220: 6f 72 64 20 69 66 20 50 41 53 53 20 6f 72 20 46 ord if PASS or F
2230: 41 49 4c 20 61 6e 64 20 74 68 69 73 20 69 73 20 AIL and this is
2240: 61 20 73 75 62 74 65 73 74 0a 20 20 20 20 28 72 a subtest. (r
2250: 64 62 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d db:roll-up-pass-
2260: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 64 62 20 72 fail-counts db r
2270: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
2280: 69 74 65 6d 2d 70 61 74 68 20 73 74 61 74 75 73 item-path status
2290: 29 0a 0a 20 20 20 20 28 69 66 20 28 6f 72 20 28 ).. (if (or (
22a0: 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 63 6f 6d and (string? com
22b0: 6d 65 6e 74 29 0a 09 09 20 28 73 74 72 69 6e 67 ment)... (string
22c0: 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 -match (regexp "
22d0: 5c 5c 53 2b 22 29 20 63 6f 6d 6d 65 6e 74 29 29 \\S+") comment))
22e0: 0a 09 20 20 20 20 77 61 69 76 65 64 29 0a 09 28 .. waived)..(
22f0: 6c 65 74 20 28 28 63 6d 74 20 20 28 69 66 20 77 let ((cmt (if w
2300: 61 69 76 65 64 20 77 61 69 76 65 64 20 63 6f 6d aived waived com
2310: 6d 65 6e 74 29 29 29 0a 09 20 20 28 72 64 62 3a ment))).. (rdb:
2320: 74 65 73 74 2d 73 65 74 2d 63 6f 6d 6d 65 6e 74 test-set-comment
2330: 20 64 62 20 74 65 73 74 2d 69 64 20 63 6d 74 29 db test-id cmt)
2340: 29 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 66 69 )). ))..(defi
2350: 6e 65 20 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 ne (test-set-top
2360: 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 log! db run-id t
2370: 65 73 74 2d 6e 61 6d 65 20 6c 6f 67 66 29 20 0a est-name logf) .
2380: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
2390: 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 te db "UPDATE te
23a0: 73 74 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c 6f sts SET final_lo
23b0: 67 66 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 gf=? WHERE run_i
23c0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
23d0: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
23e0: 3d 27 27 3b 22 20 0a 09 09 20 20 20 6c 6f 67 66 ='';" ... logf
23f0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
2400: 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 e))..(define (te
2410: 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
2420: 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ems db run-id te
2430: 73 74 2d 6e 61 6d 65 20 66 6f 72 63 65 29 0a 20 st-name force).
2440: 20 3b 3b 20 69 66 20 6e 6f 74 20 66 6f 72 63 65 ;; if not force
2450: 20 74 68 65 6e 20 6f 6e 6c 79 20 75 70 64 61 74 then only updat
2460: 65 20 74 68 65 20 72 65 63 6f 72 64 20 69 66 20 e the record if
2470: 6f 6e 65 20 6f 66 20 74 68 65 73 65 20 69 73 20 one of these is
2480: 74 72 75 65 3a 0a 20 20 3b 3b 20 20 20 31 2e 20 true:. ;; 1.
2490: 6c 6f 67 66 20 69 73 20 22 6c 6f 67 2f 66 69 6e logf is "log/fin
24a0: 61 6c 2e 6c 6f 67 0a 20 20 3b 3b 20 20 20 32 2e al.log. ;; 2.
24b0: 20 6c 6f 67 66 20 69 73 20 73 61 6d 65 20 61 73 logf is same as
24c0: 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 0a outputfilename.
24d0: 20 20 28 6c 65 74 20 28 28 6f 75 74 70 75 74 66 (let ((outputf
24e0: 69 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 20 22 6d ilename (conc "m
24f0: 65 67 61 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 22 egatest-rollup-"
2500: 20 74 65 73 74 2d 6e 61 6d 65 20 22 2e 68 74 6d test-name ".htm
2510: 6c 22 29 29 0a 09 28 6f 72 69 67 2d 64 69 72 20 l"))..(orig-dir
2520: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 64 (current-d
2530: 69 72 65 63 74 6f 72 79 29 29 0a 09 28 6c 6f 67 irectory))..(log
2540: 66 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 f #f))
2550: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
2560: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
2570: 20 28 6c 61 6d 62 64 61 20 28 70 61 74 68 20 66 (lambda (path f
2580: 69 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 inal_logf).
2590: 20 20 28 73 65 74 21 20 6c 6f 67 66 20 66 69 6e (set! logf fin
25a0: 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 al_logf).
25b0: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 (if (directory?
25c0: 70 61 74 68 29 0a 09 20 20 20 28 62 65 67 69 6e path).. (begin
25d0: 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 .. (print "F
25e0: 6f 75 6e 64 20 70 61 74 68 3a 20 22 20 70 61 74 ound path: " pat
25f0: 68 29 0a 09 20 20 20 20 20 28 63 68 61 6e 67 65 h).. (change
2600: 2d 64 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 -directory path)
2610: 29 0a 09 20 20 20 20 20 3b 3b 20 28 73 65 74 21 ).. ;; (set!
2620: 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 outputfilename
2630: 28 63 6f 6e 63 20 70 61 74 68 20 22 2f 22 20 6f (conc path "/" o
2640: 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 29 29 utputfilename)))
2650: 0a 09 20 20 20 28 70 72 69 6e 74 20 22 4e 6f 20 .. (print "No
2660: 73 75 63 68 20 70 61 74 68 3a 20 22 20 70 61 74 such path: " pat
2670: 68 29 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 h))). db .
2680: 20 20 20 22 53 45 4c 45 43 54 20 72 75 6e 64 69 "SELECT rundi
2690: 72 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f r,final_logf FRO
26a0: 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 M tests WHERE ru
26b0: 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e n_id=? AND testn
26c0: 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 ame=? AND item_p
26d0: 61 74 68 3d 27 27 3b 22 0a 20 20 20 20 20 72 75 ath='';". ru
26e0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
26f0: 20 20 20 20 28 70 72 69 6e 74 20 22 73 75 6d 6d (print "summ
2700: 61 72 69 7a 65 2d 69 74 65 6d 73 20 77 69 74 68 arize-items with
2710: 20 6c 6f 67 66 20 22 20 6c 6f 67 66 29 0a 20 20 logf " logf).
2720: 20 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c (if (or (equal
2730: 3f 20 6c 6f 67 66 20 22 6c 6f 67 73 2f 66 69 6e ? logf "logs/fin
2740: 61 6c 2e 6c 6f 67 22 29 0a 09 20 20 20 20 28 65 al.log").. (e
2750: 71 75 61 6c 3f 20 6c 6f 67 66 20 6f 75 74 70 75 qual? logf outpu
2760: 74 66 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 tfilename)..
2770: 66 6f 72 63 65 29 0a 09 28 62 65 67 69 6e 0a 09 force)..(begin..
2780: 20 20 28 69 66 20 28 6f 62 74 61 69 6e 2d 64 6f (if (obtain-do
2790: 74 2d 6c 6f 63 6b 20 6f 75 74 70 75 74 66 69 6c t-lock outputfil
27a0: 65 6e 61 6d 65 20 31 20 32 30 20 33 30 29 20 3b ename 1 20 30) ;
27b0: 3b 20 72 65 74 72 79 20 65 76 65 72 79 20 73 65 ; retry every se
27c0: 63 6f 6e 64 20 66 6f 72 20 32 30 20 73 65 63 6f cond for 20 seco
27d0: 6e 64 73 2c 20 63 61 6c 6c 20 69 74 20 64 65 61 nds, call it dea
27e0: 64 20 61 66 74 65 72 20 33 30 20 73 65 63 6f 6e d after 30 secon
27f0: 64 73 20 61 6e 64 20 73 74 65 61 6c 20 74 68 65 ds and steal the
2800: 20 6c 6f 63 6b 0a 09 20 20 20 20 20 20 28 70 72 lock.. (pr
2810: 69 6e 74 20 22 4f 62 74 61 69 6e 65 64 20 6c 6f int "Obtained lo
2820: 63 6b 20 66 6f 72 20 22 20 6f 75 74 70 75 74 66 ck for " outputf
2830: 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 ilename)..
2840: 28 70 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 (print "Failed t
2850: 6f 20 6f 62 74 61 69 6e 20 6c 6f 63 6b 20 66 6f o obtain lock fo
2860: 72 20 22 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 r " outputfilena
2870: 6d 65 29 29 0a 09 20 20 28 6c 65 74 20 28 28 6f me)).. (let ((o
2880: 75 70 20 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 up (open-outp
2890: 75 74 2d 66 69 6c 65 20 6f 75 74 70 75 74 66 69 ut-file outputfi
28a0: 6c 65 6e 61 6d 65 29 29 0a 09 09 28 63 6f 75 6e lename))...(coun
28b0: 74 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 ts (make-hash-ta
28c0: 62 6c 65 29 29 0a 09 09 28 73 74 61 74 65 63 6f ble))...(stateco
28d0: 75 6e 74 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d unts (make-hash-
28e0: 74 61 62 6c 65 29 29 0a 09 09 28 6f 75 74 74 78 table))...(outtx
28f0: 74 20 22 22 29 0a 09 09 28 74 6f 74 20 20 20 20 t "")...(tot
2900: 30 29 29 0a 09 20 20 20 20 28 77 69 74 68 2d 6f 0)).. (with-o
2910: 75 74 70 75 74 2d 74 6f 2d 70 6f 72 74 0a 09 09 utput-to-port...
2920: 6f 75 70 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 oup.. (lamb
2930: 64 61 20 28 29 0a 09 09 28 73 65 74 21 20 6f 75 da ()...(set! ou
2940: 74 74 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 78 ttxt (conc outtx
2950: 74 20 22 3c 68 74 6d 6c 3e 3c 74 69 74 6c 65 3e t "<html><title>
2960: 53 75 6d 6d 61 72 79 3a 20 22 20 74 65 73 74 2d Summary: " test-
2970: 6e 61 6d 65 20 0a 09 09 09 09 20 20 20 22 3c 2f name ..... "</
2980: 74 69 74 6c 65 3e 3c 62 6f 64 79 3e 3c 68 32 3e title><body><h2>
2990: 53 75 6d 6d 61 72 79 20 66 6f 72 20 22 20 74 65 Summary for " te
29a0: 73 74 2d 6e 61 6d 65 20 22 3c 2f 68 32 3e 22 29 st-name "</h2>")
29b0: 29 0a 09 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 )...(sqlite3:for
29c0: 2d 65 61 63 68 2d 72 6f 77 20 0a 09 09 20 28 6c -each-row ... (l
29d0: 61 6d 62 64 61 20 28 69 64 20 69 74 65 6d 70 61 ambda (id itempa
29e0: 74 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 th state status
29f0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 run_duration log
2a00: 66 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 20 20 f comment)...
2a10: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
2a20: 20 63 6f 75 6e 74 73 20 73 74 61 74 75 73 20 28 counts status (
2a30: 2b 20 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d + 1 (hash-table-
2a40: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 75 6e ref/default coun
2a50: 74 73 20 73 74 61 74 75 73 20 30 29 29 29 0a 09 ts status 0)))..
2a60: 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d . (hash-table-
2a70: 73 65 74 21 20 73 74 61 74 65 63 6f 75 6e 74 73 set! statecounts
2a80: 20 73 74 61 74 65 20 28 2b 20 31 20 28 68 61 73 state (+ 1 (has
2a90: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
2aa0: 75 6c 74 20 73 74 61 74 65 63 6f 75 6e 74 73 20 ult statecounts
2ab0: 73 74 61 74 65 20 30 29 29 29 0a 09 09 20 20 20 state 0)))...
2ac0: 28 73 65 74 21 20 6f 75 74 74 78 74 20 28 63 6f (set! outtxt (co
2ad0: 6e 63 20 6f 75 74 74 78 74 20 22 3c 74 72 3e 22 nc outtxt "<tr>"
2ae0: 0a 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 3e ..... "<td>
2af0: 3c 61 20 68 72 65 66 3d 5c 22 22 20 69 74 65 6d <a href=\"" item
2b00: 70 61 74 68 20 22 2f 22 20 6c 6f 67 66 20 22 5c path "/" logf "\
2b10: 22 3e 20 22 20 69 74 65 6d 70 61 74 68 20 22 3c "> " itempath "<
2b20: 2f 61 3e 3c 2f 74 64 3e 22 20 0a 09 09 09 09 20 /a></td>" .....
2b30: 20 20 20 20 20 22 3c 74 64 3e 22 20 73 74 61 74 "<td>" stat
2b40: 65 20 20 20 20 22 3c 2f 74 64 3e 22 20 0a 09 09 e "</td>" ...
2b50: 09 09 20 20 20 20 20 20 22 3c 74 64 3e 3c 66 6f .. "<td><fo
2b60: 6e 74 20 63 6f 6c 6f 72 3d 22 20 28 63 6f 6d 6d nt color=" (comm
2b70: 6f 6e 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 72 6f on:get-color-fro
2b80: 6d 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 29 m-status status)
2b90: 0a 09 09 09 09 20 20 20 20 20 20 22 3e 22 20 20 ..... ">"
2ba0: 20 73 74 61 74 75 73 20 20 20 22 3c 2f 66 6f 6e status "</fon
2bb0: 74 3e 3c 2f 74 64 3e 22 0a 09 09 09 09 20 20 20 t></td>".....
2bc0: 20 20 20 22 3c 74 64 3e 22 20 28 69 66 20 28 65 "<td>" (if (e
2bd0: 71 75 61 6c 3f 20 63 6f 6d 6d 65 6e 74 20 22 22 qual? comment ""
2be0: 29 0a 09 09 09 09 09 09 20 22 26 6e 62 73 70 3b )....... "
2bf0: 22 0a 09 09 09 09 09 09 20 63 6f 6d 6d 65 6e 74 "....... comment
2c00: 29 20 22 3c 2f 74 64 3e 22 0a 09 09 09 09 09 09 ) "</td>".......
2c10: 20 22 3c 2f 74 72 3e 22 29 29 29 0a 09 09 20 64 "</tr>")))... d
2c20: 62 0a 09 09 20 22 53 45 4c 45 43 54 20 69 64 2c b... "SELECT id,
2c30: 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c item_path,state,
2c40: 73 74 61 74 75 73 2c 72 75 6e 5f 64 75 72 61 74 status,run_durat
2c50: 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 ion,final_logf,c
2c60: 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 omment FROM test
2c70: 73 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f s WHERE run_id=?
2c80: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
2c90: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d AND item_path !=
2ca0: 20 27 27 3b 22 0a 09 09 20 72 75 6e 2d 69 64 20 '';"... run-id
2cb0: 74 65 73 74 2d 6e 61 6d 65 29 0a 0a 09 09 28 70 test-name)....(p
2cc0: 72 69 6e 74 20 22 3c 74 61 62 6c 65 3e 3c 74 72 rint "<table><tr
2cd0: 3e 3c 74 64 20 76 61 6c 69 67 6e 3d 5c 22 74 6f ><td valign=\"to
2ce0: 70 5c 22 3e 22 29 0a 09 09 3b 3b 20 50 72 69 6e p\">")...;; Prin
2cf0: 74 20 6f 75 74 20 73 74 61 74 73 20 66 6f 72 20 t out stats for
2d00: 73 74 61 74 75 73 0a 09 09 28 73 65 74 21 20 74 status...(set! t
2d10: 6f 74 20 30 29 0a 09 09 28 70 72 69 6e 74 20 22 ot 0)...(print "
2d20: 3c 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 <table cellspaci
2d30: 6e 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d ng=\"0\" border=
2d40: 5c 22 31 5c 22 3e 3c 74 72 3e 3c 74 64 20 63 6f \"1\"><tr><td co
2d50: 6c 73 70 61 6e 3d 5c 22 32 5c 22 3e 3c 68 32 3e lspan=\"2\"><h2>
2d60: 53 74 61 74 65 20 73 74 61 74 73 3c 2f 68 32 3e State stats</h2>
2d70: 3c 2f 74 64 3e 3c 2f 74 72 3e 22 29 0a 09 09 28 </td></tr>")...(
2d80: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
2d90: 20 28 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 (state)....
2da0: 28 73 65 74 21 20 74 6f 74 20 28 2b 20 74 6f 74 (set! tot (+ tot
2db0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2dc0: 20 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 61 statecounts sta
2dd0: 74 65 29 29 29 0a 09 09 09 20 20 20 20 28 70 72 te))).... (pr
2de0: 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e 22 20 73 int "<tr><td>" s
2df0: 74 61 74 65 20 22 3c 2f 74 64 3e 3c 74 64 3e 22 tate "</td><td>"
2e00: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2e10: 20 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 61 statecounts sta
2e20: 74 65 29 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 22 te) "</td></tr>"
2e30: 29 29 0a 09 09 09 20 20 28 68 61 73 68 2d 74 61 )).... (hash-ta
2e40: 62 6c 65 2d 6b 65 79 73 20 73 74 61 74 65 63 6f ble-keys stateco
2e50: 75 6e 74 73 29 29 0a 09 09 28 70 72 69 6e 74 20 unts))...(print
2e60: 22 3c 74 72 3e 3c 74 64 3e 54 6f 74 61 6c 3c 2f "<tr><td>Total</
2e70: 74 64 3e 3c 74 64 3e 22 20 74 6f 74 20 22 3c 2f td><td>" tot "</
2e80: 74 64 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 3e td></tr></table>
2e90: 22 29 0a 09 09 28 70 72 69 6e 74 20 22 3c 2f 74 ")...(print "</t
2ea0: 64 3e 3c 74 64 20 76 61 6c 69 67 6e 3d 5c 22 74 d><td valign=\"t
2eb0: 6f 70 5c 22 3e 22 29 0a 09 09 3b 3b 20 50 72 69 op\">")...;; Pri
2ec0: 6e 74 20 6f 75 74 20 73 74 61 74 73 20 66 6f 72 nt out stats for
2ed0: 20 73 74 61 74 65 0a 09 09 28 73 65 74 21 20 74 state...(set! t
2ee0: 6f 74 20 30 29 0a 09 09 28 70 72 69 6e 74 20 22 ot 0)...(print "
2ef0: 3c 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 <table cellspaci
2f00: 6e 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d ng=\"0\" border=
2f10: 5c 22 31 5c 22 3e 3c 74 72 3e 3c 74 64 20 63 6f \"1\"><tr><td co
2f20: 6c 73 70 61 6e 3d 5c 22 32 5c 22 3e 3c 68 32 3e lspan=\"2\"><h2>
2f30: 53 74 61 74 75 73 20 73 74 61 74 73 3c 2f 68 32 Status stats</h2
2f40: 3e 3c 2f 74 64 3e 3c 2f 74 72 3e 22 29 0a 09 09 ></td></tr>")...
2f50: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
2f60: 61 20 28 73 74 61 74 75 73 29 0a 09 09 09 20 20 a (status)....
2f70: 20 20 28 73 65 74 21 20 74 6f 74 20 28 2b 20 74 (set! tot (+ t
2f80: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ot (hash-table-r
2f90: 65 66 20 63 6f 75 6e 74 73 20 73 74 61 74 75 73 ef counts status
2fa0: 29 29 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e ))).... (prin
2fb0: 74 20 22 3c 74 72 3e 3c 74 64 3e 3c 66 6f 6e 74 t "<tr><td><font
2fc0: 20 63 6f 6c 6f 72 3d 5c 22 22 20 28 63 6f 6d 6d color=\"" (comm
2fd0: 6f 6e 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 72 6f on:get-color-fro
2fe0: 6d 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 29 m-status status)
2ff0: 20 22 5c 22 3e 22 20 73 74 61 74 75 73 0a 09 09 "\">" status...
3000: 09 09 20 20 20 22 3c 2f 66 6f 6e 74 3e 3c 2f 74 .. "</font></t
3010: 64 3e 3c 74 64 3e 22 20 28 68 61 73 68 2d 74 61 d><td>" (hash-ta
3020: 62 6c 65 2d 72 65 66 20 63 6f 75 6e 74 73 20 73 ble-ref counts s
3030: 74 61 74 75 73 29 20 22 3c 2f 74 64 3e 3c 2f 74 tatus) "</td></t
3040: 72 3e 22 29 29 0a 09 09 09 20 20 28 68 61 73 68 r>")).... (hash
3050: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 63 6f 75 6e -table-keys coun
3060: 74 73 29 29 0a 09 09 28 70 72 69 6e 74 20 22 3c ts))...(print "<
3070: 74 72 3e 3c 74 64 3e 54 6f 74 61 6c 3c 2f 74 64 tr><td>Total</td
3080: 3e 3c 74 64 3e 22 20 74 6f 74 20 22 3c 2f 74 64 ><td>" tot "</td
3090: 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 3e 22 29 ></tr></table>")
30a0: 0a 09 09 28 70 72 69 6e 74 20 22 3c 2f 74 64 3e ...(print "</td>
30b0: 3c 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c </td></tr></tabl
30c0: 65 3e 22 29 0a 0a 09 09 28 70 72 69 6e 74 20 22 e>")....(print "
30d0: 3c 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 <table cellspaci
30e0: 6e 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d ng=\"0\" border=
30f0: 5c 22 31 5c 22 3e 22 20 0a 09 09 20 20 20 20 20 \"1\">" ...
3100: 20 20 22 3c 74 72 3e 3c 74 64 3e 49 74 65 6d 3c "<tr><td>Item<
3110: 2f 74 64 3e 3c 74 64 3e 53 74 61 74 65 3c 2f 74 /td><td>State</t
3120: 64 3e 3c 74 64 3e 53 74 61 74 75 73 3c 2f 74 64 d><td>Status</td
3130: 3e 3c 74 64 3e 43 6f 6d 6d 65 6e 74 3c 2f 74 64 ><td>Comment</td
3140: 3e 22 0a 09 09 20 20 20 20 20 20 20 6f 75 74 74 >"... outt
3150: 78 74 20 22 3c 2f 74 61 62 6c 65 3e 3c 2f 62 6f xt "</table></bo
3160: 64 79 3e 3c 2f 68 74 6d 6c 3e 22 29 0a 09 09 28 dy></html>")...(
3170: 72 65 6c 65 61 73 65 2d 64 6f 74 2d 6c 6f 63 6b release-dot-lock
3180: 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 outputfilename)
3190: 29 29 0a 09 20 20 20 20 28 63 6c 6f 73 65 2d 6f )).. (close-o
31a0: 75 74 70 75 74 2d 70 6f 72 74 20 6f 75 70 29 0a utput-port oup).
31b0: 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 . (change-dir
31c0: 65 63 74 6f 72 79 20 6f 72 69 67 2d 64 69 72 29 ectory orig-dir)
31d0: 0a 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d .. (test-set-
31e0: 74 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 toplog! db run-i
31f0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 6f 75 74 70 d test-name outp
3200: 75 74 66 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 utfilename)..
3210: 20 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 )))))..(define
3220: 28 67 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 (get-all-legal-t
3230: 65 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 ests). (let* ((
3240: 74 65 73 74 73 20 20 28 67 6c 6f 62 20 28 63 6f tests (glob (co
3250: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 74 nc *toppath* "/t
3260: 65 73 74 73 2f 2a 22 29 29 29 0a 09 20 28 72 65 ests/*"))).. (re
3270: 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 28 s '())). (
3280: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 debug:print 4 "I
3290: 4e 46 4f 3a 20 4c 6f 6f 6b 69 6e 67 20 61 74 20 NFO: Looking at
32a0: 74 65 73 74 73 20 22 20 28 73 74 72 69 6e 67 2d tests " (string-
32b0: 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 74 intersperse test
32c0: 73 20 22 2c 22 29 29 0a 20 20 20 20 28 66 6f 72 s ",")). (for
32d0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 -each (lambda (t
32e0: 65 73 74 70 61 74 68 29 0a 09 09 28 69 66 20 28 estpath)...(if (
32f0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f file-exists? (co
3300: 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 74 65 nc testpath "/te
3310: 73 74 63 6f 6e 66 69 67 22 29 29 0a 09 09 20 20 stconfig"))...
3320: 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e (set! res (con
3330: 73 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d s (last (string-
3340: 73 70 6c 69 74 20 74 65 73 74 70 61 74 68 20 22 split testpath "
3350: 2f 22 29 29 20 72 65 73 29 29 29 29 0a 09 20 20 /")) res))))..
3360: 20 20 20 20 74 65 73 74 73 29 0a 20 20 20 20 72 tests). r
3370: 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 es))..(define (t
3380: 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e ests:get-testcon
3390: 66 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 73 79 fig test-name sy
33a0: 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 29 0a 20 20 stem-allowed).
33b0: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 70 61 74 (let* ((test-pat
33c0: 68 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 h (conc *topp
33d0: 61 74 68 2a 20 22 2f 74 65 73 74 73 2f 22 20 74 ath* "/tests/" t
33e0: 65 73 74 2d 6e 61 6d 65 29 29 0a 09 20 28 74 65 est-name)).. (te
33f0: 73 74 2d 63 6f 6e 66 69 67 66 20 28 63 6f 6e 63 st-configf (conc
3400: 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 65 73 test-path "/tes
3410: 74 63 6f 6e 66 69 67 22 29 29 0a 09 20 28 74 65 tconfig")).. (te
3420: 73 74 65 78 69 73 74 73 20 20 20 28 61 6e 64 20 stexists (and
3430: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 (file-exists? te
3440: 73 74 2d 63 6f 6e 66 69 67 66 29 28 66 69 6c 65 st-configf)(file
3450: 2d 72 65 61 64 2d 61 63 63 65 73 73 3f 20 74 65 -read-access? te
3460: 73 74 2d 63 6f 6e 66 69 67 66 29 29 29 29 0a 20 st-configf)))).
3470: 20 20 20 28 69 66 20 74 65 73 74 65 78 69 73 74 (if testexist
3480: 73 0a 09 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 s..(read-config
3490: 74 65 73 74 2d 63 6f 6e 66 69 67 66 20 23 66 20 test-configf #f
34a0: 73 79 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 20 65 system-allowed e
34b0: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 28 69 66 nviron-patt: (if
34c0: 20 73 79 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 0a system-allowed.
34d0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 22 70 ........ "p
34e0: 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 re-launch-env-va
34f0: 72 73 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 rs".........
3500: 20 20 23 66 29 29 0a 09 23 66 29 29 29 0a 20 20 #f))..#f))).
3510: 0a 3b 3b 20 73 6f 72 74 20 74 65 73 74 73 20 62 .;; sort tests b
3520: 79 20 70 72 69 6f 72 69 74 79 20 61 6e 64 20 77 y priority and w
3530: 61 69 74 6f 6e 0a 3b 3b 20 4d 6f 76 65 20 74 65 aiton.;; Move te
3540: 73 74 20 73 70 65 63 69 66 69 63 20 73 74 75 66 st specific stuf
3550: 66 20 74 6f 20 61 20 74 65 73 74 20 75 6e 69 74 f to a test unit
3560: 20 46 49 58 4d 45 20 6f 6e 65 20 6f 66 20 74 68 FIXME one of th
3570: 65 73 65 20 64 61 79 73 0a 28 64 65 66 69 6e 65 ese days.(define
3580: 20 28 74 65 73 74 73 3a 73 6f 72 74 2d 62 79 2d (tests:sort-by-
3590: 70 72 69 6f 72 69 74 79 2d 61 6e 64 2d 77 61 69 priority-and-wai
35a0: 74 6f 6e 20 74 65 73 74 2d 72 65 63 6f 72 64 73 ton test-records
35b0: 29 0a 20 20 28 6c 65 74 20 28 28 6d 75 6e 67 65 ). (let ((munge
35c0: 70 72 69 6f 72 69 74 79 20 28 6c 61 6d 62 64 61 priority (lambda
35d0: 20 28 70 72 69 6f 72 69 74 79 29 0a 09 09 09 20 (priority)....
35e0: 28 69 66 20 70 72 69 6f 72 69 74 79 0a 09 09 09 (if priority....
35f0: 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 (let ((tmp
3600: 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 70 72 69 (any->number pri
3610: 6f 72 69 74 79 29 29 29 0a 09 09 09 20 20 20 20 ority)))....
3620: 20 20 20 28 69 66 20 74 6d 70 20 74 6d 70 20 28 (if tmp tmp (
3630: 62 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 begin (debug:pri
3640: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 62 61 64 nt 0 "ERROR: bad
3650: 20 70 72 69 6f 72 69 74 79 20 76 61 6c 75 65 20 priority value
3660: 22 20 70 72 69 6f 72 69 74 79 20 22 2c 20 75 73 " priority ", us
3670: 69 6e 67 20 30 22 29 20 30 29 29 29 0a 09 09 09 ing 0") 0)))....
3680: 20 20 20 20 20 30 29 29 29 29 0a 20 20 20 20 28 0)))). (
3690: 73 6f 72 74 20 0a 20 20 20 20 20 28 68 61 73 68 sort . (hash
36a0: 2d 74 61 62 6c 65 2d 6b 65 79 73 20 74 65 73 74 -table-keys test
36b0: 2d 72 65 63 6f 72 64 73 29 20 3b 3b 20 61 76 6f -records) ;; avo
36c0: 69 64 20 64 65 61 6c 69 6e 67 20 77 69 74 68 20 id dealing with
36d0: 64 65 6c 65 74 65 64 20 74 65 73 74 73 2c 20 6c deleted tests, l
36e0: 6f 6f 6b 20 61 74 20 74 68 65 20 68 61 73 68 20 ook at the hash
36f0: 74 61 62 6c 65 0a 20 20 20 20 20 28 6c 61 6d 62 table. (lamb
3700: 64 61 20 28 61 20 62 29 0a 20 20 20 20 20 20 20 da (a b).
3710: 28 6c 65 74 2a 20 28 28 61 2d 72 65 63 6f 72 64 (let* ((a-record
3720: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
3730: 65 66 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 ef test-records
3740: 61 29 29 0a 09 20 20 20 20 20 20 28 62 2d 72 65 a)).. (b-re
3750: 63 6f 72 64 20 20 20 28 68 61 73 68 2d 74 61 62 cord (hash-tab
3760: 6c 65 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f le-ref test-reco
3770: 72 64 73 20 62 29 29 0a 09 20 20 20 20 20 20 28 rds b)).. (
3780: 61 2d 77 61 69 74 6f 6e 73 20 20 28 74 65 73 74 a-waitons (test
3790: 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d s:testqueue-get-
37a0: 77 61 69 74 6f 6e 73 20 61 2d 72 65 63 6f 72 64 waitons a-record
37b0: 29 29 0a 09 20 20 20 20 20 20 28 62 2d 77 61 69 )).. (b-wai
37c0: 74 6f 6e 73 20 20 28 74 65 73 74 73 3a 74 65 73 tons (tests:tes
37d0: 74 71 75 65 75 65 2d 67 65 74 2d 77 61 69 74 6f tqueue-get-waito
37e0: 6e 73 20 62 2d 72 65 63 6f 72 64 29 29 0a 09 20 ns b-record))..
37f0: 20 20 20 20 20 28 61 2d 63 6f 6e 66 69 67 20 20 (a-config
3800: 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 (tests:testqueu
3810: 65 2d 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 e-get-testconfig
3820: 20 20 61 2d 72 65 63 6f 72 64 29 29 0a 09 20 20 a-record))..
3830: 20 20 20 20 28 62 2d 63 6f 6e 66 69 67 20 20 20 (b-config
3840: 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 (tests:testqueue
3850: 2d 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 -get-testconfig
3860: 20 62 2d 72 65 63 6f 72 64 29 29 0a 09 20 20 20 b-record))..
3870: 20 20 20 28 61 2d 72 61 77 2d 70 72 69 20 20 28 (a-raw-pri (
3880: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 61 2d config-lookup a-
3890: 63 6f 6e 66 69 67 20 22 72 65 71 75 69 72 65 6d config "requirem
38a0: 65 6e 74 73 22 20 22 70 72 69 6f 72 69 74 79 22 ents" "priority"
38b0: 29 29 0a 09 20 20 20 20 20 20 28 62 2d 72 61 77 )).. (b-raw
38c0: 2d 70 72 69 20 20 28 63 6f 6e 66 69 67 2d 6c 6f -pri (config-lo
38d0: 6f 6b 75 70 20 62 2d 63 6f 6e 66 69 67 20 22 72 okup b-config "r
38e0: 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 70 72 equirements" "pr
38f0: 69 6f 72 69 74 79 22 29 29 0a 09 20 20 20 20 20 iority"))..
3900: 20 28 61 2d 70 72 69 6f 72 69 74 79 20 28 6d 75 (a-priority (mu
3910: 6e 67 65 70 72 69 6f 72 69 74 79 20 61 2d 72 61 ngepriority a-ra
3920: 77 2d 70 72 69 29 29 0a 09 20 20 20 20 20 20 28 w-pri)).. (
3930: 62 2d 70 72 69 6f 72 69 74 79 20 28 6d 75 6e 67 b-priority (mung
3940: 65 70 72 69 6f 72 69 74 79 20 62 2d 72 61 77 2d epriority b-raw-
3950: 70 72 69 29 29 29 0a 09 3b 3b 20 20 28 64 65 62 pri)))..;; (deb
3960: 75 67 3a 70 72 69 6e 74 20 35 20 22 73 6f 72 74 ug:print 5 "sort
3970: 2d 62 79 2d 70 72 69 6f 72 69 74 79 2d 61 6e 64 -by-priority-and
3980: 2d 77 61 69 74 6f 6e 2c 20 61 3a 20 22 20 61 20 -waiton, a: " a
3990: 22 20 62 3a 20 22 20 62 0a 09 3b 3b 20 09 20 20 " b: " b..;; .
39a0: 20 20 20 20 22 5c 6e 20 20 20 20 20 61 2d 72 65 "\n a-re
39b0: 63 6f 72 64 3a 20 20 20 22 20 61 2d 72 65 63 6f cord: " a-reco
39c0: 72 64 20 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 rd ..;; . "
39d0: 5c 6e 20 20 20 20 20 62 2d 72 65 63 6f 72 64 3a \n b-record:
39e0: 20 20 20 22 20 62 2d 72 65 63 6f 72 64 0a 09 3b " b-record..;
39f0: 3b 20 09 20 20 20 20 20 20 22 5c 6e 20 20 20 20 ; . "\n
3a00: 20 61 2d 77 61 69 74 6f 6e 73 3a 20 20 22 20 61 a-waitons: " a
3a10: 2d 77 61 69 74 6f 6e 73 0a 09 3b 3b 20 09 20 20 -waitons..;; .
3a20: 20 20 20 20 22 5c 6e 20 20 20 20 20 62 2d 77 61 "\n b-wa
3a30: 69 74 6f 6e 73 3a 20 20 22 20 62 2d 77 61 69 74 itons: " b-wait
3a40: 6f 6e 73 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 ons..;; . "
3a50: 5c 6e 20 20 20 20 20 61 2d 63 6f 6e 66 69 67 3a \n a-config:
3a60: 20 20 20 22 20 28 68 61 73 68 2d 74 61 62 6c 65 " (hash-table
3a70: 2d 3e 61 6c 69 73 74 20 61 2d 63 6f 6e 66 69 67 ->alist a-config
3a80: 29 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e )..;; . "\n
3a90: 20 20 20 20 20 62 2d 63 6f 6e 66 69 67 3a 20 20 b-config:
3aa0: 20 22 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e " (hash-table->
3ab0: 61 6c 69 73 74 20 62 2d 63 6f 6e 66 69 67 29 0a alist b-config).
3ac0: 09 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e 20 20 .;; . "\n
3ad0: 20 20 20 61 2d 72 61 77 2d 70 72 69 3a 20 20 22 a-raw-pri: "
3ae0: 20 61 2d 72 61 77 2d 70 72 69 0a 09 3b 3b 20 09 a-raw-pri..;; .
3af0: 20 20 20 20 20 20 22 5c 6e 20 20 20 20 20 62 2d "\n b-
3b00: 72 61 77 2d 70 72 69 3a 20 20 22 20 62 2d 72 61 raw-pri: " b-ra
3b10: 77 2d 70 72 69 0a 09 3b 3b 20 09 20 20 20 20 20 w-pri..;; .
3b20: 20 22 5c 6e 20 20 20 20 20 61 2d 70 72 69 6f 72 "\n a-prior
3b30: 69 74 79 3a 20 22 20 61 2d 70 72 69 6f 72 69 74 ity: " a-priorit
3b40: 79 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e y..;; . "\n
3b50: 20 20 20 20 20 62 2d 70 72 69 6f 72 69 74 79 3a b-priority:
3b60: 20 22 20 62 2d 70 72 69 6f 72 69 74 79 29 0a 09 " b-priority)..
3b70: 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 (tests:testqueu
3b80: 65 2d 73 65 74 2d 70 72 69 6f 72 69 74 79 21 20 e-set-priority!
3b90: 61 2d 72 65 63 6f 72 64 20 61 2d 70 72 69 6f 72 a-record a-prior
3ba0: 69 74 79 29 0a 09 20 28 74 65 73 74 73 3a 74 65 ity).. (tests:te
3bb0: 73 74 71 75 65 75 65 2d 73 65 74 2d 70 72 69 6f stqueue-set-prio
3bc0: 72 69 74 79 21 20 62 2d 72 65 63 6f 72 64 20 62 rity! b-record b
3bd0: 2d 70 72 69 6f 72 69 74 79 29 0a 09 20 28 69 66 -priority).. (if
3be0: 20 28 61 6e 64 20 61 2d 77 61 69 74 6f 6e 73 20 (and a-waitons
3bf0: 28 6d 65 6d 62 65 72 20 28 74 65 73 74 73 3a 74 (member (tests:t
3c00: 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 estqueue-get-tes
3c10: 74 6e 61 6d 65 20 62 2d 72 65 63 6f 72 64 29 20 tname b-record)
3c20: 61 2d 77 61 69 74 6f 6e 73 29 29 0a 09 20 20 20 a-waitons))..
3c30: 20 20 23 66 20 3b 3b 20 63 61 6e 6e 6f 74 20 68 #f ;; cannot h
3c40: 61 76 65 20 61 20 77 68 69 63 68 20 69 73 20 77 ave a which is w
3c50: 61 69 74 69 6e 67 20 6f 6e 20 62 20 68 61 70 70 aiting on b happ
3c60: 65 6e 69 6e 67 20 62 65 66 6f 72 65 20 62 0a 09 ening before b..
3c70: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 62 2d (if (and b-
3c80: 77 61 69 74 6f 6e 73 20 28 6d 65 6d 62 65 72 20 waitons (member
3c90: 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 (tests:testqueue
3ca0: 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 61 2d -get-testname a-
3cb0: 72 65 63 6f 72 64 29 20 62 2d 77 61 69 74 6f 6e record) b-waiton
3cc0: 73 29 29 0a 09 09 20 23 74 20 3b 3b 20 74 68 69 s))... #t ;; thi
3cd0: 73 20 69 73 20 74 68 65 20 63 6f 72 72 65 63 74 s is the correct
3ce0: 20 6f 72 64 65 72 2c 20 62 20 69 73 20 77 61 69 order, b is wai
3cf0: 74 69 6e 67 20 6f 6e 20 61 20 61 6e 64 20 62 20 ting on a and b
3d00: 69 73 20 62 65 66 6f 72 65 20 61 0a 09 09 20 28 is before a... (
3d10: 69 66 20 28 3e 20 61 2d 70 72 69 6f 72 69 74 79 if (> a-priority
3d20: 20 62 2d 70 72 69 6f 72 69 74 79 29 0a 09 09 20 b-priority)...
3d30: 20 20 20 20 23 74 20 3b 3b 20 69 66 20 61 20 69 #t ;; if a i
3d40: 73 20 61 20 68 69 67 68 65 72 20 70 72 69 6f 72 s a higher prior
3d50: 69 74 79 20 74 68 61 6e 20 62 20 74 68 65 6e 20 ity than b then
3d60: 77 65 20 61 72 65 20 67 6f 6f 64 20 74 6f 20 67 we are good to g
3d70: 6f 0a 09 09 20 20 20 20 20 23 66 29 29 29 29 29 o... #f)))))
3d80: 29 29 29 0a 0a 3b 3b 20 66 6f 72 20 65 61 63 68 )))..;; for each
3d90: 20 74 65 73 74 3a 0a 3b 3b 20 20 20 0a 28 64 65 test:.;; .(de
3da0: 66 69 6e 65 20 28 74 65 73 74 73 3a 66 69 6c 74 fine (tests:filt
3db0: 65 72 2d 6e 6f 6e 2d 72 75 6e 6e 61 62 6c 65 20 er-non-runnable
3dc0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6b 65 db run-id testke
3dd0: 79 6e 61 6d 65 73 20 74 65 73 74 72 65 63 6f 72 ynames testrecor
3de0: 64 73 68 61 73 68 29 0a 20 20 28 6c 65 74 20 28 dshash). (let (
3df0: 28 72 75 6e 6e 61 62 6c 65 73 20 27 28 29 29 29 (runnables '()))
3e00: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 . (for-each.
3e10: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 (lambda (tes
3e20: 74 6b 65 79 6e 61 6d 65 29 0a 20 20 20 20 20 20 tkeyname).
3e30: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 72 65 (let* ((test-re
3e40: 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cord (hash-table
3e50: 2d 72 65 66 20 74 65 73 74 72 65 63 6f 72 64 73 -ref testrecords
3e60: 68 61 73 68 20 74 65 73 74 6b 65 79 6e 61 6d 65 hash testkeyname
3e70: 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 2d )).. (test-
3e80: 6e 61 6d 65 20 20 20 28 74 65 73 74 73 3a 74 65 name (tests:te
3e90: 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 stqueue-get-test
3ea0: 6e 61 6d 65 20 20 74 65 73 74 2d 72 65 63 6f 72 name test-recor
3eb0: 64 29 29 0a 09 20 20 20 20 20 20 28 69 74 65 6d d)).. (item
3ec0: 64 61 74 20 20 20 20 20 28 74 65 73 74 73 3a 74 dat (tests:t
3ed0: 65 73 74 71 75 65 75 65 2d 67 65 74 2d 69 74 65 estqueue-get-ite
3ee0: 6d 64 61 74 20 20 20 74 65 73 74 2d 72 65 63 6f mdat test-reco
3ef0: 72 64 29 29 0a 09 20 20 20 20 20 20 28 69 74 65 rd)).. (ite
3f00: 6d 2d 70 61 74 68 20 20 20 28 74 65 73 74 73 3a m-path (tests:
3f10: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 69 74 testqueue-get-it
3f20: 65 6d 5f 70 61 74 68 20 74 65 73 74 2d 72 65 63 em_path test-rec
3f30: 6f 72 64 29 29 0a 09 20 20 20 20 20 20 28 77 61 ord)).. (wa
3f40: 69 74 6f 6e 73 20 20 20 20 20 28 74 65 73 74 73 itons (tests
3f50: 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 77 :testqueue-get-w
3f60: 61 69 74 6f 6e 73 20 20 20 74 65 73 74 2d 72 65 aitons test-re
3f70: 63 6f 72 64 29 29 0a 09 20 20 20 20 20 20 28 6b cord)).. (k
3f80: 65 65 70 2d 74 65 73 74 20 20 20 23 74 29 0a 09 eep-test #t)..
3f90: 20 20 20 20 20 20 28 74 64 61 74 20 20 20 20 20 (tdat
3fa0: 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d (db:get-test-
3fb0: 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 info db run-id t
3fc0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
3fd0: 74 68 29 29 29 0a 09 20 28 69 66 20 74 64 61 74 th))).. (if tdat
3fe0: 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 .. (begin..
3ff0: 20 20 20 20 20 20 3b 3b 20 4c 6f 6f 6b 20 61 74 ;; Look at
4000: 20 74 68 65 20 74 65 73 74 20 73 74 61 74 65 20 the test state
4010: 61 6e 64 20 73 74 61 74 75 73 0a 09 20 20 20 20 and status..
4020: 20 20 20 28 69 66 20 28 6f 72 20 28 6d 65 6d 62 (if (or (memb
4030: 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d er (db:test-get-
4040: 73 74 61 74 75 73 20 74 64 61 74 29 20 0a 09 09 status tdat) ...
4050: 09 20 20 20 20 20 20 20 27 28 22 50 41 53 53 22 . '("PASS"
4060: 20 22 57 41 52 4e 22 20 22 57 41 49 56 45 44 22 "WARN" "WAIVED"
4070: 20 22 43 48 45 43 4b 22 29 29 0a 09 09 20 20 20 "CHECK"))...
4080: 20 20 20 20 28 6d 65 6d 62 65 72 20 28 64 62 3a (member (db:
4090: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
40a0: 64 61 74 29 0a 09 09 09 20 20 20 20 20 20 20 27 dat).... '
40b0: 28 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4b ("INCOMPLETE" "K
40c0: 49 4c 4c 45 44 22 29 29 29 0a 09 09 20 20 20 28 ILLED")))... (
40d0: 73 65 74 21 20 6b 65 65 70 2d 74 65 73 74 20 23 set! keep-test #
40e0: 66 29 29 0a 0a 09 20 20 20 20 20 20 20 3b 3b 20 f))... ;;
40f0: 65 78 61 6d 69 6e 65 20 77 61 69 74 6f 6e 73 20 examine waitons
4100: 66 6f 72 20 61 6e 79 20 66 61 69 6c 73 2e 20 49 for any fails. I
4110: 66 20 69 74 20 69 73 20 46 41 49 4c 20 6f 72 20 f it is FAIL or
4120: 49 4e 43 4f 4d 50 4c 45 54 45 20 74 68 65 6e 20 INCOMPLETE then
4130: 65 6c 69 6d 69 6e 61 74 65 20 74 68 69 73 20 74 eliminate this t
4140: 65 73 74 0a 09 20 20 20 20 20 20 20 3b 3b 20 66 est.. ;; f
4150: 72 6f 6d 20 74 68 65 20 72 75 6e 6e 61 62 6c 65 rom the runnable
4160: 20 6c 69 73 74 0a 09 20 20 20 20 20 20 20 28 69 list.. (i
4170: 66 20 6b 65 65 70 2d 74 65 73 74 0a 09 09 20 20 f keep-test...
4180: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
4190: 64 61 20 28 77 61 69 74 6f 6e 29 0a 09 09 09 20 da (waiton)....
41a0: 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 6e 6f 77 ;; for now
41b0: 20 77 65 20 61 72 65 20 77 61 69 74 69 6e 67 20 we are waiting
41c0: 6f 6e 6c 79 20 6f 6e 20 74 68 65 20 70 61 72 65 only on the pare
41d0: 6e 74 20 74 65 73 74 0a 09 09 09 20 20 20 20 20 nt test....
41e0: 20 20 28 6c 65 74 20 28 28 77 74 64 61 74 20 28 (let ((wtdat (
41f0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
4200: 20 64 62 20 72 75 6e 2d 69 64 20 77 61 69 74 6f db run-id waito
4210: 6e 20 22 22 29 29 29 20 0a 09 09 09 09 20 28 69 n ""))) ..... (i
4220: 66 20 28 6f 72 20 28 6d 65 6d 62 65 72 20 28 64 f (or (member (d
4230: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
4240: 73 20 77 74 64 61 74 29 0a 09 09 09 09 09 09 20 s wtdat).......
4250: 27 28 22 46 41 49 4c 22 20 22 4b 49 4c 4c 45 44 '("FAIL" "KILLED
4260: 22 29 29 0a 09 09 09 09 09 20 28 6d 65 6d 62 65 "))...... (membe
4270: 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 r (db:test-get-s
4280: 74 61 74 65 20 77 74 64 61 74 29 0a 09 09 09 09 tate wtdat).....
4290: 09 09 20 27 28 22 49 4e 43 4f 4d 50 45 54 45 22 .. '("INCOMPETE"
42a0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 73 65 )))..... (se
42b0: 74 21 20 6b 65 65 70 2d 74 65 73 74 20 23 66 29 t! keep-test #f)
42c0: 29 29 29 20 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 ))) ;; no point
42d0: 69 6e 20 72 75 6e 6e 69 6e 67 20 74 68 69 73 20 in running this
42e0: 6f 6e 65 20 61 67 61 69 6e 0a 09 09 09 20 20 20 one again....
42f0: 20 20 77 61 69 74 6f 6e 73 29 29 29 29 0a 09 20 waitons))))..
4300: 28 69 66 20 6b 65 65 70 2d 74 65 73 74 20 28 73 (if keep-test (s
4310: 65 74 21 20 72 75 6e 6e 61 62 6c 65 73 20 28 63 et! runnables (c
4320: 6f 6e 73 20 74 65 73 74 6b 65 79 6e 61 6d 65 20 ons testkeyname
4330: 72 75 6e 6e 61 62 6c 65 73 29 29 29 29 29 0a 20 runnables))))).
4340: 20 20 20 20 74 65 73 74 6b 65 79 6e 61 6d 65 73 testkeynames
4350: 29 0a 20 20 20 20 72 75 6e 6e 61 62 6c 65 73 29 ). runnables)
4360: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
4370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 74 ===========.;; t
43b0: 65 73 74 20 73 74 65 70 73 0a 3b 3b 3d 3d 3d 3d est steps.;;====
43c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
43f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4400: 3d 3d 0a 0a 3b 3b 20 74 65 73 74 73 74 65 70 2d ==..;; teststep-
4410: 73 65 74 2d 73 74 61 74 75 73 21 20 75 73 65 64 set-status! used
4420: 20 74 6f 20 62 65 20 68 65 72 65 0a 0a 28 64 65 to be here..(de
4430: 66 69 6e 65 20 28 74 65 73 74 2d 67 65 74 2d 6b fine (test-get-k
4440: 69 6c 6c 2d 72 65 71 75 65 73 74 20 64 62 20 72 ill-request db r
4450: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
4460: 69 74 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a itemdat). (let*
4470: 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 ((item-path (it
4480: 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 em-list->path it
4490: 65 6d 64 61 74 29 29 0a 09 20 28 74 65 73 74 64 emdat)).. (testd
44a0: 61 74 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 at (db:get-tes
44b0: 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 t-info db run-id
44c0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
44d0: 70 61 74 68 29 29 29 0a 20 20 20 20 28 65 71 75 path))). (equ
44e0: 61 6c 3f 20 28 74 65 73 74 3a 67 65 74 2d 73 74 al? (test:get-st
44f0: 61 74 65 20 74 65 73 74 64 61 74 29 20 22 4b 49 ate testdat) "KI
4500: 4c 4c 52 45 51 22 29 29 29 0a 0a 28 64 65 66 69 LLREQ")))..(defi
4510: 6e 65 20 28 74 65 73 74 2d 73 65 74 2d 6d 65 74 ne (test-set-met
4520: 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 a-info db run-id
4530: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 testname itemda
4540: 74 29 0a 20 20 28 6c 65 74 20 28 28 69 74 65 6d t). (let ((item
4550: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
4560: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
4570: 0a 09 28 63 70 75 6c 6f 61 64 20 20 28 67 65 74 ..(cpuload (get
4580: 2d 63 70 75 2d 6c 6f 61 64 29 29 0a 09 28 68 6f -cpu-load))..(ho
4590: 73 74 6e 61 6d 65 20 28 67 65 74 2d 68 6f 73 74 stname (get-host
45a0: 2d 6e 61 6d 65 29 29 0a 09 28 64 69 73 6b 66 72 -name))..(diskfr
45b0: 65 65 20 28 67 65 74 2d 64 66 20 28 63 75 72 72 ee (get-df (curr
45c0: 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 29 ent-directory)))
45d0: 0a 09 28 75 6e 61 6d 65 20 20 20 20 28 67 65 74 ..(uname (get
45e0: 2d 75 6e 61 6d 65 20 22 2d 73 72 76 70 69 6f 22 -uname "-srvpio"
45f0: 29 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 ))). (sqlite3
4600: 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 :execute db "UPD
4610: 41 54 45 20 74 65 73 74 73 20 53 45 54 20 68 6f ATE tests SET ho
4620: 73 74 3d 3f 2c 63 70 75 6c 6f 61 64 3d 3f 2c 64 st=?,cpuload=?,d
4630: 69 73 6b 66 72 65 65 3d 3f 2c 75 6e 61 6d 65 3d iskfree=?,uname=
4640: 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f ? WHERE run_id=?
4650: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
4660: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b AND item_path=?;
4670: 22 0a 09 09 20 20 68 6f 73 74 6e 61 6d 65 0a 09 "... hostname..
4680: 09 20 20 63 70 75 6c 6f 61 64 0a 09 09 20 20 64 . cpuload... d
4690: 69 73 6b 66 72 65 65 0a 09 09 20 20 75 6e 61 6d iskfree... unam
46a0: 65 0a 09 09 20 20 72 75 6e 2d 69 64 0a 09 09 20 e... run-id...
46b0: 20 74 65 73 74 6e 61 6d 65 0a 09 09 20 20 69 74 testname... it
46c0: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 3b 3b 3d 3d em-path)))..;;==
46d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
46f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4710: 3d 3d 3d 3d 0a 3b 3b 20 41 20 52 20 43 20 48 20 ====.;; A R C H
4720: 49 20 56 20 49 20 4e 20 47 0a 3b 3b 3d 3d 3d 3d I V I N G.;;====
4730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4770: 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ==..(define (tes
4780: 74 3a 61 72 63 68 69 76 65 20 64 62 20 74 65 73 t:archive db tes
4790: 74 2d 69 64 29 0a 20 20 23 66 29 0a 0a 28 64 65 t-id). #f)..(de
47a0: 66 69 6e 65 20 28 74 65 73 74 3a 61 72 63 68 69 fine (test:archi
47b0: 76 65 2d 74 65 73 74 73 20 64 62 20 6b 65 79 6e ve-tests db keyn
47c0: 61 6d 65 73 20 74 61 72 67 65 74 29 0a 20 20 23 ames target). #
47d0: 66 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d f)..;;==========
47e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
47f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4810: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
4820: 52 20 50 20 43 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d R P C.;;========
4830: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4840: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
4870: 28 64 65 66 69 6e 65 20 28 72 74 65 73 74 73 3a (define (rtests:
4880: 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 64 62 register-test db
4890: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
48a0: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
48b0: 69 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 20 if *runremote*.
48c0: 20 20 20 20 20 28 6c 65 74 20 28 28 68 6f 73 74 (let ((host
48d0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a 72 75 (vector-ref *ru
48e0: 6e 72 65 6d 6f 74 65 2a 20 30 29 29 0a 09 20 20 nremote* 0))..
48f0: 20 20 28 70 6f 72 74 20 28 76 65 63 74 6f 72 2d (port (vector-
4900: 72 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 ref *runremote*
4910: 31 29 29 29 0a 09 28 28 72 70 63 3a 70 72 6f 63 1)))..((rpc:proc
4920: 65 64 75 72 65 20 27 72 74 65 73 74 73 3a 72 65 edure 'rtests:re
4930: 67 69 73 74 65 72 2d 74 65 73 74 20 68 6f 73 74 gister-test host
4940: 20 70 6f 72 74 29 20 72 75 6e 2d 69 64 20 74 65 port) run-id te
4950: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
4960: 68 29 29 0a 20 20 20 20 20 20 28 74 65 73 74 73 h)). (tests
4970: 3a 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 64 :register-test d
4980: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
4990: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a me item-path))).
49a0: 0a 28 64 65 66 69 6e 65 20 28 72 74 65 73 74 73 .(define (rtests
49b0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
49c0: 21 20 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 ! db test-id st
49d0: 61 74 65 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 ate status comme
49e0: 6e 74 20 64 61 74 29 0a 20 20 28 69 66 20 2a 72 nt dat). (if *r
49f0: 75 6e 72 65 6d 6f 74 65 2a 0a 20 20 20 20 20 20 unremote*.
4a00: 28 6c 65 74 20 28 28 68 6f 73 74 20 28 76 65 63 (let ((host (vec
4a10: 74 6f 72 2d 72 65 66 20 2a 72 75 6e 72 65 6d 6f tor-ref *runremo
4a20: 74 65 2a 20 30 29 29 0a 09 20 20 20 20 28 70 6f te* 0)).. (po
4a30: 72 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 2a rt (vector-ref *
4a40: 72 75 6e 72 65 6d 6f 74 65 2a 20 31 29 29 29 0a runremote* 1))).
4a50: 09 28 28 72 70 63 3a 70 72 6f 63 65 64 75 72 65 .((rpc:procedure
4a60: 20 27 72 74 65 73 74 73 3a 74 65 73 74 2d 73 65 'rtests:test-se
4a70: 74 2d 73 74 61 74 75 73 21 20 68 6f 73 74 20 70 t-status! host p
4a80: 6f 72 74 29 20 74 65 73 74 2d 69 64 20 73 74 61 ort) test-id sta
4a90: 74 65 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e te status commen
4aa0: 74 20 64 61 74 29 29 0a 20 20 20 20 20 20 28 74 t dat)). (t
4ab0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
4ac0: 64 62 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 db test-id state
4ad0: 20 73 74 61 74 75 73 20 63 6f 6d 6d 65 6e 74 20 status comment
4ae0: 64 61 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 dat)))..(define
4af0: 28 72 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (rtests:test-set
4b00: 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d -toplog! db run-
4b10: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 6c 6f 67 id test-name log
4b20: 66 29 0a 20 20 28 69 66 20 2a 72 75 6e 72 65 6d f). (if *runrem
4b30: 6f 74 65 2a 0a 20 20 20 20 20 20 28 6c 65 74 20 ote*. (let
4b40: 28 28 68 6f 73 74 20 28 76 65 63 74 6f 72 2d 72 ((host (vector-r
4b50: 65 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 30 ef *runremote* 0
4b60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
4b70: 70 6f 72 74 20 28 76 65 63 74 6f 72 2d 72 65 66 port (vector-ref
4b80: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 31 29 29 *runremote* 1))
4b90: 29 0a 20 20 20 20 20 20 20 20 28 28 72 70 63 3a ). ((rpc:
4ba0: 70 72 6f 63 65 64 75 72 65 20 27 72 74 65 73 74 procedure 'rtest
4bb0: 73 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c 6f s:test-set-toplo
4bc0: 67 21 20 68 6f 73 74 20 70 6f 72 74 29 20 72 75 g! host port) ru
4bd0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 6c n-id test-name l
4be0: 6f 67 66 29 29 0a 20 20 20 20 20 20 28 74 65 73 ogf)). (tes
4bf0: 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 62 t-set-toplog! db
4c00: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
4c10: 65 20 6c 6f 67 66 29 29 29 0a 0a e logf)))..