0000: 3b 3b 20 20 43 6f 70 79 72 69 67 68 74 20 32 30 ;; Copyright 20
0010: 30 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 06-2017, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 3b 3b 0a 3b 3b 20 70 72 nses/>..;;.;; pr
0300: 65 74 65 6e 64 20 74 6f 20 62 65 20 61 20 73 69 etend to be a si
0310: 6d 70 6c 69 66 69 65 64 20 4d 65 67 61 74 65 73 mplified Megates
0320: 74 0a 0a 28 75 73 65 20 73 71 6c 2d 64 65 2d 6c t..(use sql-de-l
0330: 69 74 65 20 64 65 66 73 74 72 75 63 74 29 0a 0a ite defstruct)..
0340: 3b 3b 20 69 6e 69 74 20 74 68 65 20 64 62 20 2d ;; init the db -
0350: 20 4e 4f 54 45 3a 20 74 61 6b 65 73 20 61 20 64 NOTE: takes a d
0360: 62 20 4e 4f 54 20 61 20 64 62 63 6f 6e 6e 0a 3b b NOT a dbconn.;
0370: 3b 0a 28 64 65 66 69 6e 65 20 28 69 6e 69 74 2d ;.(define (init-
0380: 64 62 20 64 62 29 0a 20 20 28 77 69 74 68 2d 74 db db). (with-t
0390: 72 61 6e 73 61 63 74 69 6f 6e 0a 20 20 20 64 62 ransaction. db
03a0: 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 . (lambda ().
03b0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
03c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 71 72 79 (lambda (qry
03d0: 73 74 72 29 0a 09 28 65 78 65 63 20 28 73 71 6c str)..(exec (sql
03e0: 20 64 62 20 71 72 79 73 74 72 29 29 29 0a 20 20 db qrystr))).
03f0: 20 20 20 20 27 28 22 43 52 45 41 54 45 20 54 41 '("CREATE TA
0400: 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 BLE IF NOT EXIST
0410: 53 20 72 75 6e 73 20 0a 20 20 20 20 20 20 20 20 S runs .
0420: 20 20 20 28 69 64 20 20 20 20 20 20 20 20 49 4e (id IN
0430: 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 TEGER PRIMARY KE
0440: 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 74 Y,. t
0450: 61 72 67 65 74 20 20 20 20 54 45 58 54 20 4e 4f arget TEXT NO
0460: 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 T NULL,.
0470: 20 20 20 20 72 75 6e 5f 6e 61 6d 65 20 20 54 45 run_name TE
0480: 58 54 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 XT NOT NULL,.
0490: 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 20 state
04a0: 20 20 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c 4c TEXT NOT NULL
04b0: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 74 ,. st
04c0: 61 74 75 73 20 20 20 20 54 45 58 54 20 4e 4f 54 atus TEXT NOT
04d0: 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 20 NULL,.
04e0: 20 20 20 43 4f 4e 53 54 52 41 49 4e 54 20 72 75 CONSTRAINT ru
04f0: 6e 73 5f 63 6f 6e 73 74 72 61 69 6e 74 20 55 4e ns_constraint UN
0500: 49 51 55 45 20 28 72 75 6e 5f 6e 61 6d 65 29 29 IQUE (run_name))
0510: 3b 22 0a 09 22 43 52 45 41 54 45 20 54 41 42 4c ;".."CREATE TABL
0520: 45 20 49 46 20 4e 4f 54 20 45 58 49 53 54 53 20 E IF NOT EXISTS
0530: 74 65 73 74 73 0a 20 20 20 20 20 20 20 20 20 20 tests.
0540: 20 28 69 64 20 20 20 20 20 20 20 20 49 4e 54 45 (id INTE
0550: 47 45 52 20 50 52 49 4d 41 52 59 20 4b 45 59 2c GER PRIMARY KEY,
0560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e . run
0570: 5f 69 64 20 20 20 20 49 4e 54 45 47 45 52 20 4e _id INTEGER N
0580: 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 OT NULL,.
0590: 20 20 20 20 20 74 65 73 74 5f 6e 61 6d 65 20 54 test_name T
05a0: 45 58 54 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 EXT NOT NULL,.
05b0: 20 20 20 20 20 20 20 20 20 20 73 74 61 74 65 20 state
05c0: 20 20 20 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c TEXT NOT NUL
05d0: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 L,. s
05e0: 74 61 74 75 73 20 20 20 20 54 45 58 54 20 4e 4f tatus TEXT NO
05f0: 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 T NULL,.
0600: 20 20 20 20 73 74 61 72 74 5f 74 69 6d 65 20 49 start_time I
0610: 4e 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 28 NTEGER DEFAULT (
0620: 73 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e strftime('%s','n
0630: 6f 77 27 29 29 2c 0a 20 20 20 20 20 20 20 20 20 ow')),.
0640: 20 20 20 65 6e 64 5f 74 69 6d 65 20 20 20 49 4e end_time IN
0650: 54 45 47 45 52 20 44 45 46 41 55 4c 54 20 2d 31 TEGER DEFAULT -1
0660: 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 43 4f ,. CO
0670: 4e 53 54 52 41 49 4e 54 20 74 65 73 74 73 5f 63 NSTRAINT tests_c
0680: 6f 6e 73 74 72 61 69 6e 74 20 55 4e 49 51 55 45 onstraint UNIQUE
0690: 20 28 72 75 6e 5f 69 64 2c 74 65 73 74 5f 6e 61 (run_id,test_na
06a0: 6d 65 29 29 3b 22 0a 09 22 43 52 45 41 54 45 20 me));".."CREATE
06b0: 54 41 42 4c 45 20 49 46 20 4e 4f 54 20 45 58 49 TABLE IF NOT EXI
06c0: 53 54 53 20 73 74 65 70 73 0a 20 20 20 20 20 20 STS steps.
06d0: 20 20 20 20 20 28 69 64 20 20 20 20 20 20 20 20 (id
06e0: 49 4e 54 45 47 45 52 20 50 52 49 4d 41 52 59 20 INTEGER PRIMARY
06f0: 4b 45 59 2c 0a 20 20 20 20 20 20 20 20 20 20 20 KEY,.
0700: 20 74 65 73 74 5f 69 64 20 20 20 49 4e 54 45 47 test_id INTEG
0710: 45 52 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 ER NOT NULL,.
0720: 20 20 20 20 20 20 20 20 20 73 74 65 70 5f 6e 61 step_na
0730: 6d 65 20 20 54 45 58 54 20 4e 4f 54 20 4e 55 4c me TEXT NOT NUL
0740: 4c 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 L,. s
0750: 74 61 74 65 20 20 20 20 20 54 45 58 54 20 4e 4f tate TEXT NO
0760: 54 20 4e 55 4c 4c 2c 0a 20 20 20 20 20 20 20 20 T NULL,.
0770: 20 20 20 20 73 74 61 74 75 73 20 20 20 20 54 45 status TE
0780: 58 54 20 4e 4f 54 20 4e 55 4c 4c 2c 0a 20 20 20 XT NOT NULL,.
0790: 20 20 20 20 20 20 20 20 20 43 4f 4e 53 54 52 41 CONSTRA
07a0: 49 4e 54 20 73 74 65 70 5f 63 6f 6e 73 74 72 61 INT step_constra
07b0: 69 6e 74 20 55 4e 49 51 55 45 20 28 74 65 73 74 int UNIQUE (test
07c0: 5f 69 64 2c 73 74 65 70 5f 6e 61 6d 65 29 29 3b _id,step_name));
07d0: 22 29 29 29 29 29 0a 0a 28 64 65 66 73 74 72 75 ")))))..(defstru
07e0: 63 74 20 64 62 63 6f 6e 6e 2d 64 61 74 0a 20 20 ct dbconn-dat.
07f0: 64 62 68 20 20 20 20 20 20 20 3b 3b 20 74 68 65 dbh ;; the
0800: 20 64 61 74 61 62 61 73 65 20 68 61 6e 64 6c 65 database handle
0810: 0a 20 20 77 72 69 74 65 61 62 6c 65 20 3b 3b 20 . writeable ;;
0820: 64 6f 20 77 65 20 68 61 76 65 20 77 72 69 74 65 do we have write
0830: 20 61 63 63 65 73 73 3f 0a 20 20 70 61 74 68 20 access?. path
0840: 20 20 20 20 20 3b 3b 20 77 68 65 72 65 20 74 68 ;; where th
0850: 65 20 64 62 20 6c 69 76 65 73 0a 20 20 6e 61 6d e db lives. nam
0860: 65 20 20 20 20 20 20 3b 3b 20 6e 61 6d 65 20 6f e ;; name o
0870: 66 20 74 68 65 20 64 62 0a 20 20 29 0a 0a 3b 3b f the db. )..;;
0880: 20 6f 70 65 6e 20 74 68 65 20 64 61 74 61 62 61 open the databa
0890: 73 65 2c 20 72 65 74 75 72 6e 20 61 20 64 62 63 se, return a dbc
08a0: 6f 6e 6e 20 73 74 72 75 63 74 0a 28 64 65 66 69 onn struct.(defi
08b0: 6e 65 20 28 6f 70 65 6e 2d 63 72 65 61 74 65 2d ne (open-create-
08c0: 64 62 20 70 61 74 68 20 66 6e 61 6d 65 20 69 6e db path fname in
08d0: 69 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 66 75 it). (let* ((fu
08e0: 6c 6c 6e 61 6d 65 20 20 20 20 20 20 20 28 63 6f llname (co
08f0: 6e 63 20 70 61 74 68 20 22 2f 22 20 66 6e 61 6d nc path "/" fnam
0900: 65 29 29 0a 09 20 28 61 6c 72 65 61 64 79 2d 65 e)).. (already-e
0910: 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 69 73 xists (file-exis
0920: 74 73 3f 20 66 75 6c 6c 6e 61 6d 65 29 29 0a 09 ts? fullname))..
0930: 20 28 77 72 69 74 65 2d 61 63 63 65 73 73 20 20 (write-access
0940: 20 28 61 6e 64 20 28 66 69 6c 65 2d 77 72 69 74 (and (file-writ
0950: 65 2d 61 63 63 65 73 73 3f 20 70 61 74 68 29 0a e-access? path).
0960: 09 09 09 20 20 20 20 20 20 28 6f 72 20 28 6e 6f ... (or (no
0970: 74 20 61 6c 72 65 61 64 79 2d 65 78 69 73 74 73 t already-exists
0980: 29 0a 09 09 09 09 20 20 28 61 6e 64 20 61 6c 72 )..... (and alr
0990: 65 61 64 79 2d 65 78 69 73 74 73 0a 09 09 09 09 eady-exists.....
09a0: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 (file-wri
09b0: 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 6e te-access? fulln
09c0: 61 6d 65 29 29 29 29 29 0a 09 20 28 64 62 20 20 ame))))).. (db
09d0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
09e0: 6f 72 20 61 6c 72 65 61 64 79 2d 65 78 69 73 74 or already-exist
09f0: 73 20 77 72 69 74 65 2d 61 63 63 65 73 73 29 0a s write-access).
0a00: 09 09 09 20 20 20 20 20 28 6f 70 65 6e 2d 64 61 ... (open-da
0a10: 74 61 62 61 73 65 20 66 75 6c 6c 6e 61 6d 65 29 tabase fullname)
0a20: 0a 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a .... (begin.
0a30: 09 09 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 ... (print
0a40: 20 22 46 41 54 41 4c 3a 20 4e 6f 20 65 78 69 73 "FATAL: No exis
0a50: 74 69 6e 67 20 64 62 20 61 6e 64 20 6e 6f 20 77 ting db and no w
0a60: 72 69 74 65 20 61 63 63 65 73 73 20 74 68 75 73 rite access thus
0a70: 20 63 61 6e 6e 6f 74 20 63 72 65 61 74 65 20 22 cannot create "
0a80: 20 66 75 6c 6c 6e 61 6d 65 29 20 20 3b 3b 20 6e fullname) ;; n
0a90: 6f 20 64 62 20 61 6e 64 20 6e 6f 20 77 72 69 74 o db and no writ
0aa0: 65 20 61 63 63 65 73 73 20 63 61 6e 6e 6f 74 20 e access cannot
0ab0: 70 72 6f 63 65 65 64 2e 0a 09 09 09 20 20 20 20 proceed.....
0ac0: 20 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 (exit 1))))..
0ad0: 20 28 64 62 63 6f 6e 6e 20 20 20 20 20 20 20 20 (dbconn
0ae0: 20 28 6d 61 6b 65 2d 64 62 63 6f 6e 6e 2d 64 61 (make-dbconn-da
0af0: 74 29 29 29 0a 20 20 20 20 28 73 65 74 2d 62 75 t))). (set-bu
0b00: 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 28 sy-handler! db (
0b10: 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 31 32 30 busy-timeout 120
0b20: 30 30 30 29 29 20 3b 3b 20 73 65 74 20 61 20 62 000)) ;; set a b
0b30: 75 73 79 20 74 69 6d 65 6f 75 74 0a 20 20 20 20 usy timeout.
0b40: 28 65 78 65 63 20 28 73 71 6c 20 64 62 20 22 50 (exec (sql db "P
0b50: 52 41 47 4d 41 20 73 79 6e 63 68 72 6f 6e 6f 75 RAGMA synchronou
0b60: 73 3d 30 3b 22 29 29 0a 20 20 20 20 28 69 66 20 s=0;")). (if
0b70: 28 61 6e 64 20 69 6e 69 74 20 77 72 69 74 65 2d (and init write-
0b80: 61 63 63 65 73 73 20 28 6e 6f 74 20 61 6c 72 65 access (not alre
0b90: 61 64 79 2d 65 78 69 73 74 73 29 29 0a 09 28 69 ady-exists))..(i
0ba0: 6e 69 74 20 64 62 29 29 0a 20 20 20 20 28 64 62 nit db)). (db
0bb0: 63 6f 6e 6e 2d 64 61 74 2d 64 62 68 2d 73 65 74 conn-dat-dbh-set
0bc0: 21 20 20 20 20 20 20 20 64 62 63 6f 6e 6e 20 64 ! dbconn d
0bd0: 62 29 0a 20 20 20 20 28 64 62 63 6f 6e 6e 2d 64 b). (dbconn-d
0be0: 61 74 2d 77 72 69 74 65 61 62 6c 65 2d 73 65 74 at-writeable-set
0bf0: 21 20 64 62 63 6f 6e 6e 20 77 72 69 74 65 2d 61 ! dbconn write-a
0c00: 63 63 65 73 73 29 0a 20 20 20 20 28 64 62 63 6f ccess). (dbco
0c10: 6e 6e 2d 64 61 74 2d 70 61 74 68 2d 73 65 74 21 nn-dat-path-set!
0c20: 20 20 20 20 20 20 64 62 63 6f 6e 6e 20 70 61 74 dbconn pat
0c30: 68 29 0a 20 20 20 20 28 64 62 63 6f 6e 6e 2d 64 h). (dbconn-d
0c40: 61 74 2d 6e 61 6d 65 2d 73 65 74 21 20 20 20 20 at-name-set!
0c50: 20 20 64 62 63 6f 6e 6e 20 66 6e 61 6d 65 29 0a dbconn fname).
0c60: 20 20 20 20 64 62 63 6f 6e 6e 29 29 0a 0a 28 64 dbconn))..(d
0c70: 65 66 69 6e 65 2d 69 6e 6c 69 6e 65 20 28 67 65 efine-inline (ge
0c80: 74 2d 64 62 20 64 62 63 6f 6e 6e 29 0a 20 20 28 t-db dbconn). (
0c90: 64 62 63 6f 6e 6e 2d 64 61 74 2d 64 62 68 20 64 dbconn-dat-dbh d
0ca0: 62 63 6f 6e 6e 29 29 0a 0a 3b 3b 20 52 55 4e 53 bconn))..;; RUNS
0cb0: 0a 0a 3b 3b 20 63 72 65 61 74 65 20 61 20 72 75 ..;; create a ru
0cc0: 6e 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 n.(define (creat
0cd0: 65 2d 72 75 6e 20 64 62 63 6f 6e 6e 20 74 61 72 e-run dbconn tar
0ce0: 67 65 74 20 72 75 6e 2d 6e 61 6d 65 29 0a 20 20 get run-name).
0cf0: 28 65 78 65 63 20 28 73 71 6c 20 28 67 65 74 2d (exec (sql (get-
0d00: 64 62 20 64 62 63 6f 6e 6e 29 20 22 49 4e 53 45 db dbconn) "INSE
0d10: 52 54 20 49 4e 54 4f 20 72 75 6e 73 20 28 72 75 RT INTO runs (ru
0d20: 6e 5f 6e 61 6d 65 2c 74 61 72 67 65 74 2c 73 74 n_name,target,st
0d30: 61 74 65 2c 73 74 61 74 75 73 29 20 56 41 4c 55 ate,status) VALU
0d40: 45 53 20 28 3f 2c 3f 2c 27 4e 45 57 27 2c 27 6e ES (?,?,'NEW','n
0d50: 61 27 29 3b 22 29 0a 09 72 75 6e 2d 6e 61 6d 65 a');")..run-name
0d60: 20 74 61 72 67 65 74 29 29 0a 0a 3b 3b 20 67 65 target))..;; ge
0d70: 74 20 61 20 72 75 6e 20 69 64 0a 28 64 65 66 69 t a run id.(defi
0d80: 6e 65 20 28 67 65 74 2d 72 75 6e 2d 69 64 20 64 ne (get-run-id d
0d90: 62 63 6f 6e 6e 20 74 61 72 67 65 74 20 72 75 6e bconn target run
0da0: 2d 6e 61 6d 65 29 0a 20 20 28 66 69 72 73 74 2d -name). (first-
0db0: 63 6f 6c 75 6d 6e 20 28 71 75 65 72 79 20 66 65 column (query fe
0dc0: 74 63 68 20 28 73 71 6c 20 28 67 65 74 2d 64 62 tch (sql (get-db
0dd0: 20 64 62 63 6f 6e 6e 29 20 22 53 45 4c 45 43 54 dbconn) "SELECT
0de0: 20 69 64 20 46 52 4f 4d 20 72 75 6e 73 20 57 48 id FROM runs WH
0df0: 45 52 45 20 74 61 72 67 65 74 3d 3f 20 41 4e 44 ERE target=? AND
0e00: 20 72 75 6e 5f 6e 61 6d 65 3d 3f 3b 22 29 0a 09 run_name=?;")..
0e10: 09 20 20 20 20 20 20 20 74 61 72 67 65 74 20 72 . target r
0e20: 75 6e 2d 6e 61 6d 65 29 29 29 0a 0a 3b 3b 20 54 un-name)))..;; T
0e30: 45 53 54 53 0a 0a 28 64 65 66 73 74 72 75 63 74 ESTS..(defstruct
0e40: 20 74 65 73 74 2d 64 61 74 0a 20 20 69 64 0a 20 test-dat. id.
0e50: 20 72 75 6e 2d 69 64 0a 20 20 74 65 73 74 2d 6e run-id. test-n
0e60: 61 6d 65 0a 20 20 73 74 61 74 65 0a 20 20 73 74 ame. state. st
0e70: 61 74 75 73 29 0a 0a 3b 3b 20 63 72 65 61 74 65 atus)..;; create
0e80: 20 61 20 74 65 73 74 0a 28 64 65 66 69 6e 65 20 a test.(define
0e90: 28 63 72 65 61 74 65 2d 74 65 73 74 20 64 62 63 (create-test dbc
0ea0: 6f 6e 6e 20 72 75 6e 2d 69 64 20 74 65 73 74 2d onn run-id test-
0eb0: 6e 61 6d 65 29 0a 20 20 28 65 78 65 63 20 28 73 name). (exec (s
0ec0: 71 6c 20 28 67 65 74 2d 64 62 20 64 62 63 6f 6e ql (get-db dbcon
0ed0: 6e 29 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 n) "INSERT INTO
0ee0: 74 65 73 74 73 20 28 72 75 6e 5f 69 64 2c 74 65 tests (run_id,te
0ef0: 73 74 5f 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 st_name,state,st
0f00: 61 74 75 73 29 20 56 41 4c 55 45 53 20 28 3f 2c atus) VALUES (?,
0f10: 3f 2c 27 4e 4f 54 5f 53 54 41 52 54 45 44 27 2c ?,'NOT_STARTED',
0f20: 27 6e 61 27 29 3b 22 29 0a 09 72 75 6e 2d 69 64 'na');")..run-id
0f30: 20 74 65 73 74 2d 6e 61 6d 65 29 29 0a 0a 3b 3b test-name))..;;
0f40: 20 67 65 74 20 61 20 74 65 73 74 20 69 64 0a 28 get a test id.(
0f50: 64 65 66 69 6e 65 20 28 67 65 74 2d 74 65 73 74 define (get-test
0f60: 2d 69 64 20 64 62 63 6f 6e 6e 20 72 75 6e 2d 69 -id dbconn run-i
0f70: 64 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 28 d test-name). (
0f80: 66 69 72 73 74 2d 63 6f 6c 75 6d 6e 20 28 71 75 first-column (qu
0f90: 65 72 79 20 66 65 74 63 68 20 28 73 71 6c 20 28 ery fetch (sql (
0fa0: 67 65 74 2d 64 62 20 64 62 63 6f 6e 6e 29 20 22 get-db dbconn) "
0fb0: 53 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 74 SELECT id FROM t
0fc0: 65 73 74 73 20 57 48 45 52 45 20 72 75 6e 5f 69 ests WHERE run_i
0fd0: 64 3d 3f 20 41 4e 44 20 74 65 73 74 5f 6e 61 6d d=? AND test_nam
0fe0: 65 3d 3f 3b 22 29 0a 09 09 20 20 20 20 20 20 20 e=?;")...
0ff0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
1000: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 69 6e 6c )))..(define-inl
1010: 69 6e 65 20 28 74 65 73 74 2d 72 6f 77 2d 3e 74 ine (test-row->t
1020: 65 73 74 2d 64 61 74 20 72 6f 77 29 0a 20 20 20 est-dat row).
1030: 20 28 6d 61 6b 65 2d 74 65 73 74 2d 64 61 74 0a (make-test-dat.
1040: 20 20 20 20 20 69 64 3a 20 20 20 20 20 20 20 20 id:
1050: 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 20 30 29 (list-ref row 0)
1060: 0a 20 20 20 20 20 72 75 6e 2d 69 64 3a 20 20 20 . run-id:
1070: 20 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 20 31 (list-ref row 1
1080: 29 0a 20 20 20 20 20 74 65 73 74 2d 6e 61 6d 65 ). test-name
1090: 3a 20 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 20 : (list-ref row
10a0: 32 29 0a 20 20 20 20 20 73 74 61 74 65 3a 20 20 2). state:
10b0: 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 6f 77 (list-ref row
10c0: 20 33 29 0a 20 20 20 20 20 73 74 61 74 75 73 3a 3). status:
10d0: 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 72 6f (list-ref ro
10e0: 77 20 34 29 29 29 0a 20 20 0a 3b 3b 20 67 65 74 w 4))). .;; get
10f0: 20 74 68 65 20 64 61 74 61 20 66 6f 72 20 67 69 the data for gi
1100: 76 65 6e 20 74 65 73 74 2d 69 64 0a 28 64 65 66 ven test-id.(def
1110: 69 6e 65 20 28 74 65 73 74 2d 67 65 74 2d 72 65 ine (test-get-re
1120: 63 6f 72 64 20 64 62 63 6f 6e 6e 20 74 65 73 74 cord dbconn test
1130: 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 -id). (let* ((r
1140: 6f 77 20 28 71 75 65 72 79 20 66 65 74 63 68 2d ow (query fetch-
1150: 72 6f 77 20 28 73 71 6c 20 28 67 65 74 2d 64 62 row (sql (get-db
1160: 20 64 62 63 6f 6e 6e 29 20 22 53 45 4c 45 43 54 dbconn) "SELECT
1170: 20 69 64 2c 72 75 6e 5f 69 64 2c 74 65 73 74 5f id,run_id,test_
1180: 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 name,state,statu
1190: 73 20 46 52 4f 4d 20 74 65 73 74 73 20 57 48 45 s FROM tests WHE
11a0: 52 45 20 74 65 73 74 5f 69 64 3d 3f 3b 22 29 0a RE test_id=?;").
11b0: 09 09 20 20 20 20 20 74 65 73 74 2d 69 64 29 29 .. test-id))
11c0: 29 0a 20 20 20 20 28 74 65 73 74 2d 72 6f 77 2d ). (test-row-
11d0: 3e 74 65 73 74 2d 64 61 74 20 72 6f 77 29 29 29 >test-dat row)))
11e0: 0a 0a 3b 3b 20 67 65 74 20 61 20 62 75 6e 63 68 ..;; get a bunch
11f0: 20 6f 66 20 74 65 73 74 73 20 64 61 74 61 0a 28 of tests data.(
1200: 64 65 66 69 6e 65 20 28 74 65 73 74 2d 67 65 74 define (test-get
1210: 2d 74 65 73 74 73 20 64 62 63 6f 6e 6e 20 72 75 -tests dbconn ru
1220: 6e 2d 69 64 73 20 74 65 73 74 2d 6e 61 6d 65 2d n-ids test-name-
1230: 70 61 74 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 patt). (let* ((
1240: 72 6f 77 73 20 28 71 75 65 72 79 20 66 65 74 63 rows (query fetc
1250: 68 2d 72 6f 77 73 0a 09 09 20 20 20 20 20 20 28 h-rows... (
1260: 73 71 6c 20 28 67 65 74 2d 64 62 20 64 62 63 6f sql (get-db dbco
1270: 6e 6e 29 0a 09 09 09 20 20 20 28 63 6f 6e 63 20 nn).... (conc
1280: 22 53 45 4c 45 43 54 20 69 64 2c 72 75 6e 5f 69 "SELECT id,run_i
1290: 64 2c 74 65 73 74 5f 6e 61 6d 65 2c 73 74 61 74 d,test_name,stat
12a0: 65 2c 73 74 61 74 75 73 20 46 52 4f 4d 20 74 65 e,status FROM te
12b0: 73 74 73 20 57 48 45 52 45 20 74 65 73 74 5f 6e sts WHERE test_n
12c0: 61 6d 65 20 4c 49 4b 45 20 3f 20 41 4e 44 20 72 ame LIKE ? AND r
12d0: 75 6e 5f 69 64 20 49 4e 20 28 22 0a 09 09 09 09 un_id IN (".....
12e0: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
12f0: 65 72 73 65 20 28 6d 61 70 20 63 6f 6e 63 20 72 erse (map conc r
1300: 75 6e 2d 69 64 73 29 20 22 2c 22 29 20 22 29 3b un-ids) ",") ");
1310: 22 29 29 0a 09 09 20 20 20 20 20 20 74 65 73 74 "))... test
1320: 2d 6e 61 6d 65 2d 70 61 74 74 29 29 29 0a 20 20 -name-patt))).
1330: 20 20 28 6d 61 70 20 74 65 73 74 2d 72 6f 77 2d (map test-row-
1340: 3e 74 65 73 74 2d 64 61 74 20 72 6f 77 73 29 29 >test-dat rows))
1350: 29 0a 20 20 20 0a 28 64 65 66 69 6e 65 20 28 74 ). .(define (t
1360: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
1370: 61 74 75 73 20 64 62 63 6f 6e 6e 20 74 65 73 74 atus dbconn test
1380: 2d 69 64 20 6e 65 77 2d 73 74 61 74 65 20 6e 65 -id new-state ne
1390: 77 2d 73 74 61 74 75 73 29 0a 20 20 28 65 78 65 w-status). (exe
13a0: 63 20 28 73 71 6c 20 28 67 65 74 2d 64 62 20 64 c (sql (get-db d
13b0: 62 63 6f 6e 6e 29 20 22 55 50 44 41 54 45 20 74 bconn) "UPDATE t
13c0: 65 73 74 73 20 53 45 54 20 73 74 61 74 65 3d 3f ests SET state=?
13d0: 2c 73 74 61 74 75 73 3d 3f 2c 65 6e 64 5f 74 69 ,status=?,end_ti
13e0: 6d 65 3d 3f 20 57 48 45 52 45 20 69 64 3d 3f 3b me=? WHERE id=?;
13f0: 22 29 0a 09 6e 65 77 2d 73 74 61 74 65 20 6e 65 ")..new-state ne
1400: 77 2d 73 74 61 74 75 73 20 28 63 75 72 72 65 6e w-status (curren
1410: 74 2d 73 65 63 6f 6e 64 73 29 20 74 65 73 74 2d t-seconds) test-
1420: 69 64 29 29 0a 0a 3b 3b 20 53 54 45 50 53 0a 0a id))..;; STEPS..
1430: 3b 3b 20 63 72 65 61 74 65 20 61 20 73 74 65 70 ;; create a step
1440: 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 65 .(define (create
1450: 2d 73 74 65 70 20 64 62 63 6f 6e 6e 20 74 65 73 -step dbconn tes
1460: 74 2d 69 64 20 73 74 65 70 2d 6e 61 6d 65 29 0a t-id step-name).
1470: 20 20 28 65 78 65 63 20 28 73 71 6c 20 28 67 65 (exec (sql (ge
1480: 74 2d 64 62 20 64 62 63 6f 6e 6e 29 20 22 49 4e t-db dbconn) "IN
1490: 53 45 52 54 20 49 4e 54 4f 20 73 74 65 70 73 20 SERT INTO steps
14a0: 28 74 65 73 74 5f 69 64 2c 73 74 65 70 5f 6e 61 (test_id,step_na
14b0: 6d 65 2c 73 74 61 74 65 2c 73 74 61 74 75 73 29 me,state,status)
14c0: 20 56 41 4c 55 45 53 20 28 3f 2c 3f 2c 27 4e 4f VALUES (?,?,'NO
14d0: 54 5f 53 54 41 52 54 45 44 27 2c 27 6e 61 27 29 T_STARTED','na')
14e0: 3b 22 29 0a 09 74 65 73 74 2d 69 64 20 73 74 65 ;")..test-id ste
14f0: 70 2d 6e 61 6d 65 29 29 0a 0a 3b 3b 20 67 65 74 p-name))..;; get
1500: 20 61 20 73 74 65 70 20 69 64 0a 28 64 65 66 69 a step id.(defi
1510: 6e 65 20 28 67 65 74 2d 73 74 65 70 2d 69 64 20 ne (get-step-id
1520: 64 62 63 6f 6e 6e 20 74 65 73 74 2d 69 64 20 73 dbconn test-id s
1530: 74 65 70 2d 6e 61 6d 65 29 0a 20 20 28 66 69 72 tep-name). (fir
1540: 73 74 2d 63 6f 6c 75 6d 6e 20 28 71 75 65 72 79 st-column (query
1550: 20 66 65 74 63 68 20 28 73 71 6c 20 28 67 65 74 fetch (sql (get
1560: 2d 64 62 20 64 62 63 6f 6e 6e 29 20 22 53 45 4c -db dbconn) "SEL
1570: 45 43 54 20 69 64 20 46 52 4f 4d 20 73 74 65 70 ECT id FROM step
1580: 73 20 57 48 45 52 45 20 74 65 73 74 5f 69 64 3d s WHERE test_id=
1590: 3f 20 41 4e 44 20 73 74 65 70 5f 6e 61 6d 65 3d ? AND step_name=
15a0: 3f 3b 22 29 0a 09 09 20 20 20 20 20 20 20 74 65 ?;")... te
15b0: 73 74 2d 69 64 20 73 74 65 70 2d 6e 61 6d 65 29 st-id step-name)
15c0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 65 ))..(define (ste
15d0: 70 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 p-set-state-stat
15e0: 75 73 20 64 62 63 6f 6e 6e 20 73 74 65 70 2d 69 us dbconn step-i
15f0: 64 20 6e 65 77 2d 73 74 61 74 65 20 6e 65 77 2d d new-state new-
1600: 73 74 61 74 75 73 29 0a 20 20 28 65 78 65 63 20 status). (exec
1610: 28 73 71 6c 20 28 67 65 74 2d 64 62 20 64 62 63 (sql (get-db dbc
1620: 6f 6e 6e 29 20 22 55 50 44 41 54 45 20 73 74 65 onn) "UPDATE ste
1630: 70 73 20 53 45 54 20 73 74 61 74 65 3d 3f 2c 73 ps SET state=?,s
1640: 74 61 74 75 73 3d 3f 20 57 48 45 52 45 20 69 64 tatus=? WHERE id
1650: 3d 3f 3b 22 29 0a 09 6e 65 77 2d 73 74 61 74 65 =?;")..new-state
1660: 20 6e 65 77 2d 73 74 61 74 75 73 20 73 74 65 70 new-status step
1670: 2d 69 64 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d -id))..;;=======
1680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
16c0: 3b 3b 20 53 74 61 74 69 73 74 69 63 73 20 67 61 ;; Statistics ga
16d0: 74 68 65 72 69 6e 67 0a 3b 3b 3d 3d 3d 3d 3d 3d thering.;;======
16e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
16f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1720: 0a 0a 28 64 65 66 69 6e 65 20 2a 73 74 61 74 73 ..(define *stats
1730: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
1740: 6c 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 le))..(define (u
1750: 70 64 61 74 65 2d 73 74 61 74 73 20 6b 65 79 20 pdate-stats key
1760: 64 75 72 61 74 69 6f 6e 29 0a 20 20 28 6c 65 74 duration). (let
1770: 20 28 28 72 65 63 20 28 6f 72 20 28 68 61 73 68 ((rec (or (hash
1780: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
1790: 6c 74 20 2a 73 74 61 74 73 2a 20 6b 65 79 20 23 lt *stats* key #
17a0: 66 29 0a 09 09 20 28 6c 65 74 20 28 28 6e 65 77 f)... (let ((new
17b0: 20 28 76 65 63 74 6f 72 20 30 20 30 20 30 29 29 (vector 0 0 0))
17c0: 29 0a 09 09 20 20 20 28 68 61 73 68 2d 74 61 62 )... (hash-tab
17d0: 6c 65 2d 73 65 74 21 20 2a 73 74 61 74 73 2a 20 le-set! *stats*
17e0: 6b 65 79 20 6e 65 77 29 0a 09 09 20 20 20 6e 65 key new)... ne
17f0: 77 29 29 29 29 0a 20 20 20 20 28 76 65 63 74 6f w)))). (vecto
1800: 72 2d 73 65 74 21 20 72 65 63 20 30 20 28 2b 20 r-set! rec 0 (+
1810: 28 76 65 63 74 6f 72 2d 72 65 66 20 72 65 63 20 (vector-ref rec
1820: 30 29 20 31 29 29 20 20 20 20 20 20 20 20 3b 3b 0) 1)) ;;
1830: 20 6e 75 6d 20 63 61 6c 6c 73 0a 20 20 20 20 28 num calls. (
1840: 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 20 vector-set! rec
1850: 31 20 28 2b 20 28 76 65 63 74 6f 72 2d 72 65 66 1 (+ (vector-ref
1860: 20 72 65 63 20 31 29 20 64 75 72 61 74 69 6f 6e rec 1) duration
1870: 29 29 20 3b 3b 20 74 6f 74 61 6c 20 64 75 72 61 )) ;; total dura
1880: 74 69 6f 6e 0a 20 20 20 20 28 69 66 20 28 3e 20 tion. (if (>
1890: 64 75 72 61 74 69 6f 6e 20 28 76 65 63 74 6f 72 duration (vector
18a0: 2d 72 65 66 20 72 65 63 20 32 29 20 29 0a 09 28 -ref rec 2) )..(
18b0: 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 63 20 vector-set! rec
18c0: 32 20 64 75 72 61 74 69 6f 6e 29 29 29 29 0a 0a 2 duration))))..
18d0: 28 64 65 66 69 6e 65 20 28 73 74 61 74 77 72 61 (define (statwra
18e0: 70 20 6e 61 6d 65 20 70 72 6f 63 29 0a 20 20 28 p name proc). (
18f0: 6c 61 6d 62 64 61 20 70 61 72 61 6d 73 0a 20 20 lambda params.
1900: 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 2d 74 (let ((start-t
1910: 69 6d 65 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c ime (current-mil
1920: 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 20 20 28 liseconds)).. (
1930: 72 65 73 20 20 20 20 20 20 20 20 28 61 70 70 6c res (appl
1940: 79 20 70 72 6f 63 20 70 61 72 61 6d 73 29 29 29 y proc params)))
1950: 0a 20 20 20 20 20 20 28 75 70 64 61 74 65 2d 73 . (update-s
1960: 74 61 74 73 20 6e 61 6d 65 20 28 2d 20 28 63 75 tats name (- (cu
1970: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
1980: 64 73 29 20 73 74 61 72 74 2d 74 69 6d 65 29 29 ds) start-time))
1990: 0a 20 20 20 20 20 20 72 65 73 29 29 29 0a 0a 28 . res)))..(
19a0: 64 65 66 69 6e 65 20 28 70 72 69 6e 74 2d 73 74 define (print-st
19b0: 61 74 73 20 73 74 61 74 64 61 74 29 0a 20 20 28 ats statdat). (
19c0: 68 61 73 68 2d 74 61 62 6c 65 2d 66 6f 72 2d 65 hash-table-for-e
19d0: 61 63 68 0a 20 20 20 73 74 61 74 64 61 74 0a 20 ach. statdat.
19e0: 20 20 28 6c 61 6d 62 64 61 20 28 6b 65 79 20 76 (lambda (key v
19f0: 61 6c 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 al). (print
1a00: 6b 65 79 20 22 20 63 6f 75 6e 74 3a 20 22 20 28 key " count: " (
1a10: 76 65 63 74 6f 72 2d 72 65 66 20 76 61 6c 20 30 vector-ref val 0
1a20: 29 20 22 20 61 76 67 3a 20 22 20 28 2f 20 28 76 ) " avg: " (/ (v
1a30: 65 63 74 6f 72 2d 72 65 66 20 76 61 6c 20 31 29 ector-ref val 1)
1a40: 28 76 65 63 74 6f 72 2d 72 65 66 20 76 61 6c 20 (vector-ref val
1a50: 30 29 29 20 22 20 6d 61 78 3a 20 22 20 28 76 65 0)) " max: " (ve
1a60: 63 74 6f 72 2d 72 65 66 20 76 61 6c 20 32 29 29 ctor-ref val 2))
1a70: 29 29 29 0a ))).