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 0a 0a 28 64 cords.scm")...(d
0150: 65 66 69 6e 65 20 28 72 65 67 69 73 74 65 72 2d efine (register-
0160: 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 test db run-id t
0170: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
0180: 74 68 29 0a 20 20 28 6c 65 74 20 28 28 69 74 65 th). (let ((ite
0190: 6d 2d 70 61 74 68 73 20 28 69 66 20 28 65 71 75 m-paths (if (equ
01a0: 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 al? item-path ""
01b0: 29 0a 09 09 09 28 6c 69 73 74 20 69 74 65 6d 2d )....(list item-
01c0: 70 61 74 68 29 0a 09 09 09 28 6c 69 73 74 20 69 path)....(list i
01d0: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 29 0a tem-path "")))).
01e0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 (for-each .
01f0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 74 68 (lambda (pth
0200: 29 0a 20 20 20 20 20 20 20 28 73 71 6c 69 74 65 ). (sqlite
0210: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 49 4e 3:execute db "IN
0220: 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 20 49 SERT OR IGNORE I
0230: 4e 54 4f 20 74 65 73 74 73 20 28 72 75 6e 5f 69 NTO tests (run_i
0240: 64 2c 74 65 73 74 6e 61 6d 65 2c 65 76 65 6e 74 d,testname,event
0250: 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 61 74 68 2c _time,item_path,
0260: 73 74 61 74 65 2c 73 74 61 74 75 73 29 20 56 41 state,status) VA
0270: 4c 55 45 53 20 28 3f 2c 3f 2c 73 74 72 66 74 69 LUES (?,?,strfti
0280: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f me('%s','now'),?
0290: 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c 27 ,'NOT_STARTED','
02a0: 6e 2f 61 27 29 3b 22 20 0a 09 09 09 72 75 6e 2d n/a');" ....run-
02b0: 69 64 20 0a 09 09 09 74 65 73 74 2d 6e 61 6d 65 id ....test-name
02c0: 0a 09 09 09 70 74 68 20 0a 09 09 09 3b 3b 20 28 ....pth ....;; (
02d0: 63 6f 6e 63 20 22 2c 22 20 28 73 74 72 69 6e 67 conc "," (string
02e0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 74 61 67 -intersperse tag
02f0: 73 20 22 2c 22 29 20 22 2c 22 29 0a 09 09 09 29 s ",") ",")....)
0300: 29 0a 20 20 20 20 20 69 74 65 6d 2d 70 61 74 68 ). item-path
0310: 73 20 29 29 29 0a 0a 3b 3b 20 67 65 74 20 74 68 s )))..;; get th
0320: 65 20 70 72 65 76 69 6f 75 73 20 72 65 63 6f 72 e previous recor
0330: 64 20 66 6f 72 20 77 68 65 6e 20 74 68 69 73 20 d for when this
0340: 74 65 73 74 20 77 61 73 20 72 75 6e 20 77 68 65 test was run whe
0350: 72 65 20 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 re all keys matc
0360: 68 20 62 75 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b h but runname.;;
0370: 20 72 65 74 75 72 6e 73 20 23 66 20 69 66 20 6e returns #f if n
0380: 6f 20 73 75 63 68 20 74 65 73 74 20 66 6f 75 6e o such test foun
0390: 64 2c 20 72 65 74 75 72 6e 73 20 61 20 73 69 6e d, returns a sin
03a0: 67 6c 65 20 74 65 73 74 20 72 65 63 6f 72 64 20 gle test record
03b0: 69 66 20 66 6f 75 6e 64 0a 28 64 65 66 69 6e 65 if found.(define
03c0: 20 28 74 65 73 74 3a 67 65 74 2d 70 72 65 76 69 (test:get-previ
03d0: 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 ous-test-run-rec
03e0: 6f 72 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ord db run-id te
03f0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
0400: 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 h). (let* ((key
0410: 73 20 20 20 20 28 64 62 3a 67 65 74 2d 6b 65 79 s (db:get-key
0420: 73 20 64 62 29 29 0a 09 20 28 73 65 6c 73 74 72 s db)).. (selstr
0430: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
0440: 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
0450: 64 61 20 28 78 29 28 76 65 63 74 6f 72 2d 72 65 da (x)(vector-re
0460: 66 20 78 20 30 29 29 20 6b 65 79 73 29 20 22 2c f x 0)) keys) ",
0470: 22 29 29 0a 09 20 28 71 72 79 73 74 72 20 20 28 ")).. (qrystr (
0480: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
0490: 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 se (map (lambda
04a0: 28 78 29 28 63 6f 6e 63 20 28 76 65 63 74 6f 72 (x)(conc (vector
04b0: 2d 72 65 66 20 78 20 30 29 20 22 3d 3f 22 29 29 -ref x 0) "=?"))
04c0: 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 29 keys) " AND "))
04d0: 0a 09 20 28 6b 65 79 76 61 6c 73 20 23 66 29 29 .. (keyvals #f))
04e0: 0a 20 20 20 20 3b 3b 20 66 69 72 73 74 20 6c 6f . ;; first lo
04f0: 6f 6b 20 75 70 20 74 68 65 20 6b 65 79 20 76 61 ok up the key va
0500: 6c 75 65 73 20 66 72 6f 6d 20 74 68 65 20 72 75 lues from the ru
0510: 6e 20 73 65 6c 65 63 74 65 64 20 62 79 20 72 75 n selected by ru
0520: 6e 2d 69 64 0a 20 20 20 20 28 73 71 6c 69 74 65 n-id. (sqlite
0530: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
0540: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 (lambda (a
0550: 2e 20 62 29 0a 20 20 20 20 20 20 20 28 73 65 74 . b). (set
0560: 21 20 6b 65 79 76 61 6c 73 20 28 63 6f 6e 73 20 ! keyvals (cons
0570: 61 20 62 29 29 29 0a 20 20 20 20 20 64 62 0a 20 a b))). db.
0580: 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 (conc "SELEC
0590: 54 20 22 20 73 65 6c 73 74 72 20 22 20 46 52 4f T " selstr " FRO
05a0: 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 64 3d M runs WHERE id=
05b0: 3f 20 4f 52 44 45 52 20 42 59 20 65 76 65 6e 74 ? ORDER BY event
05c0: 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 20 72 75 _time DESC;") ru
05d0: 6e 2d 69 64 29 0a 20 20 20 20 28 69 66 20 28 6e n-id). (if (n
05e0: 6f 74 20 6b 65 79 76 61 6c 73 29 0a 09 23 66 0a ot keyvals)..#f.
05f0: 09 28 6c 65 74 20 28 28 70 72 65 76 2d 72 75 6e .(let ((prev-run
0600: 2d 69 64 73 20 27 28 29 29 29 0a 09 20 20 28 61 -ids '())).. (a
0610: 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 pply sqlite3:for
0620: 2d 65 61 63 68 2d 72 6f 77 0a 09 09 20 28 6c 61 -each-row... (la
0630: 6d 62 64 61 20 28 69 64 29 0a 09 09 20 20 20 28 mbda (id)... (
0640: 73 65 74 21 20 70 72 65 76 2d 72 75 6e 2d 69 64 set! prev-run-id
0650: 73 20 28 63 6f 6e 73 20 69 64 20 70 72 65 76 2d s (cons id prev-
0660: 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 20 64 62 run-ids)))... db
0670: 0a 09 09 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 ... (conc "SELEC
0680: 54 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 20 57 T id FROM runs W
0690: 48 45 52 45 20 22 20 71 72 79 73 74 72 20 22 20 HERE " qrystr "
06a0: 41 4e 44 20 69 64 20 21 3d 20 3f 3b 22 29 20 28 AND id != ?;") (
06b0: 61 70 70 65 6e 64 20 6b 65 79 76 61 6c 73 20 28 append keyvals (
06c0: 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 29 0a 09 list run-id)))..
06d0: 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 20 72 75 ;; for each ru
06e0: 6e 20 73 74 61 72 74 69 6e 67 20 77 69 74 68 20 n starting with
06f0: 74 68 65 20 6d 6f 73 74 20 72 65 63 65 6e 74 20 the most recent
0700: 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 69 66 20 74 look to see if t
0710: 68 65 72 65 20 69 73 20 61 20 6d 61 74 63 68 69 here is a matchi
0720: 6e 67 20 74 65 73 74 0a 09 20 20 3b 3b 20 69 66 ng test.. ;; if
0730: 20 66 6f 75 6e 64 20 74 68 65 6e 20 72 65 74 75 found then retu
0740: 72 6e 20 74 68 61 74 20 6d 61 74 63 68 69 6e 67 rn that matching
0750: 20 74 65 73 74 20 72 65 63 6f 72 64 0a 09 20 20 test record..
0760: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
0770: 73 65 6c 73 74 72 3a 20 22 20 73 65 6c 73 74 72 selstr: " selstr
0780: 20 22 2c 20 71 72 79 73 74 72 3a 20 22 20 71 72 ", qrystr: " qr
0790: 79 73 74 72 20 22 2c 20 6b 65 79 76 61 6c 73 3a ystr ", keyvals:
07a0: 20 22 20 6b 65 79 76 61 6c 73 20 22 2c 20 70 72 " keyvals ", pr
07b0: 65 76 69 6f 75 73 20 72 75 6e 20 69 64 73 20 66 evious run ids f
07c0: 6f 75 6e 64 3a 20 22 20 70 72 65 76 2d 72 75 6e ound: " prev-run
07d0: 2d 69 64 73 29 0a 09 20 20 28 69 66 20 28 6e 75 -ids).. (if (nu
07e0: 6c 6c 3f 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 ll? prev-run-ids
07f0: 29 20 23 66 0a 09 20 20 20 20 20 20 28 6c 65 74 ) #f.. (let
0800: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
0810: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 0a prev-run-ids)).
0820: 09 09 09 20 28 74 61 6c 20 28 63 64 72 20 70 72 ... (tal (cdr pr
0830: 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 ev-run-ids)))...
0840: 28 6c 65 74 20 28 28 72 65 73 75 6c 74 73 20 28 (let ((results (
0850: 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db-get-tests-for
0860: 2d 72 75 6e 20 64 62 20 68 65 64 20 74 65 73 74 -run db hed test
0870: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
0880: 27 28 29 20 27 28 29 29 29 29 0a 09 09 20 20 28 '() '())))... (
0890: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 47 debug:print 4 "G
08a0: 6f 74 20 74 65 73 74 73 20 66 6f 72 20 72 75 6e ot tests for run
08b0: 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 2c 20 -id " run-id ",
08c0: 74 65 73 74 2d 6e 61 6d 65 20 22 20 74 65 73 74 test-name " test
08d0: 2d 6e 61 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 -name ", item-pa
08e0: 74 68 20 22 20 69 74 65 6d 2d 70 61 74 68 20 22 th " item-path "
08f0: 3a 20 22 20 72 65 73 75 6c 74 73 29 0a 09 09 20 : " results)...
0900: 20 28 69 66 20 28 61 6e 64 20 28 6e 75 6c 6c 3f (if (and (null?
0910: 20 72 65 73 75 6c 74 73 29 0a 09 09 09 20 20 20 results)....
0920: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (not (null? tal)
0930: 29 29 0a 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 ))... (loop
0940: 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 (car tal)(cdr t
0950: 61 6c 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 al))... (if
0960: 20 28 6e 75 6c 6c 3f 20 72 65 73 75 6c 74 73 29 (null? results)
0970: 20 23 66 0a 09 09 09 20 20 28 63 61 72 20 72 65 #f.... (car re
0980: 73 75 6c 74 73 29 29 29 29 29 29 29 29 29 29 0a sults)))))))))).
0990: 20 20 20 20 0a 3b 3b 20 67 65 74 20 74 68 65 20 .;; get the
09a0: 70 72 65 76 69 6f 75 73 20 72 65 63 6f 72 64 73 previous records
09b0: 20 66 6f 72 20 77 68 65 6e 20 74 68 65 73 65 20 for when these
09c0: 74 65 73 74 73 20 77 65 72 65 20 72 75 6e 20 77 tests were run w
09d0: 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 20 6d 61 here all keys ma
09e0: 74 63 68 20 62 75 74 20 72 75 6e 6e 61 6d 65 0a tch but runname.
09f0: 3b 3b 20 4e 42 2f 2f 20 4d 65 72 67 65 20 74 68 ;; NB// Merge th
0a00: 69 73 20 77 69 74 68 20 74 65 73 74 3a 67 65 74 is with test:get
0a10: 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 -previous-test-r
0a20: 75 6e 2d 72 65 63 6f 72 64 73 3f 20 54 68 69 73 un-records? This
0a30: 20 6f 6e 65 20 6c 6f 6f 6b 73 20 66 6f 72 20 61 one looks for a
0a40: 6c 6c 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 ll matching test
0a50: 73 0a 3b 3b 20 63 61 6e 20 75 73 65 20 77 69 6c s.;; can use wil
0a60: 64 63 61 72 64 73 2e 20 0a 28 64 65 66 69 6e 65 dcards. .(define
0a70: 20 28 74 65 73 74 3a 67 65 74 2d 6d 61 74 63 68 (test:get-match
0a80: 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 ing-previous-tes
0a90: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 64 62 t-run-records db
0aa0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
0ab0: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 e item-path). (
0ac0: 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 28 let* ((keys (
0ad0: 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 db:get-keys db))
0ae0: 0a 09 20 28 73 65 6c 73 74 72 20 20 28 73 74 72 .. (selstr (str
0af0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
0b00: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
0b10: 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 (vector-ref x 0)
0b20: 29 20 6b 65 79 73 29 20 22 2c 22 29 29 0a 09 20 ) keys) ","))..
0b30: 28 71 72 79 73 74 72 20 20 28 73 74 72 69 6e 67 (qrystr (string
0b40: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 -intersperse (ma
0b50: 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 63 6f p (lambda (x)(co
0b60: 6e 63 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 nc (vector-ref x
0b70: 20 30 29 20 22 3d 3f 22 29 29 20 6b 65 79 73 29 0) "=?")) keys)
0b80: 20 22 20 41 4e 44 20 22 29 29 0a 09 20 28 6b 65 " AND ")).. (ke
0b90: 79 76 61 6c 73 20 23 66 29 0a 09 20 28 74 65 73 yvals #f).. (tes
0ba0: 74 73 2d 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 ts-hash (make-ha
0bb0: 73 68 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 sh-table))).
0bc0: 3b 3b 20 66 69 72 73 74 20 6c 6f 6f 6b 20 75 70 ;; first look up
0bd0: 20 74 68 65 20 6b 65 79 20 76 61 6c 75 65 73 20 the key values
0be0: 66 72 6f 6d 20 74 68 65 20 72 75 6e 20 73 65 6c from the run sel
0bf0: 65 63 74 65 64 20 62 79 20 72 75 6e 2d 69 64 0a ected by run-id.
0c00: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
0c10: 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 -each-row .
0c20: 28 6c 61 6d 62 64 61 20 28 61 20 2e 20 62 29 0a (lambda (a . b).
0c30: 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 (set! key
0c40: 76 61 6c 73 20 28 63 6f 6e 73 20 61 20 62 29 29 vals (cons a b))
0c50: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 28 ). db. (
0c60: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 22 20 73 conc "SELECT " s
0c70: 65 6c 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e elstr " FROM run
0c80: 73 20 57 48 45 52 45 20 69 64 3d 3f 20 4f 52 44 s WHERE id=? ORD
0c90: 45 52 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 ER BY event_time
0ca0: 20 44 45 53 43 3b 22 29 20 72 75 6e 2d 69 64 29 DESC;") run-id)
0cb0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6b 65 . (if (not ke
0cc0: 79 76 61 6c 73 29 0a 09 27 28 29 0a 09 28 6c 65 yvals)..'()..(le
0cd0: 74 20 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 t ((prev-run-ids
0ce0: 20 27 28 29 29 29 0a 09 20 20 28 61 70 70 6c 79 '())).. (apply
0cf0: 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 sqlite3:for-eac
0d00: 68 2d 72 6f 77 0a 09 09 20 28 6c 61 6d 62 64 61 h-row... (lambda
0d10: 20 28 69 64 29 0a 09 09 20 20 20 28 73 65 74 21 (id)... (set!
0d20: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 63 prev-run-ids (c
0d30: 6f 6e 73 20 69 64 20 70 72 65 76 2d 72 75 6e 2d ons id prev-run-
0d40: 69 64 73 29 29 29 0a 09 09 20 64 62 0a 09 09 20 ids)))... db...
0d50: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 (conc "SELECT id
0d60: 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 FROM runs WHERE
0d70: 20 22 20 71 72 79 73 74 72 20 22 20 41 4e 44 20 " qrystr " AND
0d80: 69 64 20 21 3d 20 3f 3b 22 29 20 28 61 70 70 65 id != ?;") (appe
0d90: 6e 64 20 6b 65 79 76 61 6c 73 20 28 6c 69 73 74 nd keyvals (list
0da0: 20 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 3b 3b run-id))).. ;;
0db0: 20 63 6f 6c 6c 65 63 74 20 61 6c 6c 20 6d 61 74 collect all mat
0dc0: 63 68 69 6e 67 20 74 65 73 74 73 20 66 6f 72 20 ching tests for
0dd0: 74 68 65 20 72 75 6e 73 20 74 68 65 6e 0a 09 20 the runs then..
0de0: 20 3b 3b 20 65 78 74 72 61 63 74 20 74 68 65 20 ;; extract the
0df0: 6d 6f 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 most recent test
0e00: 20 61 6e 64 20 72 65 74 75 72 6e 20 74 68 61 74 and return that
0e10: 2e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
0e20: 74 20 34 20 22 73 65 6c 73 74 72 3a 20 22 20 73 t 4 "selstr: " s
0e30: 65 6c 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a elstr ", qrystr:
0e40: 20 22 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 " qrystr ", key
0e50: 76 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 vals: " keyvals
0e60: 0a 09 09 20 20 20 20 20 20 20 22 2c 20 70 72 65 ... ", pre
0e70: 76 69 6f 75 73 20 72 75 6e 20 69 64 73 20 66 6f vious run ids fo
0e80: 75 6e 64 3a 20 22 20 70 72 65 76 2d 72 75 6e 2d und: " prev-run-
0e90: 69 64 73 29 0a 09 20 20 28 69 66 20 28 6e 75 6c ids).. (if (nul
0ea0: 6c 3f 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 l? prev-run-ids)
0eb0: 20 27 28 29 20 20 3b 3b 20 6e 6f 20 70 72 65 76 '() ;; no prev
0ec0: 69 6f 75 73 20 72 75 6e 73 3f 20 72 65 74 75 72 ious runs? retur
0ed0: 6e 20 6e 75 6c 6c 0a 09 20 20 20 20 20 20 28 6c n null.. (l
0ee0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
0ef0: 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 ar prev-run-ids)
0f00: 29 0a 09 09 09 20 28 74 61 6c 20 28 63 64 72 20 ).... (tal (cdr
0f10: 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a prev-run-ids))).
0f20: 09 09 28 6c 65 74 20 28 28 72 65 73 75 6c 74 73 ..(let ((results
0f30: 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 (db-get-tests-f
0f40: 6f 72 2d 72 75 6e 20 64 62 20 68 65 64 20 74 65 or-run db hed te
0f50: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
0f60: 68 20 27 28 29 20 27 28 29 29 29 29 0a 09 09 20 h '() '())))...
0f70: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
0f80: 22 47 6f 74 20 74 65 73 74 73 20 66 6f 72 20 72 "Got tests for r
0f90: 75 6e 2d 69 64 20 22 20 72 75 6e 2d 69 64 20 22 un-id " run-id "
0fa0: 2c 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 74 65 , test-name " te
0fb0: 73 74 2d 6e 61 6d 65 20 0a 09 09 09 20 20 20 20 st-name ....
0fc0: 20 20 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 ", item-path
0fd0: 22 20 69 74 65 6d 2d 70 61 74 68 20 22 20 72 65 " item-path " re
0fe0: 73 75 6c 74 73 3a 20 22 20 28 69 6e 74 65 72 73 sults: " (inters
0ff0: 70 65 72 73 65 20 72 65 73 75 6c 74 73 20 22 5c perse results "\
1000: 6e 22 29 29 0a 09 09 20 20 3b 3b 20 4b 65 65 70 n"))... ;; Keep
1010: 20 6f 6e 6c 79 20 74 68 65 20 79 6f 75 6e 67 65 only the younge
1020: 73 74 20 6f 66 20 61 6e 79 20 74 65 73 74 2f 69 st of any test/i
1030: 74 65 6d 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 0a tem combination.
1040: 09 09 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 .. (for-each ..
1050: 09 20 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 . (lambda (tes
1060: 74 64 61 74 29 0a 09 09 20 20 20 20 20 28 6c 65 tdat)... (le
1070: 74 2a 20 28 28 66 75 6c 6c 2d 74 65 73 74 6e 61 t* ((full-testna
1080: 6d 65 20 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 me (conc (db:tes
1090: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
10a0: 65 73 74 64 61 74 29 20 22 2f 22 20 28 64 62 3a estdat) "/" (db:
10b0: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
10c0: 74 68 20 74 65 73 74 64 61 74 29 29 29 0a 09 09 th testdat)))...
10d0: 09 20 20 20 20 28 73 74 6f 72 65 64 2d 74 65 73 . (stored-tes
10e0: 74 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d t (hash-table-
10f0: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
1100: 73 2d 68 61 73 68 20 66 75 6c 6c 2d 74 65 73 74 s-hash full-test
1110: 6e 61 6d 65 20 23 66 29 29 29 0a 09 09 20 20 20 name #f)))...
1120: 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 (if (or (not
1130: 20 73 74 6f 72 65 64 2d 74 65 73 74 29 0a 09 09 stored-test)...
1140: 09 20 20 20 20 20 20 20 28 61 6e 64 20 73 74 6f . (and sto
1150: 72 65 64 2d 74 65 73 74 0a 09 09 09 09 20 20 20 red-test.....
1160: 20 28 3e 20 28 64 62 3a 74 65 73 74 2d 67 65 74 (> (db:test-get
1170: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 -event_time test
1180: 64 61 74 29 28 64 62 3a 74 65 73 74 2d 67 65 74 dat)(db:test-get
1190: 2d 65 76 65 6e 74 5f 74 69 6d 65 20 73 74 6f 72 -event_time stor
11a0: 65 64 2d 74 65 73 74 29 29 29 29 0a 09 09 09 20 ed-test))))....
11b0: 20 20 3b 3b 20 74 68 69 73 20 74 65 73 74 20 69 ;; this test i
11c0: 73 20 79 6f 75 6e 67 65 72 2c 20 73 74 6f 72 65 s younger, store
11d0: 20 69 74 20 69 6e 20 74 68 65 20 68 61 73 68 0a it in the hash.
11e0: 09 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 6c ... (hash-tabl
11f0: 65 2d 73 65 74 21 20 74 65 73 74 73 2d 68 61 73 e-set! tests-has
1200: 68 20 66 75 6c 6c 2d 74 65 73 74 6e 61 6d 65 20 h full-testname
1210: 74 65 73 74 64 61 74 29 29 29 29 0a 09 09 20 20 testdat))))...
1220: 20 72 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 results)... (i
1230: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 09 f (null? tal)...
1240: 20 20 20 20 20 20 28 6d 61 70 20 63 64 72 20 28 (map cdr (
1250: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
1260: 74 20 74 65 73 74 73 2d 68 61 73 68 29 29 20 3b t tests-hash)) ;
1270: 3b 20 72 65 74 75 72 6e 20 61 20 6c 69 73 74 20 ; return a list
1280: 6f 66 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 of the most rece
1290: 6e 74 20 74 65 73 74 73 0a 09 09 20 20 20 20 20 nt tests...
12a0: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
12b0: 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 29 (cdr tal))))))))
12c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
12d0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db
12e0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
12f0: 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 69 e state status i
1300: 74 65 6d 64 61 74 2d 6f 72 2d 70 61 74 68 20 63 temdat-or-path c
1310: 6f 6d 6d 65 6e 74 20 64 61 74 29 0a 20 20 28 6c omment dat). (l
1320: 65 74 2a 20 28 28 72 65 61 6c 2d 73 74 61 74 75 et* ((real-statu
1330: 73 20 73 74 61 74 75 73 29 0a 09 20 28 69 74 65 s status).. (ite
1340: 6d 2d 70 61 74 68 20 20 20 28 69 66 20 28 73 74 m-path (if (st
1350: 72 69 6e 67 3f 20 69 74 65 6d 64 61 74 2d 6f 72 ring? itemdat-or
1360: 2d 70 61 74 68 29 20 69 74 65 6d 64 61 74 2d 6f -path) itemdat-o
1370: 72 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 r-path (item-lis
1380: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 2d t->path itemdat-
1390: 6f 72 2d 70 61 74 68 29 29 29 0a 09 20 28 74 65 or-path))).. (te
13a0: 73 74 64 61 74 20 20 20 20 20 28 64 62 3a 67 65 stdat (db:ge
13b0: 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 t-test-info db r
13c0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
13d0: 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 74 item-path)).. (t
13e0: 65 73 74 2d 69 64 20 20 20 20 20 28 69 66 20 74 est-id (if t
13f0: 65 73 74 64 61 74 20 28 64 62 3a 74 65 73 74 2d estdat (db:test-
1400: 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 20 get-id testdat)
1410: 23 66 29 29 0a 09 20 28 6f 74 68 65 72 64 61 74 #f)).. (otherdat
1420: 20 20 20 20 28 69 66 20 64 61 74 20 64 61 74 20 (if dat dat
1430: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
1440: 29 29 29 0a 09 20 3b 3b 20 62 65 66 6f 72 65 20 ))).. ;; before
1450: 70 72 6f 63 65 65 64 69 6e 67 20 77 65 20 6d 75 proceeding we mu
1460: 73 74 20 66 69 6e 64 20 6f 75 74 20 69 66 20 74 st find out if t
1470: 68 65 20 70 72 65 76 69 6f 75 73 20 74 65 73 74 he previous test
1480: 20 28 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 (where all keys
1490: 20 6d 61 74 63 68 65 64 20 65 78 63 65 70 74 20 matched except
14a0: 72 75 6e 6e 61 6d 65 29 0a 09 20 3b 3b 20 77 61 runname).. ;; wa
14b0: 73 20 57 41 49 56 45 44 20 69 66 20 74 68 69 73 s WAIVED if this
14c0: 20 74 65 73 74 20 69 73 20 46 41 49 4c 0a 09 20 test is FAIL..
14d0: 28 77 61 69 76 65 64 20 20 20 28 69 66 20 28 65 (waived (if (e
14e0: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 46 41 qual? status "FA
14f0: 49 4c 22 29 0a 09 09 20 20 20 20 20 20 20 28 6c IL")... (l
1500: 65 74 20 28 28 70 72 65 76 2d 74 65 73 74 20 28 et ((prev-test (
1510: 74 65 73 74 3a 67 65 74 2d 70 72 65 76 69 6f 75 test:get-previou
1520: 73 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 s-test-run-recor
1530: 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 d db run-id test
1540: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
1550: 29 29 0a 09 09 09 20 28 69 66 20 70 72 65 76 2d )).... (if prev-
1560: 74 65 73 74 20 3b 3b 20 74 72 75 65 20 69 66 20 test ;; true if
1570: 77 65 20 66 6f 75 6e 64 20 61 20 70 72 65 76 69 we found a previ
1580: 6f 75 73 20 74 65 73 74 20 69 6e 20 74 68 69 73 ous test in this
1590: 20 72 75 6e 20 73 65 72 69 65 73 0a 09 09 09 20 run series....
15a0: 20 20 20 20 28 6c 65 74 20 28 28 70 72 65 76 2d (let ((prev-
15b0: 73 74 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d status (db:test-
15c0: 67 65 74 2d 73 74 61 74 75 73 20 20 20 70 72 65 get-status pre
15d0: 76 2d 74 65 73 74 29 29 0a 09 09 09 09 20 20 20 v-test)).....
15e0: 28 70 72 65 76 2d 73 74 61 74 65 20 20 28 64 62 (prev-state (db
15f0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
1600: 20 20 20 70 72 65 76 2d 74 65 73 74 29 29 0a 09 prev-test))..
1610: 09 09 09 20 20 20 28 70 72 65 76 2d 63 6f 6d 6d ... (prev-comm
1620: 65 6e 74 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ent (db:test-get
1630: 2d 63 6f 6d 6d 65 6e 74 20 70 72 65 76 2d 74 65 -comment prev-te
1640: 73 74 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 st)))....
1650: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
1660: 70 72 65 76 2d 73 74 61 74 75 73 20 22 20 70 72 prev-status " pr
1670: 65 76 2d 73 74 61 74 75 73 20 22 2c 20 70 72 65 ev-status ", pre
1680: 76 2d 73 74 61 74 65 20 22 20 70 72 65 76 2d 73 v-state " prev-s
1690: 74 61 74 65 20 22 2c 20 70 72 65 76 2d 63 6f 6d tate ", prev-com
16a0: 6d 65 6e 74 20 22 20 70 72 65 76 2d 63 6f 6d 6d ment " prev-comm
16b0: 65 6e 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 ent).... (
16c0: 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 if (and (equal?
16d0: 70 72 65 76 2d 73 74 61 74 65 20 20 22 43 4f 4d prev-state "COM
16e0: 50 4c 45 54 45 44 22 29 0a 09 09 09 09 09 28 65 PLETED")......(e
16f0: 71 75 61 6c 3f 20 70 72 65 76 2d 73 74 61 74 75 qual? prev-statu
1700: 73 20 22 57 41 49 56 45 44 22 29 29 0a 09 09 09 s "WAIVED"))....
1710: 09 20 20 20 70 72 65 76 2d 63 6f 6d 6d 65 6e 74 . prev-comment
1720: 20 3b 3b 20 77 61 69 76 65 64 20 69 73 20 65 69 ;; waived is ei
1730: 74 68 65 72 20 74 68 65 20 63 6f 6d 6d 65 6e 74 ther the comment
1740: 20 6f 72 20 23 66 0a 09 09 09 09 20 20 20 23 66 or #f..... #f
1750: 29 29 0a 09 09 09 20 20 20 20 20 23 66 29 29 0a )).... #f)).
1760: 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 20 .. #f))).
1770: 20 20 20 28 69 66 20 77 61 69 76 65 64 20 28 73 (if waived (s
1780: 65 74 21 20 72 65 61 6c 2d 73 74 61 74 75 73 20 et! real-status
1790: 22 57 41 49 56 45 44 22 29 29 0a 20 20 20 20 28 "WAIVED")). (
17a0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 72 debug:print 4 "r
17b0: 65 61 6c 2d 73 74 61 74 75 73 20 22 20 72 65 61 eal-status " rea
17c0: 6c 2d 73 74 61 74 75 73 20 22 2c 20 77 61 69 76 l-status ", waiv
17d0: 65 64 20 22 20 77 61 69 76 65 64 20 22 2c 20 73 ed " waived ", s
17e0: 74 61 74 75 73 20 22 20 73 74 61 74 75 73 29 0a tatus " status).
17f0: 0a 20 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 . ;; update t
1800: 68 65 20 70 72 69 6d 61 72 79 20 72 65 63 6f 72 he primary recor
1810: 64 20 49 46 20 73 74 61 74 65 20 41 4e 44 20 73 d IF state AND s
1820: 74 61 74 75 73 20 61 72 65 20 64 65 66 69 6e 65 tatus are define
1830: 64 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 73 d. (if (and s
1840: 74 61 74 65 20 73 74 61 74 75 73 29 0a 09 28 73 tate status)..(s
1850: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 qlite3:execute d
1860: 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 b "UPDATE tests
1870: 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 SET state=?,stat
1880: 75 73 3d 3f 2c 65 76 65 6e 74 5f 74 69 6d 65 3d us=?,event_time=
1890: 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e strftime('%s','n
18a0: 6f 77 27 29 20 57 48 45 52 45 20 72 75 6e 5f 69 ow') WHERE run_i
18b0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
18c0: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
18d0: 3d 3f 3b 22 20 0a 09 09 09 20 73 74 61 74 65 20 =?;" .... state
18e0: 72 65 61 6c 2d 73 74 61 74 75 73 20 72 75 6e 2d real-status run-
18f0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
1900: 6d 2d 70 61 74 68 29 29 0a 0a 20 20 20 20 3b 3b m-path)).. ;;
1910: 20 69 66 20 73 74 61 74 75 73 20 69 73 20 22 41 if status is "A
1920: 55 54 4f 22 20 74 68 65 6e 20 63 61 6c 6c 20 72 UTO" then call r
1930: 6f 6c 6c 75 70 0a 20 20 20 20 28 69 66 20 28 61 ollup. (if (a
1940: 6e 64 20 74 65 73 74 2d 69 64 20 73 74 61 74 65 nd test-id state
1950: 20 73 74 61 74 75 73 20 28 65 71 75 61 6c 3f 20 status (equal?
1960: 73 74 61 74 75 73 20 22 41 55 54 4f 22 29 29 20 status "AUTO"))
1970: 0a 09 28 64 62 3a 74 65 73 74 2d 64 61 74 61 2d ..(db:test-data-
1980: 72 6f 6c 6c 75 70 20 64 62 20 74 65 73 74 2d 69 rollup db test-i
1990: 64 29 29 0a 0a 20 20 20 20 3b 3b 20 61 64 64 20 d)).. ;; add
19a0: 6d 65 74 61 64 61 74 61 20 28 6e 65 65 64 20 74 metadata (need t
19b0: 6f 20 64 6f 20 74 68 69 73 20 77 61 79 20 74 6f o do this way to
19c0: 20 61 76 6f 69 64 20 53 51 4c 20 69 6e 6a 65 63 avoid SQL injec
19d0: 74 69 6f 6e 20 69 73 73 75 65 73 29 0a 0a 20 20 tion issues)..
19e0: 20 20 3b 3b 20 3a 66 69 72 73 74 5f 65 72 72 0a ;; :first_err.
19f0: 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 76 61 ;; (let ((va
1a00: 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 l (hash-table-re
1a10: 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 f/default otherd
1a20: 61 74 20 22 3a 66 69 72 73 74 5f 65 72 72 22 20 at ":first_err"
1a30: 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 #f))). ;; (
1a40: 69 66 20 76 61 6c 0a 20 20 20 20 3b 3b 20 20 20 if val. ;;
1a50: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 (sqlite3:exe
1a60: 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 cute db "UPDATE
1a70: 74 65 73 74 73 20 53 45 54 20 66 69 72 73 74 5f tests SET first_
1a80: 65 72 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f err=? WHERE run_
1a90: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
1aa0: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
1ab0: 68 3d 3f 3b 22 20 76 61 6c 20 72 75 6e 2d 69 64 h=?;" val run-id
1ac0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
1ad0: 70 61 74 68 29 29 29 0a 20 20 20 20 3b 3b 20 0a path))). ;; .
1ae0: 20 20 20 20 3b 3b 20 3b 3b 20 3a 66 69 72 73 74 ;; ;; :first
1af0: 5f 77 61 72 6e 0a 20 20 20 20 3b 3b 20 28 6c 65 _warn. ;; (le
1b00: 74 20 28 28 76 61 6c 20 28 68 61 73 68 2d 74 61 t ((val (hash-ta
1b10: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1b20: 6f 74 68 65 72 64 61 74 20 22 3a 66 69 72 73 74 otherdat ":first
1b30: 5f 77 61 72 6e 22 20 23 66 29 29 29 0a 20 20 20 _warn" #f))).
1b40: 20 3b 3b 20 20 20 28 69 66 20 76 61 6c 0a 20 20 ;; (if val.
1b50: 20 20 3b 3b 20 20 20 20 20 20 20 28 73 71 6c 69 ;; (sqli
1b60: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
1b70: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
1b80: 20 66 69 72 73 74 5f 77 61 72 6e 3d 3f 20 57 48 first_warn=? WH
1b90: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
1ba0: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
1bb0: 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 76 61 item_path=?;" va
1bc0: 6c 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 l run-id test-na
1bd0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a me item-path))).
1be0: 0a 20 20 20 20 28 6c 65 74 20 28 28 63 61 74 65 . (let ((cate
1bf0: 67 6f 72 79 20 28 68 61 73 68 2d 74 61 62 6c 65 gory (hash-table
1c00: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 -ref/default oth
1c10: 65 72 64 61 74 20 22 3a 63 61 74 65 67 6f 72 79 erdat ":category
1c20: 22 20 22 22 29 29 0a 09 20 20 28 76 61 72 69 61 " "")).. (varia
1c30: 62 6c 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ble (hash-table-
1c40: 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 ref/default othe
1c50: 72 64 61 74 20 22 3a 76 61 72 69 61 62 6c 65 22 rdat ":variable"
1c60: 20 22 22 29 29 0a 09 20 20 28 76 61 6c 75 65 20 "")).. (value
1c70: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
1c80: 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 ef/default other
1c90: 64 61 74 20 22 3a 76 61 6c 75 65 22 20 20 20 20 dat ":value"
1ca0: 23 66 29 29 0a 09 20 20 28 65 78 70 65 63 74 65 #f)).. (expecte
1cb0: 64 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 d (hash-table-re
1cc0: 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 f/default otherd
1cd0: 61 74 20 22 3a 65 78 70 65 63 74 65 64 22 20 23 at ":expected" #
1ce0: 66 29 29 0a 09 20 20 28 74 6f 6c 20 20 20 20 20 f)).. (tol
1cf0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1d00: 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 /default otherda
1d10: 74 20 22 3a 74 6f 6c 22 20 20 20 20 20 20 23 66 t ":tol" #f
1d20: 29 29 0a 09 20 20 28 75 6e 69 74 73 20 20 20 20 )).. (units
1d30: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1d40: 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 74 default otherdat
1d50: 20 22 3a 75 6e 69 74 73 22 20 20 20 20 22 22 29 ":units" "")
1d60: 29 0a 09 20 20 28 64 63 6f 6d 6d 65 6e 74 20 28 ).. (dcomment (
1d70: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
1d80: 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 74 20 efault otherdat
1d90: 22 3a 63 6f 6d 6d 65 6e 74 22 20 20 22 22 29 29 ":comment" ""))
1da0: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
1db0: 72 69 6e 74 20 34 20 0a 09 09 20 20 20 22 63 61 rint 4 ... "ca
1dc0: 74 65 67 6f 72 79 3a 20 22 20 63 61 74 65 67 6f tegory: " catego
1dd0: 72 79 20 22 2c 20 76 61 72 69 61 62 6c 65 3a 20 ry ", variable:
1de0: 22 20 76 61 72 69 61 62 6c 65 20 22 2c 20 76 61 " variable ", va
1df0: 6c 75 65 3a 20 22 20 76 61 6c 75 65 0a 09 09 20 lue: " value...
1e00: 20 20 22 2c 20 65 78 70 65 63 74 65 64 3a 20 22 ", expected: "
1e10: 20 65 78 70 65 63 74 65 64 20 22 2c 20 74 6f 6c expected ", tol
1e20: 3a 20 22 20 74 6f 6c 20 22 2c 20 75 6e 69 74 73 : " tol ", units
1e30: 3a 20 22 20 75 6e 69 74 73 29 0a 20 20 20 20 20 : " units).
1e40: 20 28 69 66 20 28 61 6e 64 20 76 61 6c 75 65 20 (if (and value
1e50: 65 78 70 65 63 74 65 64 20 74 6f 6c 29 20 3b 3b expected tol) ;;
1e60: 20 61 6c 6c 20 74 68 72 65 65 20 72 65 71 75 69 all three requi
1e70: 72 65 64 0a 09 20 20 28 64 62 3a 63 73 76 2d 3e red.. (db:csv->
1e80: 74 65 73 74 2d 64 61 74 61 20 64 62 20 74 65 73 test-data db tes
1e90: 74 2d 69 64 20 0a 09 09 09 20 20 20 20 20 28 63 t-id .... (c
1ea0: 6f 6e 63 20 63 61 74 65 67 6f 72 79 20 22 2c 22 onc category ","
1eb0: 0a 09 09 09 09 20 20 20 76 61 72 69 61 62 6c 65 ..... variable
1ec0: 20 22 2c 22 0a 09 09 09 09 20 20 20 76 61 6c 75 ","..... valu
1ed0: 65 20 20 20 20 22 2c 22 0a 09 09 09 09 20 20 20 e ",".....
1ee0: 65 78 70 65 63 74 65 64 20 22 2c 22 0a 09 09 09 expected ","....
1ef0: 09 20 20 20 74 6f 6c 20 20 20 20 20 20 22 2c 22 . tol ","
1f00: 0a 09 09 09 09 20 20 20 75 6e 69 74 73 20 20 20 ..... units
1f10: 20 22 2c 22 0a 09 09 09 09 20 20 20 64 63 6f 6d ","..... dcom
1f20: 6d 65 6e 74 20 22 2c 22 29 29 29 29 0a 09 09 09 ment ","))))....
1f30: 09 20 20 20 0a 20 20 20 20 3b 3b 20 6e 65 65 64 . . ;; need
1f40: 20 74 6f 20 75 70 64 61 74 65 20 74 68 65 20 74 to update the t
1f50: 6f 70 20 74 65 73 74 20 72 65 63 6f 72 64 20 69 op test record i
1f60: 66 20 50 41 53 53 20 6f 72 20 46 41 49 4c 20 61 f PASS or FAIL a
1f70: 6e 64 20 74 68 69 73 20 69 73 20 61 20 73 75 62 nd this is a sub
1f80: 74 65 73 74 0a 20 20 20 20 28 69 66 20 28 61 6e test. (if (an
1f90: 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 d (not (equal? i
1fa0: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 20 tem-path ""))..
1fb0: 20 20 20 20 28 6f 72 20 28 65 71 75 61 6c 3f 20 (or (equal?
1fc0: 73 74 61 74 75 73 20 22 50 41 53 53 22 29 0a 09 status "PASS")..
1fd0: 09 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 . (equal? status
1fe0: 20 22 57 41 52 4e 22 29 0a 09 09 20 28 65 71 75 "WARN")... (equ
1ff0: 61 6c 3f 20 73 74 61 74 75 73 20 22 46 41 49 4c al? status "FAIL
2000: 22 29 0a 09 09 20 28 65 71 75 61 6c 3f 20 73 74 ")... (equal? st
2010: 61 74 75 73 20 22 57 41 49 56 45 44 22 29 0a 09 atus "WAIVED")..
2020: 09 20 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 . (equal? status
2030: 20 22 52 55 4e 4e 49 4e 47 22 29 29 29 0a 09 28 "RUNNING")))..(
2040: 62 65 67 69 6e 0a 09 20 20 28 73 71 6c 69 74 65 begin.. (sqlite
2050: 33 3a 65 78 65 63 75 74 65 20 0a 09 20 20 20 64 3:execute .. d
2060: 62 0a 09 20 20 20 22 55 50 44 41 54 45 20 74 65 b.. "UPDATE te
2070: 73 74 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 sts .
2080: 20 20 53 45 54 20 66 61 69 6c 5f 63 6f 75 6e 74 SET fail_count
2090: 3d 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 =(SELECT count(i
20a0: 64 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 d) FROM tests WH
20b0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
20c0: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
20d0: 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 item_path != ''
20e0: 41 4e 44 20 73 74 61 74 75 73 3d 27 46 41 49 4c AND status='FAIL
20f0: 27 29 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 '),.
2100: 20 20 20 20 20 70 61 73 73 5f 63 6f 75 6e 74 3d pass_count=
2110: 28 53 45 4c 45 43 54 20 63 6f 75 6e 74 28 69 64 (SELECT count(id
2120: 29 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 ) FROM tests WHE
2130: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
2140: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
2150: 74 65 6d 5f 70 61 74 68 20 21 3d 20 27 27 20 41 tem_path != '' A
2160: 4e 44 20 28 73 74 61 74 75 73 3d 27 50 41 53 53 ND (status='PASS
2170: 27 20 4f 52 20 73 74 61 74 75 73 3d 27 57 41 52 ' OR status='WAR
2180: 4e 27 20 4f 52 20 73 74 61 74 75 73 3d 27 57 41 N' OR status='WA
2190: 49 56 45 44 27 29 29 0a 20 20 20 20 20 20 20 20 IVED')).
21a0: 20 20 20 20 20 57 48 45 52 45 20 72 75 6e 5f 69 WHERE run_i
21b0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
21c0: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
21d0: 3d 27 27 3b 22 0a 09 20 20 20 72 75 6e 2d 69 64 ='';".. run-id
21e0: 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 test-name run-i
21f0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d d test-name run-
2200: 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 id test-name)..
2210: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 (if (equal? sta
2220: 74 75 73 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b tus "RUNNING") ;
2230: 3b 20 72 75 6e 6e 69 6e 67 20 74 61 6b 65 73 20 ; running takes
2240: 70 72 69 6f 72 69 74 79 20 6f 76 65 72 20 61 6c priority over al
2250: 6c 20 6f 74 68 65 72 20 73 74 61 74 65 73 2c 20 l other states,
2260: 66 6f 72 63 65 20 74 68 65 20 74 65 73 74 20 73 force the test s
2270: 74 61 74 65 20 74 6f 20 52 55 4e 4e 49 4e 47 0a tate to RUNNING.
2280: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a . (sqlite3:
2290: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
22a0: 54 45 20 74 65 73 74 73 20 53 45 54 20 73 74 61 TE tests SET sta
22b0: 74 65 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 te=? WHERE run_i
22c0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
22d0: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
22e0: 3d 27 27 3b 22 20 72 75 6e 2d 69 64 20 74 65 73 ='';" run-id tes
22f0: 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 t-name).. (
2300: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 0a sqlite3:execute.
2310: 09 20 20 20 20 20 20 20 64 62 0a 09 20 20 20 20 . db..
2320: 20 20 20 22 55 50 44 41 54 45 20 74 65 73 74 73 "UPDATE tests
2330: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2340: 20 20 20 20 20 20 20 20 53 45 54 20 73 74 61 74 SET stat
2350: 65 3d 43 41 53 45 20 57 48 45 4e 20 28 53 45 4c e=CASE WHEN (SEL
2360: 45 43 54 20 63 6f 75 6e 74 28 69 64 29 20 46 52 ECT count(id) FR
2370: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 OM tests WHERE r
2380: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
2390: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
23a0: 70 61 74 68 20 21 3d 20 27 27 20 41 4e 44 20 73 path != '' AND s
23b0: 74 61 74 65 20 69 6e 20 28 27 52 55 4e 4e 49 4e tate in ('RUNNIN
23c0: 47 27 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 G','NOT_STARTED'
23d0: 29 29 20 3e 20 30 20 54 48 45 4e 20 0a 20 20 20 )) > 0 THEN .
23e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23f0: 20 20 20 20 20 20 20 27 52 55 4e 4e 49 4e 47 27 'RUNNING'
2400: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2410: 20 20 20 20 20 20 20 20 45 4c 53 45 20 27 43 4f ELSE 'CO
2420: 4d 50 4c 45 54 45 44 27 20 45 4e 44 2c 0a 20 20 MPLETED' END,.
2430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2440: 20 20 20 20 20 20 20 20 73 74 61 74 75 73 3d 43 status=C
2450: 41 53 45 20 57 48 45 4e 20 66 61 69 6c 5f 63 6f ASE WHEN fail_co
2460: 75 6e 74 20 3e 20 30 20 54 48 45 4e 20 27 46 41 unt > 0 THEN 'FA
2470: 49 4c 27 20 57 48 45 4e 20 70 61 73 73 5f 63 6f IL' WHEN pass_co
2480: 75 6e 74 20 3e 20 30 20 41 4e 44 20 66 61 69 6c unt > 0 AND fail
2490: 5f 63 6f 75 6e 74 3d 30 20 54 48 45 4e 20 27 50 _count=0 THEN 'P
24a0: 41 53 53 27 20 45 4c 53 45 20 27 55 4e 4b 4e 4f ASS' ELSE 'UNKNO
24b0: 57 4e 27 20 45 4e 44 0a 20 20 20 20 20 20 20 20 WN' END.
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 57 W
24d0: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
24e0: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
24f0: 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a item_path='';".
2500: 09 20 20 20 20 20 20 20 72 75 6e 2d 69 64 20 74 . run-id t
2510: 65 73 74 2d 6e 61 6d 65 20 72 75 6e 2d 69 64 20 est-name run-id
2520: 74 65 73 74 2d 6e 61 6d 65 29 29 29 29 0a 20 20 test-name)))).
2530: 20 20 28 69 66 20 28 6f 72 20 28 61 6e 64 20 28 (if (or (and (
2540: 73 74 72 69 6e 67 3f 20 63 6f 6d 6d 65 6e 74 29 string? comment)
2550: 0a 09 09 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 ... (string-matc
2560: 68 20 28 72 65 67 65 78 70 20 22 5c 5c 53 2b 22 h (regexp "\\S+"
2570: 29 20 63 6f 6d 6d 65 6e 74 29 29 0a 09 20 20 20 ) comment))..
2580: 20 77 61 69 76 65 64 29 0a 09 28 73 71 6c 69 74 waived)..(sqlit
2590: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
25a0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
25b0: 63 6f 6d 6d 65 6e 74 3d 3f 20 57 48 45 52 45 20 comment=? WHERE
25c0: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
25d0: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
25e0: 5f 70 61 74 68 3d 3f 3b 22 0a 09 09 09 20 28 69 _path=?;".... (i
25f0: 66 20 77 61 69 76 65 64 20 77 61 69 76 65 64 20 f waived waived
2600: 63 6f 6d 6d 65 6e 74 29 20 72 75 6e 2d 69 64 20 comment) run-id
2610: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
2620: 61 74 68 29 29 0a 20 20 20 20 29 29 0a 0a 28 64 ath)). ))..(d
2630: 65 66 69 6e 65 20 28 74 65 73 74 2d 73 65 74 2d efine (test-set-
2640: 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 log! db run-id t
2650: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
2660: 20 6c 6f 67 66 29 20 0a 20 20 28 6c 65 74 20 28 logf) . (let (
2670: 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d (item-path (item
2680: 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
2690: 64 61 74 29 29 29 0a 20 20 20 20 28 73 71 6c 69 dat))). (sqli
26a0: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
26b0: 55 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 UPDATE tests SET
26c0: 20 66 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 final_logf=? WH
26d0: 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 ERE run_id=? AND
26e0: 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 testname=? AND
26f0: 69 74 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 0a 09 item_path=?;" ..
2700: 09 20 20 20 20 20 6c 6f 67 66 20 72 75 6e 2d 69 . logf run-i
2710: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
2720: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
2730: 65 20 28 74 65 73 74 2d 73 65 74 2d 74 6f 70 6c e (test-set-topl
2740: 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 og! db run-id te
2750: 73 74 2d 6e 61 6d 65 20 6c 6f 67 66 29 20 0a 20 st-name logf) .
2760: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
2770: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
2780: 74 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c 6f 67 ts SET final_log
2790: 66 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 f=? WHERE run_id
27a0: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
27b0: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
27c0: 27 27 3b 22 20 0a 09 09 20 20 20 6c 6f 67 66 20 '';" ... logf
27d0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
27e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
27f0: 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ts:summarize-ite
2800: 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ms db run-id tes
2810: 74 2d 6e 61 6d 65 20 66 6f 72 63 65 29 0a 20 20 t-name force).
2820: 3b 3b 20 69 66 20 6e 6f 74 20 66 6f 72 63 65 20 ;; if not force
2830: 74 68 65 6e 20 6f 6e 6c 79 20 75 70 64 61 74 65 then only update
2840: 20 74 68 65 20 72 65 63 6f 72 64 20 69 66 20 6f the record if o
2850: 6e 65 20 6f 66 20 74 68 65 73 65 20 69 73 20 74 ne of these is t
2860: 72 75 65 3a 0a 20 20 3b 3b 20 20 20 31 2e 20 6c rue:. ;; 1. l
2870: 6f 67 66 20 69 73 20 22 6c 6f 67 2f 66 69 6e 61 ogf is "log/fina
2880: 6c 2e 6c 6f 67 0a 20 20 3b 3b 20 20 20 32 2e 20 l.log. ;; 2.
2890: 6c 6f 67 66 20 69 73 20 73 61 6d 65 20 61 73 20 logf is same as
28a0: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 0a 20 outputfilename.
28b0: 20 28 6c 65 74 20 28 28 6f 75 74 70 75 74 66 69 (let ((outputfi
28c0: 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 20 22 6d 65 lename (conc "me
28d0: 67 61 74 65 73 74 2d 72 6f 6c 6c 75 70 2d 22 20 gatest-rollup-"
28e0: 74 65 73 74 2d 6e 61 6d 65 20 22 2e 68 74 6d 6c test-name ".html
28f0: 22 29 29 0a 09 28 6f 72 69 67 2d 64 69 72 20 20 "))..(orig-dir
2900: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 (current-di
2910: 72 65 63 74 6f 72 79 29 29 0a 09 28 6c 6f 67 66 rectory))..(logf
2920: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 0a #f)).
2930: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 (sqlite3:for
2940: 2d 65 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 -each-row .
2950: 28 6c 61 6d 62 64 61 20 28 70 61 74 68 20 66 69 (lambda (path fi
2960: 6e 61 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 nal_logf).
2970: 20 28 73 65 74 21 20 6c 6f 67 66 20 66 69 6e 61 (set! logf fina
2980: 6c 5f 6c 6f 67 66 29 0a 20 20 20 20 20 20 20 28 l_logf). (
2990: 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 70 if (directory? p
29a0: 61 74 68 29 0a 09 20 20 20 28 62 65 67 69 6e 0a ath).. (begin.
29b0: 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 6f . (print "Fo
29c0: 75 6e 64 20 70 61 74 68 3a 20 22 20 70 61 74 68 und path: " path
29d0: 29 0a 09 20 20 20 20 20 28 63 68 61 6e 67 65 2d ).. (change-
29e0: 64 69 72 65 63 74 6f 72 79 20 70 61 74 68 29 29 directory path))
29f0: 0a 09 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 .. ;; (set!
2a00: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 28 outputfilename (
2a10: 63 6f 6e 63 20 70 61 74 68 20 22 2f 22 20 6f 75 conc path "/" ou
2a20: 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 29 29 0a tputfilename))).
2a30: 09 20 20 20 28 70 72 69 6e 74 20 22 4e 6f 20 73 . (print "No s
2a40: 75 63 68 20 70 61 74 68 3a 20 22 20 70 61 74 68 uch path: " path
2a50: 29 29 29 0a 20 20 20 20 20 64 62 20 0a 20 20 20 ))). db .
2a60: 20 20 22 53 45 4c 45 43 54 20 72 75 6e 64 69 72 "SELECT rundir
2a70: 2c 66 69 6e 61 6c 5f 6c 6f 67 66 20 46 52 4f 4d ,final_logf FROM
2a80: 20 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e tests WHERE run
2a90: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
2aa0: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
2ab0: 74 68 3d 27 27 3b 22 0a 20 20 20 20 20 72 75 6e th='';". run
2ac0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 -id test-name).
2ad0: 20 20 20 28 70 72 69 6e 74 20 22 73 75 6d 6d 61 (print "summa
2ae0: 72 69 7a 65 2d 69 74 65 6d 73 20 77 69 74 68 20 rize-items with
2af0: 6c 6f 67 66 20 22 20 6c 6f 67 66 29 0a 20 20 20 logf " logf).
2b00: 20 28 69 66 20 28 6f 72 20 28 65 71 75 61 6c 3f (if (or (equal?
2b10: 20 6c 6f 67 66 20 22 6c 6f 67 73 2f 66 69 6e 61 logf "logs/fina
2b20: 6c 2e 6c 6f 67 22 29 0a 09 20 20 20 20 28 65 71 l.log").. (eq
2b30: 75 61 6c 3f 20 6c 6f 67 66 20 6f 75 74 70 75 74 ual? logf output
2b40: 66 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 66 filename).. f
2b50: 6f 72 63 65 29 0a 09 28 62 65 67 69 6e 0a 09 20 orce)..(begin..
2b60: 20 28 69 66 20 28 6f 62 74 61 69 6e 2d 64 6f 74 (if (obtain-dot
2b70: 2d 6c 6f 63 6b 20 6f 75 74 70 75 74 66 69 6c 65 -lock outputfile
2b80: 6e 61 6d 65 20 31 20 32 30 20 33 30 29 20 3b 3b name 1 20 30) ;;
2b90: 20 72 65 74 72 79 20 65 76 65 72 79 20 73 65 63 retry every sec
2ba0: 6f 6e 64 20 66 6f 72 20 32 30 20 73 65 63 6f 6e ond for 20 secon
2bb0: 64 73 2c 20 63 61 6c 6c 20 69 74 20 64 65 61 64 ds, call it dead
2bc0: 20 61 66 74 65 72 20 33 30 20 73 65 63 6f 6e 64 after 30 second
2bd0: 73 20 61 6e 64 20 73 74 65 61 6c 20 74 68 65 20 s and steal the
2be0: 6c 6f 63 6b 0a 09 20 20 20 20 20 20 28 70 72 69 lock.. (pri
2bf0: 6e 74 20 22 4f 62 74 61 69 6e 65 64 20 6c 6f 63 nt "Obtained loc
2c00: 6b 20 66 6f 72 20 22 20 6f 75 74 70 75 74 66 69 k for " outputfi
2c10: 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 lename).. (
2c20: 70 72 69 6e 74 20 22 46 61 69 6c 65 64 20 74 6f print "Failed to
2c30: 20 6f 62 74 61 69 6e 20 6c 6f 63 6b 20 66 6f 72 obtain lock for
2c40: 20 22 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d " outputfilenam
2c50: 65 29 29 0a 09 20 20 28 6c 65 74 20 28 28 6f 75 e)).. (let ((ou
2c60: 70 20 20 20 20 28 6f 70 65 6e 2d 6f 75 74 70 75 p (open-outpu
2c70: 74 2d 66 69 6c 65 20 6f 75 74 70 75 74 66 69 6c t-file outputfil
2c80: 65 6e 61 6d 65 29 29 0a 09 09 28 63 6f 75 6e 74 ename))...(count
2c90: 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 s (make-hash-tab
2ca0: 6c 65 29 29 0a 09 09 28 73 74 61 74 65 63 6f 75 le))...(statecou
2cb0: 6e 74 73 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 nts (make-hash-t
2cc0: 61 62 6c 65 29 29 0a 09 09 28 6f 75 74 74 78 74 able))...(outtxt
2cd0: 20 22 22 29 0a 09 09 28 74 6f 74 20 20 20 20 30 "")...(tot 0
2ce0: 29 29 0a 09 20 20 20 20 28 77 69 74 68 2d 6f 75 )).. (with-ou
2cf0: 74 70 75 74 2d 74 6f 2d 70 6f 72 74 0a 09 09 6f tput-to-port...o
2d00: 75 70 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 up.. (lambd
2d10: 61 20 28 29 0a 09 09 28 73 65 74 21 20 6f 75 74 a ()...(set! out
2d20: 74 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 78 74 txt (conc outtxt
2d30: 20 22 3c 68 74 6d 6c 3e 3c 74 69 74 6c 65 3e 53 "<html><title>S
2d40: 75 6d 6d 61 72 79 3a 20 22 20 74 65 73 74 2d 6e ummary: " test-n
2d50: 61 6d 65 20 0a 09 09 09 09 20 20 20 22 3c 2f 74 ame ..... "</t
2d60: 69 74 6c 65 3e 3c 62 6f 64 79 3e 3c 68 32 3e 53 itle><body><h2>S
2d70: 75 6d 6d 61 72 79 20 66 6f 72 20 22 20 74 65 73 ummary for " tes
2d80: 74 2d 6e 61 6d 65 20 22 3c 2f 68 32 3e 22 29 29 t-name "</h2>"))
2d90: 0a 09 09 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d ...(sqlite3:for-
2da0: 65 61 63 68 2d 72 6f 77 20 0a 09 09 20 28 6c 61 each-row ... (la
2db0: 6d 62 64 61 20 28 69 64 20 69 74 65 6d 70 61 74 mbda (id itempat
2dc0: 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 72 h state status r
2dd0: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 6c 6f 67 66 un_duration logf
2de0: 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 20 20 28 comment)... (
2df0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
2e00: 63 6f 75 6e 74 73 20 73 74 61 74 75 73 20 28 2b counts status (+
2e10: 20 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 1 (hash-table-r
2e20: 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 75 6e 74 ef/default count
2e30: 73 20 73 74 61 74 75 73 20 30 29 29 29 0a 09 09 s status 0)))...
2e40: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
2e50: 65 74 21 20 73 74 61 74 65 63 6f 75 6e 74 73 20 et! statecounts
2e60: 73 74 61 74 65 20 28 2b 20 31 20 28 68 61 73 68 state (+ 1 (hash
2e70: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
2e80: 6c 74 20 73 74 61 74 65 63 6f 75 6e 74 73 20 73 lt statecounts s
2e90: 74 61 74 65 20 30 29 29 29 0a 09 09 20 20 20 28 tate 0)))... (
2ea0: 73 65 74 21 20 6f 75 74 74 78 74 20 28 63 6f 6e set! outtxt (con
2eb0: 63 20 6f 75 74 74 78 74 20 22 3c 74 72 3e 22 0a c outtxt "<tr>".
2ec0: 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 3e 3c .... "<td><
2ed0: 61 20 68 72 65 66 3d 5c 22 22 20 69 74 65 6d 70 a href=\"" itemp
2ee0: 61 74 68 20 22 2f 22 20 6c 6f 67 66 20 22 5c 22 ath "/" logf "\"
2ef0: 3e 20 22 20 69 74 65 6d 70 61 74 68 20 22 3c 2f > " itempath "</
2f00: 61 3e 3c 2f 74 64 3e 22 20 0a 09 09 09 09 20 20 a></td>" .....
2f10: 20 20 20 20 22 3c 74 64 3e 22 20 73 74 61 74 65 "<td>" state
2f20: 20 20 20 20 22 3c 2f 74 64 3e 22 20 0a 09 09 09 "</td>" ....
2f30: 09 20 20 20 20 20 20 22 3c 74 64 3e 3c 66 6f 6e . "<td><fon
2f40: 74 20 63 6f 6c 6f 72 3d 22 20 28 63 6f 6d 6d 6f t color=" (commo
2f50: 6e 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 72 6f 6d n:get-color-from
2f60: 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 29 0a -status status).
2f70: 09 09 09 09 20 20 20 20 20 20 22 3e 22 20 20 20 .... ">"
2f80: 73 74 61 74 75 73 20 20 20 22 3c 2f 66 6f 6e 74 status "</font
2f90: 3e 3c 2f 74 64 3e 22 0a 09 09 09 09 20 20 20 20 ></td>".....
2fa0: 20 20 22 3c 74 64 3e 22 20 28 69 66 20 28 65 71 "<td>" (if (eq
2fb0: 75 61 6c 3f 20 63 6f 6d 6d 65 6e 74 20 22 22 29 ual? comment "")
2fc0: 0a 09 09 09 09 09 09 20 22 26 6e 62 73 70 3b 22 ....... " "
2fd0: 0a 09 09 09 09 09 09 20 63 6f 6d 6d 65 6e 74 29 ....... comment)
2fe0: 20 22 3c 2f 74 64 3e 22 0a 09 09 09 09 09 09 20 "</td>".......
2ff0: 22 3c 2f 74 72 3e 22 29 29 29 0a 09 09 20 64 62 "</tr>")))... db
3000: 0a 09 09 20 22 53 45 4c 45 43 54 20 69 64 2c 69 ... "SELECT id,i
3010: 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 2c 73 tem_path,state,s
3020: 74 61 74 75 73 2c 72 75 6e 5f 64 75 72 61 74 69 tatus,run_durati
3030: 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 66 2c 63 6f on,final_logf,co
3040: 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 73 mment FROM tests
3050: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
3060: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
3070: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
3080: 27 27 3b 22 0a 09 09 20 72 75 6e 2d 69 64 20 74 '';"... run-id t
3090: 65 73 74 2d 6e 61 6d 65 29 0a 0a 09 09 28 70 72 est-name)....(pr
30a0: 69 6e 74 20 22 3c 74 61 62 6c 65 3e 3c 74 72 3e int "<table><tr>
30b0: 3c 74 64 20 76 61 6c 69 67 6e 3d 5c 22 74 6f 70 <td valign=\"top
30c0: 5c 22 3e 22 29 0a 09 09 3b 3b 20 50 72 69 6e 74 \">")...;; Print
30d0: 20 6f 75 74 20 73 74 61 74 73 20 66 6f 72 20 73 out stats for s
30e0: 74 61 74 75 73 0a 09 09 28 73 65 74 21 20 74 6f tatus...(set! to
30f0: 74 20 30 29 0a 09 09 28 70 72 69 6e 74 20 22 3c t 0)...(print "<
3100: 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 6e table cellspacin
3110: 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d 5c g=\"0\" border=\
3120: 22 31 5c 22 3e 3c 74 72 3e 3c 74 64 20 63 6f 6c "1\"><tr><td col
3130: 73 70 61 6e 3d 5c 22 32 5c 22 3e 3c 68 32 3e 53 span=\"2\"><h2>S
3140: 74 61 74 65 20 73 74 61 74 73 3c 2f 68 32 3e 3c tate stats</h2><
3150: 2f 74 64 3e 3c 2f 74 72 3e 22 29 0a 09 09 28 66 /td></tr>")...(f
3160: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
3170: 28 73 74 61 74 65 29 0a 09 09 09 20 20 20 20 28 (state).... (
3180: 73 65 74 21 20 74 6f 74 20 28 2b 20 74 6f 74 20 set! tot (+ tot
3190: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
31a0: 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 61 74 statecounts stat
31b0: 65 29 29 29 0a 09 09 09 20 20 20 20 28 70 72 69 e))).... (pri
31c0: 6e 74 20 22 3c 74 72 3e 3c 74 64 3e 22 20 73 74 nt "<tr><td>" st
31d0: 61 74 65 20 22 3c 2f 74 64 3e 3c 74 64 3e 22 20 ate "</td><td>"
31e0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
31f0: 73 74 61 74 65 63 6f 75 6e 74 73 20 73 74 61 74 statecounts stat
3200: 65 29 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 22 29 e) "</td></tr>")
3210: 29 0a 09 09 09 20 20 28 68 61 73 68 2d 74 61 62 ).... (hash-tab
3220: 6c 65 2d 6b 65 79 73 20 73 74 61 74 65 63 6f 75 le-keys statecou
3230: 6e 74 73 29 29 0a 09 09 28 70 72 69 6e 74 20 22 nts))...(print "
3240: 3c 74 72 3e 3c 74 64 3e 54 6f 74 61 6c 3c 2f 74 <tr><td>Total</t
3250: 64 3e 3c 74 64 3e 22 20 74 6f 74 20 22 3c 2f 74 d><td>" tot "</t
3260: 64 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 3e 22 d></tr></table>"
3270: 29 0a 09 09 28 70 72 69 6e 74 20 22 3c 2f 74 64 )...(print "</td
3280: 3e 3c 74 64 20 76 61 6c 69 67 6e 3d 5c 22 74 6f ><td valign=\"to
3290: 70 5c 22 3e 22 29 0a 09 09 3b 3b 20 50 72 69 6e p\">")...;; Prin
32a0: 74 20 6f 75 74 20 73 74 61 74 73 20 66 6f 72 20 t out stats for
32b0: 73 74 61 74 65 0a 09 09 28 73 65 74 21 20 74 6f state...(set! to
32c0: 74 20 30 29 0a 09 09 28 70 72 69 6e 74 20 22 3c t 0)...(print "<
32d0: 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 6e table cellspacin
32e0: 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d 5c g=\"0\" border=\
32f0: 22 31 5c 22 3e 3c 74 72 3e 3c 74 64 20 63 6f 6c "1\"><tr><td col
3300: 73 70 61 6e 3d 5c 22 32 5c 22 3e 3c 68 32 3e 53 span=\"2\"><h2>S
3310: 74 61 74 75 73 20 73 74 61 74 73 3c 2f 68 32 3e tatus stats</h2>
3320: 3c 2f 74 64 3e 3c 2f 74 72 3e 22 29 0a 09 09 28 </td></tr>")...(
3330: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
3340: 20 28 73 74 61 74 75 73 29 0a 09 09 09 20 20 20 (status)....
3350: 20 28 73 65 74 21 20 74 6f 74 20 28 2b 20 74 6f (set! tot (+ to
3360: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
3370: 66 20 63 6f 75 6e 74 73 20 73 74 61 74 75 73 29 f counts status)
3380: 29 29 0a 09 09 09 20 20 20 20 28 70 72 69 6e 74 )).... (print
3390: 20 22 3c 74 72 3e 3c 74 64 3e 3c 66 6f 6e 74 20 "<tr><td><font
33a0: 63 6f 6c 6f 72 3d 5c 22 22 20 28 63 6f 6d 6d 6f color=\"" (commo
33b0: 6e 3a 67 65 74 2d 63 6f 6c 6f 72 2d 66 72 6f 6d n:get-color-from
33c0: 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 29 20 -status status)
33d0: 22 5c 22 3e 22 20 73 74 61 74 75 73 0a 09 09 09 "\">" status....
33e0: 09 20 20 20 22 3c 2f 66 6f 6e 74 3e 3c 2f 74 64 . "</font></td
33f0: 3e 3c 74 64 3e 22 20 28 68 61 73 68 2d 74 61 62 ><td>" (hash-tab
3400: 6c 65 2d 72 65 66 20 63 6f 75 6e 74 73 20 73 74 le-ref counts st
3410: 61 74 75 73 29 20 22 3c 2f 74 64 3e 3c 2f 74 72 atus) "</td></tr
3420: 3e 22 29 29 0a 09 09 09 20 20 28 68 61 73 68 2d >")).... (hash-
3430: 74 61 62 6c 65 2d 6b 65 79 73 20 63 6f 75 6e 74 table-keys count
3440: 73 29 29 0a 09 09 28 70 72 69 6e 74 20 22 3c 74 s))...(print "<t
3450: 72 3e 3c 74 64 3e 54 6f 74 61 6c 3c 2f 74 64 3e r><td>Total</td>
3460: 3c 74 64 3e 22 20 74 6f 74 20 22 3c 2f 74 64 3e <td>" tot "</td>
3470: 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 3e 22 29 0a </tr></table>").
3480: 09 09 28 70 72 69 6e 74 20 22 3c 2f 74 64 3e 3c ..(print "</td><
3490: 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 61 62 6c 65 /td></tr></table
34a0: 3e 22 29 0a 0a 09 09 28 70 72 69 6e 74 20 22 3c >")....(print "<
34b0: 74 61 62 6c 65 20 63 65 6c 6c 73 70 61 63 69 6e table cellspacin
34c0: 67 3d 5c 22 30 5c 22 20 62 6f 72 64 65 72 3d 5c g=\"0\" border=\
34d0: 22 31 5c 22 3e 22 20 0a 09 09 20 20 20 20 20 20 "1\">" ...
34e0: 20 22 3c 74 72 3e 3c 74 64 3e 49 74 65 6d 3c 2f "<tr><td>Item</
34f0: 74 64 3e 3c 74 64 3e 53 74 61 74 65 3c 2f 74 64 td><td>State</td
3500: 3e 3c 74 64 3e 53 74 61 74 75 73 3c 2f 74 64 3e ><td>Status</td>
3510: 3c 74 64 3e 43 6f 6d 6d 65 6e 74 3c 2f 74 64 3e <td>Comment</td>
3520: 22 0a 09 09 20 20 20 20 20 20 20 6f 75 74 74 78 "... outtx
3530: 74 20 22 3c 2f 74 61 62 6c 65 3e 3c 2f 62 6f 64 t "</table></bod
3540: 79 3e 3c 2f 68 74 6d 6c 3e 22 29 0a 09 09 28 72 y></html>")...(r
3550: 65 6c 65 61 73 65 2d 64 6f 74 2d 6c 6f 63 6b 20 elease-dot-lock
3560: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 29 outputfilename))
3570: 29 0a 09 20 20 20 20 28 63 6c 6f 73 65 2d 6f 75 ).. (close-ou
3580: 74 70 75 74 2d 70 6f 72 74 20 6f 75 70 29 0a 09 tput-port oup)..
3590: 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 (change-dire
35a0: 63 74 6f 72 79 20 6f 72 69 67 2d 64 69 72 29 0a ctory orig-dir).
35b0: 09 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d 74 . (test-set-t
35c0: 6f 70 6c 6f 67 21 20 64 62 20 72 75 6e 2d 69 64 oplog! db run-id
35d0: 20 74 65 73 74 2d 6e 61 6d 65 20 6f 75 74 70 75 test-name outpu
35e0: 74 66 69 6c 65 6e 61 6d 65 29 0a 09 20 20 20 20 tfilename)..
35f0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
3600: 67 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 get-all-legal-te
3610: 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 sts). (let* ((t
3620: 65 73 74 73 20 20 28 67 6c 6f 62 20 28 63 6f 6e ests (glob (con
3630: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 74 65 c *toppath* "/te
3640: 73 74 73 2f 2a 22 29 29 29 0a 09 20 28 72 65 73 sts/*"))).. (res
3650: 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 28 64 '())). (d
3660: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e ebug:print 4 "IN
3670: 46 4f 3a 20 4c 6f 6f 6b 69 6e 67 20 61 74 20 74 FO: Looking at t
3680: 65 73 74 73 20 22 20 28 73 74 72 69 6e 67 2d 69 ests " (string-i
3690: 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 74 73 ntersperse tests
36a0: 20 22 2c 22 29 29 0a 20 20 20 20 28 66 6f 72 2d ",")). (for-
36b0: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 74 65 each (lambda (te
36c0: 73 74 70 61 74 68 29 0a 09 09 28 69 66 20 28 66 stpath)...(if (f
36d0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e ile-exists? (con
36e0: 63 20 74 65 73 74 70 61 74 68 20 22 2f 74 65 73 c testpath "/tes
36f0: 74 63 6f 6e 66 69 67 22 29 29 0a 09 09 20 20 20 tconfig"))...
3700: 20 28 73 65 74 21 20 72 65 73 20 28 63 6f 6e 73 (set! res (cons
3710: 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 2d 73 (last (string-s
3720: 70 6c 69 74 20 74 65 73 74 70 61 74 68 20 22 2f plit testpath "/
3730: 22 29 29 20 72 65 73 29 29 29 29 0a 09 20 20 20 ")) res))))..
3740: 20 20 20 74 65 73 74 73 29 0a 20 20 20 20 72 65 tests). re
3750: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 s))..(define (te
3760: 73 74 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 st:get-testconfi
3770: 67 20 74 65 73 74 2d 6e 61 6d 65 20 73 79 73 74 g test-name syst
3780: 65 6d 2d 61 6c 6c 6f 77 65 64 29 0a 20 20 28 6c em-allowed). (l
3790: 65 74 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 et* ((test-path
37a0: 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 (conc *toppat
37b0: 68 2a 20 22 2f 74 65 73 74 73 2f 22 20 74 65 73 h* "/tests/" tes
37c0: 74 2d 6e 61 6d 65 29 29 0a 09 20 28 74 65 73 74 t-name)).. (test
37d0: 2d 63 6f 6e 66 69 67 66 20 28 63 6f 6e 63 20 74 -configf (conc t
37e0: 65 73 74 2d 70 61 74 68 20 22 2f 74 65 73 74 63 est-path "/testc
37f0: 6f 6e 66 69 67 22 29 29 0a 09 20 28 74 65 73 74 onfig")).. (test
3800: 65 78 69 73 74 73 20 20 20 28 61 6e 64 20 28 66 exists (and (f
3810: 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 73 74 ile-exists? test
3820: 2d 63 6f 6e 66 69 67 66 29 28 66 69 6c 65 2d 72 -configf)(file-r
3830: 65 61 64 2d 61 63 63 65 73 73 3f 20 74 65 73 74 ead-access? test
3840: 2d 63 6f 6e 66 69 67 66 29 29 29 29 0a 20 20 20 -configf)))).
3850: 20 28 69 66 20 74 65 73 74 65 78 69 73 74 73 0a (if testexists.
3860: 09 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 74 65 .(read-config te
3870: 73 74 2d 63 6f 6e 66 69 67 66 20 23 66 20 73 79 st-configf #f sy
3880: 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 20 65 6e 76 stem-allowed env
3890: 69 72 6f 6e 2d 70 61 74 74 3a 20 28 69 66 20 73 iron-patt: (if s
38a0: 79 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 0a 09 09 ystem-allowed...
38b0: 09 09 09 09 09 09 20 20 20 20 20 20 22 70 72 65 ...... "pre
38c0: 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 -launch-env-vars
38d0: 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ".........
38e0: 23 66 29 29 0a 09 23 66 29 29 29 0a 20 20 0a 3b #f))..#f))). .;
38f0: 3b 20 73 6f 72 74 20 74 65 73 74 73 20 62 79 20 ; sort tests by
3900: 70 72 69 6f 72 69 74 79 20 61 6e 64 20 77 61 69 priority and wai
3910: 74 6f 6e 0a 3b 3b 20 4d 6f 76 65 20 74 65 73 74 ton.;; Move test
3920: 20 73 70 65 63 69 66 69 63 20 73 74 75 66 66 20 specific stuff
3930: 74 6f 20 61 20 74 65 73 74 20 75 6e 69 74 20 46 to a test unit F
3940: 49 58 4d 45 20 6f 6e 65 20 6f 66 20 74 68 65 73 IXME one of thes
3950: 65 20 64 61 79 73 0a 28 64 65 66 69 6e 65 20 28 e days.(define (
3960: 74 65 73 74 73 3a 73 6f 72 74 2d 62 79 2d 70 72 tests:sort-by-pr
3970: 69 6f 72 69 74 79 2d 61 6e 64 2d 77 61 69 74 6f iority-and-waito
3980: 6e 20 74 65 73 74 2d 6e 61 6d 65 73 29 0a 20 20 n test-names).
3990: 28 6c 65 74 20 28 28 74 65 73 74 64 65 74 61 69 (let ((testdetai
39a0: 6c 73 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d ls (make-hash-
39b0: 74 61 62 6c 65 29 29 0a 09 28 6d 75 6e 67 65 70 table))..(mungep
39c0: 72 69 6f 72 69 74 79 20 28 6c 61 6d 62 64 61 20 riority (lambda
39d0: 28 70 72 69 6f 72 69 74 79 29 0a 09 09 09 20 28 (priority).... (
39e0: 69 66 20 70 72 69 6f 72 69 74 79 0a 09 09 09 20 if priority....
39f0: 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 28 (let ((tmp (
3a00: 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 70 72 69 6f any->number prio
3a10: 72 69 74 79 29 29 29 0a 09 09 09 20 20 20 20 20 rity)))....
3a20: 20 20 28 69 66 20 74 6d 70 20 74 6d 70 20 28 62 (if tmp tmp (b
3a30: 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e egin (debug:prin
3a40: 74 20 30 20 22 45 52 52 4f 52 3a 20 62 61 64 20 t 0 "ERROR: bad
3a50: 70 72 69 6f 72 69 74 79 20 76 61 6c 75 65 20 22 priority value "
3a60: 20 70 72 69 6f 72 69 74 79 20 22 2c 20 75 73 69 priority ", usi
3a70: 6e 67 20 30 22 29 20 30 29 29 29 0a 09 09 09 20 ng 0") 0)))....
3a80: 20 20 20 20 30 29 29 29 29 0a 20 20 20 20 28 66 0)))). (f
3a90: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
3aa0: 28 74 65 73 74 2d 6e 61 6d 65 29 0a 09 09 28 6c (test-name)...(l
3ab0: 65 74 20 28 28 74 65 73 74 2d 63 6f 6e 66 69 67 et ((test-config
3ac0: 20 28 74 65 73 74 3a 67 65 74 2d 74 65 73 74 63 (test:get-testc
3ad0: 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 onfig test-name
3ae0: 23 66 29 29 29 0a 09 09 20 20 28 69 66 20 74 65 #f)))... (if te
3af0: 73 74 2d 63 6f 6e 66 69 67 20 28 68 61 73 68 2d st-config (hash-
3b00: 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 74 64 table-set! testd
3b10: 65 74 61 69 6c 73 20 74 65 73 74 2d 6e 61 6d 65 etails test-name
3b20: 20 74 65 73 74 2d 63 6f 6e 66 69 67 29 29 29 29 test-config))))
3b30: 0a 09 20 20 20 20 20 20 74 65 73 74 2d 6e 61 6d .. test-nam
3b40: 65 73 29 0a 20 20 20 20 28 73 6f 72 74 20 0a 20 es). (sort .
3b50: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
3b60: 6b 65 79 73 20 74 65 73 74 64 65 74 61 69 6c 73 keys testdetails
3b70: 29 20 3b 3b 20 61 76 6f 69 64 20 64 65 61 6c 69 ) ;; avoid deali
3b80: 6e 67 20 77 69 74 68 20 64 65 6c 65 74 65 64 20 ng with deleted
3b90: 74 65 73 74 73 2c 20 6c 6f 6f 6b 20 61 74 20 74 tests, look at t
3ba0: 68 65 20 68 61 73 68 20 74 61 62 6c 65 0a 20 20 he hash table.
3bb0: 20 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 (lambda (a b)
3bc0: 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
3bd0: 74 63 6f 6e 66 2d 61 20 20 20 28 68 61 73 68 2d tconf-a (hash-
3be0: 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 64 65 table-ref testde
3bf0: 74 61 69 6c 73 20 61 29 29 0a 09 20 20 20 20 20 tails a))..
3c00: 20 28 74 63 6f 6e 66 2d 62 20 20 20 28 68 61 73 (tconf-b (has
3c10: 68 2d 74 61 62 6c 65 2d 72 65 66 20 74 65 73 74 h-table-ref test
3c20: 64 65 74 61 69 6c 73 20 62 29 29 0a 09 20 20 20 details b))..
3c30: 20 20 20 28 61 2d 77 61 69 74 6f 6e 20 20 20 28 (a-waiton (
3c40: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 config-lookup tc
3c50: 6f 6e 66 2d 61 20 22 72 65 71 75 69 72 65 6d 65 onf-a "requireme
3c60: 6e 74 73 22 20 22 77 61 69 74 6f 6e 22 29 29 0a nts" "waiton")).
3c70: 09 20 20 20 20 20 20 28 62 2d 77 61 69 74 6f 6e . (b-waiton
3c80: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
3c90: 70 20 74 63 6f 6e 66 2d 62 20 22 72 65 71 75 69 p tconf-b "requi
3ca0: 72 65 6d 65 6e 74 73 22 20 22 77 61 69 74 6f 6e rements" "waiton
3cb0: 22 29 29 0a 09 20 20 20 20 20 20 28 61 2d 70 72 ")).. (a-pr
3cc0: 69 6f 72 69 74 79 20 28 6d 75 6e 67 65 70 72 69 iority (mungepri
3cd0: 6f 72 69 74 79 20 28 63 6f 6e 66 69 67 2d 6c 6f ority (config-lo
3ce0: 6f 6b 75 70 20 74 63 6f 6e 66 2d 61 20 22 72 65 okup tconf-a "re
3cf0: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 70 72 69 quirements" "pri
3d00: 6f 72 69 74 79 22 29 29 29 0a 09 20 20 20 20 20 ority")))..
3d10: 20 28 62 2d 70 72 69 6f 72 69 74 79 20 28 6d 75 (b-priority (mu
3d20: 6e 67 65 70 72 69 6f 72 69 74 79 20 28 63 6f 6e ngepriority (con
3d30: 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 fig-lookup tconf
3d40: 2d 62 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 -b "requirements
3d50: 22 20 22 70 72 69 6f 72 69 74 79 22 29 29 29 29 " "priority"))))
3d60: 0a 09 20 28 69 66 20 28 61 6e 64 20 61 2d 77 61 .. (if (and a-wa
3d70: 69 74 6f 6e 20 28 65 71 75 61 6c 3f 20 61 2d 77 iton (equal? a-w
3d80: 61 69 74 6f 6e 20 62 29 29 0a 09 20 20 20 20 20 aiton b))..
3d90: 23 66 20 3b 3b 20 63 61 6e 6e 6f 74 20 68 61 76 #f ;; cannot hav
3da0: 65 20 61 20 77 68 69 63 68 20 69 73 20 77 61 69 e a which is wai
3db0: 74 69 6e 67 20 6f 6e 20 62 20 68 61 70 70 65 6e ting on b happen
3dc0: 69 6e 67 20 62 65 66 6f 72 65 20 62 0a 09 20 20 ing before b..
3dd0: 20 20 20 28 69 66 20 28 61 6e 64 20 62 2d 77 61 (if (and b-wa
3de0: 69 74 6f 6e 20 28 65 71 75 61 6c 3f 20 62 2d 77 iton (equal? b-w
3df0: 61 69 74 6f 6e 20 61 29 29 0a 09 09 20 23 74 20 aiton a))... #t
3e00: 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 63 ;; this is the c
3e10: 6f 72 72 65 63 74 20 6f 72 64 65 72 2c 20 62 20 orrect order, b
3e20: 69 73 20 77 61 69 74 69 6e 67 20 6f 6e 20 61 20 is waiting on a
3e30: 61 6e 64 20 62 20 69 73 20 62 65 66 6f 72 65 20 and b is before
3e40: 61 0a 09 09 20 28 69 66 20 28 3e 20 61 2d 70 72 a... (if (> a-pr
3e50: 69 6f 72 69 74 79 20 62 2d 70 72 69 6f 72 69 74 iority b-priorit
3e60: 79 29 0a 09 09 20 20 20 20 20 23 74 20 3b 3b 20 y)... #t ;;
3e70: 69 66 20 61 20 69 73 20 61 20 68 69 67 68 65 72 if a is a higher
3e80: 20 70 72 69 6f 72 69 74 79 20 74 68 61 6e 20 62 priority than b
3e90: 20 74 68 65 6e 20 77 65 20 61 72 65 20 67 6f 6f then we are goo
3ea0: 64 20 74 6f 20 67 6f 0a 09 09 20 20 20 20 20 23 d to go... #
3eb0: 66 29 29 29 29 29 29 29 29 0a 0a 0a 3b 3b 3d 3d f))))))))...;;==
3ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ed0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ee0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3ef0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f00: 3d 3d 3d 3d 0a 3b 3b 20 74 65 73 74 20 73 74 65 ====.;; test ste
3f10: 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ps.;;===========
3f20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
3f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
3f60: 66 69 6e 65 20 28 74 65 73 74 73 74 65 70 2d 73 fine (teststep-s
3f70: 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 72 75 et-status! db ru
3f80: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 74 n-id test-name t
3f90: 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 eststep-name sta
3fa0: 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 6e 20 te-in status-in
3fb0: 69 74 65 6d 64 61 74 20 63 6f 6d 6d 65 6e 74 20 itemdat comment
3fc0: 6c 6f 67 66 69 6c 65 29 0a 20 20 28 64 65 62 75 logfile). (debu
3fd0: 67 3a 70 72 69 6e 74 20 34 20 22 72 75 6e 2d 69 g:print 4 "run-i
3fe0: 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 74 65 d: " run-id " te
3ff0: 73 74 2d 6e 61 6d 65 3a 20 22 20 74 65 73 74 2d st-name: " test-
4000: 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 name). (let* ((
4010: 73 74 61 74 65 20 20 20 20 20 28 63 68 65 63 6b state (check
4020: 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 74 -valid-items "st
4030: 61 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 0a ate" state-in)).
4040: 09 20 28 73 74 61 74 75 73 20 20 20 20 28 63 68 . (status (ch
4050: 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 eck-valid-items
4060: 22 73 74 61 74 75 73 22 20 73 74 61 74 75 73 2d "status" status-
4070: 69 6e 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 in)).. (item-pat
4080: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
4090: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 28 th itemdat)).. (
40a0: 74 65 73 74 64 61 74 20 20 20 28 64 62 3a 67 65 testdat (db:ge
40b0: 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 t-test-info db r
40c0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
40d0: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 20 20 20 item-path))).
40e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 20 (debug:print 5
40f0: 22 74 65 73 74 64 61 74 3a 20 22 20 74 65 73 74 "testdat: " test
4100: 64 61 74 29 0a 20 20 20 20 28 69 66 20 28 61 6e dat). (if (an
4110: 64 20 74 65 73 74 64 61 74 20 3b 3b 20 69 66 20 d testdat ;; if
4120: 74 68 65 20 73 65 63 74 69 6f 6e 20 65 78 69 73 the section exis
4130: 74 73 20 74 68 65 6e 20 66 6f 72 63 65 20 73 70 ts then force sp
4140: 65 63 69 66 69 63 61 74 69 6f 6e 20 42 55 47 2c ecification BUG,
4150: 20 49 20 64 6f 6e 27 74 20 6c 69 6b 65 20 68 6f I don't like ho
4160: 77 20 74 68 69 73 20 77 6f 72 6b 73 2e 0a 09 20 w this works...
4170: 20 20 20 20 28 6f 72 20 28 6e 6f 74 20 73 74 61 (or (not sta
4180: 74 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 29 te)(not status))
4190: 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 )..(debug:print
41a0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 61 0 "WARNING: Inva
41b0: 6c 69 64 20 22 20 28 69 66 20 73 74 61 74 75 73 lid " (if status
41c0: 20 22 73 74 61 74 75 73 22 20 22 73 74 61 74 65 "status" "state
41d0: 22 29 0a 09 20 20 20 20 20 20 20 22 20 76 61 6c ").. " val
41e0: 75 65 20 5c 22 22 20 28 69 66 20 73 74 61 74 75 ue \"" (if statu
41f0: 73 20 73 74 61 74 65 2d 69 6e 20 73 74 61 74 75 s state-in statu
4200: 73 2d 69 6e 29 20 22 5c 22 2c 20 75 70 64 61 74 s-in) "\", updat
4210: 65 20 79 6f 75 72 20 76 61 6c 69 64 76 61 6c 75 e your validvalu
4220: 65 73 20 73 65 63 74 69 6f 6e 20 69 6e 20 6d 65 es section in me
4230: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 gatest.config"))
4240: 0a 20 20 20 20 28 69 66 20 74 65 73 74 64 61 74 . (if testdat
4250: 0a 09 28 6c 65 74 20 28 28 74 65 73 74 2d 69 64 ..(let ((test-id
4260: 20 28 74 65 73 74 3a 67 65 74 2d 69 64 20 74 65 (test:get-id te
4270: 73 74 64 61 74 29 29 29 0a 09 20 20 3b 3b 20 46 stdat))).. ;; F
4280: 49 58 4d 45 20 2d 20 74 68 69 73 20 73 68 6f 75 IXME - this shou
4290: 6c 64 20 6e 6f 74 20 75 70 64 61 74 65 20 74 68 ld not update th
42a0: 65 20 6c 6f 67 66 69 6c 65 20 75 6e 6c 65 73 73 e logfile unless
42b0: 20 69 74 20 69 73 20 73 70 65 63 69 66 69 65 64 it is specified
42c0: 2e 0a 09 20 20 28 73 71 6c 69 74 65 33 3a 65 78 ... (sqlite3:ex
42d0: 65 63 75 74 65 20 64 62 20 0a 09 09 09 22 49 4e ecute db ...."IN
42e0: 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 SERT OR REPLACE
42f0: 69 6e 74 6f 20 74 65 73 74 5f 73 74 65 70 73 20 into test_steps
4300: 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d (test_id,stepnam
4310: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 e,state,status,e
4320: 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 6e vent_time,commen
4330: 74 2c 6c 6f 67 66 69 6c 65 29 20 56 41 4c 55 45 t,logfile) VALUE
4340: 53 28 3f 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 S(?,?,?,?,strfti
4350: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f me('%s','now'),?
4360: 2c 3f 29 3b 22 0a 09 09 09 74 65 73 74 2d 69 64 ,?);"....test-id
4370: 20 74 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 teststep-name s
4380: 74 61 74 65 2d 69 6e 20 73 74 61 74 75 73 2d 69 tate-in status-i
4390: 6e 20 28 69 66 20 63 6f 6d 6d 65 6e 74 20 63 6f n (if comment co
43a0: 6d 6d 65 6e 74 20 22 22 29 20 28 69 66 20 6c 6f mment "") (if lo
43b0: 67 66 69 6c 65 20 6c 6f 67 66 69 6c 65 20 22 22 gfile logfile ""
43c0: 29 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e )))..(debug:prin
43d0: 74 20 30 20 22 45 52 52 4f 52 3a 20 43 61 6e 27 t 0 "ERROR: Can'
43e0: 74 20 75 70 64 61 74 65 20 22 20 74 65 73 74 2d t update " test-
43f0: 6e 61 6d 65 20 22 20 66 6f 72 20 72 75 6e 20 22 name " for run "
4400: 20 72 75 6e 2d 69 64 20 22 20 2d 3e 20 6e 6f 20 run-id " -> no
4410: 73 75 63 68 20 74 65 73 74 20 69 6e 20 64 62 22 such test in db"
4420: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ))))..(define (t
4430: 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 est-get-kill-req
4440: 75 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 uest db run-id t
4450: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
4460: 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d ). (let* ((item
4470: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
4480: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
4490: 0a 09 20 28 74 65 73 74 64 61 74 20 20 20 28 64 .. (testdat (d
44a0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 b:get-test-info
44b0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
44c0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
44d0: 0a 20 20 20 20 28 65 71 75 61 6c 3f 20 28 74 65 . (equal? (te
44e0: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 73 st:get-state tes
44f0: 74 64 61 74 29 20 22 4b 49 4c 4c 52 45 51 22 29 tdat) "KILLREQ")
4500: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
4510: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
4520: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
4530: 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 28 6c me itemdat). (l
4540: 65 74 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 et ((item-path (
4550: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
4560: 69 74 65 6d 64 61 74 29 29 0a 09 28 63 70 75 6c itemdat))..(cpul
4570: 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f oad (get-cpu-lo
4580: 61 64 29 29 0a 09 28 68 6f 73 74 6e 61 6d 65 20 ad))..(hostname
4590: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
45a0: 0a 09 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 ..(diskfree (get
45b0: 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 -df (current-dir
45c0: 65 63 74 6f 72 79 29 29 29 0a 09 28 75 6e 61 6d ectory)))..(unam
45d0: 65 20 20 20 20 28 67 65 74 2d 75 6e 61 6d 65 20 e (get-uname
45e0: 22 2d 73 72 76 70 69 6f 22 29 29 0a 09 28 72 75 "-srvpio"))..(ru
45f0: 6e 70 61 74 68 20 20 28 63 75 72 72 65 6e 74 2d npath (current-
4600: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 20 20 20 directory))).
4610: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4620: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
4630: 74 73 20 53 45 54 20 68 6f 73 74 3d 3f 2c 63 70 ts SET host=?,cp
4640: 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 65 65 uload=?,diskfree
4650: 3d 3f 2c 75 6e 61 6d 65 3d 3f 2c 72 75 6e 64 69 =?,uname=?,rundi
4660: 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 r=? WHERE run_id
4670: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
4680: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
4690: 3f 3b 22 0a 09 09 20 20 68 6f 73 74 6e 61 6d 65 ?;"... hostname
46a0: 0a 09 09 20 20 63 70 75 6c 6f 61 64 0a 09 09 20 ... cpuload...
46b0: 20 64 69 73 6b 66 72 65 65 0a 09 09 20 20 75 6e diskfree... un
46c0: 61 6d 65 0a 09 09 20 20 72 75 6e 70 61 74 68 0a ame... runpath.
46d0: 09 09 20 20 72 75 6e 2d 69 64 0a 09 09 20 20 74 .. run-id... t
46e0: 65 73 74 6e 61 6d 65 0a 09 09 20 20 69 74 65 6d estname... item
46f0: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
4700: 65 20 28 74 65 73 74 2d 75 70 64 61 74 65 2d 6d e (test-update-m
4710: 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d eta-info db run-
4720: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
4730: 64 61 74 20 6d 69 6e 75 74 65 73 20 63 70 75 6c dat minutes cpul
4740: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 oad diskfree tmp
4750: 66 72 65 65 29 0a 20 20 28 6c 65 74 20 28 28 69 free). (let ((i
4760: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
4770: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
4780: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f t))). (if (no
4790: 74 20 69 74 65 6d 2d 70 61 74 68 29 28 62 65 67 t item-path)(beg
47a0: 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 in (debug:print
47b0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 54 45 4d 0 "WARNING: ITEM
47c0: 50 41 54 48 20 6e 6f 74 20 73 65 74 2e 22 29 20 PATH not set.")
47d0: 20 20 28 73 65 74 21 20 69 74 65 6d 2d 70 61 74 (set! item-pat
47e0: 68 20 22 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 h ""))). ;; (
47f0: 6c 65 74 20 28 28 74 65 73 74 69 6e 66 6f 20 28 let ((testinfo (
4800: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
4810: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db run-id testn
4820: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
4830: 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 . ;; (if (a
4840: 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 nd (not (equal?
4850: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4860: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 43 tus testinfo) "C
4870: 4f 4d 50 4c 45 54 45 44 22 29 29 0a 20 20 20 20 OMPLETED")).
4880: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 6e ;; (n
4890: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
48a0: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
48b0: 65 73 74 69 6e 66 6f 29 20 22 4b 49 4c 4c 52 45 estinfo) "KILLRE
48c0: 51 22 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 Q")). (sqlite
48d0: 33 3a 65 78 65 63 75 74 65 0a 20 20 20 20 20 64 3:execute. d
48e0: 62 0a 20 20 20 20 20 22 55 50 44 41 54 45 20 74 b. "UPDATE t
48f0: 65 73 74 73 20 53 45 54 20 63 70 75 6c 6f 61 64 ests SET cpuload
4900: 3d 3f 2c 64 69 73 6b 66 72 65 65 3d 3f 2c 72 75 =?,diskfree=?,ru
4910: 6e 5f 64 75 72 61 74 69 6f 6e 3d 3f 2c 73 74 61 n_duration=?,sta
4920: 74 65 3d 27 52 55 4e 4e 49 4e 47 27 20 57 48 45 te='RUNNING' WHE
4930: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
4940: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
4950: 74 65 6d 5f 70 61 74 68 3d 3f 20 41 4e 44 20 73 tem_path=? AND s
4960: 74 61 74 65 20 4e 4f 54 20 49 4e 20 28 27 43 4f tate NOT IN ('CO
4970: 4d 50 4c 45 54 45 44 27 2c 27 4b 49 4c 4c 52 45 MPLETED','KILLRE
4980: 51 27 2c 27 4b 49 4c 4c 45 44 27 29 3b 22 0a 20 Q','KILLED');".
4990: 20 20 20 20 63 70 75 6c 6f 61 64 0a 20 20 20 20 cpuload.
49a0: 20 64 69 73 6b 66 72 65 65 0a 20 20 20 20 20 6d diskfree. m
49b0: 69 6e 75 74 65 73 0a 20 20 20 20 20 72 75 6e 2d inutes. run-
49c0: 69 64 0a 20 20 20 20 20 74 65 73 74 6e 61 6d 65 id. testname
49d0: 0a 20 20 20 20 20 69 74 65 6d 2d 70 61 74 68 29 . item-path)
49e0: 29 29 0a 0a ))..