0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 31 2c 20 4d 61 74 74 68 65 77 06-2011, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 20 20 73 PURPOSE...;; s
0150: 74 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f 25 trftime('%m/%d/%
0160: 59 20 25 48 3a 25 4d 3a 25 53 27 2c 27 6e 6f 77 Y %H:%M:%S','now
0170: 27 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 0a 0a ','localtime')..
0180: 3b 3b 20 72 65 67 69 73 74 65 72 20 61 20 74 65 ;; register a te
0190: 73 74 20 72 75 6e 20 77 69 74 68 20 74 68 65 20 st run with the
01a0: 64 62 0a 28 64 65 66 69 6e 65 20 28 72 65 67 69 db.(define (regi
01b0: 73 74 65 72 2d 72 75 6e 20 64 62 20 6b 65 79 73 ster-run db keys
01c0: 29 20 3b 3b 20 74 65 73 74 2d 6e 61 6d 65 29 0a ) ;; test-name).
01d0: 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 74 72 (let* ((keystr
01e0: 20 20 20 20 28 6b 65 79 73 2d 3e 6b 65 79 73 74 (keys->keyst
01f0: 72 20 6b 65 79 73 29 29 0a 09 20 28 63 6f 6d 6d r keys)).. (comm
0200: 61 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 a (if (> (le
0210: 6e 67 74 68 20 6b 65 79 73 29 20 30 29 20 22 2c ngth keys) 0) ",
0220: 22 20 22 22 29 29 0a 09 20 28 61 6e 64 73 74 72 " "")).. (andstr
0230: 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng
0240: 74 68 20 6b 65 79 73 29 20 30 29 20 22 20 41 4e th keys) 0) " AN
0250: 44 20 22 20 22 22 29 29 0a 09 20 28 76 61 6c 73 D " "")).. (vals
0260: 6c 6f 74 73 20 20 28 6b 65 79 73 2d 3e 76 61 6c lots (keys->val
0270: 73 6c 6f 74 73 20 6b 65 79 73 29 29 20 3b 3b 20 slots keys)) ;;
0280: 3f 2c 3f 2c 3f 20 2e 2e 2e 0a 09 20 28 6b 65 79 ?,?,? ..... (key
0290: 76 61 6c 6c 73 74 20 28 6b 65 79 73 2d 3e 76 61 vallst (keys->va
02a0: 6c 6c 69 73 74 20 6b 65 79 73 29 29 20 3b 3b 20 llist keys)) ;;
02b0: 65 78 74 72 61 63 74 73 20 74 68 65 20 76 61 6c extracts the val
02c0: 75 65 73 20 66 72 6f 6d 20 72 65 6d 61 69 6e 64 ues from remaind
02d0: 65 72 20 6f 66 20 28 61 72 67 76 29 0a 09 20 28 er of (argv).. (
02e0: 72 75 6e 6e 61 6d 65 20 20 20 28 67 65 74 2d 77 runname (get-w
02f0: 69 74 68 2d 64 65 66 61 75 6c 74 20 22 3a 72 75 ith-default ":ru
0300: 6e 6e 61 6d 65 22 20 23 66 29 29 0a 09 20 28 73 nname" #f)).. (s
0310: 74 61 74 65 20 20 20 20 20 28 67 65 74 2d 77 69 tate (get-wi
0320: 74 68 2d 64 65 66 61 75 6c 74 20 22 3a 73 74 61 th-default ":sta
0330: 74 65 22 20 22 6e 6f 22 29 29 0a 09 20 28 73 74 te" "no")).. (st
0340: 61 74 75 73 20 20 20 20 28 67 65 74 2d 77 69 74 atus (get-wit
0350: 68 2d 64 65 66 61 75 6c 74 20 22 3a 73 74 61 74 h-default ":stat
0360: 75 73 22 20 22 6e 2f 61 22 29 29 0a 09 20 28 61 us" "n/a")).. (a
0370: 6c 6c 76 61 6c 73 20 20 20 28 61 70 70 65 6e 64 llvals (append
0380: 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 20 73 (list runname s
0390: 74 61 74 65 20 73 74 61 74 75 73 20 75 73 65 72 tate status user
03a0: 29 20 6b 65 79 76 61 6c 6c 73 74 29 29 0a 09 20 ) keyvallst))..
03b0: 28 71 72 79 76 61 6c 73 20 20 20 28 61 70 70 65 (qryvals (appe
03c0: 6e 64 20 28 6c 69 73 74 20 72 75 6e 6e 61 6d 65 nd (list runname
03d0: 29 20 6b 65 79 76 61 6c 6c 73 74 29 29 0a 09 20 ) keyvallst))..
03e0: 28 6b 65 79 3d 3f 73 74 72 20 20 28 73 74 72 69 (key=?str (stri
03f0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
0400: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 29 28 map (lambda (k)(
0410: 63 6f 6e 63 20 28 6b 65 79 3a 67 65 74 2d 66 69 conc (key:get-fi
0420: 65 6c 64 6e 61 6d 65 20 6b 29 20 22 3d 3f 22 29 eldname k) "=?")
0430: 29 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 29 ) keys) " AND ")
0440: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
0450: 69 6e 74 20 33 20 22 6b 65 79 73 3a 20 22 20 6b int 3 "keys: " k
0460: 65 79 73 20 22 20 61 6c 6c 76 61 6c 73 3a 20 22 eys " allvals: "
0470: 20 61 6c 6c 76 61 6c 73 20 22 20 6b 65 79 76 61 allvals " keyva
0480: 6c 6c 73 74 3a 20 22 20 6b 65 79 76 61 6c 6c 73 llst: " keyvalls
0490: 74 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 t). (debug:pr
04a0: 69 6e 74 20 32 20 22 4e 4f 54 45 3a 20 75 73 69 int 2 "NOTE: usi
04b0: 6e 67 20 6b 65 79 20 22 20 28 73 74 72 69 6e 67 ng key " (string
04c0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
04d0: 76 61 6c 6c 73 74 20 22 2f 22 29 20 22 20 66 6f vallst "/") " fo
04e0: 72 20 74 68 69 73 20 72 75 6e 22 29 0a 20 20 20 r this run").
04f0: 20 28 69 66 20 28 61 6e 64 20 72 75 6e 6e 61 6d (if (and runnam
0500: 65 20 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 e (null? (filter
0510: 20 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 (lambda (x)(not
0520: 20 78 29 29 20 6b 65 79 76 61 6c 6c 73 74 29 29 x)) keyvallst))
0530: 29 20 3b 3b 20 74 68 65 72 65 20 6d 75 73 74 20 ) ;; there must
0540: 62 65 20 61 20 62 65 74 74 65 72 20 77 61 79 20 be a better way
0550: 74 6f 20 22 61 70 70 6c 79 20 61 6e 64 22 0a 09 to "apply and"..
0560: 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 29 0a (let ((res #f)).
0570: 09 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 . (apply sqlite
0580: 33 3a 65 78 65 63 75 74 65 20 64 62 20 28 63 6f 3:execute db (co
0590: 6e 63 20 22 49 4e 53 45 52 54 20 4f 52 20 49 47 nc "INSERT OR IG
05a0: 4e 4f 52 45 20 49 4e 54 4f 20 72 75 6e 73 20 28 NORE INTO runs (
05b0: 72 75 6e 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 runname,state,st
05c0: 61 74 75 73 2c 6f 77 6e 65 72 2c 65 76 65 6e 74 atus,owner,event
05d0: 5f 74 69 6d 65 22 20 63 6f 6d 6d 61 20 6b 65 79 _time" comma key
05e0: 73 74 72 20 22 29 20 56 41 4c 55 45 53 20 28 3f str ") VALUES (?
05f0: 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 6d 65 28 ,?,?,?,strftime(
0600: 27 25 73 27 2c 27 6e 6f 77 27 29 22 20 63 6f 6d '%s','now')" com
0610: 6d 61 20 76 61 6c 73 6c 6f 74 73 20 22 29 3b 22 ma valslots ");"
0620: 29 0a 09 09 20 61 6c 6c 76 61 6c 73 29 0a 09 20 )... allvals)..
0630: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
0640: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 20 for-each-row ..
0650: 20 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 (lambda (id)..
0660: 20 20 20 20 20 28 73 65 74 21 20 72 65 73 20 69 (set! res i
0670: 64 29 29 0a 09 20 20 20 64 62 0a 09 20 20 20 28 d)).. db.. (
0680: 6c 65 74 20 28 28 71 72 79 20 28 63 6f 6e 63 20 let ((qry (conc
0690: 22 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 "SELECT id FROM
06a0: 72 75 6e 73 20 57 48 45 52 45 20 28 72 75 6e 6e runs WHERE (runn
06b0: 61 6d 65 3d 3f 20 22 20 61 6e 64 73 74 72 20 6b ame=? " andstr k
06c0: 65 79 3d 3f 73 74 72 20 22 29 3b 22 29 29 29 0a ey=?str ");"))).
06d0: 09 20 20 20 20 20 3b 28 64 65 62 75 67 3a 70 72 . ;(debug:pr
06e0: 69 6e 74 20 34 20 22 71 72 79 3a 20 22 20 71 72 int 4 "qry: " qr
06f0: 79 29 20 0a 09 20 20 20 20 20 71 72 79 29 0a 09 y) .. qry)..
0700: 20 20 20 71 72 79 76 61 6c 73 29 0a 09 20 20 28 qryvals).. (
0710: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
0720: 64 62 20 22 55 50 44 41 54 45 20 72 75 6e 73 20 db "UPDATE runs
0730: 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 74 61 74 SET state=?,stat
0740: 75 73 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b us=? WHERE id=?;
0750: 22 20 73 74 61 74 65 20 73 74 61 74 75 73 20 72 " state status r
0760: 65 73 29 0a 09 20 20 72 65 73 29 20 0a 09 28 62 es).. res) ..(b
0770: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
0780: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 43 rint 0 "ERROR: C
0790: 61 6c 6c 65 64 20 77 69 74 68 6f 75 74 20 61 6c alled without al
07a0: 6c 20 6e 65 63 65 73 73 61 72 79 20 6b 65 79 73 l necessary keys
07b0: 22 29 0a 09 20 20 23 66 29 29 29 29 0a 0a 3b 3b ").. #f))))..;;
07c0: 20 72 75 6e 73 3a 67 65 74 2d 72 75 6e 73 2d 62 runs:get-runs-b
07d0: 79 2d 70 61 74 74 0a 3b 3b 20 67 65 74 20 72 75 y-patt.;; get ru
07e0: 6e 73 20 62 79 20 6c 69 73 74 20 6f 66 20 63 72 ns by list of cr
07f0: 69 74 65 72 69 61 0a 3b 3b 20 72 65 67 69 73 74 iteria.;; regist
0800: 65 72 20 61 20 74 65 73 74 20 72 75 6e 20 77 69 er a test run wi
0810: 74 68 20 74 68 65 20 64 62 0a 3b 3b 0a 3b 3b 20 th the db.;;.;;
0820: 55 73 65 3a 20 28 64 62 2d 67 65 74 2d 76 61 6c Use: (db-get-val
0830: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 ue-by-header (db
0840: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 69 :get-header runi
0850: 6e 66 6f 29 28 64 62 3a 67 65 74 2d 72 6f 77 20 nfo)(db:get-row
0860: 72 75 6e 69 6e 66 6f 29 29 0a 3b 3b 20 20 74 6f runinfo)).;; to
0870: 20 65 78 74 72 61 63 74 20 69 6e 66 6f 20 66 72 extract info fr
0880: 6f 6d 20 74 68 65 20 73 74 72 75 63 74 75 72 65 om the structure
0890: 20 72 65 74 75 72 6e 65 64 0a 3b 3b 0a 28 64 65 returned.;;.(de
08a0: 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 2d 72 fine (runs:get-r
08b0: 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 20 6b uns-by-patt db k
08c0: 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 20 eys runnamepatt
08d0: 2e 20 70 61 72 61 6d 73 29 20 3b 3b 20 74 65 73 . params) ;; tes
08e0: 74 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 t-name). (let*
08f0: 28 28 6b 65 79 76 61 6c 6c 73 74 20 28 6b 65 79 ((keyvallst (key
0900: 73 2d 3e 76 61 6c 6c 69 73 74 20 6b 65 79 73 29 s->vallist keys)
0910: 29 0a 09 20 28 74 6d 70 20 20 20 20 20 20 28 72 ).. (tmp (r
0920: 75 6e 73 3a 67 65 74 2d 73 74 64 2d 72 75 6e 2d uns:get-std-run-
0930: 66 69 65 6c 64 73 20 6b 65 79 73 20 27 28 22 69 fields keys '("i
0940: 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 74 d" "runname" "st
0950: 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 6f ate" "status" "o
0960: 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 6d wner" "event_tim
0970: 65 22 29 29 29 0a 09 20 28 6b 65 79 73 74 72 20 e"))).. (keystr
0980: 20 20 28 63 61 72 20 74 6d 70 29 29 0a 09 20 28 (car tmp)).. (
0990: 68 65 61 64 65 72 20 20 20 28 63 61 64 72 20 74 header (cadr t
09a0: 6d 70 29 29 0a 09 20 28 72 65 73 20 20 20 20 20 mp)).. (res
09b0: 27 28 29 29 0a 09 20 28 6b 65 79 2d 70 61 74 74 '()).. (key-patt
09c0: 20 22 22 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 "")). (for-e
09d0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 ach (lambda (key
09e0: 76 61 6c 29 0a 09 09 28 6c 65 74 2a 20 28 28 6b val)...(let* ((k
09f0: 65 79 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 ey (vector-re
0a00: 66 20 6b 65 79 76 61 6c 20 30 29 29 0a 09 09 20 f keyval 0))...
0a10: 20 20 20 20 20 20 28 66 75 6c 6b 65 79 20 28 63 (fulkey (c
0a20: 6f 6e 63 20 22 3a 22 20 6b 65 79 29 29 0a 09 09 onc ":" key))...
0a30: 20 20 20 20 20 20 20 28 70 61 74 74 20 20 20 28 (patt (
0a40: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 66 75 6c args:get-arg ful
0a50: 6b 65 79 29 29 29 0a 09 09 20 20 28 69 66 20 70 key)))... (if p
0a60: 61 74 74 0a 09 09 20 20 20 20 20 20 28 73 65 74 att... (set
0a70: 21 20 6b 65 79 2d 70 61 74 74 20 28 63 6f 6e 63 ! key-patt (conc
0a80: 20 6b 65 79 2d 70 61 74 74 20 22 20 41 4e 44 20 key-patt " AND
0a90: 22 20 6b 65 79 20 22 20 6c 69 6b 65 20 27 22 20 " key " like '"
0aa0: 70 61 74 74 20 22 27 22 29 29 0a 09 09 20 20 20 patt "'"))...
0ab0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 64 65 (begin....(de
0ac0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
0ad0: 4f 52 3a 20 73 65 61 72 63 68 69 6e 67 20 66 6f OR: searching fo
0ae0: 72 20 72 75 6e 73 20 77 69 74 68 20 6e 6f 20 70 r runs with no p
0af0: 61 74 74 65 72 6e 20 73 65 74 20 66 6f 72 20 22 attern set for "
0b00: 20 66 75 6c 6b 65 79 29 0a 09 09 09 28 65 78 69 fulkey)....(exi
0b10: 74 20 36 29 29 29 29 29 0a 09 20 20 20 20 20 20 t 6)))))..
0b20: 6b 65 79 73 29 0a 20 20 20 20 28 73 71 6c 69 74 keys). (sqlit
0b30: 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 e3:for-each-row
0b40: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 61 . (lambda (a
0b50: 20 2e 20 72 29 0a 20 20 20 20 20 20 20 28 73 65 . r). (se
0b60: 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c 69 t! res (cons (li
0b70: 73 74 2d 3e 76 65 63 74 6f 72 20 28 63 6f 6e 73 st->vector (cons
0b80: 20 61 20 72 29 29 20 72 65 73 29 29 29 0a 20 20 a r)) res))).
0b90: 20 20 20 64 62 20 0a 20 20 20 20 20 28 63 6f 6e db . (con
0ba0: 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 79 73 c "SELECT " keys
0bb0: 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 tr " FROM runs W
0bc0: 48 45 52 45 20 72 75 6e 6e 61 6d 65 20 6c 69 6b HERE runname lik
0bd0: 65 20 3f 20 22 20 6b 65 79 2d 70 61 74 74 20 22 e ? " key-patt "
0be0: 3b 22 29 0a 20 20 20 20 20 72 75 6e 6e 61 6d 65 ;"). runname
0bf0: 70 61 74 74 29 0a 20 20 20 20 28 76 65 63 74 6f patt). (vecto
0c00: 72 20 68 65 61 64 65 72 20 72 65 73 29 29 29 0a r header res))).
0c10: 0a 28 64 65 66 69 6e 65 20 28 72 65 67 69 73 74 .(define (regist
0c20: 65 72 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 er-test db run-i
0c30: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
0c40: 2d 70 61 74 68 29 0a 20 20 28 6c 65 74 20 28 28 -path). (let ((
0c50: 69 74 65 6d 2d 70 61 74 68 73 20 28 69 66 20 28 item-paths (if (
0c60: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
0c70: 20 22 22 29 0a 09 09 09 28 6c 69 73 74 20 69 74 "")....(list it
0c80: 65 6d 2d 70 61 74 68 29 0a 09 09 09 28 6c 69 73 em-path)....(lis
0c90: 74 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 t item-path ""))
0ca0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each
0cb0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
0cc0: 70 74 68 29 0a 20 20 20 20 20 20 20 28 73 71 6c pth). (sql
0cd0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 ite3:execute db
0ce0: 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 "INSERT OR IGNOR
0cf0: 45 20 49 4e 54 4f 20 74 65 73 74 73 20 28 72 75 E INTO tests (ru
0d00: 6e 5f 69 64 2c 74 65 73 74 6e 61 6d 65 2c 65 76 n_id,testname,ev
0d10: 65 6e 74 5f 74 69 6d 65 2c 69 74 65 6d 5f 70 61 ent_time,item_pa
0d20: 74 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 29 th,state,status)
0d30: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 73 74 72 VALUES (?,?,str
0d40: 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 ftime('%s','now'
0d50: 29 2c 3f 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 ),?,'NOT_STARTED
0d60: 27 2c 27 6e 2f 61 27 29 3b 22 20 0a 09 09 09 72 ','n/a');" ....r
0d70: 75 6e 2d 69 64 20 0a 09 09 09 74 65 73 74 2d 6e un-id ....test-n
0d80: 61 6d 65 0a 09 09 09 70 74 68 20 0a 09 09 09 3b ame....pth ....;
0d90: 3b 20 28 63 6f 6e 63 20 22 2c 22 20 28 73 74 72 ; (conc "," (str
0da0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
0db0: 74 61 67 73 20 22 2c 22 29 20 22 2c 22 29 0a 09 tags ",") ",")..
0dc0: 09 09 29 29 0a 20 20 20 20 20 69 74 65 6d 2d 70 ..)). item-p
0dd0: 61 74 68 73 20 29 29 29 0a 0a 3b 3b 20 67 65 74 aths )))..;; get
0de0: 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 72 65 the previous re
0df0: 63 6f 72 64 20 66 6f 72 20 77 68 65 6e 20 74 68 cord for when th
0e00: 69 73 20 74 65 73 74 20 77 61 73 20 72 75 6e 20 is test was run
0e10: 77 68 65 72 65 20 61 6c 6c 20 6b 65 79 73 20 6d where all keys m
0e20: 61 74 63 68 20 62 75 74 20 72 75 6e 6e 61 6d 65 atch but runname
0e30: 0a 3b 3b 20 72 65 74 75 72 6e 73 20 23 66 20 69 .;; returns #f i
0e40: 66 20 6e 6f 20 73 75 63 68 20 74 65 73 74 20 66 f no such test f
0e50: 6f 75 6e 64 2c 20 72 65 74 75 72 6e 73 20 61 20 ound, returns a
0e60: 73 69 6e 67 6c 65 20 74 65 73 74 20 72 65 63 6f single test reco
0e70: 72 64 20 69 66 20 66 6f 75 6e 64 0a 28 64 65 66 rd if found.(def
0e80: 69 6e 65 20 28 74 65 73 74 3a 67 65 74 2d 70 72 ine (test:get-pr
0e90: 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e 2d evious-test-run-
0ea0: 72 65 63 6f 72 64 20 64 62 20 72 75 6e 2d 69 64 record db run-id
0eb0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
0ec0: 70 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 path). (let* ((
0ed0: 6b 65 79 73 20 20 20 20 28 64 62 3a 67 65 74 2d keys (db:get-
0ee0: 6b 65 79 73 20 64 62 29 29 0a 09 20 28 73 65 6c keys db)).. (sel
0ef0: 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 str (string-int
0f00: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
0f10: 61 6d 62 64 61 20 28 78 29 28 76 65 63 74 6f 72 ambda (x)(vector
0f20: 2d 72 65 66 20 78 20 30 29 29 20 6b 65 79 73 29 -ref x 0)) keys)
0f30: 20 22 2c 22 29 29 0a 09 20 28 71 72 79 73 74 72 ",")).. (qrystr
0f40: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
0f50: 70 65 72 73 65 20 28 6d 61 70 20 28 6c 61 6d 62 perse (map (lamb
0f60: 64 61 20 28 78 29 28 63 6f 6e 63 20 28 76 65 63 da (x)(conc (vec
0f70: 74 6f 72 2d 72 65 66 20 78 20 30 29 20 22 3d 3f tor-ref x 0) "=?
0f80: 22 29 29 20 6b 65 79 73 29 20 22 20 41 4e 44 20 ")) keys) " AND
0f90: 22 29 29 0a 09 20 28 6b 65 79 76 61 6c 73 20 23 ")).. (keyvals #
0fa0: 66 29 29 0a 20 20 20 20 3b 3b 20 66 69 72 73 74 f)). ;; first
0fb0: 20 6c 6f 6f 6b 20 75 70 20 74 68 65 20 6b 65 79 look up the key
0fc0: 20 76 61 6c 75 65 73 20 66 72 6f 6d 20 74 68 65 values from the
0fd0: 20 72 75 6e 20 73 65 6c 65 63 74 65 64 20 62 79 run selected by
0fe0: 20 72 75 6e 2d 69 64 0a 20 20 20 20 28 73 71 6c run-id. (sql
0ff0: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
1000: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
1010: 28 61 20 2e 20 62 29 0a 20 20 20 20 20 20 20 28 (a . b). (
1020: 73 65 74 21 20 6b 65 79 76 61 6c 73 20 28 63 6f set! keyvals (co
1030: 6e 73 20 61 20 62 29 29 29 0a 20 20 20 20 20 64 ns a b))). d
1040: 62 0a 20 20 20 20 20 28 63 6f 6e 63 20 22 53 45 b. (conc "SE
1050: 4c 45 43 54 20 22 20 73 65 6c 73 74 72 20 22 20 LECT " selstr "
1060: 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 FROM runs WHERE
1070: 69 64 3d 3f 20 4f 52 44 45 52 20 42 59 20 65 76 id=? ORDER BY ev
1080: 65 6e 74 5f 74 69 6d 65 20 44 45 53 43 3b 22 29 ent_time DESC;")
1090: 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 28 69 66 run-id). (if
10a0: 20 28 6e 6f 74 20 6b 65 79 76 61 6c 73 29 0a 09 (not keyvals)..
10b0: 23 66 0a 09 28 6c 65 74 20 28 28 70 72 65 76 2d #f..(let ((prev-
10c0: 72 75 6e 2d 69 64 73 20 27 28 29 29 29 0a 09 20 run-ids '()))..
10d0: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
10e0: 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 09 09 20 for-each-row...
10f0: 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 09 09 20 (lambda (id)...
1100: 20 20 28 73 65 74 21 20 70 72 65 76 2d 72 75 6e (set! prev-run
1110: 2d 69 64 73 20 28 63 6f 6e 73 20 69 64 20 70 72 -ids (cons id pr
1120: 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 ev-run-ids)))...
1130: 20 64 62 0a 09 09 20 28 63 6f 6e 63 20 22 53 45 db... (conc "SE
1140: 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 72 75 6e LECT id FROM run
1150: 73 20 57 48 45 52 45 20 22 20 71 72 79 73 74 72 s WHERE " qrystr
1160: 20 22 20 41 4e 44 20 69 64 20 21 3d 20 3f 3b 22 " AND id != ?;"
1170: 29 20 28 61 70 70 65 6e 64 20 6b 65 79 76 61 6c ) (append keyval
1180: 73 20 28 6c 69 73 74 20 72 75 6e 2d 69 64 29 29 s (list run-id))
1190: 29 0a 09 20 20 3b 3b 20 66 6f 72 20 65 61 63 68 ).. ;; for each
11a0: 20 72 75 6e 20 73 74 61 72 74 69 6e 67 20 77 69 run starting wi
11b0: 74 68 20 74 68 65 20 6d 6f 73 74 20 72 65 63 65 th the most rece
11c0: 6e 74 20 6c 6f 6f 6b 20 74 6f 20 73 65 65 20 69 nt look to see i
11d0: 66 20 74 68 65 72 65 20 69 73 20 61 20 6d 61 74 f there is a mat
11e0: 63 68 69 6e 67 20 74 65 73 74 0a 09 20 20 3b 3b ching test.. ;;
11f0: 20 69 66 20 66 6f 75 6e 64 20 74 68 65 6e 20 72 if found then r
1200: 65 74 75 72 6e 20 74 68 61 74 20 6d 61 74 63 68 eturn that match
1210: 69 6e 67 20 74 65 73 74 20 72 65 63 6f 72 64 0a ing test record.
1220: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
1230: 34 20 22 73 65 6c 73 74 72 3a 20 22 20 73 65 6c 4 "selstr: " sel
1240: 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a 20 22 str ", qrystr: "
1250: 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 76 61 qrystr ", keyva
1260: 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 22 2c ls: " keyvals ",
1270: 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 64 previous run id
1280: 73 20 66 6f 75 6e 64 3a 20 22 20 70 72 65 76 2d s found: " prev-
1290: 72 75 6e 2d 69 64 73 29 0a 09 20 20 28 69 66 20 run-ids).. (if
12a0: 28 6e 75 6c 6c 3f 20 70 72 65 76 2d 72 75 6e 2d (null? prev-run-
12b0: 69 64 73 29 20 23 66 0a 09 20 20 20 20 20 20 28 ids) #f.. (
12c0: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 let loop ((hed (
12d0: 63 61 72 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 car prev-run-ids
12e0: 29 29 0a 09 09 09 20 28 74 61 6c 20 28 63 64 72 )).... (tal (cdr
12f0: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 prev-run-ids)))
1300: 0a 09 09 28 6c 65 74 20 28 28 72 65 73 75 6c 74 ...(let ((result
1310: 73 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d s (db-get-tests-
1320: 66 6f 72 2d 72 75 6e 20 64 62 20 68 65 64 20 74 for-run db hed t
1330: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
1340: 74 68 29 29 29 0a 09 09 20 20 28 64 65 62 75 67 th)))... (debug
1350: 3a 70 72 69 6e 74 20 34 20 22 47 6f 74 20 74 65 :print 4 "Got te
1360: 73 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 sts for run-id "
1370: 20 72 75 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d run-id ", test-
1380: 6e 61 6d 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 name " test-name
1390: 20 22 2c 20 69 74 65 6d 2d 70 61 74 68 20 22 20 ", item-path "
13a0: 69 74 65 6d 2d 70 61 74 68 20 22 3a 20 22 20 72 item-path ": " r
13b0: 65 73 75 6c 74 73 29 0a 09 09 20 20 28 69 66 20 esults)... (if
13c0: 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 72 65 73 75 (and (null? resu
13d0: 6c 74 73 29 0a 09 09 09 20 20 20 28 6e 6f 74 20 lts).... (not
13e0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 (null? tal)))...
13f0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
1400: 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 0a tal)(cdr tal)).
1410: 09 09 20 20 20 20 20 20 28 63 61 72 20 72 65 73 .. (car res
1420: 75 6c 74 73 29 29 29 29 29 29 29 29 29 0a 20 20 ults))))))))).
1430: 20 20 0a 3b 3b 20 67 65 74 20 74 68 65 20 70 72 .;; get the pr
1440: 65 76 69 6f 75 73 20 72 65 63 6f 72 64 73 20 66 evious records f
1450: 6f 72 20 77 68 65 6e 20 74 68 65 73 65 20 74 65 or when these te
1460: 73 74 73 20 77 65 72 65 20 72 75 6e 20 77 68 65 sts were run whe
1470: 72 65 20 61 6c 6c 20 6b 65 79 73 20 6d 61 74 63 re all keys matc
1480: 68 20 62 75 74 20 72 75 6e 6e 61 6d 65 0a 3b 3b h but runname.;;
1490: 20 4e 42 2f 2f 20 4d 65 72 67 65 20 74 68 69 73 NB// Merge this
14a0: 20 77 69 74 68 20 74 65 73 74 3a 67 65 74 2d 70 with test:get-p
14b0: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e revious-test-run
14c0: 2d 72 65 63 6f 72 64 73 3f 20 54 68 69 73 20 6f -records? This o
14d0: 6e 65 20 6c 6f 6f 6b 73 20 66 6f 72 20 61 6c 6c ne looks for all
14e0: 20 6d 61 74 63 68 69 6e 67 20 74 65 73 74 73 0a matching tests.
14f0: 3b 3b 20 63 61 6e 20 75 73 65 20 77 69 6c 64 63 ;; can use wildc
1500: 61 72 64 73 2e 20 0a 28 64 65 66 69 6e 65 20 28 ards. .(define (
1510: 74 65 73 74 3a 67 65 74 2d 6d 61 74 63 68 69 6e test:get-matchin
1520: 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 74 2d g-previous-test-
1530: 72 75 6e 2d 72 65 63 6f 72 64 73 20 64 62 20 72 run-records db r
1540: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
1550: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 6c 65 item-path). (le
1560: 74 2a 20 28 28 6b 65 79 73 20 20 20 20 28 64 62 t* ((keys (db
1570: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 :get-keys db))..
1580: 20 28 73 65 6c 73 74 72 20 20 28 73 74 72 69 6e (selstr (strin
1590: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
15a0: 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 28 76 ap (lambda (x)(v
15b0: 65 63 74 6f 72 2d 72 65 66 20 78 20 30 29 29 20 ector-ref x 0))
15c0: 6b 65 79 73 29 20 22 2c 22 29 29 0a 09 20 28 71 keys) ",")).. (q
15d0: 72 79 73 74 72 20 20 28 73 74 72 69 6e 67 2d 69 rystr (string-i
15e0: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
15f0: 28 6c 61 6d 62 64 61 20 28 78 29 28 63 6f 6e 63 (lambda (x)(conc
1600: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 30 (vector-ref x 0
1610: 29 20 22 3d 3f 22 29 29 20 6b 65 79 73 29 20 22 ) "=?")) keys) "
1620: 20 41 4e 44 20 22 29 29 0a 09 20 28 6b 65 79 76 AND ")).. (keyv
1630: 61 6c 73 20 23 66 29 0a 09 20 28 74 65 73 74 73 als #f).. (tests
1640: 2d 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 -hash (make-hash
1650: 2d 74 61 62 6c 65 29 29 29 0a 20 20 20 20 3b 3b -table))). ;;
1660: 20 66 69 72 73 74 20 6c 6f 6f 6b 20 75 70 20 74 first look up t
1670: 68 65 20 6b 65 79 20 76 61 6c 75 65 73 20 66 72 he key values fr
1680: 6f 6d 20 74 68 65 20 72 75 6e 20 73 65 6c 65 63 om the run selec
1690: 74 65 64 20 62 79 20 72 75 6e 2d 69 64 0a 20 20 ted by run-id.
16a0: 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 (sqlite3:for-e
16b0: 61 63 68 2d 72 6f 77 20 0a 20 20 20 20 20 28 6c ach-row . (l
16c0: 61 6d 62 64 61 20 28 61 20 2e 20 62 29 0a 20 20 ambda (a . b).
16d0: 20 20 20 20 20 28 73 65 74 21 20 6b 65 79 76 61 (set! keyva
16e0: 6c 73 20 28 63 6f 6e 73 20 61 20 62 29 29 29 0a ls (cons a b))).
16f0: 20 20 20 20 20 64 62 0a 20 20 20 20 20 28 63 6f db. (co
1700: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 73 65 6c nc "SELECT " sel
1710: 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 str " FROM runs
1720: 57 48 45 52 45 20 69 64 3d 3f 20 4f 52 44 45 52 WHERE id=? ORDER
1730: 20 42 59 20 65 76 65 6e 74 5f 74 69 6d 65 20 44 BY event_time D
1740: 45 53 43 3b 22 29 20 72 75 6e 2d 69 64 29 0a 20 ESC;") run-id).
1750: 20 20 20 28 69 66 20 28 6e 6f 74 20 6b 65 79 76 (if (not keyv
1760: 61 6c 73 29 0a 09 27 28 29 0a 09 28 6c 65 74 20 als)..'()..(let
1770: 28 28 70 72 65 76 2d 72 75 6e 2d 69 64 73 20 27 ((prev-run-ids '
1780: 28 29 29 29 0a 09 20 20 28 61 70 70 6c 79 20 73 ())).. (apply s
1790: 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d qlite3:for-each-
17a0: 72 6f 77 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 row... (lambda (
17b0: 69 64 29 0a 09 09 20 20 20 28 73 65 74 21 20 70 id)... (set! p
17c0: 72 65 76 2d 72 75 6e 2d 69 64 73 20 28 63 6f 6e rev-run-ids (con
17d0: 73 20 69 64 20 70 72 65 76 2d 72 75 6e 2d 69 64 s id prev-run-id
17e0: 73 29 29 29 0a 09 09 20 64 62 0a 09 09 20 28 63 s)))... db... (c
17f0: 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 20 46 onc "SELECT id F
1800: 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 22 ROM runs WHERE "
1810: 20 71 72 79 73 74 72 20 22 20 41 4e 44 20 69 64 qrystr " AND id
1820: 20 21 3d 20 3f 3b 22 29 20 28 61 70 70 65 6e 64 != ?;") (append
1830: 20 6b 65 79 76 61 6c 73 20 28 6c 69 73 74 20 72 keyvals (list r
1840: 75 6e 2d 69 64 29 29 29 0a 09 20 20 3b 3b 20 63 un-id))).. ;; c
1850: 6f 6c 6c 65 63 74 20 61 6c 6c 20 6d 61 74 63 68 ollect all match
1860: 69 6e 67 20 74 65 73 74 73 20 66 6f 72 20 74 68 ing tests for th
1870: 65 20 72 75 6e 73 20 74 68 65 6e 0a 09 20 20 3b e runs then.. ;
1880: 3b 20 65 78 74 72 61 63 74 20 74 68 65 20 6d 6f ; extract the mo
1890: 73 74 20 72 65 63 65 6e 74 20 74 65 73 74 20 61 st recent test a
18a0: 6e 64 20 72 65 74 75 72 6e 20 74 68 61 74 2e 0a nd return that..
18b0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
18c0: 34 20 22 73 65 6c 73 74 72 3a 20 22 20 73 65 6c 4 "selstr: " sel
18d0: 73 74 72 20 22 2c 20 71 72 79 73 74 72 3a 20 22 str ", qrystr: "
18e0: 20 71 72 79 73 74 72 20 22 2c 20 6b 65 79 76 61 qrystr ", keyva
18f0: 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 20 0a 09 ls: " keyvals ..
1900: 09 20 20 20 20 20 20 20 22 2c 20 70 72 65 76 69 . ", previ
1910: 6f 75 73 20 72 75 6e 20 69 64 73 20 66 6f 75 6e ous run ids foun
1920: 64 3a 20 22 20 70 72 65 76 2d 72 75 6e 2d 69 64 d: " prev-run-id
1930: 73 29 0a 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f s).. (if (null?
1940: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 20 27 prev-run-ids) '
1950: 28 29 20 20 3b 3b 20 6e 6f 20 70 72 65 76 69 6f () ;; no previo
1960: 75 73 20 72 75 6e 73 3f 20 72 65 74 75 72 6e 20 us runs? return
1970: 6e 75 6c 6c 0a 09 20 20 20 20 20 20 28 6c 65 74 null.. (let
1980: 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 loop ((hed (car
1990: 20 70 72 65 76 2d 72 75 6e 2d 69 64 73 29 29 0a prev-run-ids)).
19a0: 09 09 09 20 28 74 61 6c 20 28 63 64 72 20 70 72 ... (tal (cdr pr
19b0: 65 76 2d 72 75 6e 2d 69 64 73 29 29 29 0a 09 09 ev-run-ids)))...
19c0: 28 6c 65 74 20 28 28 72 65 73 75 6c 74 73 20 28 (let ((results (
19d0: 64 62 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 db-get-tests-for
19e0: 2d 72 75 6e 20 64 62 20 68 65 64 20 74 65 73 74 -run db hed test
19f0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
1a00: 29 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 ))... (debug:pr
1a10: 69 6e 74 20 34 20 22 47 6f 74 20 74 65 73 74 73 int 4 "Got tests
1a20: 20 66 6f 72 20 72 75 6e 2d 69 64 20 22 20 72 75 for run-id " ru
1a30: 6e 2d 69 64 20 22 2c 20 74 65 73 74 2d 6e 61 6d n-id ", test-nam
1a40: 65 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 0a 09 e " test-name ..
1a50: 09 09 20 20 20 20 20 20 20 22 2c 20 69 74 65 6d .. ", item
1a60: 2d 70 61 74 68 20 22 20 69 74 65 6d 2d 70 61 74 -path " item-pat
1a70: 68 20 22 20 72 65 73 75 6c 74 73 3a 20 22 20 28 h " results: " (
1a80: 69 6e 74 65 72 73 70 65 72 73 65 20 72 65 73 75 intersperse resu
1a90: 6c 74 73 20 22 5c 6e 22 29 29 0a 09 09 20 20 3b lts "\n"))... ;
1aa0: 3b 20 4b 65 65 70 20 6f 6e 6c 79 20 74 68 65 20 ; Keep only the
1ab0: 79 6f 75 6e 67 65 73 74 20 6f 66 20 61 6e 79 20 youngest of any
1ac0: 74 65 73 74 2f 69 74 65 6d 20 63 6f 6d 62 69 6e test/item combin
1ad0: 61 74 69 6f 6e 0a 09 09 20 20 28 66 6f 72 2d 65 ation... (for-e
1ae0: 61 63 68 20 0a 09 09 20 20 20 28 6c 61 6d 62 64 ach ... (lambd
1af0: 61 20 28 74 65 73 74 64 61 74 29 0a 09 09 20 20 a (testdat)...
1b00: 20 20 20 28 6c 65 74 2a 20 28 28 66 75 6c 6c 2d (let* ((full-
1b10: 74 65 73 74 6e 61 6d 65 20 28 63 6f 6e 63 20 28 testname (conc (
1b20: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
1b30: 6e 61 6d 65 20 74 65 73 74 64 61 74 29 20 22 2f name testdat) "/
1b40: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i
1b50: 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 74 tem-path testdat
1b60: 29 29 29 0a 09 09 09 20 20 20 20 28 73 74 6f 72 ))).... (stor
1b70: 65 64 2d 74 65 73 74 20 20 20 28 68 61 73 68 2d ed-test (hash-
1b80: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
1b90: 74 20 74 65 73 74 73 2d 68 61 73 68 20 66 75 6c t tests-hash ful
1ba0: 6c 2d 74 65 73 74 6e 61 6d 65 20 23 66 29 29 29 l-testname #f)))
1bb0: 0a 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6f ... (if (o
1bc0: 72 20 28 6e 6f 74 20 73 74 6f 72 65 64 2d 74 65 r (not stored-te
1bd0: 73 74 29 0a 09 09 09 20 20 20 20 20 20 20 28 61 st).... (a
1be0: 6e 64 20 73 74 6f 72 65 64 2d 74 65 73 74 0a 09 nd stored-test..
1bf0: 09 09 09 20 20 20 20 28 3e 20 28 64 62 3a 74 65 ... (> (db:te
1c00: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
1c10: 65 20 74 65 73 74 64 61 74 29 28 64 62 3a 74 65 e testdat)(db:te
1c20: 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d st-get-event_tim
1c30: 65 20 73 74 6f 72 65 64 2d 74 65 73 74 29 29 29 e stored-test)))
1c40: 29 0a 09 09 09 20 20 20 3b 3b 20 74 68 69 73 20 ).... ;; this
1c50: 74 65 73 74 20 69 73 20 79 6f 75 6e 67 65 72 2c test is younger,
1c60: 20 73 74 6f 72 65 20 69 74 20 69 6e 20 74 68 65 store it in the
1c70: 20 68 61 73 68 0a 09 09 09 20 20 20 28 68 61 73 hash.... (has
1c80: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 65 73 h-table-set! tes
1c90: 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 74 65 73 ts-hash full-tes
1ca0: 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 tname testdat)))
1cb0: 29 0a 09 09 20 20 20 72 65 73 75 6c 74 73 29 0a )... results).
1cc0: 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 .. (if (null? t
1cd0: 61 6c 29 0a 09 09 20 20 20 20 20 20 28 6d 61 70 al)... (map
1ce0: 20 63 64 72 20 28 68 61 73 68 2d 74 61 62 6c 65 cdr (hash-table
1cf0: 2d 3e 61 6c 69 73 74 20 74 65 73 74 73 2d 68 61 ->alist tests-ha
1d00: 73 68 29 29 20 3b 3b 20 72 65 74 75 72 6e 20 61 sh)) ;; return a
1d10: 20 6c 69 73 74 20 6f 66 20 74 68 65 20 6d 6f 73 list of the mos
1d20: 74 20 72 65 63 65 6e 74 20 74 65 73 74 73 0a 09 t recent tests..
1d30: 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 . (loop (ca
1d40: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 29 r tal)(cdr tal))
1d50: 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e ))))))))..(defin
1d60: 65 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 e (test-set-stat
1d70: 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 us! db run-id te
1d80: 73 74 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 st-name state st
1d90: 61 74 75 73 20 69 74 65 6d 64 61 74 2d 6f 72 2d atus itemdat-or-
1da0: 70 61 74 68 20 63 6f 6d 6d 65 6e 74 20 64 61 74 path comment dat
1db0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 65 61 6c ). (let* ((real
1dc0: 2d 73 74 61 74 75 73 20 73 74 61 74 75 73 29 0a -status status).
1dd0: 09 20 28 69 74 65 6d 2d 70 61 74 68 20 20 20 28 . (item-path (
1de0: 69 66 20 28 73 74 72 69 6e 67 3f 20 69 74 65 6d if (string? item
1df0: 64 61 74 2d 6f 72 2d 70 61 74 68 29 20 69 74 65 dat-or-path) ite
1e00: 6d 64 61 74 2d 6f 72 2d 70 61 74 68 20 28 69 74 mdat-or-path (it
1e10: 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 em-list->path it
1e20: 65 6d 64 61 74 2d 6f 72 2d 70 61 74 68 29 29 29 emdat-or-path)))
1e30: 0a 09 20 28 74 65 73 74 64 61 74 20 20 20 20 20 .. (testdat
1e40: 28 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 (db:get-test-inf
1e50: 6f 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 o db run-id test
1e60: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
1e70: 29 0a 09 20 28 74 65 73 74 2d 69 64 20 20 20 20 ).. (test-id
1e80: 20 28 69 66 20 74 65 73 74 64 61 74 20 28 64 62 (if testdat (db
1e90: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
1ea0: 74 64 61 74 29 20 23 66 29 29 0a 09 20 28 6f 74 tdat) #f)).. (ot
1eb0: 68 65 72 64 61 74 20 20 20 20 28 69 66 20 64 61 herdat (if da
1ec0: 74 20 64 61 74 20 28 6d 61 6b 65 2d 68 61 73 68 t dat (make-hash
1ed0: 2d 74 61 62 6c 65 29 29 29 0a 09 20 3b 3b 20 62 -table))).. ;; b
1ee0: 65 66 6f 72 65 20 70 72 6f 63 65 65 64 69 6e 67 efore proceeding
1ef0: 20 77 65 20 6d 75 73 74 20 66 69 6e 64 20 6f 75 we must find ou
1f00: 74 20 69 66 20 74 68 65 20 70 72 65 76 69 6f 75 t if the previou
1f10: 73 20 74 65 73 74 20 28 77 68 65 72 65 20 61 6c s test (where al
1f20: 6c 20 6b 65 79 73 20 6d 61 74 63 68 65 64 20 65 l keys matched e
1f30: 78 63 65 70 74 20 72 75 6e 6e 61 6d 65 29 0a 09 xcept runname)..
1f40: 20 3b 3b 20 77 61 73 20 57 41 49 56 45 44 20 69 ;; was WAIVED i
1f50: 66 20 74 68 69 73 20 74 65 73 74 20 69 73 20 46 f this test is F
1f60: 41 49 4c 0a 09 20 28 77 61 69 76 65 64 20 20 20 AIL.. (waived
1f70: 28 69 66 20 28 65 71 75 61 6c 3f 20 73 74 61 74 (if (equal? stat
1f80: 75 73 20 22 46 41 49 4c 22 29 0a 09 09 20 20 20 us "FAIL")...
1f90: 20 20 20 20 28 6c 65 74 20 28 28 70 72 65 76 2d (let ((prev-
1fa0: 74 65 73 74 20 28 74 65 73 74 3a 67 65 74 2d 70 test (test:get-p
1fb0: 72 65 76 69 6f 75 73 2d 74 65 73 74 2d 72 75 6e revious-test-run
1fc0: 2d 72 65 63 6f 72 64 20 64 62 20 72 75 6e 2d 69 -record db run-i
1fd0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
1fe0: 2d 70 61 74 68 29 29 29 0a 09 09 09 20 28 69 66 -path))).... (if
1ff0: 20 70 72 65 76 2d 74 65 73 74 20 3b 3b 20 74 72 prev-test ;; tr
2000: 75 65 20 69 66 20 77 65 20 66 6f 75 6e 64 20 61 ue if we found a
2010: 20 70 72 65 76 69 6f 75 73 20 74 65 73 74 20 69 previous test i
2020: 6e 20 74 68 69 73 20 72 75 6e 20 73 65 72 69 65 n this run serie
2030: 73 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 s.... (let (
2040: 28 70 72 65 76 2d 73 74 61 74 75 73 20 28 64 62 (prev-status (db
2050: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
2060: 20 20 20 70 72 65 76 2d 74 65 73 74 29 29 0a 09 prev-test))..
2070: 09 09 09 20 20 20 28 70 72 65 76 2d 73 74 61 74 ... (prev-stat
2080: 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d e (db:test-get-
2090: 73 74 61 74 65 20 20 20 20 70 72 65 76 2d 74 65 state prev-te
20a0: 73 74 29 29 0a 09 09 09 09 20 20 20 28 70 72 65 st))..... (pre
20b0: 76 2d 63 6f 6d 6d 65 6e 74 20 28 64 62 3a 74 65 v-comment (db:te
20c0: 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 70 st-get-comment p
20d0: 72 65 76 2d 74 65 73 74 29 29 29 0a 09 09 09 20 rev-test)))....
20e0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
20f0: 6e 74 20 34 20 22 70 72 65 76 2d 73 74 61 74 75 nt 4 "prev-statu
2100: 73 20 22 20 70 72 65 76 2d 73 74 61 74 75 73 20 s " prev-status
2110: 22 2c 20 70 72 65 76 2d 73 74 61 74 65 20 22 20 ", prev-state "
2120: 70 72 65 76 2d 73 74 61 74 65 20 22 2c 20 70 72 prev-state ", pr
2130: 65 76 2d 63 6f 6d 6d 65 6e 74 20 22 20 70 72 65 ev-comment " pre
2140: 76 2d 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 20 20 v-comment)....
2150: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 (if (and (e
2160: 71 75 61 6c 3f 20 70 72 65 76 2d 73 74 61 74 65 qual? prev-state
2170: 20 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 "COMPLETED")..
2180: 09 09 09 09 28 65 71 75 61 6c 3f 20 70 72 65 76 ....(equal? prev
2190: 2d 73 74 61 74 75 73 20 22 57 41 49 56 45 44 22 -status "WAIVED"
21a0: 29 29 0a 09 09 09 09 20 20 20 70 72 65 76 2d 63 ))..... prev-c
21b0: 6f 6d 6d 65 6e 74 20 3b 3b 20 77 61 69 76 65 64 omment ;; waived
21c0: 20 69 73 20 65 69 74 68 65 72 20 74 68 65 20 63 is either the c
21d0: 6f 6d 6d 65 6e 74 20 6f 72 20 23 66 0a 09 09 09 omment or #f....
21e0: 09 20 20 20 23 66 29 29 0a 09 09 09 20 20 20 20 . #f))....
21f0: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 20 23 #f))... #
2200: 66 29 29 29 0a 20 20 20 20 28 69 66 20 77 61 69 f))). (if wai
2210: 76 65 64 20 28 73 65 74 21 20 72 65 61 6c 2d 73 ved (set! real-s
2220: 74 61 74 75 73 20 22 57 41 49 56 45 44 22 29 29 tatus "WAIVED"))
2230: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
2240: 74 20 34 20 22 72 65 61 6c 2d 73 74 61 74 75 73 t 4 "real-status
2250: 20 22 20 72 65 61 6c 2d 73 74 61 74 75 73 20 22 " real-status "
2260: 2c 20 77 61 69 76 65 64 20 22 20 77 61 69 76 65 , waived " waive
2270: 64 20 22 2c 20 73 74 61 74 75 73 20 22 20 73 74 d ", status " st
2280: 61 74 75 73 29 0a 0a 20 20 20 20 3b 3b 20 75 70 atus).. ;; up
2290: 64 61 74 65 20 74 68 65 20 70 72 69 6d 61 72 79 date the primary
22a0: 20 72 65 63 6f 72 64 20 49 46 20 73 74 61 74 65 record IF state
22b0: 20 41 4e 44 20 73 74 61 74 75 73 20 61 72 65 20 AND status are
22c0: 64 65 66 69 6e 65 64 0a 20 20 20 20 28 69 66 20 defined. (if
22d0: 28 61 6e 64 20 73 74 61 74 65 20 73 74 61 74 75 (and state statu
22e0: 73 29 0a 09 28 73 71 6c 69 74 65 33 3a 65 78 65 s)..(sqlite3:exe
22f0: 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 cute db "UPDATE
2300: 74 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d tests SET state=
2310: 3f 2c 73 74 61 74 75 73 3d 3f 2c 65 76 65 6e 74 ?,status=?,event
2320: 5f 74 69 6d 65 3d 73 74 72 66 74 69 6d 65 28 27 _time=strftime('
2330: 25 73 27 2c 27 6e 6f 77 27 29 20 57 48 45 52 45 %s','now') WHERE
2340: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
2350: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
2360: 6d 5f 70 61 74 68 3d 3f 3b 22 20 0a 09 09 09 20 m_path=?;" ....
2370: 73 74 61 74 65 20 72 65 61 6c 2d 73 74 61 74 75 state real-statu
2380: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
2390: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a me item-path))..
23a0: 20 20 20 20 3b 3b 20 69 66 20 73 74 61 74 75 73 ;; if status
23b0: 20 69 73 20 22 41 55 54 4f 22 20 74 68 65 6e 20 is "AUTO" then
23c0: 63 61 6c 6c 20 72 6f 6c 6c 75 70 0a 20 20 20 20 call rollup.
23d0: 28 69 66 20 28 61 6e 64 20 74 65 73 74 2d 69 64 (if (and test-id
23e0: 20 73 74 61 74 65 20 73 74 61 74 75 73 20 28 65 state status (e
23f0: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 41 55 qual? status "AU
2400: 54 4f 22 29 29 20 0a 09 28 64 62 3a 74 65 73 74 TO")) ..(db:test
2410: 2d 64 61 74 61 2d 72 6f 6c 6c 75 70 20 64 62 20 -data-rollup db
2420: 74 65 73 74 2d 69 64 29 29 0a 0a 20 20 20 20 3b test-id)).. ;
2430: 3b 20 61 64 64 20 6d 65 74 61 64 61 74 61 20 28 ; add metadata (
2440: 6e 65 65 64 20 74 6f 20 64 6f 20 74 68 69 73 20 need to do this
2450: 77 61 79 20 74 6f 20 61 76 6f 69 64 20 53 51 4c way to avoid SQL
2460: 20 69 6e 6a 65 63 74 69 6f 6e 20 69 73 73 75 65 injection issue
2470: 73 29 0a 0a 20 20 20 20 3b 3b 20 3a 66 69 72 73 s).. ;; :firs
2480: 74 5f 65 72 72 0a 20 20 20 20 28 6c 65 74 20 28 t_err. (let (
2490: 28 76 61 6c 20 28 68 61 73 68 2d 74 61 62 6c 65 (val (hash-table
24a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6f 74 68 -ref/default oth
24b0: 65 72 64 61 74 20 22 3a 66 69 72 73 74 5f 65 72 erdat ":first_er
24c0: 72 22 20 23 66 29 29 29 0a 20 20 20 20 20 20 28 r" #f))). (
24d0: 69 66 20 76 61 6c 0a 09 20 20 28 73 71 6c 69 74 if val.. (sqlit
24e0: 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 e3:execute db "U
24f0: 50 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 PDATE tests SET
2500: 66 69 72 73 74 5f 65 72 72 3d 3f 20 57 48 45 52 first_err=? WHER
2510: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
2520: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
2530: 65 6d 5f 70 61 74 68 3d 3f 3b 22 20 76 61 6c 20 em_path=?;" val
2540: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
2550: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 item-path)))..
2560: 20 20 20 3b 3b 20 3a 66 69 72 73 74 5f 77 61 72 ;; :first_war
2570: 6e 0a 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c n. (let ((val
2580: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
2590: 2f 64 65 66 61 75 6c 74 20 6f 74 68 65 72 64 61 /default otherda
25a0: 74 20 22 3a 66 69 72 73 74 5f 77 61 72 6e 22 20 t ":first_warn"
25b0: 23 66 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 #f))). (if
25c0: 76 61 6c 0a 09 20 20 28 73 71 6c 69 74 65 33 3a val.. (sqlite3:
25d0: 65 78 65 63 75 74 65 20 64 62 20 22 55 50 44 41 execute db "UPDA
25e0: 54 45 20 74 65 73 74 73 20 53 45 54 20 66 69 72 TE tests SET fir
25f0: 73 74 5f 77 61 72 6e 3d 3f 20 57 48 45 52 45 20 st_warn=? WHERE
2600: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
2610: 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d tname=? AND item
2620: 5f 70 61 74 68 3d 3f 3b 22 20 76 61 6c 20 72 75 _path=?;" val ru
2630: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
2640: 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 tem-path)))..
2650: 20 3b 3b 20 6e 65 65 64 20 74 6f 20 75 70 64 61 ;; need to upda
2660: 74 65 20 74 68 65 20 74 6f 70 20 74 65 73 74 20 te the top test
2670: 72 65 63 6f 72 64 20 69 66 20 50 41 53 53 20 6f record if PASS o
2680: 72 20 46 41 49 4c 20 61 6e 64 20 74 68 69 73 20 r FAIL and this
2690: 69 73 20 61 20 73 75 62 74 65 73 74 0a 20 20 20 is a subtest.
26a0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
26b0: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
26c0: 20 22 22 29 29 0a 09 20 20 20 20 20 28 6f 72 20 "")).. (or
26d0: 28 65 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 (equal? status "
26e0: 50 41 53 53 22 29 0a 09 09 20 28 65 71 75 61 6c PASS")... (equal
26f0: 3f 20 73 74 61 74 75 73 20 22 57 41 52 4e 22 29 ? status "WARN")
2700: 0a 09 09 20 28 65 71 75 61 6c 3f 20 73 74 61 74 ... (equal? stat
2710: 75 73 20 22 46 41 49 4c 22 29 0a 09 09 20 28 65 us "FAIL")... (e
2720: 71 75 61 6c 3f 20 73 74 61 74 75 73 20 22 57 41 qual? status "WA
2730: 49 56 45 44 22 29 0a 09 09 20 28 65 71 75 61 6c IVED")... (equal
2740: 3f 20 73 74 61 74 75 73 20 22 52 55 4e 4e 49 4e ? status "RUNNIN
2750: 47 22 29 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 G")))..(begin..
2760: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
2770: 65 20 0a 09 20 20 20 64 62 0a 09 20 20 20 22 55 e .. db.. "U
2780: 50 44 41 54 45 20 74 65 73 74 73 20 0a 20 20 20 PDATE tests .
2790: 20 20 20 20 20 20 20 20 20 20 53 45 54 20 66 61 SET fa
27a0: 69 6c 5f 63 6f 75 6e 74 3d 28 53 45 4c 45 43 54 il_count=(SELECT
27b0: 20 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 count(id) FROM
27c0: 74 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f tests WHERE run_
27d0: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
27e0: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
27f0: 68 20 21 3d 20 27 27 20 41 4e 44 20 73 74 61 74 h != '' AND stat
2800: 75 73 3d 27 46 41 49 4c 27 29 2c 0a 20 20 20 20 us='FAIL'),.
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 61 73 pas
2820: 73 5f 63 6f 75 6e 74 3d 28 53 45 4c 45 43 54 20 s_count=(SELECT
2830: 63 6f 75 6e 74 28 69 64 29 20 46 52 4f 4d 20 74 count(id) FROM t
2840: 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 ests WHERE run_i
2850: 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 d=? AND testname
2860: 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 =? AND item_path
2870: 20 21 3d 20 27 27 20 41 4e 44 20 28 73 74 61 74 != '' AND (stat
2880: 75 73 3d 27 50 41 53 53 27 20 4f 52 20 73 74 61 us='PASS' OR sta
2890: 74 75 73 3d 27 57 41 52 4e 27 20 4f 52 20 73 74 tus='WARN' OR st
28a0: 61 74 75 73 3d 27 57 41 49 56 45 44 27 29 29 0a atus='WAIVED')).
28b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 57 48 45 WHE
28c0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
28d0: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
28e0: 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a 09 20 tem_path='';"..
28f0: 20 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 run-id test-na
2900: 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e me run-id test-n
2910: 61 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ame run-id test-
2920: 6e 61 6d 65 29 0a 09 20 20 28 69 66 20 28 65 71 name).. (if (eq
2930: 75 61 6c 3f 20 73 74 61 74 75 73 20 22 52 55 4e ual? status "RUN
2940: 4e 49 4e 47 22 29 20 3b 3b 20 72 75 6e 6e 69 6e NING") ;; runnin
2950: 67 20 74 61 6b 65 73 20 70 72 69 6f 72 69 74 79 g takes priority
2960: 20 6f 76 65 72 20 61 6c 6c 20 6f 74 68 65 72 20 over all other
2970: 73 74 61 74 65 73 2c 20 66 6f 72 63 65 20 74 68 states, force th
2980: 65 20 74 65 73 74 20 73 74 61 74 65 20 74 6f 20 e test state to
2990: 52 55 4e 4e 49 4e 47 0a 09 20 20 20 20 20 20 28 RUNNING.. (
29a0: 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 sqlite3:execute
29b0: 64 62 20 22 55 50 44 41 54 45 20 74 65 73 74 73 db "UPDATE tests
29c0: 20 53 45 54 20 73 74 61 74 65 3d 3f 20 57 48 45 SET state=? WHE
29d0: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
29e0: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
29f0: 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 72 75 tem_path='';" ru
2a00: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a n-id test-name).
2a10: 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a . (sqlite3:
2a20: 65 78 65 63 75 74 65 0a 09 20 20 20 20 20 20 20 execute..
2a30: 64 62 0a 09 20 20 20 20 20 20 20 22 55 50 44 41 db.. "UPDA
2a40: 54 45 20 74 65 73 74 73 0a 20 20 20 20 20 20 20 TE tests.
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a60: 53 45 54 20 73 74 61 74 65 3d 43 41 53 45 20 57 SET state=CASE W
2a70: 48 45 4e 20 28 53 45 4c 45 43 54 20 63 6f 75 6e HEN (SELECT coun
2a80: 74 28 69 64 29 20 46 52 4f 4d 20 74 65 73 74 73 t(id) FROM tests
2a90: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
2aa0: 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 AND testname=? A
2ab0: 4e 44 20 69 74 65 6d 5f 70 61 74 68 20 21 3d 20 ND item_path !=
2ac0: 27 27 20 41 4e 44 20 73 74 61 74 65 20 69 6e 20 '' AND state in
2ad0: 28 27 52 55 4e 4e 49 4e 47 27 2c 27 4e 4f 54 5f ('RUNNING','NOT_
2ae0: 53 54 41 52 54 45 44 27 29 29 20 3e 20 30 20 54 STARTED')) > 0 T
2af0: 48 45 4e 20 0a 20 20 20 20 20 20 20 20 20 20 20 HEN .
2b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
2b10: 52 55 4e 4e 49 4e 47 27 0a 20 20 20 20 20 20 20 RUNNING'.
2b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b30: 45 4c 53 45 20 27 43 4f 4d 50 4c 45 54 45 44 27 ELSE 'COMPLETED'
2b40: 20 45 4e 44 2c 0a 20 20 20 20 20 20 20 20 20 20 END,.
2b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b60: 73 74 61 74 75 73 3d 43 41 53 45 20 57 48 45 4e status=CASE WHEN
2b70: 20 66 61 69 6c 5f 63 6f 75 6e 74 20 3e 20 30 20 fail_count > 0
2b80: 54 48 45 4e 20 27 46 41 49 4c 27 20 57 48 45 4e THEN 'FAIL' WHEN
2b90: 20 70 61 73 73 5f 63 6f 75 6e 74 20 3e 20 30 20 pass_count > 0
2ba0: 41 4e 44 20 66 61 69 6c 5f 63 6f 75 6e 74 3d 30 AND fail_count=0
2bb0: 20 54 48 45 4e 20 27 50 41 53 53 27 20 45 4c 53 THEN 'PASS' ELS
2bc0: 45 20 27 55 4e 4b 4e 4f 57 4e 27 20 45 4e 44 0a E 'UNKNOWN' END.
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2be0: 20 20 20 20 20 20 20 57 48 45 52 45 20 72 75 6e WHERE run
2bf0: 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 _id=? AND testna
2c00: 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 me=? AND item_pa
2c10: 74 68 3d 27 27 3b 22 0a 09 20 20 20 20 20 20 20 th='';"..
2c20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
2c30: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
2c40: 65 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 6f e)))). (if (o
2c50: 72 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 r (and (string?
2c60: 63 6f 6d 6d 65 6e 74 29 0a 09 09 20 28 73 74 72 comment)... (str
2c70: 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 ing-match (regex
2c80: 70 20 22 5c 5c 53 2b 22 29 20 63 6f 6d 6d 65 6e p "\\S+") commen
2c90: 74 29 29 0a 09 20 20 20 20 77 61 69 76 65 64 29 t)).. waived)
2ca0: 0a 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ..(sqlite3:execu
2cb0: 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 te db "UPDATE te
2cc0: 73 74 73 20 53 45 54 20 63 6f 6d 6d 65 6e 74 3d sts SET comment=
2cd0: 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f ? WHERE run_id=?
2ce0: 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 AND testname=?
2cf0: 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d 3f 3b AND item_path=?;
2d00: 22 0a 09 09 09 20 28 69 66 20 77 61 69 76 65 64 ".... (if waived
2d10: 20 77 61 69 76 65 64 20 63 6f 6d 6d 65 6e 74 29 waived comment)
2d20: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
2d30: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 20 20 e item-path)).
2d40: 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ))..(define (t
2d50: 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 64 62 20 est-set-log! db
2d60: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
2d70: 20 69 74 65 6d 64 61 74 20 6c 6f 67 66 29 20 0a itemdat logf) .
2d80: 20 20 28 6c 65 74 20 28 28 69 74 65 6d 2d 70 61 (let ((item-pa
2d90: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
2da0: 61 74 68 20 69 74 65 6d 64 61 74 29 29 29 0a 20 ath itemdat))).
2db0: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
2dc0: 75 74 65 20 64 62 20 22 55 50 44 41 54 45 20 74 ute db "UPDATE t
2dd0: 65 73 74 73 20 53 45 54 20 66 69 6e 61 6c 5f 6c ests SET final_l
2de0: 6f 67 66 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f ogf=? WHERE run_
2df0: 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d id=? AND testnam
2e00: 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 e=? AND item_pat
2e10: 68 3d 3f 3b 22 20 0a 09 09 20 20 20 20 20 6c 6f h=?;" ... lo
2e20: 67 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e gf run-id test-n
2e30: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
2e40: 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 2d ..(define (test-
2e50: 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 62 20 72 set-toplog! db r
2e60: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
2e70: 6c 6f 67 66 29 20 0a 20 20 28 73 71 6c 69 74 65 logf) . (sqlite
2e80: 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 55 50 3:execute db "UP
2e90: 44 41 54 45 20 74 65 73 74 73 20 53 45 54 20 66 DATE tests SET f
2ea0: 69 6e 61 6c 5f 6c 6f 67 66 3d 3f 20 57 48 45 52 inal_logf=? WHER
2eb0: 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 E run_id=? AND t
2ec0: 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 estname=? AND it
2ed0: 65 6d 5f 70 61 74 68 3d 27 27 3b 22 20 0a 09 09 em_path='';" ...
2ee0: 20 20 20 6c 6f 67 66 20 72 75 6e 2d 69 64 20 74 logf run-id t
2ef0: 65 73 74 2d 6e 61 6d 65 29 29 0a 0a 28 64 65 66 est-name))..(def
2f00: 69 6e 65 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 ine (tests:summa
2f10: 72 69 7a 65 2d 69 74 65 6d 73 20 64 62 20 72 75 rize-items db ru
2f20: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 66 n-id test-name f
2f30: 6f 72 63 65 29 0a 20 20 3b 3b 20 69 66 20 6e 6f orce). ;; if no
2f40: 74 20 66 6f 72 63 65 20 74 68 65 6e 20 6f 6e 6c t force then onl
2f50: 79 20 75 70 64 61 74 65 20 74 68 65 20 72 65 63 y update the rec
2f60: 6f 72 64 20 69 66 20 6f 6e 65 20 6f 66 20 74 68 ord if one of th
2f70: 65 73 65 20 69 73 20 74 72 75 65 3a 0a 20 20 3b ese is true:. ;
2f80: 3b 20 20 20 31 2e 20 6c 6f 67 66 20 69 73 20 22 ; 1. logf is "
2f90: 6c 6f 67 2f 66 69 6e 61 6c 2e 6c 6f 67 0a 20 20 log/final.log.
2fa0: 3b 3b 20 20 20 32 2e 20 6c 6f 67 66 20 69 73 20 ;; 2. logf is
2fb0: 73 61 6d 65 20 61 73 20 6f 75 74 70 75 74 66 69 same as outputfi
2fc0: 6c 65 6e 61 6d 65 0a 20 20 28 6c 65 74 20 28 28 lename. (let ((
2fd0: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 28 outputfilename (
2fe0: 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 2d 72 conc "megatest-r
2ff0: 6f 6c 6c 75 70 2d 22 20 74 65 73 74 2d 6e 61 6d ollup-" test-nam
3000: 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 28 6f 72 e ".html"))..(or
3010: 69 67 2d 64 69 72 20 20 20 20 20 20 20 28 63 75 ig-dir (cu
3020: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
3030: 29 0a 09 28 6c 6f 67 66 20 20 20 20 20 20 20 20 )..(logf
3040: 20 20 20 23 66 29 29 0a 20 20 20 20 28 73 71 6c #f)). (sql
3050: 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f ite3:for-each-ro
3060: 77 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 w . (lambda
3070: 28 70 61 74 68 20 66 69 6e 61 6c 5f 6c 6f 67 66 (path final_logf
3080: 29 0a 20 20 20 20 20 20 20 28 73 65 74 21 20 6c ). (set! l
3090: 6f 67 66 20 66 69 6e 61 6c 5f 6c 6f 67 66 29 0a ogf final_logf).
30a0: 20 20 20 20 20 20 20 28 69 66 20 28 64 69 72 65 (if (dire
30b0: 63 74 6f 72 79 3f 20 70 61 74 68 29 0a 09 20 20 ctory? path)..
30c0: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 (begin.. (p
30d0: 72 69 6e 74 20 22 46 6f 75 6e 64 20 70 61 74 68 rint "Found path
30e0: 3a 20 22 20 70 61 74 68 29 0a 09 20 20 20 20 20 : " path)..
30f0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
3100: 79 20 70 61 74 68 29 29 0a 09 20 20 20 20 20 3b y path)).. ;
3110: 3b 20 28 73 65 74 21 20 6f 75 74 70 75 74 66 69 ; (set! outputfi
3120: 6c 65 6e 61 6d 65 20 28 63 6f 6e 63 20 70 61 74 lename (conc pat
3130: 68 20 22 2f 22 20 6f 75 74 70 75 74 66 69 6c 65 h "/" outputfile
3140: 6e 61 6d 65 29 29 29 0a 09 20 20 20 28 70 72 69 name))).. (pri
3150: 6e 74 20 22 4e 6f 20 73 75 63 68 20 70 61 74 68 nt "No such path
3160: 3a 20 22 20 70 61 74 68 29 29 29 0a 20 20 20 20 : " path))).
3170: 20 64 62 20 0a 20 20 20 20 20 22 53 45 4c 45 43 db . "SELEC
3180: 54 20 72 75 6e 64 69 72 2c 66 69 6e 61 6c 5f 6c T rundir,final_l
3190: 6f 67 66 20 46 52 4f 4d 20 74 65 73 74 73 20 57 ogf FROM tests W
31a0: 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e HERE run_id=? AN
31b0: 44 20 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 D testname=? AND
31c0: 20 69 74 65 6d 5f 70 61 74 68 3d 27 27 3b 22 0a item_path='';".
31d0: 20 20 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 run-id test
31e0: 2d 6e 61 6d 65 29 0a 20 20 20 20 28 70 72 69 6e -name). (prin
31f0: 74 20 22 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 t "summarize-ite
3200: 6d 73 20 77 69 74 68 20 6c 6f 67 66 20 22 20 6c ms with logf " l
3210: 6f 67 66 29 0a 20 20 20 20 28 69 66 20 28 6f 72 ogf). (if (or
3220: 20 28 65 71 75 61 6c 3f 20 6c 6f 67 66 20 22 6c (equal? logf "l
3230: 6f 67 73 2f 66 69 6e 61 6c 2e 6c 6f 67 22 29 0a ogs/final.log").
3240: 09 20 20 20 20 28 65 71 75 61 6c 3f 20 6c 6f 67 . (equal? log
3250: 66 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 f outputfilename
3260: 29 0a 09 20 20 20 20 66 6f 72 63 65 29 0a 09 28 ).. force)..(
3270: 62 65 67 69 6e 0a 09 20 20 28 69 66 20 28 6f 62 begin.. (if (ob
3280: 74 61 69 6e 2d 64 6f 74 2d 6c 6f 63 6b 20 6f 75 tain-dot-lock ou
3290: 74 70 75 74 66 69 6c 65 6e 61 6d 65 20 31 20 32 tputfilename 1 2
32a0: 30 20 33 30 29 20 3b 3b 20 72 65 74 72 79 20 65 0 30) ;; retry e
32b0: 76 65 72 79 20 73 65 63 6f 6e 64 20 66 6f 72 20 very second for
32c0: 32 30 20 73 65 63 6f 6e 64 73 2c 20 63 61 6c 6c 20 seconds, call
32d0: 20 69 74 20 64 65 61 64 20 61 66 74 65 72 20 33 it dead after 3
32e0: 30 20 73 65 63 6f 6e 64 73 20 61 6e 64 20 73 74 0 seconds and st
32f0: 65 61 6c 20 74 68 65 20 6c 6f 63 6b 0a 09 20 20 eal the lock..
3300: 20 20 20 20 28 70 72 69 6e 74 20 22 4f 62 74 61 (print "Obta
3310: 69 6e 65 64 20 6c 6f 63 6b 20 66 6f 72 20 22 20 ined lock for "
3320: 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 0a outputfilename).
3330: 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 46 . (print "F
3340: 61 69 6c 65 64 20 74 6f 20 6f 62 74 61 69 6e 20 ailed to obtain
3350: 6c 6f 63 6b 20 66 6f 72 20 22 20 6f 75 74 70 75 lock for " outpu
3360: 74 66 69 6c 65 6e 61 6d 65 29 29 0a 09 20 20 28 tfilename)).. (
3370: 6c 65 74 20 28 28 6f 75 70 20 20 20 20 28 6f 70 let ((oup (op
3380: 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 20 6f en-output-file o
3390: 75 74 70 75 74 66 69 6c 65 6e 61 6d 65 29 29 0a utputfilename)).
33a0: 09 09 28 63 6f 75 6e 74 73 20 28 6d 61 6b 65 2d ..(counts (make-
33b0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 09 28 hash-table))...(
33c0: 73 74 61 74 65 63 6f 75 6e 74 73 20 28 6d 61 6b statecounts (mak
33d0: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 e-hash-table))..
33e0: 09 28 6f 75 74 74 78 74 20 22 22 29 0a 09 09 28 .(outtxt "")...(
33f0: 74 6f 74 20 20 20 20 30 29 29 0a 09 20 20 20 20 tot 0))..
3400: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
3410: 70 6f 72 74 0a 09 09 6f 75 70 0a 09 20 20 20 20 port...oup..
3420: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 28 (lambda ()...(
3430: 73 65 74 21 20 6f 75 74 74 78 74 20 28 63 6f 6e set! outtxt (con
3440: 63 20 6f 75 74 74 78 74 20 22 3c 68 74 6d 6c 3e c outtxt "<html>
3450: 3c 74 69 74 6c 65 3e 53 75 6d 6d 61 72 79 3a 20 <title>Summary:
3460: 22 20 74 65 73 74 2d 6e 61 6d 65 20 0a 09 09 09 " test-name ....
3470: 09 20 20 20 22 3c 2f 74 69 74 6c 65 3e 3c 62 6f . "</title><bo
3480: 64 79 3e 3c 68 32 3e 53 75 6d 6d 61 72 79 20 66 dy><h2>Summary f
3490: 6f 72 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 or " test-name "
34a0: 3c 2f 68 32 3e 22 29 29 0a 09 09 28 73 71 6c 69 </h2>"))...(sqli
34b0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
34c0: 20 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 69 64 ... (lambda (id
34d0: 20 69 74 65 6d 70 61 74 68 20 73 74 61 74 65 20 itempath state
34e0: 73 74 61 74 75 73 20 72 75 6e 5f 64 75 72 61 74 status run_durat
34f0: 69 6f 6e 20 6c 6f 67 66 20 63 6f 6d 6d 65 6e 74 ion logf comment
3500: 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 )... (hash-tab
3510: 6c 65 2d 73 65 74 21 20 63 6f 75 6e 74 73 20 73 le-set! counts s
3520: 74 61 74 75 73 20 28 2b 20 31 20 28 68 61 73 68 tatus (+ 1 (hash
3530: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
3540: 6c 74 20 63 6f 75 6e 74 73 20 73 74 61 74 75 73 lt counts status
3550: 20 30 29 29 29 0a 09 09 20 20 20 28 68 61 73 68 0)))... (hash
3560: 2d 74 61 62 6c 65 2d 73 65 74 21 20 73 74 61 74 -table-set! stat
3570: 65 63 6f 75 6e 74 73 20 73 74 61 74 65 20 28 2b ecounts state (+
3580: 20 31 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 1 (hash-table-r
3590: 65 66 2f 64 65 66 61 75 6c 74 20 73 74 61 74 65 ef/default state
35a0: 63 6f 75 6e 74 73 20 73 74 61 74 65 20 30 29 29 counts state 0))
35b0: 29 0a 09 09 20 20 20 28 73 65 74 21 20 6f 75 74 )... (set! out
35c0: 74 78 74 20 28 63 6f 6e 63 20 6f 75 74 74 78 74 txt (conc outtxt
35d0: 20 22 3c 74 72 3e 22 0a 09 09 09 09 20 20 20 20 "<tr>".....
35e0: 20 20 22 3c 74 64 3e 3c 61 20 68 72 65 66 3d 5c "<td><a href=\
35f0: 22 22 20 69 74 65 6d 70 61 74 68 20 22 2f 22 20 "" itempath "/"
3600: 6c 6f 67 66 20 22 5c 22 3e 20 22 20 69 74 65 6d logf "\"> " item
3610: 70 61 74 68 20 22 3c 2f 61 3e 3c 2f 74 64 3e 22 path "</a></td>"
3620: 20 0a 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 ..... "<td
3630: 3e 22 20 73 74 61 74 65 20 20 20 20 22 3c 2f 74 >" state "</t
3640: 64 3e 22 20 0a 09 09 09 09 20 20 20 20 20 20 22 d>" ..... "
3650: 3c 74 64 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d <td><font color=
3660: 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f " (common:get-co
3670: 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 lor-from-status
3680: 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 20 20 status).....
3690: 20 20 22 3e 22 20 20 20 73 74 61 74 75 73 20 20 ">" status
36a0: 20 22 3c 2f 66 6f 6e 74 3e 3c 2f 74 64 3e 22 0a "</font></td>".
36b0: 09 09 09 09 20 20 20 20 20 20 22 3c 74 64 3e 22 .... "<td>"
36c0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 63 6f 6d (if (equal? com
36d0: 6d 65 6e 74 20 22 22 29 0a 09 09 09 09 09 09 20 ment "").......
36e0: 22 26 6e 62 73 70 3b 22 0a 09 09 09 09 09 09 20 " ".......
36f0: 63 6f 6d 6d 65 6e 74 29 20 22 3c 2f 74 64 3e 22 comment) "</td>"
3700: 0a 09 09 09 09 09 09 20 22 3c 2f 74 72 3e 22 29 ....... "</tr>")
3710: 29 29 0a 09 09 20 64 62 0a 09 09 20 22 53 45 4c ))... db... "SEL
3720: 45 43 54 20 69 64 2c 69 74 65 6d 5f 70 61 74 68 ECT id,item_path
3730: 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 72 75 ,state,status,ru
3740: 6e 5f 64 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c n_duration,final
3750: 5f 6c 6f 67 66 2c 63 6f 6d 6d 65 6e 74 20 46 52 _logf,comment FR
3760: 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 72 OM tests WHERE r
3770: 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 74 un_id=? AND test
3780: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
3790: 70 61 74 68 20 21 3d 20 27 27 3b 22 0a 09 09 20 path != '';"...
37a0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
37b0: 29 0a 0a 09 09 28 70 72 69 6e 74 20 22 3c 74 61 )....(print "<ta
37c0: 62 6c 65 3e 3c 74 72 3e 3c 74 64 20 76 61 6c 69 ble><tr><td vali
37d0: 67 6e 3d 5c 22 74 6f 70 5c 22 3e 22 29 0a 09 09 gn=\"top\">")...
37e0: 3b 3b 20 50 72 69 6e 74 20 6f 75 74 20 73 74 61 ;; Print out sta
37f0: 74 73 20 66 6f 72 20 73 74 61 74 75 73 0a 09 09 ts for status...
3800: 28 73 65 74 21 20 74 6f 74 20 30 29 0a 09 09 28 (set! tot 0)...(
3810: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
3820: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
3830: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 3c 74 72 border=\"1\"><tr
3840: 3e 3c 74 64 20 63 6f 6c 73 70 61 6e 3d 5c 22 32 ><td colspan=\"2
3850: 5c 22 3e 3c 68 32 3e 53 74 61 74 65 20 73 74 61 \"><h2>State sta
3860: 74 73 3c 2f 68 32 3e 3c 2f 74 64 3e 3c 2f 74 72 ts</h2></td></tr
3870: 3e 22 29 0a 09 09 28 66 6f 72 2d 65 61 63 68 20 >")...(for-each
3880: 28 6c 61 6d 62 64 61 20 28 73 74 61 74 65 29 0a (lambda (state).
3890: 09 09 09 20 20 20 20 28 73 65 74 21 20 74 6f 74 ... (set! tot
38a0: 20 28 2b 20 74 6f 74 20 28 68 61 73 68 2d 74 61 (+ tot (hash-ta
38b0: 62 6c 65 2d 72 65 66 20 73 74 61 74 65 63 6f 75 ble-ref statecou
38c0: 6e 74 73 20 73 74 61 74 65 29 29 29 0a 09 09 09 nts state)))....
38d0: 20 20 20 20 28 70 72 69 6e 74 20 22 3c 74 72 3e (print "<tr>
38e0: 3c 74 64 3e 22 20 73 74 61 74 65 20 22 3c 2f 74 <td>" state "</t
38f0: 64 3e 3c 74 64 3e 22 20 28 68 61 73 68 2d 74 61 d><td>" (hash-ta
3900: 62 6c 65 2d 72 65 66 20 73 74 61 74 65 63 6f 75 ble-ref statecou
3910: 6e 74 73 20 73 74 61 74 65 29 20 22 3c 2f 74 64 nts state) "</td
3920: 3e 3c 2f 74 72 3e 22 29 29 0a 09 09 09 20 20 28 ></tr>")).... (
3930: 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 73 20 hash-table-keys
3940: 73 74 61 74 65 63 6f 75 6e 74 73 29 29 0a 09 09 statecounts))...
3950: 28 70 72 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e (print "<tr><td>
3960: 54 6f 74 61 6c 3c 2f 74 64 3e 3c 74 64 3e 22 20 Total</td><td>"
3970: 74 6f 74 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 3c tot "</td></tr><
3980: 2f 74 61 62 6c 65 3e 22 29 0a 09 09 28 70 72 69 /table>")...(pri
3990: 6e 74 20 22 3c 2f 74 64 3e 3c 74 64 20 76 61 6c nt "</td><td val
39a0: 69 67 6e 3d 5c 22 74 6f 70 5c 22 3e 22 29 0a 09 ign=\"top\">")..
39b0: 09 3b 3b 20 50 72 69 6e 74 20 6f 75 74 20 73 74 .;; Print out st
39c0: 61 74 73 20 66 6f 72 20 73 74 61 74 65 0a 09 09 ats for state...
39d0: 28 73 65 74 21 20 74 6f 74 20 30 29 0a 09 09 28 (set! tot 0)...(
39e0: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
39f0: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
3a00: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 3c 74 72 border=\"1\"><tr
3a10: 3e 3c 74 64 20 63 6f 6c 73 70 61 6e 3d 5c 22 32 ><td colspan=\"2
3a20: 5c 22 3e 3c 68 32 3e 53 74 61 74 75 73 20 73 74 \"><h2>Status st
3a30: 61 74 73 3c 2f 68 32 3e 3c 2f 74 64 3e 3c 2f 74 ats</h2></td></t
3a40: 72 3e 22 29 0a 09 09 28 66 6f 72 2d 65 61 63 68 r>")...(for-each
3a50: 20 28 6c 61 6d 62 64 61 20 28 73 74 61 74 75 73 (lambda (status
3a60: 29 0a 09 09 09 20 20 20 20 28 73 65 74 21 20 74 ).... (set! t
3a70: 6f 74 20 28 2b 20 74 6f 74 20 28 68 61 73 68 2d ot (+ tot (hash-
3a80: 74 61 62 6c 65 2d 72 65 66 20 63 6f 75 6e 74 73 table-ref counts
3a90: 20 73 74 61 74 75 73 29 29 29 0a 09 09 09 20 20 status)))....
3aa0: 20 20 28 70 72 69 6e 74 20 22 3c 74 72 3e 3c 74 (print "<tr><t
3ab0: 64 3e 3c 66 6f 6e 74 20 63 6f 6c 6f 72 3d 5c 22 d><font color=\"
3ac0: 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 63 6f " (common:get-co
3ad0: 6c 6f 72 2d 66 72 6f 6d 2d 73 74 61 74 75 73 20 lor-from-status
3ae0: 73 74 61 74 75 73 29 20 22 5c 22 3e 22 20 73 74 status) "\">" st
3af0: 61 74 75 73 0a 09 09 09 09 20 20 20 22 3c 2f 66 atus..... "</f
3b00: 6f 6e 74 3e 3c 2f 74 64 3e 3c 74 64 3e 22 20 28 ont></td><td>" (
3b10: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 63 hash-table-ref c
3b20: 6f 75 6e 74 73 20 73 74 61 74 75 73 29 20 22 3c ounts status) "<
3b30: 2f 74 64 3e 3c 2f 74 72 3e 22 29 29 0a 09 09 09 /td></tr>"))....
3b40: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 (hash-table-ke
3b50: 79 73 20 63 6f 75 6e 74 73 29 29 0a 09 09 28 70 ys counts))...(p
3b60: 72 69 6e 74 20 22 3c 74 72 3e 3c 74 64 3e 54 6f rint "<tr><td>To
3b70: 74 61 6c 3c 2f 74 64 3e 3c 74 64 3e 22 20 74 6f tal</td><td>" to
3b80: 74 20 22 3c 2f 74 64 3e 3c 2f 74 72 3e 3c 2f 74 t "</td></tr></t
3b90: 61 62 6c 65 3e 22 29 0a 09 09 28 70 72 69 6e 74 able>")...(print
3ba0: 20 22 3c 2f 74 64 3e 3c 2f 74 64 3e 3c 2f 74 72 "</td></td></tr
3bb0: 3e 3c 2f 74 61 62 6c 65 3e 22 29 0a 0a 09 09 28 ></table>")....(
3bc0: 70 72 69 6e 74 20 22 3c 74 61 62 6c 65 20 63 65 print "<table ce
3bd0: 6c 6c 73 70 61 63 69 6e 67 3d 5c 22 30 5c 22 20 llspacing=\"0\"
3be0: 62 6f 72 64 65 72 3d 5c 22 31 5c 22 3e 22 20 0a border=\"1\">" .
3bf0: 09 09 20 20 20 20 20 20 20 22 3c 74 72 3e 3c 74 .. "<tr><t
3c00: 64 3e 49 74 65 6d 3c 2f 74 64 3e 3c 74 64 3e 53 d>Item</td><td>S
3c10: 74 61 74 65 3c 2f 74 64 3e 3c 74 64 3e 53 74 61 tate</td><td>Sta
3c20: 74 75 73 3c 2f 74 64 3e 3c 74 64 3e 43 6f 6d 6d tus</td><td>Comm
3c30: 65 6e 74 3c 2f 74 64 3e 22 0a 09 09 20 20 20 20 ent</td>"...
3c40: 20 20 20 6f 75 74 74 78 74 20 22 3c 2f 74 61 62 outtxt "</tab
3c50: 6c 65 3e 3c 2f 62 6f 64 79 3e 3c 2f 68 74 6d 6c le></body></html
3c60: 3e 22 29 0a 09 09 28 72 65 6c 65 61 73 65 2d 64 >")...(release-d
3c70: 6f 74 2d 6c 6f 63 6b 20 6f 75 74 70 75 74 66 69 ot-lock outputfi
3c80: 6c 65 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 28 lename))).. (
3c90: 63 6c 6f 73 65 2d 6f 75 74 70 75 74 2d 70 6f 72 close-output-por
3ca0: 74 20 6f 75 70 29 0a 09 20 20 20 20 28 63 68 61 t oup).. (cha
3cb0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 6f 72 nge-directory or
3cc0: 69 67 2d 64 69 72 29 0a 09 20 20 20 20 28 74 65 ig-dir).. (te
3cd0: 73 74 2d 73 65 74 2d 74 6f 70 6c 6f 67 21 20 64 st-set-toplog! d
3ce0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
3cf0: 6d 65 20 6f 75 74 70 75 74 66 69 6c 65 6e 61 6d me outputfilenam
3d00: 65 29 0a 09 20 20 20 20 29 29 29 29 29 0a 0a 3b e).. )))))..;
3d10: 3b 20 3b 3b 20 54 4f 44 4f 3a 20 43 6f 6e 76 65 ; ;; TODO: Conve
3d20: 72 67 65 20 74 68 69 73 20 77 69 74 68 20 64 62 rge this with db
3d30: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 0a 3b :get-test-info.;
3d40: 3b 20 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a ; (define (runs:
3d50: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 get-test-info db
3d60: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3d70: 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 3b 3b 20 e item-path).;;
3d80: 20 20 28 6c 65 74 20 28 28 72 65 73 20 23 66 29 (let ((res #f)
3d90: 29 20 3b 3b 20 28 76 65 63 74 6f 72 20 23 66 20 ) ;; (vector #f
3da0: 23 66 20 23 66 20 23 66 20 23 66 20 23 66 29 29 #f #f #f #f #f))
3db0: 29 0a 3b 3b 20 20 20 20 20 28 73 71 6c 69 74 65 ).;; (sqlite
3dc0: 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 3:for-each-row .
3dd0: 3b 3b 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 ;; (lambda
3de0: 28 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d (id run-id test-
3df0: 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 name state statu
3e00: 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 73 65 s).;; (se
3e10: 74 21 20 72 65 73 20 28 76 65 63 74 6f 72 20 69 t! res (vector i
3e20: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 d run-id test-na
3e30: 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 20 me state status
3e40: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 3b 3b 20 item-path))).;;
3e50: 20 20 20 20 20 64 62 20 22 53 45 4c 45 43 54 20 db "SELECT
3e60: 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 6e 61 id,run_id,testna
3e70: 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 20 me,state,status
3e80: 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 FROM tests WHERE
3e90: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 run_id=? AND te
3ea0: 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 stname=? AND ite
3eb0: 6d 5f 70 61 74 68 3d 3f 3b 22 0a 3b 3b 20 20 20 m_path=?;".;;
3ec0: 20 20 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e run-id test-n
3ed0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 3b ame item-path).;
3ee0: 3b 20 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 ; res))..(de
3ef0: 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 65 73 fine-inline (tes
3f00: 74 3a 67 65 74 2d 69 64 20 76 65 63 29 20 20 20 t:get-id vec)
3f10: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3f20: 76 65 63 20 30 29 29 0a 28 64 65 66 69 6e 65 2d vec 0)).(define-
3f30: 69 6e 6c 69 6e 65 20 28 74 65 73 74 3a 67 65 74 inline (test:get
3f40: 2d 72 75 6e 5f 69 64 20 76 65 63 29 20 20 20 28 -run_id vec) (
3f50: 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 31 vector-ref vec 1
3f60: 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e )).(define-inlin
3f70: 65 20 28 74 65 73 74 3a 67 65 74 2d 74 65 73 74 e (test:get-test
3f80: 2d 6e 61 6d 65 20 76 65 63 29 28 76 65 63 74 6f -name vec)(vecto
3f90: 72 2d 72 65 66 20 76 65 63 20 32 29 29 0a 28 64 r-ref vec 2)).(d
3fa0: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 74 65 efine-inline (te
3fb0: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 76 65 63 st:get-state vec
3fc0: 29 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 ) (vector-ref
3fd0: 20 76 65 63 20 33 29 29 0a 28 64 65 66 69 6e 65 vec 3)).(define
3fe0: 2d 69 6e 6c 69 6e 65 20 28 74 65 73 74 3a 67 65 -inline (test:ge
3ff0: 74 2d 73 74 61 74 75 73 20 76 65 63 29 20 20 20 t-status vec)
4000: 28 76 65 63 74 6f 72 2d 72 65 66 20 76 65 63 20 (vector-ref vec
4010: 34 29 29 0a 28 64 65 66 69 6e 65 2d 69 6e 6c 69 4)).(define-inli
4020: 6e 65 20 28 74 65 73 74 3a 67 65 74 2d 69 74 65 ne (test:get-ite
4030: 6d 2d 70 61 74 68 20 76 65 63 29 28 76 65 63 74 m-path vec)(vect
4040: 6f 72 2d 72 65 66 20 76 65 63 20 35 29 29 0a 0a or-ref vec 5))..
4050: 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a 74 65 (define (runs:te
4060: 73 74 2d 67 65 74 2d 66 75 6c 6c 2d 70 61 74 68 st-get-full-path
4070: 20 74 65 73 74 29 0a 20 20 28 6c 65 74 2a 20 28 test). (let* (
4080: 28 74 65 73 74 6e 61 6d 65 20 28 64 62 3a 74 65 (testname (db:te
4090: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
40a0: 20 20 74 65 73 74 29 29 0a 09 20 28 69 74 65 6d test)).. (item
40b0: 70 61 74 68 20 28 64 62 3a 74 65 73 74 2d 67 65 path (db:test-ge
40c0: 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 t-item-path test
40d0: 29 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 74 65 ))). (conc te
40e0: 73 74 6e 61 6d 65 20 28 69 66 20 28 65 71 75 61 stname (if (equa
40f0: 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 20 l? itempath "")
4100: 22 22 20 28 63 6f 6e 63 20 22 28 22 20 69 74 65 "" (conc "(" ite
4110: 6d 70 61 74 68 20 22 29 22 29 29 29 29 29 0a 0a mpath ")")))))..
4120: 28 64 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 (define-inline (
4130: 74 65 73 74 3a 74 65 73 74 2d 67 65 74 2d 66 75 test:test-get-fu
4140: 6c 6c 6e 61 6d 65 20 74 65 73 74 29 0a 20 20 20 llname test).
4150: 28 63 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 (conc (db:test-g
4160: 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 74 et-testname test
4170: 29 0a 09 20 28 69 66 20 28 65 71 75 61 6c 3f 20 ).. (if (equal?
4180: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 (db:test-get-ite
4190: 6d 2d 70 61 74 68 20 74 65 73 74 29 20 22 22 29 m-path test) "")
41a0: 0a 09 20 20 20 20 20 22 22 0a 09 20 20 20 20 20 .. ""..
41b0: 28 63 6f 6e 63 20 22 28 22 20 28 64 62 3a 74 65 (conc "(" (db:te
41c0: 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 st-get-item-path
41d0: 20 74 65 73 74 29 20 22 29 22 29 29 29 29 0a 0a test) ")"))))..
41e0: 28 64 65 66 69 6e 65 20 28 63 68 65 63 6b 2d 76 (define (check-v
41f0: 61 6c 69 64 2d 69 74 65 6d 73 20 63 6c 61 73 73 alid-items class
4200: 20 69 74 65 6d 29 0a 20 20 28 6c 65 74 20 28 28 item). (let ((
4210: 76 61 6c 69 64 2d 76 61 6c 75 65 73 20 28 6c 65 valid-values (le
4220: 74 20 28 28 73 20 28 63 6f 6e 66 69 67 2d 6c 6f t ((s (config-lo
4230: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
4240: 20 22 76 61 6c 69 64 76 61 6c 75 65 73 22 20 63 "validvalues" c
4250: 6c 61 73 73 29 29 29 0a 09 09 09 28 69 66 20 73 lass)))....(if s
4260: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 (string-split s
4270: 29 20 23 66 29 29 29 29 0a 20 20 20 20 28 69 66 ) #f)))). (if
4280: 20 76 61 6c 69 64 2d 76 61 6c 75 65 73 0a 09 28 valid-values..(
4290: 69 66 20 28 6d 65 6d 62 65 72 20 69 74 65 6d 20 if (member item
42a0: 76 61 6c 69 64 2d 76 61 6c 75 65 73 29 0a 09 20 valid-values)..
42b0: 20 20 20 69 74 65 6d 20 23 66 29 0a 09 69 74 65 item #f)..ite
42c0: 6d 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 m)))..(define (t
42d0: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
42e0: 75 73 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 us! db run-id te
42f0: 73 74 2d 6e 61 6d 65 20 74 65 73 74 73 74 65 70 st-name teststep
4300: 2d 6e 61 6d 65 20 73 74 61 74 65 2d 69 6e 20 73 -name state-in s
4310: 74 61 74 75 73 2d 69 6e 20 69 74 65 6d 64 61 74 tatus-in itemdat
4320: 20 63 6f 6d 6d 65 6e 74 29 0a 20 20 28 64 65 62 comment). (deb
4330: 75 67 3a 70 72 69 6e 74 20 34 20 22 72 75 6e 2d ug:print 4 "run-
4340: 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 20 74 id: " run-id " t
4350: 65 73 74 2d 6e 61 6d 65 3a 20 22 20 74 65 73 74 est-name: " test
4360: 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 -name). (let* (
4370: 28 73 74 61 74 65 20 20 20 20 20 28 63 68 65 63 (state (chec
4380: 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 20 22 73 k-valid-items "s
4390: 74 61 74 65 22 20 73 74 61 74 65 2d 69 6e 29 29 tate" state-in))
43a0: 0a 09 20 28 73 74 61 74 75 73 20 20 20 20 28 63 .. (status (c
43b0: 68 65 63 6b 2d 76 61 6c 69 64 2d 69 74 65 6d 73 heck-valid-items
43c0: 20 22 73 74 61 74 75 73 22 20 73 74 61 74 75 73 "status" status
43d0: 2d 69 6e 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 -in)).. (item-pa
43e0: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
43f0: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
4400: 28 74 65 73 74 64 61 74 20 20 20 28 64 62 3a 67 (testdat (db:g
4410: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 et-test-info db
4420: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
4430: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 20 20 item-path))).
4440: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 (debug:print 5
4450: 20 22 74 65 73 74 64 61 74 3a 20 22 20 74 65 73 "testdat: " tes
4460: 74 64 61 74 29 0a 20 20 20 20 28 69 66 20 28 61 tdat). (if (a
4470: 6e 64 20 74 65 73 74 64 61 74 20 3b 3b 20 69 66 nd testdat ;; if
4480: 20 74 68 65 20 73 65 63 74 69 6f 6e 20 65 78 69 the section exi
4490: 73 74 73 20 74 68 65 6e 20 66 6f 72 63 65 20 73 sts then force s
44a0: 70 65 63 69 66 69 63 61 74 69 6f 6e 20 42 55 47 pecification BUG
44b0: 2c 20 49 20 64 6f 6e 27 74 20 6c 69 6b 65 20 68 , I don't like h
44c0: 6f 77 20 74 68 69 73 20 77 6f 72 6b 73 2e 0a 09 ow this works...
44d0: 20 20 20 20 20 28 6f 72 20 28 6e 6f 74 20 73 74 (or (not st
44e0: 61 74 65 29 28 6e 6f 74 20 73 74 61 74 75 73 29 ate)(not status)
44f0: 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 ))..(debug:print
4500: 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 6e 76 0 "WARNING: Inv
4510: 61 6c 69 64 20 22 20 28 69 66 20 73 74 61 74 75 alid " (if statu
4520: 73 20 22 73 74 61 74 75 73 22 20 22 73 74 61 74 s "status" "stat
4530: 65 22 29 0a 09 20 20 20 20 20 20 20 22 20 76 61 e").. " va
4540: 6c 75 65 20 5c 22 22 20 28 69 66 20 73 74 61 74 lue \"" (if stat
4550: 75 73 20 73 74 61 74 75 73 2d 69 6e 20 73 74 61 us status-in sta
4560: 74 65 2d 69 6e 29 20 22 5c 22 2c 20 75 70 64 61 te-in) "\", upda
4570: 74 65 20 79 6f 75 72 20 76 61 6c 69 64 73 74 61 te your validsta
4580: 74 65 73 20 73 65 63 74 69 6f 6e 20 69 6e 20 6d tes section in m
4590: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 egatest.config")
45a0: 29 0a 20 20 20 20 28 69 66 20 74 65 73 74 64 61 ). (if testda
45b0: 74 0a 09 28 6c 65 74 20 28 28 74 65 73 74 2d 69 t..(let ((test-i
45c0: 64 20 28 74 65 73 74 3a 67 65 74 2d 69 64 20 74 d (test:get-id t
45d0: 65 73 74 64 61 74 29 29 29 0a 09 20 20 28 73 71 estdat))).. (sq
45e0: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
45f0: 20 0a 09 09 09 22 49 4e 53 45 52 54 20 4f 52 20 ...."INSERT OR
4600: 52 45 50 4c 41 43 45 20 69 6e 74 6f 20 74 65 73 REPLACE into tes
4610: 74 5f 73 74 65 70 73 20 28 74 65 73 74 5f 69 64 t_steps (test_id
4620: 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c ,stepname,state,
4630: 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d status,event_tim
4640: 65 2c 63 6f 6d 6d 65 6e 74 29 20 56 41 4c 55 45 e,comment) VALUE
4650: 53 28 3f 2c 3f 2c 3f 2c 3f 2c 73 74 72 66 74 69 S(?,?,?,?,strfti
4660: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 2c 3f me('%s','now'),?
4670: 29 3b 22 0a 09 09 09 74 65 73 74 2d 69 64 20 74 );"....test-id t
4680: 65 73 74 73 74 65 70 2d 6e 61 6d 65 20 73 74 61 eststep-name sta
4690: 74 65 20 73 74 61 74 75 73 20 28 69 66 20 63 6f te status (if co
46a0: 6d 6d 65 6e 74 20 63 6f 6d 6d 65 6e 74 20 22 22 mment comment ""
46b0: 29 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e )))..(debug:prin
46c0: 74 20 30 20 22 45 52 52 4f 52 3a 20 43 61 6e 27 t 0 "ERROR: Can'
46d0: 74 20 75 70 64 61 74 65 20 22 20 74 65 73 74 2d t update " test-
46e0: 6e 61 6d 65 20 22 20 66 6f 72 20 72 75 6e 20 22 name " for run "
46f0: 20 72 75 6e 2d 69 64 20 22 20 2d 3e 20 6e 6f 20 run-id " -> no
4700: 73 75 63 68 20 74 65 73 74 20 69 6e 20 64 62 22 such test in db"
4710: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 ))))..(define (t
4720: 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 est-get-kill-req
4730: 75 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 uest db run-id t
4740: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
4750: 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d ). (let* ((item
4760: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
4770: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
4780: 0a 09 20 28 74 65 73 74 64 61 74 20 20 20 28 64 .. (testdat (d
4790: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 b:get-test-info
47a0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
47b0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
47c0: 0a 20 20 20 20 28 65 71 75 61 6c 3f 20 28 74 65 . (equal? (te
47d0: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 73 st:get-state tes
47e0: 74 64 61 74 29 20 22 4b 49 4c 4c 52 45 51 22 29 tdat) "KILLREQ")
47f0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 ))..(define (tes
4800: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
4810: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
4820: 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 28 6c me itemdat). (l
4830: 65 74 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 et ((item-path (
4840: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
4850: 69 74 65 6d 64 61 74 29 29 0a 09 28 63 70 75 6c itemdat))..(cpul
4860: 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f oad (get-cpu-lo
4870: 61 64 29 29 0a 09 28 68 6f 73 74 6e 61 6d 65 20 ad))..(hostname
4880: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
4890: 0a 09 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 ..(diskfree (get
48a0: 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 -df (current-dir
48b0: 65 63 74 6f 72 79 29 29 29 0a 09 28 75 6e 61 6d ectory)))..(unam
48c0: 65 20 20 20 20 28 67 65 74 2d 75 6e 61 6d 65 20 e (get-uname
48d0: 22 2d 73 72 76 70 69 6f 22 29 29 0a 09 28 72 75 "-srvpio"))..(ru
48e0: 6e 70 61 74 68 20 20 28 63 75 72 72 65 6e 74 2d npath (current-
48f0: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 20 20 20 directory))).
4900: 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 (sqlite3:execut
4910: 65 20 64 62 20 22 55 50 44 41 54 45 20 74 65 73 e db "UPDATE tes
4920: 74 73 20 53 45 54 20 68 6f 73 74 3d 3f 2c 63 70 ts SET host=?,cp
4930: 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b 66 72 65 65 uload=?,diskfree
4940: 3d 3f 2c 75 6e 61 6d 65 3d 3f 2c 72 75 6e 64 69 =?,uname=?,rundi
4950: 72 3d 3f 20 57 48 45 52 45 20 72 75 6e 5f 69 64 r=? WHERE run_id
4960: 3d 3f 20 41 4e 44 20 74 65 73 74 6e 61 6d 65 3d =? AND testname=
4970: 3f 20 41 4e 44 20 69 74 65 6d 5f 70 61 74 68 3d ? AND item_path=
4980: 3f 3b 22 0a 09 09 20 20 68 6f 73 74 6e 61 6d 65 ?;"... hostname
4990: 0a 09 09 20 20 63 70 75 6c 6f 61 64 0a 09 09 20 ... cpuload...
49a0: 20 64 69 73 6b 66 72 65 65 0a 09 09 20 20 75 6e diskfree... un
49b0: 61 6d 65 0a 09 09 20 20 72 75 6e 70 61 74 68 0a ame... runpath.
49c0: 09 09 20 20 72 75 6e 2d 69 64 0a 09 09 20 20 74 .. run-id... t
49d0: 65 73 74 6e 61 6d 65 0a 09 09 20 20 69 74 65 6d estname... item
49e0: 2d 70 61 74 68 29 29 29 0a 0a 28 64 65 66 69 6e -path)))..(defin
49f0: 65 20 28 74 65 73 74 2d 75 70 64 61 74 65 2d 6d e (test-update-m
4a00: 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d eta-info db run-
4a10: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
4a20: 64 61 74 20 6d 69 6e 75 74 65 73 20 63 70 75 6c dat minutes cpul
4a30: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 oad diskfree tmp
4a40: 66 72 65 65 29 0a 20 20 28 6c 65 74 20 28 28 69 free). (let ((i
4a50: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
4a60: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
4a70: 74 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f t))). (if (no
4a80: 74 20 69 74 65 6d 2d 70 61 74 68 29 28 62 65 67 t item-path)(beg
4a90: 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 in (debug:print
4aa0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 49 54 45 4d 0 "WARNING: ITEM
4ab0: 50 41 54 48 20 6e 6f 74 20 73 65 74 2e 22 29 20 PATH not set.")
4ac0: 20 20 28 73 65 74 21 20 69 74 65 6d 2d 70 61 74 (set! item-pat
4ad0: 68 20 22 22 29 29 29 0a 20 20 20 20 3b 3b 20 28 h ""))). ;; (
4ae0: 6c 65 74 20 28 28 74 65 73 74 69 6e 66 6f 20 28 let ((testinfo (
4af0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
4b00: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db run-id testn
4b10: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
4b20: 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 . ;; (if (a
4b30: 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 nd (not (equal?
4b40: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
4b50: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 43 tus testinfo) "C
4b60: 4f 4d 50 4c 45 54 45 44 22 29 29 0a 20 20 20 20 OMPLETED")).
4b70: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 6e ;; (n
4b80: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
4b90: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
4ba0: 65 73 74 69 6e 66 6f 29 20 22 4b 49 4c 4c 52 45 estinfo) "KILLRE
4bb0: 51 22 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 Q")). (sqlite
4bc0: 33 3a 65 78 65 63 75 74 65 0a 20 20 20 20 20 64 3:execute. d
4bd0: 62 0a 20 20 20 20 20 22 55 50 44 41 54 45 20 74 b. "UPDATE t
4be0: 65 73 74 73 20 53 45 54 20 63 70 75 6c 6f 61 64 ests SET cpuload
4bf0: 3d 3f 2c 64 69 73 6b 66 72 65 65 3d 3f 2c 72 75 =?,diskfree=?,ru
4c00: 6e 5f 64 75 72 61 74 69 6f 6e 3d 3f 2c 73 74 61 n_duration=?,sta
4c10: 74 65 3d 27 52 55 4e 4e 49 4e 47 27 20 57 48 45 te='RUNNING' WHE
4c20: 52 45 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 RE run_id=? AND
4c30: 74 65 73 74 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 testname=? AND i
4c40: 74 65 6d 5f 70 61 74 68 3d 3f 20 41 4e 44 20 73 tem_path=? AND s
4c50: 74 61 74 65 20 4e 4f 54 20 49 4e 20 28 27 43 4f tate NOT IN ('CO
4c60: 4d 50 4c 45 54 45 44 27 2c 27 4b 49 4c 4c 52 45 MPLETED','KILLRE
4c70: 51 27 2c 27 4b 49 4c 4c 45 44 27 29 3b 22 0a 20 Q','KILLED');".
4c80: 20 20 20 20 63 70 75 6c 6f 61 64 0a 20 20 20 20 cpuload.
4c90: 20 64 69 73 6b 66 72 65 65 0a 20 20 20 20 20 6d diskfree. m
4ca0: 69 6e 75 74 65 73 0a 20 20 20 20 20 72 75 6e 2d inutes. run-
4cb0: 69 64 0a 20 20 20 20 20 74 65 73 74 6e 61 6d 65 id. testname
4cc0: 0a 20 20 20 20 20 69 74 65 6d 2d 70 61 74 68 29 . item-path)
4cd0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 ))..(define (set
4ce0: 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 -megatest-env-va
4cf0: 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 rs db run-id).
4d00: 28 6c 65 74 20 28 28 6b 65 79 73 20 28 64 62 2d (let ((keys (db-
4d10: 67 65 74 2d 6b 65 79 73 20 64 62 29 29 29 0a 20 get-keys db))).
4d20: 20 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 (for-each (la
4d30: 6d 62 64 61 20 28 6b 65 79 29 0a 09 09 28 73 71 mbda (key)...(sq
4d40: 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 lite3:for-each-r
4d50: 6f 77 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 76 ow... (lambda (v
4d60: 61 6c 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a al)... (debug:
4d70: 70 72 69 6e 74 20 32 20 22 73 65 74 65 6e 76 20 print 2 "setenv
4d80: 22 20 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 " (key:get-field
4d90: 6e 61 6d 65 20 6b 65 79 29 20 22 20 22 20 76 61 name key) " " va
4da0: 6c 29 0a 09 09 20 20 20 28 73 65 74 65 6e 76 20 l)... (setenv
4db0: 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 (key:get-fieldna
4dc0: 6d 65 20 6b 65 79 29 20 76 61 6c 29 29 0a 09 09 me key) val))...
4dd0: 20 64 62 20 0a 09 09 20 28 63 6f 6e 63 20 22 53 db ... (conc "S
4de0: 45 4c 45 43 54 20 22 20 28 6b 65 79 3a 67 65 74 ELECT " (key:get
4df0: 2d 66 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 20 -fieldname key)
4e00: 22 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 " FROM runs WHER
4e10: 45 20 69 64 3d 3f 3b 22 29 0a 09 09 20 72 75 6e E id=?;")... run
4e20: 2d 69 64 29 29 0a 09 20 20 20 20 20 20 6b 65 79 -id)).. key
4e30: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 s)))..(define (s
4e40: 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 et-item-env-vars
4e50: 20 69 74 65 6d 64 61 74 29 0a 20 20 28 66 6f 72 itemdat). (for
4e60: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 69 -each (lambda (i
4e70: 74 65 6d 29 0a 09 20 20 20 20 20 20 28 64 65 62 tem).. (deb
4e80: 75 67 3a 70 72 69 6e 74 20 32 20 22 73 65 74 65 ug:print 2 "sete
4e90: 6e 76 20 22 20 28 63 61 72 20 69 74 65 6d 29 20 nv " (car item)
4ea0: 22 20 22 20 28 63 61 64 72 20 69 74 65 6d 29 29 " " (cadr item))
4eb0: 0a 09 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 .. (setenv
4ec0: 28 63 61 72 20 69 74 65 6d 29 20 28 63 61 64 72 (car item) (cadr
4ed0: 20 69 74 65 6d 29 29 29 0a 09 20 20 20 20 69 74 item))).. it
4ee0: 65 6d 64 61 74 29 29 0a 0a 28 64 65 66 69 6e 65 emdat))..(define
4ef0: 20 28 67 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d (get-all-legal-
4f00: 74 65 73 74 73 29 0a 20 20 28 6c 65 74 2a 20 28 tests). (let* (
4f10: 28 74 65 73 74 73 20 20 28 67 6c 6f 62 20 28 63 (tests (glob (c
4f20: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
4f30: 74 65 73 74 73 2f 2a 22 29 29 29 0a 09 20 28 72 tests/*"))).. (r
4f40: 65 73 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 es '())).
4f50: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
4f60: 49 4e 46 4f 3a 20 4c 6f 6f 6b 69 6e 67 20 61 74 INFO: Looking at
4f70: 20 74 65 73 74 73 20 22 20 28 73 74 72 69 6e 67 tests " (string
4f80: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 74 65 73 -intersperse tes
4f90: 74 73 20 22 2c 22 29 29 0a 20 20 20 20 28 66 6f ts ",")). (fo
4fa0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
4fb0: 74 65 73 74 70 61 74 68 29 0a 09 09 28 69 66 20 testpath)...(if
4fc0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 (file-exists? (c
4fd0: 6f 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 74 onc testpath "/t
4fe0: 65 73 74 63 6f 6e 66 69 67 22 29 29 0a 09 09 20 estconfig"))...
4ff0: 20 20 20 28 73 65 74 21 20 72 65 73 20 28 63 6f (set! res (co
5000: 6e 73 20 28 6c 61 73 74 20 28 73 74 72 69 6e 67 ns (last (string
5010: 2d 73 70 6c 69 74 20 74 65 73 74 70 61 74 68 20 -split testpath
5020: 22 2f 22 29 29 20 72 65 73 29 29 29 29 0a 09 20 "/")) res))))..
5030: 20 20 20 20 20 74 65 73 74 73 29 0a 20 20 20 20 tests).
5040: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 res))..(define (
5050: 72 75 6e 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 runs:can-run-mor
5060: 65 2d 74 65 73 74 73 20 64 62 29 0a 20 20 28 6c e-tests db). (l
5070: 65 74 20 28 28 6e 75 6d 2d 72 75 6e 6e 69 6e 67 et ((num-running
5080: 20 28 64 62 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 (db:get-count-t
5090: 65 73 74 73 2d 72 75 6e 6e 69 6e 67 20 64 62 29 ests-running db)
50a0: 29 0a 09 28 6d 61 78 2d 63 6f 6e 63 75 72 72 65 )..(max-concurre
50b0: 6e 74 2d 6a 6f 62 73 20 28 63 6f 6e 66 69 67 2d nt-jobs (config-
50c0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
50d0: 74 2a 20 22 73 65 74 75 70 22 20 22 6d 61 78 5f t* "setup" "max_
50e0: 63 6f 6e 63 75 72 72 65 6e 74 5f 6a 6f 62 73 22 concurrent_jobs"
50f0: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
5100: 72 69 6e 74 20 32 20 22 6d 61 78 2d 63 6f 6e 63 rint 2 "max-conc
5110: 75 72 72 65 6e 74 2d 6a 6f 62 73 3a 20 22 20 6d urrent-jobs: " m
5120: 61 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f ax-concurrent-jo
5130: 62 73 20 22 2c 20 6e 75 6d 2d 72 75 6e 6e 69 6e bs ", num-runnin
5140: 67 3a 20 22 20 6e 75 6d 2d 72 75 6e 6e 69 6e 67 g: " num-running
5150: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
5160: 65 71 3f 20 30 20 2a 67 6c 6f 62 61 6c 65 78 69 eq? 0 *globalexi
5170: 74 73 74 61 74 75 73 2a 29 29 0a 09 23 66 0a 09 tstatus*))..#f..
5180: 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 6d 61 78 (if (or (not max
5190: 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 -concurrent-jobs
51a0: 29 0a 09 09 28 61 6e 64 20 6d 61 78 2d 63 6f 6e )...(and max-con
51b0: 63 75 72 72 65 6e 74 2d 6a 6f 62 73 0a 09 09 20 current-jobs...
51c0: 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
51d0: 62 65 72 20 6d 61 78 2d 63 6f 6e 63 75 72 72 65 ber max-concurre
51e0: 6e 74 2d 6a 6f 62 73 29 0a 09 09 20 20 20 20 20 nt-jobs)...
51f0: 28 6e 6f 74 20 28 3e 3d 20 6e 75 6d 2d 72 75 6e (not (>= num-run
5200: 6e 69 6e 67 20 28 73 74 72 69 6e 67 2d 3e 6e 75 ning (string->nu
5210: 6d 62 65 72 20 6d 61 78 2d 63 6f 6e 63 75 72 72 mber max-concurr
5220: 65 6e 74 2d 6a 6f 62 73 29 29 29 29 29 0a 09 20 ent-jobs)))))..
5230: 20 20 20 23 74 0a 09 20 20 20 20 28 62 65 67 69 #t.. (begi
5240: 6e 20 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 n .. (debug
5250: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
5260: 47 3a 20 4d 61 78 20 72 75 6e 6e 69 6e 67 20 6a G: Max running j
5270: 6f 62 73 20 65 78 63 65 65 64 65 64 2c 20 63 75 obs exceeded, cu
5280: 72 72 65 6e 74 20 6e 75 6d 62 65 72 20 72 75 6e rrent number run
5290: 6e 69 6e 67 3a 20 22 20 6e 75 6d 2d 72 75 6e 6e ning: " num-runn
52a0: 69 6e 67 20 0a 09 09 09 20 20 20 22 2c 20 6d 61 ing .... ", ma
52b0: 78 5f 63 6f 6e 63 75 72 72 65 6e 74 5f 6a 6f 62 x_concurrent_job
52c0: 73 3a 20 22 20 6d 61 78 2d 63 6f 6e 63 75 72 72 s: " max-concurr
52d0: 65 6e 74 2d 6a 6f 62 73 29 0a 09 20 20 20 20 20 ent-jobs)..
52e0: 20 23 66 29 29 29 29 29 0a 20 20 0a 28 64 65 66 #f))))). .(def
52f0: 69 6e 65 20 28 72 75 6e 2d 74 65 73 74 73 20 64 ine (run-tests d
5300: 62 20 74 65 73 74 2d 6e 61 6d 65 73 29 0a 20 20 b test-names).
5310: 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 20 (let* ((keys
5320: 20 20 20 20 28 64 62 2d 67 65 74 2d 6b 65 79 73 (db-get-keys
5330: 20 64 62 29 29 0a 09 20 28 6b 65 79 76 61 6c 6c db)).. (keyvall
5340: 73 74 20 20 20 28 6b 65 79 73 2d 3e 76 61 6c 6c st (keys->vall
5350: 69 73 74 20 6b 65 79 73 20 23 74 29 29 0a 09 20 ist keys #t))..
5360: 28 72 75 6e 2d 69 64 20 20 20 20 20 20 28 72 65 (run-id (re
5370: 67 69 73 74 65 72 2d 72 75 6e 20 64 62 20 6b 65 gister-run db ke
5380: 79 73 29 29 20 20 3b 3b 20 20 74 65 73 74 2d 6e ys)) ;; test-n
5390: 61 6d 65 29 29 29 0a 09 20 28 64 65 66 65 72 72 ame))).. (deferr
53a0: 65 64 20 20 20 20 27 28 29 29 29 20 3b 3b 20 64 ed '())) ;; d
53b0: 65 6c 61 79 20 72 75 6e 6e 69 6e 67 20 74 68 65 elay running the
53c0: 73 65 20 73 69 6e 63 65 20 74 68 65 79 20 68 61 se since they ha
53d0: 76 65 20 61 20 77 61 69 74 6f 6e 20 63 6c 61 75 ve a waiton clau
53e0: 73 65 0a 20 20 20 20 3b 3b 20 6f 6e 20 74 68 65 se. ;; on the
53f0: 20 66 69 72 73 74 20 70 61 73 73 20 6f 72 20 63 first pass or c
5400: 61 6c 6c 20 74 6f 20 72 75 6e 2d 74 65 73 74 73 all to run-tests
5410: 20 73 65 74 20 46 41 49 4c 53 20 74 6f 20 4e 4f set FAILS to NO
5420: 54 5f 53 54 41 52 54 45 44 20 69 66 0a 20 20 20 T_STARTED if.
5430: 20 3b 3b 20 2d 6b 65 65 70 67 6f 69 6e 67 20 69 ;; -keepgoing i
5440: 73 20 73 70 65 63 69 66 69 65 64 0a 20 20 20 20 s specified.
5450: 28 69 66 20 28 61 6e 64 20 28 65 71 3f 20 2a 70 (if (and (eq? *p
5460: 61 73 73 6e 75 6d 2a 20 30 29 0a 09 20 20 20 20 assnum* 0)..
5470: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
5480: 2d 6b 65 65 70 67 6f 69 6e 67 22 29 29 0a 09 28 -keepgoing"))..(
5490: 62 65 67 69 6e 0a 09 20 20 3b 3b 20 68 61 76 65 begin.. ;; have
54a0: 20 74 6f 20 64 65 6c 65 74 65 20 74 65 73 74 20 to delete test
54b0: 72 65 63 6f 72 64 73 20 77 68 65 72 65 20 4e 4f records where NO
54c0: 54 5f 53 54 41 52 54 45 44 20 73 69 6e 63 65 20 T_STARTED since
54d0: 74 68 65 79 20 63 61 6e 20 63 61 75 73 65 20 2d they can cause -
54e0: 6b 65 65 70 67 6f 69 6e 67 20 74 6f 20 0a 09 20 keepgoing to ..
54f0: 20 3b 3b 20 67 65 74 20 73 74 75 63 6b 20 64 75 ;; get stuck du
5500: 65 20 74 6f 20 62 65 63 6f 6d 69 6e 67 20 69 6e e to becoming in
5510: 61 63 63 65 73 73 69 62 6c 65 20 66 72 6f 6d 20 accessible from
5520: 61 20 66 61 69 6c 65 64 20 74 65 73 74 2e 20 49 a failed test. I
5530: 2e 65 2e 20 69 66 20 74 65 73 74 20 42 20 64 65 .e. if test B de
5540: 70 65 6e 64 73 20 0a 09 20 20 3b 3b 20 6f 6e 20 pends .. ;; on
5550: 74 65 73 74 20 41 20 62 75 74 20 74 65 73 74 20 test A but test
5560: 42 20 72 65 61 63 68 65 64 20 74 68 65 20 70 6f B reached the po
5570: 69 6e 74 20 6f 6e 20 62 65 69 6e 67 20 72 65 67 int on being reg
5580: 69 73 74 65 72 65 64 20 61 73 20 4e 4f 54 5f 53 istered as NOT_S
5590: 54 41 52 54 45 44 20 61 6e 64 20 74 65 73 74 0a TARTED and test.
55a0: 09 20 20 3b 3b 20 41 20 66 61 69 6c 65 64 20 66 . ;; A failed f
55b0: 6f 72 20 73 6f 6d 65 20 72 65 61 73 6f 6e 20 74 or some reason t
55c0: 68 65 6e 20 6f 6e 20 72 65 2d 72 75 6e 20 75 73 hen on re-run us
55d0: 69 6e 67 20 2d 6b 65 65 70 67 6f 69 6e 67 20 74 ing -keepgoing t
55e0: 68 65 20 72 75 6e 20 63 61 6e 20 6e 65 76 65 72 he run can never
55f0: 20 63 6f 6d 70 6c 65 74 65 2e 0a 09 20 20 28 64 complete... (d
5600: 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 73 2d 69 b:delete-tests-i
5610: 6e 2d 73 74 61 74 65 20 64 62 20 72 75 6e 2d 69 n-state db run-i
5620: 64 20 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 d "NOT_STARTED")
5630: 0a 09 20 20 28 64 62 3a 73 65 74 2d 74 65 73 74 .. (db:set-test
5640: 73 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 64 s-state-status d
5650: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
5660: 6d 65 73 20 23 66 20 22 46 41 49 4c 22 20 22 4e mes #f "FAIL" "N
5670: 4f 54 5f 53 54 41 52 54 45 44 22 20 22 46 41 49 OT_STARTED" "FAI
5680: 4c 22 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 L"))). (set!
5690: 2a 70 61 73 73 6e 75 6d 2a 20 28 2b 20 2a 70 61 *passnum* (+ *pa
56a0: 73 73 6e 75 6d 2a 20 31 29 29 0a 20 20 20 20 28 ssnum* 1)). (
56b0: 6c 65 74 20 6c 6f 6f 70 20 28 28 6e 75 6d 74 69 let loop ((numti
56c0: 6d 65 73 20 30 29 29 0a 20 20 20 20 20 20 28 66 mes 0)). (f
56d0: 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 20 20 or-each .
56e0: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 6e 61 (lambda (test-na
56f0: 6d 65 29 0a 09 20 28 69 66 20 28 72 75 6e 73 3a me).. (if (runs:
5700: 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 65 73 can-run-more-tes
5710: 74 73 20 64 62 29 0a 09 20 20 20 20 20 28 72 75 ts db).. (ru
5720: 6e 2d 6f 6e 65 2d 74 65 73 74 20 64 62 20 72 75 n-one-test db ru
5730: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 6b n-id test-name k
5740: 65 79 76 61 6c 6c 73 74 29 0a 09 20 20 20 20 20 eyvallst)..
5750: 3b 3b 20 61 64 64 20 73 6f 6d 65 20 64 65 6c 61 ;; add some dela
5760: 79 20 0a 09 20 20 20 20 20 3b 28 73 6c 65 65 70 y .. ;(sleep
5770: 20 32 29 0a 09 20 20 20 20 20 29 29 0a 20 20 20 2).. )).
5780: 20 20 20 20 74 65 73 74 2d 6e 61 6d 65 73 29 0a test-names).
5790: 20 20 20 20 20 20 3b 3b 20 28 72 75 6e 2d 77 61 ;; (run-wa
57a0: 69 74 69 6e 67 2d 74 65 73 74 73 20 64 62 29 0a iting-tests db).
57b0: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
57c0: 67 65 74 2d 61 72 67 20 22 2d 6b 65 65 70 67 6f get-arg "-keepgo
57d0: 69 6e 67 22 29 0a 09 20 20 28 6c 65 74 20 28 28 ing").. (let ((
57e0: 65 73 74 72 65 6d 20 28 64 62 3a 65 73 74 69 6d estrem (db:estim
57f0: 61 74 65 64 2d 74 65 73 74 73 2d 72 65 6d 61 69 ated-tests-remai
5800: 6e 69 6e 67 20 64 62 20 72 75 6e 2d 69 64 29 29 ning db run-id))
5810: 29 0a 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 ).. (if (and
5820: 28 3e 20 65 73 74 72 65 6d 20 30 29 0a 09 09 20 (> estrem 0)...
5830: 20 20 20 20 28 65 71 3f 20 2a 67 6c 6f 62 61 6c (eq? *global
5840: 65 78 69 74 73 74 61 74 75 73 2a 20 30 29 29 0a exitstatus* 0)).
5850: 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 ..(begin... (de
5860: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4b 65 65 bug:print 1 "Kee
5870: 70 20 67 6f 69 6e 67 2c 20 65 73 74 69 6d 61 74 p going, estimat
5880: 65 64 20 22 20 65 73 74 72 65 6d 20 22 20 74 65 ed " estrem " te
5890: 73 74 73 20 72 65 6d 61 69 6e 69 6e 67 20 74 6f sts remaining to
58a0: 20 72 75 6e 2c 20 77 69 6c 6c 20 63 6f 6e 74 69 run, will conti
58b0: 6e 75 65 20 69 6e 20 33 20 73 65 63 6f 6e 64 73 nue in 3 seconds
58c0: 20 2e 2e 2e 22 29 0a 09 09 20 20 28 73 6c 65 65 ...")... (slee
58d0: 70 20 33 29 0a 09 09 20 20 28 72 75 6e 2d 77 61 p 3)... (run-wa
58e0: 69 74 69 6e 67 2d 74 65 73 74 73 20 64 62 29 0a iting-tests db).
58f0: 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 6e 75 6d .. (loop (+ num
5900: 74 69 6d 65 73 20 31 29 29 29 29 29 29 29 29 29 times 1)))))))))
5910: 0a 09 20 20 20 0a 3b 3b 20 56 45 52 59 20 49 4e .. .;; VERY IN
5920: 45 46 46 49 43 49 45 4e 54 21 20 4d 6f 76 65 20 EFFICIENT! Move
5930: 73 74 75 66 66 20 74 68 61 74 20 73 68 6f 75 6c stuff that shoul
5940: 64 20 62 65 20 64 6f 6e 65 20 6f 6e 63 65 20 75 d be done once u
5950: 70 20 74 6f 20 63 61 6c 6c 69 6e 67 20 70 72 6f p to calling pro
5960: 63 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 2d 6f c.(define (run-o
5970: 6e 65 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 ne-test db run-i
5980: 64 20 74 65 73 74 2d 6e 61 6d 65 20 6b 65 79 76 d test-name keyv
5990: 61 6c 6c 73 74 29 0a 20 20 28 64 65 62 75 67 3a allst). (debug:
59a0: 70 72 69 6e 74 20 31 20 22 4c 61 75 6e 63 68 69 print 1 "Launchi
59b0: 6e 67 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e ng test " test-n
59c0: 61 6d 65 29 0a 20 20 3b 3b 20 41 6c 6c 20 74 68 ame). ;; All th
59d0: 65 73 65 20 76 61 72 73 20 6d 69 67 68 74 20 62 ese vars might b
59e0: 65 20 72 65 66 65 72 65 6e 63 65 64 20 62 79 20 e referenced by
59f0: 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 20 66 the testconfig f
5a00: 69 6c 65 20 72 65 61 64 65 72 0a 20 20 28 73 65 ile reader. (se
5a10: 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e 41 tenv "MT_TEST_NA
5a20: 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 20 3b ME" test-name) ;
5a30: 3b 20 0a 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ; . (setenv "MT
5a40: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 28 61 72 67 _RUNNAME" (arg
5a50: 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e s:get-arg ":runn
5a60: 61 6d 65 22 29 29 0a 20 20 28 73 65 74 2d 6d 65 ame")). (set-me
5a70: 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 gatest-env-vars
5a80: 64 62 20 72 75 6e 2d 69 64 29 20 3b 3b 20 74 68 db run-id) ;; th
5a90: 65 73 65 20 6d 61 79 20 62 65 20 6e 65 65 64 65 ese may be neede
5aa0: 64 20 62 79 20 74 68 65 20 6c 61 75 6e 63 68 69 d by the launchi
5ab0: 6e 67 20 70 72 6f 63 65 73 73 0a 20 20 28 63 68 ng process. (ch
5ac0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a ange-directory *
5ad0: 74 6f 70 70 61 74 68 2a 29 0a 20 20 28 6c 65 74 toppath*). (let
5ae0: 2a 20 28 28 74 65 73 74 2d 70 61 74 68 20 20 20 * ((test-path
5af0: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
5b00: 20 22 2f 74 65 73 74 73 2f 22 20 74 65 73 74 2d "/tests/" test-
5b10: 6e 61 6d 65 29 29 0a 09 20 28 74 65 73 74 2d 63 name)).. (test-c
5b20: 6f 6e 66 69 67 66 20 28 63 6f 6e 63 20 74 65 73 onfigf (conc tes
5b30: 74 2d 70 61 74 68 20 22 2f 74 65 73 74 63 6f 6e t-path "/testcon
5b40: 66 69 67 22 29 29 0a 09 20 28 74 65 73 74 65 78 fig")).. (testex
5b50: 69 73 74 73 20 20 20 28 61 6e 64 20 28 66 69 6c ists (and (fil
5b60: 65 2d 65 78 69 73 74 73 3f 20 74 65 73 74 2d 63 e-exists? test-c
5b70: 6f 6e 66 69 67 66 29 28 66 69 6c 65 2d 72 65 61 onfigf)(file-rea
5b80: 64 2d 61 63 63 65 73 73 3f 20 74 65 73 74 2d 63 d-access? test-c
5b90: 6f 6e 66 69 67 66 29 29 29 0a 09 20 28 74 65 73 onfigf))).. (tes
5ba0: 74 2d 63 6f 6e 66 20 20 20 20 28 69 66 20 74 65 t-conf (if te
5bb0: 73 74 65 78 69 73 74 73 20 28 72 65 61 64 2d 63 stexists (read-c
5bc0: 6f 6e 66 69 67 20 74 65 73 74 2d 63 6f 6e 66 69 onfig test-confi
5bd0: 67 66 20 23 66 20 23 74 29 20 28 6d 61 6b 65 2d gf #f #t) (make-
5be0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 hash-table)))..
5bf0: 28 77 61 69 74 6f 6e 20 20 20 20 20 20 20 28 6c (waiton (l
5c00: 65 74 20 28 28 77 20 28 63 6f 6e 66 69 67 2d 6c et ((w (config-l
5c10: 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 ookup test-conf
5c20: 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 "requirements" "
5c30: 77 61 69 74 6f 6e 22 29 29 29 0a 09 09 09 20 28 waiton"))).... (
5c40: 69 66 20 28 73 74 72 69 6e 67 3f 20 77 29 28 73 if (string? w)(s
5c50: 74 72 69 6e 67 2d 73 70 6c 69 74 20 77 29 27 28 tring-split w)'(
5c60: 29 29 29 29 0a 09 20 28 74 61 67 73 20 20 20 20 )))).. (tags
5c70: 20 20 20 20 20 28 6c 65 74 20 28 28 74 20 28 63 (let ((t (c
5c80: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
5c90: 74 2d 63 6f 6e 66 20 22 73 65 74 75 70 22 20 22 t-conf "setup" "
5ca0: 74 61 67 73 22 29 29 29 0a 09 09 09 20 3b 3b 20 tags"))).... ;;
5cb0: 77 65 20 77 61 6e 74 20 6f 75 72 20 74 61 67 73 we want our tags
5cc0: 20 74 6f 20 62 65 20 73 65 70 61 72 61 74 65 64 to be separated
5cd0: 20 62 79 20 63 6f 6d 6d 61 73 20 61 6e 64 20 66 by commas and f
5ce0: 75 6c 6c 79 20 64 65 6c 69 6d 69 74 65 64 20 62 ully delimited b
5cf0: 79 20 63 6f 6d 6d 61 73 0a 09 09 09 20 3b 3b 20 y commas.... ;;
5d00: 73 6f 20 74 68 61 74 20 71 75 65 72 69 65 73 20 so that queries
5d10: 77 69 74 68 20 22 6c 69 6b 65 22 20 63 61 6e 20 with "like" can
5d20: 74 69 65 20 74 6f 20 74 68 65 20 63 6f 6d 6d 61 tie to the comma
5d30: 73 20 61 74 20 65 69 74 68 65 72 20 65 6e 64 20 s at either end
5d40: 6f 66 20 65 61 63 68 20 74 61 67 0a 09 09 09 20 of each tag....
5d50: 3b 3b 20 77 68 69 6c 65 20 61 6c 73 6f 20 61 6c ;; while also al
5d60: 6c 6f 77 69 6e 67 20 74 68 65 20 65 6e 64 20 75 lowing the end u
5d70: 73 65 72 20 74 6f 20 66 72 65 65 6c 79 20 75 73 ser to freely us
5d80: 65 20 73 70 61 63 65 73 20 61 6e 64 20 63 6f 6d e spaces and com
5d90: 6d 61 73 20 74 6f 20 73 65 70 61 72 61 74 65 20 mas to separate
5da0: 74 61 67 73 0a 09 09 09 20 28 69 66 20 28 73 74 tags.... (if (st
5db0: 72 69 6e 67 3f 20 74 29 28 73 74 72 69 6e 67 2d ring? t)(string-
5dc0: 73 75 62 73 74 69 74 75 74 65 20 28 72 65 67 65 substitute (rege
5dd0: 78 70 20 22 5b 2c 5c 5c 73 5d 2b 22 29 20 22 2c xp "[,\\s]+") ",
5de0: 22 20 28 63 6f 6e 63 20 22 2c 22 20 74 20 22 2c " (conc "," t ",
5df0: 22 29 20 23 74 29 0a 09 09 09 20 20 20 20 20 27 ") #t).... '
5e00: 28 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 28 ())))). (if (
5e10: 6e 6f 74 20 74 65 73 74 65 78 69 73 74 73 29 0a not testexists).
5e20: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
5e30: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
5e40: 3a 20 43 61 6e 27 74 20 66 69 6e 64 20 63 6f 6e : Can't find con
5e50: 66 69 67 20 66 69 6c 65 20 22 20 74 65 73 74 2d fig file " test-
5e60: 63 6f 6e 66 69 67 66 29 0a 09 20 20 28 65 78 69 configf).. (exi
5e70: 74 20 32 29 29 0a 09 3b 3b 20 70 75 74 20 74 6f t 2))..;; put to
5e80: 70 20 76 61 72 73 20 69 6e 74 6f 20 63 6f 6e 76 p vars into conv
5e90: 65 6e 69 65 6e 74 20 76 61 72 69 61 62 6c 65 73 enient variables
5ea0: 20 61 6e 64 20 6f 70 65 6e 20 74 68 65 20 64 62 and open the db
5eb0: 0a 09 28 6c 65 74 2a 20 28 3b 3b 20 64 62 20 69 ..(let* (;; db i
5ec0: 73 20 61 6c 77 61 79 73 20 61 74 20 2a 74 6f 70 s always at *top
5ed0: 70 61 74 68 2a 2f 64 62 2f 6d 65 67 61 74 65 73 path*/db/megates
5ee0: 74 2e 64 62 0a 09 20 20 20 20 20 20 20 28 69 74 t.db.. (it
5ef0: 65 6d 73 20 20 20 20 20 20 20 28 68 61 73 68 2d ems (hash-
5f00: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5f10: 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 69 74 65 t test-conf "ite
5f20: 6d 73 22 20 27 28 29 29 29 0a 09 20 20 20 20 20 ms" '()))..
5f30: 20 20 28 69 74 65 6d 73 74 61 62 6c 65 20 20 28 (itemstable (
5f40: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
5f50: 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 efault test-conf
5f60: 20 22 69 74 65 6d 73 74 61 62 6c 65 22 20 27 28 "itemstable" '(
5f70: 29 29 29 0a 09 20 20 20 20 20 20 20 28 61 6c 6c ))).. (all
5f80: 69 74 65 6d 73 20 20 20 20 28 69 66 20 28 6f 72 items (if (or
5f90: 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 69 74 65 (not (null? ite
5fa0: 6d 73 29 29 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 ms))(not (null?
5fb0: 69 74 65 6d 73 74 61 62 6c 65 29 29 29 0a 09 09 itemstable)))...
5fc0: 09 09 28 61 70 70 65 6e 64 20 28 69 74 65 6d 2d ..(append (item-
5fd0: 61 73 73 6f 63 2d 3e 69 74 65 6d 2d 6c 69 73 74 assoc->item-list
5fe0: 20 69 74 65 6d 73 29 0a 09 09 09 09 09 28 69 74 items)......(it
5ff0: 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c em-table->item-l
6000: 69 73 74 20 69 74 65 6d 73 74 61 62 6c 65 29 29 ist itemstable))
6010: 0a 09 09 09 09 27 28 28 29 29 29 29 20 3b 3b 20 .....'(()))) ;;
6020: 61 20 6c 69 73 74 20 77 69 74 68 20 6f 6e 65 20 a list with one
6030: 6e 75 6c 6c 20 6c 69 73 74 20 69 73 20 61 20 74 null list is a t
6040: 65 73 74 20 77 69 74 68 20 6e 6f 20 69 74 65 6d est with no item
6050: 73 0a 09 20 20 20 20 20 20 20 28 72 75 6e 63 6f s.. (runco
6060: 6e 66 69 67 66 20 20 28 63 6f 6e 63 20 20 2a 74 nfigf (conc *t
6070: 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e oppath* "/runcon
6080: 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 29 29 0a figs.config"))).
6090: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
60a0: 31 20 22 69 74 65 6d 73 3a 20 22 29 0a 09 20 20 1 "items: ")..
60b0: 28 69 66 20 28 3e 3d 20 2a 76 65 72 62 6f 73 69 (if (>= *verbosi
60c0: 74 79 2a 20 31 29 28 70 70 20 61 6c 6c 69 74 65 ty* 1)(pp allite
60d0: 6d 73 29 29 0a 09 20 20 28 69 66 20 28 3e 3d 20 ms)).. (if (>=
60e0: 2a 76 65 72 62 6f 73 69 74 79 2a 20 35 29 0a 09 *verbosity* 5)..
60f0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
6100: 70 72 69 6e 74 20 22 69 74 65 6d 73 3a 20 22 29 print "items: ")
6110: 28 70 70 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d (pp (item-assoc-
6120: 3e 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d 73 >item-list items
6130: 29 29 0a 09 09 28 70 72 69 6e 74 20 22 69 74 65 ))...(print "ite
6140: 73 74 61 62 6c 65 3a 20 22 29 28 70 70 20 28 69 stable: ")(pp (i
6150: 74 65 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 6d 2d tem-table->item-
6160: 6c 69 73 74 20 69 74 65 6d 73 74 61 62 6c 65 29 list itemstable)
6170: 29 29 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 ))).. (if (args
6180: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 0a 09 :get-arg "-m")..
6190: 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d 63 6f (db:set-co
61a0: 6d 6d 65 6e 74 2d 66 6f 72 2d 72 75 6e 20 64 62 mment-for-run db
61b0: 20 72 75 6e 2d 69 64 20 28 61 72 67 73 3a 67 65 run-id (args:ge
61c0: 74 2d 61 72 67 20 22 2d 6d 22 29 29 29 0a 0a 09 t-arg "-m")))...
61d0: 20 20 3b 3b 20 48 65 72 65 20 69 73 20 77 68 65 ;; Here is whe
61e0: 72 65 20 74 68 65 20 74 65 73 74 5f 6d 65 74 61 re the test_meta
61f0: 20 74 61 62 6c 65 20 69 73 20 62 65 73 74 20 75 table is best u
6200: 70 64 61 74 65 64 0a 09 20 20 28 72 75 6e 73 3a pdated.. (runs:
6210: 75 70 64 61 74 65 2d 74 65 73 74 5f 6d 65 74 61 update-test_meta
6220: 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 db test-name te
6230: 73 74 2d 63 6f 6e 66 29 0a 0a 09 20 20 3b 3b 20 st-conf)... ;;
6240: 62 72 61 69 6e 64 65 61 64 20 77 6f 72 6b 2d 61 braindead work-a
6250: 72 6f 75 6e 64 20 66 6f 72 20 70 6f 6f 72 6c 79 round for poorly
6260: 20 73 70 65 63 69 66 69 65 64 20 61 6c 6c 69 74 specified allit
6270: 65 6d 73 20 6c 69 73 74 20 42 55 47 21 21 21 20 ems list BUG!!!
6280: 46 49 58 4d 45 0a 09 20 20 28 69 66 20 28 6e 75 FIXME.. (if (nu
6290: 6c 6c 3f 20 61 6c 6c 69 74 65 6d 73 29 28 73 65 ll? allitems)(se
62a0: 74 21 20 61 6c 6c 69 74 65 6d 73 20 27 28 28 29 t! allitems '(()
62b0: 29 29 29 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 ))).. (let loop
62c0: 20 28 28 69 74 65 6d 64 61 74 20 28 63 61 72 20 ((itemdat (car
62d0: 61 6c 6c 69 74 65 6d 73 29 29 0a 09 09 20 20 20 allitems))...
62e0: 20 20 28 74 61 6c 20 20 20 20 20 28 63 64 72 20 (tal (cdr
62f0: 61 6c 6c 69 74 65 6d 73 29 29 29 0a 09 20 20 20 allitems)))..
6300: 20 3b 3b 20 28 6c 61 6d 62 64 61 20 28 69 74 65 ;; (lambda (ite
6310: 6d 64 61 74 29 20 3b 3b 3b 20 28 28 72 69 70 65 mdat) ;;; ((ripe
6320: 6e 65 73 73 20 22 6f 76 65 72 72 69 70 65 22 29 ness "overripe")
6330: 20 28 74 65 6d 70 65 72 61 74 75 72 65 20 22 63 (temperature "c
6340: 6f 6f 6c 22 29 20 28 73 65 61 73 6f 6e 20 22 73 ool") (season "s
6350: 75 6d 6d 65 72 22 29 29 0a 09 20 20 20 20 3b 3b ummer")).. ;;
6360: 20 48 61 6e 64 6c 65 20 6c 69 73 74 73 20 6f 66 Handle lists of
6370: 20 69 74 65 6d 73 0a 09 20 20 20 20 28 6c 65 74 items.. (let
6380: 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 20 20 * ((item-path
6390: 20 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 (item-list->pa
63a0: 74 68 20 69 74 65 6d 64 61 74 29 29 20 3b 3b 20 th itemdat)) ;;
63b0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
63c0: 72 73 65 20 28 6d 61 70 20 63 61 64 72 20 69 74 rse (map cadr it
63d0: 65 6d 64 61 74 29 20 22 2f 22 29 29 0a 09 09 20 emdat) "/"))...
63e0: 20 20 28 6e 65 77 2d 74 65 73 74 2d 70 61 74 68 (new-test-path
63f0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
6400: 65 72 73 65 20 28 63 6f 6e 73 20 74 65 73 74 2d erse (cons test-
6410: 70 61 74 68 20 28 6d 61 70 20 63 61 64 72 20 69 path (map cadr i
6420: 74 65 6d 64 61 74 29 29 20 22 2f 22 29 29 0a 09 temdat)) "/"))..
6430: 09 20 20 20 28 6e 65 77 2d 74 65 73 74 2d 6e 61 . (new-test-na
6440: 6d 65 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 me (if (equal? i
6450: 74 65 6d 2d 70 61 74 68 20 22 22 29 20 74 65 73 tem-path "") tes
6460: 74 2d 6e 61 6d 65 20 28 63 6f 6e 63 20 74 65 73 t-name (conc tes
6470: 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d t-name "/" item-
6480: 70 61 74 68 29 29 29 20 3b 3b 20 6a 75 73 74 20 path))) ;; just
6490: 6e 65 65 64 20 69 74 20 74 6f 20 62 65 20 75 6e need it to be un
64a0: 69 71 75 65 0a 09 09 20 20 20 28 74 65 73 74 64 ique... (testd
64b0: 61 74 20 20 20 23 66 29 0a 09 09 20 20 20 28 6e at #f)... (n
64c0: 75 6d 2d 72 75 6e 6e 69 6e 67 20 28 64 62 3a 67 um-running (db:g
64d0: 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 et-count-tests-r
64e0: 75 6e 6e 69 6e 67 20 64 62 29 29 0a 09 09 20 20 unning db))...
64f0: 20 28 6d 61 78 2d 63 6f 6e 63 75 72 72 65 6e 74 (max-concurrent
6500: 2d 6a 6f 62 73 20 28 63 6f 6e 66 69 67 2d 6c 6f -jobs (config-lo
6510: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
6520: 20 22 73 65 74 75 70 22 20 22 6d 61 78 5f 63 6f "setup" "max_co
6530: 6e 63 75 72 72 65 6e 74 5f 6a 6f 62 73 22 29 29 ncurrent_jobs"))
6540: 0a 09 09 20 20 20 28 70 61 72 65 6e 74 2d 74 65 ... (parent-te
6550: 73 74 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 st (and (not (nu
6560: 6c 6c 3f 20 69 74 65 6d 73 29 29 28 65 71 75 61 ll? items))(equa
6570: 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 l? item-path "")
6580: 29 29 0a 09 09 20 20 20 28 73 69 6e 67 6c 65 2d ))... (single-
6590: 74 65 73 74 20 28 61 6e 64 20 28 6e 75 6c 6c 3f test (and (null?
65a0: 20 69 74 65 6d 73 29 20 28 65 71 75 61 6c 3f 20 items) (equal?
65b0: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 0a item-path ""))).
65c0: 09 09 20 20 20 28 69 74 65 6d 2d 74 65 73 74 20 .. (item-test
65d0: 20 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 (not (equal? i
65e0: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 29 29 0a tem-path "")))).
65f0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
6600: 69 6e 74 20 33 20 22 6d 61 78 2d 63 6f 6e 63 75 int 3 "max-concu
6610: 72 72 65 6e 74 2d 6a 6f 62 73 3a 20 22 20 6d 61 rrent-jobs: " ma
6620: 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 x-concurrent-job
6630: 73 20 22 2c 20 6e 75 6d 2d 72 75 6e 6e 69 6e 67 s ", num-running
6640: 3a 20 22 20 6e 75 6d 2d 72 75 6e 6e 69 6e 67 29 : " num-running)
6650: 0a 09 20 20 20 20 20 20 28 69 66 20 28 72 75 6e .. (if (run
6660: 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 s:can-run-more-t
6670: 65 73 74 73 20 64 62 29 0a 09 09 20 20 28 62 65 ests db)... (be
6680: 67 69 6e 0a 09 09 20 20 20 20 28 6c 65 74 20 6c gin... (let l
6690: 6f 6f 70 32 20 28 28 74 73 20 28 64 62 3a 67 65 oop2 ((ts (db:ge
66a0: 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 t-test-info db r
66b0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
66c0: 69 74 65 6d 2d 70 61 74 68 29 29 20 3b 3b 20 23 item-path)) ;; #
66d0: 66 29 0a 09 09 09 09 28 63 74 20 30 29 29 0a 09 f).....(ct 0))..
66e0: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
66f0: 28 6e 6f 74 20 74 73 29 0a 09 09 09 20 20 20 20 (not ts)....
6700: 20 20 20 28 3c 20 63 74 20 31 30 29 29 0a 09 09 (< ct 10))...
6710: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 . (begin....
6720: 20 28 72 65 67 69 73 74 65 72 2d 74 65 73 74 20 (register-test
6730: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
6740: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 ame item-path)..
6750: 09 09 20 20 20 20 28 64 62 3a 74 65 73 74 2d 73 .. (db:test-s
6760: 65 74 2d 63 6f 6d 6d 65 6e 74 20 64 62 20 72 75 et-comment db ru
6770: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
6780: 74 65 6d 2d 70 61 74 68 20 22 22 29 0a 09 09 09 tem-path "")....
6790: 20 20 20 20 28 6c 6f 6f 70 32 20 28 64 62 3a 67 (loop2 (db:g
67a0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 et-test-info db
67b0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
67c0: 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 09 item-path).....
67d0: 20 20 20 28 2b 20 63 74 20 31 29 29 29 0a 09 09 (+ ct 1)))...
67e0: 09 20 20 28 69 66 20 74 73 0a 09 09 09 20 20 20 . (if ts....
67f0: 20 20 20 28 73 65 74 21 20 74 65 73 74 64 61 74 (set! testdat
6800: 20 74 73 29 0a 09 09 09 20 20 20 20 20 20 28 62 ts).... (b
6810: 65 67 69 6e 0a 09 09 09 09 28 64 65 62 75 67 3a egin.....(debug:
6820: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
6830: 3a 20 43 6f 75 6c 64 6e 27 74 20 72 65 67 69 73 : Couldn't regis
6840: 74 65 72 20 74 65 73 74 20 22 20 74 65 73 74 2d ter test " test-
6850: 6e 61 6d 65 20 22 20 77 69 74 68 20 69 74 65 6d name " with item
6860: 20 70 61 74 68 20 22 20 69 74 65 6d 2d 70 61 74 path " item-pat
6870: 68 20 22 2c 20 73 6b 69 70 70 69 6e 67 22 29 0a h ", skipping").
6880: 09 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 ....(if (not (nu
6890: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 09 20 20 ll? tal)).....
68a0: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
68b0: 29 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 )(cdr tal)))))))
68c0: 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ... (change-d
68d0: 69 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 irectory test-pa
68e0: 74 68 29 0a 09 09 20 20 20 20 3b 3b 20 74 68 69 th)... ;; thi
68f0: 73 20 62 6c 6f 63 6b 20 69 73 20 68 65 72 65 20 s block is here
6900: 6f 6e 6c 79 20 74 6f 20 69 6e 66 6f 72 6d 20 74 only to inform t
6910: 68 65 20 75 73 65 72 20 65 61 72 6c 79 20 6f 6e he user early on
6920: 0a 09 09 20 20 20 20 28 69 66 20 28 66 69 6c 65 ... (if (file
6930: 2d 65 78 69 73 74 73 3f 20 72 75 6e 63 6f 6e 66 -exists? runconf
6940: 69 67 66 29 0a 09 09 09 28 73 65 74 75 70 2d 65 igf)....(setup-e
6950: 6e 76 2d 64 65 66 61 75 6c 74 73 20 64 62 20 72 nv-defaults db r
6960: 75 6e 63 6f 6e 66 69 67 66 20 72 75 6e 2d 69 64 unconfigf run-id
6970: 20 2a 61 6c 72 65 61 64 79 2d 73 65 65 6e 2d 72 *already-seen-r
6980: 75 6e 63 6f 6e 66 69 67 2d 69 6e 66 6f 2a 29 0a unconfig-info*).
6990: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
69a0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 59 6f 75 20 0 "WARNING: You
69b0: 64 6f 20 6e 6f 74 20 68 61 76 65 20 61 20 72 75 do not have a ru
69c0: 6e 20 63 6f 6e 66 69 67 20 66 69 6c 65 3a 20 22 n config file: "
69d0: 20 72 75 6e 63 6f 6e 66 69 67 66 29 29 0a 09 09 runconfigf))...
69e0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
69f0: 20 34 20 22 72 75 6e 2d 69 64 3a 20 22 20 72 75 4 "run-id: " ru
6a00: 6e 2d 69 64 20 22 20 74 65 73 74 2d 6e 61 6d 65 n-id " test-name
6a10: 3a 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 : " test-name "
6a20: 69 74 65 6d 2d 70 61 74 68 3a 20 22 20 69 74 65 item-path: " ite
6a30: 6d 2d 70 61 74 68 20 22 20 74 65 73 74 64 61 74 m-path " testdat
6a40: 3a 20 22 20 28 74 65 73 74 3a 67 65 74 2d 73 74 : " (test:get-st
6a50: 61 74 75 73 20 74 65 73 74 64 61 74 29 20 22 20 atus testdat) "
6a60: 74 65 73 74 2d 73 74 61 74 65 3a 20 22 20 28 74 test-state: " (t
6a70: 65 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 est:get-state te
6a80: 73 74 64 61 74 29 29 0a 09 09 20 20 20 20 28 63 stdat))... (c
6a90: 61 73 65 20 28 69 66 20 28 61 72 67 73 3a 67 65 ase (if (args:ge
6aa0: 74 2d 61 72 67 20 22 2d 66 6f 72 63 65 22 29 0a t-arg "-force").
6ab0: 09 09 09 20 20 20 20 20 20 27 4e 4f 54 5f 53 54 ... 'NOT_ST
6ac0: 41 52 54 45 44 0a 09 09 09 20 20 20 20 20 20 28 ARTED.... (
6ad0: 69 66 20 74 65 73 74 64 61 74 0a 09 09 09 09 20 if testdat.....
6ae0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6af0: 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 65 (test:get-state
6b00: 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 20 testdat)).....
6b10: 20 27 66 61 69 6c 65 64 2d 74 6f 2d 69 6e 73 65 'failed-to-inse
6b20: 72 74 29 29 0a 09 09 20 20 20 20 20 20 28 28 66 rt))... ((f
6b30: 61 69 6c 65 64 2d 74 6f 2d 69 6e 73 65 72 74 29 ailed-to-insert)
6b40: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
6b50: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6b60: 20 46 61 69 6c 65 64 20 74 6f 20 69 6e 73 65 72 Failed to inser
6b70: 74 20 74 68 65 20 72 65 63 6f 72 64 20 69 6e 74 t the record int
6b80: 6f 20 74 68 65 20 64 62 22 29 29 0a 09 09 20 20 o the db"))...
6b90: 20 20 20 20 28 28 4e 4f 54 5f 53 54 41 52 54 45 ((NOT_STARTE
6ba0: 44 20 43 4f 4d 50 4c 45 54 45 44 29 0a 09 09 20 D COMPLETED)...
6bb0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
6bc0: 6e 74 20 36 20 22 47 6f 74 20 68 65 72 65 2c 20 nt 6 "Got here,
6bd0: 22 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 " (test:get-stat
6be0: 65 20 74 65 73 74 64 61 74 29 29 0a 09 09 20 20 e testdat))...
6bf0: 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 6e 66 (let ((runf
6c00: 6c 61 67 20 23 66 29 29 0a 09 09 09 20 28 63 6f lag #f)).... (co
6c10: 6e 64 0a 09 09 09 20 20 3b 3b 20 69 2e 65 2e 20 nd.... ;; i.e.
6c20: 74 68 69 73 20 69 73 20 74 68 65 20 70 61 72 65 this is the pare
6c30: 6e 74 20 74 65 73 74 20 74 6f 20 61 20 73 75 69 nt test to a sui
6c40: 74 65 20 6f 66 20 69 74 65 6d 73 2c 20 6e 65 76 te of items, nev
6c50: 65 72 20 22 72 75 6e 22 20 69 74 0a 09 09 09 20 er "run" it....
6c60: 20 28 70 61 72 65 6e 74 2d 74 65 73 74 0a 09 09 (parent-test...
6c70: 09 20 20 20 28 73 65 74 21 20 72 75 6e 66 6c 61 . (set! runfla
6c80: 67 20 23 66 29 29 0a 09 09 09 20 20 3b 3b 20 2d g #f)).... ;; -
6c90: 66 6f 72 63 65 2c 20 72 75 6e 20 6e 6f 20 6d 61 force, run no ma
6ca0: 74 74 65 72 20 77 68 61 74 0a 09 09 09 20 20 28 tter what.... (
6cb0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6cc0: 66 6f 72 63 65 22 29 28 73 65 74 21 20 72 75 6e force")(set! run
6cd0: 66 6c 61 67 20 23 74 29 29 0a 09 09 09 20 20 3b flag #t)).... ;
6ce0: 3b 20 4e 4f 54 5f 53 54 41 52 54 45 44 2c 20 72 ; NOT_STARTED, r
6cf0: 75 6e 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 un no matter wha
6d00: 74 0a 09 09 09 20 20 28 28 65 71 75 61 6c 3f 20 t.... ((equal?
6d10: 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 65 20 (test:get-state
6d20: 74 65 73 74 64 61 74 29 20 22 4e 4f 54 5f 53 54 testdat) "NOT_ST
6d30: 41 52 54 45 44 22 29 28 73 65 74 21 20 72 75 6e ARTED")(set! run
6d40: 66 6c 61 67 20 23 74 29 29 0a 09 09 09 20 20 3b flag #t)).... ;
6d50: 3b 20 6e 6f 74 20 2d 72 65 72 75 6e 20 61 6e 64 ; not -rerun and
6d60: 20 50 41 53 53 2c 20 57 41 52 4e 20 6f 72 20 43 PASS, WARN or C
6d70: 48 45 43 4b 2c 20 64 6f 20 6e 6f 20 72 75 6e 0a HECK, do no run.
6d80: 09 09 09 20 20 28 28 61 6e 64 20 28 6f 72 20 28 ... ((and (or (
6d90: 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 not (args:get-ar
6da0: 67 20 22 2d 72 65 72 75 6e 22 29 29 0a 09 09 09 g "-rerun"))....
6db0: 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 . (args:get-a
6dc0: 72 67 20 22 2d 6b 65 65 70 67 6f 69 6e 67 22 29 rg "-keepgoing")
6dd0: 29 0a 09 09 09 09 28 6d 65 6d 62 65 72 20 28 74 ).....(member (t
6de0: 65 73 74 3a 67 65 74 2d 73 74 61 74 75 73 20 74 est:get-status t
6df0: 65 73 74 64 61 74 29 20 27 28 22 50 41 53 53 22 estdat) '("PASS"
6e00: 20 22 57 41 52 4e 22 20 22 43 48 45 43 4b 22 29 "WARN" "CHECK")
6e10: 29 29 0a 09 09 09 20 20 20 28 73 65 74 21 20 72 )).... (set! r
6e20: 75 6e 66 6c 61 67 20 23 66 29 29 0a 09 09 09 20 unflag #f))....
6e30: 20 3b 3b 20 2d 72 65 72 75 6e 20 61 6e 64 20 73 ;; -rerun and s
6e40: 74 61 74 75 73 20 69 73 20 6f 6e 65 20 6f 66 20 tatus is one of
6e50: 74 68 65 20 73 70 65 63 69 66 65 64 2c 20 72 75 the specifed, ru
6e60: 6e 20 69 74 0a 09 09 09 20 20 28 28 61 6e 64 20 n it.... ((and
6e70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6e80: 72 65 72 75 6e 22 29 0a 09 09 09 09 28 6c 65 74 rerun").....(let
6e90: 20 28 28 72 65 72 75 6e 6c 73 74 20 28 73 74 72 ((rerunlst (str
6ea0: 69 6e 67 2d 73 70 6c 69 74 20 28 61 72 67 73 3a ing-split (args:
6eb0: 67 65 74 2d 61 72 67 20 22 2d 72 65 72 75 6e 22 get-arg "-rerun"
6ec0: 29 20 22 2c 22 29 29 29 20 3b 3b 20 46 41 49 4c ) ","))) ;; FAIL
6ed0: 2c 0a 09 09 09 09 20 20 28 6d 65 6d 62 65 72 20 ,..... (member
6ee0: 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 73 (test:get-status
6ef0: 20 74 65 73 74 64 61 74 29 20 72 65 72 75 6e 6c testdat) rerunl
6f00: 73 74 29 29 29 0a 09 09 09 20 20 20 28 73 65 74 st))).... (set
6f10: 21 20 72 75 6e 66 6c 61 67 20 23 74 29 29 0a 09 ! runflag #t))..
6f20: 09 09 20 20 3b 3b 20 2d 6b 65 65 70 67 6f 69 6e .. ;; -keepgoin
6f30: 67 2c 20 64 6f 20 6e 6f 74 20 72 65 72 75 6e 20 g, do not rerun
6f40: 46 41 49 4c 0a 09 09 09 20 20 28 28 61 6e 64 20 FAIL.... ((and
6f50: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6f60: 6b 65 65 70 67 6f 69 6e 67 22 29 0a 09 09 09 09 keepgoing").....
6f70: 28 6d 65 6d 62 65 72 20 28 74 65 73 74 3a 67 65 (member (test:ge
6f80: 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 t-status testdat
6f90: 29 20 27 28 22 46 41 49 4c 22 29 29 29 0a 09 09 ) '("FAIL")))...
6fa0: 09 20 20 20 28 73 65 74 21 20 72 75 6e 66 6c 61 . (set! runfla
6fb0: 67 20 23 66 29 29 0a 09 09 09 20 20 28 28 61 6e g #f)).... ((an
6fc0: 64 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 d (not (args:get
6fd0: 2d 61 72 67 20 22 2d 72 65 72 75 6e 22 29 29 0a -arg "-rerun")).
6fe0: 09 09 09 09 28 6d 65 6d 62 65 72 20 28 74 65 73 ....(member (tes
6ff0: 74 3a 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t:get-status tes
7000: 74 64 61 74 29 20 27 28 22 46 41 49 4c 22 20 22 tdat) '("FAIL" "
7010: 6e 2f 61 22 29 29 29 0a 09 09 09 20 20 20 28 73 n/a"))).... (s
7020: 65 74 21 20 72 75 6e 66 6c 61 67 20 23 74 29 29 et! runflag #t))
7030: 0a 09 09 09 20 20 28 65 6c 73 65 20 28 73 65 74 .... (else (set
7040: 21 20 72 75 6e 66 6c 61 67 20 23 66 29 29 29 0a ! runflag #f))).
7050: 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ... (debug:print
7060: 20 36 20 22 52 55 4e 4e 49 4e 47 20 3d 3e 20 72 6 "RUNNING => r
7070: 75 6e 66 6c 61 67 3a 20 22 20 72 75 6e 66 6c 61 unflag: " runfla
7080: 67 20 22 20 53 54 41 54 45 3a 20 22 20 28 74 65 g " STATE: " (te
7090: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 73 st:get-state tes
70a0: 74 64 61 74 29 20 22 20 53 54 41 54 55 53 3a 20 tdat) " STATUS:
70b0: 22 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 " (test:get-stat
70c0: 75 73 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 us testdat))....
70d0: 20 28 69 66 20 28 6e 6f 74 20 72 75 6e 66 6c 61 (if (not runfla
70e0: 67 29 0a 09 09 09 20 20 20 20 20 28 69 66 20 28 g).... (if (
70f0: 6e 6f 74 20 70 61 72 65 6e 74 2d 74 65 73 74 29 not parent-test)
7100: 0a 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 ..... (debug:pri
7110: 6e 74 20 31 20 22 4e 4f 54 45 3a 20 4e 6f 74 20 nt 1 "NOTE: Not
7120: 73 74 61 72 74 69 6e 67 20 74 65 73 74 20 22 20 starting test "
7130: 6e 65 77 2d 74 65 73 74 2d 6e 61 6d 65 20 22 20 new-test-name "
7140: 61 73 20 69 74 20 69 73 20 73 74 61 74 65 20 5c as it is state \
7150: 22 43 4f 4d 50 4c 45 54 45 44 5c 22 20 61 6e 64 "COMPLETED\" and
7160: 20 73 74 61 74 75 73 20 5c 22 22 20 28 74 65 73 status \"" (tes
7170: 74 3a 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t:get-status tes
7180: 74 64 61 74 29 20 22 5c 22 2c 20 75 73 65 20 2d tdat) "\", use -
7190: 66 6f 72 63 65 20 74 6f 20 6f 76 65 72 72 69 64 force to overrid
71a0: 65 22 29 29 0a 09 09 09 20 20 20 20 20 28 6c 65 e")).... (le
71b0: 74 2a 20 28 28 67 65 74 2d 70 72 65 72 65 71 73 t* ((get-prereqs
71c0: 2d 63 6d 64 20 28 6c 61 6d 62 64 61 20 28 29 0a -cmd (lambda ().
71d0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 62 ...... (db
71e0: 2d 67 65 74 2d 70 72 65 72 65 71 73 2d 6e 6f 74 -get-prereqs-not
71f0: 2d 6d 65 74 20 64 62 20 72 75 6e 2d 69 64 20 77 -met db run-id w
7200: 61 69 74 6f 6e 29 29 29 20 3b 3b 20 63 68 65 63 aiton))) ;; chec
7210: 6b 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 k before running
7220: 20 2e 2e 2e 2e 0a 09 09 09 09 20 20 20 20 28 6c ......... (l
7230: 61 75 6e 63 68 2d 63 6d 64 20 20 20 20 20 20 28 aunch-cmd (
7240: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 lambda ().......
7250: 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 (launch-t
7260: 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 74 65 est db run-id te
7270: 73 74 2d 63 6f 6e 66 20 6b 65 79 76 61 6c 6c 73 st-conf keyvalls
7280: 74 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 t test-name test
7290: 2d 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 29 -path itemdat)))
72a0: 0a 09 09 09 09 20 20 20 20 28 74 65 73 74 72 75 ..... (testru
72b0: 6e 64 61 74 20 20 20 20 20 20 28 6c 69 73 74 20 ndat (list
72c0: 67 65 74 2d 70 72 65 72 65 71 73 2d 63 6d 64 20 get-prereqs-cmd
72d0: 6c 61 75 6e 63 68 2d 63 6d 64 29 29 29 0a 09 09 launch-cmd)))...
72e0: 09 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 . (if (or
72f0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7300: 66 6f 72 63 65 22 29 0a 09 09 09 09 20 20 20 20 force").....
7310: 20 20 20 28 6c 65 74 20 28 28 70 72 65 71 73 2d (let ((preqs-
7320: 6e 6f 74 2d 79 65 74 2d 6d 65 74 20 28 28 63 61 not-yet-met ((ca
7330: 72 20 74 65 73 74 72 75 6e 64 61 74 29 29 29 29 r testrundat))))
7340: 0a 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 ...... (debug:pr
7350: 69 6e 74 20 32 20 22 50 72 65 71 72 65 71 75 65 int 2 "Preqreque
7360: 73 69 74 65 73 20 66 6f 72 20 22 20 74 65 73 74 sites for " test
7370: 2d 6e 61 6d 65 20 22 3a 20 22 20 70 72 65 71 73 -name ": " preqs
7380: 2d 6e 6f 74 2d 79 65 74 2d 6d 65 74 29 0a 09 09 -not-yet-met)...
7390: 09 09 09 20 28 6e 75 6c 6c 3f 20 70 72 65 71 73 ... (null? preqs
73a0: 2d 6e 6f 74 2d 79 65 74 2d 6d 65 74 29 29 29 20 -not-yet-met)))
73b0: 3b 3b 20 61 72 65 20 74 68 65 72 65 20 61 6e 79 ;; are there any
73c0: 20 74 65 73 74 73 20 74 68 61 74 20 6d 75 73 74 tests that must
73d0: 20 62 65 20 72 75 6e 20 62 65 66 6f 72 65 20 74 be run before t
73e0: 68 69 73 20 6f 6e 65 2e 2e 2e 0a 09 09 09 09 20 his one........
73f0: 20 20 28 69 66 20 28 6e 6f 74 20 28 28 63 61 64 (if (not ((cad
7400: 72 20 74 65 73 74 72 75 6e 64 61 74 29 29 29 20 r testrundat)))
7410: 3b 3b 20 74 68 69 73 20 69 73 20 74 68 65 20 6c ;; this is the l
7420: 69 6e 65 20 74 68 61 74 20 6c 61 75 6e 63 68 65 ine that launche
7430: 73 20 74 68 65 20 74 65 73 74 20 74 6f 20 74 68 s the test to th
7440: 65 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 09 09 e remote host...
7450: 09 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a .. (begin.
7460: 09 09 09 09 09 20 28 70 72 69 6e 74 20 22 45 52 ..... (print "ER
7470: 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 6c ROR: Failed to l
7480: 61 75 6e 63 68 20 74 68 65 20 74 65 73 74 2e 20 aunch the test.
7490: 45 78 69 74 69 6e 67 20 61 73 20 73 6f 6f 6e 20 Exiting as soon
74a0: 61 73 20 70 6f 73 73 69 62 6c 65 22 29 0a 09 09 as possible")...
74b0: 09 09 09 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 ... (set! *globa
74c0: 6c 65 78 69 74 73 74 61 74 75 73 2a 20 31 29 20 lexitstatus* 1)
74d0: 3b 3b 20 0a 09 09 09 09 09 20 28 70 72 6f 63 65 ;; ...... (proce
74e0: 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 72 72 65 ss-signal (curre
74f0: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 73 nt-process-id) s
7500: 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 09 09 09 ignal/kill).....
7510: 09 20 3b 28 65 78 69 74 20 31 29 0a 09 09 09 09 . ;(exit 1).....
7520: 09 20 29 29 0a 09 09 09 09 20 20 20 28 69 66 20 . ))..... (if
7530: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
7540: 72 67 20 22 2d 6b 65 65 70 67 6f 69 6e 67 22 29 rg "-keepgoing")
7550: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 68 61 )..... (ha
7560: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 77 sh-table-set! *w
7570: 61 69 74 69 6e 67 2d 71 75 65 75 65 2a 20 6e 65 aiting-queue* ne
7580: 77 2d 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 w-test-name test
7590: 72 75 6e 64 61 74 29 29 29 29 29 29 29 0a 09 09 rundat)))))))...
75a0: 20 20 20 20 20 20 28 28 4b 49 4c 4c 45 44 29 20 ((KILLED)
75b0: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
75c0: 3a 70 72 69 6e 74 20 31 20 22 4e 4f 54 45 3a 20 :print 1 "NOTE:
75d0: 22 20 6e 65 77 2d 74 65 73 74 2d 6e 61 6d 65 20 " new-test-name
75e0: 22 20 69 73 20 61 6c 72 65 61 64 79 20 72 75 6e " is already run
75f0: 6e 69 6e 67 20 6f 72 20 77 61 73 20 65 78 70 6c ning or was expl
7600: 69 63 74 6c 79 20 6b 69 6c 6c 65 64 2c 20 75 73 ictly killed, us
7610: 65 20 2d 66 6f 72 63 65 20 74 6f 20 6c 61 75 6e e -force to laun
7620: 63 68 20 69 74 2e 22 29 29 0a 09 09 20 20 20 20 ch it."))...
7630: 20 20 28 28 4c 41 55 4e 43 48 45 44 20 52 45 4d ((LAUNCHED REM
7640: 4f 54 45 48 4f 53 54 53 54 41 52 54 20 52 55 4e OTEHOSTSTART RUN
7650: 4e 49 4e 47 29 20 20 0a 09 09 20 20 20 20 20 20 NING) ...
7660: 20 28 69 66 20 28 3e 20 28 2d 20 28 63 75 72 72 (if (> (- (curr
7670: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 28 2b 20 28 ent-seconds)(+ (
7680: 64 62 3a 74 65 73 74 2d 67 65 74 2d 65 76 65 6e db:test-get-even
7690: 74 5f 74 69 6d 65 20 74 65 73 74 64 61 74 29 0a t_time testdat).
76a0: 09 09 09 09 09 09 20 20 20 20 20 28 64 62 3a 74 ...... (db:t
76b0: 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 61 est-get-run_dura
76c0: 74 69 6f 6e 20 74 65 73 74 64 61 74 29 29 29 0a tion testdat))).
76d0: 09 09 09 20 20 20 20 20 20 31 30 30 29 20 3b 3b ... 100) ;;
76e0: 20 69 2e 65 2e 20 6e 6f 20 75 70 64 61 74 65 20 i.e. no update
76f0: 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 31 30 for more than 10
7700: 30 20 73 65 63 6f 6e 64 73 0a 09 09 09 20 20 20 0 seconds....
7710: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 28 (begin.... (
7720: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
7730: 41 52 4e 49 4e 47 3a 20 54 65 73 74 20 22 20 74 ARNING: Test " t
7740: 65 73 74 2d 6e 61 6d 65 20 22 20 61 70 70 65 61 est-name " appea
7750: 72 73 20 74 6f 20 62 65 20 64 65 61 64 2e 20 46 rs to be dead. F
7760: 6f 72 63 69 6e 67 20 69 74 20 74 6f 20 73 74 61 orcing it to sta
7770: 74 65 20 49 4e 43 4f 4d 50 4c 45 54 45 20 61 6e te INCOMPLETE an
7780: 64 20 73 74 61 74 75 73 20 53 54 55 43 4b 2f 44 d status STUCK/D
7790: 45 41 44 22 29 0a 09 09 09 20 20 20 20 20 28 74 EAD").... (t
77a0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
77b0: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
77c0: 61 6d 65 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 ame "INCOMPLETE"
77d0: 20 22 53 54 55 43 4b 2f 44 45 41 44 22 20 69 74 "STUCK/DEAD" it
77e0: 65 6d 64 61 74 20 22 54 65 73 74 20 69 73 20 73 emdat "Test is s
77f0: 74 75 63 6b 20 6f 72 20 64 65 61 64 22 20 23 66 tuck or dead" #f
7800: 29 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 3a )).... (debug:
7810: 70 72 69 6e 74 20 32 20 22 4e 4f 54 45 3a 20 22 print 2 "NOTE: "
7820: 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 69 73 20 test-name " is
7830: 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 22 already running"
7840: 29 29 29 0a 09 09 20 20 20 20 20 20 28 65 6c 73 )))... (els
7850: 65 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 e (debug:p
7860: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 46 rint 0 "ERROR: F
7870: 61 69 6c 65 64 20 74 6f 20 6c 61 75 6e 63 68 20 ailed to launch
7880: 74 65 73 74 20 22 20 6e 65 77 2d 74 65 73 74 2d test " new-test-
7890: 6e 61 6d 65 20 22 2e 20 55 6e 72 65 63 6f 67 6e name ". Unrecogn
78a0: 69 73 65 64 20 73 74 61 74 65 20 22 20 28 74 65 ised state " (te
78b0: 73 74 3a 67 65 74 2d 73 74 61 74 65 20 74 65 73 st:get-state tes
78c0: 74 64 61 74 29 29 29 29 29 29 0a 09 20 20 20 20 tdat))))))..
78d0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
78e0: 3f 20 74 61 6c 29 29 0a 09 09 20 20 28 6c 6f 6f ? tal))... (loo
78f0: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
7900: 74 61 6c 29 29 29 29 29 29 29 29 29 0a 0a 28 64 tal)))))))))..(d
7910: 65 66 69 6e 65 20 28 72 75 6e 2d 77 61 69 74 69 efine (run-waiti
7920: 6e 67 2d 74 65 73 74 73 20 64 62 29 0a 20 20 28 ng-tests db). (
7930: 6c 65 74 20 28 28 6e 75 6d 74 72 69 65 73 20 20 let ((numtries
7940: 20 20 20 20 20 20 20 20 20 30 29 0a 09 28 6c 61 0)..(la
7950: 73 74 2d 74 72 79 2d 74 69 6d 65 20 20 20 20 20 st-try-time
7960: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
7970: 73 29 29 0a 09 28 74 69 6d 65 73 20 20 20 20 20 s))..(times
7980: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 31 (list 1
7990: 29 29 29 20 3b 3b 20 6d 69 6e 75 74 65 73 20 74 ))) ;; minutes t
79a0: 6f 20 77 61 69 74 20 62 65 66 6f 72 65 20 74 72 o wait before tr
79b0: 79 69 6e 67 20 61 67 61 69 6e 20 74 6f 20 6b 69 ying again to ki
79c0: 63 6b 20 6f 66 66 20 72 75 6e 73 0a 20 20 20 20 ck off runs.
79d0: 3b 3b 20 42 55 47 20 74 68 69 73 20 68 61 63 6b ;; BUG this hack
79e0: 20 6f 66 20 62 72 75 74 65 20 66 6f 72 63 65 20 of brute force
79f0: 72 65 74 72 79 69 6e 67 20 77 6f 72 6b 73 20 71 retrying works q
7a00: 75 69 74 65 20 77 65 6c 6c 20 66 6f 72 20 6d 61 uite well for ma
7a10: 6e 79 20 63 61 73 65 73 20 62 75 74 20 0a 20 20 ny cases but .
7a20: 20 20 3b 3b 20 20 20 20 20 77 68 61 74 20 69 73 ;; what is
7a30: 20 6e 65 65 64 65 64 20 69 73 20 74 6f 20 63 68 needed is to ch
7a40: 65 63 6b 20 74 68 65 20 64 62 20 66 6f 72 20 74 eck the db for t
7a50: 65 73 74 73 20 74 68 61 74 20 68 61 76 65 20 66 ests that have f
7a60: 61 69 6c 65 64 20 6c 65 73 73 20 74 68 61 6e 0a ailed less than.
7a70: 20 20 20 20 3b 3b 20 20 20 20 20 4e 20 74 69 6d ;; N tim
7a80: 65 73 20 6f 72 20 6e 65 76 65 72 20 62 65 65 6e es or never been
7a90: 20 73 74 61 72 74 65 64 20 61 6e 64 20 6b 69 63 started and kic
7aa0: 6b 20 74 68 65 6d 20 6f 66 66 20 61 67 61 69 6e k them off again
7ab0: 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
7ac0: 28 77 61 69 74 69 6e 67 2d 74 65 73 74 2d 6e 61 (waiting-test-na
7ad0: 6d 65 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d mes (hash-table-
7ae0: 6b 65 79 73 20 2a 77 61 69 74 69 6e 67 2d 71 75 keys *waiting-qu
7af0: 65 75 65 2a 29 29 29 0a 20 20 20 20 20 20 28 63 eue*))). (c
7b00: 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 6e 6f 74 ond. ((not
7b10: 20 28 72 75 6e 73 3a 63 61 6e 2d 72 75 6e 2d 6d (runs:can-run-m
7b20: 6f 72 65 2d 74 65 73 74 73 20 64 62 29 29 0a 09 ore-tests db))..
7b30: 28 73 6c 65 65 70 20 32 29 0a 09 28 6c 6f 6f 70 (sleep 2)..(loop
7b40: 20 77 61 69 74 69 6e 67 2d 74 65 73 74 2d 6e 61 waiting-test-na
7b50: 6d 65 73 29 29 0a 20 20 20 20 20 20 20 28 28 6e mes)). ((n
7b60: 75 6c 6c 3f 20 77 61 69 74 69 6e 67 2d 74 65 73 ull? waiting-tes
7b70: 74 2d 6e 61 6d 65 73 29 0a 09 28 64 65 62 75 67 t-names)..(debug
7b80: 3a 70 72 69 6e 74 20 31 20 22 41 6c 6c 20 74 65 :print 1 "All te
7b90: 73 74 73 20 6c 61 75 6e 63 68 65 64 22 29 29 0a sts launched")).
7ba0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 73 (else..(s
7bb0: 65 74 21 20 6e 75 6d 74 72 69 65 73 20 28 2b 20 et! numtries (+
7bc0: 6e 75 6d 74 72 69 65 73 20 31 29 29 0a 09 28 66 numtries 1))..(f
7bd0: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
7be0: 28 74 65 73 74 6e 61 6d 65 29 0a 09 09 20 20 20 (testname)...
7bf0: 20 28 69 66 20 28 72 75 6e 73 3a 63 61 6e 2d 72 (if (runs:can-r
7c00: 75 6e 2d 6d 6f 72 65 2d 74 65 73 74 73 20 64 62 un-more-tests db
7c10: 29 0a 09 09 09 28 6c 65 74 2a 20 28 28 74 65 73 )....(let* ((tes
7c20: 74 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 tdat (hash-table
7c30: 2d 72 65 66 20 2a 77 61 69 74 69 6e 67 2d 71 75 -ref *waiting-qu
7c40: 65 75 65 2a 20 74 65 73 74 6e 61 6d 65 29 29 0a eue* testname)).
7c50: 09 09 09 20 20 20 20 20 20 20 28 70 72 65 72 65 ... (prere
7c60: 71 73 20 28 28 63 61 72 20 74 65 73 74 64 61 74 qs ((car testdat
7c70: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 6c ))).... (l
7c80: 64 62 20 20 20 20 20 28 69 66 20 64 62 20 64 62 db (if db db
7c90: 20 28 6f 70 65 6e 2d 64 62 29 29 29 29 0a 09 09 (open-db))))...
7ca0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
7cb0: 32 20 22 70 72 65 72 65 71 73 20 72 65 6d 61 69 2 "prereqs remai
7cc0: 6e 69 6e 67 3a 20 22 20 70 72 65 72 65 71 73 29 ning: " prereqs)
7cd0: 0a 09 09 09 20 20 28 69 66 20 28 6e 75 6c 6c 3f .... (if (null?
7ce0: 20 70 72 65 72 65 71 73 29 0a 09 09 09 20 20 20 prereqs)....
7cf0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 28 64 (begin.....(d
7d00: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 50 72 ebug:print 2 "Pr
7d10: 65 72 65 71 75 69 73 69 74 65 73 20 6d 65 74 2c erequisites met,
7d20: 20 6c 61 75 6e 63 68 69 6e 67 20 22 20 74 65 73 launching " tes
7d30: 74 6e 61 6d 65 29 0a 09 09 09 09 28 28 63 61 64 tname).....((cad
7d40: 72 20 74 65 73 74 64 61 74 29 29 0a 09 09 09 09 r testdat)).....
7d50: 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c 65 (hash-table-dele
7d60: 74 65 21 20 2a 77 61 69 74 69 6e 67 2d 71 75 65 te! *waiting-que
7d70: 75 65 2a 20 74 65 73 74 6e 61 6d 65 29 29 29 0a ue* testname))).
7d80: 09 09 09 20 20 28 69 66 20 28 6e 6f 74 20 64 62 ... (if (not db
7d90: 29 0a 09 09 09 20 20 20 20 20 20 28 73 71 6c 69 ).... (sqli
7da0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 6c 64 te3:finalize! ld
7db0: 62 29 29 29 29 29 0a 09 09 20 20 77 61 69 74 69 b)))))... waiti
7dc0: 6e 67 2d 74 65 73 74 2d 6e 61 6d 65 73 29 0a 09 ng-test-names)..
7dd0: 3b 3b 20 28 73 6c 65 65 70 20 31 30 29 20 3b 3b ;; (sleep 10) ;;
7de0: 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 72 75 73 no point in rus
7df0: 68 69 6e 67 20 74 68 69 6e 67 73 20 61 74 20 74 hing things at t
7e00: 68 69 73 20 73 74 61 67 65 3f 0a 09 28 6c 6f 6f his stage?..(loo
7e10: 70 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 p (hash-table-ke
7e20: 79 73 20 2a 77 61 69 74 69 6e 67 2d 71 75 65 75 ys *waiting-queu
7e30: 65 2a 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 e*)))))))..(defi
7e40: 6e 65 20 28 67 65 74 2d 64 69 72 2d 75 70 2d 6e ne (get-dir-up-n
7e50: 20 64 69 72 20 2e 20 70 61 72 61 6d 73 29 20 0a dir . params) .
7e60: 20 20 28 6c 65 74 20 28 28 64 70 61 72 74 73 20 (let ((dparts
7e70: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 64 (string-split d
7e80: 69 72 20 22 2f 22 29 29 0a 09 28 63 6f 75 6e 74 ir "/"))..(count
7e90: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 (if (null? pa
7ea0: 72 61 6d 73 29 20 31 20 28 63 61 72 20 70 61 72 rams) 1 (car par
7eb0: 61 6d 73 29 29 29 29 0a 20 20 20 20 28 63 6f 6e ams)))). (con
7ec0: 63 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e c "/" (string-in
7ed0: 74 65 72 73 70 65 72 73 65 20 0a 09 20 20 20 20 tersperse ..
7ee0: 20 20 20 28 74 61 6b 65 20 64 70 61 72 74 73 20 (take dparts
7ef0: 28 2d 20 28 6c 65 6e 67 74 68 20 64 70 61 72 74 (- (length dpart
7f00: 73 29 20 63 6f 75 6e 74 29 29 0a 09 20 20 20 20 s) count))..
7f10: 20 20 20 22 2f 22 29 29 29 29 0a 3b 3b 20 52 65 "/")))).;; Re
7f20: 6d 6f 76 65 20 72 75 6e 73 0a 3b 3b 20 66 69 65 move runs.;; fie
7f30: 6c 64 73 20 61 72 65 20 70 61 73 73 69 6e 67 20 lds are passing
7f40: 69 6e 20 74 68 72 6f 75 67 68 20 0a 28 64 65 66 in through .(def
7f50: 69 6e 65 20 28 72 75 6e 73 3a 72 65 6d 6f 76 65 ine (runs:remove
7f60: 2d 72 75 6e 73 20 64 62 20 72 75 6e 6e 61 6d 65 -runs db runname
7f70: 70 61 74 74 20 74 65 73 74 70 61 74 74 20 69 74 patt testpatt it
7f80: 65 6d 70 61 74 74 29 0a 20 20 28 6c 65 74 2a 20 empatt). (let*
7f90: 28 28 6b 65 79 73 20 20 20 20 20 20 20 20 28 64 ((keys (d
7fa0: 62 2d 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a b-get-keys db)).
7fb0: 09 20 28 72 75 6e 64 61 74 20 20 20 20 20 20 28 . (rundat (
7fc0: 72 75 6e 73 3a 67 65 74 2d 72 75 6e 73 2d 62 79 runs:get-runs-by
7fd0: 2d 70 61 74 74 20 64 62 20 6b 65 79 73 20 72 75 -patt db keys ru
7fe0: 6e 6e 61 6d 65 70 61 74 74 29 29 0a 09 20 28 68 nnamepatt)).. (h
7ff0: 65 61 64 65 72 20 20 20 20 20 20 28 76 65 63 74 eader (vect
8000: 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 30 29 or-ref rundat 0)
8010: 29 0a 09 20 28 72 75 6e 73 20 20 20 20 20 20 20 ).. (runs
8020: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
8030: 64 61 74 20 31 29 29 29 0a 20 20 20 20 28 64 65 dat 1))). (de
8040: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 48 65 61 bug:print 1 "Hea
8050: 64 65 72 3a 20 22 20 68 65 61 64 65 72 29 0a 20 der: " header).
8060: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
8070: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a (lambda (run).
8080: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 (let ((ru
8090: 6e 6b 65 79 20 28 73 74 72 69 6e 67 2d 69 6e 74 nkey (string-int
80a0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
80b0: 61 6d 62 64 61 20 28 6b 29 0a 09 09 09 09 09 09 ambda (k).......
80c0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
80d0: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
80e0: 65 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b er (vector-ref k
80f0: 20 30 29 29 29 20 6b 65 79 73 29 20 22 2f 22 29 0))) keys) "/")
8100: 29 0a 09 20 20 20 20 20 28 64 69 72 73 2d 74 6f ).. (dirs-to
8110: 2d 72 65 6d 6f 76 65 20 28 6d 61 6b 65 2d 68 61 -remove (make-ha
8120: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 28 6c sh-table))).. (l
8130: 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 28 64 62 et* ((run-id (db
8140: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
8150: 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 ader run header
8160: 22 69 64 22 29 20 29 0a 09 09 28 74 65 73 74 73 "id") )...(tests
8170: 20 20 28 64 62 2d 67 65 74 2d 74 65 73 74 73 2d (db-get-tests-
8180: 66 6f 72 2d 72 75 6e 20 64 62 20 28 64 62 3a 67 for-run db (db:g
8190: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
81a0: 65 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 er run header "i
81b0: 64 22 29 20 74 65 73 74 70 61 74 74 20 69 74 65 d") testpatt ite
81c0: 6d 70 61 74 74 29 29 0a 09 09 28 6c 61 73 74 74 mpatt))...(lastt
81d0: 70 61 74 68 20 22 2f 64 6f 65 73 2f 6e 6f 74 2f path "/does/not/
81e0: 65 78 69 73 74 2f 49 2f 68 6f 70 65 22 29 29 0a exist/I/hope")).
81f0: 0a 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e .. (if (not (n
8200: 75 6c 6c 3f 20 74 65 73 74 73 29 29 0a 09 20 20 ull? tests))..
8210: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 28 (begin... (
8220: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 52 debug:print 1 "R
8230: 65 6d 6f 76 69 6e 67 20 74 65 73 74 73 20 66 6f emoving tests fo
8240: 72 20 72 75 6e 3a 20 22 20 72 75 6e 6b 65 79 20 r run: " runkey
8250: 22 20 22 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 " " (db:get-valu
8260: 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 e-by-header run
8270: 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d 65 22 header "runname"
8280: 29 29 0a 09 09 20 28 66 6f 72 2d 65 61 63 68 0a ))... (for-each.
8290: 09 09 20 20 28 6c 61 6d 62 64 61 20 28 74 65 73 .. (lambda (tes
82a0: 74 29 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 t)... (let* (
82b0: 28 69 74 65 6d 2d 70 61 74 68 20 28 64 62 3a 74 (item-path (db:t
82c0: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
82d0: 68 20 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 h test)).... (
82e0: 74 65 73 74 2d 6e 61 6d 65 20 28 64 62 3a 74 65 test-name (db:te
82f0: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
8300: 74 65 73 74 29 29 0a 09 09 09 20 20 20 28 72 75 test)).... (ru
8310: 6e 2d 64 69 72 20 20 20 28 64 62 3a 74 65 73 74 n-dir (db:test
8320: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
8330: 29 29 29 0a 09 09 20 20 20 20 20 20 28 64 65 62 )))... (deb
8340: 75 67 3a 70 72 69 6e 74 20 31 20 22 20 20 22 20 ug:print 1 " "
8350: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
8360: 74 6e 61 6d 65 20 74 65 73 74 29 20 22 20 69 64 tname test) " id
8370: 3a 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 : " (db:test-get
8380: 2d 69 64 20 74 65 73 74 29 20 22 20 22 20 69 74 -id test) " " it
8390: 65 6d 2d 70 61 74 68 29 0a 09 09 20 20 20 20 20 em-path)...
83a0: 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 (db:delete-test
83b0: 2d 72 65 63 6f 72 64 73 20 64 62 20 28 64 62 3a -records db (db:
83c0: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
83d0: 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 ))... (if (
83e0: 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 > (string-length
83f0: 20 72 75 6e 2d 64 69 72 29 20 35 29 20 3b 3b 20 run-dir) 5) ;;
8400: 62 61 64 20 68 65 75 72 69 73 74 69 63 20 62 75 bad heuristic bu
8410: 74 20 73 68 6f 75 6c 64 20 70 72 65 76 65 6e 74 t should prevent
8420: 20 2f 74 6d 70 20 2f 68 6f 6d 65 20 65 74 63 2e /tmp /home etc.
8430: 0a 09 09 09 20 20 28 6c 65 74 20 28 28 66 75 6c .... (let ((ful
8440: 6c 70 61 74 68 20 72 75 6e 2d 64 69 72 29 29 20 lpath run-dir))
8450: 3b 3b 20 22 2f 22 20 28 64 62 3a 74 65 73 74 2d ;; "/" (db:test-
8460: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te
8470: 73 74 29 29 29 29 0a 09 09 09 20 20 20 20 28 73 st)))).... (s
8480: 65 74 21 20 6c 61 73 74 74 70 61 74 68 20 66 75 et! lasttpath fu
8490: 6c 6c 70 61 74 68 29 0a 09 09 09 20 20 20 20 28 llpath).... (
84a0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
84b0: 64 69 72 73 2d 74 6f 2d 72 65 6d 6f 76 65 20 66 dirs-to-remove f
84c0: 75 6c 6c 70 61 74 68 20 23 74 29 0a 09 09 09 20 ullpath #t)....
84d0: 20 20 20 3b 3b 20 54 68 65 20 66 6f 6c 6c 6f 77 ;; The follow
84e0: 69 6e 67 20 77 61 73 20 74 68 65 20 73 61 66 65 ing was the safe
84f0: 20 64 65 6c 65 74 65 20 63 6f 64 65 20 62 75 74 delete code but
8500: 20 69 74 20 77 61 73 20 6e 6f 74 20 62 65 69 6e it was not bein
8510: 67 20 65 78 65 63 74 75 74 65 64 2e 0a 09 09 09 g exectuted.....
8520: 20 20 20 20 3b 3b 20 28 6c 65 74 2a 20 28 28 64 ;; (let* ((d
8530: 69 72 73 2d 63 6f 75 6e 74 20 28 2b 20 31 20 28 irs-count (+ 1 (
8540: 6c 65 6e 67 74 68 20 6b 65 79 73 29 28 6c 65 6e length keys)(len
8550: 67 74 68 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 gth (string-spli
8560: 74 20 69 74 65 6d 2d 70 61 74 68 20 22 2f 22 29 t item-path "/")
8570: 29 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 20 20 ))).... ;;
8580: 20 20 20 20 20 28 64 69 72 2d 74 6f 2d 72 65 6d (dir-to-rem
8590: 20 28 67 65 74 2d 64 69 72 2d 75 70 2d 6e 20 66 (get-dir-up-n f
85a0: 75 6c 6c 70 61 74 68 20 64 69 72 73 2d 63 6f 75 ullpath dirs-cou
85b0: 6e 74 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 20 nt)).... ;;
85c0: 20 20 20 20 20 20 28 72 65 6d 61 69 6e 69 6e 67 (remaining
85d0: 64 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 d (string-substi
85e0: 74 75 74 65 20 28 72 65 67 65 78 70 20 28 63 6f tute (regexp (co
85f0: 6e 63 20 22 5e 22 20 64 69 72 2d 74 6f 2d 72 65 nc "^" dir-to-re
8600: 6d 20 22 2f 22 29 29 20 22 22 20 66 75 6c 6c 70 m "/")) "" fullp
8610: 61 74 68 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 ath)).... ;;
8620: 20 20 20 20 20 20 20 28 63 6d 64 20 28 63 6f 6e (cmd (con
8630: 63 20 22 63 64 20 22 20 64 69 72 2d 74 6f 2d 72 c "cd " dir-to-r
8640: 65 6d 20 22 3b 20 72 6d 64 69 72 20 2d 70 20 22 em "; rmdir -p "
8650: 20 72 65 6d 61 69 6e 69 6e 67 64 20 29 29 29 0a remainingd ))).
8660: 09 09 09 20 20 20 20 3b 3b 20 20 20 28 69 66 20 ... ;; (if
8670: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 (file-exists? fu
8680: 6c 6c 70 61 74 68 29 0a 09 09 09 20 20 20 20 3b llpath).... ;
8690: 3b 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ; (begin..
86a0: 09 09 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 .. ;;
86b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
86c0: 63 6d 64 29 0a 09 09 09 20 20 20 20 3b 3b 20 20 cmd).... ;;
86d0: 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 63 (system c
86e0: 6d 64 29 29 29 0a 09 09 09 20 20 20 20 3b 3b 20 md))).... ;;
86f0: 20 20 29 29 0a 09 09 09 20 20 20 20 29 29 29 29 )).... ))))
8700: 0a 09 09 20 20 20 20 74 65 73 74 73 29 29 29 0a ... tests))).
8710: 0a 09 20 20 20 3b 3b 20 6c 6f 6f 6b 20 74 68 6f .. ;; look tho
8720: 75 67 68 20 74 68 65 20 64 69 72 73 2d 74 6f 2d ugh the dirs-to-
8730: 72 65 6d 6f 76 65 20 66 6f 72 20 63 61 6e 64 69 remove for candi
8740: 64 61 74 65 73 20 66 6f 72 20 72 65 6d 6f 76 61 dates for remova
8750: 6c 2e 20 44 6f 20 74 68 69 73 20 61 66 74 65 72 l. Do this after
8760: 20 64 65 6c 65 74 69 6e 67 20 74 68 65 20 72 65 deleting the re
8770: 63 6f 72 64 73 0a 09 20 20 20 3b 3b 20 66 6f 72 cords.. ;; for
8780: 20 65 61 63 68 20 74 65 73 74 20 69 6e 20 63 61 each test in ca
8790: 73 65 20 77 65 20 67 65 74 20 6b 69 6c 6c 65 64 se we get killed
87a0: 2e 20 54 68 61 74 20 73 68 6f 75 6c 64 20 6d 69 . That should mi
87b0: 6e 69 6d 69 7a 65 20 74 68 65 20 64 65 74 72 69 nimize the detri
87c0: 74 75 73 20 6c 65 66 74 20 6f 6e 20 64 69 73 6b tus left on disk
87d0: 0a 09 20 20 20 3b 3b 20 70 72 6f 63 65 73 73 20 .. ;; process
87e0: 74 68 65 20 64 69 72 73 20 66 72 6f 6d 20 6c 6f the dirs from lo
87f0: 6e 67 65 73 74 20 73 74 72 69 6e 67 20 6c 65 6e ngest string len
8800: 67 74 68 20 74 6f 20 73 68 6f 72 74 65 73 74 0a gth to shortest.
8810: 09 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 . (for-each ..
8820: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 69 72 (lambda (dir
8830: 2d 74 6f 2d 72 65 6d 6f 76 65 29 0a 09 20 20 20 -to-remove)..
8840: 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 (if (file-exi
8850: 73 74 73 3f 20 64 69 72 2d 74 6f 2d 72 65 6d 6f sts? dir-to-remo
8860: 76 65 29 0a 09 09 20 20 28 6c 65 74 20 28 28 64 ve)... (let ((d
8870: 69 72 2d 69 6e 2d 64 62 20 27 28 29 29 29 0a 09 ir-in-db '()))..
8880: 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 6f . (sqlite3:fo
8890: 72 2d 65 61 63 68 2d 72 6f 77 0a 09 09 20 20 20 r-each-row...
88a0: 20 20 28 6c 61 6d 62 64 61 20 28 64 69 72 29 0a (lambda (dir).
88b0: 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 64 .. (set! d
88c0: 69 72 2d 69 6e 2d 64 62 20 28 63 6f 6e 73 20 64 ir-in-db (cons d
88d0: 69 72 20 64 69 72 2d 69 6e 2d 64 62 29 29 29 0a ir dir-in-db))).
88e0: 09 09 20 20 20 20 20 64 62 20 22 53 45 4c 45 43 .. db "SELEC
88f0: 54 20 72 75 6e 64 69 72 20 46 52 4f 4d 20 74 65 T rundir FROM te
8900: 73 74 73 20 57 48 45 52 45 20 72 75 6e 64 69 72 sts WHERE rundir
8910: 20 4c 49 4b 45 20 3f 3b 22 20 0a 09 09 20 20 20 LIKE ?;" ...
8920: 20 20 28 63 6f 6e 63 20 22 25 22 20 64 69 72 2d (conc "%" dir-
8930: 74 6f 2d 72 65 6d 6f 76 65 20 22 25 22 29 29 20 to-remove "%"))
8940: 3b 3b 20 79 65 73 2c 20 49 27 6d 20 67 6f 69 6e ;; yes, I'm goin
8950: 67 20 74 6f 20 62 61 69 6c 20 69 66 20 74 68 65 g to bail if the
8960: 72 65 20 69 73 20 61 6e 79 74 68 69 6e 67 20 6c re is anything l
8970: 69 6b 65 20 74 68 69 73 20 64 69 72 20 69 6e 20 ike this dir in
8980: 74 68 65 20 64 62 0a 09 09 20 20 20 20 28 69 66 the db... (if
8990: 20 28 6e 75 6c 6c 3f 20 64 69 72 2d 69 6e 2d 64 (null? dir-in-d
89a0: 62 29 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 b)....(begin....
89b0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
89c0: 20 22 52 65 6d 6f 76 69 6e 67 20 64 69 72 65 63 "Removing direc
89d0: 74 6f 72 79 20 77 69 74 68 20 7a 65 72 6f 20 64 tory with zero d
89e0: 62 20 72 65 66 65 72 65 6e 63 65 73 3a 20 22 20 b references: "
89f0: 64 69 72 2d 74 6f 2d 72 65 6d 6f 76 65 29 0a 09 dir-to-remove)..
8a00: 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e .. (system (con
8a10: 63 20 22 72 6d 20 2d 72 66 20 22 20 64 69 72 2d c "rm -rf " dir-
8a20: 74 6f 2d 72 65 6d 6f 76 65 29 29 0a 09 09 09 20 to-remove))....
8a30: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 64 65 6c (hash-table-del
8a40: 65 74 65 21 20 64 69 72 73 2d 74 6f 2d 72 65 6d ete! dirs-to-rem
8a50: 6f 76 65 20 64 69 72 2d 74 6f 2d 72 65 6d 6f 76 ove dir-to-remov
8a60: 65 29 29 0a 09 09 09 28 64 65 62 75 67 3a 70 72 e))....(debug:pr
8a70: 69 6e 74 20 32 20 22 53 6b 69 70 70 69 6e 67 20 int 2 "Skipping
8a80: 72 65 6d 6f 76 61 6c 20 6f 66 20 22 20 64 69 72 removal of " dir
8a90: 2d 74 6f 2d 72 65 6d 6f 76 65 20 22 20 66 6f 72 -to-remove " for
8aa0: 20 6e 6f 77 20 61 73 20 69 74 20 73 74 69 6c 6c now as it still
8ab0: 20 68 61 73 20 72 65 66 65 72 65 6e 63 65 73 20 has references
8ac0: 69 6e 20 74 68 65 20 64 61 74 61 62 61 73 65 22 in the database"
8ad0: 29 29 29 29 29 0a 09 20 20 20 20 28 73 6f 72 74 ))))).. (sort
8ae0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 6b 65 79 (hash-table-key
8af0: 73 20 64 69 72 73 2d 74 6f 2d 72 65 6d 6f 76 65 s dirs-to-remove
8b00: 29 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 28 ) (lambda (a b)(
8b10: 3e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 > (string-length
8b20: 20 61 29 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 a)(string-lengt
8b30: 68 20 62 29 29 29 29 29 0a 0a 09 20 20 20 3b 3b h b)))))... ;;
8b40: 20 72 65 6d 6f 76 65 20 74 68 65 20 72 75 6e 20 remove the run
8b50: 69 66 20 7a 65 72 6f 20 74 65 73 74 73 20 72 65 if zero tests re
8b60: 6d 61 69 6e 0a 09 20 20 20 28 6c 65 74 20 28 28 main.. (let ((
8b70: 72 65 6d 74 65 73 74 73 20 28 64 62 2d 67 65 74 remtests (db-get
8b80: 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 -tests-for-run d
8b90: 62 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d b (db:get-value-
8ba0: 62 79 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 by-header run he
8bb0: 61 64 65 72 20 22 69 64 22 29 29 29 29 0a 09 20 ader "id"))))..
8bc0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 72 (if (null? r
8bd0: 65 6d 74 65 73 74 73 29 20 3b 3b 20 6e 6f 20 6d emtests) ;; no m
8be0: 6f 72 65 20 74 65 73 74 73 20 72 65 6d 61 69 6e ore tests remain
8bf0: 69 6e 67 0a 09 09 20 28 6c 65 74 2a 20 28 28 64 ing... (let* ((d
8c00: 70 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 parts (string-s
8c10: 70 6c 69 74 20 6c 61 73 74 74 70 61 74 68 20 22 plit lasttpath "
8c20: 2f 22 29 29 0a 09 09 09 28 72 75 6e 70 61 74 68 /"))....(runpath
8c30: 20 28 63 6f 6e 63 20 22 2f 22 20 28 73 74 72 69 (conc "/" (stri
8c40: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 0a ng-intersperse .
8c50: 09 09 09 09 09 20 20 20 20 28 74 61 6b 65 20 64 ..... (take d
8c60: 70 61 72 74 73 20 28 2d 20 28 6c 65 6e 67 74 68 parts (- (length
8c70: 20 64 70 61 72 74 73 29 20 31 29 29 0a 09 09 09 dparts) 1))....
8c80: 09 09 20 20 20 20 22 2f 22 29 29 29 29 0a 09 09 .. "/"))))...
8c90: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8ca0: 31 20 22 52 65 6d 6f 76 69 6e 67 20 72 75 6e 3a 1 "Removing run:
8cb0: 20 22 20 72 75 6e 6b 65 79 20 22 20 22 20 28 64 " runkey " " (d
8cc0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
8cd0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
8ce0: 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 09 20 "runname"))...
8cf0: 20 20 28 64 62 3a 64 65 6c 65 74 65 2d 72 75 6e (db:delete-run
8d00: 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 09 20 20 db run-id)...
8d10: 20 3b 3b 20 6e 65 65 64 20 74 6f 20 66 69 67 75 ;; need to figu
8d20: 72 65 20 6f 75 74 20 74 68 65 20 70 61 74 68 20 re out the path
8d30: 74 6f 20 74 68 65 20 72 75 6e 20 64 69 72 20 61 to the run dir a
8d40: 6e 64 20 72 65 6d 6f 76 65 20 69 74 20 69 66 20 nd remove it if
8d50: 65 6d 70 74 79 0a 09 09 20 20 20 3b 3b 20 20 20 empty... ;;
8d60: 20 28 69 66 20 28 6e 75 6c 6c 3f 20 28 67 6c 6f (if (null? (glo
8d70: 62 20 28 63 6f 6e 63 20 72 75 6e 70 61 74 68 20 b (conc runpath
8d80: 22 2f 2a 22 29 29 29 0a 09 09 20 20 20 3b 3b 20 "/*")))... ;;
8d90: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
8da0: 20 20 20 3b 3b 20 09 20 28 64 65 62 75 67 3a 70 ;; . (debug:p
8db0: 72 69 6e 74 20 31 20 22 52 65 6d 6f 76 69 6e 67 rint 1 "Removing
8dc0: 20 72 75 6e 20 64 69 72 20 22 20 72 75 6e 70 61 run dir " runpa
8dd0: 74 68 29 0a 09 09 20 20 20 3b 3b 20 09 20 28 73 th)... ;; . (s
8de0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 64 ystem (conc "rmd
8df0: 69 72 20 2d 70 20 22 20 72 75 6e 70 61 74 68 29 ir -p " runpath)
8e00: 29 29 29 0a 09 09 20 20 20 29 29 29 29 0a 09 20 )))... ))))..
8e10: 29 29 0a 20 20 20 20 20 72 75 6e 73 29 29 29 0a )). runs))).
8e20: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
8e30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8e60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 75 =========.;; Rou
8e70: 74 69 6e 65 73 20 66 6f 72 20 6d 61 6e 69 70 75 tines for manipu
8e80: 6c 61 74 69 6e 67 20 72 75 6e 73 0a 3b 3b 3d 3d lating runs.;;==
8e90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ea0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8eb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ec0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ed0: 3d 3d 3d 3d 0a 0a 3b 3b 20 53 69 6e 63 65 20 6d ====..;; Since m
8ee0: 61 6e 79 20 63 61 6c 6c 73 20 74 6f 20 61 20 72 any calls to a r
8ef0: 75 6e 20 72 65 71 75 69 72 65 20 70 72 65 74 74 un require prett
8f00: 79 20 6d 75 63 68 20 74 68 65 20 73 61 6d 65 20 y much the same
8f10: 73 65 74 75 70 20 0a 3b 3b 20 74 68 69 73 20 77 setup .;; this w
8f20: 72 61 70 70 65 72 20 69 73 20 75 73 65 64 20 74 rapper is used t
8f30: 6f 20 72 65 64 75 63 65 20 74 68 65 20 72 65 70 o reduce the rep
8f40: 6c 69 63 61 74 69 6f 6e 20 6f 66 20 63 6f 64 65 lication of code
8f50: 0a 28 64 65 66 69 6e 65 20 28 67 65 6e 65 72 61 .(define (genera
8f60: 6c 2d 72 75 6e 2d 63 61 6c 6c 20 73 77 69 74 63 l-run-call switc
8f70: 68 6e 61 6d 65 20 61 63 74 69 6f 6e 2d 64 65 73 hname action-des
8f80: 63 20 70 72 6f 63 29 0a 20 20 28 69 66 20 28 6e c proc). (if (n
8f90: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
8fa0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 29 0a 20 20 ":runname")).
8fb0: 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 (begin..(deb
8fc0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
8fd0: 52 3a 20 4d 69 73 73 69 6e 67 20 72 65 71 75 69 R: Missing requi
8fe0: 72 65 64 20 70 61 72 61 6d 65 74 65 72 20 66 6f red parameter fo
8ff0: 72 20 22 20 73 77 69 74 63 68 6e 61 6d 65 20 22 r " switchname "
9000: 2c 20 79 6f 75 20 6d 75 73 74 20 73 70 65 63 69 , you must speci
9010: 66 79 20 74 68 65 20 72 75 6e 20 6e 61 6d 65 20 fy the run name
9020: 77 69 74 68 20 3a 72 75 6e 6e 61 6d 65 20 72 75 with :runname ru
9030: 6e 6e 61 6d 65 22 29 0a 09 28 65 78 69 74 20 32 nname")..(exit 2
9040: 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 )). (let ((
9050: 64 62 20 23 66 29 29 0a 09 28 69 66 20 28 6e 6f db #f))..(if (no
9060: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
9070: 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 20 0a )).. (begin .
9080: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
9090: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
90a0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
90b0: 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 ).. (exit 1
90c0: 29 29 29 0a 09 28 73 65 74 21 20 64 62 20 28 6f )))..(set! db (o
90d0: 70 65 6e 2d 64 62 29 29 0a 09 28 69 66 20 28 6e pen-db))..(if (n
90e0: 6f 74 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 ot (car *configi
90f0: 6e 66 6f 2a 29 29 0a 09 20 20 20 20 28 62 65 67 nfo*)).. (beg
9100: 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
9110: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
9120: 20 41 74 74 65 6d 70 74 65 64 20 74 6f 20 22 20 Attempted to "
9130: 61 63 74 69 6f 6e 2d 64 65 73 63 20 22 20 62 75 action-desc " bu
9140: 74 20 72 75 6e 20 61 72 65 61 20 63 6f 6e 66 69 t run area confi
9150: 67 20 66 69 6c 65 20 6e 6f 74 20 66 6f 75 6e 64 g file not found
9160: 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 ").. (exit
9170: 31 29 29 0a 09 20 20 20 20 3b 3b 20 45 78 74 72 1)).. ;; Extr
9180: 61 63 74 20 6f 75 74 20 73 74 75 66 66 20 6e 65 act out stuff ne
9190: 65 64 65 64 20 69 6e 20 6d 6f 73 74 20 6f 72 20 eded in most or
91a0: 6d 61 6e 79 20 63 61 6c 6c 73 0a 09 20 20 20 20 many calls..
91b0: 3b 3b 20 68 65 72 65 20 74 68 65 6e 20 63 61 6c ;; here then cal
91c0: 6c 20 70 72 6f 63 0a 09 20 20 20 20 28 6c 65 74 l proc.. (let
91d0: 2a 20 28 28 6b 65 79 73 20 20 20 20 20 20 20 28 * ((keys (
91e0: 64 62 2d 67 65 74 2d 6b 65 79 73 20 64 62 29 29 db-get-keys db))
91f0: 0a 09 09 20 20 20 28 6b 65 79 6e 61 6d 65 73 20 ... (keynames
9200: 20 20 28 6d 61 70 20 6b 65 79 3a 67 65 74 2d 66 (map key:get-f
9210: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 73 29 29 0a ieldname keys)).
9220: 09 09 20 20 20 28 6b 65 79 76 61 6c 6c 73 74 20 .. (keyvallst
9230: 20 28 6b 65 79 73 2d 3e 76 61 6c 6c 69 73 74 20 (keys->vallist
9240: 6b 65 79 73 20 23 74 29 29 29 0a 09 20 20 20 20 keys #t)))..
9250: 20 20 28 70 72 6f 63 20 64 62 20 6b 65 79 73 20 (proc db keys
9260: 6b 65 79 6e 61 6d 65 73 20 6b 65 79 76 61 6c 6c keynames keyvall
9270: 73 74 29 29 29 0a 09 28 73 71 6c 69 74 65 33 3a st)))..(sqlite3:
9280: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 28 finalize! db)..(
9290: 73 65 74 21 20 2a 64 69 64 73 6f 6d 65 74 68 69 set! *didsomethi
92a0: 6e 67 2a 20 23 74 29 29 29 29 0a 0a 3b 3b 3d 3d ng* #t))))..;;==
92b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
92f0: 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 72 ====.;; Rollup r
9300: 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d uns.;;==========
9310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
9350: 20 55 70 64 61 74 65 20 74 68 65 20 74 65 73 74 Update the test
9360: 5f 6d 65 74 61 20 74 61 62 6c 65 20 66 6f 72 20 _meta table for
9370: 74 68 69 73 20 74 65 73 74 0a 28 64 65 66 69 6e this test.(defin
9380: 65 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d 74 e (runs:update-t
9390: 65 73 74 5f 6d 65 74 61 20 64 62 20 74 65 73 74 est_meta db test
93a0: 2d 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 29 -name test-conf)
93b0: 0a 20 20 28 6c 65 74 20 28 28 63 75 72 72 72 65 . (let ((currre
93c0: 63 6f 72 64 20 28 64 62 3a 74 65 73 74 6d 65 74 cord (db:testmet
93d0: 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 20 a-get-record db
93e0: 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 20 20 20 test-name))).
93f0: 20 28 69 66 20 28 6e 6f 74 20 63 75 72 72 72 65 (if (not currre
9400: 63 6f 72 64 29 0a 09 28 62 65 67 69 6e 0a 09 20 cord)..(begin..
9410: 20 28 73 65 74 21 20 63 75 72 72 72 65 63 6f 72 (set! currrecor
9420: 64 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 31 d (make-vector 1
9430: 30 20 23 66 29 29 0a 09 20 20 28 64 62 3a 74 65 0 #f)).. (db:te
9440: 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f 72 stmeta-add-recor
9450: 64 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 29 29 d db test-name))
9460: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
9470: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6b . (lambda (k
9480: 65 79 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a ey). (let*
9490: 20 28 28 69 64 78 20 28 63 61 64 72 20 6b 65 79 ((idx (cadr key
94a0: 29 29 0a 09 20 20 20 20 20 20 28 66 6c 64 20 28 )).. (fld (
94b0: 63 61 72 20 20 6b 65 79 29 29 0a 09 20 20 20 20 car key))..
94c0: 20 20 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d 6c (val (config-l
94d0: 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 ookup test-conf
94e0: 22 74 65 73 74 5f 6d 65 74 61 22 20 66 6c 64 29 "test_meta" fld)
94f0: 29 29 0a 09 20 28 69 66 20 28 61 6e 64 20 76 61 )).. (if (and va
9500: 6c 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 l (not (equal? (
9510: 76 65 63 74 6f 72 2d 72 65 66 20 63 75 72 72 72 vector-ref currr
9520: 65 63 6f 72 64 20 69 64 78 29 20 76 61 6c 29 29 ecord idx) val))
9530: 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ).. (begin..
9540: 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 55 (print "U
9550: 70 64 61 74 69 6e 67 20 22 20 74 65 73 74 2d 6e pdating " test-n
9560: 61 6d 65 20 22 20 22 20 66 6c 64 20 22 20 74 6f ame " " fld " to
9570: 20 22 20 76 61 6c 29 0a 09 20 20 20 20 20 20 20 " val)..
9580: 28 64 62 3a 74 65 73 74 6d 65 74 61 2d 75 70 64 (db:testmeta-upd
9590: 61 74 65 2d 66 69 65 6c 64 20 64 62 20 74 65 73 ate-field db tes
95a0: 74 2d 6e 61 6d 65 20 66 6c 64 20 76 61 6c 29 29 t-name fld val))
95b0: 29 29 29 0a 20 20 20 20 20 27 28 28 22 61 75 74 ))). '(("aut
95c0: 68 6f 72 22 20 32 29 28 22 6f 77 6e 65 72 22 20 hor" 2)("owner"
95d0: 33 29 28 22 64 65 73 63 72 69 70 74 69 6f 6e 22 3)("description"
95e0: 20 34 29 28 22 72 65 76 69 65 77 65 64 22 20 35 4)("reviewed" 5
95f0: 29 28 22 74 61 67 73 22 20 39 29 29 29 29 29 0a )("tags" 9))))).
9600: 0a 3b 3b 20 55 70 64 61 74 65 20 74 65 73 74 5f .;; Update test_
9610: 6d 65 74 61 20 66 6f 72 20 61 6c 6c 20 74 65 73 meta for all tes
9620: 74 73 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 73 ts.(define (runs
9630: 3a 75 70 64 61 74 65 2d 61 6c 6c 2d 74 65 73 74 :update-all-test
9640: 5f 6d 65 74 61 20 64 62 29 0a 20 20 28 6c 65 74 _meta db). (let
9650: 20 28 28 74 65 73 74 2d 6e 61 6d 65 73 20 28 67 ((test-names (g
9660: 65 74 2d 61 6c 6c 2d 6c 65 67 61 6c 2d 74 65 73 et-all-legal-tes
9670: 74 73 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 ts))). (for-e
9680: 61 63 68 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 ach . (lambd
9690: 61 20 28 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 a (test-name).
96a0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 (let* ((tes
96b0: 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 t-path (conc
96c0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 74 65 73 74 *toppath* "/test
96d0: 73 2f 22 20 74 65 73 74 2d 6e 61 6d 65 29 29 0a s/" test-name)).
96e0: 09 20 20 20 20 20 20 28 74 65 73 74 2d 63 6f 6e . (test-con
96f0: 66 69 67 66 20 28 63 6f 6e 63 20 74 65 73 74 2d figf (conc test-
9700: 70 61 74 68 20 22 2f 74 65 73 74 63 6f 6e 66 69 path "/testconfi
9710: 67 22 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 g")).. (tes
9720: 74 65 78 69 73 74 73 20 20 20 28 61 6e 64 20 28 texists (and (
9730: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 73 file-exists? tes
9740: 74 2d 63 6f 6e 66 69 67 66 29 28 66 69 6c 65 2d t-configf)(file-
9750: 72 65 61 64 2d 61 63 63 65 73 73 3f 20 74 65 73 read-access? tes
9760: 74 2d 63 6f 6e 66 69 67 66 29 29 29 0a 09 20 20 t-configf)))..
9770: 20 20 20 20 3b 3b 20 72 65 61 64 20 63 6f 6e 66 ;; read conf
9780: 69 67 73 20 77 69 74 68 20 74 72 69 63 6b 73 20 igs with tricks
9790: 74 75 72 6e 65 64 20 6f 66 66 20 28 69 2e 65 2e turned off (i.e.
97a0: 20 6e 6f 20 73 79 73 74 65 6d 29 0a 09 20 20 20 no system)..
97b0: 20 20 20 28 74 65 73 74 2d 63 6f 6e 66 20 20 20 (test-conf
97c0: 20 28 69 66 20 74 65 73 74 65 78 69 73 74 73 20 (if testexists
97d0: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 74 65 73 (read-config tes
97e0: 74 2d 63 6f 6e 66 69 67 66 20 23 66 20 23 66 29 t-configf #f #f)
97f0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
9800: 29 29 29 29 0a 09 20 28 72 75 6e 73 3a 75 70 64 )))).. (runs:upd
9810: 61 74 65 2d 74 65 73 74 5f 6d 65 74 61 20 64 62 ate-test_meta db
9820: 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d test-name test-
9830: 63 6f 6e 66 29 29 29 0a 20 20 20 20 20 74 65 73 conf))). tes
9840: 74 2d 6e 61 6d 65 73 29 29 29 0a 09 20 0a 3b 3b t-names))).. .;;
9850: 20 54 68 69 73 20 63 6f 75 6c 64 20 70 72 6f 62 This could prob
9860: 61 62 6c 79 20 62 65 20 72 65 66 61 63 74 6f 72 ably be refactor
9870: 65 64 20 69 6e 74 6f 20 6f 6e 65 20 63 6f 6d 70 ed into one comp
9880: 6c 65 78 20 71 75 65 72 79 20 2e 2e 2e 0a 28 64 lex query ....(d
9890: 65 66 69 6e 65 20 28 72 75 6e 73 3a 72 6f 6c 6c efine (runs:roll
98a0: 75 70 2d 72 75 6e 20 64 62 20 6b 65 79 73 29 0a up-run db keys).
98b0: 20 20 28 6c 65 74 2a 20 28 28 6e 65 77 2d 72 75 (let* ((new-ru
98c0: 6e 2d 69 64 20 20 20 20 20 20 28 72 65 67 69 73 n-id (regis
98d0: 74 65 72 2d 72 75 6e 20 64 62 20 6b 65 79 73 29 ter-run db keys)
98e0: 29 0a 09 20 28 70 72 65 76 2d 74 65 73 74 73 20 ).. (prev-tests
98f0: 20 20 20 20 20 28 74 65 73 74 3a 67 65 74 2d 6d (test:get-m
9900: 61 74 63 68 69 6e 67 2d 70 72 65 76 69 6f 75 73 atching-previous
9910: 2d 74 65 73 74 2d 72 75 6e 2d 72 65 63 6f 72 64 -test-run-record
9920: 73 20 64 62 20 6e 65 77 2d 72 75 6e 2d 69 64 20 s db new-run-id
9930: 22 25 22 20 22 25 22 29 29 0a 09 20 28 63 75 72 "%" "%")).. (cur
9940: 72 2d 74 65 73 74 73 20 20 20 20 20 20 28 64 62 r-tests (db
9950: 2d 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 -get-tests-for-r
9960: 75 6e 20 64 62 20 6e 65 77 2d 72 75 6e 2d 69 64 un db new-run-id
9970: 20 22 25 22 20 22 25 22 29 29 0a 09 20 28 63 75 "%" "%")).. (cu
9980: 72 72 2d 74 65 73 74 73 2d 68 61 73 68 20 28 6d rr-tests-hash (m
9990: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
99a0: 29 0a 20 20 20 20 3b 3b 20 69 6e 64 65 78 20 74 ). ;; index t
99b0: 68 65 20 61 6c 72 65 61 64 79 20 73 61 76 65 64 he already saved
99c0: 20 74 65 73 74 73 20 62 79 20 74 65 73 74 6e 61 tests by testna
99d0: 6d 65 20 61 6e 64 20 69 74 65 6d 70 61 74 68 20 me and itempath
99e0: 69 6e 20 63 75 72 72 2d 74 65 73 74 73 2d 68 61 in curr-tests-ha
99f0: 73 68 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 sh. (for-each
9a00: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
9a10: 65 73 74 64 61 74 29 0a 20 20 20 20 20 20 20 28 estdat). (
9a20: 6c 65 74 2a 20 28 28 74 65 73 74 6e 61 6d 65 20 let* ((testname
9a30: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 (db:test-get-te
9a40: 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 29 stname testdat))
9a50: 0a 09 20 20 20 20 20 20 28 69 74 65 6d 2d 70 61 .. (item-pa
9a60: 74 68 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d th (db:test-get-
9a70: 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 61 item-path testda
9a80: 74 29 29 0a 09 20 20 20 20 20 20 28 66 75 6c 6c t)).. (full
9a90: 2d 6e 61 6d 65 20 28 63 6f 6e 63 20 74 65 73 74 -name (conc test
9aa0: 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 name "/" item-pa
9ab0: 74 68 29 29 29 0a 09 20 28 68 61 73 68 2d 74 61 th))).. (hash-ta
9ac0: 62 6c 65 2d 73 65 74 21 20 63 75 72 72 2d 74 65 ble-set! curr-te
9ad0: 73 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 6e 61 sts-hash full-na
9ae0: 6d 65 20 74 65 73 74 64 61 74 29 29 29 0a 20 20 me testdat))).
9af0: 20 20 20 63 75 72 72 2d 74 65 73 74 73 29 0a 20 curr-tests).
9b00: 20 20 20 3b 3b 20 4e 4f 50 45 3a 20 4e 6f 6e 2d ;; NOPE: Non-
9b10: 6f 70 74 69 6d 61 6c 20 61 70 70 72 6f 61 63 68 optimal approach
9b20: 2e 20 54 72 79 20 74 68 69 73 20 69 6e 73 74 65 . Try this inste
9b30: 61 64 2e 0a 20 20 20 20 3b 3b 20 20 20 31 2e 20 ad.. ;; 1.
9b40: 74 65 73 74 73 20 61 72 65 20 72 65 63 65 69 76 tests are receiv
9b50: 65 64 20 69 6e 20 61 20 6c 69 73 74 2c 20 6d 6f ed in a list, mo
9b60: 73 74 20 72 65 63 65 6e 74 20 66 69 72 73 74 0a st recent first.
9b70: 20 20 20 20 3b 3b 20 20 20 32 2e 20 72 65 70 6c ;; 2. repl
9b80: 61 63 65 20 74 68 65 20 72 6f 6c 6c 75 70 20 74 ace the rollup t
9b90: 65 73 74 20 77 69 74 68 20 74 68 65 20 6e 65 77 est with the new
9ba0: 20 2a 61 6c 77 61 79 73 2a 0a 20 20 20 20 28 66 *always*. (f
9bb0: 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c or-each . (l
9bc0: 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 0a ambda (testdat).
9bd0: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 (let* ((t
9be0: 65 73 74 6e 61 6d 65 20 20 28 64 62 3a 74 65 73 estname (db:tes
9bf0: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
9c00: 65 73 74 64 61 74 29 29 0a 09 20 20 20 20 20 20 estdat))..
9c10: 28 69 74 65 6d 2d 70 61 74 68 20 28 64 62 3a 74 (item-path (db:t
9c20: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
9c30: 68 20 74 65 73 74 64 61 74 29 29 0a 09 20 20 20 h testdat))..
9c40: 20 20 20 28 66 75 6c 6c 2d 6e 61 6d 65 20 28 63 (full-name (c
9c50: 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f 22 onc testname "/"
9c60: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 item-path))..
9c70: 20 20 20 20 28 70 72 65 76 2d 74 65 73 74 2d 64 (prev-test-d
9c80: 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 at (hash-table-r
9c90: 65 66 2f 64 65 66 61 75 6c 74 20 63 75 72 72 2d ef/default curr-
9ca0: 74 65 73 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d tests-hash full-
9cb0: 6e 61 6d 65 20 23 66 29 29 0a 09 20 20 20 20 20 name #f))..
9cc0: 20 28 74 65 73 74 2d 73 74 65 70 73 20 20 20 20 (test-steps
9cd0: 20 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 2d (db:get-steps-
9ce0: 66 6f 72 2d 74 65 73 74 20 64 62 20 28 64 62 3a for-test db (db:
9cf0: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
9d00: 64 61 74 29 29 29 0a 09 20 20 20 20 20 20 28 6e dat))).. (n
9d10: 65 77 2d 74 65 73 74 2d 72 65 63 6f 72 64 20 23 ew-test-record #
9d20: 66 29 29 0a 09 20 3b 3b 20 72 65 70 6c 61 63 65 f)).. ;; replace
9d30: 20 74 68 65 73 65 20 77 69 74 68 20 69 6e 73 65 these with inse
9d40: 72 74 20 2e 2e 2e 20 73 65 6c 65 63 74 0a 09 20 rt ... select..
9d50: 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 (apply sqlite3:e
9d60: 78 65 63 75 74 65 20 0a 09 09 64 62 20 0a 09 09 xecute ...db ...
9d70: 28 63 6f 6e 63 20 22 49 4e 53 45 52 54 20 4f 52 (conc "INSERT OR
9d80: 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 74 65 REPLACE INTO te
9d90: 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 73 74 sts (run_id,test
9da0: 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 name,state,statu
9db0: 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f 73 s,event_time,hos
9dc0: 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 t,cpuload,diskfr
9dd0: 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c ee,uname,rundir,
9de0: 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 75 item_path,run_du
9df0: 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f 67 ration,final_log
9e00: 66 2c 63 6f 6d 6d 65 6e 74 2c 66 69 72 73 74 5f f,comment,first_
9e10: 65 72 72 2c 66 69 72 73 74 5f 77 61 72 6e 29 20 err,first_warn)
9e20: 22 0a 09 09 20 20 20 20 20 20 22 56 41 4c 55 45 "... "VALUE
9e30: 53 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f S (?,?,?,?,?,?,?
9e40: 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ,?,?,?,?,?,?,?,?
9e50: 2c 3f 29 3b 22 29 0a 09 09 6e 65 77 2d 72 75 6e ,?);")...new-run
9e60: 2d 69 64 20 28 63 64 64 72 20 28 76 65 63 74 6f -id (cddr (vecto
9e70: 72 2d 3e 6c 69 73 74 20 74 65 73 74 64 61 74 29 r->list testdat)
9e80: 29 29 0a 09 20 28 73 65 74 21 20 6e 65 77 2d 74 )).. (set! new-t
9e90: 65 73 74 64 61 74 20 28 63 61 72 20 28 64 62 2d estdat (car (db-
9ea0: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
9eb0: 6e 20 64 62 20 6e 65 77 2d 72 75 6e 2d 69 64 20 n db new-run-id
9ec0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 testname item-pa
9ed0: 74 68 29 29 29 0a 09 20 28 68 61 73 68 2d 74 61 th))).. (hash-ta
9ee0: 62 6c 65 2d 73 65 74 21 20 63 75 72 72 2d 74 65 ble-set! curr-te
9ef0: 73 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 6e 61 sts-hash full-na
9f00: 6d 65 20 6e 65 77 2d 74 65 73 74 64 61 74 29 20 me new-testdat)
9f10: 3b 3b 20 74 68 69 73 20 63 6f 75 6c 64 20 62 65 ;; this could be
9f20: 20 63 6f 6e 66 75 73 69 6e 67 2c 20 77 68 69 63 confusing, whic
9f30: 68 20 72 65 63 6f 72 64 20 73 68 6f 75 6c 64 20 h record should
9f40: 67 6f 20 69 6e 74 6f 20 74 68 65 20 6c 6f 6f 6b go into the look
9f50: 75 70 20 74 61 62 6c 65 3f 0a 09 20 3b 3b 20 4e up table?.. ;; N
9f60: 6f 77 20 64 75 70 6c 69 63 61 74 65 20 74 68 65 ow duplicate the
9f70: 20 74 65 73 74 20 73 74 65 70 73 0a 09 20 28 64 test steps.. (d
9f80: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 43 6f ebug:print 4 "Co
9f90: 70 79 69 6e 67 20 72 65 63 6f 72 64 73 20 69 6e pying records in
9fa0: 20 74 65 73 74 5f 73 74 65 70 73 20 66 72 6f 6d test_steps from
9fb0: 20 74 65 73 74 5f 69 64 3d 22 20 28 64 62 3a 74 test_id=" (db:t
9fc0: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 64 est-get-id testd
9fd0: 61 74 29 20 22 20 74 6f 20 22 20 28 64 62 3a 74 at) " to " (db:t
9fe0: 65 73 74 2d 67 65 74 2d 69 64 20 6e 65 77 2d 74 est-get-id new-t
9ff0: 65 73 74 64 61 74 29 29 0a 09 20 28 73 71 6c 69 estdat)).. (sqli
a000: 74 65 33 3a 65 78 65 63 75 74 65 20 0a 09 20 20 te3:execute ..
a010: 64 62 20 0a 09 20 20 28 63 6f 6e 63 20 22 49 4e db .. (conc "IN
a020: 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 SERT OR REPLACE
a030: 49 4e 54 4f 20 74 65 73 74 5f 73 74 65 70 73 20 INTO test_steps
a040: 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 6d (test_id,stepnam
a050: 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 65 e,state,status,e
a060: 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 6e vent_time,commen
a070: 74 29 20 22 0a 09 09 22 53 45 4c 45 43 54 20 22 t) "..."SELECT "
a080: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
a090: 20 6e 65 77 2d 74 65 73 74 64 61 74 29 20 22 2c new-testdat) ",
a0a0: 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c 73 stepname,state,s
a0b0: 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 tatus,event_time
a0c0: 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 65 ,comment FROM te
a0d0: 73 74 5f 73 74 65 70 73 20 57 48 45 52 45 20 74 st_steps WHERE t
a0e0: 65 73 74 5f 69 64 3d 3f 3b 22 29 0a 09 20 20 28 est_id=?;").. (
a0f0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t
a100: 65 73 74 64 61 74 29 29 0a 09 20 3b 3b 20 4e 6f estdat)).. ;; No
a110: 77 20 64 75 70 6c 69 63 61 74 65 20 74 68 65 20 w duplicate the
a120: 74 65 73 74 20 64 61 74 61 0a 09 20 28 64 65 62 test data.. (deb
a130: 75 67 3a 70 72 69 6e 74 20 34 20 22 43 6f 70 79 ug:print 4 "Copy
a140: 69 6e 67 20 72 65 63 6f 72 64 73 20 69 6e 20 74 ing records in t
a150: 65 73 74 5f 64 61 74 61 20 66 72 6f 6d 20 74 65 est_data from te
a160: 73 74 5f 69 64 3d 22 20 28 64 62 3a 74 65 73 74 st_id=" (db:test
a170: 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 -get-id testdat)
a180: 20 22 20 74 6f 20 22 20 28 64 62 3a 74 65 73 74 " to " (db:test
a190: 2d 67 65 74 2d 69 64 20 6e 65 77 2d 74 65 73 74 -get-id new-test
a1a0: 64 61 74 29 29 0a 09 20 28 73 71 6c 69 74 65 33 dat)).. (sqlite3
a1b0: 3a 65 78 65 63 75 74 65 20 0a 09 20 20 64 62 20 :execute .. db
a1c0: 0a 09 20 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 .. (conc "INSER
a1d0: 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e 54 T OR REPLACE INT
a1e0: 4f 20 74 65 73 74 5f 64 61 74 61 20 28 74 65 73 O test_data (tes
a1f0: 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 61 t_id,category,va
a200: 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78 70 riable,value,exp
a210: 65 63 74 65 64 5f 76 61 6c 75 65 2c 74 6f 6c 2c ected_value,tol,
a220: 75 6e 69 74 73 2c 63 6f 6d 6d 65 6e 74 29 20 22 units,comment) "
a230: 0a 09 09 22 53 45 4c 45 43 54 20 22 20 28 64 62 ..."SELECT " (db
a240: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 6e 65 77 :test-get-id new
a250: 2d 74 65 73 74 64 61 74 29 20 22 2c 63 61 74 65 -testdat) ",cate
a260: 67 6f 72 79 2c 76 61 72 69 61 62 6c 65 2c 76 61 gory,variable,va
a270: 6c 75 65 2c 65 78 70 65 63 74 65 64 5f 76 61 6c lue,expected_val
a280: 75 65 2c 74 6f 6c 2c 75 6e 69 74 73 2c 63 6f 6d ue,tol,units,com
a290: 6d 65 6e 74 20 46 52 4f 4d 20 74 65 73 74 5f 64 ment FROM test_d
a2a0: 61 74 61 20 57 48 45 52 45 20 74 65 73 74 5f 69 ata WHERE test_i
a2b0: 64 3d 3f 3b 22 29 0a 09 20 20 28 64 62 3a 74 65 d=?;").. (db:te
a2c0: 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 st-get-id testda
a2d0: 74 29 29 0a 09 20 29 29 0a 20 20 20 20 20 70 72 t)).. )). pr
a2e0: 65 76 2d 74 65 73 74 73 29 29 29 0a 09 20 0a 20 ev-tests))).. .
a2f0: 20 20 20 20 0a .