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: 28 75 73 65 20 73 71 6c 69 74 65 33 20 73 72 66 (use sqlite3 srf
0190: 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 i-1 posix regex
01a0: 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d regex-case srfi-
01b0: 36 39 20 64 6f 74 2d 6c 6f 63 6b 69 6e 67 20 28 69 dot-locking (
01c0: 73 72 66 69 20 31 38 29 20 70 6f 73 69 78 2d 65 srfi 18) posix-e
01d0: 78 74 72 61 73 20 64 69 72 65 63 74 6f 72 79 2d xtras directory-
01e0: 75 74 69 6c 73 29 0a 28 69 6d 70 6f 72 74 20 28 utils).(import (
01f0: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0200: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
0210: 61 72 65 20 28 75 6e 69 74 20 72 75 6e 73 29 29 are (unit runs))
0220: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0230: 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 db)).(declare (u
0240: 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 ses common)).(de
0250: 63 6c 61 72 65 20 28 75 73 65 73 20 69 74 65 6d clare (uses item
0260: 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 s)).(declare (us
0270: 65 73 20 72 75 6e 63 6f 6e 66 69 67 29 29 0a 28 es runconfig)).(
0280: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0290: 73 74 73 29 29 0a 28 64 65 63 6c 61 72 65 20 28 sts)).(declare (
02a0: 75 73 65 73 20 73 65 72 76 65 72 29 29 0a 0a 28 uses server))..(
02b0: 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f include "common_
02c0: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
02d0: 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f nclude "key_reco
02e0: 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 rds.scm").(inclu
02f0: 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 de "db_records.s
0300: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 cm").(include "r
0310: 75 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 un_records.scm")
0320: 0a 28 69 6e 63 6c 75 64 65 20 22 74 65 73 74 5f .(include "test_
0330: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b records.scm")..;
0340: 3b 20 72 75 6e 73 3a 67 65 74 2d 72 75 6e 73 2d ; runs:get-runs-
0350: 62 79 2d 70 61 74 74 0a 3b 3b 20 67 65 74 20 72 by-patt.;; get r
0360: 75 6e 73 20 62 79 20 6c 69 73 74 20 6f 66 20 63 uns by list of c
0370: 72 69 74 65 72 69 61 0a 3b 3b 20 72 65 67 69 73 riteria.;; regis
0380: 74 65 72 20 61 20 74 65 73 74 20 72 75 6e 20 77 ter a test run w
0390: 69 74 68 20 74 68 65 20 64 62 0a 3b 3b 0a 3b 3b ith the db.;;.;;
03a0: 20 55 73 65 3a 20 28 64 62 2d 67 65 74 2d 76 61 Use: (db-get-va
03b0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 lue-by-header (d
03c0: 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e b:get-header run
03d0: 69 6e 66 6f 29 28 64 62 3a 67 65 74 2d 72 6f 77 info)(db:get-row
03e0: 20 72 75 6e 69 6e 66 6f 29 29 0a 3b 3b 20 20 74 runinfo)).;; t
03f0: 6f 20 65 78 74 72 61 63 74 20 69 6e 66 6f 20 66 o extract info f
0400: 72 6f 6d 20 74 68 65 20 73 74 72 75 63 74 75 72 rom the structur
0410: 65 20 72 65 74 75 72 6e 65 64 0a 3b 3b 0a 28 64 e returned.;;.(d
0420: 65 66 69 6e 65 20 28 72 75 6e 73 3a 67 65 74 2d efine (runs:get-
0430: 72 75 6e 73 2d 62 79 2d 70 61 74 74 20 64 62 20 runs-by-patt db
0440: 6b 65 79 73 20 72 75 6e 6e 61 6d 65 70 61 74 74 keys runnamepatt
0450: 20 2e 20 70 61 72 61 6d 73 29 20 3b 3b 20 74 65 . params) ;; te
0460: 73 74 2d 6e 61 6d 65 29 0a 20 20 28 6c 65 74 2a st-name). (let*
0470: 20 28 28 6b 65 79 76 61 6c 6c 73 74 20 28 6b 65 ((keyvallst (ke
0480: 79 73 2d 3e 76 61 6c 6c 69 73 74 20 6b 65 79 73 ys->vallist keys
0490: 29 29 0a 09 20 28 74 6d 70 20 20 20 20 20 20 28 )).. (tmp (
04a0: 72 75 6e 73 3a 67 65 74 2d 73 74 64 2d 72 75 6e runs:get-std-run
04b0: 2d 66 69 65 6c 64 73 20 6b 65 79 73 20 27 28 22 -fields keys '("
04c0: 69 64 22 20 22 72 75 6e 6e 61 6d 65 22 20 22 73 id" "runname" "s
04d0: 74 61 74 65 22 20 22 73 74 61 74 75 73 22 20 22 tate" "status" "
04e0: 6f 77 6e 65 72 22 20 22 65 76 65 6e 74 5f 74 69 owner" "event_ti
04f0: 6d 65 22 29 29 29 0a 09 20 28 6b 65 79 73 74 72 me"))).. (keystr
0500: 20 20 20 28 63 61 72 20 74 6d 70 29 29 0a 09 20 (car tmp))..
0510: 28 68 65 61 64 65 72 20 20 20 28 63 61 64 72 20 (header (cadr
0520: 74 6d 70 29 29 0a 09 20 28 72 65 73 20 20 20 20 tmp)).. (res
0530: 20 27 28 29 29 0a 09 20 28 6b 65 79 2d 70 61 74 '()).. (key-pat
0540: 74 20 22 22 29 29 0a 20 20 20 20 28 66 6f 72 2d t "")). (for-
0550: 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 65 each (lambda (ke
0560: 79 76 61 6c 29 0a 09 09 28 6c 65 74 2a 20 28 28 yval)...(let* ((
0570: 6b 65 79 20 20 20 20 28 76 65 63 74 6f 72 2d 72 key (vector-r
0580: 65 66 20 6b 65 79 76 61 6c 20 30 29 29 0a 09 09 ef keyval 0))...
0590: 20 20 20 20 20 20 20 28 66 75 6c 6b 65 79 20 28 (fulkey (
05a0: 63 6f 6e 63 20 22 3a 22 20 6b 65 79 29 29 0a 09 conc ":" key))..
05b0: 09 20 20 20 20 20 20 20 28 70 61 74 74 20 20 20 . (patt
05c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 66 75 (args:get-arg fu
05d0: 6c 6b 65 79 29 29 29 0a 09 09 20 20 28 69 66 20 lkey)))... (if
05e0: 70 61 74 74 0a 09 09 20 20 20 20 20 20 28 73 65 patt... (se
05f0: 74 21 20 6b 65 79 2d 70 61 74 74 20 28 63 6f 6e t! key-patt (con
0600: 63 20 6b 65 79 2d 70 61 74 74 20 22 20 41 4e 44 c key-patt " AND
0610: 20 22 20 6b 65 79 20 22 20 6c 69 6b 65 20 27 22 " key " like '"
0620: 20 70 61 74 74 20 22 27 22 29 29 0a 09 09 20 20 patt "'"))...
0630: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 64 (begin....(d
0640: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
0650: 52 4f 52 3a 20 73 65 61 72 63 68 69 6e 67 20 66 ROR: searching f
0660: 6f 72 20 72 75 6e 73 20 77 69 74 68 20 6e 6f 20 or runs with no
0670: 70 61 74 74 65 72 6e 20 73 65 74 20 66 6f 72 20 pattern set for
0680: 22 20 66 75 6c 6b 65 79 29 0a 09 09 09 28 65 78 " fulkey)....(ex
0690: 69 74 20 36 29 29 29 29 29 0a 09 20 20 20 20 20 it 6)))))..
06a0: 20 6b 65 79 73 29 0a 20 20 20 20 28 73 71 6c 69 keys). (sqli
06b0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
06c0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
06d0: 61 20 2e 20 72 29 0a 20 20 20 20 20 20 20 28 73 a . r). (s
06e0: 65 74 21 20 72 65 73 20 28 63 6f 6e 73 20 28 6c et! res (cons (l
06f0: 69 73 74 2d 3e 76 65 63 74 6f 72 20 28 63 6f 6e ist->vector (con
0700: 73 20 61 20 72 29 29 20 72 65 73 29 29 29 0a 20 s a r)) res))).
0710: 20 20 20 20 64 62 20 0a 20 20 20 20 20 28 63 6f db . (co
0720: 6e 63 20 22 53 45 4c 45 43 54 20 22 20 6b 65 79 nc "SELECT " key
0730: 73 74 72 20 22 20 46 52 4f 4d 20 72 75 6e 73 20 str " FROM runs
0740: 57 48 45 52 45 20 72 75 6e 6e 61 6d 65 20 6c 69 WHERE runname li
0750: 6b 65 20 3f 20 22 20 6b 65 79 2d 70 61 74 74 20 ke ? " key-patt
0760: 22 3b 22 29 0a 20 20 20 20 20 72 75 6e 6e 61 6d ";"). runnam
0770: 65 70 61 74 74 29 0a 20 20 20 20 28 76 65 63 74 epatt). (vect
0780: 6f 72 20 68 65 61 64 65 72 20 72 65 73 29 29 29 or header res)))
0790: 0a 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a ..(define (runs:
07a0: 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 2d 70 61 test-get-full-pa
07b0: 74 68 20 74 65 73 74 29 0a 20 20 28 6c 65 74 2a th test). (let*
07c0: 20 28 28 74 65 73 74 6e 61 6d 65 20 28 64 62 3a ((testname (db:
07d0: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam
07e0: 65 20 20 20 74 65 73 74 29 29 0a 09 20 28 69 74 e test)).. (it
07f0: 65 6d 70 61 74 68 20 28 64 62 3a 74 65 73 74 2d empath (db:test-
0800: 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 get-item-path te
0810: 73 74 29 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 st))). (conc
0820: 74 65 73 74 6e 61 6d 65 20 28 69 66 20 28 65 71 testname (if (eq
0830: 75 61 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 ual? itempath ""
0840: 29 20 22 22 20 28 63 6f 6e 63 20 22 28 22 20 69 ) "" (conc "(" i
0850: 74 65 6d 70 61 74 68 20 22 29 22 29 29 29 29 29 tempath ")")))))
0860: 0a 0a 28 64 65 66 69 6e 65 20 28 73 65 74 2d 6d ..(define (set-m
0870: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
0880: 20 64 62 20 72 75 6e 2d 69 64 29 0a 20 20 28 6c db run-id). (l
0890: 65 74 20 28 28 6b 65 79 73 20 28 64 62 3a 67 65 et ((keys (db:ge
08a0: 74 2d 6b 65 79 73 20 64 62 29 29 29 0a 20 20 20 t-keys db))).
08b0: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
08c0: 64 61 20 28 6b 65 79 29 0a 09 09 28 73 71 6c 69 da (key)...(sqli
08d0: 74 65 33 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 te3:for-each-row
08e0: 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 76 61 6c ... (lambda (val
08f0: 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 )... (debug:pr
0900: 69 6e 74 20 32 20 22 73 65 74 65 6e 76 20 22 20 int 2 "setenv "
0910: 28 6b 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 (key:get-fieldna
0920: 6d 65 20 6b 65 79 29 20 22 20 22 20 76 61 6c 29 me key) " " val)
0930: 0a 09 09 20 20 20 28 73 65 74 65 6e 76 20 28 6b ... (setenv (k
0940: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
0950: 20 6b 65 79 29 20 76 61 6c 29 29 0a 09 09 20 64 key) val))... d
0960: 62 20 0a 09 09 20 28 63 6f 6e 63 20 22 53 45 4c b ... (conc "SEL
0970: 45 43 54 20 22 20 28 6b 65 79 3a 67 65 74 2d 66 ECT " (key:get-f
0980: 69 65 6c 64 6e 61 6d 65 20 6b 65 79 29 20 22 20 ieldname key) "
0990: 46 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 FROM runs WHERE
09a0: 69 64 3d 3f 3b 22 29 0a 09 09 20 72 75 6e 2d 69 id=?;")... run-i
09b0: 64 29 29 0a 09 20 20 20 20 20 20 6b 65 79 73 29 d)).. keys)
09c0: 0a 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 . (alist->env
09d0: 2d 76 61 72 73 20 28 68 61 73 68 2d 74 61 62 6c -vars (hash-tabl
09e0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
09f0: 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f onfigdat* "env-o
0a00: 76 65 72 72 69 64 65 22 20 27 28 29 29 29 0a 20 verride" '())).
0a10: 20 20 20 3b 3b 20 4c 65 74 73 20 75 73 65 20 74 ;; Lets use t
0a20: 68 69 73 20 61 73 20 61 6e 20 6f 70 70 6f 72 74 his as an opport
0a30: 75 6e 69 74 79 20 74 6f 20 70 75 74 20 4d 54 5f unity to put MT_
0a40: 52 55 4e 4e 41 4d 45 20 69 6e 20 74 68 65 20 65 RUNNAME in the e
0a50: 6e 76 69 72 6f 6e 6d 65 6e 74 0a 20 20 20 20 28 nvironment. (
0a60: 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 68 sqlite3:for-each
0a70: 2d 72 6f 77 0a 20 20 20 20 20 28 6c 61 6d 62 64 -row. (lambd
0a80: 61 20 28 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 a (runname).
0a90: 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 (setenv "MT_R
0aa0: 55 4e 4e 41 4d 45 22 20 72 75 6e 6e 61 6d 65 29 UNNAME" runname)
0ab0: 29 0a 20 20 20 20 20 64 62 0a 20 20 20 20 20 22 ). db. "
0ac0: 53 45 4c 45 43 54 20 72 75 6e 6e 61 6d 65 20 46 SELECT runname F
0ad0: 52 4f 4d 20 72 75 6e 73 20 57 48 45 52 45 20 69 ROM runs WHERE i
0ae0: 64 3d 3f 3b 22 0a 20 20 20 20 20 72 75 6e 2d 69 d=?;". run-i
0af0: 64 29 0a 20 20 20 20 29 29 0a 0a 28 64 65 66 69 d). ))..(defi
0b00: 6e 65 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 ne (set-item-env
0b10: 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a 20 -vars itemdat).
0b20: 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 (for-each (lamb
0b30: 64 61 20 28 69 74 65 6d 29 0a 09 20 20 20 20 20 da (item)..
0b40: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0b50: 22 73 65 74 65 6e 76 20 22 20 28 63 61 72 20 69 "setenv " (car i
0b60: 74 65 6d 29 20 22 20 22 20 28 63 61 64 72 20 69 tem) " " (cadr i
0b70: 74 65 6d 29 29 0a 09 20 20 20 20 20 20 28 73 65 tem)).. (se
0b80: 74 65 6e 76 20 28 63 61 72 20 69 74 65 6d 29 20 tenv (car item)
0b90: 28 63 61 64 72 20 69 74 65 6d 29 29 29 0a 09 20 (cadr item)))..
0ba0: 20 20 20 69 74 65 6d 64 61 74 29 29 0a 0a 28 64 itemdat))..(d
0bb0: 65 66 69 6e 65 20 2a 6c 61 73 74 2d 6e 75 6d 2d efine *last-num-
0bc0: 72 75 6e 6e 69 6e 67 2d 74 65 73 74 73 2a 20 30 running-tests* 0
0bd0: 29 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a ).(define (runs:
0be0: 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 65 73 can-run-more-tes
0bf0: 74 73 20 64 62 20 74 65 73 74 2d 72 65 63 6f 72 ts db test-recor
0c00: 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 63 6f d). (let* ((tco
0c10: 6e 66 69 67 20 20 20 20 20 20 20 20 20 20 20 20 nfig
0c20: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
0c30: 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 63 6f queue-get-testco
0c40: 6e 66 69 67 20 74 65 73 74 2d 72 65 63 6f 72 64 nfig test-record
0c50: 29 29 0a 09 20 28 6a 6f 62 67 72 6f 75 70 20 20 )).. (jobgroup
0c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
0c70: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 6f onfig-lookup tco
0c80: 6e 66 69 67 20 22 72 65 71 75 69 72 65 6d 65 6e nfig "requiremen
0c90: 74 73 22 20 22 6a 6f 62 67 72 6f 75 70 22 29 29 ts" "jobgroup"))
0ca0: 0a 09 20 28 6e 75 6d 2d 72 75 6e 6e 69 6e 67 20 .. (num-running
0cb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a (db:
0cc0: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
0cd0: 72 75 6e 6e 69 6e 67 20 64 62 29 29 0a 09 20 28 running db)).. (
0ce0: 6e 75 6d 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a num-running-in-j
0cf0: 6f 62 67 72 6f 75 70 20 28 64 62 3a 67 65 74 2d obgroup (db:get-
0d00: 63 6f 75 6e 74 2d 74 65 73 74 73 2d 72 75 6e 6e count-tests-runn
0d10: 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 70 20 ing-in-jobgroup
0d20: 64 62 20 6a 6f 62 67 72 6f 75 70 29 29 0a 09 20 db jobgroup))..
0d30: 28 6d 61 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d (max-concurrent-
0d40: 6a 6f 62 73 20 20 20 20 20 28 63 6f 6e 66 69 67 jobs (config
0d50: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
0d60: 61 74 2a 20 22 73 65 74 75 70 22 20 20 20 20 20 at* "setup"
0d70: 22 6d 61 78 5f 63 6f 6e 63 75 72 72 65 6e 74 5f "max_concurrent_
0d80: 6a 6f 62 73 22 29 29 0a 09 20 28 6a 6f 62 2d 67 jobs")).. (job-g
0d90: 72 6f 75 70 2d 6c 69 6d 69 74 20 20 20 20 20 20 roup-limit
0da0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
0db0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
0dc0: 6f 62 67 72 6f 75 70 73 22 20 6a 6f 62 67 72 6f obgroups" jobgro
0dd0: 75 70 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e up))). (if (n
0de0: 6f 74 20 28 65 71 3f 20 2a 6c 61 73 74 2d 6e 75 ot (eq? *last-nu
0df0: 6d 2d 72 75 6e 6e 69 6e 67 2d 74 65 73 74 73 2a m-running-tests*
0e00: 20 6e 75 6d 2d 72 75 6e 6e 69 6e 67 29 29 0a 09 num-running))..
0e10: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
0e20: 3a 70 72 69 6e 74 20 32 20 22 6d 61 78 2d 63 6f :print 2 "max-co
0e30: 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 3a 20 22 ncurrent-jobs: "
0e40: 20 6d 61 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d max-concurrent-
0e50: 6a 6f 62 73 20 22 2c 20 6e 75 6d 2d 72 75 6e 6e jobs ", num-runn
0e60: 69 6e 67 3a 20 22 20 6e 75 6d 2d 72 75 6e 6e 69 ing: " num-runni
0e70: 6e 67 29 0a 09 20 20 28 73 65 74 21 20 2a 6c 61 ng).. (set! *la
0e80: 73 74 2d 6e 75 6d 2d 72 75 6e 6e 69 6e 67 2d 74 st-num-running-t
0e90: 65 73 74 73 2a 20 6e 75 6d 2d 72 75 6e 6e 69 6e ests* num-runnin
0ea0: 67 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f g))). (if (no
0eb0: 74 20 28 65 71 3f 20 30 20 2a 67 6c 6f 62 61 6c t (eq? 0 *global
0ec0: 65 78 69 74 73 74 61 74 75 73 2a 29 29 0a 09 23 exitstatus*))..#
0ed0: 66 0a 09 28 6c 65 74 20 28 28 63 61 6e 2d 6e 6f f..(let ((can-no
0ee0: 74 2d 72 75 6e 2d 6d 6f 72 65 20 28 63 6f 6e 64 t-run-more (cond
0ef0: 0a 09 09 09 09 20 3b 3b 20 69 66 20 6d 61 78 2d ..... ;; if max-
0f00: 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 20 concurrent-jobs
0f10: 69 73 20 73 65 74 20 61 6e 64 20 74 68 65 20 6e is set and the n
0f20: 75 6d 62 65 72 20 72 75 6e 6e 69 6e 67 20 69 73 umber running is
0f30: 20 67 72 65 61 74 65 72 20 0a 09 09 09 09 20 3b greater ..... ;
0f40: 3b 20 74 68 61 6e 20 69 74 20 74 68 61 6e 20 63 ; than it than c
0f50: 61 6e 6e 6f 74 20 72 75 6e 20 6d 6f 72 65 20 6a annot run more j
0f60: 6f 62 73 0a 09 09 09 09 20 28 28 61 6e 64 20 6d obs..... ((and m
0f70: 61 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f ax-concurrent-jo
0f80: 62 73 0a 09 09 09 09 20 20 20 20 20 20 20 28 73 bs..... (s
0f90: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6d 61 tring->number ma
0fa0: 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 x-concurrent-job
0fb0: 73 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 3e s)..... (>
0fc0: 3d 20 6e 75 6d 2d 72 75 6e 6e 69 6e 67 20 28 73 = num-running (s
0fd0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6d 61 tring->number ma
0fe0: 78 2d 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 x-concurrent-job
0ff0: 73 29 29 29 0a 09 09 09 09 20 20 28 64 65 62 75 s)))..... (debu
1000: 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 g:print 0 "WARNI
1010: 4e 47 3a 20 4d 61 78 20 72 75 6e 6e 69 6e 67 20 NG: Max running
1020: 6a 6f 62 73 20 65 78 63 65 65 64 65 64 2c 20 63 jobs exceeded, c
1030: 75 72 72 65 6e 74 20 6e 75 6d 62 65 72 20 72 75 urrent number ru
1040: 6e 6e 69 6e 67 3a 20 22 20 6e 75 6d 2d 72 75 6e nning: " num-run
1050: 6e 69 6e 67 20 0a 09 09 09 09 09 20 20 20 20 20 ning ......
1060: 20 20 22 2c 20 6d 61 78 5f 63 6f 6e 63 75 72 72 ", max_concurr
1070: 65 6e 74 5f 6a 6f 62 73 3a 20 22 20 6d 61 78 2d ent_jobs: " max-
1080: 63 6f 6e 63 75 72 72 65 6e 74 2d 6a 6f 62 73 29 concurrent-jobs)
1090: 0a 09 09 09 09 20 20 23 74 29 0a 09 09 09 09 20 ..... #t).....
10a0: 3b 3b 20 69 66 20 6a 6f 62 2d 67 72 6f 75 70 2d ;; if job-group-
10b0: 6c 69 6d 69 74 20 69 73 20 73 65 74 20 61 6e 64 limit is set and
10c0: 20 6e 75 6d 62 65 72 20 6f 66 20 6a 6f 62 73 20 number of jobs
10d0: 69 6e 20 74 68 65 20 67 72 6f 75 70 20 69 73 20 in the group is
10e0: 67 72 65 61 74 65 72 0a 09 09 09 09 20 3b 3b 20 greater..... ;;
10f0: 74 68 61 6e 20 74 68 65 20 6c 69 6d 69 74 20 74 than the limit t
1100: 68 65 6e 20 63 61 6e 6e 6f 74 20 72 75 6e 20 6d hen cannot run m
1110: 6f 72 65 20 6a 6f 62 73 20 6f 66 20 74 68 69 73 ore jobs of this
1120: 20 6b 69 6e 64 0a 09 09 09 09 20 28 28 61 6e 64 kind..... ((and
1130: 20 6a 6f 62 2d 67 72 6f 75 70 2d 6c 69 6d 69 74 job-group-limit
1140: 0a 09 09 09 09 20 20 20 20 20 20 20 28 3e 3d 20 ..... (>=
1150: 6e 75 6d 2d 72 75 6e 6e 69 6e 67 2d 69 6e 2d 6a num-running-in-j
1160: 6f 62 67 72 6f 75 70 20 6a 6f 62 2d 67 72 6f 75 obgroup job-grou
1170: 70 2d 6c 69 6d 69 74 29 29 0a 09 09 09 09 20 20 p-limit)).....
1180: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
1190: 57 41 52 4e 49 4e 47 3a 20 6e 75 6d 62 65 72 20 WARNING: number
11a0: 6f 66 20 6a 6f 62 73 20 22 20 6e 75 6d 2d 72 75 of jobs " num-ru
11b0: 6e 6e 69 6e 67 2d 69 6e 2d 6a 6f 62 67 72 6f 75 nning-in-jobgrou
11c0: 70 20 0a 09 09 09 09 09 20 20 20 20 20 20 20 22 p ...... "
11d0: 20 69 6e 20 22 20 6a 6f 62 67 72 6f 75 70 20 22 in " jobgroup "
11e0: 20 65 78 63 65 65 64 65 64 2c 20 77 69 6c 6c 20 exceeded, will
11f0: 6e 6f 74 20 72 75 6e 20 22 20 28 74 65 73 74 73 not run " (tests
1200: 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 :testqueue-get-t
1210: 65 73 74 6e 61 6d 65 20 74 65 73 74 2d 72 65 63 estname test-rec
1220: 6f 72 64 29 29 0a 09 09 09 09 20 20 23 74 29 0a ord))..... #t).
1230: 09 09 09 09 20 28 65 6c 73 65 20 23 66 29 29 29 .... (else #f)))
1240: 29 0a 09 20 20 28 6e 6f 74 20 63 61 6e 2d 6e 6f ).. (not can-no
1250: 74 2d 72 75 6e 2d 6d 6f 72 65 29 29 29 29 29 0a t-run-more))))).
1260: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
1270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1290: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
12a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4e 65 77 =========.;; New
12b0: 20 6d 65 74 68 6f 64 6f 6c 6f 67 79 2e 20 54 68 methodology. Th
12c0: 65 73 65 20 72 6f 75 74 69 6e 65 73 20 77 69 6c ese routines wil
12d0: 6c 20 72 65 70 6c 61 63 65 20 74 68 65 20 61 62 l replace the ab
12e0: 6f 76 65 20 69 6e 20 74 69 6d 65 2e 20 46 6f 72 ove in time. For
12f0: 0a 3b 3b 20 6e 6f 77 20 74 68 65 20 63 6f 64 65 .;; now the code
1300: 20 69 73 20 64 75 70 6c 69 63 61 74 65 64 2e 20 is duplicated.
1310: 54 68 69 73 20 73 74 75 66 66 20 69 73 20 69 6e This stuff is in
1320: 69 74 69 61 6c 6c 79 20 75 73 65 64 20 69 6e 20 itially used in
1330: 74 68 65 20 6d 6f 6e 69 74 6f 72 0a 3b 3b 20 62 the monitor.;; b
1340: 61 73 65 64 20 63 6f 64 65 2e 0a 3b 3b 3d 3d 3d ased code..;;===
1350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1390: 3d 3d 3d 0a 0a 3b 3b 20 72 65 67 69 73 74 65 72 ===..;; register
13a0: 20 61 20 74 65 73 74 20 72 75 6e 20 77 69 74 68 a test run with
13b0: 20 74 68 65 20 64 62 0a 28 64 65 66 69 6e 65 20 the db.(define
13c0: 28 72 75 6e 73 3a 72 65 67 69 73 74 65 72 2d 72 (runs:register-r
13d0: 75 6e 20 64 62 20 6b 65 79 73 20 6b 65 79 76 61 un db keys keyva
13e0: 6c 6c 73 74 20 72 75 6e 6e 61 6d 65 20 73 74 61 llst runname sta
13f0: 74 65 20 73 74 61 74 75 73 20 75 73 65 72 29 0a te status user).
1400: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 33 (debug:print 3
1410: 20 22 72 75 6e 73 3a 72 65 67 69 73 74 65 72 2d "runs:register-
1420: 72 75 6e 2c 20 6b 65 79 73 3a 20 22 20 6b 65 79 run, keys: " key
1430: 73 20 22 20 6b 65 79 76 61 6c 6c 73 74 3a 20 22 s " keyvallst: "
1440: 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 72 75 6e keyvallst " run
1450: 6e 61 6d 65 3a 20 22 20 72 75 6e 6e 61 6d 65 20 name: " runname
1460: 22 20 73 74 61 74 65 3a 20 22 20 73 74 61 74 65 " state: " state
1470: 20 22 20 73 74 61 74 75 73 3a 20 22 20 73 74 61 " status: " sta
1480: 74 75 73 20 22 20 75 73 65 72 3a 20 22 20 75 73 tus " user: " us
1490: 65 72 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b 65 er). (let* ((ke
14a0: 79 73 74 72 20 20 20 20 28 6b 65 79 73 2d 3e 6b ystr (keys->k
14b0: 65 79 73 74 72 20 6b 65 79 73 29 29 0a 09 20 28 eystr keys)).. (
14c0: 63 6f 6d 6d 61 20 20 20 20 20 28 69 66 20 28 3e comma (if (>
14d0: 20 28 6c 65 6e 67 74 68 20 6b 65 79 73 29 20 30 (length keys) 0
14e0: 29 20 22 2c 22 20 22 22 29 29 0a 09 20 28 61 6e ) "," "")).. (an
14f0: 64 73 74 72 20 20 20 20 28 69 66 20 28 3e 20 28 dstr (if (> (
1500: 6c 65 6e 67 74 68 20 6b 65 79 73 29 20 30 29 20 length keys) 0)
1510: 22 20 41 4e 44 20 22 20 22 22 29 29 0a 09 20 28 " AND " "")).. (
1520: 76 61 6c 73 6c 6f 74 73 20 20 28 6b 65 79 73 2d valslots (keys-
1530: 3e 76 61 6c 73 6c 6f 74 73 20 6b 65 79 73 29 29 >valslots keys))
1540: 20 3b 3b 20 3f 2c 3f 2c 3f 20 2e 2e 2e 0a 09 20 ;; ?,?,? .....
1550: 28 6b 65 79 76 61 6c 73 20 20 20 28 6d 61 70 20 (keyvals (map
1560: 63 61 64 72 20 6b 65 79 76 61 6c 6c 73 74 29 29 cadr keyvallst))
1570: 0a 09 20 28 61 6c 6c 76 61 6c 73 20 20 20 28 61 .. (allvals (a
1580: 70 70 65 6e 64 20 28 6c 69 73 74 20 72 75 6e 6e ppend (list runn
1590: 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 75 73 ame state status
15a0: 20 75 73 65 72 29 20 6b 65 79 76 61 6c 73 29 29 user) keyvals))
15b0: 0a 09 20 28 71 72 79 76 61 6c 73 20 20 20 28 61 .. (qryvals (a
15c0: 70 70 65 6e 64 20 28 6c 69 73 74 20 72 75 6e 6e ppend (list runn
15d0: 61 6d 65 29 20 6b 65 79 76 61 6c 73 29 29 0a 09 ame) keyvals))..
15e0: 20 28 6b 65 79 3d 3f 73 74 72 20 20 28 73 74 72 (key=?str (str
15f0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
1600: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 6b 29 (map (lambda (k)
1610: 28 63 6f 6e 63 20 28 6b 65 79 3a 67 65 74 2d 66 (conc (key:get-f
1620: 69 65 6c 64 6e 61 6d 65 20 6b 29 20 22 3d 3f 22 ieldname k) "=?"
1630: 29 29 20 6b 65 79 73 29 20 22 20 41 4e 44 20 22 )) keys) " AND "
1640: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
1650: 72 69 6e 74 20 33 20 22 6b 65 79 73 3a 20 22 20 rint 3 "keys: "
1660: 6b 65 79 73 20 22 20 61 6c 6c 76 61 6c 73 3a 20 keys " allvals:
1670: 22 20 61 6c 6c 76 61 6c 73 20 22 20 6b 65 79 76 " allvals " keyv
1680: 61 6c 73 3a 20 22 20 6b 65 79 76 61 6c 73 29 0a als: " keyvals).
1690: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
16a0: 20 32 20 22 4e 4f 54 45 3a 20 75 73 69 6e 67 20 2 "NOTE: using
16b0: 74 61 72 67 65 74 20 22 20 28 73 74 72 69 6e 67 target " (string
16c0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
16d0: 76 61 6c 73 20 22 2f 22 29 20 22 20 66 6f 72 20 vals "/") " for
16e0: 74 68 69 73 20 72 75 6e 22 29 0a 20 20 20 20 28 this run"). (
16f0: 69 66 20 28 61 6e 64 20 72 75 6e 6e 61 6d 65 20 if (and runname
1700: 28 6e 75 6c 6c 3f 20 28 66 69 6c 74 65 72 20 28 (null? (filter (
1710: 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 78 lambda (x)(not x
1720: 29 29 20 6b 65 79 76 61 6c 73 29 29 29 20 3b 3b )) keyvals))) ;;
1730: 20 74 68 65 72 65 20 6d 75 73 74 20 62 65 20 61 there must be a
1740: 20 62 65 74 74 65 72 20 77 61 79 20 74 6f 20 22 better way to "
1750: 61 70 70 6c 79 20 61 6e 64 22 0a 09 28 6c 65 74 apply and"..(let
1760: 20 28 28 72 65 73 20 23 66 29 29 0a 09 20 20 28 ((res #f)).. (
1770: 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a 65 78 apply sqlite3:ex
1780: 65 63 75 74 65 20 64 62 20 28 63 6f 6e 63 20 22 ecute db (conc "
1790: 49 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 45 INSERT OR IGNORE
17a0: 20 49 4e 54 4f 20 72 75 6e 73 20 28 72 75 6e 6e INTO runs (runn
17b0: 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 ame,state,status
17c0: 2c 6f 77 6e 65 72 2c 65 76 65 6e 74 5f 74 69 6d ,owner,event_tim
17d0: 65 22 20 63 6f 6d 6d 61 20 6b 65 79 73 74 72 20 e" comma keystr
17e0: 22 29 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 3f ") VALUES (?,?,?
17f0: 2c 3f 2c 73 74 72 66 74 69 6d 65 28 27 25 73 27 ,?,strftime('%s'
1800: 2c 27 6e 6f 77 27 29 22 20 63 6f 6d 6d 61 20 76 ,'now')" comma v
1810: 61 6c 73 6c 6f 74 73 20 22 29 3b 22 29 0a 09 09 alslots ");")...
1820: 20 61 6c 6c 76 61 6c 73 29 0a 09 20 20 28 61 70 allvals).. (ap
1830: 70 6c 79 20 73 71 6c 69 74 65 33 3a 66 6f 72 2d ply sqlite3:for-
1840: 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 20 28 6c each-row .. (l
1850: 61 6d 62 64 61 20 28 69 64 29 0a 09 20 20 20 20 ambda (id)..
1860: 20 28 73 65 74 21 20 72 65 73 20 69 64 29 29 0a (set! res id)).
1870: 09 20 20 20 64 62 0a 09 20 20 20 28 6c 65 74 20 . db.. (let
1880: 28 28 71 72 79 20 28 63 6f 6e 63 20 22 53 45 4c ((qry (conc "SEL
1890: 45 43 54 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 ECT id FROM runs
18a0: 20 57 48 45 52 45 20 28 72 75 6e 6e 61 6d 65 3d WHERE (runname=
18b0: 3f 20 22 20 61 6e 64 73 74 72 20 6b 65 79 3d 3f ? " andstr key=?
18c0: 73 74 72 20 22 29 3b 22 29 29 29 0a 09 20 20 20 str ");")))..
18d0: 20 20 3b 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ;(debug:print
18e0: 34 20 22 71 72 79 3a 20 22 20 71 72 79 29 20 0a 4 "qry: " qry) .
18f0: 09 20 20 20 20 20 71 72 79 29 0a 09 20 20 20 71 . qry).. q
1900: 72 79 76 61 6c 73 29 0a 09 20 20 28 73 71 6c 69 ryvals).. (sqli
1910: 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 20 22 te3:execute db "
1920: 55 50 44 41 54 45 20 72 75 6e 73 20 53 45 54 20 UPDATE runs SET
1930: 73 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f state=?,status=?
1940: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 73 74 WHERE id=?;" st
1950: 61 74 65 20 73 74 61 74 75 73 20 72 65 73 29 0a ate status res).
1960: 09 20 20 72 65 73 29 20 0a 09 28 62 65 67 69 6e . res) ..(begin
1970: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
1980: 20 30 20 22 45 52 52 4f 52 3a 20 43 61 6c 6c 65 0 "ERROR: Calle
1990: 64 20 77 69 74 68 6f 75 74 20 61 6c 6c 20 6e 65 d without all ne
19a0: 63 65 73 73 61 72 79 20 6b 65 79 73 22 29 0a 09 cessary keys")..
19b0: 20 20 23 66 29 29 29 29 0a 0a 3b 3b 20 54 68 69 #f))))..;; Thi
19c0: 73 20 69 73 20 61 20 64 75 70 6c 69 63 61 74 65 s is a duplicate
19d0: 20 6f 66 20 72 75 6e 2d 74 65 73 74 73 20 28 77 of run-tests (w
19e0: 68 69 63 68 20 68 61 73 20 62 65 65 6e 20 64 65 hich has been de
19f0: 70 72 65 63 61 74 65 64 29 2e 20 55 73 65 20 74 precated). Use t
1a00: 68 69 73 20 6f 6e 65 20 69 6e 73 74 65 61 64 20 his one instead
1a10: 6f 66 20 72 75 6e 20 74 65 73 74 73 2e 0a 3b 3b of run tests..;;
1a20: 20 6b 65 79 76 61 6c 73 0a 28 64 65 66 69 6e 65 keyvals.(define
1a30: 20 28 72 75 6e 73 3a 72 75 6e 2d 74 65 73 74 73 (runs:run-tests
1a40: 20 64 62 20 74 61 72 67 65 74 20 72 75 6e 6e 61 db target runna
1a50: 6d 65 20 74 65 73 74 2d 70 61 74 74 73 20 75 73 me test-patts us
1a60: 65 72 20 66 6c 61 67 73 29 0a 20 20 28 6c 65 74 er flags). (let
1a70: 2a 20 28 28 6b 65 79 73 20 20 20 20 20 20 20 20 * ((keys
1a80: 28 72 64 62 3a 67 65 74 2d 6b 65 79 73 20 64 62 (rdb:get-keys db
1a90: 29 29 0a 09 20 28 6b 65 79 76 61 6c 6c 73 74 20 )).. (keyvallst
1aa0: 20 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e (keys:target->
1ab0: 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 keyval keys targ
1ac0: 65 74 29 29 0a 09 20 28 72 75 6e 2d 69 64 20 20 et)).. (run-id
1ad0: 20 20 20 20 28 72 75 6e 73 3a 72 65 67 69 73 74 (runs:regist
1ae0: 65 72 2d 72 75 6e 20 64 62 20 6b 65 79 73 20 6b er-run db keys k
1af0: 65 79 76 61 6c 6c 73 74 20 72 75 6e 6e 61 6d 65 eyvallst runname
1b00: 20 22 6e 65 77 22 20 22 6e 2f 61 22 20 75 73 65 "new" "n/a" use
1b10: 72 29 29 20 20 3b 3b 20 20 74 65 73 74 2d 6e 61 r)) ;; test-na
1b20: 6d 65 29 29 29 0a 09 20 28 64 65 66 65 72 72 65 me))).. (deferre
1b30: 64 20 20 20 20 27 28 29 29 20 3b 3b 20 64 65 6c d '()) ;; del
1b40: 61 79 20 72 75 6e 6e 69 6e 67 20 74 68 65 73 65 ay running these
1b50: 20 73 69 6e 63 65 20 74 68 65 79 20 68 61 76 65 since they have
1b60: 20 61 20 77 61 69 74 6f 6e 20 63 6c 61 75 73 65 a waiton clause
1b70: 0a 09 20 3b 3b 20 6b 65 65 70 67 6f 69 6e 67 20 .. ;; keepgoing
1b80: 69 73 20 74 68 65 20 64 65 66 61 63 74 6f 20 6d is the defacto m
1b90: 6f 64 61 6c 69 74 79 20 6e 6f 77 2c 20 77 69 6c odality now, wil
1ba0: 6c 20 61 64 64 20 68 69 74 2d 6e 2d 72 75 6e 20 l add hit-n-run
1bb0: 61 20 62 69 74 20 6c 61 74 65 72 0a 09 20 3b 3b a bit later.. ;;
1bc0: 20 28 6b 65 65 70 67 6f 69 6e 67 20 20 20 28 68 (keepgoing (h
1bd0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1be0: 66 61 75 6c 74 20 66 6c 61 67 73 20 22 2d 6b 65 fault flags "-ke
1bf0: 65 70 67 6f 69 6e 67 22 20 23 66 29 29 0a 09 20 epgoing" #f))..
1c00: 28 74 65 73 74 2d 6e 61 6d 65 73 20 20 27 28 29 (test-names '()
1c10: 29 0a 09 20 28 72 75 6e 63 6f 6e 66 69 67 66 20 ).. (runconfigf
1c20: 20 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 (conc *toppat
1c30: 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e h* "/runconfigs.
1c40: 63 6f 6e 66 69 67 22 29 29 0a 09 20 28 72 65 71 config")).. (req
1c50: 75 69 72 65 64 2d 74 65 73 74 73 20 27 28 29 29 uired-tests '())
1c60: 0a 09 20 28 74 65 73 74 2d 72 65 63 6f 72 64 73 .. (test-records
1c70: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
1c80: 65 29 29 29 0a 0a 20 20 20 20 28 73 65 74 2d 6d e))).. (set-m
1c90: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
1ca0: 20 64 62 20 72 75 6e 2d 69 64 29 20 3b 3b 20 74 db run-id) ;; t
1cb0: 68 65 73 65 20 6d 61 79 20 62 65 20 6e 65 65 64 hese may be need
1cc0: 65 64 20 62 79 20 74 68 65 20 6c 61 75 6e 63 68 ed by the launch
1cd0: 69 6e 67 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 ing process..
1ce0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
1cf0: 73 3f 20 72 75 6e 63 6f 6e 66 69 67 66 29 0a 09 s? runconfigf)..
1d00: 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 (setup-env-defau
1d10: 6c 74 73 20 64 62 20 72 75 6e 63 6f 6e 66 69 67 lts db runconfig
1d20: 66 20 72 75 6e 2d 69 64 20 2a 61 6c 72 65 61 64 f run-id *alread
1d30: 79 2d 73 65 65 6e 2d 72 75 6e 63 6f 6e 66 69 67 y-seen-runconfig
1d40: 2d 69 6e 66 6f 2a 20 22 70 72 65 2d 6c 61 75 6e -info* "pre-laun
1d50: 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 0a 09 28 ch-env-vars")..(
1d60: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
1d70: 41 52 4e 49 4e 47 3a 20 59 6f 75 20 64 6f 20 6e ARNING: You do n
1d80: 6f 74 20 68 61 76 65 20 61 20 72 75 6e 20 63 6f ot have a run co
1d90: 6e 66 69 67 20 66 69 6c 65 3a 20 22 20 72 75 6e nfig file: " run
1da0: 63 6f 6e 66 69 67 66 29 29 0a 20 20 20 20 0a 20 configf)). .
1db0: 20 20 20 3b 3b 20 6c 6f 6f 6b 20 75 70 20 61 6c ;; look up al
1dc0: 6c 20 74 65 73 74 73 20 6d 61 74 63 68 69 6e 67 l tests matching
1dd0: 20 74 68 65 20 63 6f 6d 6d 61 20 73 65 70 61 72 the comma separ
1de0: 61 74 65 64 20 6c 69 73 74 20 6f 66 20 67 6c 6f ated list of glo
1df0: 62 73 20 69 6e 0a 20 20 20 20 3b 3b 20 74 65 73 bs in. ;; tes
1e00: 74 2d 70 61 74 74 73 20 28 75 73 69 6e 67 20 25 t-patts (using %
1e10: 20 61 73 20 77 69 6c 64 63 61 72 64 29 0a 20 20 as wildcard).
1e20: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 (for-each .
1e30: 20 20 28 6c 61 6d 62 64 61 20 28 70 61 74 74 29 (lambda (patt)
1e40: 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 . (let ((t
1e50: 65 73 74 73 20 28 67 6c 6f 62 20 28 63 6f 6e 63 ests (glob (conc
1e60: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 74 65 73 *toppath* "/tes
1e70: 74 73 2f 22 20 28 73 74 72 69 6e 67 2d 74 72 61 ts/" (string-tra
1e80: 6e 73 6c 61 74 65 20 70 61 74 74 20 22 25 22 20 nslate patt "%"
1e90: 22 2a 22 29 29 29 29 29 0a 09 20 28 73 65 74 21 "*"))))).. (set!
1ea0: 20 74 65 73 74 73 20 28 66 69 6c 74 65 72 20 28 tests (filter (
1eb0: 6c 61 6d 62 64 61 20 28 74 65 73 74 29 28 66 69 lambda (test)(fi
1ec0: 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 le-exists? (conc
1ed0: 20 74 65 73 74 20 22 2f 74 65 73 74 63 6f 6e 66 test "/testconf
1ee0: 69 67 22 29 29 29 20 74 65 73 74 73 29 29 0a 09 ig"))) tests))..
1ef0: 20 28 73 65 74 21 20 74 65 73 74 2d 6e 61 6d 65 (set! test-name
1f00: 73 20 28 61 70 70 65 6e 64 20 74 65 73 74 2d 6e s (append test-n
1f10: 61 6d 65 73 20 0a 09 09 09 09 20 20 28 6d 61 70 ames ..... (map
1f20: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 70 29 (lambda (testp)
1f30: 0a 09 09 09 09 09 20 28 6c 61 73 74 20 28 73 74 ...... (last (st
1f40: 72 69 6e 67 2d 73 70 6c 69 74 20 74 65 73 74 70 ring-split testp
1f50: 20 22 2f 22 29 29 29 0a 09 09 09 09 20 20 20 20 "/"))).....
1f60: 20 20 20 74 65 73 74 73 29 29 29 29 29 0a 20 20 tests))))).
1f70: 20 20 20 28 69 66 20 74 65 73 74 2d 70 61 74 74 (if test-patt
1f80: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
1f90: 74 65 73 74 2d 70 61 74 74 73 20 22 2c 22 29 28 test-patts ",")(
1fa0: 6c 69 73 74 20 22 25 22 29 29 29 0a 0a 20 20 20 list "%")))..
1fb0: 20 20 3b 3b 20 6e 6f 77 20 72 65 6d 6f 76 65 20 ;; now remove
1fc0: 64 75 70 6c 69 63 61 74 65 73 0a 20 20 20 20 28 duplicates. (
1fd0: 73 65 74 21 20 74 65 73 74 2d 6e 61 6d 65 73 20 set! test-names
1fe0: 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 (delete-duplicat
1ff0: 65 73 20 74 65 73 74 2d 6e 61 6d 65 73 29 29 0a es test-names)).
2000: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
2010: 74 20 30 20 22 49 4e 46 4f 3a 20 74 65 73 74 20 t 0 "INFO: test
2020: 6e 61 6d 65 73 20 22 20 74 65 73 74 2d 6e 61 6d names " test-nam
2030: 65 73 29 0a 0a 20 20 20 20 3b 3b 20 6f 6e 20 74 es).. ;; on t
2040: 68 65 20 66 69 72 73 74 20 70 61 73 73 20 6f 72 he first pass or
2050: 20 63 61 6c 6c 20 74 6f 20 72 75 6e 2d 74 65 73 call to run-tes
2060: 74 73 20 73 65 74 20 46 41 49 4c 53 20 74 6f 20 ts set FAILS to
2070: 4e 4f 54 5f 53 54 41 52 54 45 44 20 69 66 0a 20 NOT_STARTED if.
2080: 20 20 20 3b 3b 20 2d 6b 65 65 70 67 6f 69 6e 67 ;; -keepgoing
2090: 20 69 73 20 73 70 65 63 69 66 69 65 64 0a 20 20 is specified.
20a0: 20 20 28 69 66 20 28 65 71 3f 20 2a 70 61 73 73 (if (eq? *pass
20b0: 6e 75 6d 2a 20 30 29 0a 09 28 62 65 67 69 6e 0a num* 0)..(begin.
20c0: 09 20 20 3b 3b 20 68 61 76 65 20 74 6f 20 64 65 . ;; have to de
20d0: 6c 65 74 65 20 74 65 73 74 20 72 65 63 6f 72 64 lete test record
20e0: 73 20 77 68 65 72 65 20 4e 4f 54 5f 53 54 41 52 s where NOT_STAR
20f0: 54 45 44 20 73 69 6e 63 65 20 74 68 65 79 20 63 TED since they c
2100: 61 6e 20 63 61 75 73 65 20 2d 6b 65 65 70 67 6f an cause -keepgo
2110: 69 6e 67 20 74 6f 20 0a 09 20 20 3b 3b 20 67 65 ing to .. ;; ge
2120: 74 20 73 74 75 63 6b 20 64 75 65 20 74 6f 20 62 t stuck due to b
2130: 65 63 6f 6d 69 6e 67 20 69 6e 61 63 63 65 73 73 ecoming inaccess
2140: 69 62 6c 65 20 66 72 6f 6d 20 61 20 66 61 69 6c ible from a fail
2150: 65 64 20 74 65 73 74 2e 20 49 2e 65 2e 20 69 66 ed test. I.e. if
2160: 20 74 65 73 74 20 42 20 64 65 70 65 6e 64 73 20 test B depends
2170: 0a 09 20 20 3b 3b 20 6f 6e 20 74 65 73 74 20 41 .. ;; on test A
2180: 20 62 75 74 20 74 65 73 74 20 42 20 72 65 61 63 but test B reac
2190: 68 65 64 20 74 68 65 20 70 6f 69 6e 74 20 6f 6e hed the point on
21a0: 20 62 65 69 6e 67 20 72 65 67 69 73 74 65 72 65 being registere
21b0: 64 20 61 73 20 4e 4f 54 5f 53 54 41 52 54 45 44 d as NOT_STARTED
21c0: 20 61 6e 64 20 74 65 73 74 0a 09 20 20 3b 3b 20 and test.. ;;
21d0: 41 20 66 61 69 6c 65 64 20 66 6f 72 20 73 6f 6d A failed for som
21e0: 65 20 72 65 61 73 6f 6e 20 74 68 65 6e 20 6f 6e e reason then on
21f0: 20 72 65 2d 72 75 6e 20 75 73 69 6e 67 20 2d 6b re-run using -k
2200: 65 65 70 67 6f 69 6e 67 20 74 68 65 20 72 75 6e eepgoing the run
2210: 20 63 61 6e 20 6e 65 76 65 72 20 63 6f 6d 70 6c can never compl
2220: 65 74 65 2e 0a 09 20 20 28 64 62 3a 64 65 6c 65 ete... (db:dele
2230: 74 65 2d 74 65 73 74 73 2d 69 6e 2d 73 74 61 74 te-tests-in-stat
2240: 65 20 64 62 20 72 75 6e 2d 69 64 20 22 4e 4f 54 e db run-id "NOT
2250: 5f 53 54 41 52 54 45 44 22 29 0a 09 20 20 28 72 _STARTED").. (r
2260: 64 62 3a 73 65 74 2d 74 65 73 74 73 2d 73 74 61 db:set-tests-sta
2270: 74 65 2d 73 74 61 74 75 73 20 64 62 20 72 75 6e te-status db run
2280: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 73 20 23 -id test-names #
2290: 66 20 22 46 41 49 4c 22 20 22 4e 4f 54 5f 53 54 f "FAIL" "NOT_ST
22a0: 41 52 54 45 44 22 20 22 46 41 49 4c 22 29 29 29 ARTED" "FAIL")))
22b0: 0a 0a 20 20 20 20 3b 3b 20 66 72 6f 6d 20 68 65 .. ;; from he
22c0: 72 65 20 6f 6e 20 6f 75 74 20 74 68 65 20 64 62 re on out the db
22d0: 20 77 69 6c 6c 20 62 65 20 6f 70 65 6e 65 64 20 will be opened
22e0: 61 6e 64 20 63 6c 6f 73 65 64 20 6f 6e 20 65 76 and closed on ev
22f0: 65 72 79 20 63 61 6c 6c 20 72 75 6e 73 3a 72 75 ery call runs:ru
2300: 6e 2d 74 65 73 74 73 2d 71 75 65 75 65 0a 20 20 n-tests-queue.
2310: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
2320: 69 7a 65 21 20 64 62 29 20 0a 20 20 20 20 3b 3b ize! db) . ;;
2330: 20 6e 6f 77 20 61 64 64 20 6e 6f 6e 2d 64 69 72 now add non-dir
2340: 65 63 74 6c 79 20 72 65 66 65 72 65 6e 63 65 64 ectly referenced
2350: 20 64 65 70 65 6e 64 65 6e 63 69 65 73 20 28 69 dependencies (i
2360: 2e 65 2e 20 77 61 69 74 6f 6e 29 0a 20 20 20 20 .e. waiton).
2370: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
2380: 74 65 73 74 2d 6e 61 6d 65 73 29 29 0a 09 28 6c test-names))..(l
2390: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
23a0: 61 72 20 74 65 73 74 2d 6e 61 6d 65 73 29 29 0a ar test-names)).
23b0: 09 09 20 20 20 28 74 61 6c 20 28 63 64 72 20 74 .. (tal (cdr t
23c0: 65 73 74 2d 6e 61 6d 65 73 29 29 29 20 20 20 20 est-names)))
23d0: 20 20 20 20 20 3b 3b 20 27 72 65 74 75 72 6e 2d ;; 'return-
23e0: 70 72 6f 63 73 20 74 65 6c 6c 73 20 74 68 65 20 procs tells the
23f0: 63 6f 6e 66 69 67 20 72 65 61 64 65 72 20 74 6f config reader to
2400: 20 70 72 65 70 20 72 75 6e 6e 69 6e 67 20 73 79 prep running sy
2410: 73 74 65 6d 20 62 75 74 20 72 65 74 75 72 6e 20 stem but return
2420: 61 20 70 72 6f 63 0a 09 20 20 28 64 65 62 75 67 a proc.. (debug
2430: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
2440: 68 65 64 3d 22 20 68 65 64 20 22 20 61 74 20 74 hed=" hed " at t
2450: 6f 70 20 6f 66 20 6c 6f 6f 70 22 29 0a 09 20 20 op of loop")..
2460: 28 6c 65 74 2a 20 28 28 63 6f 6e 66 69 67 20 20 (let* ((config
2470: 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 (tests:get-testc
2480: 6f 6e 66 69 67 20 68 65 64 20 27 72 65 74 75 72 onfig hed 'retur
2490: 6e 2d 70 72 6f 63 73 29 29 0a 09 09 20 28 77 61 n-procs))... (wa
24a0: 69 74 6f 6e 73 20 28 69 66 20 63 6f 6e 66 69 67 itons (if config
24b0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 28 (string-split (
24c0: 6c 65 74 20 28 28 77 20 28 63 6f 6e 66 69 67 2d let ((w (config-
24d0: 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 20 22 72 lookup config "r
24e0: 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 77 61 equirements" "wa
24f0: 69 74 6f 6e 22 29 29 29 0a 09 09 09 09 09 09 20 iton"))).......
2500: 20 20 20 20 28 69 66 20 77 20 77 20 22 22 29 29 (if w w ""))
2510: 29 0a 09 09 09 20 20 20 20 20 20 28 62 65 67 69 ).... (begi
2520: 6e 0a 09 09 09 09 28 64 65 62 75 67 3a 70 72 69 n.....(debug:pri
2530: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 6e 6f 6e nt 0 "ERROR: non
2540: 2d 65 78 69 73 74 65 6e 74 20 72 65 71 75 69 72 -existent requir
2550: 65 64 20 74 65 73 74 20 5c 22 22 20 68 65 64 20 ed test \"" hed
2560: 22 5c 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 "\"").
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
2590: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 inalize! db)....
25a0: 09 28 65 78 69 74 20 31 29 29 29 29 29 0a 09 20 .(exit 1)))))..
25b0: 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 20 ;; check for
25c0: 68 65 64 20 69 6e 20 77 61 69 74 6f 6e 73 20 3d hed in waitons =
25d0: 3e 20 74 68 69 73 20 77 6f 75 6c 64 20 62 65 20 > this would be
25e0: 63 69 72 63 75 6c 61 72 2c 20 72 65 6d 6f 76 65 circular, remove
25f0: 20 69 74 20 61 6e 64 20 69 73 73 75 65 20 61 6e it and issue an
2600: 0a 09 20 20 20 20 3b 3b 20 65 72 72 6f 72 0a 09 .. ;; error..
2610: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
2620: 68 65 64 20 77 61 69 74 6f 6e 73 29 0a 09 09 28 hed waitons)...(
2630: 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug
2640: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
2650: 20 74 65 73 74 20 22 20 68 65 64 20 22 20 68 61 test " hed " ha
2660: 73 20 6c 69 73 74 65 64 20 69 74 73 65 6c 66 20 s listed itself
2670: 61 73 20 61 20 77 61 69 74 6f 6e 2c 20 70 6c 65 as a waiton, ple
2680: 61 73 65 20 63 6f 72 72 65 63 74 20 74 68 69 73 ase correct this
2690: 21 22 29 0a 09 09 20 20 28 73 65 74 21 20 77 61 !")... (set! wa
26a0: 69 74 6f 6e 73 20 28 66 69 6c 74 65 72 20 28 6c itons (filter (l
26b0: 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 28 65 ambda (x)(not (e
26c0: 71 75 61 6c 3f 20 78 20 68 65 64 29 29 29 20 77 qual? x hed))) w
26d0: 61 69 74 6f 6e 73 29 29 29 29 0a 09 20 20 20 20 aitons))))..
26e0: 0a 09 20 20 20 20 3b 3b 20 28 69 74 65 6d 73 20 .. ;; (items
26f0: 20 20 28 69 74 65 6d 73 3a 67 65 74 2d 69 74 65 (items:get-ite
2700: 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 20 63 ms-from-config c
2710: 6f 6e 66 69 67 29 29 29 0a 09 20 20 20 20 28 69 onfig))).. (i
2720: 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 f (not (hash-tab
2730: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
2740: 65 73 74 2d 72 65 63 6f 72 64 73 20 68 65 64 20 est-records hed
2750: 23 66 29 29 0a 09 09 28 68 61 73 68 2d 74 61 62 #f))...(hash-tab
2760: 6c 65 2d 73 65 74 21 20 74 65 73 74 2d 72 65 63 le-set! test-rec
2770: 6f 72 64 73 0a 09 09 09 09 20 68 65 64 20 28 76 ords..... hed (v
2780: 65 63 74 6f 72 20 68 65 64 20 20 20 20 20 3b 3b ector hed ;;
2790: 20 30 0a 09 09 09 09 09 20 20 20 20 20 63 6f 6e 0...... con
27a0: 66 69 67 20 20 3b 3b 20 31 0a 09 09 09 09 09 20 fig ;; 1......
27b0: 20 20 20 20 77 61 69 74 6f 6e 73 20 3b 3b 20 32 waitons ;; 2
27c0: 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e 66 ...... (conf
27d0: 69 67 2d 6c 6f 6f 6b 75 70 20 63 6f 6e 66 69 67 ig-lookup config
27e0: 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 "requirements"
27f0: 22 70 72 69 6f 72 69 74 79 22 29 20 20 20 20 20 "priority")
2800: 3b 3b 20 70 72 69 6f 72 69 74 79 20 33 0a 09 09 ;; priority 3...
2810: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 69 ... (let ((i
2820: 74 65 6d 73 20 20 20 20 20 20 28 68 61 73 68 2d tems (hash-
2830: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
2840: 74 20 63 6f 6e 66 69 67 20 22 69 74 65 6d 73 22 t config "items"
2850: 20 23 66 29 29 20 3b 3b 20 69 74 65 6d 73 20 34 #f)) ;; items 4
2860: 0a 09 09 09 09 09 09 20 20 20 28 69 74 65 6d 73 ....... (items
2870: 74 61 62 6c 65 20 28 68 61 73 68 2d 74 61 62 6c table (hash-tabl
2880: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f e-ref/default co
2890: 6e 66 69 67 20 22 69 74 65 6d 73 74 61 62 6c 65 nfig "itemstable
28a0: 22 20 23 66 29 29 29 20 0a 09 09 09 09 09 20 20 " #f))) ......
28b0: 20 20 20 20 20 3b 3b 20 69 66 20 65 69 74 68 65 ;; if eithe
28c0: 72 20 69 74 65 6d 73 20 6f 72 20 69 74 65 6d 73 r items or items
28d0: 20 74 61 62 6c 65 20 69 73 20 61 20 70 72 6f 63 table is a proc
28e0: 20 72 65 74 75 72 6e 20 69 74 20 73 6f 20 74 65 return it so te
28f0: 73 74 20 72 75 6e 6e 69 6e 67 0a 09 09 09 09 09 st running......
2900: 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 73 ;; proces
2910: 73 20 63 61 6e 20 6b 6e 6f 77 20 74 6f 20 63 61 s can know to ca
2920: 6c 6c 20 69 74 65 6d 73 3a 67 65 74 2d 69 74 65 ll items:get-ite
2930: 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 0a 09 ms-from-config..
2940: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 .... ;; if
2950: 20 65 69 74 68 65 72 20 69 73 20 61 20 6c 69 73 either is a lis
2960: 74 20 61 6e 64 20 6e 6f 6e 65 20 69 73 20 61 20 t and none is a
2970: 70 72 6f 63 20 67 6f 20 61 68 65 61 64 20 61 6e proc go ahead an
2980: 64 20 63 61 6c 6c 20 67 65 74 2d 69 74 65 6d 73 d call get-items
2990: 0a 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 ...... ;;
29a0: 6f 74 68 65 72 77 69 73 65 20 72 65 74 75 72 6e otherwise return
29b0: 20 23 66 20 2d 20 74 68 69 73 20 69 73 20 6e 6f #f - this is no
29c0: 74 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 t an iterated te
29d0: 73 74 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 st...... (
29e0: 63 6f 6e 64 0a 09 09 09 09 09 09 28 28 70 72 6f cond.......((pro
29f0: 63 65 64 75 72 65 3f 20 69 74 65 6d 73 29 20 20 cedure? items)
2a00: 20 20 20 20 0a 09 09 09 09 09 09 20 28 64 65 62 ....... (deb
2a10: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
2a20: 3a 20 69 74 65 6d 73 20 69 73 20 61 20 70 72 6f : items is a pro
2a30: 63 65 64 75 72 65 2c 20 77 69 6c 6c 20 63 61 6c cedure, will cal
2a40: 63 20 6c 61 74 65 72 22 29 0a 09 09 09 09 09 09 c later").......
2a50: 20 69 74 65 6d 73 29 20 20 20 20 20 20 20 20 20 items)
2a60: 20 20 20 3b 3b 20 63 61 6c 63 20 6c 61 74 65 72 ;; calc later
2a70: 0a 09 09 09 09 09 09 28 28 70 72 6f 63 65 64 75 .......((procedu
2a80: 72 65 3f 20 69 74 65 6d 73 74 61 62 6c 65 29 0a re? itemstable).
2a90: 09 09 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 ...... (debug:pr
2aa0: 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 69 74 65 int 4 "INFO: ite
2ab0: 6d 73 74 61 62 6c 65 20 69 73 20 61 20 70 72 6f mstable is a pro
2ac0: 63 65 64 75 72 65 2c 20 77 69 6c 6c 20 63 61 6c cedure, will cal
2ad0: 63 20 6c 61 74 65 72 22 29 0a 09 09 09 09 09 09 c later").......
2ae0: 20 69 74 65 6d 73 74 61 62 6c 65 29 20 20 20 20 itemstable)
2af0: 20 20 20 3b 3b 20 63 61 6c 63 20 6c 61 74 65 72 ;; calc later
2b00: 0a 09 09 09 09 09 09 28 28 66 69 6c 74 65 72 20 .......((filter
2b10: 28 6c 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 (lambda (x).....
2b20: 09 09 09 20 20 20 28 6c 65 74 20 28 28 76 61 6c ... (let ((val
2b30: 20 28 63 61 72 20 78 29 29 29 0a 09 09 09 09 09 (car x)))......
2b40: 09 09 20 20 20 20 20 28 69 66 20 28 70 72 6f 63 .. (if (proc
2b50: 65 64 75 72 65 3f 20 76 61 6c 29 20 76 61 6c 20 edure? val) val
2b60: 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 28 61 #f)))........ (a
2b70: 70 70 65 6e 64 20 28 69 66 20 28 6c 69 73 74 3f ppend (if (list?
2b80: 20 69 74 65 6d 73 29 20 69 74 65 6d 73 20 27 28 items) items '(
2b90: 29 29 0a 09 09 09 09 09 09 09 09 20 28 69 66 20 ))......... (if
2ba0: 28 6c 69 73 74 3f 20 69 74 65 6d 73 74 61 62 6c (list? itemstabl
2bb0: 65 29 20 69 74 65 6d 73 74 61 62 6c 65 20 27 28 e) itemstable '(
2bc0: 29 29 29 29 0a 09 09 09 09 09 09 20 27 68 61 76 ))))....... 'hav
2bd0: 65 2d 70 72 6f 63 65 64 75 72 65 29 0a 09 09 09 e-procedure)....
2be0: 09 09 09 28 28 6f 72 20 28 6c 69 73 74 3f 20 69 ...((or (list? i
2bf0: 74 65 6d 73 29 28 6c 69 73 74 3f 20 69 74 65 6d tems)(list? item
2c00: 73 74 61 62 6c 65 29 29 20 3b 3b 20 63 61 6c 63 stable)) ;; calc
2c10: 20 6e 6f 77 0a 09 09 09 09 09 09 20 28 64 65 62 now....... (deb
2c20: 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f ug:print 4 "INFO
2c30: 3a 20 69 74 65 6d 73 20 61 6e 64 20 69 74 65 6d : items and item
2c40: 73 74 61 62 6c 65 20 61 72 65 20 6c 69 73 74 73 stable are lists
2c50: 2c 20 63 61 6c 63 20 6e 6f 77 5c 6e 22 0a 09 09 , calc now\n"...
2c60: 09 09 09 09 09 20 20 20 20 20 20 22 20 20 20 20 ..... "
2c70: 69 74 65 6d 73 3a 20 22 20 69 74 65 6d 73 20 22 items: " items "
2c80: 20 69 74 65 6d 73 74 61 62 6c 65 3a 20 22 20 69 itemstable: " i
2c90: 74 65 6d 73 74 61 62 6c 65 29 0a 09 09 09 09 09 temstable)......
2ca0: 09 20 28 69 74 65 6d 73 3a 67 65 74 2d 69 74 65 . (items:get-ite
2cb0: 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 20 63 ms-from-config c
2cc0: 6f 6e 66 69 67 29 29 0a 09 09 09 09 09 09 28 65 onfig)).......(e
2cd0: 6c 73 65 20 23 66 29 29 29 20 20 20 20 20 20 20 lse #f)))
2ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cf0: 20 20 20 20 3b 3b 20 6e 6f 74 20 69 74 65 72 61 ;; not itera
2d00: 74 65 64 0a 09 09 09 09 09 20 20 20 20 20 23 66 ted...... #f
2d10: 20 20 20 20 20 20 3b 3b 20 69 74 65 6d 73 64 61 ;; itemsda
2d20: 74 20 35 0a 09 09 09 09 09 20 20 20 20 20 23 66 t 5...... #f
2d30: 20 20 20 20 20 20 3b 3b 20 73 70 61 72 65 20 2d ;; spare -
2d40: 20 75 73 65 64 20 66 6f 72 20 69 74 65 6d 2d 70 used for item-p
2d50: 61 74 68 0a 09 09 09 09 09 20 20 20 20 20 29 29 ath...... ))
2d60: 29 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ).. (for-each
2d70: 20 0a 09 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
2d80: 28 77 61 69 74 6f 6e 29 0a 09 20 20 20 20 20 20 (waiton)..
2d90: 20 28 69 66 20 28 61 6e 64 20 77 61 69 74 6f 6e (if (and waiton
2da0: 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 77 61 (not (member wa
2db0: 69 74 6f 6e 20 74 65 73 74 2d 6e 61 6d 65 73 29 iton test-names)
2dc0: 29 29 0a 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ))... (begin..
2dd0: 09 20 20 20 20 20 28 73 65 74 21 20 72 65 71 75 . (set! requ
2de0: 69 72 65 64 2d 74 65 73 74 73 20 28 63 6f 6e 73 ired-tests (cons
2df0: 20 77 61 69 74 6f 6e 20 72 65 71 75 69 72 65 64 waiton required
2e00: 2d 74 65 73 74 73 29 29 0a 09 09 20 20 20 20 20 -tests))...
2e10: 28 73 65 74 21 20 74 65 73 74 2d 6e 61 6d 65 73 (set! test-names
2e20: 20 28 63 6f 6e 73 20 77 61 69 74 6f 6e 20 74 65 (cons waiton te
2e30: 73 74 2d 6e 61 6d 65 73 29 29 29 29 29 20 3b 3b st-names))))) ;;
2e40: 20 77 61 73 20 61 6e 20 61 70 70 65 6e 64 2c 20 was an append,
2e50: 6e 6f 77 20 61 20 63 6f 6e 73 0a 09 20 20 20 20 now a cons..
2e60: 20 77 61 69 74 6f 6e 73 29 0a 09 20 20 20 20 28 waitons).. (
2e70: 6c 65 74 20 28 28 72 65 6d 74 65 73 74 73 20 28 let ((remtests (
2e80: 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 delete-duplicate
2e90: 73 20 28 61 70 70 65 6e 64 20 77 61 69 74 6f 6e s (append waiton
2ea0: 73 20 74 61 6c 29 29 29 29 0a 09 20 20 20 20 20 s tal))))..
2eb0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
2ec0: 20 72 65 6d 74 65 73 74 73 29 29 0a 09 09 20 20 remtests))...
2ed0: 28 6c 6f 6f 70 20 28 63 61 72 20 72 65 6d 74 65 (loop (car remte
2ee0: 73 74 73 29 28 63 64 72 20 72 65 6d 74 65 73 74 sts)(cdr remtest
2ef0: 73 29 29 29 29 29 29 29 0a 0a 20 20 20 20 28 69 s))))))).. (i
2f00: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 65 f (not (null? re
2f10: 71 75 69 72 65 64 2d 74 65 73 74 73 29 29 0a 09 quired-tests))..
2f20: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
2f30: 49 4e 46 4f 3a 20 41 64 64 69 6e 67 20 22 20 72 INFO: Adding " r
2f40: 65 71 75 69 72 65 64 2d 74 65 73 74 73 20 22 20 equired-tests "
2f50: 74 6f 20 74 68 65 20 72 75 6e 20 71 75 65 75 65 to the run queue
2f60: 22 29 29 0a 20 20 20 20 3b 3b 20 4e 4f 54 45 3a ")). ;; NOTE:
2f70: 20 74 68 65 73 65 20 61 72 65 20 61 6c 6c 20 70 these are all p
2f80: 61 72 65 6e 74 20 74 65 73 74 73 2c 20 69 74 65 arent tests, ite
2f90: 6d 73 20 61 72 65 20 6e 6f 74 20 65 78 70 61 6e ms are not expan
2fa0: 64 65 64 20 79 65 74 2e 0a 20 20 20 20 28 64 65 ded yet.. (de
2fb0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 bug:print 4 "INF
2fc0: 4f 3a 20 74 65 73 74 2d 72 65 63 6f 72 64 73 3d O: test-records=
2fd0: 22 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 " (hash-table->a
2fe0: 6c 69 73 74 20 74 65 73 74 2d 72 65 63 6f 72 64 list test-record
2ff0: 73 29 29 0a 20 20 20 20 28 72 75 6e 73 3a 72 75 s)). (runs:ru
3000: 6e 2d 74 65 73 74 73 2d 71 75 65 75 65 20 72 75 n-tests-queue ru
3010: 6e 2d 69 64 20 72 75 6e 6e 61 6d 65 20 74 65 73 n-id runname tes
3020: 74 2d 72 65 63 6f 72 64 73 20 6b 65 79 76 61 6c t-records keyval
3030: 6c 73 74 20 66 6c 61 67 73 29 0a 20 20 20 20 28 lst flags). (
3040: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 49 debug:print 1 "I
3050: 4e 46 4f 3a 20 72 75 6e 6e 69 6e 67 20 71 75 65 NFO: running que
3060: 75 65 20 6f 6e 65 20 6d 6f 72 65 20 74 69 6d 65 ue one more time
3070: 20 74 6f 20 63 61 74 63 68 20 61 6e 79 20 63 68 to catch any ch
3080: 61 6e 67 65 64 20 74 65 73 74 20 73 74 61 74 65 anged test state
3090: 73 22 29 0a 20 20 20 20 28 72 75 6e 73 3a 72 75 s"). (runs:ru
30a0: 6e 2d 74 65 73 74 73 2d 71 75 65 75 65 20 72 75 n-tests-queue ru
30b0: 6e 2d 69 64 20 72 75 6e 6e 61 6d 65 20 74 65 73 n-id runname tes
30c0: 74 2d 72 65 63 6f 72 64 73 20 6b 65 79 76 61 6c t-records keyval
30d0: 6c 73 74 20 66 6c 61 67 73 29 0a 20 20 20 20 28 lst flags). (
30e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 debug:print 4 "I
30f0: 4e 46 4f 3a 20 41 6c 6c 20 64 6f 6e 65 20 62 79 NFO: All done by
3100: 20 68 65 72 65 22 29 29 29 0a 0a 3b 3b 20 74 65 here")))..;; te
3110: 73 74 2d 72 65 63 6f 72 64 73 20 69 73 20 61 20 st-records is a
3120: 68 61 73 68 20 74 61 62 6c 65 20 74 65 73 74 6e hash table testn
3130: 61 6d 65 3a 69 74 65 6d 5f 70 61 74 68 20 3d 3e ame:item_path =>
3140: 20 76 65 63 74 6f 72 20 3c 20 74 65 73 74 6e 61 vector < testna
3150: 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 20 77 61 me testconfig wa
3160: 69 74 6f 6e 73 20 70 72 69 6f 72 69 74 79 20 69 itons priority i
3170: 74 65 6d 73 2d 69 6e 66 6f 20 2e 2e 2e 20 3e 0a tems-info ... >.
3180: 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a 72 75 (define (runs:ru
3190: 6e 2d 74 65 73 74 73 2d 71 75 65 75 65 20 72 75 n-tests-queue ru
31a0: 6e 2d 69 64 20 72 75 6e 6e 61 6d 65 20 74 65 73 n-id runname tes
31b0: 74 2d 72 65 63 6f 72 64 73 20 6b 65 79 76 61 6c t-records keyval
31c0: 6c 73 74 20 66 6c 61 67 73 29 0a 20 20 20 20 3b lst flags). ;
31d0: 3b 20 41 74 20 74 68 69 73 20 70 6f 69 6e 74 20 ; At this point
31e0: 74 68 65 20 6c 69 73 74 20 6f 66 20 70 61 72 65 the list of pare
31f0: 6e 74 20 74 65 73 74 73 20 69 73 20 65 78 70 61 nt tests is expa
3200: 6e 64 65 64 20 0a 20 20 20 20 3b 3b 20 4e 42 2f nded . ;; NB/
3210: 2f 20 53 68 6f 75 6c 64 20 65 78 70 61 6e 64 20 / Should expand
3220: 69 74 65 6d 73 20 68 65 72 65 20 61 6e 64 20 74 items here and t
3230: 68 65 6e 20 69 6e 73 65 72 74 20 69 6e 74 6f 20 hen insert into
3240: 74 68 65 20 72 75 6e 20 71 75 65 75 65 2e 0a 20 the run queue..
3250: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 35 20 (debug:print 5
3260: 22 74 65 73 74 2d 72 65 63 6f 72 64 73 3a 20 22 "test-records: "
3270: 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 22 2c test-records ",
3280: 20 6b 65 79 76 61 6c 6c 73 74 3a 20 22 20 6b 65 keyvallst: " ke
3290: 79 76 61 6c 6c 73 74 20 22 20 66 6c 61 67 73 3a yvallst " flags:
32a0: 20 22 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e " (hash-table->
32b0: 61 6c 69 73 74 20 66 6c 61 67 73 29 29 0a 20 20 alist flags)).
32c0: 28 6c 65 74 20 28 28 73 6f 72 74 65 64 2d 74 65 (let ((sorted-te
32d0: 73 74 2d 6e 61 6d 65 73 20 28 74 65 73 74 73 3a st-names (tests:
32e0: 73 6f 72 74 2d 62 79 2d 70 72 69 6f 72 69 74 79 sort-by-priority
32f0: 2d 61 6e 64 2d 77 61 69 74 6f 6e 20 74 65 73 74 -and-waiton test
3300: 2d 72 65 63 6f 72 64 73 29 29 0a 09 28 69 74 65 -records))..(ite
3310: 6d 2d 70 61 74 74 73 20 20 20 20 20 20 20 20 28 m-patts (
3320: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3330: 65 66 61 75 6c 74 20 66 6c 61 67 73 20 22 2d 69 efault flags "-i
3340: 74 65 6d 70 61 74 74 22 20 23 66 29 29 0a 09 28 tempatt" #f))..(
3350: 74 65 73 74 2d 72 65 67 69 73 74 65 72 79 20 20 test-registery
3360: 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 (make-hash-tab
3370: 6c 65 29 29 0a 09 28 6e 75 6d 2d 72 65 74 72 69 le))..(num-retri
3380: 65 73 20 20 20 20 20 20 20 20 30 29 0a 09 28 6d es 0)..(m
3390: 61 78 2d 72 65 74 72 69 65 73 20 20 20 20 20 20 ax-retries
33a0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
33b0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
33c0: 75 70 22 20 22 6d 61 78 72 65 74 72 69 65 73 22 up" "maxretries"
33d0: 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 6d 61 ))). (set! ma
33e0: 78 2d 72 65 74 72 69 65 73 20 28 69 66 20 28 61 x-retries (if (a
33f0: 6e 64 20 6d 61 78 2d 72 65 74 72 69 65 73 20 28 nd max-retries (
3400: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6d string->number m
3410: 61 78 2d 72 65 74 72 69 65 73 29 29 28 73 74 72 ax-retries))(str
3420: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 6d 61 78 2d ing->number max-
3430: 72 65 74 72 69 65 73 29 20 31 30 30 29 29 0a 20 retries) 100)).
3440: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c (if (not (nul
3450: 6c 3f 20 73 6f 72 74 65 64 2d 74 65 73 74 2d 6e l? sorted-test-n
3460: 61 6d 65 73 29 29 0a 09 28 6c 65 74 20 6c 6f 6f ames))..(let loo
3470: 70 20 28 28 68 65 64 20 20 20 20 20 20 20 20 20 p ((hed
3480: 28 63 61 72 20 73 6f 72 74 65 64 2d 74 65 73 74 (car sorted-test
3490: 2d 6e 61 6d 65 73 29 29 0a 09 09 20 20 20 28 74 -names))... (t
34a0: 61 6c 20 20 20 20 20 20 20 20 20 28 63 64 72 20 al (cdr
34b0: 73 6f 72 74 65 64 2d 74 65 73 74 2d 6e 61 6d 65 sorted-test-name
34c0: 73 29 29 0a 09 09 20 20 20 28 72 65 72 75 6e 73 s))... (reruns
34d0: 20 20 20 20 20 20 27 28 29 29 29 0a 09 20 20 28 '())).. (
34e0: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 72 if (not (null? r
34f0: 65 72 75 6e 73 29 29 28 64 65 62 75 67 3a 70 72 eruns))(debug:pr
3500: 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 72 65 72 int 4 "INFO: rer
3510: 75 6e 73 3d 22 20 72 65 72 75 6e 73 29 29 0a 09 uns=" reruns))..
3520: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 72 (let* ((test-r
3530: 65 63 6f 72 64 20 28 68 61 73 68 2d 74 61 62 6c ecord (hash-tabl
3540: 65 2d 72 65 66 20 74 65 73 74 2d 72 65 63 6f 72 e-ref test-recor
3550: 64 73 20 68 65 64 29 29 0a 09 09 20 28 74 65 73 ds hed))... (tes
3560: 74 2d 6e 61 6d 65 20 20 20 28 74 65 73 74 73 3a t-name (tests:
3570: 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 65 testqueue-get-te
3580: 73 74 6e 61 6d 65 20 74 65 73 74 2d 72 65 63 6f stname test-reco
3590: 72 64 29 29 0a 09 09 20 28 74 63 6f 6e 66 69 67 rd))... (tconfig
35a0: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
35b0: 71 75 65 75 65 2d 67 65 74 2d 74 65 73 74 63 6f queue-get-testco
35c0: 6e 66 69 67 20 74 65 73 74 2d 72 65 63 6f 72 64 nfig test-record
35d0: 29 29 0a 09 09 20 28 74 65 73 74 6d 6f 64 65 20 ))... (testmode
35e0: 20 20 20 28 6c 65 74 20 28 28 6d 20 28 63 6f 6e (let ((m (con
35f0: 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 fig-lookup tconf
3600: 69 67 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 ig "requirements
3610: 22 20 22 6d 6f 64 65 22 29 29 29 0a 09 09 09 09 " "mode"))).....
3620: 28 69 66 20 6d 20 28 73 74 72 69 6e 67 2d 3e 73 (if m (string->s
3630: 79 6d 62 6f 6c 20 6d 29 20 27 6e 6f 72 6d 61 6c ymbol m) 'normal
3640: 29 29 29 0a 09 09 20 28 77 61 69 74 6f 6e 73 20 )))... (waitons
3650: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 71 (tests:testq
3660: 75 65 75 65 2d 67 65 74 2d 77 61 69 74 6f 6e 73 ueue-get-waitons
3670: 20 20 20 20 74 65 73 74 2d 72 65 63 6f 72 64 29 test-record)
3680: 29 0a 09 09 20 28 70 72 69 6f 72 69 74 79 20 20 )... (priority
3690: 20 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 (tests:testque
36a0: 75 65 2d 67 65 74 2d 70 72 69 6f 72 69 74 79 20 ue-get-priority
36b0: 20 20 74 65 73 74 2d 72 65 63 6f 72 64 29 29 0a test-record)).
36c0: 09 09 20 28 69 74 65 6d 64 61 74 20 20 20 20 20 .. (itemdat
36d0: 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 (tests:testqueue
36e0: 2d 67 65 74 2d 69 74 65 6d 64 61 74 20 20 20 20 -get-itemdat
36f0: 74 65 73 74 2d 72 65 63 6f 72 64 29 29 20 3b 3b test-record)) ;;
3700: 20 69 74 65 6d 64 61 74 20 63 61 6e 20 62 65 20 itemdat can be
3710: 61 20 73 74 72 69 6e 67 2c 20 6c 69 73 74 20 6f a string, list o
3720: 72 20 23 66 0a 09 09 20 28 69 74 65 6d 73 20 20 r #f... (items
3730: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
3740: 71 75 65 75 65 2d 67 65 74 2d 69 74 65 6d 73 20 queue-get-items
3750: 20 20 20 20 20 74 65 73 74 2d 72 65 63 6f 72 64 test-record
3760: 29 29 0a 09 09 20 28 69 74 65 6d 2d 70 61 74 68 ))... (item-path
3770: 20 20 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 (item-list->p
3780: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 ath itemdat))...
3790: 20 28 6e 65 77 74 61 6c 20 20 20 20 20 20 28 61 (newtal (a
37a0: 70 70 65 6e 64 20 74 61 6c 20 28 6c 69 73 74 20 ppend tal (list
37b0: 68 65 64 29 29 29 0a 09 09 20 28 63 61 6c 63 2d hed)))... (calc-
37c0: 66 61 69 6c 73 20 20 28 6c 61 6d 62 64 61 20 28 fails (lambda (
37d0: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 prereqs-not-met)
37e0: 0a 09 09 09 09 28 66 69 6c 74 65 72 20 28 6c 61 .....(filter (la
37f0: 6d 62 64 61 20 28 74 65 73 74 29 0a 09 09 09 09 mbda (test).....
3800: 09 20 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f . (and (vector?
3810: 20 74 65 73 74 29 20 3b 3b 20 6e 6f 74 20 28 73 test) ;; not (s
3820: 74 72 69 6e 67 3f 20 74 65 73 74 29 29 0a 09 09 tring? test))...
3830: 09 09 09 20 20 20 20 20 20 20 28 65 71 75 61 6c ... (equal
3840: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
3850: 74 61 74 65 20 74 65 73 74 29 20 22 43 4f 4d 50 tate test) "COMP
3860: 4c 45 54 45 44 22 29 0a 09 09 09 09 09 20 20 20 LETED")......
3870: 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 65 72 (not (member
3880: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
3890: 61 74 75 73 20 74 65 73 74 29 0a 09 09 09 09 09 atus test)......
38a0: 09 09 20 20 20 20 27 28 22 50 41 53 53 22 20 22 .. '("PASS" "
38b0: 57 41 52 4e 22 20 22 43 48 45 43 4b 22 20 22 57 WARN" "CHECK" "W
38c0: 41 49 56 45 44 22 29 29 29 29 29 0a 09 09 09 09 AIVED"))))).....
38d0: 09 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 .prereqs-not-met
38e0: 29 29 29 0a 09 09 20 28 63 61 6c 63 2d 6e 6f 74 )))... (calc-not
38f0: 2d 63 6f 6d 70 6c 65 74 65 64 20 28 6c 61 6d 62 -completed (lamb
3900: 64 61 20 28 70 72 65 72 65 71 73 2d 6e 6f 74 2d da (prereqs-not-
3910: 6d 65 74 29 0a 09 09 09 09 20 20 20 20 20 20 20 met).....
3920: 28 66 69 6c 74 65 72 0a 09 09 09 09 09 28 6c 61 (filter......(la
3930: 6d 62 64 61 20 28 74 29 0a 09 09 09 09 09 20 20 mbda (t)......
3940: 28 6f 72 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 (or (not (vector
3950: 3f 20 74 29 29 0a 09 09 09 09 09 20 20 20 20 20 ? t))......
3960: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 22 43 (not (equal? "C
3970: 4f 4d 50 4c 45 54 45 44 22 20 28 64 62 3a 74 65 OMPLETED" (db:te
3980: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 29 29 st-get-state t))
3990: 29 29 29 0a 09 09 09 09 09 70 72 65 72 65 71 73 )))......prereqs
39a0: 2d 6e 6f 74 2d 6d 65 74 29 29 29 0a 09 09 20 28 -not-met)))... (
39b0: 70 72 65 74 74 79 2d 73 74 72 69 6e 67 20 28 6c pretty-string (l
39c0: 61 6d 62 64 61 20 28 6c 73 74 29 0a 09 09 09 09 ambda (lst).....
39d0: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
39e0: 74 29 0a 09 09 09 09 09 20 28 69 66 20 28 6e 6f t)...... (if (no
39f0: 74 20 28 76 65 63 74 6f 72 3f 20 74 29 29 0a 09 t (vector? t))..
3a00: 09 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 74 .... (conc t
3a10: 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 6f 6e )...... (con
3a20: 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 c (db:test-get-t
3a30: 65 73 74 6e 61 6d 65 20 74 29 20 22 3a 22 20 28 estname t) ":" (
3a40: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
3a50: 65 20 74 29 20 22 2f 22 20 28 64 62 3a 74 65 73 e t) "/" (db:tes
3a60: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 29 29 t-get-status t))
3a70: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 6c 73 ))..... ls
3a80: 74 29 29 29 29 0a 09 20 20 20 20 0a 09 20 20 20 t)))).. ..
3a90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 0a (debug:print 6.
3aa0: 09 09 09 20 22 74 65 73 74 2d 6e 61 6d 65 3a 20 ... "test-name:
3ab0: 22 20 74 65 73 74 2d 6e 61 6d 65 0a 09 09 09 20 " test-name....
3ac0: 22 5c 6e 20 20 68 65 64 3a 20 20 20 20 20 20 20 "\n hed:
3ad0: 20 20 22 20 68 65 64 0a 09 09 09 20 22 5c 6e 20 " hed.... "\n
3ae0: 20 69 74 65 6d 64 61 74 3a 20 20 20 20 20 22 20 itemdat: "
3af0: 69 74 65 6d 64 61 74 0a 09 09 09 20 22 5c 6e 20 itemdat.... "\n
3b00: 20 69 74 65 6d 73 3a 20 20 20 20 20 20 20 22 20 items: "
3b10: 69 74 65 6d 73 0a 09 09 09 20 22 5c 6e 20 20 69 items.... "\n i
3b20: 74 65 6d 2d 70 61 74 68 3a 20 20 20 22 20 69 74 tem-path: " it
3b30: 65 6d 2d 70 61 74 68 0a 09 09 09 20 22 5c 6e 20 em-path.... "\n
3b40: 20 77 61 69 74 6f 6e 73 3a 20 20 20 20 20 22 20 waitons: "
3b50: 77 61 69 74 6f 6e 73 0a 09 09 09 20 22 5c 6e 20 waitons.... "\n
3b60: 20 6e 75 6d 2d 72 65 74 72 69 65 73 3a 20 22 20 num-retries: "
3b70: 6e 75 6d 2d 72 65 74 72 69 65 73 29 0a 0a 09 20 num-retries)...
3b80: 20 20 20 3b 3b 20 63 68 65 63 6b 20 66 6f 72 20 ;; check for
3b90: 68 65 64 20 69 6e 20 77 61 69 74 6f 6e 73 20 3d hed in waitons =
3ba0: 3e 20 74 68 69 73 20 77 6f 75 6c 64 20 62 65 20 > this would be
3bb0: 63 69 72 63 75 6c 61 72 2c 20 72 65 6d 6f 76 65 circular, remove
3bc0: 20 69 74 20 61 6e 64 20 69 73 73 75 65 20 61 6e it and issue an
3bd0: 0a 09 20 20 20 20 3b 3b 20 65 72 72 6f 72 0a 09 .. ;; error..
3be0: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
3bf0: 74 65 73 74 2d 6e 61 6d 65 20 77 61 69 74 6f 6e test-name waiton
3c00: 73 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 s)...(begin...
3c10: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
3c20: 45 52 52 4f 52 3a 20 74 65 73 74 20 22 20 74 65 ERROR: test " te
3c30: 73 74 2d 6e 61 6d 65 20 22 20 68 61 73 20 6c 69 st-name " has li
3c40: 73 74 65 64 20 69 74 73 65 6c 66 20 61 73 20 61 sted itself as a
3c50: 20 77 61 69 74 6f 6e 2c 20 70 6c 65 61 73 65 20 waiton, please
3c60: 63 6f 72 72 65 63 74 20 74 68 69 73 21 22 29 0a correct this!").
3c70: 09 09 20 20 28 73 65 74 21 20 77 61 69 74 6f 6e .. (set! waiton
3c80: 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 (filter (lambda
3c90: 20 28 78 29 28 6e 6f 74 20 28 65 71 75 61 6c 3f (x)(not (equal?
3ca0: 20 78 20 68 65 64 29 29 29 20 77 61 69 74 6f 6e x hed))) waiton
3cb0: 73 29 29 29 29 0a 0a 09 20 20 20 20 28 63 6f 6e s))))... (con
3cc0: 64 0a 09 20 20 20 20 20 28 28 6e 6f 74 20 69 74 d.. ((not it
3cd0: 65 6d 73 29 20 3b 3b 20 77 68 65 6e 20 66 61 6c ems) ;; when fal
3ce0: 73 65 20 74 68 65 20 74 65 73 74 20 69 73 20 6f se the test is o
3cf0: 6b 20 74 6f 20 62 65 20 68 61 6e 64 65 64 20 6f k to be handed o
3d00: 66 66 20 74 6f 20 6c 61 75 6e 63 68 20 28 62 75 ff to launch (bu
3d10: 74 20 6e 6f 74 20 62 65 66 6f 72 65 29 0a 09 20 t not before)..
3d20: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 68 61 76 (let* ((hav
3d30: 65 2d 72 65 73 6f 75 72 63 65 73 20 20 28 6f 70 e-resources (op
3d40: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 6e en-run-close run
3d50: 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 s:can-run-more-t
3d60: 65 73 74 73 20 23 66 20 74 65 73 74 2d 72 65 63 ests #f test-rec
3d70: 6f 72 64 29 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 ord)) ;; look at
3d80: 20 74 68 65 20 74 65 73 74 20 6a 6f 62 67 72 6f the test jobgro
3d90: 75 70 20 61 6e 64 20 74 6f 74 20 6a 6f 62 73 20 up and tot jobs
3da0: 72 75 6e 6e 69 6e 67 0a 09 09 20 20 20 20 20 28 running... (
3db0: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 prereqs-not-met
3dc0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
3dd0: 64 62 3a 67 65 74 2d 70 72 65 72 65 71 73 2d 6e db:get-prereqs-n
3de0: 6f 74 2d 6d 65 74 20 23 66 20 72 75 6e 2d 69 64 ot-met #f run-id
3df0: 20 77 61 69 74 6f 6e 73 20 69 74 65 6d 2d 70 61 waitons item-pa
3e00: 74 68 20 6d 6f 64 65 3a 20 74 65 73 74 6d 6f 64 th mode: testmod
3e10: 65 29 29 0a 09 09 20 20 20 20 20 28 66 61 69 6c e))... (fail
3e20: 73 20 20 20 20 20 20 20 20 20 20 20 28 63 61 6c s (cal
3e30: 63 2d 66 61 69 6c 73 20 70 72 65 72 65 71 73 2d c-fails prereqs-
3e40: 6e 6f 74 2d 6d 65 74 29 29 0a 09 09 20 20 20 20 not-met))...
3e50: 20 28 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 20 (non-completed
3e60: 20 20 28 63 61 6c 63 2d 6e 6f 74 2d 63 6f 6d 70 (calc-not-comp
3e70: 6c 65 74 65 64 20 70 72 65 72 65 71 73 2d 6e 6f leted prereqs-no
3e80: 74 2d 6d 65 74 29 29 29 0a 09 09 28 64 65 62 75 t-met)))...(debu
3e90: 67 3a 70 72 69 6e 74 20 38 20 22 49 4e 46 4f 3a g:print 8 "INFO:
3ea0: 20 68 61 76 65 2d 72 65 73 6f 75 72 63 65 73 3a have-resources:
3eb0: 20 22 20 68 61 76 65 2d 72 65 73 6f 75 72 63 65 " have-resource
3ec0: 73 20 22 20 70 72 65 72 65 71 73 2d 6e 6f 74 2d s " prereqs-not-
3ed0: 6d 65 74 3a 20 22 20 0a 09 09 09 20 20 20 20 20 met: " ....
3ee0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
3ef0: 72 73 65 20 0a 09 09 09 20 20 20 20 20 20 28 6d rse .... (m
3f00: 61 70 20 28 6c 61 6d 62 64 61 20 28 74 29 0a 09 ap (lambda (t)..
3f10: 09 09 09 20 20 20 20 20 28 69 66 20 28 76 65 63 ... (if (vec
3f20: 74 6f 72 3f 20 74 29 0a 09 09 09 09 09 20 28 63 tor? t)...... (c
3f30: 6f 6e 63 20 28 64 62 3a 74 65 73 74 2d 67 65 74 onc (db:test-get
3f40: 2d 73 74 61 74 65 20 74 29 20 22 2f 22 20 28 64 -state t) "/" (d
3f50: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
3f60: 73 20 74 29 29 0a 09 09 09 09 09 20 28 63 6f 6e s t))...... (con
3f70: 63 20 22 20 57 41 52 4e 49 4e 47 3a 20 74 20 69 c " WARNING: t i
3f80: 73 20 6e 6f 74 20 61 20 76 65 63 74 6f 72 3d 22 s not a vector="
3f90: 20 74 20 29 29 29 0a 09 09 09 09 20 20 20 70 72 t )))..... pr
3fa0: 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 20 22 ereqs-not-met) "
3fb0: 2c 20 22 29 20 22 20 66 61 69 6c 73 3a 20 22 20 , ") " fails: "
3fc0: 66 61 69 6c 73 29 0a 09 09 28 64 65 62 75 67 3a fails)...(debug:
3fd0: 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 68 print 4 "INFO: h
3fe0: 65 64 3d 22 20 68 65 64 29 0a 09 09 3b 3b 20 44 ed=" hed)...;; D
3ff0: 6f 6e 27 74 20 6b 6e 6f 77 20 61 74 20 74 68 69 on't know at thi
4000: 73 20 74 69 6d 65 20 69 66 20 74 68 65 20 74 65 s time if the te
4010: 73 74 20 68 61 76 65 20 62 65 65 6e 20 6c 61 75 st have been lau
4020: 6e 63 68 65 64 20 61 74 20 73 6f 6d 65 20 74 69 nched at some ti
4030: 6d 65 20 69 6e 20 74 68 65 20 70 61 73 74 0a 09 me in the past..
4040: 09 3b 3b 20 69 2e 65 2e 20 69 73 20 74 68 69 73 .;; i.e. is this
4050: 20 61 20 72 65 2d 6c 61 75 6e 63 68 3f 0a 09 09 a re-launch?...
4060: 28 63 6f 6e 64 0a 09 09 20 28 28 6e 6f 74 20 28 (cond... ((not (
4070: 70 61 74 74 2d 6c 69 73 74 2d 6d 61 74 63 68 20 patt-list-match
4080: 69 74 65 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 item-path item-p
4090: 61 74 74 73 29 29 0a 09 09 20 20 3b 3b 20 65 6c atts))... ;; el
40a0: 73 65 20 74 68 65 20 72 75 6e 20 69 73 20 73 74 se the run is st
40b0: 75 63 6b 2c 20 74 65 6d 70 6f 72 61 72 69 6c 79 uck, temporarily
40c0: 20 6f 72 20 70 65 72 6d 61 6e 65 6e 74 6c 79 0a or permanently.
40d0: 09 09 20 20 3b 3b 20 62 75 74 20 73 68 6f 75 6c .. ;; but shoul
40e0: 64 20 63 68 65 63 6b 20 69 66 20 69 74 20 69 73 d check if it is
40f0: 20 64 75 65 20 74 6f 20 6c 61 63 6b 20 6f 66 20 due to lack of
4100: 72 65 73 6f 75 72 63 65 73 20 76 73 2e 20 70 72 resources vs. pr
4110: 65 72 65 71 75 69 73 69 74 65 73 0a 09 09 20 20 erequisites...
4120: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
4130: 49 4e 46 4f 3a 20 53 6b 69 70 70 69 6e 67 20 22 INFO: Skipping "
4140: 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 (tests:testqueu
4150: 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 e-get-testname t
4160: 65 73 74 2d 72 65 63 6f 72 64 29 20 22 20 22 20 est-record) " "
4170: 69 74 65 6d 2d 70 61 74 68 20 22 20 61 73 20 69 item-path " as i
4180: 74 20 64 6f 65 73 6e 27 74 20 6d 61 74 63 68 20 t doesn't match
4190: 22 20 69 74 65 6d 2d 70 61 74 74 73 29 0a 09 09 " item-patts)...
41a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
41b0: 3f 20 74 61 6c 29 29 0a 09 09 20 20 20 20 20 20 ? tal))...
41c0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 (loop (car tal)(
41d0: 63 64 72 20 74 61 6c 29 20 72 65 72 75 6e 73 29 cdr tal) reruns)
41e0: 29 29 0a 09 09 20 28 28 6e 6f 74 20 28 68 61 73 ))... ((not (has
41f0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
4200: 75 6c 74 20 74 65 73 74 2d 72 65 67 69 73 74 65 ult test-registe
4210: 72 79 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 ry (conc test-na
4220: 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 me "/" item-path
4230: 29 20 23 66 29 29 0a 09 09 20 20 28 6f 70 65 6e ) #f))... (open
4240: 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 -run-close db:te
4250: 73 74 73 2d 72 65 67 69 73 74 65 72 2d 74 65 73 sts-register-tes
4260: 74 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 t #f run-id test
4270: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
4280: 0a 09 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ... (hash-table
4290: 2d 73 65 74 21 20 74 65 73 74 2d 72 65 67 69 73 -set! test-regis
42a0: 74 65 72 79 20 28 63 6f 6e 63 20 74 65 73 74 2d tery (conc test-
42b0: 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 name "/" item-pa
42c0: 74 68 29 20 23 74 29 0a 09 09 20 20 28 6c 6f 6f th) #t)... (loo
42d0: 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 p (car newtal)(c
42e0: 64 72 20 6e 65 77 74 61 6c 29 20 72 65 72 75 6e dr newtal) rerun
42f0: 73 29 29 0a 09 09 20 28 28 6e 6f 74 20 68 61 76 s))... ((not hav
4300: 65 2d 72 65 73 6f 75 72 63 65 73 29 20 3b 3b 20 e-resources) ;;
4310: 73 69 6d 70 6c 79 20 74 72 79 20 61 67 61 69 6e simply try again
4320: 20 61 66 74 65 72 20 77 61 69 74 69 6e 67 20 61 after waiting a
4330: 20 73 65 63 6f 6e 64 0a 09 09 20 20 28 74 68 72 second... (thr
4340: 65 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 20 ead-sleep! (+ 1
4350: 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 *global-delta*))
4360: 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
4370: 74 20 31 20 22 49 4e 46 4f 3a 20 6e 6f 20 72 65 t 1 "INFO: no re
4380: 73 6f 75 72 63 65 73 20 74 6f 20 72 75 6e 20 6e sources to run n
4390: 65 77 20 74 65 73 74 73 2c 20 77 61 69 74 69 6e ew tests, waitin
43a0: 67 20 2e 2e 2e 22 29 0a 09 09 20 20 3b 3b 20 63 g ...")... ;; c
43b0: 6f 75 6c 64 20 68 61 76 65 20 64 6f 6e 65 20 68 ould have done h
43c0: 65 64 20 74 61 6c 20 68 65 72 65 20 62 75 74 20 ed tal here but
43d0: 64 6f 69 6e 67 20 63 61 72 2f 63 64 72 20 6f 66 doing car/cdr of
43e0: 20 6e 65 77 74 61 6c 20 74 6f 20 72 6f 74 61 74 newtal to rotat
43f0: 65 20 74 65 73 74 73 0a 09 09 20 20 28 6c 6f 6f e tests... (loo
4400: 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 p (car newtal)(c
4410: 64 72 20 6e 65 77 74 61 6c 29 20 72 65 72 75 6e dr newtal) rerun
4420: 73 29 29 0a 09 09 20 28 28 61 6e 64 20 68 61 76 s))... ((and hav
4430: 65 2d 72 65 73 6f 75 72 63 65 73 0a 09 09 20 20 e-resources...
4440: 20 20 20 20 20 28 6f 72 20 28 6e 75 6c 6c 3f 20 (or (null?
4450: 70 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 prereqs-not-met)
4460: 0a 09 09 09 20 20 20 28 61 6e 64 20 28 65 71 3f .... (and (eq?
4470: 20 74 65 73 74 6d 6f 64 65 20 27 74 6f 70 6c 65 testmode 'tople
4480: 76 65 6c 29 0a 09 09 09 09 28 6e 75 6c 6c 3f 20 vel).....(null?
4490: 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 65 64 29 29 29 non-completed)))
44a0: 29 0a 09 09 20 20 3b 3b 20 6e 6f 20 6c 6f 6f 70 )... ;; no loop
44b0: 20 68 65 72 65 2c 20 6a 75 73 74 20 64 72 6f 70 here, just drop
44c0: 20 74 68 6f 75 67 68 20 61 6e 64 20 75 73 65 20 though and use
44d0: 74 68 65 20 6c 6f 6f 70 20 61 74 20 74 68 65 20 the loop at the
44e0: 62 6f 74 74 6f 6d 20 0a 09 09 20 20 28 72 75 6e bottom ... (run
44f0: 3a 74 65 73 74 20 72 75 6e 2d 69 64 20 72 75 6e :test run-id run
4500: 6e 61 6d 65 20 6b 65 79 76 61 6c 6c 73 74 20 74 name keyvallst t
4510: 65 73 74 2d 72 65 63 6f 72 64 20 66 6c 61 67 73 est-record flags
4520: 20 23 66 29 29 0a 09 09 20 28 65 6c 73 65 20 3b #f))... (else ;
4530: 3b 20 6d 75 73 74 20 62 65 20 77 65 20 68 61 76 ; must be we hav
4540: 65 20 75 6e 6d 65 74 20 70 72 65 72 65 71 75 69 e unmet prerequi
4550: 73 69 74 65 73 0a 09 09 20 20 20 20 28 64 65 62 sites... (deb
4560: 75 67 3a 70 72 69 6e 74 20 34 20 22 46 41 49 4c ug:print 4 "FAIL
4570: 53 3a 20 22 20 66 61 69 6c 73 29 0a 09 09 20 20 S: " fails)...
4580: 20 20 3b 3b 20 49 66 20 6f 6e 65 20 6f 72 20 6d ;; If one or m
4590: 6f 72 65 20 6f 66 20 74 68 65 20 70 72 65 72 65 ore of the prere
45a0: 71 73 2d 6e 6f 74 2d 6d 65 74 20 61 72 65 20 46 qs-not-met are F
45b0: 41 49 4c 20 74 68 65 6e 20 77 65 20 63 61 6e 20 AIL then we can
45c0: 69 73 73 75 65 0a 09 09 20 20 20 20 3b 3b 20 61 issue... ;; a
45d0: 20 6d 65 73 73 61 67 65 20 61 6e 64 20 64 72 6f message and dro
45e0: 70 20 68 65 64 20 66 72 6f 6d 20 74 68 65 20 69 p hed from the i
45f0: 74 65 6d 73 20 74 6f 20 62 65 20 70 72 6f 63 65 tems to be proce
4600: 73 73 65 64 2e 0a 09 09 20 20 20 20 28 69 66 20 ssed.... (if
4610: 28 6e 75 6c 6c 3f 20 66 61 69 6c 73 29 0a 09 09 (null? fails)...
4620: 09 28 62 65 67 69 6e 0a 09 09 09 20 20 3b 3b 20 .(begin.... ;;
4630: 63 6f 75 6c 64 6e 27 74 20 72 75 6e 2c 20 74 61 couldn't run, ta
4640: 6b 65 20 61 20 62 72 65 61 74 68 65 72 0a 09 09 ke a breather...
4650: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
4660: 34 20 22 49 4e 46 4f 3a 20 53 68 6f 75 6c 64 6e 4 "INFO: Shouldn
4670: 27 74 20 72 65 61 6c 6c 79 20 67 65 74 20 68 65 't really get he
4680: 72 65 2c 20 72 61 63 65 20 63 6f 6e 64 69 74 69 re, race conditi
4690: 6f 6e 3f 20 55 6e 61 62 6c 65 20 74 6f 20 6c 61 on? Unable to la
46a0: 75 6e 63 68 20 6d 6f 72 65 20 74 65 73 74 73 20 unch more tests
46b0: 61 74 20 74 68 69 73 20 6d 6f 6d 65 6e 74 2c 20 at this moment,
46c0: 6b 69 6c 6c 69 6e 67 20 74 69 6d 65 20 2e 2e 2e killing time ...
46d0: 22 29 0a 09 09 09 20 20 28 74 68 72 65 61 64 2d ").... (thread-
46e0: 73 6c 65 65 70 21 20 28 2b 20 31 20 2a 67 6c 6f sleep! (+ 1 *glo
46f0: 62 61 6c 2d 64 65 6c 74 61 2a 29 29 20 3b 3b 20 bal-delta*)) ;;
4700: 6c 6f 6e 67 20 73 6c 65 65 70 20 68 65 72 65 20 long sleep here
4710: 2d 20 6e 6f 20 72 65 73 6f 75 72 63 65 73 2c 20 - no resources,
4720: 6d 61 79 20 61 73 20 77 65 6c 6c 20 62 65 20 70 may as well be p
4730: 61 74 69 65 6e 74 0a 09 09 09 20 20 3b 3b 20 77 atient.... ;; w
4740: 65 20 6d 61 64 65 20 6e 65 77 20 74 61 6c 20 62 e made new tal b
4750: 79 20 73 74 69 63 6b 69 6e 67 20 68 65 64 20 61 y sticking hed a
4760: 74 20 74 68 65 20 62 61 63 6b 20 6f 66 20 74 68 t the back of th
4770: 65 20 6c 69 73 74 0a 09 09 09 20 20 28 6c 6f 6f e list.... (loo
4780: 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 p (car newtal)(c
4790: 64 72 20 6e 65 77 74 61 6c 29 20 72 65 72 75 6e dr newtal) rerun
47a0: 73 29 29 0a 09 09 09 3b 3b 20 74 68 65 20 77 61 s))....;; the wa
47b0: 69 74 6f 6e 20 69 73 20 46 41 49 4c 20 73 6f 20 iton is FAIL so
47c0: 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 74 72 79 69 no point in tryi
47d0: 6e 67 20 74 6f 20 72 75 6e 20 68 65 64 20 65 76 ng to run hed ev
47e0: 65 72 20 61 67 61 69 6e 0a 09 09 09 28 69 66 20 er again....(if
47f0: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (not (null? tal)
4800: 29 0a 09 09 09 20 20 20 20 28 69 66 20 28 76 65 ).... (if (ve
4810: 63 74 6f 72 3f 20 68 65 64 29 0a 09 09 09 09 28 ctor? hed).....(
4820: 62 65 67 69 6e 20 28 64 65 62 75 67 3a 70 72 69 begin (debug:pri
4830: 6e 74 20 31 20 22 57 41 52 4e 3a 20 44 72 6f 70 nt 1 "WARN: Drop
4840: 70 69 6e 67 20 74 65 73 74 20 22 20 28 64 62 3a ping test " (db:
4850: 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d test-get-testnam
4860: 65 20 68 65 64 29 20 22 2f 22 20 28 64 62 3a 74 e hed) "/" (db:t
4870: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
4880: 68 20 68 65 64 29 0a 09 09 09 09 09 09 20 20 20 h hed).......
4890: 20 22 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e " from the laun
48a0: 63 68 20 6c 69 73 74 20 61 73 20 69 74 20 68 61 ch list as it ha
48b0: 73 20 70 72 65 72 65 71 75 69 73 74 65 73 20 74 s prerequistes t
48c0: 68 61 74 20 61 72 65 20 46 41 49 4c 22 29 0a 09 hat are FAIL")..
48d0: 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 ... (loop
48e0: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
48f0: 6c 29 20 28 63 6f 6e 73 20 68 65 64 20 72 65 72 l) (cons hed rer
4900: 75 6e 73 29 29 29 0a 09 09 09 09 28 62 65 67 69 uns))).....(begi
4910: 6e 0a 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 n..... (debug:p
4920: 72 69 6e 74 20 31 20 22 57 41 52 4e 3a 20 54 65 rint 1 "WARN: Te
4930: 73 74 20 6e 6f 74 20 70 72 6f 63 65 73 73 65 64 st not processed
4940: 20 63 6f 72 72 65 63 74 6c 79 2e 20 43 6f 75 6c correctly. Coul
4950: 64 20 62 65 20 61 20 72 61 63 65 20 63 6f 6e 64 d be a race cond
4960: 69 74 69 6f 6e 20 69 6e 20 79 6f 75 72 20 74 65 ition in your te
4970: 73 74 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f st implementatio
4980: 6e 3f 20 22 20 68 65 64 29 20 3b 3b 20 20 22 20 n? " hed) ;; "
4990: 61 73 20 69 74 20 68 61 73 20 70 72 65 72 65 71 as it has prereq
49a0: 75 69 73 74 65 73 20 74 68 61 74 20 61 72 65 20 uistes that are
49b0: 46 41 49 4c 2e 20 28 4e 4f 54 45 3a 20 68 65 64 FAIL. (NOTE: hed
49c0: 20 69 73 20 6e 6f 74 20 61 20 76 65 63 74 6f 72 is not a vector
49d0: 29 22 29 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 )")..... (loop
49e0: 68 65 64 20 74 61 6c 20 72 65 72 75 6e 73 29 29 hed tal reruns))
49f0: 29 29 29 29 29 29 29 0a 09 20 20 20 20 20 0a 09 ))))))).. ..
4a00: 20 20 20 20 20 3b 3b 20 63 61 73 65 20 77 68 65 ;; case whe
4a10: 72 65 20 61 6e 20 69 74 65 6d 73 20 63 61 6d 65 re an items came
4a20: 20 69 6e 20 61 73 20 61 20 6c 69 73 74 20 62 65 in as a list be
4a30: 65 6e 20 70 72 6f 63 65 73 73 65 64 0a 09 20 20 en processed..
4a40: 20 20 20 28 28 61 6e 64 20 28 6c 69 73 74 3f 20 ((and (list?
4a50: 69 74 65 6d 73 29 20 20 20 20 20 3b 3b 20 74 68 items) ;; th
4a60: 75 73 20 77 65 20 6b 6e 6f 77 20 6f 75 72 20 69 us we know our i
4a70: 74 65 6d 73 20 61 72 65 20 61 6c 72 65 61 64 79 tems are already
4a80: 20 63 61 6c 63 75 6c 61 74 65 64 0a 09 09 20 20 calculated...
4a90: 20 28 6e 6f 74 20 20 20 69 74 65 6d 64 61 74 29 (not itemdat)
4aa0: 29 20 3b 3b 20 61 6e 64 20 6e 6f 74 20 79 65 74 ) ;; and not yet
4ab0: 20 65 78 70 61 6e 64 65 64 20 69 6e 74 6f 20 74 expanded into t
4ac0: 68 65 20 6c 69 73 74 20 6f 66 20 74 68 69 6e 67 he list of thing
4ad0: 73 20 74 6f 20 62 65 20 64 6f 6e 65 0a 09 20 20 s to be done..
4ae0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 3e 3d (if (and (>=
4af0: 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 31 29 0a *verbosity* 1).
4b00: 09 09 20 20 20 20 20 20 20 28 3e 20 28 6c 65 6e .. (> (len
4b10: 67 74 68 20 69 74 65 6d 73 29 20 30 29 0a 09 09 gth items) 0)...
4b20: 20 20 20 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 (> (lengt
4b30: 68 20 28 63 61 72 20 69 74 65 6d 73 29 29 20 30 h (car items)) 0
4b40: 29 29 0a 09 09 20 20 28 70 70 20 69 74 65 6d 73 ))... (pp items
4b50: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 69 66 )).. ;; (if
4b60: 20 28 3e 3d 20 2a 76 65 72 62 6f 73 69 74 79 2a (>= *verbosity*
4b70: 20 35 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 5).. ;;
4b80: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
4b90: 3b 3b 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 ;; (print
4ba0: 22 69 74 65 6d 73 3a 20 22 29 20 20 20 20 20 28 "items: ") (
4bb0: 70 70 20 28 69 74 65 6d 2d 61 73 73 6f 63 2d 3e pp (item-assoc->
4bc0: 69 74 65 6d 2d 6c 69 73 74 20 69 74 65 6d 73 29 item-list items)
4bd0: 29 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ).. ;;
4be0: 20 20 28 70 72 69 6e 74 20 22 69 74 65 6d 73 74 (print "itemst
4bf0: 61 62 6c 65 3a 20 22 29 28 70 70 20 28 69 74 65 able: ")(pp (ite
4c00: 6d 2d 74 61 62 6c 65 2d 3e 69 74 65 6d 2d 6c 69 m-table->item-li
4c10: 73 74 20 69 74 65 6d 73 74 61 62 6c 65 29 29 29 st itemstable)))
4c20: 29 0a 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 ).. (for-ea
4c30: 63 68 0a 09 20 20 20 20 20 20 20 28 6c 61 6d 62 ch.. (lamb
4c40: 64 61 20 28 6d 79 2d 69 74 65 6d 64 61 74 29 0a da (my-itemdat).
4c50: 09 09 20 28 6c 65 74 2a 20 28 28 6e 65 77 2d 74 .. (let* ((new-t
4c60: 65 73 74 2d 72 65 63 6f 72 64 20 28 6c 65 74 20 est-record (let
4c70: 28 28 6e 65 77 72 65 63 20 28 6d 61 6b 65 2d 74 ((newrec (make-t
4c80: 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 29 29 ests:testqueue))
4c90: 29 0a 09 09 09 09 09 20 20 20 28 76 65 63 74 6f )...... (vecto
4ca0: 72 2d 63 6f 70 79 21 20 74 65 73 74 2d 72 65 63 r-copy! test-rec
4cb0: 6f 72 64 20 6e 65 77 72 65 63 29 0a 09 09 09 09 ord newrec).....
4cc0: 09 20 20 20 6e 65 77 72 65 63 29 29 0a 09 09 09 . newrec))....
4cd0: 28 6d 79 2d 69 74 65 6d 2d 70 61 74 68 20 28 69 (my-item-path (i
4ce0: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 6d tem-list->path m
4cf0: 79 2d 69 74 65 6d 64 61 74 29 29 29 0a 09 09 20 y-itemdat)))...
4d00: 20 20 28 69 66 20 28 70 61 74 74 2d 6c 69 73 74 (if (patt-list
4d10: 2d 6d 61 74 63 68 20 6d 79 2d 69 74 65 6d 2d 70 -match my-item-p
4d20: 61 74 68 20 69 74 65 6d 2d 70 61 74 74 73 29 20 ath item-patts)
4d30: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 79 65 73 ;; yes
4d40: 2c 20 77 65 20 77 61 6e 74 20 74 6f 20 70 72 6f , we want to pro
4d50: 63 65 73 73 20 74 68 69 73 20 69 74 65 6d 2c 20 cess this item,
4d60: 4e 4f 54 45 3a 20 53 68 6f 75 6c 64 20 6e 6f 74 NOTE: Should not
4d70: 20 6e 65 65 64 20 74 68 69 73 20 63 68 65 63 6b need this check
4d80: 20 68 65 72 65 21 0a 09 09 20 20 20 20 20 20 20 here!...
4d90: 28 6c 65 74 20 28 28 6e 65 77 74 65 73 74 6e 61 (let ((newtestna
4da0: 6d 65 20 28 63 6f 6e 63 20 68 65 64 20 22 2f 22 me (conc hed "/"
4db0: 20 6d 79 2d 69 74 65 6d 2d 70 61 74 68 29 29 29 my-item-path)))
4dc0: 20 20 20 20 3b 3b 20 74 65 73 74 20 6e 61 6d 65 ;; test name
4dd0: 73 20 61 72 65 20 75 6e 69 71 75 65 20 6f 6e 20 s are unique on
4de0: 74 65 73 74 6e 61 6d 65 2f 69 74 65 6d 2d 70 61 testname/item-pa
4df0: 74 68 0a 09 09 09 20 28 74 65 73 74 73 3a 74 65 th.... (tests:te
4e00: 73 74 71 75 65 75 65 2d 73 65 74 2d 69 74 65 6d stqueue-set-item
4e10: 73 21 20 20 20 20 20 6e 65 77 2d 74 65 73 74 2d s! new-test-
4e20: 72 65 63 6f 72 64 20 23 66 29 0a 09 09 09 20 28 record #f).... (
4e30: 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d tests:testqueue-
4e40: 73 65 74 2d 69 74 65 6d 64 61 74 21 20 20 20 6e set-itemdat! n
4e50: 65 77 2d 74 65 73 74 2d 72 65 63 6f 72 64 20 6d ew-test-record m
4e60: 79 2d 69 74 65 6d 64 61 74 29 0a 09 09 09 20 28 y-itemdat).... (
4e70: 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d tests:testqueue-
4e80: 73 65 74 2d 69 74 65 6d 5f 70 61 74 68 21 20 6e set-item_path! n
4e90: 65 77 2d 74 65 73 74 2d 72 65 63 6f 72 64 20 6d ew-test-record m
4ea0: 79 2d 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 y-item-path)....
4eb0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
4ec0: 21 20 74 65 73 74 2d 72 65 63 6f 72 64 73 20 6e ! test-records n
4ed0: 65 77 74 65 73 74 6e 61 6d 65 20 6e 65 77 2d 74 ewtestname new-t
4ee0: 65 73 74 2d 72 65 63 6f 72 64 29 0a 09 09 09 20 est-record)....
4ef0: 28 73 65 74 21 20 74 61 6c 20 28 63 6f 6e 73 20 (set! tal (cons
4f00: 6e 65 77 74 65 73 74 6e 61 6d 65 20 74 61 6c 29 newtestname tal)
4f10: 29 29 29 29 29 20 3b 3b 20 73 69 6e 63 65 20 74 ))))) ;; since t
4f20: 68 65 73 65 20 61 72 65 20 69 74 65 6d 69 7a 65 hese are itemize
4f30: 64 20 63 72 65 61 74 65 20 6e 65 77 20 74 65 73 d create new tes
4f40: 74 20 6e 61 6d 65 73 20 74 65 73 74 6e 61 6d 65 t names testname
4f50: 2f 69 74 65 6d 70 61 74 68 0a 09 20 20 20 20 20 /itempath..
4f60: 20 20 69 74 65 6d 73 29 0a 09 20 20 20 20 20 20 items)..
4f70: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
4f80: 74 61 6c 29 29 0a 09 09 20 20 28 6c 6f 6f 70 20 tal))... (loop
4f90: 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 (car tal)(cdr ta
4fa0: 6c 29 20 72 65 72 75 6e 73 29 29 29 0a 0a 09 20 l) reruns)))...
4fb0: 20 20 20 20 3b 3b 20 69 66 20 69 74 65 6d 73 20 ;; if items
4fc0: 69 73 20 61 20 70 72 6f 63 20 74 68 65 6e 20 6e is a proc then n
4fd0: 65 65 64 20 74 6f 20 72 75 6e 20 69 74 65 6d 73 eed to run items
4fe0: 3a 67 65 74 2d 69 74 65 6d 73 2d 66 72 6f 6d 2d :get-items-from-
4ff0: 63 6f 6e 66 69 67 2c 20 67 65 74 20 74 68 65 20 config, get the
5000: 6c 69 73 74 20 61 6e 64 20 6c 6f 6f 70 20 0a 09 list and loop ..
5010: 20 20 20 20 20 3b 3b 20 20 20 20 2d 20 62 75 74 ;; - but
5020: 20 6f 6e 6c 79 20 64 6f 20 74 68 61 74 20 69 66 only do that if
5030: 20 72 65 73 6f 75 72 63 65 73 20 65 78 69 73 74 resources exist
5040: 20 74 6f 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 to kick off the
5050: 20 6a 6f 62 0a 09 20 20 20 20 20 28 28 6f 72 20 job.. ((or
5060: 28 70 72 6f 63 65 64 75 72 65 3f 20 69 74 65 6d (procedure? item
5070: 73 29 28 65 71 3f 20 69 74 65 6d 73 20 27 68 61 s)(eq? items 'ha
5080: 76 65 2d 70 72 6f 63 65 64 75 72 65 29 29 0a 09 ve-procedure))..
5090: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 61 6e (let ((can
50a0: 2d 72 75 6e 2d 6d 6f 72 65 20 20 20 20 28 6f 70 -run-more (op
50b0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 6e en-run-close run
50c0: 73 3a 63 61 6e 2d 72 75 6e 2d 6d 6f 72 65 2d 74 s:can-run-more-t
50d0: 65 73 74 73 20 23 66 20 74 65 73 74 2d 72 65 63 ests #f test-rec
50e0: 6f 72 64 29 29 29 0a 09 09 28 69 66 20 63 61 6e ord)))...(if can
50f0: 2d 72 75 6e 2d 6d 6f 72 65 0a 09 09 20 20 20 20 -run-more...
5100: 28 6c 65 74 2a 20 28 28 70 72 65 72 65 71 73 2d (let* ((prereqs-
5110: 6e 6f 74 2d 6d 65 74 20 28 6f 70 65 6e 2d 72 75 not-met (open-ru
5120: 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 70 n-close db:get-p
5130: 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 20 23 rereqs-not-met #
5140: 66 20 72 75 6e 2d 69 64 20 77 61 69 74 6f 6e 73 f run-id waitons
5150: 20 69 74 65 6d 2d 70 61 74 68 20 6d 6f 64 65 3a item-path mode:
5160: 20 74 65 73 74 6d 6f 64 65 29 29 0a 09 09 09 20 testmode))....
5170: 20 20 28 66 61 69 6c 73 20 20 20 20 20 20 20 20 (fails
5180: 20 20 20 28 63 61 6c 63 2d 66 61 69 6c 73 20 70 (calc-fails p
5190: 72 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 29 rereqs-not-met))
51a0: 0a 09 09 09 20 20 20 28 6e 6f 6e 2d 63 6f 6d 70 .... (non-comp
51b0: 6c 65 74 65 64 20 20 20 28 63 61 6c 63 2d 6e 6f leted (calc-no
51c0: 74 2d 63 6f 6d 70 6c 65 74 65 64 20 70 72 65 72 t-completed prer
51d0: 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 29 29 0a 09 eqs-not-met)))..
51e0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
51f0: 69 6e 74 20 38 20 22 49 4e 46 4f 3a 20 63 61 6e int 8 "INFO: can
5200: 2d 72 75 6e 2d 6d 6f 72 65 3a 20 22 20 63 61 6e -run-more: " can
5210: 2d 72 75 6e 2d 6d 6f 72 65 0a 09 09 09 09 20 20 -run-more.....
5220: 20 22 5c 6e 20 74 65 73 74 6e 61 6d 65 3a 20 20 "\n testname:
5230: 20 20 20 20 20 20 22 20 68 65 64 0a 09 09 09 09 " hed.....
5240: 20 20 20 22 5c 6e 20 70 72 65 72 65 71 73 2d 6e "\n prereqs-n
5250: 6f 74 2d 6d 65 74 3a 20 22 20 28 70 72 65 74 74 ot-met: " (prett
5260: 79 2d 73 74 72 69 6e 67 20 70 72 65 72 65 71 73 y-string prereqs
5270: 2d 6e 6f 74 2d 6d 65 74 29 0a 09 09 09 09 20 20 -not-met).....
5280: 20 22 5c 6e 20 6e 6f 6e 2d 63 6f 6d 70 6c 65 74 "\n non-complet
5290: 65 64 3a 20 20 20 22 20 28 70 72 65 74 74 79 2d ed: " (pretty-
52a0: 73 74 72 69 6e 67 20 6e 6f 6e 2d 63 6f 6d 70 6c string non-compl
52b0: 65 74 65 64 29 20 0a 09 09 09 09 20 20 20 22 5c eted) ..... "\
52c0: 6e 20 66 61 69 6c 73 3a 20 20 20 20 20 20 20 20 n fails:
52d0: 20 20 20 22 20 28 70 72 65 74 74 79 2d 73 74 72 " (pretty-str
52e0: 69 6e 67 20 66 61 69 6c 73 29 0a 09 09 09 09 20 ing fails).....
52f0: 20 20 22 5c 6e 20 74 65 73 74 6d 6f 64 65 3a 20 "\n testmode:
5300: 20 20 20 20 20 20 20 22 20 74 65 73 74 6d 6f 64 " testmod
5310: 65 0a 09 09 09 09 20 20 20 22 5c 6e 20 6e 75 6d e..... "\n num
5320: 2d 72 65 74 72 69 65 73 3a 20 20 20 20 20 22 20 -retries: "
5330: 6e 75 6d 2d 72 65 74 72 69 65 73 0a 09 09 09 09 num-retries.....
5340: 20 20 20 22 5c 6e 20 28 65 71 3f 20 74 65 73 74 "\n (eq? test
5350: 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 3a mode 'toplevel):
5360: 20 22 20 28 65 71 3f 20 74 65 73 74 6d 6f 64 65 " (eq? testmode
5370: 20 27 74 6f 70 6c 65 76 65 6c 29 0a 09 09 09 09 'toplevel).....
5380: 20 20 20 22 5c 6e 20 28 6e 75 6c 6c 3f 20 6e 6f "\n (null? no
5390: 6e 2d 63 6f 6d 70 6c 65 74 65 64 29 3a 20 20 20 n-completed):
53a0: 20 22 20 28 6e 75 6c 6c 3f 20 6e 6f 6e 2d 63 6f " (null? non-co
53b0: 6d 70 6c 65 74 65 64 29 0a 09 09 09 09 20 20 20 mpleted).....
53c0: 22 5c 6e 20 72 65 72 75 6e 73 3a 20 22 20 72 65 "\n reruns: " re
53d0: 72 75 6e 73 29 0a 09 09 20 20 20 20 20 20 28 63 runs)... (c
53e0: 6f 6e 64 20 0a 09 09 20 20 20 20 20 20 20 28 28 ond ... ((
53f0: 6f 72 20 28 6e 75 6c 6c 3f 20 70 72 65 72 65 71 or (null? prereq
5400: 73 2d 6e 6f 74 2d 6d 65 74 29 20 3b 3b 20 61 6c s-not-met) ;; al
5410: 6c 20 70 72 65 72 65 71 73 20 6d 65 74 2c 20 66 l prereqs met, f
5420: 69 72 65 20 6f 66 66 20 74 68 65 20 74 65 73 74 ire off the test
5430: 0a 09 09 09 20 20 20 20 3b 3b 20 6f 72 2c 20 69 .... ;; or, i
5440: 66 20 69 74 20 69 73 20 61 20 27 74 6f 70 6c 65 f it is a 'tople
5450: 76 65 6c 20 74 65 73 74 20 61 6e 64 20 61 6c 6c vel test and all
5460: 20 70 72 65 72 65 71 73 20 6e 6f 74 20 6d 65 74 prereqs not met
5470: 20 61 72 65 20 43 4f 4d 50 4c 45 54 45 44 20 74 are COMPLETED t
5480: 68 65 6e 20 6c 61 75 6e 63 68 0a 09 09 09 20 20 hen launch....
5490: 20 20 28 61 6e 64 20 28 65 71 3f 20 74 65 73 74 (and (eq? test
54a0: 6d 6f 64 65 20 27 74 6f 70 6c 65 76 65 6c 29 0a mode 'toplevel).
54b0: 09 09 09 09 20 28 6e 75 6c 6c 3f 20 6e 6f 6e 2d .... (null? non-
54c0: 63 6f 6d 70 6c 65 74 65 64 29 29 29 0a 09 09 09 completed)))....
54d0: 28 6c 65 74 20 28 28 74 65 73 74 2d 6e 61 6d 65 (let ((test-name
54e0: 20 28 74 65 73 74 73 3a 74 65 73 74 71 75 65 75 (tests:testqueu
54f0: 65 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 e-get-testname t
5500: 65 73 74 2d 72 65 63 6f 72 64 29 29 29 0a 09 09 est-record)))...
5510: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 . (setenv "MT_T
5520: 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e EST_NAME" test-n
5530: 61 6d 65 29 20 3b 3b 20 0a 09 09 09 20 20 28 73 ame) ;; .... (s
5540: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
5550: 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 E" runname)...
5560: 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f . (open-run-clo
5570: 73 65 2d 6d 65 61 73 75 72 65 20 73 65 74 2d 6d se-measure set-m
5580: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
5590: 20 23 66 20 72 75 6e 2d 69 64 29 20 3b 3b 20 74 #f run-id) ;; t
55a0: 68 65 73 65 20 6d 61 79 20 62 65 20 6e 65 65 64 hese may be need
55b0: 65 64 20 62 79 20 74 68 65 20 6c 61 75 6e 63 68 ed by the launch
55c0: 69 6e 67 20 70 72 6f 63 65 73 73 0a 09 09 09 20 ing process....
55d0: 20 28 6c 65 74 20 28 28 69 74 65 6d 73 2d 6c 69 (let ((items-li
55e0: 73 74 20 28 69 74 65 6d 73 3a 67 65 74 2d 69 74 st (items:get-it
55f0: 65 6d 73 2d 66 72 6f 6d 2d 63 6f 6e 66 69 67 20 ems-from-config
5600: 74 63 6f 6e 66 69 67 29 29 29 0a 09 09 09 20 20 tconfig)))....
5610: 20 20 28 69 66 20 28 6c 69 73 74 3f 20 69 74 65 (if (list? ite
5620: 6d 73 2d 6c 69 73 74 29 0a 09 09 09 09 28 62 65 ms-list).....(be
5630: 67 69 6e 0a 09 09 09 09 20 20 28 74 65 73 74 73 gin..... (tests
5640: 3a 74 65 73 74 71 75 65 75 65 2d 73 65 74 2d 69 :testqueue-set-i
5650: 74 65 6d 73 21 20 74 65 73 74 2d 72 65 63 6f 72 tems! test-recor
5660: 64 20 69 74 65 6d 73 2d 6c 69 73 74 29 0a 09 09 d items-list)...
5670: 09 09 20 20 28 6c 6f 6f 70 20 68 65 64 20 74 61 .. (loop hed ta
5680: 6c 20 72 65 72 75 6e 73 29 29 0a 09 09 09 09 28 l reruns)).....(
5690: 62 65 67 69 6e 0a 09 09 09 09 20 20 28 64 65 62 begin..... (deb
56a0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
56b0: 52 3a 20 54 68 65 20 70 72 6f 63 20 66 72 6f 6d R: The proc from
56c0: 20 72 65 61 64 69 6e 67 20 74 68 65 20 73 65 74 reading the set
56d0: 75 70 20 64 69 64 20 6e 6f 74 20 79 69 65 6c 64 up did not yield
56e0: 20 61 20 6c 69 73 74 20 2d 20 70 6c 65 61 73 65 a list - please
56f0: 20 72 65 70 6f 72 74 20 74 68 69 73 22 29 0a 09 report this")..
5700: 09 09 09 20 20 28 65 78 69 74 20 31 29 29 29 29 ... (exit 1))))
5710: 29 29 0a 09 09 20 20 20 20 20 20 20 28 28 6e 75 ))... ((nu
5720: 6c 6c 3f 20 66 61 69 6c 73 29 0a 09 09 09 28 64 ll? fails)....(d
5730: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 4e ebug:print 4 "IN
5740: 46 4f 3a 20 66 61 69 6c 73 20 69 73 20 6e 75 6c FO: fails is nul
5750: 6c 2c 20 6d 6f 76 69 6e 67 20 6f 6e 20 69 6e 20 l, moving on in
5760: 74 68 65 20 71 75 65 75 65 20 62 75 74 20 6b 65 the queue but ke
5770: 65 70 69 6e 67 20 22 20 68 65 64 20 22 20 66 6f eping " hed " fo
5780: 72 20 6e 6f 77 22 29 0a 09 09 09 28 6c 6f 6f 70 r now")....(loop
5790: 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 64 (car newtal)(cd
57a0: 72 20 6e 65 77 74 61 6c 29 20 72 65 72 75 6e 73 r newtal) reruns
57b0: 29 29 20 3b 3b 20 61 6e 20 69 73 73 75 65 20 77 )) ;; an issue w
57c0: 69 74 68 20 70 72 65 72 65 71 73 20 6e 6f 74 20 ith prereqs not
57d0: 79 65 74 20 6d 65 74 3f 0a 09 09 20 20 20 20 20 yet met?...
57e0: 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 6e 75 ((and (not (nu
57f0: 6c 6c 3f 20 66 61 69 6c 73 29 29 28 65 71 3f 20 ll? fails))(eq?
5800: 74 65 73 74 6d 6f 64 65 20 27 6e 6f 72 6d 61 6c testmode 'normal
5810: 29 29 0a 09 09 09 28 64 65 62 75 67 3a 70 72 69 ))....(debug:pri
5820: 6e 74 20 31 20 22 49 4e 46 4f 3a 20 74 65 73 74 nt 1 "INFO: test
5830: 20 22 20 20 68 65 64 20 22 20 28 6d 6f 64 65 3d " hed " (mode=
5840: 22 20 74 65 73 74 6d 6f 64 65 20 22 29 20 68 61 " testmode ") ha
5850: 73 20 66 61 69 6c 65 64 20 70 72 65 72 65 71 75 s failed prerequ
5860: 69 73 69 74 65 28 73 29 3b 20 22 0a 09 09 09 09 isite(s); ".....
5870: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
5880: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
5890: 61 6d 62 64 61 20 28 74 29 28 63 6f 6e 63 20 28 ambda (t)(conc (
58a0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
58b0: 6e 61 6d 65 20 74 29 20 22 3a 22 20 28 64 62 3a name t) ":" (db:
58c0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
58d0: 29 22 2f 22 28 64 62 3a 74 65 73 74 2d 67 65 74 )"/"(db:test-get
58e0: 2d 73 74 61 74 75 73 20 74 29 29 29 20 66 61 69 -status t))) fai
58f0: 6c 73 29 20 22 2c 20 22 29 0a 09 09 09 09 20 20 ls) ", ").....
5900: 20 20 20 22 2c 20 72 65 6d 6f 76 69 6e 67 20 69 ", removing i
5910: 74 20 66 72 6f 6d 20 74 6f 2d 64 6f 20 6c 69 73 t from to-do lis
5920: 74 22 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 t")....(if (not
5930: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 (null? tal))....
5940: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
5950: 61 6c 29 28 63 64 72 20 74 61 6c 29 28 63 6f 6e al)(cdr tal)(con
5960: 73 20 68 65 64 20 72 65 72 75 6e 73 29 29 29 29 s hed reruns))))
5970: 0a 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 0a ... (else.
5980: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
5990: 38 20 22 45 52 52 4f 52 3a 20 4e 6f 20 68 61 6e 8 "ERROR: No han
59a0: 64 6c 65 72 20 66 6f 72 20 74 68 69 73 20 63 6f dler for this co
59b0: 6e 64 69 74 69 6f 6e 2e 22 29 0a 09 09 09 3b 3b ndition.")....;;
59c0: 20 09 20 20 20 20 20 22 5c 6e 20 20 68 65 64 3a . "\n hed:
59d0: 20 20 20 20 20 20 20 20 20 20 20 20 22 20 68 65 " he
59e0: 64 20 0a 09 09 09 3b 3b 20 09 20 20 20 20 20 22 d ....;; . "
59f0: 5c 6e 20 66 61 69 6c 73 3a 20 20 20 20 20 20 20 \n fails:
5a00: 20 20 20 20 22 20 28 73 74 72 69 6e 67 2d 69 6e " (string-in
5a10: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 64 tersperse (map d
5a20: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
5a30: 61 6d 65 20 66 61 69 6c 73 29 20 22 2c 22 29 0a ame fails) ",").
5a40: 09 09 09 3b 3b 20 09 20 20 20 20 20 22 5c 6e 20 ...;; . "\n
5a50: 74 65 73 74 6d 6f 64 65 3a 20 20 20 20 20 20 20 testmode:
5a60: 20 22 20 74 65 73 74 6d 6f 64 65 0a 09 09 09 3b " testmode....;
5a70: 3b 20 09 20 20 20 20 20 22 5c 6e 20 70 72 65 72 ; . "\n prer
5a80: 65 71 73 2d 6e 6f 74 2d 6d 65 74 3a 20 22 20 28 eqs-not-met: " (
5a90: 70 72 65 74 74 79 2d 73 74 72 69 6e 67 20 70 72 pretty-string pr
5aa0: 65 72 65 71 73 2d 6e 6f 74 2d 6d 65 74 29 0a 09 ereqs-not-met)..
5ab0: 09 09 3b 3b 20 09 20 20 20 20 20 22 5c 6e 20 69 ..;; . "\n i
5ac0: 74 65 6d 73 3a 20 20 20 20 20 20 20 20 20 20 20 tems:
5ad0: 22 20 69 74 65 6d 73 29 0a 09 09 09 28 6c 6f 6f " items)....(loo
5ae0: 70 20 28 63 61 72 20 6e 65 77 74 61 6c 29 28 63 p (car newtal)(c
5af0: 64 72 20 6e 65 77 74 61 6c 29 20 72 65 72 75 6e dr newtal) rerun
5b00: 73 29 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 69 s))))... ;; i
5b10: 66 20 63 61 6e 27 74 20 72 75 6e 20 6d 6f 72 65 f can't run more
5b20: 20 6a 75 73 74 20 6c 6f 6f 70 20 77 69 74 68 20 just loop with
5b30: 6e 65 78 74 20 70 6f 73 73 69 62 6c 65 20 74 65 next possible te
5b40: 73 74 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a st... (begin.
5b50: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
5b60: 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 70 72 rint 4 "INFO: pr
5b70: 6f 63 65 73 73 69 6e 67 20 74 68 65 20 63 61 73 ocessing the cas
5b80: 65 20 77 69 74 68 20 61 20 6c 61 6d 62 64 61 20 e with a lambda
5b90: 66 6f 72 20 69 74 65 6d 73 20 6f 72 20 27 68 61 for items or 'ha
5ba0: 76 65 2d 70 72 6f 63 65 64 75 72 65 2e 20 4d 6f ve-procedure. Mo
5bb0: 76 69 6e 67 20 74 68 72 6f 75 67 68 20 74 68 65 ving through the
5bc0: 20 71 75 65 75 65 20 77 69 74 68 6f 75 74 20 64 queue without d
5bd0: 72 6f 70 70 69 6e 67 20 22 20 68 65 64 29 0a 09 ropping " hed)..
5be0: 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
5bf0: 6c 65 65 70 21 20 28 2b 20 31 20 2a 67 6c 6f 62 leep! (+ 1 *glob
5c00: 61 6c 2d 64 65 6c 74 61 2a 29 29 0a 09 09 20 20 al-delta*))...
5c10: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 6e (loop (car n
5c20: 65 77 74 61 6c 29 28 63 64 72 20 6e 65 77 74 61 ewtal)(cdr newta
5c30: 6c 29 20 72 65 72 75 6e 73 29 29 29 29 29 0a 09 l) reruns)))))..
5c40: 20 20 20 20 20 0a 09 20 20 20 20 20 3b 3b 20 74 .. ;; t
5c50: 68 69 73 20 63 61 73 65 20 73 68 6f 75 6c 64 20 his case should
5c60: 6e 6f 74 20 68 61 70 70 65 6e 2c 20 61 64 64 65 not happen, adde
5c70: 64 20 74 6f 20 68 65 6c 70 20 63 61 74 63 68 20 d to help catch
5c80: 61 6e 79 20 62 75 67 73 0a 09 20 20 20 20 20 28 any bugs.. (
5c90: 28 61 6e 64 20 28 6c 69 73 74 3f 20 69 74 65 6d (and (list? item
5ca0: 73 29 20 69 74 65 6d 64 61 74 29 0a 09 20 20 20 s) itemdat)..
5cb0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5cc0: 30 20 22 45 52 52 4f 52 3a 20 53 68 6f 75 6c 64 0 "ERROR: Should
5cd0: 20 6e 6f 74 20 68 61 76 65 20 61 20 6c 69 73 74 not have a list
5ce0: 20 6f 66 20 69 74 65 6d 73 20 69 6e 20 61 20 74 of items in a t
5cf0: 65 73 74 20 61 6e 64 20 74 68 65 20 69 74 65 6d est and the item
5d00: 73 70 61 74 68 20 73 65 74 20 2d 20 70 6c 65 61 spath set - plea
5d10: 73 65 20 72 65 70 6f 72 74 20 74 68 69 73 22 29 se report this")
5d20: 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 29 .. (exit 1)
5d30: 29 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 77 65 ))).. .. ;; we
5d40: 20 67 65 74 20 68 65 72 65 20 6f 6e 20 22 64 72 get here on "dr
5d50: 6f 70 20 74 68 72 6f 75 67 68 22 20 2d 20 6c 6f op through" - lo
5d60: 6f 70 20 66 6f 72 20 6e 65 78 74 20 74 65 73 74 op for next test
5d70: 20 69 6e 20 71 75 65 75 65 0a 09 20 20 28 69 66 in queue.. (if
5d80: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 09 20 20 (null? tal)..
5d90: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 3b 3b 20 (begin...;;
5da0: 46 49 58 4d 45 21 21 21 21 20 54 48 49 53 20 53 FIXME!!!! THIS S
5db0: 48 4f 55 4c 44 20 4e 4f 54 20 52 45 51 55 49 52 HOULD NOT REQUIR
5dc0: 45 20 41 4e 20 45 58 49 54 21 21 21 21 21 21 21 E AN EXIT!!!!!!!
5dd0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
5de0: 31 20 22 49 4e 46 4f 3a 20 41 6c 6c 20 74 65 73 1 "INFO: All tes
5df0: 74 73 20 6c 61 75 6e 63 68 65 64 22 29 0a 09 09 ts launched")...
5e00: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 (thread-sleep! 0
5e10: 2e 35 29 0a 09 09 3b 3b 20 46 49 58 4d 45 21 20 .5)...;; FIXME!
5e20: 54 68 69 73 20 68 61 72 73 68 20 65 78 69 74 20 This harsh exit
5e30: 73 68 6f 75 6c 64 20 6e 6f 74 20 62 65 20 6e 65 should not be ne
5e40: 63 65 73 73 61 72 79 2e 2e 2e 2e 0a 09 09 28 69 cessary.......(i
5e50: 66 20 28 6e 6f 74 20 2a 72 75 6e 72 65 6d 6f 74 f (not *runremot
5e60: 65 2a 29 28 65 78 69 74 29 29 20 3b 3b 20 0a 09 e*)(exit)) ;; ..
5e70: 09 23 66 29 20 3b 3b 20 72 65 74 75 72 6e 20 61 .#f) ;; return a
5e80: 20 23 66 20 61 73 20 61 20 68 69 6e 74 20 74 68 #f as a hint th
5e90: 61 74 20 77 65 20 61 72 65 20 64 6f 6e 65 0a 09 at we are done..
5ea0: 20 20 20 20 20 20 3b 3b 20 48 65 72 65 20 77 65 ;; Here we
5eb0: 20 6e 65 65 64 20 74 6f 20 63 68 65 63 6b 20 74 need to check t
5ec0: 68 61 74 20 61 6c 6c 20 74 68 65 20 74 65 73 74 hat all the test
5ed0: 73 20 72 65 6d 61 69 6e 69 6e 67 20 74 6f 20 62 s remaining to b
5ee0: 65 20 72 75 6e 20 61 72 65 20 65 6c 69 67 69 62 e run are eligib
5ef0: 6c 65 20 74 6f 20 72 75 6e 0a 09 20 20 20 20 20 le to run..
5f00: 20 3b 3b 20 61 6e 64 20 61 72 65 20 6e 6f 74 20 ;; and are not
5f10: 62 6c 6f 63 6b 65 64 20 62 79 20 66 61 69 6c 65 blocked by faile
5f20: 64 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 d.. (let* (
5f30: 28 6e 65 77 6c 73 74 20 28 6f 70 65 6e 2d 72 75 (newlst (open-ru
5f40: 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 66 69 n-close tests:fi
5f50: 6c 74 65 72 2d 6e 6f 6e 2d 72 75 6e 6e 61 62 6c lter-non-runnabl
5f60: 65 20 23 66 20 72 75 6e 2d 69 64 20 74 61 6c 20 e #f run-id tal
5f70: 74 65 73 74 2d 72 65 63 6f 72 64 73 29 29 20 3b test-records)) ;
5f80: 3b 20 69 2e 65 2e 20 6e 6f 74 20 46 41 49 4c 2c ; i.e. not FAIL,
5f90: 20 57 41 49 56 45 44 2c 20 49 4e 43 4f 4d 50 4c WAIVED, INCOMPL
5fa0: 45 54 45 2c 20 50 41 53 53 2c 20 4b 49 4c 4c 45 ETE, PASS, KILLE
5fb0: 44 2c 0a 09 09 20 20 20 20 20 28 6a 75 6e 6b 65 D,... (junke
5fc0: 64 20 28 6c 73 65 74 2d 64 69 66 66 65 72 65 6e d (lset-differen
5fd0: 63 65 20 65 71 75 61 6c 3f 20 74 61 6c 20 6e 65 ce equal? tal ne
5fe0: 77 6c 73 74 29 29 29 0a 09 09 28 64 65 62 75 67 wlst)))...(debug
5ff0: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
6000: 66 75 6c 6c 20 64 72 6f 70 20 74 68 72 6f 75 67 full drop throug
6010: 68 2c 20 69 66 20 72 65 72 75 6e 73 20 69 73 20 h, if reruns is
6020: 6c 65 73 73 20 74 68 61 6e 20 31 30 30 20 77 65 less than 100 we
6030: 20 77 69 6c 6c 20 66 6f 72 63 65 20 72 65 74 72 will force retr
6040: 79 20 74 68 65 6d 3a 20 22 20 72 65 72 75 6e 73 y them: " reruns
6050: 29 0a 09 09 28 69 66 20 28 3c 20 6e 75 6d 2d 72 )...(if (< num-r
6060: 65 74 72 69 65 73 20 6d 61 78 2d 72 65 74 72 69 etries max-retri
6070: 65 73 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 es)... (set!
6080: 6e 65 77 6c 73 74 20 28 61 70 70 65 6e 64 20 72 newlst (append r
6090: 65 72 75 6e 73 20 6e 65 77 6c 73 74 29 29 29 0a eruns newlst))).
60a0: 09 09 28 73 65 74 21 20 6e 75 6d 2d 72 65 74 72 ..(set! num-retr
60b0: 69 65 73 20 28 2b 20 6e 75 6d 2d 72 65 74 72 69 ies (+ num-retri
60c0: 65 73 20 31 29 29 0a 09 09 28 74 68 72 65 61 64 es 1))...(thread
60d0: 2d 73 6c 65 65 70 21 20 2a 67 6c 6f 62 61 6c 2d -sleep! *global-
60e0: 64 65 6c 74 61 2a 29 0a 09 09 28 69 66 20 28 6e delta*)...(if (n
60f0: 6f 74 20 28 6e 75 6c 6c 3f 20 6e 65 77 6c 73 74 ot (null? newlst
6100: 29 29 0a 09 09 20 20 20 20 3b 3b 20 73 69 6e 63 ))... ;; sinc
6110: 65 20 72 65 72 75 6e 73 20 68 61 76 65 20 62 65 e reruns have be
6120: 65 6e 20 74 61 63 6b 65 64 20 6f 6e 20 74 6f 20 en tacked on to
6130: 6e 65 77 6c 73 74 20 63 72 65 61 74 65 20 6e 65 newlst create ne
6140: 77 20 72 65 72 75 6e 73 20 66 72 6f 6d 20 6a 75 w reruns from ju
6150: 6e 6b 65 64 0a 09 09 20 20 20 20 28 6c 6f 6f 70 nked... (loop
6160: 20 28 63 61 72 20 6e 65 77 6c 73 74 29 28 63 64 (car newlst)(cd
6170: 72 20 6e 65 77 6c 73 74 29 28 64 65 6c 65 74 65 r newlst)(delete
6180: 2d 64 75 70 6c 69 63 61 74 65 73 20 6a 75 6e 6b -duplicates junk
6190: 65 64 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 ed)))))))))..;;
61a0: 70 61 72 65 6e 74 2d 74 65 73 74 20 69 73 20 74 parent-test is t
61b0: 68 65 72 65 20 61 73 20 61 20 70 6c 61 63 65 68 here as a placeh
61c0: 6f 6c 64 65 72 20 66 6f 72 20 77 68 65 6e 20 70 older for when p
61d0: 61 72 65 6e 74 2d 74 65 73 74 73 20 63 61 6e 20 arent-tests can
61e0: 62 65 20 72 75 6e 20 61 73 20 61 20 73 65 74 75 be run as a setu
61f0: 70 20 73 74 65 70 0a 28 64 65 66 69 6e 65 20 28 p step.(define (
6200: 72 75 6e 3a 74 65 73 74 20 72 75 6e 2d 69 64 20 run:test run-id
6210: 72 75 6e 6e 61 6d 65 20 6b 65 79 76 61 6c 6c 73 runname keyvalls
6220: 74 20 74 65 73 74 2d 72 65 63 6f 72 64 20 66 6c t test-record fl
6230: 61 67 73 20 70 61 72 65 6e 74 2d 74 65 73 74 29 ags parent-test)
6240: 0a 20 20 3b 3b 20 41 6c 6c 20 74 68 65 73 65 20 . ;; All these
6250: 76 61 72 73 20 6d 69 67 68 74 20 62 65 20 72 65 vars might be re
6260: 66 65 72 65 6e 63 65 64 20 62 79 20 74 68 65 20 ferenced by the
6270: 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 20 testconfig file
6280: 72 65 61 64 65 72 0a 20 20 28 6c 65 74 2a 20 28 reader. (let* (
6290: 28 74 65 73 74 2d 6e 61 6d 65 20 20 20 20 28 74 (test-name (t
62a0: 65 73 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 ests:testqueue-g
62b0: 65 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 74 65 et-testname te
62c0: 73 74 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 st-record)).. (t
62d0: 65 73 74 2d 77 61 69 74 6f 6e 73 20 28 74 65 73 est-waitons (tes
62e0: 74 73 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 ts:testqueue-get
62f0: 2d 77 61 69 74 6f 6e 73 20 20 20 20 74 65 73 74 -waitons test
6300: 2d 72 65 63 6f 72 64 29 29 0a 09 20 28 74 65 73 -record)).. (tes
6310: 74 2d 63 6f 6e 66 20 20 20 20 28 74 65 73 74 73 t-conf (tests
6320: 3a 74 65 73 74 71 75 65 75 65 2d 67 65 74 2d 74 :testqueue-get-t
6330: 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 72 estconfig test-r
6340: 65 63 6f 72 64 29 29 0a 09 20 28 69 74 65 6d 64 ecord)).. (itemd
6350: 61 74 20 20 20 20 20 20 28 74 65 73 74 73 3a 74 at (tests:t
6360: 65 73 74 71 75 65 75 65 2d 67 65 74 2d 69 74 65 estqueue-get-ite
6370: 6d 64 61 74 20 20 20 20 74 65 73 74 2d 72 65 63 mdat test-rec
6380: 6f 72 64 29 29 0a 09 20 28 74 65 73 74 2d 70 61 ord)).. (test-pa
6390: 74 68 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 th (conc *top
63a0: 70 61 74 68 2a 20 22 2f 74 65 73 74 73 2f 22 20 path* "/tests/"
63b0: 74 65 73 74 2d 6e 61 6d 65 29 29 20 3b 3b 20 63 test-name)) ;; c
63c0: 6f 75 6c 64 20 75 73 65 20 74 65 73 74 73 3a 67 ould use tests:g
63d0: 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 68 65 et-testconfig he
63e0: 72 65 20 2e 2e 2e 0a 09 20 28 66 6f 72 63 65 20 re ..... (force
63f0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
6400: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 66 le-ref/default f
6410: 6c 61 67 73 20 22 2d 66 6f 72 63 65 22 20 23 66 lags "-force" #f
6420: 29 29 0a 09 20 28 72 65 72 75 6e 20 20 20 20 20 )).. (rerun
6430: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
6440: 65 66 2f 64 65 66 61 75 6c 74 20 66 6c 61 67 73 ef/default flags
6450: 20 22 2d 72 65 72 75 6e 22 20 23 66 29 29 0a 09 "-rerun" #f))..
6460: 20 28 6b 65 65 70 67 6f 69 6e 67 20 20 20 20 28 (keepgoing (
6470: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
6480: 65 66 61 75 6c 74 20 66 6c 61 67 73 20 22 2d 6b efault flags "-k
6490: 65 65 70 67 6f 69 6e 67 22 20 23 66 29 29 0a 09 eepgoing" #f))..
64a0: 20 28 69 74 65 6d 2d 70 61 74 68 20 20 20 20 20 (item-path
64b0: 22 22 29 0a 09 20 28 64 62 20 20 20 20 20 20 20 "").. (db
64c0: 20 20 20 20 23 66 29 29 0a 20 20 20 20 28 64 65 #f)). (de
64d0: 62 75 67 3a 70 72 69 6e 74 20 34 0a 09 09 20 22 bug:print 4... "
64e0: 74 65 73 74 2d 63 6f 6e 66 69 67 3a 20 22 20 28 test-config: " (
64f0: 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
6500: 74 20 74 65 73 74 2d 63 6f 6e 66 29 0a 09 09 20 t test-conf)...
6510: 22 5c 6e 20 20 20 69 74 65 6d 64 61 74 3a 20 22 "\n itemdat: "
6520: 20 69 74 65 6d 64 61 74 0a 09 09 20 29 0a 20 20 itemdat... ).
6530: 20 20 3b 3b 20 73 65 74 74 69 6e 67 20 69 74 65 ;; setting ite
6540: 6d 64 61 74 20 74 6f 20 61 20 6c 69 73 74 20 69 mdat to a list i
6550: 66 20 69 74 20 69 73 20 23 66 0a 20 20 20 20 28 f it is #f. (
6560: 69 66 20 28 6e 6f 74 20 69 74 65 6d 64 61 74 29 if (not itemdat)
6570: 28 73 65 74 21 20 69 74 65 6d 64 61 74 20 27 28 (set! itemdat '(
6580: 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 69 74 ))). (set! it
6590: 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 em-path (item-li
65a0: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
65b0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
65c0: 69 6e 74 20 32 20 22 41 74 74 65 6d 70 74 69 6e int 2 "Attemptin
65d0: 67 20 74 6f 20 6c 61 75 6e 63 68 20 74 65 73 74 g to launch test
65e0: 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 28 69 66 " test-name (if
65f0: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
6600: 74 68 20 22 2f 22 29 20 22 2f 22 20 69 74 65 6d th "/") "/" item
6610: 2d 70 61 74 68 29 29 0a 20 20 20 20 28 73 65 74 -path)). (set
6620: 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d env "MT_TEST_NAM
6630: 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 20 3b 3b E" test-name) ;;
6640: 20 0a 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d . (setenv "M
6650: 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
6660: 6e 61 6d 65 29 0a 20 20 20 20 28 6f 70 65 6e 2d name). (open-
6670: 72 75 6e 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 run-close-measur
6680: 65 20 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 e set-megatest-e
6690: 6e 76 2d 76 61 72 73 20 64 62 20 72 75 6e 2d 69 nv-vars db run-i
66a0: 64 29 20 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 d) ;; these may
66b0: 62 65 20 6e 65 65 64 65 64 20 62 79 20 74 68 65 be needed by the
66c0: 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 launching proce
66d0: 73 73 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 ss. (change-d
66e0: 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
66f0: 68 2a 29 0a 0a 20 20 20 20 3b 3b 20 48 65 72 65 h*).. ;; Here
6700: 20 69 73 20 77 68 65 72 65 20 74 68 65 20 74 65 is where the te
6710: 73 74 5f 6d 65 74 61 20 74 61 62 6c 65 20 69 73 st_meta table is
6720: 20 62 65 73 74 20 75 70 64 61 74 65 64 0a 20 20 best updated.
6730: 20 20 3b 3b 20 59 65 73 2c 20 61 6e 6f 74 68 65 ;; Yes, anothe
6740: 72 20 75 73 65 20 6f 66 20 61 20 67 6c 6f 62 61 r use of a globa
6750: 6c 20 66 6f 72 20 63 61 63 68 69 6e 67 2e 20 4e l for caching. N
6760: 65 65 64 20 61 20 62 65 74 74 65 72 20 77 61 79 eed a better way
6770: 3f 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ?. (if (not (
6780: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
6790: 65 66 61 75 6c 74 20 2a 74 65 73 74 2d 6d 65 74 efault *test-met
67a0: 61 2d 75 70 64 61 74 65 64 2a 20 74 65 73 74 2d a-updated* test-
67b0: 6e 61 6d 65 20 23 66 29 29 0a 20 20 20 20 20 20 name #f)).
67c0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 28 68 61 (begin.. (ha
67d0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
67e0: 65 73 74 2d 6d 65 74 61 2d 75 70 64 61 74 65 64 est-meta-updated
67f0: 2a 20 74 65 73 74 2d 6e 61 6d 65 20 23 74 29 0a * test-name #t).
6800: 20 20 20 20 20 20 20 20 20 20 20 28 6f 70 65 6e (open
6810: 2d 72 75 6e 2d 63 6c 6f 73 65 20 72 75 6e 73 3a -run-close runs:
6820: 75 70 64 61 74 65 2d 74 65 73 74 5f 6d 65 74 61 update-test_meta
6830: 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 db test-name te
6840: 73 74 2d 63 6f 6e 66 29 29 29 0a 20 20 20 20 0a st-conf))). .
6850: 20 20 20 20 3b 3b 20 28 6c 61 6d 62 64 61 20 28 ;; (lambda (
6860: 69 74 65 6d 64 61 74 29 20 3b 3b 3b 20 28 28 72 itemdat) ;;; ((r
6870: 69 70 65 6e 65 73 73 20 22 6f 76 65 72 72 69 70 ipeness "overrip
6880: 65 22 29 20 28 74 65 6d 70 65 72 61 74 75 72 65 e") (temperature
6890: 20 22 63 6f 6f 6c 22 29 20 28 73 65 61 73 6f 6e "cool") (season
68a0: 20 22 73 75 6d 6d 65 72 22 29 29 0a 20 20 20 20 "summer")).
68b0: 28 6c 65 74 2a 20 28 28 6e 65 77 2d 74 65 73 74 (let* ((new-test
68c0: 2d 70 61 74 68 20 28 73 74 72 69 6e 67 2d 69 6e -path (string-in
68d0: 74 65 72 73 70 65 72 73 65 20 28 63 6f 6e 73 20 tersperse (cons
68e0: 74 65 73 74 2d 70 61 74 68 20 28 6d 61 70 20 63 test-path (map c
68f0: 61 64 72 20 69 74 65 6d 64 61 74 29 29 20 22 2f adr itemdat)) "/
6900: 22 29 29 0a 09 20 20 20 28 6e 65 77 2d 74 65 73 ")).. (new-tes
6910: 74 2d 6e 61 6d 65 20 28 69 66 20 28 65 71 75 61 t-name (if (equa
6920: 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 l? item-path "")
6930: 20 74 65 73 74 2d 6e 61 6d 65 20 28 63 6f 6e 63 test-name (conc
6940: 20 74 65 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 test-name "/" i
6950: 74 65 6d 2d 70 61 74 68 29 29 29 20 3b 3b 20 6a tem-path))) ;; j
6960: 75 73 74 20 6e 65 65 64 20 69 74 20 74 6f 20 62 ust need it to b
6970: 65 20 75 6e 69 71 75 65 0a 09 20 20 20 28 74 65 e unique.. (te
6980: 73 74 2d 69 64 20 20 20 20 20 20 20 28 6f 70 65 st-id (ope
6990: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
69a0: 65 74 2d 74 65 73 74 2d 69 64 20 64 62 20 20 72 et-test-id db r
69b0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
69c0: 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 item-path))..
69d0: 28 74 65 73 74 64 61 74 20 20 20 20 20 20 20 28 (testdat (
69e0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
69f0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
6a00: 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 by-id db test-id
6a10: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e ))). (if (n
6a20: 6f 74 20 74 65 73 74 64 61 74 29 0a 09 20 20 28 ot testdat).. (
6a30: 62 65 67 69 6e 0a 09 20 20 20 20 3b 3b 20 65 6e begin.. ;; en
6a40: 73 75 72 65 20 74 68 61 74 20 74 68 65 20 70 61 sure that the pa
6a50: 74 68 20 65 78 69 73 74 73 20 62 65 66 6f 72 65 th exists before
6a60: 20 72 65 67 69 73 74 65 72 69 6e 67 20 74 68 65 registering the
6a70: 20 74 65 73 74 0a 09 20 20 20 20 3b 3b 20 4e 4f test.. ;; NO
6a80: 50 45 3a 20 43 61 6e 6e 6f 74 21 20 44 6f 6e 27 PE: Cannot! Don'
6a90: 74 20 6b 6e 6f 77 20 79 65 74 20 77 68 69 63 68 t know yet which
6aa0: 20 64 69 73 6b 20 61 72 65 61 20 77 69 6c 6c 20 disk area will
6ab0: 62 65 20 61 73 73 69 67 6e 65 64 2e 2e 2e 2e 0a be assigned.....
6ac0: 09 20 20 20 20 3b 3b 20 28 73 79 73 74 65 6d 20 . ;; (system
6ad0: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
6ae0: 22 20 6e 65 77 2d 74 65 73 74 2d 70 61 74 68 29 " new-test-path)
6af0: 29 0a 09 20 20 20 20 3b 3b 0a 09 20 20 20 20 3b ).. ;;.. ;
6b00: 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ; (open-run-clos
6b10: 65 20 74 65 73 74 73 3a 72 65 67 69 73 74 65 72 e tests:register
6b20: 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 -test db run-id
6b30: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 test-name item-p
6b40: 61 74 68 29 0a 09 20 20 20 20 3b 3b 0a 09 20 20 ath).. ;;..
6b50: 20 20 3b 3b 20 4e 42 2f 2f 20 66 6f 72 20 74 68 ;; NB// for th
6b60: 65 20 61 62 6f 76 65 20 6c 69 6e 65 2e 20 49 20 e above line. I
6b70: 77 61 6e 74 20 74 68 65 20 74 65 73 74 20 74 6f want the test to
6b80: 20 62 65 20 72 65 67 69 73 74 65 72 65 64 20 6c be registered l
6b90: 6f 6e 67 20 62 65 66 6f 72 65 20 74 68 69 73 20 ong before this
6ba0: 72 6f 75 74 69 6e 65 20 67 65 74 73 20 63 61 6c routine gets cal
6bb0: 6c 65 64 21 0a 09 20 20 20 20 3b 3b 0a 09 20 20 led!.. ;;..
6bc0: 20 20 28 73 65 74 21 20 74 65 73 74 2d 69 64 20 (set! test-id
6bd0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
6be0: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 db:get-test-id d
6bf0: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 b run-id test-na
6c00: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 me item-path))..
6c10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 74 65 73 (if (not tes
6c20: 74 2d 69 64 29 0a 09 09 28 62 65 67 69 6e 0a 09 t-id)...(begin..
6c30: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
6c40: 32 20 22 57 41 52 4e 3a 20 54 65 73 74 20 6e 6f 2 "WARN: Test no
6c50: 74 20 70 72 65 2d 63 72 65 61 74 65 64 3f 20 74 t pre-created? t
6c60: 65 73 74 2d 6e 61 6d 65 3d 22 20 74 65 73 74 2d est-name=" test-
6c70: 6e 61 6d 65 20 22 2c 20 69 74 65 6d 2d 70 61 74 name ", item-pat
6c80: 68 3d 22 20 69 74 65 6d 2d 70 61 74 68 20 22 2c h=" item-path ",
6c90: 20 72 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 run-id=" run-id
6ca0: 29 0a 09 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d )... (open-run-
6cb0: 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 2d 72 close db:tests-r
6cc0: 65 67 69 73 74 65 72 2d 74 65 73 74 20 64 62 20 egister-test db
6cd0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
6ce0: 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 20 20 item-path)...
6cf0: 28 73 65 74 21 20 74 65 73 74 2d 69 64 20 28 6f (set! test-id (o
6d00: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 pen-run-close db
6d10: 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 20 :get-test-id db
6d20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
6d30: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 item-path))))..
6d40: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6d50: 20 34 20 22 49 4e 46 4f 3a 20 74 65 73 74 2d 69 4 "INFO: test-i
6d60: 64 3d 22 20 74 65 73 74 2d 69 64 20 22 2c 20 72 d=" test-id ", r
6d70: 75 6e 2d 69 64 3d 22 20 72 75 6e 2d 69 64 20 22 un-id=" run-id "
6d80: 2c 20 74 65 73 74 2d 6e 61 6d 65 3d 22 20 74 65 , test-name=" te
6d90: 73 74 2d 6e 61 6d 65 20 22 2c 20 69 74 65 6d 2d st-name ", item-
6da0: 70 61 74 68 3d 5c 22 22 20 69 74 65 6d 2d 70 61 path=\"" item-pa
6db0: 74 68 20 22 5c 22 22 29 0a 09 20 20 20 20 28 73 th "\"").. (s
6dc0: 65 74 21 20 74 65 73 74 64 61 74 20 28 6f 70 65 et! testdat (ope
6dd0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
6de0: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
6df0: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 29 id db test-id)))
6e00: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 74 65 ). (set! te
6e10: 73 74 2d 69 64 20 28 64 62 3a 74 65 73 74 2d 67 st-id (db:test-g
6e20: 65 74 2d 69 64 20 74 65 73 74 64 61 74 29 29 0a et-id testdat)).
6e30: 20 20 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 (change-di
6e40: 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 74 rectory test-pat
6e50: 68 29 0a 20 20 20 20 20 20 28 63 61 73 65 20 28 h). (case (
6e60: 69 66 20 66 6f 72 63 65 20 3b 3b 20 28 61 72 67 if force ;; (arg
6e70: 73 3a 67 65 74 2d 61 72 67 20 22 2d 66 6f 72 63 s:get-arg "-forc
6e80: 65 22 29 0a 09 09 27 4e 4f 54 5f 53 54 41 52 54 e")...'NOT_START
6e90: 45 44 0a 09 09 28 69 66 20 74 65 73 74 64 61 74 ED...(if testdat
6ea0: 0a 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 3e ... (string->
6eb0: 73 79 6d 62 6f 6c 20 28 74 65 73 74 3a 67 65 74 symbol (test:get
6ec0: 2d 73 74 61 74 65 20 74 65 73 74 64 61 74 29 29 -state testdat))
6ed0: 0a 09 09 20 20 20 20 27 66 61 69 6c 65 64 2d 74 ... 'failed-t
6ee0: 6f 2d 69 6e 73 65 72 74 29 29 0a 09 28 28 66 61 o-insert))..((fa
6ef0: 69 6c 65 64 2d 74 6f 2d 69 6e 73 65 72 74 29 0a iled-to-insert).
6f00: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 . (debug:print 0
6f10: 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 "ERROR: Failed
6f20: 74 6f 20 69 6e 73 65 72 74 20 74 68 65 20 72 65 to insert the re
6f30: 63 6f 72 64 20 69 6e 74 6f 20 74 68 65 20 64 62 cord into the db
6f40: 22 29 29 0a 09 28 28 4e 4f 54 5f 53 54 41 52 54 "))..((NOT_START
6f50: 45 44 20 43 4f 4d 50 4c 45 54 45 44 29 0a 09 20 ED COMPLETED)..
6f60: 28 6c 65 74 20 28 28 72 75 6e 66 6c 61 67 20 23 (let ((runflag #
6f70: 66 29 29 0a 09 20 20 20 28 63 6f 6e 64 0a 09 20 f)).. (cond..
6f80: 20 20 20 3b 3b 20 2d 66 6f 72 63 65 2c 20 72 75 ;; -force, ru
6f90: 6e 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 74 n no matter what
6fa0: 0a 09 20 20 20 20 28 66 6f 72 63 65 20 28 73 65 .. (force (se
6fb0: 74 21 20 72 75 6e 66 6c 61 67 20 23 74 29 29 0a t! runflag #t)).
6fc0: 09 20 20 20 20 3b 3b 20 4e 4f 54 5f 53 54 41 52 . ;; NOT_STAR
6fd0: 54 45 44 2c 20 72 75 6e 20 6e 6f 20 6d 61 74 74 TED, run no matt
6fe0: 65 72 20 77 68 61 74 0a 09 20 20 20 20 28 28 65 er what.. ((e
6ff0: 71 75 61 6c 3f 20 28 74 65 73 74 3a 67 65 74 2d qual? (test:get-
7000: 73 74 61 74 65 20 74 65 73 74 64 61 74 29 20 22 state testdat) "
7010: 4e 4f 54 5f 53 54 41 52 54 45 44 22 29 28 73 65 NOT_STARTED")(se
7020: 74 21 20 72 75 6e 66 6c 61 67 20 23 74 29 29 0a t! runflag #t)).
7030: 09 20 20 20 20 3b 3b 20 6e 6f 74 20 2d 72 65 72 . ;; not -rer
7040: 75 6e 20 61 6e 64 20 50 41 53 53 2c 20 57 41 52 un and PASS, WAR
7050: 4e 20 6f 72 20 43 48 45 43 4b 2c 20 64 6f 20 6e N or CHECK, do n
7060: 6f 20 72 75 6e 0a 09 20 20 20 20 28 28 61 6e 64 o run.. ((and
7070: 20 28 6f 72 20 28 6e 6f 74 20 72 65 72 75 6e 29 (or (not rerun)
7080: 0a 09 09 20 20 20 20 20 20 6b 65 65 70 67 6f 69 ... keepgoi
7090: 6e 67 29 0a 09 09 20 20 3b 3b 20 52 65 71 75 69 ng)... ;; Requi
70a0: 72 65 20 74 6f 20 66 6f 72 63 65 20 72 65 2d 72 re to force re-r
70b0: 75 6e 20 66 6f 72 20 43 4f 4d 50 4c 45 54 45 44 un for COMPLETED
70c0: 20 6f 72 20 2a 61 6e 79 74 68 69 6e 67 2a 20 2b or *anything* +
70d0: 20 50 41 53 53 2c 57 41 52 4e 20 6f 72 20 43 48 PASS,WARN or CH
70e0: 45 43 4b 0a 09 09 20 20 28 6f 72 20 28 6d 65 6d ECK... (or (mem
70f0: 62 65 72 20 28 74 65 73 74 3a 67 65 74 2d 73 74 ber (test:get-st
7100: 61 74 75 73 20 74 65 73 74 64 61 74 29 20 27 28 atus testdat) '(
7110: 22 50 41 53 53 22 20 22 57 41 52 4e 22 20 22 43 "PASS" "WARN" "C
7120: 48 45 43 4b 22 29 29 0a 09 09 20 20 20 20 20 20 HECK"))...
7130: 28 6d 65 6d 62 65 72 20 28 74 65 73 74 3a 67 65 (member (test:ge
7140: 74 2d 73 74 61 74 65 20 20 74 65 73 74 64 61 74 t-state testdat
7150: 29 20 27 28 22 43 4f 4d 50 4c 45 54 45 44 22 29 ) '("COMPLETED")
7160: 29 29 29 20 0a 09 20 20 20 20 20 28 64 65 62 75 ))) .. (debu
7170: 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a g:print 2 "INFO:
7180: 20 72 75 6e 6e 69 6e 67 20 74 65 73 74 20 22 20 running test "
7190: 74 65 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 test-name "/" it
71a0: 65 6d 2d 70 61 74 68 20 22 20 73 75 70 70 72 65 em-path " suppre
71b0: 73 73 65 64 20 61 73 20 69 74 20 69 73 20 22 20 ssed as it is "
71c0: 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 65 20 (test:get-state
71d0: 74 65 73 74 64 61 74 29 20 22 20 61 6e 64 20 22 testdat) " and "
71e0: 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 (test:get-statu
71f0: 73 20 74 65 73 74 64 61 74 29 29 0a 09 20 20 20 s testdat))..
7200: 20 20 28 73 65 74 21 20 72 75 6e 66 6c 61 67 20 (set! runflag
7210: 23 66 29 29 0a 09 20 20 20 20 3b 3b 20 2d 72 65 #f)).. ;; -re
7220: 72 75 6e 20 61 6e 64 20 73 74 61 74 75 73 20 69 run and status i
7230: 73 20 6f 6e 65 20 6f 66 20 74 68 65 20 73 70 65 s one of the spe
7240: 63 69 66 65 64 2c 20 72 75 6e 20 69 74 0a 09 20 cifed, run it..
7250: 20 20 20 28 28 61 6e 64 20 72 65 72 75 6e 0a 09 ((and rerun..
7260: 09 20 20 28 6c 65 74 2a 20 28 28 72 65 72 75 6e . (let* ((rerun
7270: 6c 73 74 20 20 20 28 73 74 72 69 6e 67 2d 73 70 lst (string-sp
7280: 6c 69 74 20 72 65 72 75 6e 20 22 2c 22 29 29 0a lit rerun ",")).
7290: 09 09 09 20 28 6d 75 73 74 2d 72 65 72 75 6e 20 ... (must-rerun
72a0: 28 6d 65 6d 62 65 72 20 28 74 65 73 74 3a 67 65 (member (test:ge
72b0: 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 t-status testdat
72c0: 29 20 72 65 72 75 6e 6c 73 74 29 29 29 0a 09 09 ) rerunlst)))...
72d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
72e0: 20 33 20 22 49 4e 46 4f 3a 20 2d 72 65 72 75 6e 3 "INFO: -rerun
72f0: 20 6c 69 73 74 3a 20 22 20 72 65 72 75 6e 20 22 list: " rerun "
7300: 2c 20 74 65 73 74 2d 73 74 61 74 75 73 3a 20 22 , test-status: "
7310: 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 (test:get-statu
7320: 73 20 74 65 73 74 64 61 74 29 22 2c 20 6d 75 73 s testdat)", mus
7330: 74 2d 72 65 72 75 6e 3a 20 22 20 6d 75 73 74 2d t-rerun: " must-
7340: 72 65 72 75 6e 29 0a 09 09 20 20 20 20 6d 75 73 rerun)... mus
7350: 74 2d 72 65 72 75 6e 29 29 0a 09 20 20 20 20 20 t-rerun))..
7360: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
7370: 49 4e 46 4f 3a 20 52 65 72 75 6e 20 66 6f 72 63 INFO: Rerun forc
7380: 65 64 20 66 6f 72 20 74 65 73 74 20 22 20 74 65 ed for test " te
7390: 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d st-name "/" item
73a0: 2d 70 61 74 68 29 0a 09 20 20 20 20 20 28 73 65 -path).. (se
73b0: 74 21 20 72 75 6e 66 6c 61 67 20 23 74 29 29 0a t! runflag #t)).
73c0: 09 20 20 20 20 3b 3b 20 2d 6b 65 65 70 67 6f 69 . ;; -keepgoi
73d0: 6e 67 2c 20 64 6f 20 6e 6f 74 20 72 65 72 75 6e ng, do not rerun
73e0: 20 46 41 49 4c 0a 09 20 20 20 20 28 28 61 6e 64 FAIL.. ((and
73f0: 20 6b 65 65 70 67 6f 69 6e 67 0a 09 09 20 20 28 keepgoing... (
7400: 6d 65 6d 62 65 72 20 28 74 65 73 74 3a 67 65 74 member (test:get
7410: 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 29 -status testdat)
7420: 20 27 28 22 46 41 49 4c 22 29 29 29 0a 09 20 20 '("FAIL")))..
7430: 20 20 20 28 73 65 74 21 20 72 75 6e 66 6c 61 67 (set! runflag
7440: 20 23 66 29 29 0a 09 20 20 20 20 28 28 61 6e 64 #f)).. ((and
7450: 20 28 6e 6f 74 20 72 65 72 75 6e 29 0a 09 09 20 (not rerun)...
7460: 20 28 6d 65 6d 62 65 72 20 28 74 65 73 74 3a 67 (member (test:g
7470: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 et-status testda
7480: 74 29 20 27 28 22 46 41 49 4c 22 20 22 6e 2f 61 t) '("FAIL" "n/a
7490: 22 29 29 29 0a 09 20 20 20 20 20 28 73 65 74 21 "))).. (set!
74a0: 20 72 75 6e 66 6c 61 67 20 23 74 29 29 0a 09 20 runflag #t))..
74b0: 20 20 20 28 65 6c 73 65 20 28 73 65 74 21 20 72 (else (set! r
74c0: 75 6e 66 6c 61 67 20 23 66 29 29 29 0a 09 20 20 unflag #f)))..
74d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 36 20 (debug:print 6
74e0: 22 52 55 4e 4e 49 4e 47 20 3d 3e 20 72 75 6e 66 "RUNNING => runf
74f0: 6c 61 67 3a 20 22 20 72 75 6e 66 6c 61 67 20 22 lag: " runflag "
7500: 20 53 54 41 54 45 3a 20 22 20 28 74 65 73 74 3a STATE: " (test:
7510: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 64 61 get-state testda
7520: 74 29 20 22 20 53 54 41 54 55 53 3a 20 22 20 28 t) " STATUS: " (
7530: 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 73 20 test:get-status
7540: 74 65 73 74 64 61 74 29 29 0a 09 20 20 20 28 69 testdat)).. (i
7550: 66 20 28 6e 6f 74 20 72 75 6e 66 6c 61 67 29 0a f (not runflag).
7560: 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 . (if (not
7570: 20 70 61 72 65 6e 74 2d 74 65 73 74 29 0a 09 09 parent-test)...
7580: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
7590: 31 20 22 4e 4f 54 45 3a 20 4e 6f 74 20 73 74 61 1 "NOTE: Not sta
75a0: 72 74 69 6e 67 20 74 65 73 74 20 22 20 6e 65 77 rting test " new
75b0: 2d 74 65 73 74 2d 6e 61 6d 65 20 22 20 61 73 20 -test-name " as
75c0: 69 74 20 69 73 20 73 74 61 74 65 20 5c 22 22 20 it is state \""
75d0: 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 65 20 (test:get-state
75e0: 74 65 73 74 64 61 74 29 20 0a 09 09 09 09 22 5c testdat) ....."\
75f0: 22 20 61 6e 64 20 73 74 61 74 75 73 20 5c 22 22 " and status \""
7600: 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 (test:get-statu
7610: 73 20 74 65 73 74 64 61 74 29 20 22 5c 22 2c 20 s testdat) "\",
7620: 75 73 65 20 2d 72 65 72 75 6e 20 5c 22 22 20 28 use -rerun \"" (
7630: 74 65 73 74 3a 67 65 74 2d 73 74 61 74 75 73 20 test:get-status
7640: 74 65 73 74 64 61 74 29 0a 20 20 20 20 20 20 20 testdat).
7650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7660: 20 20 20 20 20 20 20 20 20 22 5c 22 20 6f 72 20 "\" or
7670: 2d 66 6f 72 63 65 20 74 6f 20 6f 76 65 72 72 69 -force to overri
7680: 64 65 22 29 29 0a 09 20 20 20 20 20 20 20 3b 3b de")).. ;;
7690: 20 4e 4f 54 45 3a 20 4e 6f 20 6c 6f 6e 67 65 72 NOTE: No longer
76a0: 20 62 65 20 63 68 65 63 6b 69 6e 67 20 70 72 65 be checking pre
76b0: 72 65 71 75 69 73 69 74 65 73 20 68 65 72 65 21 requisites here!
76c0: 20 57 69 6c 6c 20 6e 65 76 65 72 20 67 65 74 20 Will never get
76d0: 68 65 72 65 20 75 6e 6c 65 73 73 20 70 72 65 72 here unless prer
76e0: 65 71 73 20 61 72 65 0a 09 20 20 20 20 20 20 20 eqs are..
76f0: 3b 3b 20 20 20 20 20 20 20 61 6c 72 65 61 64 79 ;; already
7700: 20 6d 65 74 2e 0a 09 20 20 20 20 20 20 20 28 69 met... (i
7710: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 2d 74 f (not (launch-t
7720: 65 73 74 20 23 66 20 72 75 6e 2d 69 64 20 72 75 est #f run-id ru
7730: 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 20 nname test-conf
7740: 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 2d 6e keyvallst test-n
7750: 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 74 ame test-path it
7760: 65 6d 64 61 74 20 66 6c 61 67 73 29 29 0a 09 09 emdat flags))...
7770: 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 (begin...
7780: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
7790: 46 61 69 6c 65 64 20 74 6f 20 6c 61 75 6e 63 68 Failed to launch
77a0: 20 74 68 65 20 74 65 73 74 2e 20 45 78 69 74 69 the test. Exiti
77b0: 6e 67 20 61 73 20 73 6f 6f 6e 20 61 73 20 70 6f ng as soon as po
77c0: 73 73 69 62 6c 65 22 29 0a 09 09 20 20 20 20 20 ssible")...
77d0: 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c 65 78 69 (set! *globalexi
77e0: 74 73 74 61 74 75 73 2a 20 31 29 20 3b 3b 20 0a tstatus* 1) ;; .
77f0: 09 09 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d .. (process-
7800: 73 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d signal (current-
7810: 70 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e process-id) sign
7820: 61 6c 2f 6b 69 6c 6c 29 29 29 29 29 29 0a 09 28 al/kill))))))..(
7830: 28 4b 49 4c 4c 45 44 29 20 0a 09 20 28 64 65 62 (KILLED) .. (deb
7840: 75 67 3a 70 72 69 6e 74 20 31 20 22 4e 4f 54 45 ug:print 1 "NOTE
7850: 3a 20 22 20 6e 65 77 2d 74 65 73 74 2d 6e 61 6d : " new-test-nam
7860: 65 20 22 20 69 73 20 61 6c 72 65 61 64 79 20 72 e " is already r
7870: 75 6e 6e 69 6e 67 20 6f 72 20 77 61 73 20 65 78 unning or was ex
7880: 70 6c 69 63 74 6c 79 20 6b 69 6c 6c 65 64 2c 20 plictly killed,
7890: 75 73 65 20 2d 66 6f 72 63 65 20 74 6f 20 6c 61 use -force to la
78a0: 75 6e 63 68 20 69 74 2e 22 29 29 0a 09 28 28 4c unch it."))..((L
78b0: 41 55 4e 43 48 45 44 20 52 45 4d 4f 54 45 48 4f AUNCHED REMOTEHO
78c0: 53 54 53 54 41 52 54 20 52 55 4e 4e 49 4e 47 29 STSTART RUNNING)
78d0: 20 20 0a 09 20 28 69 66 20 28 3e 20 28 2d 20 28 .. (if (> (- (
78e0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
78f0: 28 2b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (+ (db:test-get-
7900: 65 76 65 6e 74 5f 74 69 6d 65 20 74 65 73 74 64 event_time testd
7910: 61 74 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 at)..... (
7920: 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f db:test-get-run_
7930: 64 75 72 61 74 69 6f 6e 20 74 65 73 74 64 61 74 duration testdat
7940: 29 29 29 0a 09 09 36 30 30 29 20 3b 3b 20 69 2e )))...600) ;; i.
7950: 65 2e 20 6e 6f 20 75 70 64 61 74 65 20 66 6f 72 e. no update for
7960: 20 6d 6f 72 65 20 74 68 61 6e 20 36 30 30 20 73 more than 600 s
7970: 65 63 6f 6e 64 73 0a 09 20 20 20 20 20 28 62 65 econds.. (be
7980: 67 69 6e 0a 09 20 20 20 20 20 20 20 28 64 65 62 gin.. (deb
7990: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
79a0: 49 4e 47 3a 20 54 65 73 74 20 22 20 74 65 73 74 ING: Test " test
79b0: 2d 6e 61 6d 65 20 22 20 61 70 70 65 61 72 73 20 -name " appears
79c0: 74 6f 20 62 65 20 64 65 61 64 2e 20 46 6f 72 63 to be dead. Forc
79d0: 69 6e 67 20 69 74 20 74 6f 20 73 74 61 74 65 20 ing it to state
79e0: 49 4e 43 4f 4d 50 4c 45 54 45 20 61 6e 64 20 73 INCOMPLETE and s
79f0: 74 61 74 75 73 20 53 54 55 43 4b 2f 44 45 41 44 tatus STUCK/DEAD
7a00: 22 29 0a 09 20 20 20 20 20 20 20 28 6f 70 65 6e ").. (open
7a10: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d -run-close test-
7a20: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
7a30: 65 73 74 2d 69 64 20 22 49 4e 43 4f 4d 50 4c 45 est-id "INCOMPLE
7a40: 54 45 22 20 22 53 54 55 43 4b 2f 44 45 41 44 22 TE" "STUCK/DEAD"
7a50: 20 22 54 65 73 74 20 69 73 20 73 74 75 63 6b 20 "Test is stuck
7a60: 6f 72 20 64 65 61 64 22 20 23 66 29 29 0a 09 20 or dead" #f))..
7a70: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7a80: 20 32 20 22 4e 4f 54 45 3a 20 22 20 74 65 73 74 2 "NOTE: " test
7a90: 2d 6e 61 6d 65 20 22 20 69 73 20 61 6c 72 65 61 -name " is alrea
7aa0: 64 79 20 72 75 6e 6e 69 6e 67 22 29 29 29 0a 09 dy running")))..
7ab0: 28 65 6c 73 65 20 20 20 20 20 20 20 28 64 65 62 (else (deb
7ac0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
7ad0: 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 6c 61 75 R: Failed to lau
7ae0: 6e 63 68 20 74 65 73 74 20 22 20 6e 65 77 2d 74 nch test " new-t
7af0: 65 73 74 2d 6e 61 6d 65 20 22 2e 20 55 6e 72 65 est-name ". Unre
7b00: 63 6f 67 6e 69 73 65 64 20 73 74 61 74 65 20 22 cognised state "
7b10: 20 28 74 65 73 74 3a 67 65 74 2d 73 74 61 74 65 (test:get-state
7b20: 20 74 65 73 74 64 61 74 29 29 29 29 29 29 29 0a testdat))))))).
7b30: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
7b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 45 4e 44 =========.;; END
7b80: 20 4f 46 20 4e 45 57 20 53 54 55 46 46 0a 3b 3b OF NEW STUFF.;;
7b90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7ba0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7bd0: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 ======..(define
7be0: 28 67 65 74 2d 64 69 72 2d 75 70 2d 6e 20 64 69 (get-dir-up-n di
7bf0: 72 20 2e 20 70 61 72 61 6d 73 29 20 0a 20 20 28 r . params) . (
7c00: 6c 65 74 20 28 28 64 70 61 72 74 73 20 20 28 73 let ((dparts (s
7c10: 74 72 69 6e 67 2d 73 70 6c 69 74 20 64 69 72 20 tring-split dir
7c20: 22 2f 22 29 29 0a 09 28 63 6f 75 6e 74 20 20 20 "/"))..(count
7c30: 28 69 66 20 28 6e 75 6c 6c 3f 20 70 61 72 61 6d (if (null? param
7c40: 73 29 20 31 20 28 63 61 72 20 70 61 72 61 6d 73 s) 1 (car params
7c50: 29 29 29 29 0a 20 20 20 20 28 63 6f 6e 63 20 22 )))). (conc "
7c60: 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 /" (string-inter
7c70: 73 70 65 72 73 65 20 0a 09 20 20 20 20 20 20 20 sperse ..
7c80: 28 74 61 6b 65 20 64 70 61 72 74 73 20 28 2d 20 (take dparts (-
7c90: 28 6c 65 6e 67 74 68 20 64 70 61 72 74 73 29 20 (length dparts)
7ca0: 63 6f 75 6e 74 29 29 0a 09 20 20 20 20 20 20 20 count))..
7cb0: 22 2f 22 29 29 29 29 0a 3b 3b 20 52 65 6d 6f 76 "/")))).;; Remov
7cc0: 65 20 72 75 6e 73 0a 3b 3b 20 66 69 65 6c 64 73 e runs.;; fields
7cd0: 20 61 72 65 20 70 61 73 73 69 6e 67 20 69 6e 20 are passing in
7ce0: 74 68 72 6f 75 67 68 20 0a 3b 3b 20 61 63 74 69 through .;; acti
7cf0: 6f 6e 3a 0a 3b 3b 20 20 20 20 27 72 65 6d 6f 76 on:.;; 'remov
7d00: 65 2d 72 75 6e 73 0a 3b 3b 20 20 20 20 27 73 65 e-runs.;; 'se
7d10: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 0a 3b t-state-status.;
7d20: 3b 0a 3b 3b 20 4e 42 2f 2f 20 73 68 6f 75 6c 64 ;.;; NB// should
7d30: 20 70 61 73 73 20 69 6e 20 6b 65 79 73 3f 0a 3b pass in keys?.;
7d40: 3b 0a 28 64 65 66 69 6e 65 20 28 72 75 6e 73 3a ;.(define (runs:
7d50: 6f 70 65 72 61 74 65 2d 6f 6e 20 64 62 20 61 63 operate-on db ac
7d60: 74 69 6f 6e 20 72 75 6e 6e 61 6d 65 70 61 74 74 tion runnamepatt
7d70: 20 74 65 73 74 70 61 74 74 20 69 74 65 6d 70 61 testpatt itempa
7d80: 74 74 20 23 21 6b 65 79 20 28 73 74 61 74 65 20 tt #!key (state
7d90: 23 66 29 28 73 74 61 74 75 73 20 23 66 29 28 6e #f)(status #f)(n
7da0: 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 ew-state-status
7db0: 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 6b #f)). (let* ((k
7dc0: 65 79 73 20 20 20 20 20 20 20 20 20 28 72 64 62 eys (rdb
7dd0: 3a 67 65 74 2d 6b 65 79 73 20 64 62 29 29 0a 09 :get-keys db))..
7de0: 20 28 72 75 6e 64 61 74 20 20 20 20 20 20 20 28 (rundat (
7df0: 72 75 6e 73 3a 67 65 74 2d 72 75 6e 73 2d 62 79 runs:get-runs-by
7e00: 2d 70 61 74 74 20 64 62 20 6b 65 79 73 20 72 75 -patt db keys ru
7e10: 6e 6e 61 6d 65 70 61 74 74 29 29 0a 09 20 28 68 nnamepatt)).. (h
7e20: 65 61 64 65 72 20 20 20 20 20 20 20 28 76 65 63 eader (vec
7e30: 74 6f 72 2d 72 65 66 20 72 75 6e 64 61 74 20 30 tor-ref rundat 0
7e40: 29 29 0a 09 20 28 72 75 6e 73 20 20 20 20 20 20 )).. (runs
7e50: 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 (vector-ref r
7e60: 75 6e 64 61 74 20 31 29 29 0a 09 20 28 73 74 61 undat 1)).. (sta
7e70: 74 65 73 20 20 20 20 20 20 20 28 69 66 20 73 74 tes (if st
7e80: 61 74 65 20 20 28 73 74 72 69 6e 67 2d 73 70 6c ate (string-spl
7e90: 69 74 20 73 74 61 74 65 20 20 22 2c 22 29 20 27 it state ",") '
7ea0: 28 29 29 29 0a 09 20 28 73 74 61 74 75 73 65 73 ())).. (statuses
7eb0: 20 20 20 20 20 28 69 66 20 73 74 61 74 75 73 20 (if status
7ec0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 74 (string-split st
7ed0: 61 74 75 73 20 22 2c 22 29 20 27 28 29 29 29 0a atus ",") '())).
7ee0: 09 20 28 73 74 61 74 65 2d 73 74 61 74 75 73 20 . (state-status
7ef0: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 6e 65 77 (if (string? new
7f00: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 20 28 -state-status) (
7f10: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6e 65 77 string-split new
7f20: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 22 2c -state-status ",
7f30: 22 29 20 27 28 23 66 20 23 66 29 29 29 29 0a 20 ") '(#f #f)))).
7f40: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
7f50: 32 20 22 48 65 61 64 65 72 3a 20 22 20 68 65 61 2 "Header: " hea
7f60: 64 65 72 20 22 20 61 63 74 69 6f 6e 3a 20 22 20 der " action: "
7f70: 61 63 74 69 6f 6e 20 22 20 6e 65 77 2d 73 74 61 action " new-sta
7f80: 74 65 2d 73 74 61 74 75 73 3a 20 22 20 6e 65 77 te-status: " new
7f90: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 0a 20 -state-status).
7fa0: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
7fb0: 20 20 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a (lambda (run).
7fc0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 75 (let ((ru
7fd0: 6e 6b 65 79 20 28 73 74 72 69 6e 67 2d 69 6e 74 nkey (string-int
7fe0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 28 6c ersperse (map (l
7ff0: 61 6d 62 64 61 20 28 6b 29 0a 09 09 09 09 09 09 ambda (k).......
8000: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
8010: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
8020: 65 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6b er (vector-ref k
8030: 20 30 29 29 29 20 6b 65 79 73 29 20 22 2f 22 29 0))) keys) "/")
8040: 29 0a 09 20 20 20 20 20 28 64 69 72 73 2d 74 6f ).. (dirs-to
8050: 2d 72 65 6d 6f 76 65 20 28 6d 61 6b 65 2d 68 61 -remove (make-ha
8060: 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 20 28 6c sh-table))).. (l
8070: 65 74 2a 20 28 28 72 75 6e 2d 69 64 20 20 20 20 et* ((run-id
8080: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
8090: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
80a0: 65 72 20 22 69 64 22 29 29 0a 09 09 28 72 75 6e er "id"))...(run
80b0: 2d 73 74 61 74 65 20 28 64 62 3a 67 65 74 2d 76 -state (db:get-v
80c0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
80d0: 75 6e 20 68 65 61 64 65 72 20 22 73 74 61 74 65 un header "state
80e0: 22 29 29 0a 09 09 28 74 65 73 74 73 20 20 20 20 "))...(tests
80f0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
8100: 3f 20 72 75 6e 2d 73 74 61 74 65 20 22 6c 6f 63 ? run-state "loc
8110: 6b 65 64 22 29 29 0a 09 09 09 20 20 20 20 20 20 ked"))....
8120: 20 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 (db:get-tests-f
8130: 6f 72 2d 72 75 6e 20 64 62 20 28 64 62 3a 67 65 or-run db (db:ge
8140: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
8150: 72 20 72 75 6e 20 68 65 61 64 65 72 20 22 69 64 r run header "id
8160: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 74 ")....... t
8170: 65 73 74 70 61 74 74 20 69 74 65 6d 70 61 74 74 estpatt itempatt
8180: 20 73 74 61 74 65 73 20 73 74 61 74 75 73 65 73 states statuses
8190: 0a 09 09 09 09 09 09 20 20 20 20 20 20 6e 6f 74 ....... not
81a0: 2d 69 6e 3a 20 20 23 66 0a 09 09 09 09 09 09 20 -in: #f.......
81b0: 20 20 20 20 20 73 6f 72 74 2d 62 79 3a 20 28 63 sort-by: (c
81c0: 61 73 65 20 61 63 74 69 6f 6e 0a 09 09 09 09 09 ase action......
81d0: 09 09 09 20 28 28 72 65 6d 6f 76 65 2d 72 75 6e ... ((remove-run
81e0: 73 29 20 27 72 75 6e 64 69 72 29 0a 09 09 09 09 s) 'rundir).....
81f0: 09 09 09 09 20 28 65 6c 73 65 20 20 20 20 20 20 .... (else
8200: 20 20 20 20 27 65 76 65 6e 74 5f 74 69 6d 65 29 'event_time)
8210: 29 29 0a 09 09 09 20 20 20 20 20 20 20 27 28 29 )).... '()
8220: 29 29 0a 09 09 28 6c 61 73 74 74 70 61 74 68 20 ))...(lasttpath
8230: 22 2f 64 6f 65 73 2f 6e 6f 74 2f 65 78 69 73 74 "/does/not/exist
8240: 2f 49 2f 68 6f 70 65 22 29 29 0a 0a 09 20 20 20 /I/hope"))...
8250: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
8260: 74 65 73 74 73 29 29 0a 09 20 20 20 20 20 20 20 tests))..
8270: 28 62 65 67 69 6e 0a 09 09 20 28 63 61 73 65 20 (begin... (case
8280: 61 63 74 69 6f 6e 0a 09 09 20 20 20 28 28 72 65 action... ((re
8290: 6d 6f 76 65 2d 72 75 6e 73 29 0a 09 09 20 20 20 move-runs)...
82a0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
82b0: 22 52 65 6d 6f 76 69 6e 67 20 74 65 73 74 73 20 "Removing tests
82c0: 66 6f 72 20 72 75 6e 3a 20 22 20 72 75 6e 6b 65 for run: " runke
82d0: 79 20 22 20 22 20 28 64 62 3a 67 65 74 2d 76 61 y " " (db:get-va
82e0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
82f0: 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d n header "runnam
8300: 65 22 29 29 29 0a 09 09 20 20 20 28 28 73 65 74 e")))... ((set
8310: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 0a 09 -state-status)..
8320: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
8330: 74 20 31 20 22 4d 6f 64 69 66 79 69 6e 67 20 73 t 1 "Modifying s
8340: 74 61 74 65 20 61 6e 64 20 73 74 61 75 73 20 66 tate and staus f
8350: 6f 72 20 74 65 73 74 73 20 66 6f 72 20 72 75 6e or tests for run
8360: 3a 20 22 20 72 75 6e 6b 65 79 20 22 20 22 20 28 : " runkey " " (
8370: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
8380: 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 header run heade
8390: 72 20 22 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 r "runname")))..
83a0: 09 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 20 . (else...
83b0: 28 70 72 69 6e 74 20 22 49 4e 46 4f 3a 20 61 63 (print "INFO: ac
83c0: 74 69 6f 6e 20 6e 6f 74 20 72 65 63 6f 67 6e 69 tion not recogni
83d0: 73 65 64 20 22 20 61 63 74 69 6f 6e 29 29 29 0a sed " action))).
83e0: 09 09 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 .. (for-each...
83f0: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 29 0a (lambda (test).
8400: 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 .. (let* ((it
8410: 65 6d 2d 70 61 74 68 20 28 64 62 3a 74 65 73 74 em-path (db:test
8420: 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 20 74 -get-item-path t
8430: 65 73 74 29 29 0a 09 09 09 20 20 20 28 74 65 73 est)).... (tes
8440: 74 2d 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d t-name (db:test-
8450: 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 65 73 get-testname tes
8460: 74 29 29 0a 09 09 09 20 20 20 28 72 75 6e 2d 64 t)).... (run-d
8470: 69 72 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 ir (db:test-ge
8480: 74 2d 72 75 6e 64 69 72 20 74 65 73 74 29 29 0a t-rundir test)).
8490: 09 09 09 20 20 20 28 74 65 73 74 2d 69 64 20 20 ... (test-id
84a0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 (db:test-get-id
84b0: 20 74 65 73 74 29 29 29 0a 09 09 20 20 20 20 20 test)))...
84c0: 20 3b 3b 20 20 20 28 74 64 62 20 20 20 20 20 20 ;; (tdb
84d0: 20 28 64 62 3a 6f 70 65 6e 2d 74 65 73 74 2d 64 (db:open-test-d
84e0: 62 20 72 75 6e 2d 64 69 72 29 29 29 0a 09 09 20 b run-dir)))...
84f0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
8500: 74 20 31 20 22 20 20 22 20 28 64 62 3a 74 65 73 t 1 " " (db:tes
8510: 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 74 t-get-testname t
8520: 65 73 74 29 20 22 20 69 64 3a 20 22 20 28 64 62 est) " id: " (db
8530: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
8540: 74 29 20 22 20 22 20 69 74 65 6d 2d 70 61 74 68 t) " " item-path
8550: 20 22 20 61 63 74 69 6f 6e 3a 20 22 20 61 63 74 " action: " act
8560: 69 6f 6e 29 0a 09 09 20 20 20 20 20 20 28 63 61 ion)... (ca
8570: 73 65 20 61 63 74 69 6f 6e 0a 09 09 09 28 28 72 se action....((r
8580: 65 6d 6f 76 65 2d 72 75 6e 73 29 20 3b 3b 20 74 emove-runs) ;; t
8590: 68 65 20 74 64 62 20 69 73 20 66 6f 72 20 66 75 he tdb is for fu
85a0: 74 75 72 65 20 70 6f 73 73 69 62 6c 65 2e 20 0a ture possible. .
85b0: 09 09 09 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 ... (db:delete-t
85c0: 65 73 74 2d 72 65 63 6f 72 64 73 20 64 62 20 23 est-records db #
85d0: 66 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 f (db:test-get-i
85e0: 64 20 74 65 73 74 29 29 0a 09 09 09 20 28 64 65 d test)).... (de
85f0: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 49 4e 46 bug:print 1 "INF
8600: 4f 3a 20 41 74 74 65 6d 70 74 69 6e 67 20 74 6f O: Attempting to
8610: 20 72 65 6d 6f 76 65 20 64 69 72 20 22 20 72 75 remove dir " ru
8620: 6e 2d 64 69 72 29 0a 09 09 09 20 28 69 66 20 28 n-dir).... (if (
8630: 61 6e 64 20 28 3e 20 28 73 74 72 69 6e 67 2d 6c and (> (string-l
8640: 65 6e 67 74 68 20 72 75 6e 2d 64 69 72 29 20 35 ength run-dir) 5
8650: 29 0a 09 09 09 09 20 20 28 66 69 6c 65 2d 65 78 )..... (file-ex
8660: 69 73 74 73 3f 20 72 75 6e 2d 64 69 72 29 29 20 ists? run-dir))
8670: 3b 3b 20 62 61 64 20 68 65 75 72 69 73 74 69 63 ;; bad heuristic
8680: 20 62 75 74 20 73 68 6f 75 6c 64 20 70 72 65 76 but should prev
8690: 65 6e 74 20 2f 74 6d 70 20 2f 68 6f 6d 65 20 65 ent /tmp /home e
86a0: 74 63 2e 0a 09 09 09 20 20 20 20 20 28 6c 65 74 tc..... (let
86b0: 2a 20 28 28 72 65 61 6c 70 61 74 68 20 28 72 65 * ((realpath (re
86c0: 73 6f 6c 76 65 2d 70 61 74 68 6e 61 6d 65 20 72 solve-pathname r
86d0: 75 6e 2d 64 69 72 29 29 29 0a 09 09 09 20 20 20 un-dir)))....
86e0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
86f0: 20 31 20 22 49 4e 46 4f 3a 20 52 65 61 6c 20 70 1 "INFO: Real p
8700: 61 74 68 20 6f 66 20 69 73 20 22 20 72 65 61 6c ath of is " real
8710: 70 61 74 68 29 0a 09 09 09 20 20 20 20 20 20 20 path)....
8720: 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (if (file-exists
8730: 3f 20 72 65 61 6c 70 61 74 68 29 0a 09 09 09 09 ? realpath).....
8740: 20 20 20 28 69 66 20 28 3e 20 28 73 79 73 74 65 (if (> (syste
8750: 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 m (conc "rm -rf
8760: 22 20 72 65 61 6c 70 61 74 68 29 29 20 30 29 0a " realpath)) 0).
8770: 09 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 .... (debu
8780: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
8790: 3a 20 54 68 65 72 65 20 77 61 73 20 61 20 70 72 : There was a pr
87a0: 6f 62 6c 65 6d 20 72 65 6d 6f 76 69 6e 67 20 22 oblem removing "
87b0: 20 72 65 61 6c 70 61 74 68 20 22 20 77 69 74 68 realpath " with
87c0: 20 72 6d 20 2d 66 22 29 29 0a 09 09 09 09 20 20 rm -f")).....
87d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
87e0: 22 57 41 52 4e 49 4e 47 3a 20 74 65 73 74 20 72 "WARNING: test r
87f0: 75 6e 20 64 69 72 20 22 20 72 65 61 6c 70 61 74 un dir " realpat
8800: 68 20 22 20 61 70 70 65 61 72 73 20 74 6f 20 6e h " appears to n
8810: 6f 74 20 65 78 69 73 74 22 29 29 0a 09 09 09 20 ot exist"))....
8820: 20 20 20 20 20 20 28 69 66 20 28 66 69 6c 65 2d (if (file-
8830: 65 78 69 73 74 73 3f 20 72 75 6e 2d 64 69 72 29 exists? run-dir)
8840: 20 3b 3b 20 74 68 65 20 6c 69 6e 6b 0a 09 09 09 ;; the link....
8850: 09 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 . (if (symboli
8860: 63 2d 6c 69 6e 6b 3f 20 72 75 6e 2d 64 69 72 29 c-link? run-dir)
8870: 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 65 6c ..... (del
8880: 65 74 65 2d 66 69 6c 65 20 72 75 6e 2d 64 69 72 ete-file run-dir
8890: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 )..... (if
88a0: 20 28 64 69 72 65 63 74 6f 72 79 3f 20 72 75 6e (directory? run
88b0: 2d 64 69 72 29 0a 09 09 09 09 09 20 20 20 28 69 -dir)...... (i
88c0: 66 20 28 3e 20 28 64 69 72 65 63 74 6f 72 79 2d f (> (directory-
88d0: 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 66 20 fold (lambda (f
88e0: 78 29 28 2b 20 31 20 78 29 29 20 30 20 72 75 6e x)(+ 1 x)) 0 run
88f0: 2d 64 69 72 29 20 30 29 0a 09 09 09 09 09 20 20 -dir) 0)......
8900: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
8910: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 72 65 t 0 "WARNING: re
8920: 66 75 73 69 6e 67 20 74 6f 20 72 65 6d 6f 76 65 fusing to remove
8930: 20 22 20 72 75 6e 2d 64 69 72 20 22 20 61 73 20 " run-dir " as
8940: 69 74 20 69 73 20 6e 6f 74 20 65 6d 70 74 79 22 it is not empty"
8950: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 64 )...... (d
8960: 65 6c 65 74 65 2d 64 69 72 65 63 74 6f 72 79 20 elete-directory
8970: 72 75 6e 2d 64 69 72 29 29 20 3b 3b 20 69 74 20 run-dir)) ;; it
8980: 73 68 6f 75 6c 64 20 62 65 20 65 6d 70 74 79 20 should be empty
8990: 62 79 20 68 65 72 65 20 42 55 47 20 42 55 47 2c by here BUG BUG,
89a0: 20 61 64 64 20 65 72 72 6f 72 20 63 61 74 63 68 add error catch
89b0: 0a 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a ...... (debug:
89c0: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
89d0: 72 65 66 75 73 69 6e 67 20 74 6f 20 72 65 6d 6f refusing to remo
89e0: 76 65 20 22 20 72 75 6e 2d 64 69 72 20 22 20 61 ve " run-dir " a
89f0: 73 20 69 74 20 69 73 20 6e 65 69 74 68 65 72 20 s it is neither
8a00: 61 20 73 79 6d 6c 69 6e 6b 20 6e 6f 72 20 61 20 a symlink nor a
8a10: 64 69 72 65 63 74 6f 72 79 22 29 0a 09 09 09 09 directory").....
8a20: 09 20 20 20 29 29 29 29 0a 09 09 09 20 20 20 20 . ))))....
8a30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
8a40: 22 57 41 52 4e 49 4e 47 3a 20 64 69 72 65 63 74 "WARNING: direct
8a50: 6f 72 79 20 61 6c 72 65 61 64 79 20 72 65 6d 6f ory already remo
8a60: 76 65 64 20 22 20 72 75 6e 2d 64 69 72 29 29 29 ved " run-dir)))
8a70: 0a 09 09 09 28 28 73 65 74 2d 73 74 61 74 65 2d ....((set-state-
8a80: 73 74 61 74 75 73 29 0a 09 09 09 20 28 64 65 62 status).... (deb
8a90: 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f ug:print 2 "INFO
8aa0: 3a 20 6e 65 77 20 73 74 61 74 65 20 22 20 28 63 : new state " (c
8ab0: 61 72 20 73 74 61 74 65 2d 73 74 61 74 75 73 29 ar state-status)
8ac0: 20 22 2c 20 6e 65 77 20 73 74 61 74 75 73 20 22 ", new status "
8ad0: 20 28 63 61 64 72 20 73 74 61 74 65 2d 73 74 61 (cadr state-sta
8ae0: 74 75 73 29 29 0a 09 09 09 20 28 6f 70 65 6e 2d tus)).... (open-
8af0: 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 run-close db:tes
8b00: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
8b10: 75 73 2d 62 79 2d 69 64 20 64 62 20 28 64 62 3a us-by-id db (db:
8b20: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
8b30: 29 20 28 63 61 72 20 73 74 61 74 65 2d 73 74 61 ) (car state-sta
8b40: 74 75 73 29 28 63 61 64 72 20 73 74 61 74 65 2d tus)(cadr state-
8b50: 73 74 61 74 75 73 29 20 23 66 29 29 29 29 29 0a status) #f))))).
8b60: 09 09 20 20 74 65 73 74 73 29 29 29 0a 09 20 20 .. tests)))..
8b70: 20 0a 09 20 20 20 3b 3b 20 72 65 6d 6f 76 65 20 .. ;; remove
8b80: 74 68 65 20 72 75 6e 20 69 66 20 7a 65 72 6f 20 the run if zero
8b90: 74 65 73 74 73 20 72 65 6d 61 69 6e 0a 09 20 20 tests remain..
8ba0: 20 28 69 66 20 28 65 71 3f 20 61 63 74 69 6f 6e (if (eq? action
8bb0: 20 27 72 65 6d 6f 76 65 2d 72 75 6e 73 29 0a 09 'remove-runs)..
8bc0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 (let ((re
8bd0: 6d 74 65 73 74 73 20 28 64 62 3a 67 65 74 2d 74 mtests (db:get-t
8be0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 ests-for-run db
8bf0: 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 (db:get-value-by
8c00: 2d 68 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 -header run head
8c10: 65 72 20 22 69 64 22 29 20 23 66 20 23 66 20 27 er "id") #f #f '
8c20: 28 22 44 45 4c 45 54 45 44 22 29 20 27 28 22 6e ("DELETED") '("n
8c30: 2f 61 22 29 20 6e 6f 74 2d 69 6e 3a 20 23 74 29 /a") not-in: #t)
8c40: 29 29 0a 09 09 20 28 69 66 20 28 6e 75 6c 6c 3f ))... (if (null?
8c50: 20 72 65 6d 74 65 73 74 73 29 20 3b 3b 20 6e 6f remtests) ;; no
8c60: 20 6d 6f 72 65 20 74 65 73 74 73 20 72 65 6d 61 more tests rema
8c70: 69 6e 69 6e 67 0a 09 09 20 20 20 20 20 28 6c 65 ining... (le
8c80: 74 2a 20 28 28 64 70 61 72 74 73 20 20 28 73 74 t* ((dparts (st
8c90: 72 69 6e 67 2d 73 70 6c 69 74 20 6c 61 73 74 74 ring-split lastt
8ca0: 70 61 74 68 20 22 2f 22 29 29 0a 09 09 09 20 20 path "/"))....
8cb0: 20 20 28 72 75 6e 70 61 74 68 20 28 63 6f 6e 63 (runpath (conc
8cc0: 20 22 2f 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 "/" (string-int
8cd0: 65 72 73 70 65 72 73 65 20 0a 09 09 09 09 09 09 ersperse .......
8ce0: 28 74 61 6b 65 20 64 70 61 72 74 73 20 28 2d 20 (take dparts (-
8cf0: 28 6c 65 6e 67 74 68 20 64 70 61 72 74 73 29 20 (length dparts)
8d00: 31 29 29 0a 09 09 09 09 09 09 22 2f 22 29 29 29 1))......."/")))
8d10: 29 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 )... (debu
8d20: 67 3a 70 72 69 6e 74 20 31 20 22 52 65 6d 6f 76 g:print 1 "Remov
8d30: 69 6e 67 20 72 75 6e 3a 20 22 20 72 75 6e 6b 65 ing run: " runke
8d40: 79 20 22 20 22 20 28 64 62 3a 67 65 74 2d 76 61 y " " (db:get-va
8d50: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 75 lue-by-header ru
8d60: 6e 20 68 65 61 64 65 72 20 22 72 75 6e 6e 61 6d n header "runnam
8d70: 65 22 29 20 22 20 61 6e 64 20 72 65 6c 61 74 65 e") " and relate
8d80: 64 20 72 65 63 6f 72 64 22 29 0a 09 09 20 20 20 d record")...
8d90: 20 20 20 20 28 64 62 3a 64 65 6c 65 74 65 2d 72 (db:delete-r
8da0: 75 6e 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 09 un db run-id)...
8db0: 20 20 20 20 20 20 20 3b 3b 20 54 68 69 73 20 69 ;; This i
8dc0: 73 20 61 20 70 72 65 74 74 79 20 67 6f 6f 64 20 s a pretty good
8dd0: 70 6c 61 63 65 20 74 6f 20 70 75 72 67 65 20 6f place to purge o
8de0: 6c 64 20 44 45 4c 45 54 45 44 20 74 65 73 74 73 ld DELETED tests
8df0: 0a 09 09 20 20 20 20 20 20 20 28 64 62 3a 64 65 ... (db:de
8e00: 6c 65 74 65 2d 74 65 73 74 73 2d 66 6f 72 2d 72 lete-tests-for-r
8e10: 75 6e 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 09 un db run-id)...
8e20: 20 20 20 20 20 20 20 28 64 62 3a 64 65 6c 65 74 (db:delet
8e30: 65 2d 6f 6c 64 2d 64 65 6c 65 74 65 64 2d 74 65 e-old-deleted-te
8e40: 73 74 2d 72 65 63 6f 72 64 73 20 64 62 29 0a 09 st-records db)..
8e50: 09 20 20 20 20 20 20 20 28 64 62 3a 73 65 74 2d . (db:set-
8e60: 76 61 72 20 64 62 20 22 44 45 4c 45 54 45 44 5f var db "DELETED_
8e70: 54 45 53 54 53 22 20 28 63 75 72 72 65 6e 74 2d TESTS" (current-
8e80: 73 65 63 6f 6e 64 73 29 29 0a 09 09 20 20 20 20 seconds))...
8e90: 20 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 66 69 ;; need to fi
8ea0: 67 75 72 65 20 6f 75 74 20 74 68 65 20 70 61 74 gure out the pat
8eb0: 68 20 74 6f 20 74 68 65 20 72 75 6e 20 64 69 72 h to the run dir
8ec0: 20 61 6e 64 20 72 65 6d 6f 76 65 20 69 74 20 69 and remove it i
8ed0: 66 20 65 6d 70 74 79 0a 09 09 20 20 20 20 20 20 f empty...
8ee0: 20 3b 3b 20 20 20 20 28 69 66 20 28 6e 75 6c 6c ;; (if (null
8ef0: 3f 20 28 67 6c 6f 62 20 28 63 6f 6e 63 20 72 75 ? (glob (conc ru
8f00: 6e 70 61 74 68 20 22 2f 2a 22 29 29 29 0a 09 09 npath "/*")))...
8f10: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
8f20: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
8f30: 20 3b 3b 20 09 20 28 64 65 62 75 67 3a 70 72 69 ;; . (debug:pri
8f40: 6e 74 20 31 20 22 52 65 6d 6f 76 69 6e 67 20 72 nt 1 "Removing r
8f50: 75 6e 20 64 69 72 20 22 20 72 75 6e 70 61 74 68 un dir " runpath
8f60: 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 09 20 )... ;; .
8f70: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 (system (conc "r
8f80: 6d 64 69 72 20 2d 70 20 22 20 72 75 6e 70 61 74 mdir -p " runpat
8f90: 68 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 29 h))))... )
8fa0: 29 29 29 29 0a 09 20 29 29 0a 20 20 20 20 20 72 )))).. )). r
8fb0: 75 6e 73 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d uns)))..;;======
8fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8fd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8fe0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8ff0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9000: 0a 3b 3b 20 52 6f 75 74 69 6e 65 73 20 66 6f 72 .;; Routines for
9010: 20 6d 61 6e 69 70 75 6c 61 74 69 6e 67 20 72 75 manipulating ru
9020: 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ns.;;===========
9030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 ===========..;;
9070: 53 69 6e 63 65 20 6d 61 6e 79 20 63 61 6c 6c 73 Since many calls
9080: 20 74 6f 20 61 20 72 75 6e 20 72 65 71 75 69 72 to a run requir
9090: 65 20 70 72 65 74 74 79 20 6d 75 63 68 20 74 68 e pretty much th
90a0: 65 20 73 61 6d 65 20 73 65 74 75 70 20 0a 3b 3b e same setup .;;
90b0: 20 74 68 69 73 20 77 72 61 70 70 65 72 20 69 73 this wrapper is
90c0: 20 75 73 65 64 20 74 6f 20 72 65 64 75 63 65 20 used to reduce
90d0: 74 68 65 20 72 65 70 6c 69 63 61 74 69 6f 6e 20 the replication
90e0: 6f 66 20 63 6f 64 65 0a 28 64 65 66 69 6e 65 20 of code.(define
90f0: 28 67 65 6e 65 72 61 6c 2d 72 75 6e 2d 63 61 6c (general-run-cal
9100: 6c 20 73 77 69 74 63 68 6e 61 6d 65 20 61 63 74 l switchname act
9110: 69 6f 6e 2d 64 65 73 63 20 70 72 6f 63 29 0a 20 ion-desc proc).
9120: 20 28 6c 65 74 20 28 28 72 75 6e 6e 61 6d 65 20 (let ((runname
9130: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
9140: 72 75 6e 6e 61 6d 65 22 29 29 0a 09 28 74 61 72 runname"))..(tar
9150: 67 65 74 20 20 28 69 66 20 28 61 72 67 73 3a 67 get (if (args:g
9160: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
9170: 29 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 )... (args:g
9180: 65 74 2d 61 72 67 20 22 2d 74 61 72 67 65 74 22 et-arg "-target"
9190: 29 0a 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 )... (args:g
91a0: 65 74 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 et-arg "-reqtarg
91b0: 22 29 29 29 0a 09 28 74 68 31 20 20 20 20 20 23 ")))..(th1 #
91c0: 66 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 f)). (cond.
91d0: 20 20 20 28 28 6e 6f 74 20 74 61 72 67 65 74 29 ((not target)
91e0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
91f0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4d 69 int 0 "ERROR: Mi
9200: 73 73 69 6e 67 20 72 65 71 75 69 72 65 64 20 70 ssing required p
9210: 61 72 61 6d 65 74 65 72 20 66 6f 72 20 22 20 73 arameter for " s
9220: 77 69 74 63 68 6e 61 6d 65 20 22 2c 20 79 6f 75 witchname ", you
9230: 20 6d 75 73 74 20 73 70 65 63 69 66 79 20 74 68 must specify th
9240: 65 20 74 61 72 67 65 74 20 77 69 74 68 20 2d 74 e target with -t
9250: 61 72 67 65 74 22 29 0a 20 20 20 20 20 20 28 65 arget"). (e
9260: 78 69 74 20 33 29 29 0a 20 20 20 20 20 28 28 6e xit 3)). ((n
9270: 6f 74 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 ot runname).
9280: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
9290: 20 22 45 52 52 4f 52 3a 20 4d 69 73 73 69 6e 67 "ERROR: Missing
92a0: 20 72 65 71 75 69 72 65 64 20 70 61 72 61 6d 65 required parame
92b0: 74 65 72 20 66 6f 72 20 22 20 73 77 69 74 63 68 ter for " switch
92c0: 6e 61 6d 65 20 22 2c 20 79 6f 75 20 6d 75 73 74 name ", you must
92d0: 20 73 70 65 63 69 66 79 20 74 68 65 20 72 75 6e specify the run
92e0: 20 6e 61 6d 65 20 77 69 74 68 20 3a 72 75 6e 6e name with :runn
92f0: 61 6d 65 20 72 75 6e 6e 61 6d 65 22 29 0a 20 20 ame runname").
9300: 20 20 20 20 28 65 78 69 74 20 33 29 29 0a 20 20 (exit 3)).
9310: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 (else. (
9320: 6c 65 74 20 28 28 64 62 20 20 20 23 66 29 0a 09 let ((db #f)..
9330: 20 20 20 20 28 6b 65 79 73 20 23 66 29 29 0a 09 (keys #f))..
9340: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
9350: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 28 for-run)).. (
9360: 62 65 67 69 6e 20 0a 09 20 20 20 20 20 20 28 64 begin .. (d
9370: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 ebug:print 0 "Fa
9380: 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 iled to setup, e
9390: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 20 xiting")..
93a0: 28 65 78 69 74 20 31 29 29 29 0a 09 28 73 65 74 (exit 1)))..(set
93b0: 21 20 64 62 20 20 20 28 6f 70 65 6e 2d 64 62 29 ! db (open-db)
93c0: 29 0a 09 28 69 66 20 28 61 72 67 73 3a 67 65 74 )..(if (args:get
93d0: 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 0a -arg "-server").
93e0: 09 20 20 20 20 28 73 65 72 76 65 72 3a 73 74 61 . (server:sta
93f0: 72 74 20 64 62 20 28 61 72 67 73 3a 67 65 74 2d rt db (args:get-
9400: 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a arg "-server")).
9410: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f . (if (not (o
9420: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
9430: 22 2d 72 75 6e 61 6c 6c 22 29 0a 09 09 09 20 20 "-runall")....
9440: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
9450: 72 75 6e 74 65 73 74 73 22 29 29 29 0a 09 09 28 runtests")))...(
9460: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
9470: 74 75 70 20 64 62 29 29 29 0a 09 28 73 65 74 21 tup db)))..(set!
9480: 20 6b 65 79 73 20 28 72 64 62 3a 67 65 74 2d 6b keys (rdb:get-k
9490: 65 79 73 20 64 62 29 29 0a 09 3b 3b 20 68 61 76 eys db))..;; hav
94a0: 65 20 65 6e 6f 75 67 68 20 74 6f 20 70 72 6f 63 e enough to proc
94b0: 65 73 73 20 2d 74 61 72 67 65 74 20 6f 72 20 2d ess -target or -
94c0: 72 65 71 74 61 72 67 20 68 65 72 65 0a 09 28 69 reqtarg here..(i
94d0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
94e0: 22 2d 72 65 71 74 61 72 67 22 29 0a 09 20 20 20 "-reqtarg")..
94f0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 63 6f 6e 66 (let* ((runconf
9500: 69 67 66 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 igf (conc *topp
9510: 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 ath* "/runconfig
9520: 73 2e 63 6f 6e 66 69 67 22 29 29 20 3b 3b 20 44 s.config")) ;; D
9530: 4f 20 4e 4f 54 20 45 56 41 4c 55 41 54 45 20 41 O NOT EVALUATE A
9540: 4c 4c 20 0a 09 09 20 20 20 28 72 75 6e 63 6f 6e LL ... (runcon
9550: 66 69 67 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 fig (read-confi
9560: 67 20 72 75 6e 63 6f 6e 66 69 67 66 20 23 66 20 g runconfigf #f
9570: 23 66 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a #f environ-patt:
9580: 20 23 66 29 29 29 20 0a 09 20 20 20 20 20 20 28 #f))) .. (
9590: 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 if (hash-table-r
95a0: 65 66 2f 64 65 66 61 75 6c 74 20 72 75 6e 63 6f ef/default runco
95b0: 6e 66 69 67 20 28 61 72 67 73 3a 67 65 74 2d 61 nfig (args:get-a
95c0: 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 20 23 rg "-reqtarg") #
95d0: 66 29 0a 09 09 20 20 28 6b 65 79 73 3a 74 61 72 f)... (keys:tar
95e0: 67 65 74 2d 73 65 74 2d 61 72 67 73 20 6b 65 79 get-set-args key
95f0: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 s (args:get-arg
9600: 22 2d 72 65 71 74 61 72 67 22 29 20 61 72 67 73 "-reqtarg") args
9610: 3a 61 72 67 2d 68 61 73 68 29 0a 09 09 20 20 28 :arg-hash)... (
9620: 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 begin... (deb
9630: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
9640: 52 3a 20 5b 22 20 28 61 72 67 73 3a 67 65 74 2d R: [" (args:get-
9650: 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 20 arg "-reqtarg")
9660: 22 5d 20 6e 6f 74 20 66 6f 75 6e 64 20 69 6e 20 "] not found in
9670: 22 20 72 75 6e 63 6f 6e 66 69 67 66 29 0a 09 09 " runconfigf)...
9680: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
9690: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 20 20 20 alize! db)...
96a0: 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 20 20 (exit 1))))..
96b0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
96c0: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a 09 arg "-target")..
96d0: 09 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 73 65 .(keys:target-se
96e0: 74 2d 61 72 67 73 20 6b 65 79 73 20 28 61 72 67 t-args keys (arg
96f0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
9700: 65 74 22 20 61 72 67 73 3a 61 72 67 2d 68 61 73 et" args:arg-has
9710: 68 29 20 61 72 67 73 3a 61 72 67 2d 68 61 73 68 h) args:arg-hash
9720: 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 63 )))..(if (not (c
9730: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
9740: 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin..
9750: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
9760: 74 20 30 20 22 45 52 52 4f 52 3a 20 41 74 74 65 t 0 "ERROR: Atte
9770: 6d 70 74 65 64 20 74 6f 20 22 20 61 63 74 69 6f mpted to " actio
9780: 6e 2d 64 65 73 63 20 22 20 62 75 74 20 72 75 6e n-desc " but run
9790: 20 61 72 65 61 20 63 6f 6e 66 69 67 20 66 69 6c area config fil
97a0: 65 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 20 e not found")..
97b0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 (exit 1))..
97c0: 20 20 20 20 3b 3b 20 45 78 74 72 61 63 74 20 6f ;; Extract o
97d0: 75 74 20 73 74 75 66 66 20 6e 65 65 64 65 64 20 ut stuff needed
97e0: 69 6e 20 6d 6f 73 74 20 6f 72 20 6d 61 6e 79 20 in most or many
97f0: 63 61 6c 6c 73 0a 09 20 20 20 20 3b 3b 20 68 65 calls.. ;; he
9800: 72 65 20 74 68 65 6e 20 63 61 6c 6c 20 70 72 6f re then call pro
9810: 63 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 6b c.. (let* ((k
9820: 65 79 6e 61 6d 65 73 20 20 20 28 6d 61 70 20 6b eynames (map k
9830: 65 79 3a 67 65 74 2d 66 69 65 6c 64 6e 61 6d 65 ey:get-fieldname
9840: 20 6b 65 79 73 29 29 0a 09 09 20 20 20 28 6b 65 keys))... (ke
9850: 79 76 61 6c 6c 73 74 20 20 28 6b 65 79 73 2d 3e yvallst (keys->
9860: 76 61 6c 6c 69 73 74 20 6b 65 79 73 20 23 74 29 vallist keys #t)
9870: 29 29 0a 09 20 20 20 20 20 20 28 70 72 6f 63 20 )).. (proc
9880: 64 62 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d db target runnam
9890: 65 20 6b 65 79 73 20 6b 65 79 6e 61 6d 65 73 20 e keys keynames
98a0: 6b 65 79 76 61 6c 6c 73 74 29 29 29 0a 09 28 69 keyvallst)))..(i
98b0: 66 20 74 68 31 20 28 74 68 72 65 61 64 2d 6a 6f f th1 (thread-jo
98c0: 69 6e 21 20 74 68 31 29 29 0a 09 28 73 71 6c 69 in! th1))..(sqli
98d0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
98e0: 29 0a 09 28 73 65 74 21 20 2a 64 69 64 73 6f 6d )..(set! *didsom
98f0: 65 74 68 69 6e 67 2a 20 23 74 29 29 29 29 29 29 ething* #t))))))
9900: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
9910: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9920: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4c 6f ==========.;; Lo
9950: 63 6b 2f 75 6e 6c 6f 63 6b 20 72 75 6e 73 0a 3b ck/unlock runs.;
9960: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
9970: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9980: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9990: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
99a0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 =======..(define
99b0: 20 28 72 75 6e 73 3a 68 61 6e 64 6c 65 2d 6c 6f (runs:handle-lo
99c0: 63 6b 69 6e 67 20 64 62 20 74 61 72 67 65 74 20 cking db target
99d0: 6b 65 79 73 20 72 75 6e 6e 61 6d 65 20 6c 6f 63 keys runname loc
99e0: 6b 20 75 6e 6c 6f 63 6b 20 75 73 65 72 29 0a 20 k unlock user).
99f0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 64 61 74 20 (let* ((rundat
9a00: 20 20 28 72 75 6e 73 3a 67 65 74 2d 72 75 6e 73 (runs:get-runs
9a10: 2d 62 79 2d 70 61 74 74 20 64 62 20 6b 65 79 73 -by-patt db keys
9a20: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 68 65 runname)).. (he
9a30: 61 64 65 72 20 20 20 28 76 65 63 74 6f 72 2d 72 ader (vector-r
9a40: 65 66 20 72 75 6e 64 61 74 20 30 29 29 0a 09 20 ef rundat 0))..
9a50: 28 72 75 6e 73 20 20 20 20 20 28 76 65 63 74 6f (runs (vecto
9a60: 72 2d 72 65 66 20 72 75 6e 64 61 74 20 31 29 29 r-ref rundat 1))
9a70: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
9a80: 28 6c 61 6d 62 64 61 20 28 72 75 6e 29 0a 09 09 (lambda (run)...
9a90: 28 6c 65 74 20 28 28 72 75 6e 2d 69 64 20 28 64 (let ((run-id (d
9aa0: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
9ab0: 65 61 64 65 72 20 72 75 6e 20 68 65 61 64 65 72 eader run header
9ac0: 20 22 69 64 22 29 29 29 0a 09 09 20 20 28 69 66 "id")))... (if
9ad0: 20 28 6f 72 20 6c 6f 63 6b 0a 09 09 09 20 20 28 (or lock.... (
9ae0: 61 6e 64 20 75 6e 6c 6f 63 6b 0a 09 09 09 20 20 and unlock....
9af0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
9b00: 20 28 70 72 69 6e 74 20 22 44 6f 20 79 6f 75 20 (print "Do you
9b10: 72 65 61 6c 6c 79 20 77 69 73 68 20 74 6f 20 75 really wish to u
9b20: 6e 6c 6f 63 6b 20 72 75 6e 20 22 20 72 75 6e 2d nlock run " run-
9b30: 69 64 20 22 3f 5c 6e 20 20 20 79 2f 6e 3a 20 22 id "?\n y/n: "
9b40: 29 0a 09 09 09 09 20 28 65 71 75 61 6c 3f 20 22 )..... (equal? "
9b50: 79 22 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 y" (read-line)))
9b60: 29 29 0a 09 09 20 20 20 20 20 20 28 64 62 3a 6c ))... (db:l
9b70: 6f 63 6b 2f 75 6e 6c 6f 63 6b 2d 72 75 6e 20 64 ock/unlock-run d
9b80: 62 20 72 75 6e 2d 69 64 20 6c 6f 63 6b 20 75 6e b run-id lock un
9b90: 6c 6f 63 6b 20 75 73 65 72 29 0a 09 09 20 20 20 lock user)...
9ba0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
9bb0: 30 20 22 49 4e 46 4f 3a 20 53 6b 69 70 70 69 6e 0 "INFO: Skippin
9bc0: 67 20 6c 6f 63 6b 2f 75 6e 6c 6f 63 6b 20 6f 6e g lock/unlock on
9bd0: 20 22 20 72 75 6e 2d 69 64 29 29 29 29 0a 09 20 " run-id))))..
9be0: 20 20 20 20 20 72 75 6e 73 29 29 29 0a 3b 3b 3d runs))).;;=
9bf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c30: 3d 3d 3d 3d 3d 0a 3b 3b 20 52 6f 6c 6c 75 70 20 =====.;; Rollup
9c40: 72 75 6e 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d runs.;;=========
9c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
9c80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b =============..;
9c90: 3b 20 55 70 64 61 74 65 20 74 68 65 20 74 65 73 ; Update the tes
9ca0: 74 5f 6d 65 74 61 20 74 61 62 6c 65 20 66 6f 72 t_meta table for
9cb0: 20 74 68 69 73 20 74 65 73 74 0a 28 64 65 66 69 this test.(defi
9cc0: 6e 65 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d ne (runs:update-
9cd0: 74 65 73 74 5f 6d 65 74 61 20 64 62 20 74 65 73 test_meta db tes
9ce0: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 t-name test-conf
9cf0: 29 0a 20 20 28 6c 65 74 20 28 28 63 75 72 72 72 ). (let ((currr
9d00: 65 63 6f 72 64 20 28 64 62 3a 74 65 73 74 6d 65 ecord (db:testme
9d10: 74 61 2d 67 65 74 2d 72 65 63 6f 72 64 20 64 62 ta-get-record db
9d20: 20 74 65 73 74 2d 6e 61 6d 65 29 29 29 0a 20 20 test-name))).
9d30: 20 20 28 69 66 20 28 6e 6f 74 20 63 75 72 72 72 (if (not currr
9d40: 65 63 6f 72 64 29 0a 09 28 62 65 67 69 6e 0a 09 ecord)..(begin..
9d50: 20 20 28 73 65 74 21 20 63 75 72 72 72 65 63 6f (set! currreco
9d60: 72 64 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 rd (make-vector
9d70: 31 30 20 23 66 29 29 0a 09 20 20 28 64 62 3a 74 10 #f)).. (db:t
9d80: 65 73 74 6d 65 74 61 2d 61 64 64 2d 72 65 63 6f estmeta-add-reco
9d90: 72 64 20 64 62 20 74 65 73 74 2d 6e 61 6d 65 29 rd db test-name)
9da0: 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 )). (for-each
9db0: 20 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
9dc0: 6b 65 79 29 0a 20 20 20 20 20 20 20 28 6c 65 74 key). (let
9dd0: 2a 20 28 28 69 64 78 20 28 63 61 64 72 20 6b 65 * ((idx (cadr ke
9de0: 79 29 29 0a 09 20 20 20 20 20 20 28 66 6c 64 20 y)).. (fld
9df0: 28 63 61 72 20 20 6b 65 79 29 29 0a 09 20 20 20 (car key))..
9e00: 20 20 20 28 76 61 6c 20 28 63 6f 6e 66 69 67 2d (val (config-
9e10: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
9e20: 20 22 74 65 73 74 5f 6d 65 74 61 22 20 66 6c 64 "test_meta" fld
9e30: 29 29 29 0a 09 20 3b 3b 20 28 64 65 62 75 67 3a ))).. ;; (debug:
9e40: 70 72 69 6e 74 20 35 20 22 69 64 78 3a 20 22 20 print 5 "idx: "
9e50: 69 64 78 20 22 20 66 6c 64 3a 20 22 20 66 6c 64 idx " fld: " fld
9e60: 20 22 20 76 61 6c 3a 20 22 20 76 61 6c 29 0a 09 " val: " val)..
9e70: 20 28 69 66 20 28 61 6e 64 20 76 61 6c 20 28 6e (if (and val (n
9e80: 6f 74 20 28 65 71 75 61 6c 3f 20 28 76 65 63 74 ot (equal? (vect
9e90: 6f 72 2d 72 65 66 20 63 75 72 72 72 65 63 6f 72 or-ref currrecor
9ea0: 64 20 69 64 78 29 20 76 61 6c 29 29 29 0a 09 20 d idx) val)))..
9eb0: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
9ec0: 20 20 20 28 70 72 69 6e 74 20 22 55 70 64 61 74 (print "Updat
9ed0: 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 ing " test-name
9ee0: 22 20 22 20 66 6c 64 20 22 20 74 6f 20 22 20 76 " " fld " to " v
9ef0: 61 6c 29 0a 09 20 20 20 20 20 20 20 28 64 62 3a al).. (db:
9f00: 74 65 73 74 6d 65 74 61 2d 75 70 64 61 74 65 2d testmeta-update-
9f10: 66 69 65 6c 64 20 64 62 20 74 65 73 74 2d 6e 61 field db test-na
9f20: 6d 65 20 66 6c 64 20 76 61 6c 29 29 29 29 29 0a me fld val))))).
9f30: 20 20 20 20 20 27 28 28 22 61 75 74 68 6f 72 22 '(("author"
9f40: 20 32 29 28 22 6f 77 6e 65 72 22 20 33 29 28 22 2)("owner" 3)("
9f50: 64 65 73 63 72 69 70 74 69 6f 6e 22 20 34 29 28 description" 4)(
9f60: 22 72 65 76 69 65 77 65 64 22 20 35 29 28 22 74 "reviewed" 5)("t
9f70: 61 67 73 22 20 39 29 29 29 29 29 0a 0a 3b 3b 20 ags" 9)))))..;;
9f80: 55 70 64 61 74 65 20 74 65 73 74 5f 6d 65 74 61 Update test_meta
9f90: 20 66 6f 72 20 61 6c 6c 20 74 65 73 74 73 0a 28 for all tests.(
9fa0: 64 65 66 69 6e 65 20 28 72 75 6e 73 3a 75 70 64 define (runs:upd
9fb0: 61 74 65 2d 61 6c 6c 2d 74 65 73 74 5f 6d 65 74 ate-all-test_met
9fc0: 61 20 64 62 29 0a 20 20 28 6c 65 74 20 28 28 74 a db). (let ((t
9fd0: 65 73 74 2d 6e 61 6d 65 73 20 28 67 65 74 2d 61 est-names (get-a
9fe0: 6c 6c 2d 6c 65 67 61 6c 2d 74 65 73 74 73 29 29 ll-legal-tests))
9ff0: 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ). (for-each
a000: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
a010: 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 est-name).
a020: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 70 61 (let* ((test-pa
a030: 74 68 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 th (conc *top
a040: 70 61 74 68 2a 20 22 2f 74 65 73 74 73 2f 22 20 path* "/tests/"
a050: 74 65 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 20 test-name))..
a060: 20 20 20 28 74 65 73 74 2d 63 6f 6e 66 69 67 66 (test-configf
a070: 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 (conc test-path
a080: 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 29 "/testconfig"))
a090: 0a 09 20 20 20 20 20 20 28 74 65 73 74 65 78 69 .. (testexi
a0a0: 73 74 73 20 20 20 28 61 6e 64 20 28 66 69 6c 65 sts (and (file
a0b0: 2d 65 78 69 73 74 73 3f 20 74 65 73 74 2d 63 6f -exists? test-co
a0c0: 6e 66 69 67 66 29 28 66 69 6c 65 2d 72 65 61 64 nfigf)(file-read
a0d0: 2d 61 63 63 65 73 73 3f 20 74 65 73 74 2d 63 6f -access? test-co
a0e0: 6e 66 69 67 66 29 29 29 0a 09 20 20 20 20 20 20 nfigf)))..
a0f0: 3b 3b 20 72 65 61 64 20 63 6f 6e 66 69 67 73 20 ;; read configs
a100: 77 69 74 68 20 74 72 69 63 6b 73 20 74 75 72 6e with tricks turn
a110: 65 64 20 6f 66 66 20 28 69 2e 65 2e 20 6e 6f 20 ed off (i.e. no
a120: 73 79 73 74 65 6d 29 0a 09 20 20 20 20 20 20 28 system).. (
a130: 74 65 73 74 2d 63 6f 6e 66 20 20 20 20 28 69 66 test-conf (if
a140: 20 74 65 73 74 65 78 69 73 74 73 20 28 72 65 61 testexists (rea
a150: 64 2d 63 6f 6e 66 69 67 20 74 65 73 74 2d 63 6f d-config test-co
a160: 6e 66 69 67 66 20 23 66 20 23 66 29 28 6d 61 6b nfigf #f #f)(mak
a170: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 29 29 e-hash-table))))
a180: 0a 09 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d .. (runs:update-
a190: 74 65 73 74 5f 6d 65 74 61 20 64 62 20 74 65 73 test_meta db tes
a1a0: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 t-name test-conf
a1b0: 29 29 29 0a 20 20 20 20 20 74 65 73 74 2d 6e 61 ))). test-na
a1c0: 6d 65 73 29 29 29 0a 0a 3b 3b 20 54 68 69 73 20 mes)))..;; This
a1d0: 63 6f 75 6c 64 20 70 72 6f 62 61 62 6c 79 20 62 could probably b
a1e0: 65 20 72 65 66 61 63 74 6f 72 65 64 20 69 6e 74 e refactored int
a1f0: 6f 20 6f 6e 65 20 63 6f 6d 70 6c 65 78 20 71 75 o one complex qu
a200: 65 72 79 20 2e 2e 2e 0a 28 64 65 66 69 6e 65 20 ery ....(define
a210: 28 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e (runs:rollup-run
a220: 20 64 62 20 6b 65 79 73 20 6b 65 79 76 61 6c 6c db keys keyvall
a230: 73 74 20 72 75 6e 6e 61 6d 65 20 75 73 65 72 29 st runname user)
a240: 20 3b 3b 20 77 61 73 20 74 61 72 67 65 74 2c 20 ;; was target,
a250: 6e 6f 77 20 6b 65 79 76 61 6c 6c 73 74 0a 20 20 now keyvallst.
a260: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
a270: 72 75 6e 73 3a 72 6f 6c 6c 75 70 2d 72 75 6e 2c runs:rollup-run,
a280: 20 6b 65 79 73 3a 20 22 20 6b 65 79 73 20 22 20 keys: " keys "
a290: 6b 65 79 76 61 6c 6c 73 74 3a 20 22 20 6b 65 79 keyvallst: " key
a2a0: 76 61 6c 6c 73 74 20 22 20 3a 72 75 6e 6e 61 6d vallst " :runnam
a2b0: 65 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 75 73 e " runname " us
a2c0: 65 72 3a 20 22 20 75 73 65 72 29 0a 20 20 28 6c er: " user). (l
a2d0: 65 74 2a 20 28 3b 20 28 6b 65 79 76 61 6c 6c 6c et* (; (keyvalll
a2e0: 73 74 20 20 20 20 20 20 28 6b 65 79 73 3a 74 61 st (keys:ta
a2f0: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
a300: 73 20 74 61 72 67 65 74 29 29 0a 09 20 28 6e 65 s target)).. (ne
a310: 77 2d 72 75 6e 2d 69 64 20 20 20 20 20 20 28 72 w-run-id (r
a320: 75 6e 73 3a 72 65 67 69 73 74 65 72 2d 72 75 6e uns:register-run
a330: 20 64 62 20 6b 65 79 73 20 6b 65 79 76 61 6c 6c db keys keyvall
a340: 73 74 20 72 75 6e 6e 61 6d 65 20 22 6e 65 77 22 st runname "new"
a350: 20 22 6e 2f 61 22 20 75 73 65 72 29 29 0a 09 20 "n/a" user))..
a360: 28 70 72 65 76 2d 74 65 73 74 73 20 20 20 20 20 (prev-tests
a370: 20 28 74 65 73 74 3a 67 65 74 2d 6d 61 74 63 68 (test:get-match
a380: 69 6e 67 2d 70 72 65 76 69 6f 75 73 2d 74 65 73 ing-previous-tes
a390: 74 2d 72 75 6e 2d 72 65 63 6f 72 64 73 20 64 62 t-run-records db
a3a0: 20 6e 65 77 2d 72 75 6e 2d 69 64 20 22 25 22 20 new-run-id "%"
a3b0: 22 25 22 29 29 0a 09 20 28 63 75 72 72 2d 74 65 "%")).. (curr-te
a3c0: 73 74 73 20 20 20 20 20 20 28 72 64 62 3a 67 65 sts (rdb:ge
a3d0: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
a3e0: 64 62 20 6e 65 77 2d 72 75 6e 2d 69 64 20 22 25 db new-run-id "%
a3f0: 22 20 22 25 22 20 27 28 29 20 27 28 29 29 29 0a " "%" '() '())).
a400: 09 20 28 63 75 72 72 2d 74 65 73 74 73 2d 68 61 . (curr-tests-ha
a410: 73 68 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 sh (make-hash-ta
a420: 62 6c 65 29 29 29 0a 20 20 20 20 28 64 62 3a 75 ble))). (db:u
a430: 70 64 61 74 65 2d 72 75 6e 2d 65 76 65 6e 74 5f pdate-run-event_
a440: 74 69 6d 65 20 64 62 20 6e 65 77 2d 72 75 6e 2d time db new-run-
a450: 69 64 29 0a 20 20 20 20 3b 3b 20 69 6e 64 65 78 id). ;; index
a460: 20 74 68 65 20 61 6c 72 65 61 64 79 20 73 61 76 the already sav
a470: 65 64 20 74 65 73 74 73 20 62 79 20 74 65 73 74 ed tests by test
a480: 6e 61 6d 65 20 61 6e 64 20 69 74 65 6d 64 61 74 name and itemdat
a490: 20 69 6e 20 63 75 72 72 2d 74 65 73 74 73 2d 68 in curr-tests-h
a4a0: 61 73 68 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ash. (for-eac
a4b0: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
a4c0: 74 65 73 74 64 61 74 29 0a 20 20 20 20 20 20 20 testdat).
a4d0: 28 6c 65 74 2a 20 28 28 74 65 73 74 6e 61 6d 65 (let* ((testname
a4e0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 (db:test-get-t
a4f0: 65 73 74 6e 61 6d 65 20 74 65 73 74 64 61 74 29 estname testdat)
a500: 29 0a 09 20 20 20 20 20 20 28 69 74 65 6d 2d 70 ).. (item-p
a510: 61 74 68 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ath (db:test-get
a520: 2d 69 74 65 6d 2d 70 61 74 68 20 74 65 73 74 64 -item-path testd
a530: 61 74 29 29 0a 09 20 20 20 20 20 20 28 66 75 6c at)).. (ful
a540: 6c 2d 6e 61 6d 65 20 28 63 6f 6e 63 20 74 65 73 l-name (conc tes
a550: 74 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 tname "/" item-p
a560: 61 74 68 29 29 29 0a 09 20 28 68 61 73 68 2d 74 ath))).. (hash-t
a570: 61 62 6c 65 2d 73 65 74 21 20 63 75 72 72 2d 74 able-set! curr-t
a580: 65 73 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 6e ests-hash full-n
a590: 61 6d 65 20 74 65 73 74 64 61 74 29 29 29 0a 20 ame testdat))).
a5a0: 20 20 20 20 63 75 72 72 2d 74 65 73 74 73 29 0a curr-tests).
a5b0: 20 20 20 20 3b 3b 20 4e 4f 50 45 3a 20 4e 6f 6e ;; NOPE: Non
a5c0: 2d 6f 70 74 69 6d 61 6c 20 61 70 70 72 6f 61 63 -optimal approac
a5d0: 68 2e 20 54 72 79 20 74 68 69 73 20 69 6e 73 74 h. Try this inst
a5e0: 65 61 64 2e 0a 20 20 20 20 3b 3b 20 20 20 31 2e ead.. ;; 1.
a5f0: 20 74 65 73 74 73 20 61 72 65 20 72 65 63 65 69 tests are recei
a600: 76 65 64 20 69 6e 20 61 20 6c 69 73 74 2c 20 6d ved in a list, m
a610: 6f 73 74 20 72 65 63 65 6e 74 20 66 69 72 73 74 ost recent first
a620: 0a 20 20 20 20 3b 3b 20 20 20 32 2e 20 72 65 70 . ;; 2. rep
a630: 6c 61 63 65 20 74 68 65 20 72 6f 6c 6c 75 70 20 lace the rollup
a640: 74 65 73 74 20 77 69 74 68 20 74 68 65 20 6e 65 test with the ne
a650: 77 20 2a 61 6c 77 61 79 73 2a 0a 20 20 20 20 28 w *always*. (
a660: 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 for-each . (
a670: 6c 61 6d 62 64 61 20 28 74 65 73 74 64 61 74 29 lambda (testdat)
a680: 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
a690: 74 65 73 74 6e 61 6d 65 20 20 28 64 62 3a 74 65 testname (db:te
a6a0: 73 74 2d 67 65 74 2d 74 65 73 74 6e 61 6d 65 20 st-get-testname
a6b0: 74 65 73 74 64 61 74 29 29 0a 09 20 20 20 20 20 testdat))..
a6c0: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 64 62 3a (item-path (db:
a6d0: 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 test-get-item-pa
a6e0: 74 68 20 74 65 73 74 64 61 74 29 29 0a 09 20 20 th testdat))..
a6f0: 20 20 20 20 28 66 75 6c 6c 2d 6e 61 6d 65 20 28 (full-name (
a700: 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2f conc testname "/
a710: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 " item-path))..
a720: 20 20 20 20 20 28 70 72 65 76 2d 74 65 73 74 2d (prev-test-
a730: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
a740: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 75 72 72 ref/default curr
a750: 2d 74 65 73 74 73 2d 68 61 73 68 20 66 75 6c 6c -tests-hash full
a760: 2d 6e 61 6d 65 20 23 66 29 29 0a 09 20 20 20 20 -name #f))..
a770: 20 20 28 74 65 73 74 2d 73 74 65 70 73 20 20 20 (test-steps
a780: 20 20 20 28 64 62 3a 67 65 74 2d 73 74 65 70 73 (db:get-steps
a790: 2d 66 6f 72 2d 74 65 73 74 20 64 62 20 28 64 62 -for-test db (db
a7a0: 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 :test-get-id tes
a7b0: 74 64 61 74 29 29 29 0a 09 20 20 20 20 20 20 28 tdat))).. (
a7c0: 6e 65 77 2d 74 65 73 74 2d 72 65 63 6f 72 64 20 new-test-record
a7d0: 23 66 29 29 0a 09 20 3b 3b 20 72 65 70 6c 61 63 #f)).. ;; replac
a7e0: 65 20 74 68 65 73 65 20 77 69 74 68 20 69 6e 73 e these with ins
a7f0: 65 72 74 20 2e 2e 2e 20 73 65 6c 65 63 74 0a 09 ert ... select..
a800: 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 33 3a (apply sqlite3:
a810: 65 78 65 63 75 74 65 20 0a 09 09 64 62 20 0a 09 execute ...db ..
a820: 09 28 63 6f 6e 63 20 22 49 4e 53 45 52 54 20 4f .(conc "INSERT O
a830: 52 20 52 45 50 4c 41 43 45 20 49 4e 54 4f 20 74 R REPLACE INTO t
a840: 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 73 ests (run_id,tes
a850: 74 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 tname,state,stat
a860: 75 73 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 68 6f us,event_time,ho
a870: 73 74 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 st,cpuload,diskf
a880: 72 65 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 ree,uname,rundir
a890: 2c 69 74 65 6d 5f 70 61 74 68 2c 72 75 6e 5f 64 ,item_path,run_d
a8a0: 75 72 61 74 69 6f 6e 2c 66 69 6e 61 6c 5f 6c 6f uration,final_lo
a8b0: 67 66 2c 63 6f 6d 6d 65 6e 74 29 20 22 0a 09 09 gf,comment) "...
a8c0: 20 20 20 20 20 20 22 56 41 4c 55 45 53 20 28 3f "VALUES (?
a8d0: 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ,?,?,?,?,?,?,?,?
a8e0: 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 29 0a 09 ,?,?,?,?,?);")..
a8f0: 09 6e 65 77 2d 72 75 6e 2d 69 64 20 28 63 64 64 .new-run-id (cdd
a900: 72 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 r (vector->list
a910: 74 65 73 74 64 61 74 29 29 29 0a 09 20 28 73 65 testdat))).. (se
a920: 74 21 20 6e 65 77 2d 74 65 73 74 64 61 74 20 28 t! new-testdat (
a930: 63 61 72 20 28 72 64 62 3a 67 65 74 2d 74 65 73 car (rdb:get-tes
a940: 74 73 2d 66 6f 72 2d 72 75 6e 20 64 62 20 6e 65 ts-for-run db ne
a950: 77 2d 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d w-run-id testnam
a960: 65 20 69 74 65 6d 2d 70 61 74 68 20 27 28 29 20 e item-path '()
a970: 27 28 29 29 29 29 0a 09 20 28 68 61 73 68 2d 74 '()))).. (hash-t
a980: 61 62 6c 65 2d 73 65 74 21 20 63 75 72 72 2d 74 able-set! curr-t
a990: 65 73 74 73 2d 68 61 73 68 20 66 75 6c 6c 2d 6e ests-hash full-n
a9a0: 61 6d 65 20 6e 65 77 2d 74 65 73 74 64 61 74 29 ame new-testdat)
a9b0: 20 3b 3b 20 74 68 69 73 20 63 6f 75 6c 64 20 62 ;; this could b
a9c0: 65 20 63 6f 6e 66 75 73 69 6e 67 2c 20 77 68 69 e confusing, whi
a9d0: 63 68 20 72 65 63 6f 72 64 20 73 68 6f 75 6c 64 ch record should
a9e0: 20 67 6f 20 69 6e 74 6f 20 74 68 65 20 6c 6f 6f go into the loo
a9f0: 6b 75 70 20 74 61 62 6c 65 3f 0a 09 20 3b 3b 20 kup table?.. ;;
aa00: 4e 6f 77 20 64 75 70 6c 69 63 61 74 65 20 74 68 Now duplicate th
aa10: 65 20 74 65 73 74 20 73 74 65 70 73 0a 09 20 28 e test steps.. (
aa20: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 43 debug:print 4 "C
aa30: 6f 70 79 69 6e 67 20 72 65 63 6f 72 64 73 20 69 opying records i
aa40: 6e 20 74 65 73 74 5f 73 74 65 70 73 20 66 72 6f n test_steps fro
aa50: 6d 20 74 65 73 74 5f 69 64 3d 22 20 28 64 62 3a m test_id=" (db:
aa60: 74 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 test-get-id test
aa70: 64 61 74 29 20 22 20 74 6f 20 22 20 28 64 62 3a dat) " to " (db:
aa80: 74 65 73 74 2d 67 65 74 2d 69 64 20 6e 65 77 2d test-get-id new-
aa90: 74 65 73 74 64 61 74 29 29 0a 09 20 28 73 71 6c testdat)).. (sql
aaa0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 0a 09 20 ite3:execute ..
aab0: 20 64 62 20 0a 09 20 20 28 63 6f 6e 63 20 22 49 db .. (conc "I
aac0: 4e 53 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 NSERT OR REPLACE
aad0: 20 49 4e 54 4f 20 74 65 73 74 5f 73 74 65 70 73 INTO test_steps
aae0: 20 28 74 65 73 74 5f 69 64 2c 73 74 65 70 6e 61 (test_id,stepna
aaf0: 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c me,state,status,
ab00: 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f 6d 6d 65 event_time,comme
ab10: 6e 74 29 20 22 0a 09 09 22 53 45 4c 45 43 54 20 nt) "..."SELECT
ab20: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 " (db:test-get-i
ab30: 64 20 6e 65 77 2d 74 65 73 74 64 61 74 29 20 22 d new-testdat) "
ab40: 2c 73 74 65 70 6e 61 6d 65 2c 73 74 61 74 65 2c ,stepname,state,
ab50: 73 74 61 74 75 73 2c 65 76 65 6e 74 5f 74 69 6d status,event_tim
ab60: 65 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 e,comment FROM t
ab70: 65 73 74 5f 73 74 65 70 73 20 57 48 45 52 45 20 est_steps WHERE
ab80: 74 65 73 74 5f 69 64 3d 3f 3b 22 29 0a 09 20 20 test_id=?;")..
ab90: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 (db:test-get-id
aba0: 74 65 73 74 64 61 74 29 29 0a 09 20 3b 3b 20 4e testdat)).. ;; N
abb0: 6f 77 20 64 75 70 6c 69 63 61 74 65 20 74 68 65 ow duplicate the
abc0: 20 74 65 73 74 20 64 61 74 61 0a 09 20 28 64 65 test data.. (de
abd0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 43 6f 70 bug:print 4 "Cop
abe0: 79 69 6e 67 20 72 65 63 6f 72 64 73 20 69 6e 20 ying records in
abf0: 74 65 73 74 5f 64 61 74 61 20 66 72 6f 6d 20 74 test_data from t
ac00: 65 73 74 5f 69 64 3d 22 20 28 64 62 3a 74 65 73 est_id=" (db:tes
ac10: 74 2d 67 65 74 2d 69 64 20 74 65 73 74 64 61 74 t-get-id testdat
ac20: 29 20 22 20 74 6f 20 22 20 28 64 62 3a 74 65 73 ) " to " (db:tes
ac30: 74 2d 67 65 74 2d 69 64 20 6e 65 77 2d 74 65 73 t-get-id new-tes
ac40: 74 64 61 74 29 29 0a 09 20 28 73 71 6c 69 74 65 tdat)).. (sqlite
ac50: 33 3a 65 78 65 63 75 74 65 20 0a 09 20 20 64 62 3:execute .. db
ac60: 20 0a 09 20 20 28 63 6f 6e 63 20 22 49 4e 53 45 .. (conc "INSE
ac70: 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 4e RT OR REPLACE IN
ac80: 54 4f 20 74 65 73 74 5f 64 61 74 61 20 28 74 65 TO test_data (te
ac90: 73 74 5f 69 64 2c 63 61 74 65 67 6f 72 79 2c 76 st_id,category,v
aca0: 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 78 ariable,value,ex
acb0: 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 73 pected,tol,units
acc0: 2c 63 6f 6d 6d 65 6e 74 29 20 22 0a 09 09 22 53 ,comment) "..."S
acd0: 45 4c 45 43 54 20 22 20 28 64 62 3a 74 65 73 74 ELECT " (db:test
ace0: 2d 67 65 74 2d 69 64 20 6e 65 77 2d 74 65 73 74 -get-id new-test
acf0: 64 61 74 29 20 22 2c 63 61 74 65 67 6f 72 79 2c dat) ",category,
ad00: 76 61 72 69 61 62 6c 65 2c 76 61 6c 75 65 2c 65 variable,value,e
ad10: 78 70 65 63 74 65 64 2c 74 6f 6c 2c 75 6e 69 74 xpected,tol,unit
ad20: 73 2c 63 6f 6d 6d 65 6e 74 20 46 52 4f 4d 20 74 s,comment FROM t
ad30: 65 73 74 5f 64 61 74 61 20 57 48 45 52 45 20 74 est_data WHERE t
ad40: 65 73 74 5f 69 64 3d 3f 3b 22 29 0a 09 20 20 28 est_id=?;").. (
ad50: 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 64 20 74 db:test-get-id t
ad60: 65 73 74 64 61 74 29 29 0a 09 20 29 29 0a 20 20 estdat)).. )).
ad70: 20 20 20 70 72 65 76 2d 74 65 73 74 73 29 29 29 prev-tests)))
ad80: 0a 09 20 0a 20 20 20 20 20 0a .. . .