0000: 28 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 (use sqlite3 srf
0010: 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 i-1 posix regex
0020: 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d regex-case srfi-
0030: 36 39 20 64 6f 74 2d 6c 6f 63 6b 69 6e 67 29 0a 69 dot-locking).
0040: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
0050: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
0060: 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e ))..(declare (un
0070: 69 74 20 74 65 73 74 73 29 29 0a 28 64 65 63 6c it tests)).(decl
0080: 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 are (uses db)).(
0090: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
00a0: 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 mmon)).(declare
00b0: 28 75 73 65 73 20 69 74 65 6d 73 29 29 0a 28 64 (uses items)).(d
00c0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 75 6e eclare (uses run
00d0: 63 6f 6e 66 69 67 29 29 0a 0a 28 69 6e 63 6c 75 config))..(inclu
00e0: 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 de "common_recor
00f0: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
0100: 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 e "key_records.s
0110: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 cm").(include "d
0120: 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a b_records.scm").
0130: 28 69 6e 63 6c 75 64 65 20 22 72 75 6e 5f 72 65 (include "run_re
0140: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 cords.scm").(inc
0150: 6c 75 64 65 20 22 74 65 73 74 5f 72 65 63 6f 72 lude "test_recor
0160: 64 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e ds.scm")..(defin
0170: 65 20 28 72 65 67 69 73 74 65 72 2d 74 65 73 74 e (register-test
0180: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d db run-id test-
0190: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a name item-path).
01a0: 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d 70 61 (let ((item-pa
01b0: 74 68 73 20 28 69 66 20 28 65 71 75 61 6c 3f 20 ths (if (equal?
01c0: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 item-path "")...
01d0: 09 28 6c 69 73 74 20 69 74 65 6d 2d 70 61 74 68 .(list item-path
01e0: 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d 2d )....(list item-
01f0: 70 61 74 68 20 22 22 29 29 29 29 0a 20 20 20 20 path "")))).
0200: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each .
0210: 28 6c 61 6d 62 64 61 20 28 70 74 68 29 0a 20 20 (lambda (pth).
0220: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
0230: 65 63 75 74 65 20 64 62 20 22 49 4e 53 45 52 54 ecute db "INSERT
0240: 20 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 OR IGNORE INTO
0250: 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 tests (run_id,te
0260: 73 74 6e 61 6d 65 2c 65 76 65 6e 74 5f 74 69 6d stname,event_tim
0270: 65 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 e,item_path,stat
0280: 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 45 53 e,status) VALUES
0290: 20 28 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 27 (?,?,strftime('
02a0: 25 73 27 2c 27 6e 6f 77 27 29 2c 3f 2c 27 4e 4f %s','now'),?,'NO
02b0: 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 2f 61 27 T_STARTED','n/a'
02c0: 29 3b 22 20 0a 09 09 09 72 75 6e 2d 69 64 20 0a );" ....run-id .
02d0: 09 09 09 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09 ...test-name....
02e0: 70 74 68 20 0a 09 09 09 3b 3b 20 28 63 6f 6e 63 pth ....;; (conc
02f0: 20 22 2c 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "," (string-int
0300: 65 72 73 70 65 72 73 65 20 74 61 67 73 20 22 2c ersperse tags ",
0310: 22 29 20 22 2c 22 29 0a 09 09 09 29 29 0a 20 20 ") ",")....)).
0320: 20 20 20 69 74 65 6d 2d 70 61 74 68 73 20 29 29 item-paths ))
0330: 29 0a 0a 3b 3b 20 67 65 74 20 74 68 65 20 70 72 )..;; get the pr
0340: 65 76 69 6f 75 73 20 72 65 63 6f 72 64 20 66 6f evious record fo
0350: 72 20 77 68 65 6e 20 74 68 69 73 20 74 65 73 74 r when this test
0360: 20 77 61 73 20 72 75 6e 20 77 68 65 72 65 20 61 was run where a
0370: 6c 6c 20 6b 65 79 73 20 6d 61 74 63 68 20 62 75 ll keys match bu
0380: 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 72 65 74 t runname.;; ret
0390: 75 72 6e 73 20 23 66 20 69 66 20 6e 6f 20 73 75 urns #f if no su
03a0: 63 68 20 74 65 73 74 20 66 6f 75 6e 64 2c 20 72 ch test found, r
03b0: 65 74 75 72 6e 73 20 61 20 73 69 6e 67 6c 65 20 eturns a single
03c0: 74 65 73 74 20 72 65 63 6f 72 64 20 69 66 20 66 test record if f
03d0: 6f 75 6e 64 0a 28 64 65 66 69 6e 65 20 28 74 65 ound.(define (te
03e0: 73 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d st:get-previous-
03f0: 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 test-run-record
0400: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
0410: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 ame item-path).
0420: 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 (let* ((keys
0430: 20 28 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (db:get-keys db
0440: 29 29 0a 09 20 28 73 65 6c 73 74 72 20 20 28 73 )).. (selstr (s
0450: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
0460: 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 e (map (lambda (
0470: 78 29 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 x)(vector-ref x
0480: 30 29 29 20 6b 65 79 73 29 20 22 2c 22 29 29 0a 0)) keys) ",")).
0490: 09 20 28 71 72 79 73 74 72 20 20 28 73 74 72 69 . (qrystr (stri
04a0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
04b0: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 map (lambda (x)(
04c0: 63 6f 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 conc (vector-ref
04d0: 20 78 20 30 29 20 22 3d 3f 22 29 29 20 6b 65 79 x 0) "=?")) key
04e0: 73 29 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 s) " AND ")).. (
04f0: 6b 65 79 76 61 6c 73 20 23 66 29 29 0a 20 20 20 keyvals #f)).
0500: 20 3b 3b 20 66 69 72 73 74 20 6c 6f 6f 6b 20 75 ;; first look u
0510: 70 20 74 68 65 20 6b 65 79 20 76 61 6c 75 65 73 p the key values
0520: 20 66 72 6f 6d 20 74 68 65 20 72 75 6e 20 73 65 from the run se
0530: 6c 65 63 74 65 64 20 62 79 20 72 75 6e 2d 69 64 lected by run-id
0540: 0a 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
0550: 72 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 r-each-row .
0560: 20 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 (lambda (a . b)
0570: 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 . (set! ke
0580: 79 76 61 6c 73 20 28 63 6f 6e 73 20 61 20 62 29 yvals (cons a b)
0590: 29 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 )). db.
05a0: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 (conc "SELECT "
05b0: 73 65 6c 73 74 72 20 22 20 46 52 4f 4d 20 72 75 selstr " FROM ru
05c0: 6e 73 20 57 48 45 52 45 20 69 64 3d 3f 20 4f 52 ns WHERE id=? OR
05d0: 44 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d DER BY event_tim
05e0: 65 20 44 45 53 43 3b 22 29 20 72 75 6e 2d 69 64 e DESC;") run-id
05f0: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b ). (if (not k
0600: 65 79 76 61 6c 73 29 0a 09 23 66 0a 09 28 6c 65 eyvals)..#f..(le
0610: 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 t ((prev-run-ids
0620: 20 27 28 29 29 29 0a 09 20 20 28 61 70 70 6c 79 '())).. (apply
0630: 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 sqlite3:for-eac
0640: 68 2d 72 6f 77 0a 09 09 20 28 6c 61 6d 62 64 61 h-row... (lambda
0650: 20 28 69 64 29 0a 09 09 20 20 20 28 73 65 74 21 (id)... (set!
0660: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 63 prev-run-ids (c
0670: 6f 6e 73 20 69 64 20 70 72 65 76 2d 72 75 6e 2d ons id prev-run-
0680: 69 64 73 29 29 29 0a 09 09 20 64 62 0a 09 09 20 ids)))... db...
0690: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 (conc "SELECT id
06a0: 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 FROM runs WHERE
06b0: 20 22 20 71 72 79 73 74 72 20 22 20 41 4e 44 20 " qrystr " AND
06c0: 69 64 20 21 3d 20 3f 3b 22 29 20 28 61 70 70 65 id != ?;") (appe
06d0: 6e 64 20 6b 65 79 76 61 6c 73 20 28 6c 69 73 74 nd keyvals (list
06e0: 20 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 3b 3b run-id))).. ;;
06f0: 20 66 6f 72 20 65 61 63 68 20 72 75 6e 20 73 74 for each run st
0700: 61 72 74 69 6e 67 20 77 69 74 68 20 74 68 65 20 arting with the
0710: 6d 6f 73 74 20 72 65 63 65 6e 74 20 6c 6f 6f 6b most recent look
0720: 20 74 6f 20 73 65 65 20 69 66 20 74 68 65 72 65 to see if there
0730: 20 69 73 20 61 20 6d 61 74 63 68 69 6e 67 20 74 is a matching t
0740: 65 73 74 0a 09 20 20 3b 3b 20 69 66 20 66 6f 75 est.. ;; if fou
0750: 6e 64 20 74 68 65 6e 20 72 65 74 75 72 6e 20 74 nd then return t
0760: 68 61 74 20 6d 61 74 63 68 69 6e 67 20 74 65 73 hat matching tes
0770: 74 20 72 65 63 6f 72 64 0a 09 20 20 28 64 65 62 t record.. (deb
0780: 75 67 3a 70 72 69 6e 74 20 34 20 22 73 65 6c 73 ug:print 4 "sels
0790: 74 72 3a 20 22 20 73 65 6c 73 74 72 20 22 2c 20 tr: " selstr ",
07a0: 71 72 79 73 74 72 3a 20 22 20 71 72 79 73 74 72 qrystr: " qrystr
07b0: 20 22 2c 20 6b 65 79 76 61 6c 73 3a 20 22 20 6b ", keyvals: " k
07c0: 65 79 76 61 6c 73 20 22 2c 20 70 72 65 76 69 6f eyvals ", previo
07d0: 75 73 20 72 75 6e 20 69 64 73 20 66 6f 75 6e 64 us run ids found
07e0: 3a 20 22 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 : " prev-run-ids
07f0: 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ).. (if (null?
0800: 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 23 66 prev-run-ids) #f
0810: 0a 09 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f .. (let loo
0820: 70 20 28 28 68 65 64 20 28 63 61 72 20 70 72 65 p ((hed (car pre
0830: 76 2d 72 75 6e 2d 69 64 73 29 29 0a 09 09 09 20 v-run-ids))....
0840: 28 74 61 6c 20 28 63 64 72 20 70 72 65 76 2d 72 (tal (cdr prev-r
0850: 75 6e 2d 69 64 73 29 29 29 0a 09 09 28 6c 65 74 un-ids)))...(let
0860: 20 28 28 72 65 73 75 6c 74 73 20 28 64 62 2d 67 ((results (db-g
0870: 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e et-tests-for-run
0880: 20 64 62 20 68 65 64 20 74 65 73 74 2d 6e 61 6d db hed test-nam
0890: 65 20 69 74 65 6d 2d 70 61 74 68 20 27 28 29 20 e item-path '()
08a0: 27 28 29 29 29 29 0a 09 09 20 20 28 64 65 62 75 '())))... (debu
08b0: 67 3a 70 72 69 6e 74 20 34 20 22 47 6f 74 20 74 g:print 4 "Got t
08c0: 65 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 20 ests for run-id
08d0: 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 " run-id ", test
08e0: 2d 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 6d -name " test-nam
08f0: 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 e ", item-path "
0900: 20 69 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 20 item-path ": "
0910: 72 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 results)... (if
0920: 20 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 73 (and (null? res
0930: 75 6c 74 73 29 0a 09 09 09 20 20 20 28 6e 6f 74 ults).... (not
0940: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 (null? tal)))..
0950: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
0960: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 r tal)(cdr tal))
0970: 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 6e 75 ... (if (nu
0980: 6c 6c 3f 20 72 65 73 75 6c 74 73 29 20 23 66 0a ll? results) #f.
0990: 09 09 09 20 20 28 63 61 72 20 72 65 73 75 6c 74 ... (car result
09a0: 73 29 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 s)))))))))).
09b0: 0a 3b 3b 20 67 65 74 20 74 68 65 20 70 72 65 76 .;; get the prev
09c0: 69 6f 75 73 20 72 65 63 6f 72 64 73 20 66 6f 72 ious records for
09d0: 20 77 68 65 6e 20 74 68 65 73 65 20 74 65 73 74 when these test
09e0: 73 20 77 65 72 65 20 72 75 6e 20 77 68 65 72 65 s were run where
09f0: 20 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 68 20 all keys match
0a00: 62 75 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b 20 4e but runname.;; N
0a10: 42 2f 2f 20 4d 65 72 67 65 20 74 68 69 73 20 77 B// Merge this w
0a20: 69 74 68 20 74 65 73 74 3a 67 65 74 2d 70 72 65 ith test:get-pre
0a30: 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 vious-test-run-r
0a40: 65 63 6f 72 64 73 3f 20 54 68 69 73 20 6f 6e 65 ecords? This one
0a50: 20 6c 6f 6f 6b 73 20 66 6f 72 20 61 6c 6c 20 6d looks for all m
0a60: 61 74 63 68 69 6e 67 20 74 65 73 74 73 0a 3b 3b atching tests.;;
0a70: 20 63 61 6e 20 75 73 65 20 77 69 6c 64 63 61 72 can use wildcar
0a80: 64 73 2e 20 0a 28 64 65 66 69 6e 65 20 28 74 65 ds. .(define (te
0a90: 73 74 3a 67 65 74 2d 6d 61 74 63 68 69 6e 67 2d st:get-matching-
0aa0: 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 previous-test-ru
0ab0: 6e 2d 72 65 63 6f 72 64 73 20 64 62 20 72 75 6e n-records db run
0ac0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
0ad0: 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 2a em-path). (let*
0ae0: 20 28 28 6b 65 79 73 20 20 20 20 28 64 62 3a 67 ((keys (db:g
0af0: 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 20 28 et-keys db)).. (
0b00: 73 65 6c 73 74 72 20 20 28 73 74 72 69 6e 67 2d selstr (string-
0b10: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
0b20: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 76 65 63 (lambda (x)(vec
0b30: 74 6f 72 2d 72 65 66 20 78 20 30 29 29 20 6b 65 tor-ref x 0)) ke
0b40: 79 73 29 20 22 2c 22 29 29 0a 09 20 28 71 72 79 ys) ",")).. (qry
0b50: 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 str (string-int
0b60: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
0b70: 61 6d 62 64 61 20 28 78 29 28 63 6f 6e 63 20 28 ambda (x)(conc (
0b80: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 20 vector-ref x 0)
0b90: 22 3d 3f 22 29 29 20 6b 65 79 73 29 20 22 20 41 "=?")) keys) " A
0ba0: 4e 44 20 22 29 29 0a 09 20 28 6b 65 79 76 61 6c ND ")).. (keyval
0bb0: 73 20 23 66 29 0a 09 20 28 74 65 73 74 73 2d 68 s #f).. (tests-h
0bc0: 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 ash (make-hash-t
0bd0: 61 62 6c 65 29 29 29 0a 20 20 20 20 3b 3b 20 66 able))). ;; f
0be0: 69 72 73 74 20 6c 6f 6f 6b 20 75 70 20 74 68 65 irst look up the
0bf0: 20 6b 65 79 20 76 61 6c 75 65 73 20 66 72 6f 6d key values from
0c00: 20 74 68 65 20 72 75 6e 20 73 65 6c 65 63 74 65 the run selecte
0c10: 64 20 62 79 20 72 75 6e 2d 69 64 0a 20 20 20 20 d by run-id.
0c20: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
0c30: 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c 61 6d h-row . (lam
0c40: 62 64 61 20 28 61 20 2e 20 62 29 0a 20 20 20 20 bda (a . b).
0c50: 20 20 20 28 73 65 74 21 20 6b 65 79 76 61 6c 73 (set! keyvals
0c60: 20 28 63 6f 6e 73 20 61 20 62 29 29 29 0a 20 20 (cons a b))).
0c70: 20 20 20 64 62 0a 20 20 20 20 20 28 63 6f 6e 63 db. (conc
0c80: 20 22 53 45 4c 45 43 54 20 22 20 73 65 6c 73 74 "SELECT " selst
0c90: 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 r " FROM runs WH
0ca0: 45 52 45 20 69 64 3d 3f 20 4f 52 44 45 52 20 42 ERE id=? ORDER B
0cb0: 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 44 45 53 Y event_time DES
0cc0: 43 3b 22 29 20 72 75 6e 2d 69 64 29 0a 20 20 20 C;") run-id).
0cd0: 20 28 69 66 20 28 6e 6f 74 20 6b 65 79 76 61 6c (if (not keyval
0ce0: 73 29 0a 09 27 28 29 0a 09 28 6c 65 74 20 28 28 s)..'()..(let ((
0cf0: 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 27 28 29 prev-run-ids '()
0d00: 29 29 0a 09 20 20 28 61 70 70 6c 79 20 73 71 6c )).. (apply sql
0d10: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
0d20: 77 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 69 64 w... (lambda (id
0d30: 29 0a 09 09 20 20 20 28 73 65 74 21 20 70 72 65 )... (set! pre
0d40: 76 2d 72 75 6e 2d 69 64 73 20 28 63 6f 6e 73 20 v-run-ids (cons
0d50: 69 64 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 id prev-run-ids)
0d60: 29 29 0a 09 09 20 64 62 0a 09 09 20 28 63 6f 6e ))... db... (con
0d70: 63 20 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f c "SELECT id FRO
0d80: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 22 20 71 M runs WHERE " q
0d90: 72 79 73 74 72 20 22 20 41 4e 44 20 69 64 20 21 rystr " AND id !
0da0: 3d 20 3f 3b 22 29 20 28 61 70 70 65 6e 64 20 6b = ?;") (append k
0db0: 65 79 76 61 6c 73 20 28 6c 69 73 74 20 72 75 6e eyvals (list run
0dc0: 2d 69 64 29 29 29 0a 09 20 20 3b 3b 20 63 6f 6c -id))).. ;; col
0dd0: 6c 65 63 74 20 61 6c 6c 20 6d 61 74 63 68 69 6e lect all matchin
0de0: 67 20 74 65 73 74 73 20 66 6f 72 20 74 68 65 20 g tests for the
0df0: 72 75 6e 73 20 74 68 65 6e 0a 09 20 20 3b 3b 20 runs then.. ;;
0e00: 65 78 74 72 61 63 74 20 74 68 65 20 6d 6f 73 74 extract the most
0e10: 20 72 65 63 65 6e 74 20 74 65 73 74 20 61 6e 64 recent test and
0e20: 20 72 65 74 75 72 6e 20 74 68 61 74 2e 0a 09 20 return that...
0e30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
0e40: 22 73 65 6c 73 74 72 3a 20 22 20 73 65 6c 73 74 "selstr: " selst
0e50: 72 20 22 2c 20 71 72 79 73 74 72 3a 20 22 20 71 r ", qrystr: " q
0e60: 72 79 73 74 72 20 22 2c 20 6b 65 79 76 61 6c 73 rystr ", keyvals
0e70: 3a 20 22 20 6b 65 79 76 61 6c 73 20 0a 09 09 20 : " keyvals ...
0e80: 20 20 20 20 20 20 22 2c 20 70 72 65 76 69 6f 75 ", previou
0e90: 73 20 72 75 6e 20 69 64 73 20 66 6f 75 6e 64 3a s run ids found:
0ea0: 20 22 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 " prev-run-ids)
0eb0: 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 .. (if (null? p
0ec0: 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 27 28 29 rev-run-ids) '()
0ed0: 20 20 3b 3b 20 6e 6f 20 70 72 65 76 69 6f 75 73 ;; no previous
0ee0: 20 72 75 6e 73 3f 20 72 65 74 75 72 6e 20 6e 75 runs? return nu
0ef0: 6c 6c 0a 09 20 20 20 20 20 20 28 6c 65 74 20 6c ll.. (let l
0f00: 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 70 oop ((hed (car p
0f10: 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 0a 09 09 rev-run-ids))...
0f20: 09 20 28 74 61 6c 20 28 63 64 72 20 70 72 65 76 . (tal (cdr prev
0f30: 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 28 6c -run-ids)))...(l
0f40: 65 74 20 28 28 72 65 73 75 6c 74 73 20 28 64 62 et ((results (db
0f50: 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 -get-tests-for-r
0f60: 75 6e 20 64 62 20 68 65 64 20 74 65 73 74 2d 6e un db hed test-n
0f70: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 27 28 ame item-path '(
0f80: 29 20 27 28 29 29 29 29 0a 09 09 20 20 28 64 65 ) '())))... (de
0f90: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 47 6f 74 bug:print 4 "Got
0fa0: 20 74 65 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 tests for run-i
0fb0: 64 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 d " run-id ", te
0fc0: 73 74 2d 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e st-name " test-n
0fd0: 61 6d 65 20 0a 09 09 09 20 20 20 20 20 20 20 22 ame .... "
0fe0: 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 69 74 , item-path " it
0ff0: 65 6d 2d 70 61 74 68 20 22 20 72 65 73 75 6c 74 em-path " result
1000: 73 3a 20 22 20 28 69 6e 74 65 72 73 70 65 72 73 s: " (interspers
1010: 65 20 72 65 73 75 6c 74 73 20 22 5c 6e 22 29 29 e results "\n"))
1020: 0a 09 09 20 20 3b 3b 20 4b 65 65 70 20 6f 6e 6c ... ;; Keep onl
1030: 79 20 74 68 65 20 79 6f 75 6e 67 65 73 74 20 6f y the youngest o
1040: 66 20 61 6e 79 20 74 65 73 74 2f 69 74 65 6d 20 f any test/item
1050: 63 6f 6d 62 69 6e 61 74 69 6f 6e 0a 09 09 20 20 combination...
1060: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 20 20 20 (for-each ...
1070: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 (lambda (testdat
1080: 29 0a 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 )... (let* (
1090: 28 66 75 6c 6c 2d 74 65 73 74 6e 61 6d 65 20 28 (full-testname (
10a0: 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 conc (db:test-ge
10b0: 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 64 t-testname testd
10c0: 61 74 29 20 22 2f 22 20 28 64 62 3a 74 65 73 74 at) "/" (db:test
10d0: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
10e0: 65 73 74 64 61 74 29 29 29 0a 09 09 09 20 20 20 estdat)))....
10f0: 20 28 73 74 6f 72 65 64 2d 74 65 73 74 20 20 20 (stored-test
1100: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1110: 64 65 66 61 75 6c 74 20 74 65 73 74 73 2d 68 61 default tests-ha
1120: 73 68 20 66 75 6c 6c 2d 74 65 73 74 6e 61 6d 65 sh full-testname
1130: 20 23 66 29 29 29 0a 09 09 20 20 20 20 20 20 20 #f)))...
1140: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 73 74 6f (if (or (not sto
1150: 72 65 64 2d 74 65 73 74 29 0a 09 09 09 20 20 20 red-test)....
1160: 20 20 20 20 28 61 6e 64 20 73 74 6f 72 65 64 2d (and stored-
1170: 74 65 73 74 0a 09 09 09 09 20 20 20 20 28 3e 20 test..... (>
1180: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
1190: 6e 74 5f 74 69 6d 65 20 74 65 73 74 64 61 74 29 nt_time testdat)
11a0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 (db:test-get-eve
11b0: 6e 74 5f 74 69 6d 65 20 73 74 6f 72 65 64 2d 74 nt_time stored-t
11c0: 65 73 74 29 29 29 29 0a 09 09 09 20 20 20 3b 3b est)))).... ;;
11d0: 20 74 68 69 73 20 74 65 73 74 20 69 73 20 79 6f this test is yo
11e0: 75 6e 67 65 72 2c 20 73 74 6f 72 65 20 69 74 20 unger, store it
11f0: 69 6e 20 74 68 65 20 68 61 73 68 0a 09 09 09 20 in the hash....
1200: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
1210: 74 21 20 74 65 73 74 73 2d 68 61 73 68 20 66 75 t! tests-hash fu
1220: 6c 6c 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 ll-testname test
1230: 64 61 74 29 29 29 29 0a 09 09 20 20 20 72 65 73 dat))))... res
1240: 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 28 6e ults)... (if (n
1250: 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 20 20 20 20 ull? tal)...
1260: 20 20 28 6d 61 70 20 63 64 72 20 28 68 61 73 68 (map cdr (hash
1270: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 74 65 -table->alist te
1280: 73 74 73 2d 68 61 73 68 29 29 20 3b 3b 20 72 65 sts-hash)) ;; re
1290: 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 20 74 turn a list of t
12a0: 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 he most recent t
12b0: 65 73 74 73 0a 09 09 20 20 20 20 20 20 28 6c 6f ests... (lo
12c0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
12d0: 20 74 61 6c 29 29 29 29 29 29 29 29 29 29 0a 0a tal))))))))))..
12e0: 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d 73 65 (define (test-se
12f0: 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 6e t-status! db run
1300: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 73 74 -id test-name st
1310: 61 74 65 20 73 74 61 74 75 73 20 69 74 65 6d 64 ate status itemd
1320: 61 74 2d 6f 72 2d 70 61 74 68 20 63 6f 6d 6d 65 at-or-path comme
1330: 6e 74 20 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 nt dat). (let*
1340: 28 28 72 65 61 6c 2d 73 74 61 74 75 73 20 73 74 ((real-status st
1350: 61 74 75 73 29 0a 09 20 28 69 74 65 6d 2d 70 61 atus).. (item-pa
1360: 74 68 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 th (if (string
1370: 3f 20 69 74 65 6d 64 61 74 2d 6f 72 2d 70 61 74 ? itemdat-or-pat
1380: 68 29 20 69 74 65 6d 64 61 74 2d 6f 72 2d 70 61 h) itemdat-or-pa
1390: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
13a0: 61 74 68 20 69 74 65 6d 64 61 74 2d 6f 72 2d 70 ath itemdat-or-p
13b0: 61 74 68 29 29 29 0a 09 20 28 74 65 73 74 64 61 ath))).. (testda
13c0: 74 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 t (db:get-te
13d0: 73 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 st-info db run-i
13e0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
13f0: 2d 70 61 74 68 29 29 0a 09 20 28 74 65 73 74 2d -path)).. (test-
1400: 69 64 20 20 20 20 20 28 69 66 20 74 65 73 74 64 id (if testd
1410: 61 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d at (db:test-get-
1420: 69 64 20 74 65 73 74 64 61 74 29 20 23 66 29 29 id testdat) #f))
1430: 0a 09 20 28 6f 74 68 65 72 64 61 74 20 20 20 20 .. (otherdat
1440: 28 69 66 20 64 61 74 20 64 61 74 20 28 6d 61 6b (if dat dat (mak
1450: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a e-hash-table))).
1460: 09 20 3b 3b 20 62 65 66 6f 72 65 20 70 72 6f 63 . ;; before proc
1470: 65 65 64 69 6e 67 20 77 65 20 6d 75 73 74 20 66 eeding we must f
1480: 69 6e 64 20 6f 75 74 20 69 66 20 74 68 65 20 70 ind out if the p
1490: 72 65 76 69 6f 75 73 20 74 65 73 74 20 28 77 68 revious test (wh
14a0: 65 72 65 20 61 6c 6c 20 6b 65 79 73 20 6d 61 74 ere all keys mat
14b0: 63 68 65 64 20 65 78 63 65 70 74 20 72 75 6e 6e ched except runn
14c0: 61 6d 65 29 0a 09 20 3b 3b 20 77 61 73 20 57 41 ame).. ;; was WA
14d0: 49 56 45 44 20 69 66 20 74 68 69 73 20 74 65 73 IVED if this tes
14e0: 74 20 69 73 20 46 41 49 4c 0a 09 20 28 77 61 69 t is FAIL.. (wai
14f0: 76 65 64 20 20 20 28 69 66 20 28 65 71 75 61 6c ved (if (equal
1500: 3f 20 73 74 61 74 75 73 20 22 46 41 49 4c 22 29 ? status "FAIL")
1510: 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
1520: 28 70 72 65 76 2d 74 65 73 74 20 28 74 65 73 74 (prev-test (test
1530: 3a 67 65 74 2d 70 72 65 76 69 6f 75 73 2d 74 65 :get-previous-te
1540: 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 20 64 62 st-run-record db
1550: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
1560: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 e item-path)))..
1570: 09 09 20 28 69 66 20 70 72 65 76 2d 74 65 73 74 .. (if prev-test
1580: 20 3b 3b 20 74 72 75 65 20 69 66 20 77 65 20 66 ;; true if we f
1590: 6f 75 6e 64 20 61 20 70 72 65 76 69 6f 75 73 20 ound a previous
15a0: 74 65 73 74 20 69 6e 20 74 68 69 73 20 72 75 6e test in this run
15b0: 20 73 65 72 69 65 73 0a 09 09 09 20 20 20 20 20 series....
15c0: 28 6c 65 74 20 28 28 70 72 65 76 2d 73 74 61 74 (let ((prev-stat
15d0: 75 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d us (db:test-get-
15e0: 73 74 61 74 75 73 20 20 20 70 72 65 76 2d 74 65 status prev-te
15f0: 73 74 29 29 0a 09 09 09 09 20 20 20 28 70 72 65 st))..... (pre
1600: 76 2d 73 74 61 74 65 20 20 28 64 62 3a 74 65 73 v-state (db:tes
1610: 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 70 t-get-state p
1620: 72 65 76 2d 74 65 73 74 29 29 0a 09 09 09 09 20 rev-test)).....
1630: 20 20 28 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 20 (prev-comment
1640: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d (db:test-get-com
1650: 6d 65 6e 74 20 70 72 65 76 2d 74 65 73 74 29 29 ment prev-test))
1660: 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 65 62 ).... (deb
1670: 75 67 3a 70 72 69 6e 74 20 34 20 22 70 72 65 76 ug:print 4 "prev
1680: 2d 73 74 61 74 75 73 20 22 20 70 72 65 76 2d 73 -status " prev-s
1690: 74 61 74 75 73 20 22 2c 20 70 72 65 76 2d 73 74 tatus ", prev-st
16a0: 61 74 65 20 22 20 70 72 65 76 2d 73 74 61 74 65 ate " prev-state
16b0: 20 22 2c 20 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 ", prev-comment
16c0: 20 22 20 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 29 " prev-comment)
16d0: 0a 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
16e0: 61 6e 64 20 28 65 71 75 61 6c 3f 20 70 72 65 76 and (equal? prev
16f0: 2d 73 74 61 74 65 20 20 22 43 4f 4d 50 4c 45 54 -state "COMPLET
1700: 45 44 22 29 0a 09 09 09 09 09 28 65 71 75 61 6c ED")......(equal
1710: 3f 20 70 72 65 76 2d 73 74 61 74 75 73 20 22 57 ? prev-status "W
1720: 41 49 56 45 44 22 29 29 0a 09 09 09 09 20 20 20 AIVED")).....
1730: 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 20 3b 3b 20 prev-comment ;;
1740: 77 61 69 76 65 64 20 69 73 20 65 69 74 68 65 72 waived is either
1750: 20 74 68 65 20 63 6f 6d 6d 65 6e 74 20 6f 72 20 the comment or
1760: 23 66 0a 09 09 09 09 20 20 20 23 66 29 29 0a 09 #f..... #f))..
1770: 09 09 20 20 20 20 20 23 66 29 29 0a 09 09 20 20 .. #f))...
1780: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 28 #f))). (
1790: 69 66 20 77 61 69 76 65 64 20 28 73 65 74 21 20 if waived (set!
17a0: 72 65 61 6c 2d 73 74 61 74 75 73 20 22 57 41 49 real-status "WAI
17b0: 56 45 44 22 29 29 0a 20 20 20 20 28 64 65 62 75 VED")). (debu
17c0: 67 3a 70 72 69 6e 74 20 34 20 22 72 65 61 6c 2d g:print 4 "real-
17d0: 73 74 61 74 75 73 20 22 20 72 65 61 6c 2d 73 74 status " real-st
17e0: 61 74 75 73 20 22 2c 20 77 61 69 76 65 64 20 22 atus ", waived "
17f0: 20 77 61 69 76 65 64 20 22 2c 20 73 74 61 74 75 waived ", statu
1800: 73 20 22 20 73 74 61 74 75 73 29 0a 0a 20 20 20 s " status)..
1810: 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 70 ;; update the p
1820: 72 69 6d 61 72 79 20 72 65 63 6f 72 64 20 49 46 rimary record IF
1830: 20 73 74 61 74 65 20 41 4e 44 20 73 74 61 74 75 state AND statu
1840: 73 20 61 72 65 20 64 65 66 69 6e 65 64 0a 20 20 s are defined.
1850: 20 20 28 69 66 20 28 61 6e 64 20 73 74 61 74 65 (if (and state
1860: 20 73 74 61 74 75 73 29 0a 09 28 73 71 6c 69 74 status)..(sqlit
1870: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
1880: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
1890: 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f state=?,status=?
18a0: 2c 65 76 65 6e 74 5f 74 69 6d 65 3d 73 74 72 66 ,event_time=strf
18b0: 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 time('%s','now')
18c0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
18d0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
18e0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 ND item_path=?;"
18f0: 20 0a 09 09 09 20 73 74 61 74 65 20 72 65 61 6c .... state real
1900: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 -status run-id t
1910: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
1920: 74 68 29 29 0a 0a 20 20 20 20 3b 3b 20 69 66 20 th)).. ;; if
1930: 73 74 61 74 75 73 20 69 73 20 22 41 55 54 4f 22 status is "AUTO"
1940: 20 74 68 65 6e 20 63 61 6c 6c 20 72 6f 6c 6c 75 then call rollu
1950: 70 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 p. (if (and t
1960: 65 73 74 2d 69 64 20 73 74 61 74 65 20 73 74 61 est-id state sta
1970: 74 75 73 20 28 65 71 75 61 6c 3f 20 73 74 61 74 tus (equal? stat
1980: 75 73 20 22 41 55 54 4f 22 29 29 20 0a 09 28 64 us "AUTO")) ..(d
1990: 62 3a 74 65 73 74 2d 64 61 74 61 2d 72 6f 6c 6c b:test-data-roll
19a0: 75 70 20 64 62 20 74 65 73 74 2d 69 64 20 73 74 up db test-id st
19b0: 61 74 75 73 29 29 0a 0a 20 20 20 20 3b 3b 20 61 atus)).. ;; a
19c0: 64 64 20 6d 65 74 61 64 61 74 61 20 28 6e 65 65 dd metadata (nee
19d0: 64 20 74 6f 20 64 6f 20 74 68 69 73 20 77 61 79 d to do this way
19e0: 20 74 6f 20 61 76 6f 69 64 20 53 51 4c 20 69 6e to avoid SQL in
19f0: 6a 65 63 74 69 6f 6e 20 69 73 73 75 65 73 29 0a jection issues).
1a00: 0a 20 20 20 20 3b 3b 20 3a 66 69 72 73 74 5f 65 . ;; :first_e
1a10: 72 72 0a 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 rr. ;; (let (
1a20: 28 76 61 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 (val (hash-table
1a30: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 -ref/default oth
1a40: 65 72 64 61 74 20 22 3a 66 69 72 73 74 5f 65 72 erdat ":first_er
1a50: 72 22 20 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 r" #f))). ;;
1a60: 20 20 28 69 66 20 76 61 6c 0a 20 20 20 20 3b 3b (if val. ;;
1a70: 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a (sqlite3:
1a80: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
1a90: 54 45 20 74 65 73 74 73 20 53 45 54 20 66 69 72 TE tests SET fir
1aa0: 73 74 5f 65 72 72 3d 3f 20 57 48 45 52 45 20 72 st_err=? WHERE r
1ab0: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
1ac0: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
1ad0: 70 61 74 68 3d 3f 3b 22 20 76 61 6c 20 72 75 6e path=?;" val run
1ae0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
1af0: 65 6d 2d 70 61 74 68 29 29 29 0a 20 20 20 20 3b em-path))). ;
1b00: 3b 20 0a 20 20 20 20 3b 3b 20 3b 3b 20 3a 66 69 ; . ;; ;; :fi
1b10: 72 73 74 5f 77 61 72 6e 0a 20 20 20 20 3b 3b 20 rst_warn. ;;
1b20: 28 6c 65 74 20 28 28 76 61 6c 20 28 68 61 73 68 (let ((val (hash
1b30: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
1b40: 6c 74 20 6f 74 68 65 72 64 61 74 20 22 3a 66 69 lt otherdat ":fi
1b50: 72 73 74 5f 77 61 72 6e 22 20 23 66 29 29 29 0a rst_warn" #f))).
1b60: 20 20 20 20 3b 3b 20 20 20 28 69 66 20 76 61 6c ;; (if val
1b70: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 73 . ;; (s
1b80: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
1b90: 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 b "UPDATE tests
1ba0: 53 45 54 20 66 69 72 73 74 5f 77 61 72 6e 3d 3f SET first_warn=?
1bb0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
1bc0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
1bd0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 ND item_path=?;"
1be0: 20 76 61 6c 20 72 75 6e 2d 69 64 20 74 65 73 74 val run-id test
1bf0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
1c00: 29 29 0a 0a 20 20 20 20 28 6c 65 74 20 28 28 63 )).. (let ((c
1c10: 61 74 65 67 6f 72 79 20 28 68 61 73 68 2d 74 61 ategory (hash-ta
1c20: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1c30: 6f 74 68 65 72 64 61 74 20 22 3a 63 61 74 65 67 otherdat ":categ
1c40: 6f 72 79 22 20 22 22 29 29 0a 09 20 20 28 76 61 ory" "")).. (va
1c50: 72 69 61 62 6c 65 20 28 68 61 73 68 2d 74 61 62 riable (hash-tab
1c60: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f le-ref/default o
1c70: 74 68 65 72 64 61 74 20 22 3a 76 61 72 69 61 62 therdat ":variab
1c80: 6c 65 22 20 22 22 29 29 0a 09 20 20 28 76 61 6c le" "")).. (val
1c90: 75 65 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c ue (hash-tabl
1ca0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 e-ref/default ot
1cb0: 68 65 72 64 61 74 20 22 3a 76 61 6c 75 65 22 20 herdat ":value"
1cc0: 20 20 20 23 66 29 29 0a 09 20 20 28 65 78 70 65 #f)).. (expe
1cd0: 63 74 65 64 20 28 68 61 73 68 2d 74 61 62 6c 65 cted (hash-table
1ce0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 -ref/default oth
1cf0: 65 72 64 61 74 20 22 3a 65 78 70 65 63 74 65 64 erdat ":expected
1d00: 22 20 23 66 29 29 0a 09 20 20 28 74 6f 6c 20 20 " #f)).. (tol
1d10: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
1d20: 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 ref/default othe
1d30: 72 64 61 74 20 22 3a 74 6f 6c 22 20 20 20 20 20 rdat ":tol"
1d40: 20 23 66 29 29 0a 09 20 20 28 75 6e 69 74 73 20 #f)).. (units
1d50: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
1d60: 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 ef/default other
1d70: 64 61 74 20 22 3a 75 6e 69 74 73 22 20 20 20 20 dat ":units"
1d80: 22 22 29 29 0a 09 20 20 28 74 79 70 65 20 20 20 "")).. (type
1d90: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1da0: 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 f/default otherd
1db0: 61 74 20 22 3a 74 79 70 65 22 20 20 20 20 20 22 at ":type" "
1dc0: 22 29 29 0a 09 20 20 28 64 63 6f 6d 6d 65 6e 74 ")).. (dcomment
1dd0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1de0: 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 /default otherda
1df0: 74 20 22 3a 63 6f 6d 6d 65 6e 74 22 20 20 22 22 t ":comment" ""
1e00: 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 ))). (debug
1e10: 3a 70 72 69 6e 74 20 34 20 0a 09 09 20 20 20 22 :print 4 ... "
1e20: 63 61 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 category: " cate
1e30: 67 6f 72 79 20 22 2c 20 76 61 72 69 61 62 6c 65 gory ", variable
1e40: 3a 20 22 20 76 61 72 69 61 62 6c 65 20 22 2c 20 : " variable ",
1e50: 76 61 6c 75 65 3a 20 22 20 76 61 6c 75 65 0a 09 value: " value..
1e60: 09 20 20 20 22 2c 20 65 78 70 65 63 74 65 64 3a . ", expected:
1e70: 20 22 20 65 78 70 65 63 74 65 64 20 22 2c 20 74 " expected ", t
1e80: 6f 6c 3a 20 22 20 74 6f 6c 20 22 2c 20 75 6e 69 ol: " tol ", uni
1e90: 74 73 3a 20 22 20 75 6e 69 74 73 29 0a 20 20 20 ts: " units).
1ea0: 20 20 20 28 69 66 20 28 61 6e 64 20 76 61 6c 75 (if (and valu
1eb0: 65 20 65 78 70 65 63 74 65 64 20 74 6f 6c 29 20 e expected tol)
1ec0: 3b 3b 20 61 6c 6c 20 74 68 72 65 65 20 72 65 71 ;; all three req
1ed0: 75 69 72 65 64 0a 09 20 20 28 64 62 3a 63 73 76 uired.. (db:csv
1ee0: 2d 3e 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 ->test-data db t
1ef0: 65 73 74 2d 69 64 20 0a 09 09 09 20 20 20 20 20 est-id ....
1f00: 28 63 6f 6e 63 20 63 61 74 65 67 6f 72 79 20 22 (conc category "
1f10: 2c 22 0a 09 09 09 09 20 20 20 76 61 72 69 61 62 ,"..... variab
1f20: 6c 65 20 22 2c 22 0a 09 09 09 09 20 20 20 76 61 le ","..... va
1f30: 6c 75 65 20 20 20 20 22 2c 22 0a 09 09 09 09 20 lue ",".....
1f40: 20 20 65 78 70 65 63 74 65 64 20 22 2c 22 0a 09 expected ","..
1f50: 09 09 09 20 20 20 74 6f 6c 20 20 20 20 20 20 22 ... tol "
1f60: 2c 22 0a 09 09 09 09 20 20 20 75 6e 69 74 73 20 ,"..... units
1f70: 20 20 20 22 2c 22 0a 09 09 09 09 20 20 20 64 63 ","..... dc
1f80: 6f 6d 6d 65 6e 74 20 22 2c 2c 22 20 3b 3b 20 65 omment ",," ;; e
1f90: 78 74 72 61 20 63 6f 6d 6d 61 20 66 6f 72 20 73 xtra comma for s
1fa0: 74 61 74 75 73 0a 09 09 09 09 20 20 20 74 79 70 tatus..... typ
1fb0: 65 20 20 20 20 20 29 29 29 29 0a 09 09 09 09 20 e )))).....
1fc0: 20 20 0a 20 20 20 20 3b 3b 20 6e 65 65 64 20 74 . ;; need t
1fd0: 6f 20 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 o update the top
1fe0: 20 74 65 73 74 20 72 65 63 6f 72 64 20 69 66 20 test record if
1ff0: 50 41 53 53 20 6f 72 20 46 41 49 4c 20 61 6e 64 PASS or FAIL and
2000: 20 74 68 69 73 20 69 73 20 61 20 73 75 62 74 65 this is a subte
2010: 73 74 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 st. (if (and
2020: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 (not (equal? ite
2030: 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 20 20 20 m-path ""))..
2040: 20 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 73 74 (or (equal? st
2050: 61 74 75 73 20 22 50 41 53 53 22 29 0a 09 09 20 atus "PASS")...
2060: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
2070: 57 41 52 4e 22 29 0a 09 09 20 28 65 71 75 61 6c WARN")... (equal
2080: 3f 20 73 74 61 74 75 73 20 22 46 41 49 4c 22 29 ? status "FAIL")
2090: 0a 09 09 20 28 65 71 75 61 6c 3f 20 73 74 61 74 ... (equal? stat
20a0: 75 73 20 22 57 41 49 56 45 44 22 29 0a 09 09 20 us "WAIVED")...
20b0: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
20c0: 52 55 4e 4e 49 4e 47 22 29 29 29 0a 09 28 62 65 RUNNING")))..(be
20d0: 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a gin.. (sqlite3:
20e0: 65 78 65 63 75 74 65 20 0a 09 20 20 20 64 62 0a execute .. db.
20f0: 09 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 . "UPDATE test
2100: 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s .
2110: 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 28 SET fail_count=(
2120: 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 SELECT count(id)
2130: 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 FROM tests WHER
2140: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
2150: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
2160: 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e em_path != '' AN
2170: 44 20 73 74 61 74 75 73 3d 27 46 41 49 4c 27 29 D status='FAIL')
2180: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ,.
2190: 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d 28 53 pass_count=(S
21a0: 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 ELECT count(id)
21b0: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
21c0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
21d0: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
21e0: 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 m_path != '' AND
21f0: 20 28 73 74 61 74 75 73 3d 27 50 41 53 53 27 20 (status='PASS'
2200: 4f 52 20 73 74 61 74 75 73 3d 27 57 41 52 4e 27 OR status='WARN'
2210: 20 4f 52 20 73 74 61 74 75 73 3d 27 57 41 49 56 OR status='WAIV
2220: 45 44 27 29 29 0a 20 20 20 20 20 20 20 20 20 20 ED')).
2230: 20 20 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d WHERE run_id=
2240: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f ? AND testname=?
2250: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 AND item_path='
2260: 27 3b 22 0a 09 20 20 20 72 75 6e 2d 69 64 20 74 ';".. run-id t
2270: 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 est-name run-id
2280: 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 test-name run-id
2290: 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 28 test-name).. (
22a0: 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 if (equal? statu
22b0: 73 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 s "RUNNING") ;;
22c0: 72 75 6e 6e 69 6e 67 20 74 61 6b 65 73 20 70 72 running takes pr
22d0: 69 6f 72 69 74 79 20 6f 76 65 72 20 61 6c 6c 20 iority over all
22e0: 6f 74 68 65 72 20 73 74 61 74 65 73 2c 20 66 6f other states, fo
22f0: 72 63 65 20 74 68 65 20 74 65 73 74 20 73 74 61 rce the test sta
2300: 74 65 20 74 6f 20 52 55 4e 4e 49 4e 47 0a 09 20 te to RUNNING..
2310: 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 (sqlite3:ex
2320: 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
2330: 20 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 tests SET state
2340: 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d =? WHERE run_id=
2350: 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f ? AND testname=?
2360: 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 27 AND item_path='
2370: 27 3b 22 20 22 52 55 4e 4e 49 4e 47 22 20 72 75 ';" "RUNNING" ru
2380: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
2390: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a . (sqlite3:
23a0: 65 78 65 63 75 74 65 0a 09 20 20 20 20 20 20 20 execute..
23b0: 64 62 0a 09 20 20 20 20 20 20 20 22 55 50 44 41 db.. "UPDA
23c0: 54 45 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 TE tests.
23d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e0: 53 45 54 20 73 74 61 74 65 3d 43 41 53 45 20 57 SET state=CASE W
23f0: 48 45 4e 20 28 53 45 4c 45 43 54 20 63 6f 75 6e HEN (SELECT coun
2400: 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 t(id) FROM tests
2410: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
2420: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
2430: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
2440: 27 27 20 41 4e 44 20 73 74 61 74 65 20 69 6e 20 '' AND state in
2450: 28 27 52 55 4e 4e 49 4e 47 27 2c 27 4e 4f 54 5f ('RUNNING','NOT_
2460: 53 54 41 52 54 45 44 27 29 29 20 3e 20 30 20 54 STARTED')) > 0 T
2470: 48 45 4e 20 0a 20 20 20 20 20 20 20 20 20 20 20 HEN .
2480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
2490: 52 55 4e 4e 49 4e 47 27 0a 20 20 20 20 20 20 20 RUNNING'.
24a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24b0: 45 4c 53 45 20 27 43 4f 4d 50 4c 45 54 45 44 27 ELSE 'COMPLETED'
24c0: 20 45 4e 44 2c 0a 20 20 20 20 20 20 20 20 20 20 END,.
24d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e0: 73 74 61 74 75 73 3d 43 41 53 45 20 57 48 45 4e status=CASE WHEN
24f0: 20 66 61 69 6c 5f 63 6f 75 6e 74 20 3e 20 30 20 fail_count > 0
2500: 54 48 45 4e 20 27 46 41 49 4c 27 20 57 48 45 4e THEN 'FAIL' WHEN
2510: 20 70 61 73 73 5f 63 6f 75 6e 74 20 3e 20 30 20 pass_count > 0
2520: 41 4e 44 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 AND fail_count=0
2530: 20 54 48 45 4e 20 27 50 41 53 53 27 20 45 4c 53 THEN 'PASS' ELS
2540: 45 20 27 55 4e 4b 4e 4f 57 4e 27 20 45 4e 44 0a E 'UNKNOWN' END.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 6e WHERE run
2570: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
2580: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
2590: 74 68 3d 27 27 3b 22 0a 09 20 20 20 20 20 20 20 th='';"..
25a0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
25b0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
25c0: 65 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f e)))). (if (o
25d0: 72 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 r (and (string?
25e0: 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 28 73 74 72 comment)... (str
25f0: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 ing-match (regex
2600: 70 20 22 5c 5c 53 2b 22 29 20 63 6f 6d 6d 65 6e p "\\S+") commen
2610: 74 29 29 0a 09 20 20 20 20 77 61 69 76 65 64 29 t)).. waived)
2620: 0a 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ..(sqlite3:execu
2630: 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 te db "UPDATE te
2640: 73 74 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 3d sts SET comment=
2650: 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f ? WHERE run_id=?
2660: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
2670: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b AND item_path=?;
2680: 22 0a 09 09 09 20 28 69 66 20 77 61 69 76 65 64 ".... (if waived
2690: 20 77 61 69 76 65 64 20 63 6f 6d 6d 65 6e 74 29 waived comment)
26a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
26b0: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 20 20 e item-path)).
26c0: 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ))..(define (t
26d0: 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 est-set-log! db
26e0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
26f0: 20 69 74 65 6d 64 61 74 20 6c 6f 67 66 29 20 0a itemdat logf) .
2700: 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d 70 61 (let ((item-pa
2710: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
2720: 61 74 68 20 69 74 65 6d 64 61 74 29 29 29 0a 20 ath itemdat))).
2730: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
2740: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
2750: 65 73 74 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c ests SET final_l
2760: 6f 67 66 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f ogf=? WHERE run_
2770: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
2780: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
2790: 68 3d 3f 3b 22 20 0a 09 09 20 20 20 20 20 6c 6f h=?;" ... lo
27a0: 67 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e gf run-id test-n
27b0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
27c0: 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d ..(define (test-
27d0: 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 set-toplog! db r
27e0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
27f0: 6c 6f 67 66 29 20 0a 20 20 28 73 71 6c 69 74 65 logf) . (sqlite
2800: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 3:execute db "UP
2810: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 66 DATE tests SET f
2820: 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 45 52 inal_logf=? WHER
2830: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
2840: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
2850: 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 0a 09 09 em_path='';" ...
2860: 20 20 20 6c 6f 67 66 20 72 75 6e 2d 69 64 20 74 logf run-id t
2870: 65 73 74 2d 6e 61 6d 65 29 29 0a 0a 28 64 65 66 est-name))..(def
2880: 69 6e 65 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 ine (tests:summa
2890: 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 75 rize-items db ru
28a0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 66 n-id test-name f
28b0: 6f 72 63 65 29 0a 20 20 3b 3b 20 69 66 20 6e 6f orce). ;; if no
28c0: 74 20 66 6f 72 63 65 20 74 68 65 6e 20 6f 6e 6c t force then onl
28d0: 79 20 75 70 64 61 74 65 20 74 68 65 20 72 65 63 y update the rec
28e0: 6f 72 64 20 69 66 20 6f 6e 65 20 6f 66 20 74 68 ord if one of th
28f0: 65 73 65 20 69 73 20 74 72 75 65 3a 0a 20 20 3b ese is true:. ;
2900: 3b 20 20 20 31 2e 20 6c 6f 67 66 20 69 73 20 22 ; 1. logf is "
2910: 6c 6f 67 2f 66 69 6e 61 6c 2e 6c 6f 67 0a 20 20 log/final.log.
2920: 3b 3b 20 20 20 32 2e 20 6c 6f 67 66 20 69 73 20 ;; 2. logf is
2930: 73 61 6d 65 20 61 73 20 6f 75 74 70 75 74 66 69 same as outputfi
2940: 6c 65 6e 61 6d 65 0a 20 20 28 6c 65 74 20 28 28 lename. (let ((
2950: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 28 outputfilename (
2960: 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 2d 72 conc "megatest-r
2970: 6f 6c 6c 75 70 2d 22 20 74 65 73 74 2d 6e 61 6d ollup-" test-nam
2980: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 28 6f 72 e ".html"))..(or
2990: 69 67 2d 64 69 72 20 20 20 20 20 20 20 28 63 75 ig-dir (cu
29a0: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
29b0: 29 0a 09 28 6c 6f 67 66 20 20 20 20 20 20 20 20 )..(logf
29c0: 20 20 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c #f)). (sql
29d0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
29e0: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
29f0: 28 70 61 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 (path final_logf
2a00: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6c ). (set! l
2a10: 6f 67 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a ogf final_logf).
2a20: 20 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 (if (dire
2a30: 63 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 ctory? path)..
2a40: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 (begin.. (p
2a50: 72 69 6e 74 20 22 46 6f 75 6e 64 20 70 61 74 68 rint "Found path
2a60: 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20 20 20 : " path)..
2a70: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
2a80: 79 20 70 61 74 68 29 29 0a 09 20 20 20 20 20 3b y path)).. ;
2a90: 3b 20 28 73 65 74 21 20 6f 75 74 70 75 74 66 69 ; (set! outputfi
2aa0: 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 20 70 61 74 lename (conc pat
2ab0: 68 20 22 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 h "/" outputfile
2ac0: 6e 61 6d 65 29 29 29 0a 09 20 20 20 28 70 72 69 name))).. (pri
2ad0: 6e 74 20 22 4e 6f 20 73 75 63 68 20 70 61 74 68 nt "No such path
2ae0: 3a 20 22 20 70 61 74 68 29 29 29 0a 20 20 20 20 : " path))).
2af0: 20 64 62 20 0a 20 20 20 20 20 22 53 45 4c 45 43 db . "SELEC
2b00: 54 20 72 75 6e 64 69 72 2c 66 69 6e 61 6c 5f 6c T rundir,final_l
2b10: 6f 67 66 20 46 52 4f 4d 20 74 65 73 74 73 20 57 ogf FROM tests W
2b20: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
2b30: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
2b40: 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a item_path='';".
2b50: 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 run-id test
2b60: 2d 6e 61 6d 65 29 0a 20 20 20 20 28 70 72 69 6e -name). (prin
2b70: 74 20 22 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 t "summarize-ite
2b80: 6d 73 20 77 69 74 68 20 6c 6f 67 66 20 22 20 6c ms with logf " l
2b90: 6f 67 66 29 0a 20 20 20 20 28 69 66 20 28 6f 72 ogf). (if (or
2ba0: 20 28 65 71 75 61 6c 3f 20 6c 6f 67 66 20 22 6c (equal? logf "l
2bb0: 6f 67 73 2f 66 69 6e 61 6c 2e 6c 6f 67 22 29 0a ogs/final.log").
2bc0: 09 20 20 20 20 28 65 71 75 61 6c 3f 20 6c 6f 67 . (equal? log
2bd0: 66 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 f outputfilename
2be0: 29 0a 09 20 20 20 20 66 6f 72 63 65 29 0a 09 28 ).. force)..(
2bf0: 62 65 67 69 6e 0a 09 20 20 28 69 66 20 28 6f 62 begin.. (if (ob
2c00: 74 61 69 6e 2d 64 6f 74 2d 6c 6f 63 6b 20 6f 75 tain-dot-lock ou
2c10: 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 31 20 32 tputfilename 1 2
2c20: 30 20 33 30 29 20 3b 3b 20 72 65 74 72 79 20 65 0 30) ;; retry e
2c30: 76 65 72 79 20 73 65 63 6f 6e 64 20 66 6f 72 20 very second for
2c40: 32 30 20 73 65 63 6f 6e 64 73 2c 20 63 61 6c 6c 20 seconds, call
2c50: 20 69 74 20 64 65 61 64 20 61 66 74 65 72 20 33 it dead after 3
2c60: 30 20 73 65 63 6f 6e 64 73 20 61 6e 64 20 73 74 0 seconds and st
2c70: 65 61 6c 20 74 68 65 20 6c 6f 63 6b 0a 09 20 20 eal the lock..
2c80: 20 20 20 20 28 70 72 69 6e 74 20 22 4f 62 74 61 (print "Obta
2c90: 69 6e 65 64 20 6c 6f 63 6b 20 66 6f 72 20 22 20 ined lock for "
2ca0: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 0a outputfilename).
2cb0: 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 . (print "F
2cc0: 61 69 6c 65 64 20 74 6f 20 6f 62 74 61 69 6e 20 ailed to obtain
2cd0: 6c 6f 63 6b 20 66 6f 72 20 22 20 6f 75 74 70 75 lock for " outpu
2ce0: 74 66 69 6c 65 6e 61 6d 65 29 29 0a 09 20 20 28 tfilename)).. (
2cf0: 6c 65 74 20 28 28 6f 75 70 20 20 20 20 28 6f 70 let ((oup (op
2d00: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f en-output-file o
2d10: 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 29 0a utputfilename)).
2d20: 09 09 28 63 6f 75 6e 74 73 20 28 6d 61 6b 65 2d ..(counts (make-
2d30: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 09 28 hash-table))...(
2d40: 73 74 61 74 65 63 6f 75 6e 74 73 20 28 6d 61 6b statecounts (mak
2d50: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table))..
2d60: 09 28 6f 75 74 74 78 74 20 22 22 29 0a 09 09 28 .(outtxt "")...(
2d70: 74 6f 74 20 20 20 20 30 29 29 0a 09 20 20 20 20 tot 0))..
2d80: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
2d90: 70 6f 72 74 0a 09 09 6f 75 70 0a 09 20 20 20 20 port...oup..
2da0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 28 (lambda ()...(
2db0: 73 65 74 21 20 6f 75 74 74 78 74 20 28 63 6f 6e set! outtxt (con
2dc0: 63 20 6f 75 74 74 78 74 20 22 3c 68 74 6d 6c 3e c outtxt "<html>
2dd0: 3c 74 69 74 6c 65 3e 53 75 6d 6d 61 72 79 3a 20 <title>Summary:
2de0: 22 20 74 65 73 74 2d 6e 61 6d 65 20 0a 09 09 09 " test-name ....
2df0: 09 20 20 20 22 3c 2f 74 69 74 6c 65 3e 3c 62 6f . "</title><bo
2e00: 64 79 3e 3c 68 32 3e 53 75 6d 6d 61 72 79 20 66 dy><h2>Summary f
2e10: 6f 72 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 or " test-name "
2e20: 3c 2f 68 32 3e 22 29 29 0a 09 09 28 73 71 6c 69 </h2>"))...(sqli
2e30: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
2e40: 20 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 69 64 ... (lambda (id
2e50: 20 69 74 65 6d 70 61 74 68 20 73 74 61 74 65 20 itempath state
2e60: 73 74 61 74 75 73 20 72 75 6e 5f 64 75 72 61 74 status run_durat
2e70: 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 ion logf comment
2e80: 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 )... (hash-tab
2e90: 6c 65 2d 73 65 74 21 20 63 6f 75 6e 74 73 20 73 le-set! counts s
2ea0: 74 61 74 75 73 20 28 2b 20 31 20 28 68 61 73 68 tatus (+ 1 (hash
2eb0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
2ec0: 6c 74 20 63 6f 75 6e 74 73 20 73 74 61 74 75 73 lt counts status
2ed0: 20 30 29 29 29 0a 09 09 20 20 20 28 68 61 73 68 0)))... (hash
2ee0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 74 61 74 -table-set! stat
2ef0: 65 63 6f 75 6e 74 73 20 73 74 61 74 65 20 28 2b ecounts state (+
2f00: 20 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 1 (hash-table-r
2f10: 65 66 2f 64 65 66 61 75 6c 74 20 73 74 61 74 65 ef/default state
2f20: 63 6f 75 6e 74 73 20 73 74 61 74 65 20 30 29 29 counts state 0))
2f30: 29 0a 09 09 20 20 20 28 73 65 74 21 20 6f 75 74 )... (set! out
2f40: 74 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 78 74 txt (conc outtxt
2f50: 20 22 3c 74 72 3e 22 0a 09 09 09 09 20 20 20 20 "<tr>".....
2f60: 20 20 22 3c 74 64 3e 3c 61 20 68 72 65 66 3d 5c "<td><a href=\
2f70: 22 22 20 69 74 65 6d 70 61 74 68 20 22 2f 22 20 "" itempath "/"
2f80: 6c 6f 67 66 20 22 5c 22 3e 20 22 20 69 74 65 6d logf "\"> " item
2f90: 70 61 74 68 20 22 3c 2f 61 3e 3c 2f 74 64 3e 22 path "</a></td>"
2fa0: 20 0a 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 ..... "<td
2fb0: 3e 22 20 73 74 61 74 65 20 20 20 20 22 3c 2f 74 >" state "</t
2fc0: 64 3e 22 20 0a 09 09 09 09 20 20 20 20 20 20 22 d>" ..... "
2fd0: 3c 74 64 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d <td><font color=
2fe0: 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f " (common:get-co
2ff0: 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 lor-from-status
3000: 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 status).....
3010: 20 20 22 3e 22 20 20 20 73 74 61 74 75 73 20 20 ">" status
3020: 20 22 3c 2f 66 6f 6e 74 3e 3c 2f 74 64 3e 22 0a "</font></td>".
3030: 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 3e 22 .... "<td>"
3040: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 63 6f 6d (if (equal? com
3050: 6d 65 6e 74 20 22 22 29 0a 09 09 09 09 09 09 20 ment "").......
3060: 22 26 6e 62 73 70 3b 22 0a 09 09 09 09 09 09 20 " ".......
3070: 63 6f 6d 6d 65 6e 74 29 20 22 3c 2f 74 64 3e 22 comment) "</td>"
3080: 0a 09 09 09 09 09 09 20 22 3c 2f 74 72 3e 22 29 ....... "</tr>")
3090: 29 29 0a 09 09 20 64 62 0a 09 09 20 22 53 45 4c ))... db... "SEL
30a0: 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 68 ECT id,item_path
30b0: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 72 75 ,state,status,ru
30c0: 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c n_duration,final
30d0: 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 _logf,comment FR
30e0: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 OM tests WHERE r
30f0: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
3100: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
3110: 70 61 74 68 20 21 3d 20 27 27 3b 22 0a 09 09 20 path != '';"...
3120: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
3130: 29 0a 0a 09 09 28 70 72 69 6e 74 20 22 3c 74 61 )....(print "<ta
3140: 62 6c 65 3e 3c 74 72 3e 3c 74 64 20 76 61 6c 69 ble><tr><td vali
3150: 67 6e 3d 5c 22 74 6f 70 5c 22 3e 22 29 0a 09 09 gn=\"top\">")...
3160: 3b 3b 20 50 72 69 6e 74 20 6f 75 74 20 73 74 61 ;; Print out sta
3170: 74 73 20 66 6f 72 20 73 74 61 74 75 73 0a 09 09 ts for status...
3180: 28 73 65 74 21 20 74 6f 74 20 30 29 0a 09 09 28 (set! tot 0)...(
3190: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
31a0: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
31b0: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 3c 74 72 border=\"1\"><tr
31c0: 3e 3c 74 64 20 63 6f 6c 73 70 61 6e 3d 5c 22 32 ><td colspan=\"2
31d0: 5c 22 3e 3c 68 32 3e 53 74 61 74 65 20 73 74 61 \"><h2>State sta
31e0: 74 73 3c 2f 68 32 3e 3c 2f 74 64 3e 3c 2f 74 72 ts</h2></td></tr
31f0: 3e 22 29 0a 09 09 28 66 6f 72 2d 65 61 63 68 20 >")...(for-each
3200: 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 29 0a (lambda (state).
3210: 09 09 09 20 20 20 20 28 73 65 74 21 20 74 6f 74 ... (set! tot
3220: 20 28 2b 20 74 6f 74 20 28 68 61 73 68 2d 74 61 (+ tot (hash-ta
3230: 62 6c 65 2d 72 65 66 20 73 74 61 74 65 63 6f 75 ble-ref statecou
3240: 6e 74 73 20 73 74 61 74 65 29 29 29 0a 09 09 09 nts state)))....
3250: 20 20 20 20 28 70 72 69 6e 74 20 22 3c 74 72 3e (print "<tr>
3260: 3c 74 64 3e 22 20 73 74 61 74 65 20 22 3c 2f 74 <td>" state "</t
3270: 64 3e 3c 74 64 3e 22 20 28 68 61 73 68 2d 74 61 d><td>" (hash-ta
3280: 62 6c 65 2d 72 65 66 20 73 74 61 74 65 63 6f 75 ble-ref statecou
3290: 6e 74 73 20 73 74 61 74 65 29 20 22 3c 2f 74 64 nts state) "</td
32a0: 3e 3c 2f 74 72 3e 22 29 29 0a 09 09 09 20 20 28 ></tr>")).... (
32b0: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
32c0: 73 74 61 74 65 63 6f 75 6e 74 73 29 29 0a 09 09 statecounts))...
32d0: 28 70 72 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e (print "<tr><td>
32e0: 54 6f 74 61 6c 3c 2f 74 64 3e 3c 74 64 3e 22 20 Total</td><td>"
32f0: 74 6f 74 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 3c tot "</td></tr><
3300: 2f 74 61 62 6c 65 3e 22 29 0a 09 09 28 70 72 69 /table>")...(pri
3310: 6e 74 20 22 3c 2f 74 64 3e 3c 74 64 20 76 61 6c nt "</td><td val
3320: 69 67 6e 3d 5c 22 74 6f 70 5c 22 3e 22 29 0a 09 ign=\"top\">")..
3330: 09 3b 3b 20 50 72 69 6e 74 20 6f 75 74 20 73 74 .;; Print out st
3340: 61 74 73 20 66 6f 72 20 73 74 61 74 65 0a 09 09 ats for state...
3350: 28 73 65 74 21 20 74 6f 74 20 30 29 0a 09 09 28 (set! tot 0)...(
3360: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
3370: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
3380: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 3c 74 72 border=\"1\"><tr
3390: 3e 3c 74 64 20 63 6f 6c 73 70 61 6e 3d 5c 22 32 ><td colspan=\"2
33a0: 5c 22 3e 3c 68 32 3e 53 74 61 74 75 73 20 73 74 \"><h2>Status st
33b0: 61 74 73 3c 2f 68 32 3e 3c 2f 74 64 3e 3c 2f 74 ats</h2></td></t
33c0: 72 3e 22 29 0a 09 09 28 66 6f 72 2d 65 61 63 68 r>")...(for-each
33d0: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 (lambda (status
33e0: 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 74 ).... (set! t
33f0: 6f 74 20 28 2b 20 74 6f 74 20 28 68 61 73 68 2d ot (+ tot (hash-
3400: 74 61 62 6c 65 2d 72 65 66 20 63 6f 75 6e 74 73 table-ref counts
3410: 20 73 74 61 74 75 73 29 29 29 0a 09 09 09 20 20 status)))....
3420: 20 20 28 70 72 69 6e 74 20 22 3c 74 72 3e 3c 74 (print "<tr><t
3430: 64 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d 5c 22 d><font color=\"
3440: 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f " (common:get-co
3450: 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 lor-from-status
3460: 73 74 61 74 75 73 29 20 22 5c 22 3e 22 20 73 74 status) "\">" st
3470: 61 74 75 73 0a 09 09 09 09 20 20 20 22 3c 2f 66 atus..... "</f
3480: 6f 6e 74 3e 3c 2f 74 64 3e 3c 74 64 3e 22 20 28 ont></td><td>" (
3490: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 hash-table-ref c
34a0: 6f 75 6e 74 73 20 73 74 61 74 75 73 29 20 22 3c ounts status) "<
34b0: 2f 74 64 3e 3c 2f 74 72 3e 22 29 29 0a 09 09 09 /td></tr>"))....
34c0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
34d0: 79 73 20 63 6f 75 6e 74 73 29 29 0a 09 09 28 70 ys counts))...(p
34e0: 72 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e 54 6f rint "<tr><td>To
34f0: 74 61 6c 3c 2f 74 64 3e 3c 74 64 3e 22 20 74 6f tal</td><td>" to
3500: 74 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 t "</td></tr></t
3510: 61 62 6c 65 3e 22 29 0a 09 09 28 70 72 69 6e 74 able>")...(print
3520: 20 22 3c 2f 74 64 3e 3c 2f 74 64 3e 3c 2f 74 72 "</td></td></tr
3530: 3e 3c 2f 74 61 62 6c 65 3e 22 29 0a 0a 09 09 28 ></table>")....(
3540: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
3550: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
3560: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 22 20 0a border=\"1\">" .
3570: 09 09 20 20 20 20 20 20 20 22 3c 74 72 3e 3c 74 .. "<tr><t
3580: 64 3e 49 74 65 6d 3c 2f 74 64 3e 3c 74 64 3e 53 d>Item</td><td>S
3590: 74 61 74 65 3c 2f 74 64 3e 3c 74 64 3e 53 74 61 tate</td><td>Sta
35a0: 74 75 73 3c 2f 74 64 3e 3c 74 64 3e 43 6f 6d 6d tus</td><td>Comm
35b0: 65 6e 74 3c 2f 74 64 3e 22 0a 09 09 20 20 20 20 ent</td>"...
35c0: 20 20 20 6f 75 74 74 78 74 20 22 3c 2f 74 61 62 outtxt "</tab
35d0: 6c 65 3e 3c 2f 62 6f 64 79 3e 3c 2f 68 74 6d 6c le></body></html
35e0: 3e 22 29 0a 09 09 28 72 65 6c 65 61 73 65 2d 64 >")...(release-d
35f0: 6f 74 2d 6c 6f 63 6b 20 6f 75 74 70 75 74 66 69 ot-lock outputfi
3600: 6c 65 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 28 lename))).. (
3610: 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 close-output-por
3620: 74 20 6f 75 70 29 0a 09 20 20 20 20 28 63 68 61 t oup).. (cha
3630: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 6f 72 nge-directory or
3640: 69 67 2d 64 69 72 29 0a 09 20 20 20 20 28 74 65 ig-dir).. (te
3650: 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 st-set-toplog! d
3660: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
3670: 6d 65 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d me outputfilenam
3680: 65 29 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 28 e).. )))))..(
3690: 64 65 66 69 6e 65 20 28 67 65 74 2d 61 6c 6c 2d define (get-all-
36a0: 6c 65 67 61 6c 2d 74 65 73 74 73 29 0a 20 20 28 legal-tests). (
36b0: 6c 65 74 2a 20 28 28 74 65 73 74 73 20 20 28 67 let* ((tests (g
36c0: 6c 6f 62 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 lob (conc *toppa
36d0: 74 68 2a 20 22 2f 74 65 73 74 73 2f 2a 22 29 29 th* "/tests/*"))
36e0: 29 0a 09 20 28 72 65 73 20 20 20 20 27 28 29 29 ).. (res '())
36f0: 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ). (debug:pri
3700: 6e 74 20 34 20 22 49 4e 46 4f 3a 20 4c 6f 6f 6b nt 4 "INFO: Look
3710: 69 6e 67 20 61 74 20 74 65 73 74 73 20 22 20 28 ing at tests " (
3720: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
3730: 73 65 20 74 65 73 74 73 20 22 2c 22 29 29 0a 20 se tests ",")).
3740: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
3750: 6d 62 64 61 20 28 74 65 73 74 70 61 74 68 29 0a mbda (testpath).
3760: 09 09 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 ..(if (file-exis
3770: 74 73 3f 20 28 63 6f 6e 63 20 74 65 73 74 70 61 ts? (conc testpa
3780: 74 68 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 th "/testconfig"
3790: 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 72 ))... (set! r
37a0: 65 73 20 28 63 6f 6e 73 20 28 6c 61 73 74 20 28 es (cons (last (
37b0: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 74 65 73 string-split tes
37c0: 74 70 61 74 68 20 22 2f 22 29 29 20 72 65 73 29 tpath "/")) res)
37d0: 29 29 29 0a 09 20 20 20 20 20 20 74 65 73 74 73 ))).. tests
37e0: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 ). res))..(de
37f0: 66 69 6e 65 20 28 74 65 73 74 3a 67 65 74 2d 74 fine (test:get-t
3800: 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e estconfig test-n
3810: 61 6d 65 20 73 79 73 74 65 6d 2d 61 6c 6c 6f 77 ame system-allow
3820: 65 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 65 ed). (let* ((te
3830: 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e 63 st-path (conc
3840: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 74 65 73 *toppath* "/tes
3850: 74 73 2f 22 20 74 65 73 74 2d 6e 61 6d 65 29 29 ts/" test-name))
3860: 0a 09 20 28 74 65 73 74 2d 63 6f 6e 66 69 67 66 .. (test-configf
3870: 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 (conc test-path
3880: 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 29 "/testconfig"))
3890: 0a 09 20 28 74 65 73 74 65 78 69 73 74 73 20 20 .. (testexists
38a0: 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 (and (file-exis
38b0: 74 73 3f 20 74 65 73 74 2d 63 6f 6e 66 69 67 66 ts? test-configf
38c0: 29 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 65 )(file-read-acce
38d0: 73 73 3f 20 74 65 73 74 2d 63 6f 6e 66 69 67 66 ss? test-configf
38e0: 29 29 29 29 0a 20 20 20 20 28 69 66 20 74 65 73 )))). (if tes
38f0: 74 65 78 69 73 74 73 0a 09 28 72 65 61 64 2d 63 texists..(read-c
3900: 6f 6e 66 69 67 20 74 65 73 74 2d 63 6f 6e 66 69 onfig test-confi
3910: 67 66 20 23 66 20 73 79 73 74 65 6d 2d 61 6c 6c gf #f system-all
3920: 6f 77 65 64 20 65 6e 76 69 72 6f 6e 2d 70 61 74 owed environ-pat
3930: 74 3a 20 28 69 66 20 73 79 73 74 65 6d 2d 61 6c t: (if system-al
3940: 6c 6f 77 65 64 0a 09 09 09 09 09 09 09 09 20 20 lowed.........
3950: 20 20 20 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d "pre-launch-
3960: 65 6e 76 2d 76 61 72 73 22 0a 09 09 09 09 09 09 env-vars".......
3970: 09 09 20 20 20 20 20 20 23 66 29 29 0a 09 23 66 .. #f))..#f
3980: 29 29 29 0a 20 20 0a 3b 3b 20 73 6f 72 74 20 74 ))). .;; sort t
3990: 65 73 74 73 20 62 79 20 70 72 69 6f 72 69 74 79 ests by priority
39a0: 20 61 6e 64 20 77 61 69 74 6f 6e 0a 3b 3b 20 4d and waiton.;; M
39b0: 6f 76 65 20 74 65 73 74 20 73 70 65 63 69 66 69 ove test specifi
39c0: 63 20 73 74 75 66 66 20 74 6f 20 61 20 74 65 73 c stuff to a tes
39d0: 74 20 75 6e 69 74 20 46 49 58 4d 45 20 6f 6e 65 t unit FIXME one
39e0: 20 6f 66 20 74 68 65 73 65 20 64 61 79 73 0a 28 of these days.(
39f0: 64 65 66 69 6e 65 20 28 74 65 73 74 73 3a 73 6f define (tests:so
3a00: 72 74 2d 62 79 2d 70 72 69 6f 72 69 74 79 2d 61 rt-by-priority-a
3a10: 6e 64 2d 77 61 69 74 6f 6e 20 74 65 73 74 2d 72 nd-waiton test-r
3a20: 65 63 6f 72 64 73 29 0a 20 20 28 6c 65 74 20 28 ecords). (let (
3a30: 28 6d 75 6e 67 65 70 72 69 6f 72 69 74 79 20 28 (mungepriority (
3a40: 6c 61 6d 62 64 61 20 28 70 72 69 6f 72 69 74 79 lambda (priority
3a50: 29 0a 09 09 09 20 28 69 66 20 70 72 69 6f 72 69 ).... (if priori
3a60: 74 79 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 ty.... (let
3a70: 28 28 74 6d 70 20 28 61 6e 79 2d 3e 6e 75 6d 62 ((tmp (any->numb
3a80: 65 72 20 70 72 69 6f 72 69 74 79 29 29 29 0a 09 er priority)))..
3a90: 09 09 20 20 20 20 20 20 20 28 69 66 20 74 6d 70 .. (if tmp
3aa0: 20 74 6d 70 20 28 62 65 67 69 6e 20 28 64 65 62 tmp (begin (deb
3ab0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
3ac0: 52 3a 20 62 61 64 20 70 72 69 6f 72 69 74 79 20 R: bad priority
3ad0: 76 61 6c 75 65 20 22 20 70 72 69 6f 72 69 74 79 value " priority
3ae0: 20 22 2c 20 75 73 69 6e 67 20 30 22 29 20 30 29 ", using 0") 0)
3af0: 29 29 0a 09 09 09 20 20 20 20 20 30 29 29 29 29 )).... 0))))
3b00: 0a 20 20 20 20 28 73 6f 72 74 20 0a 20 20 20 20 . (sort .
3b10: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
3b20: 73 20 74 65 73 74 2d 72 65 63 6f 72 64 73 29 20 s test-records)
3b30: 3b 3b 20 61 76 6f 69 64 20 64 65 61 6c 69 6e 67 ;; avoid dealing
3b40: 20 77 69 74 68 20 64 65 6c 65 74 65 64 20 74 65 with deleted te
3b50: 73 74 73 2c 20 6c 6f 6f 6b 20 61 74 20 74 68 65 sts, look at the
3b60: 20 68 61 73 68 20 74 61 62 6c 65 0a 20 20 20 20 hash table.
3b70: 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 20 (lambda (a b).
3b80: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 61 2d (let* ((a-
3b90: 72 65 63 6f 72 64 20 20 20 28 68 61 73 68 2d 74 record (hash-t
3ba0: 61 62 6c 65 2d 72 65 66 20 74 65 73 74 2d 72 65 able-ref test-re
3bb0: 63 6f 72 64 73 20 61 29 29 0a 09 20 20 20 20 20 cords a))..
3bc0: 20 28 62 2d 72 65 63 6f 72 64 20 20 20 28 68 61 (b-record (ha
3bd0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 sh-table-ref tes
3be0: 74 2d 72 65 63 6f 72 64 73 20 62 29 29 0a 09 20 t-records b))..
3bf0: 20 20 20 20 20 28 61 2d 77 61 69 74 6f 6e 73 20 (a-waitons
3c00: 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 (tests:testqueu
3c10: 65 2d 67 65 74 2d 77 61 69 74 6f 6e 73 20 61 2d e-get-waitons a-
3c20: 72 65 63 6f 72 64 29 29 0a 09 20 20 20 20 20 20 record))..
3c30: 28 62 2d 77 61 69 74 6f 6e 73 20 20 28 74 65 73 (b-waitons (tes
3c40: 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 ts:testqueue-get
3c50: 2d 77 61 69 74 6f 6e 73 20 62 2d 72 65 63 6f 72 -waitons b-recor
3c60: 64 29 29 0a 09 20 20 20 20 20 20 28 61 2d 63 6f d)).. (a-co
3c70: 6e 66 69 67 20 20 20 28 74 65 73 74 73 3a 74 65 nfig (tests:te
3c80: 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 stqueue-get-test
3c90: 63 6f 6e 66 69 67 20 20 61 2d 72 65 63 6f 72 64 config a-record
3ca0: 29 29 0a 09 20 20 20 20 20 20 28 62 2d 63 6f 6e )).. (b-con
3cb0: 66 69 67 20 20 20 28 74 65 73 74 73 3a 74 65 73 fig (tests:tes
3cc0: 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 63 tqueue-get-testc
3cd0: 6f 6e 66 69 67 20 20 62 2d 72 65 63 6f 72 64 29 onfig b-record)
3ce0: 29 0a 09 20 20 20 20 20 20 28 61 2d 72 61 77 2d ).. (a-raw-
3cf0: 70 72 69 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f pri (config-loo
3d00: 6b 75 70 20 61 2d 63 6f 6e 66 69 67 20 22 72 65 kup a-config "re
3d10: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 70 72 69 quirements" "pri
3d20: 6f 72 69 74 79 22 29 29 0a 09 20 20 20 20 20 20 ority"))..
3d30: 28 62 2d 72 61 77 2d 70 72 69 20 20 28 63 6f 6e (b-raw-pri (con
3d40: 66 69 67 2d 6c 6f 6f 6b 75 70 20 62 2d 63 6f 6e fig-lookup b-con
3d50: 66 69 67 20 22 72 65 71 75 69 72 65 6d 65 6e 74 fig "requirement
3d60: 73 22 20 22 70 72 69 6f 72 69 74 79 22 29 29 0a s" "priority")).
3d70: 09 20 20 20 20 20 20 28 61 2d 70 72 69 6f 72 69 . (a-priori
3d80: 74 79 20 28 6d 75 6e 67 65 70 72 69 6f 72 69 74 ty (mungepriorit
3d90: 79 20 61 2d 72 61 77 2d 70 72 69 29 29 0a 09 20 y a-raw-pri))..
3da0: 20 20 20 20 20 28 62 2d 70 72 69 6f 72 69 74 79 (b-priority
3db0: 20 28 6d 75 6e 67 65 70 72 69 6f 72 69 74 79 20 (mungepriority
3dc0: 62 2d 72 61 77 2d 70 72 69 29 29 29 0a 09 3b 3b b-raw-pri)))..;;
3dd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 (debug:print 5
3de0: 20 22 73 6f 72 74 2d 62 79 2d 70 72 69 6f 72 69 "sort-by-priori
3df0: 74 79 2d 61 6e 64 2d 77 61 69 74 6f 6e 2c 20 61 ty-and-waiton, a
3e00: 3a 20 22 20 61 20 22 20 62 3a 20 22 20 62 0a 09 : " a " b: " b..
3e10: 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e 20 20 20 ;; . "\n
3e20: 20 20 61 2d 72 65 63 6f 72 64 3a 20 20 20 22 20 a-record: "
3e30: 61 2d 72 65 63 6f 72 64 20 0a 09 3b 3b 20 09 20 a-record ..;; .
3e40: 20 20 20 20 20 22 5c 6e 20 20 20 20 20 62 2d 72 "\n b-r
3e50: 65 63 6f 72 64 3a 20 20 20 22 20 62 2d 72 65 63 ecord: " b-rec
3e60: 6f 72 64 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 ord..;; . "
3e70: 5c 6e 20 20 20 20 20 61 2d 77 61 69 74 6f 6e 73 \n a-waitons
3e80: 3a 20 20 22 20 61 2d 77 61 69 74 6f 6e 73 0a 09 : " a-waitons..
3e90: 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e 20 20 20 ;; . "\n
3ea0: 20 20 62 2d 77 61 69 74 6f 6e 73 3a 20 20 22 20 b-waitons: "
3eb0: 62 2d 77 61 69 74 6f 6e 73 0a 09 3b 3b 20 09 20 b-waitons..;; .
3ec0: 20 20 20 20 20 22 5c 6e 20 20 20 20 20 61 2d 63 "\n a-c
3ed0: 6f 6e 66 69 67 3a 20 20 20 22 20 28 68 61 73 68 onfig: " (hash
3ee0: 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 2d -table->alist a-
3ef0: 63 6f 6e 66 69 67 29 0a 09 3b 3b 20 09 20 20 20 config)..;; .
3f00: 20 20 20 22 5c 6e 20 20 20 20 20 62 2d 63 6f 6e "\n b-con
3f10: 66 69 67 3a 20 20 20 22 20 28 68 61 73 68 2d 74 fig: " (hash-t
3f20: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 62 2d 63 6f able->alist b-co
3f30: 6e 66 69 67 29 0a 09 3b 3b 20 09 20 20 20 20 20 nfig)..;; .
3f40: 20 22 5c 6e 20 20 20 20 20 61 2d 72 61 77 2d 70 "\n a-raw-p
3f50: 72 69 3a 20 20 22 20 61 2d 72 61 77 2d 70 72 69 ri: " a-raw-pri
3f60: 0a 09 3b 3b 20 09 20 20 20 20 20 20 22 5c 6e 20 ..;; . "\n
3f70: 20 20 20 20 62 2d 72 61 77 2d 70 72 69 3a 20 20 b-raw-pri:
3f80: 22 20 62 2d 72 61 77 2d 70 72 69 0a 09 3b 3b 20 " b-raw-pri..;;
3f90: 09 20 20 20 20 20 20 22 5c 6e 20 20 20 20 20 61 . "\n a
3fa0: 2d 70 72 69 6f 72 69 74 79 3a 20 22 20 61 2d 70 -priority: " a-p
3fb0: 72 69 6f 72 69 74 79 0a 09 3b 3b 20 09 20 20 20 riority..;; .
3fc0: 20 20 20 22 5c 6e 20 20 20 20 20 62 2d 70 72 69 "\n b-pri
3fd0: 6f 72 69 74 79 3a 20 22 20 62 2d 70 72 69 6f 72 ority: " b-prior
3fe0: 69 74 79 29 0a 09 20 28 74 65 73 74 73 3a 74 65 ity).. (tests:te
3ff0: 73 74 71 75 65 75 65 2d 73 65 74 2d 70 72 69 6f stqueue-set-prio
4000: 72 69 74 79 21 20 61 2d 72 65 63 6f 72 64 20 61 rity! a-record a
4010: 2d 70 72 69 6f 72 69 74 79 29 0a 09 20 28 74 65 -priority).. (te
4020: 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d 73 65 sts:testqueue-se
4030: 74 2d 70 72 69 6f 72 69 74 79 21 20 62 2d 72 65 t-priority! b-re
4040: 63 6f 72 64 20 62 2d 70 72 69 6f 72 69 74 79 29 cord b-priority)
4050: 0a 09 20 28 69 66 20 28 61 6e 64 20 61 2d 77 61 .. (if (and a-wa
4060: 69 74 6f 6e 73 20 28 6d 65 6d 62 65 72 20 28 74 itons (member (t
4070: 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 ests:testqueue-g
4080: 65 74 2d 74 65 73 74 6e 61 6d 65 20 62 2d 72 65 et-testname b-re
4090: 63 6f 72 64 29 20 61 2d 77 61 69 74 6f 6e 73 29 cord) a-waitons)
40a0: 29 0a 09 20 20 20 20 20 23 66 20 3b 3b 20 63 61 ).. #f ;; ca
40b0: 6e 6e 6f 74 20 68 61 76 65 20 61 20 77 68 69 63 nnot have a whic
40c0: 68 20 69 73 20 77 61 69 74 69 6e 67 20 6f 6e 20 h is waiting on
40d0: 62 20 68 61 70 70 65 6e 69 6e 67 20 62 65 66 6f b happening befo
40e0: 72 65 20 62 0a 09 20 20 20 20 20 28 69 66 20 28 re b.. (if (
40f0: 61 6e 64 20 62 2d 77 61 69 74 6f 6e 73 20 28 6d and b-waitons (m
4100: 65 6d 62 65 72 20 28 74 65 73 74 73 3a 74 65 73 ember (tests:tes
4110: 74 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 6e tqueue-get-testn
4120: 61 6d 65 20 61 2d 72 65 63 6f 72 64 29 20 62 2d ame a-record) b-
4130: 77 61 69 74 6f 6e 73 29 29 0a 09 09 20 23 74 20 waitons))... #t
4140: 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 63 ;; this is the c
4150: 6f 72 72 65 63 74 20 6f 72 64 65 72 2c 20 62 20 orrect order, b
4160: 69 73 20 77 61 69 74 69 6e 67 20 6f 6e 20 61 20 is waiting on a
4170: 61 6e 64 20 62 20 69 73 20 62 65 66 6f 72 65 20 and b is before
4180: 61 0a 09 09 20 28 69 66 20 28 3e 20 61 2d 70 72 a... (if (> a-pr
4190: 69 6f 72 69 74 79 20 62 2d 70 72 69 6f 72 69 74 iority b-priorit
41a0: 79 29 0a 09 09 20 20 20 20 20 23 74 20 3b 3b 20 y)... #t ;;
41b0: 69 66 20 61 20 69 73 20 61 20 68 69 67 68 65 72 if a is a higher
41c0: 20 70 72 69 6f 72 69 74 79 20 74 68 61 6e 20 62 priority than b
41d0: 20 74 68 65 6e 20 77 65 20 61 72 65 20 67 6f 6f then we are goo
41e0: 64 20 74 6f 20 67 6f 0a 09 09 20 20 20 20 20 23 d to go... #
41f0: 66 29 29 29 29 29 29 29 29 0a 0a 0a 3b 3b 3d 3d f))))))))...;;==
4200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4220: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4230: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4240: 3d 3d 3d 3d 0a 3b 3b 20 74 65 73 74 20 73 74 65 ====.;; test ste
4250: 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ps.;;===========
4260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
42a0: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
42b0: 74 75 73 21 20 75 73 65 64 20 74 6f 20 62 65 20 tus! used to be
42c0: 68 65 72 65 0a 0a 28 64 65 66 69 6e 65 20 28 74 here..(define (t
42d0: 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 est-get-kill-req
42e0: 75 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 uest db run-id t
42f0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
4300: 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d ). (let* ((item
4310: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
4320: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
4330: 0a 09 20 28 74 65 73 74 64 61 74 20 20 20 28 64 .. (testdat (d
4340: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 b:get-test-info
4350: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
4360: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
4370: 0a 20 20 20 20 28 65 71 75 61 6c 3f 20 28 74 65 . (equal? (te
4380: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 73 st:get-state tes
4390: 74 64 61 74 29 20 22 4b 49 4c 4c 52 45 51 22 29 tdat) "KILLREQ")
43a0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
43b0: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
43c0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
43d0: 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 28 6c me itemdat). (l
43e0: 65 74 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 et ((item-path (
43f0: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
4400: 69 74 65 6d 64 61 74 29 29 0a 09 28 63 70 75 6c itemdat))..(cpul
4410: 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f oad (get-cpu-lo
4420: 61 64 29 29 0a 09 28 68 6f 73 74 6e 61 6d 65 20 ad))..(hostname
4430: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
4440: 0a 09 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 ..(diskfree (get
4450: 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 -df (current-dir
4460: 65 63 74 6f 72 79 29 29 29 0a 09 28 75 6e 61 6d ectory)))..(unam
4470: 65 20 20 20 20 28 67 65 74 2d 75 6e 61 6d 65 20 e (get-uname
4480: 22 2d 73 72 76 70 69 6f 22 29 29 0a 09 28 72 75 "-srvpio"))..(ru
4490: 6e 70 61 74 68 20 20 28 63 75 72 72 65 6e 74 2d npath (current-
44a0: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 20 20 20 directory))).
44b0: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
44c0: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
44d0: 74 73 20 53 45 54 20 68 6f 73 74 3d 3f 2c 63 70 ts SET host=?,cp
44e0: 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 65 65 uload=?,diskfree
44f0: 3d 3f 2c 75 6e 61 6d 65 3d 3f 2c 72 75 6e 64 69 =?,uname=?,rundi
4500: 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 r=? WHERE run_id
4510: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
4520: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
4530: 3f 3b 22 0a 09 09 20 20 68 6f 73 74 6e 61 6d 65 ?;"... hostname
4540: 0a 09 09 20 20 63 70 75 6c 6f 61 64 0a 09 09 20 ... cpuload...
4550: 20 64 69 73 6b 66 72 65 65 0a 09 09 20 20 75 6e diskfree... un
4560: 61 6d 65 0a 09 09 20 20 72 75 6e 70 61 74 68 0a ame... runpath.
4570: 09 09 20 20 72 75 6e 2d 69 64 0a 09 09 20 20 74 .. run-id... t
4580: 65 73 74 6e 61 6d 65 0a 09 09 20 20 69 74 65 6d estname... item
4590: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
45a0: 65 20 28 74 65 73 74 2d 75 70 64 61 74 65 2d 6d e (test-update-m
45b0: 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d eta-info db run-
45c0: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
45d0: 64 61 74 20 6d 69 6e 75 74 65 73 20 63 70 75 6c dat minutes cpul
45e0: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 oad diskfree tmp
45f0: 66 72 65 65 29 0a 20 20 28 6c 65 74 20 28 28 69 free). (let ((i
4600: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
4610: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
4620: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f t))). (if (no
4630: 74 20 69 74 65 6d 2d 70 61 74 68 29 28 62 65 67 t item-path)(beg
4640: 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 in (debug:print
4650: 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 54 45 4d 0 "WARNING: ITEM
4660: 50 41 54 48 20 6e 6f 74 20 73 65 74 2e 22 29 20 PATH not set.")
4670: 20 20 28 73 65 74 21 20 69 74 65 6d 2d 70 61 74 (set! item-pat
4680: 68 20 22 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 h ""))). ;; (
4690: 6c 65 74 20 28 28 74 65 73 74 69 6e 66 6f 20 28 let ((testinfo (
46a0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
46b0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db run-id testn
46c0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
46d0: 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 . ;; (if (a
46e0: 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 nd (not (equal?
46f0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4700: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 43 tus testinfo) "C
4710: 4f 4d 50 4c 45 54 45 44 22 29 29 0a 20 20 20 20 OMPLETED")).
4720: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 6e ;; (n
4730: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
4740: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
4750: 65 73 74 69 6e 66 6f 29 20 22 4b 49 4c 4c 52 45 estinfo) "KILLRE
4760: 51 22 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 Q")). (sqlite
4770: 33 3a 65 78 65 63 75 74 65 0a 20 20 20 20 20 64 3:execute. d
4780: 62 0a 20 20 20 20 20 22 55 50 44 41 54 45 20 74 b. "UPDATE t
4790: 65 73 74 73 20 53 45 54 20 63 70 75 6c 6f 61 64 ests SET cpuload
47a0: 3d 3f 2c 64 69 73 6b 66 72 65 65 3d 3f 2c 72 75 =?,diskfree=?,ru
47b0: 6e 5f 64 75 72 61 74 69 6f 6e 3d 3f 2c 73 74 61 n_duration=?,sta
47c0: 74 65 3d 27 52 55 4e 4e 49 4e 47 27 20 57 48 45 te='RUNNING' WHE
47d0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
47e0: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
47f0: 74 65 6d 5f 70 61 74 68 3d 3f 20 41 4e 44 20 73 tem_path=? AND s
4800: 74 61 74 65 20 4e 4f 54 20 49 4e 20 28 27 43 4f tate NOT IN ('CO
4810: 4d 50 4c 45 54 45 44 27 2c 27 4b 49 4c 4c 52 45 MPLETED','KILLRE
4820: 51 27 2c 27 4b 49 4c 4c 45 44 27 29 3b 22 0a 20 Q','KILLED');".
4830: 20 20 20 20 63 70 75 6c 6f 61 64 0a 20 20 20 20 cpuload.
4840: 20 64 69 73 6b 66 72 65 65 0a 20 20 20 20 20 6d diskfree. m
4850: 69 6e 75 74 65 73 0a 20 20 20 20 20 72 75 6e 2d inutes. run-
4860: 69 64 0a 20 20 20 20 20 74 65 73 74 6e 61 6d 65 id. testname
4870: 0a 20 20 20 20 20 69 74 65 6d 2d 70 61 74 68 29 . item-path)
4880: 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ))..;;==========
4890: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
48c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 ============.;;
48d0: 41 20 52 20 43 20 48 20 49 20 56 20 49 20 4e 20 A R C H I V I N
48e0: 47 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d G.;;============
48f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
4920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
4930: 69 6e 65 20 28 74 65 73 74 3a 61 72 63 68 69 76 ine (test:archiv
4940: 65 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 e db test-id).
4950: 23 66 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 #f)..(define (te
4960: 73 74 3a 61 72 63 68 69 76 65 2d 74 65 73 74 73 st:archive-tests
4970: 20 64 62 20 6b 65 79 6e 61 6d 65 73 20 74 61 72 db keynames tar
4980: 67 65 74 29 0a 20 20 23 66 29 0a get). #f).