Artifact
a8ad7abd36d0781405c1ac1cad5129e004fe564b
File
launch.scm
— part of check-in
[fb1ab3f6c9]
at
2012-09-27 16:03:09
on branch test-specific-db
— Cached collection of basic run info
(user:
matt
size: 30386)
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 32 2c 20 4d 61 74 74 68 65 77 06-2012, 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 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
05d0: 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 65 64 :execute encoded
05e0: 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 -cmd). (let* ((
05f0: 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 cmdinfo (read
0600: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 (open-input-stri
0610: 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 ng (base64:base6
0620: 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 65 64 4-decode encoded
0630: 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 28 73 -cmd))))). (s
0640: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
0650: 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a O" encoded-cmd).
0660: 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 63 (if (list? c
0670: 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 65 73 mdinfo) ;; ((tes
0680: 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 65 6c tpath /tmp/mrwel
0690: 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 lan/jazzmind/src
06a0: 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 /example_run/tes
06b0: 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 29 0a ts/sqlitespeed).
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06d0: 20 20 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 ;; (test
06e0: 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 -name sqlitespee
06f0: 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 d) (runscript ru
0700: 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d nscript.rb) (db-
0710: 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 host localhost)
0720: 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c 65 (run-id 1))..(le
0730: 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 28 t* ((testpath (
0740: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0750: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
0760: 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 2d )).. (top-
0770: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
0780: 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 ault 'toppath
0790: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
07a0: 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 (work-area (as
07b0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 soc/default 'wor
07c0: 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 k-area cmdinfo))
07d0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
07e0: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
07f0: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
0800: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
0810: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
0820: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
0830: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
0840: 20 20 20 20 20 20 20 28 65 7a 73 74 65 70 73 20 (ezsteps
0850: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0860: 20 27 65 7a 73 74 65 70 73 20 20 20 63 6d 64 69 'ezsteps cmdi
0870: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
0880: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
0890: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
08a0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
08b0: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
08c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
08d0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
08e0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
08f0: 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 t-id (assoc/de
0900: 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 fault 'test-id
0910: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0920: 20 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 (target (a
0930: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 ssoc/default 'ta
0940: 72 67 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 rget cmdinfo)
0950: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
0960: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
0970: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
0980: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0990: 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 73 (env-ovrd (ass
09a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 2d oc/default 'env-
09b0: 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 0a ovrd cmdinfo)).
09c0: 09 20 20 20 20 20 20 20 28 73 65 74 2d 76 61 72 . (set-var
09d0: 73 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c s (assoc/defaul
09e0: 74 20 27 73 65 74 2d 76 61 72 73 20 20 63 6d 64 t 'set-vars cmd
09f0: 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f 76 info)) ;; pre-ov
0a00: 65 72 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 65 errides from -se
0a10: 74 76 61 72 0a 09 20 20 20 20 20 20 20 28 72 75 tvar.. (ru
0a20: 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 nname (assoc/d
0a30: 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 efault 'runname
0a40: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
0a50: 20 20 20 20 28 6d 65 67 61 74 65 73 74 20 20 28 (megatest (
0a60: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d assoc/default 'm
0a70: 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 66 6f egatest cmdinfo
0a80: 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 2d 62 )).. (mt-b
0a90: 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 73 6f indir-path (asso
0aa0: 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 c/default 'mt-bi
0ab0: 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 ndir-path cmdinf
0ac0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 66 75 6c o)).. (ful
0ad0: 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 72 lrunscript (if r
0ae0: 75 6e 73 63 72 69 70 74 20 28 63 6f 6e 63 20 74 unscript (conc t
0af0: 65 73 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 estpath "/" runs
0b00: 63 72 69 70 74 29 20 23 66 29 29 0a 09 20 20 20 cript) #f))..
0b10: 20 20 20 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 (rollup-stat
0b20: 75 73 20 30 29 29 0a 09 20 20 0a 09 20 20 28 64 us 0)).. .. (d
0b30: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 ebug:print 2 "Ex
0b40: 65 63 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e ectuing " test-n
0b50: 61 6d 65 20 22 20 28 69 64 3a 20 22 20 74 65 73 ame " (id: " tes
0b60: 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 28 67 65 t-id ") on " (ge
0b70: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 t-host-name))..
0b80: 20 3b 3b 20 61 70 70 6c 79 20 70 72 65 2d 6f 76 ;; apply pre-ov
0b90: 65 72 72 69 64 65 73 20 62 65 66 6f 72 65 20 6f errides before o
0ba0: 74 68 65 72 20 76 61 72 69 61 62 6c 65 73 2e 20 ther variables.
0bb0: 54 68 65 20 70 72 65 2d 6f 76 65 72 72 69 64 65 The pre-override
0bc0: 20 76 61 72 73 20 6d 75 73 74 20 6e 6f 74 0a 09 vars must not..
0bd0: 20 20 3b 3b 20 63 6c 6f 62 62 65 72 73 20 74 68 ;; clobbers th
0be0: 69 6e 67 73 20 66 72 6f 6d 20 74 68 65 20 6f 66 ings from the of
0bf0: 66 69 63 69 61 6c 20 73 6f 75 72 63 65 73 20 73 ficial sources s
0c00: 75 63 68 20 61 73 20 6d 65 67 61 74 65 73 74 2e uch as megatest.
0c10: 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f config and runco
0c20: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 09 20 20 nfigs.config..
0c30: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 65 74 (if (string? set
0c40: 2d 76 61 72 73 29 0a 09 20 20 20 20 20 20 28 6c -vars).. (l
0c50: 65 74 20 28 28 76 61 72 70 61 69 72 73 20 28 73 et ((varpairs (s
0c60: 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 65 74 2d tring-split set-
0c70: 76 61 72 73 20 22 2c 22 29 29 29 0a 09 09 28 64 vars ",")))...(d
0c80: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 76 61 ebug:print 4 "va
0c90: 72 70 61 69 72 73 3a 20 22 20 76 61 72 70 61 69 rpairs: " varpai
0ca0: 72 73 29 0a 09 09 28 6d 61 70 20 28 6c 61 6d 62 rs)...(map (lamb
0cb0: 64 61 20 28 76 61 72 70 61 69 72 29 0a 09 09 20 da (varpair)...
0cc0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 (let ((var
0cd0: 76 61 6c 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 val (string-spli
0ce0: 74 20 76 61 72 70 61 69 72 20 22 3d 22 29 29 29 t varpair "=")))
0cf0: 0a 09 09 09 20 28 69 66 20 28 65 71 3f 20 28 6c .... (if (eq? (l
0d00: 65 6e 67 74 68 20 76 61 72 76 61 6c 29 20 32 29 ength varval) 2)
0d10: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
0d20: 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 var (car varval)
0d30: 29 0a 09 09 09 09 20 20 20 28 76 61 6c 20 28 63 )..... (val (c
0d40: 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 adr varval)))...
0d50: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
0d60: 72 69 6e 74 20 31 20 22 41 64 64 69 6e 67 20 70 rint 1 "Adding p
0d70: 72 65 2d 76 61 72 2f 76 61 6c 20 22 20 76 61 72 re-var/val " var
0d80: 20 22 20 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 " = " val " to
0d90: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 the environment"
0da0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
0db0: 65 6e 76 20 76 61 72 20 76 61 6c 29 29 29 29 29 env var val)))))
0dc0: 0a 09 09 20 20 20 20 20 76 61 72 70 61 69 72 73 ... varpairs
0dd0: 29 29 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 ))).. (setenv "
0de0: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
0df0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 work-area).. (
0e00: 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f setenv "MT_TEST_
0e10: 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 NAME" test-name)
0e20: 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f .. (setenv "MT_
0e30: 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 ITEM_INFO" (conc
0e40: 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 28 73 itemdat)).. (s
0e50: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
0e60: 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 E" runname)..
0e70: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d 45 47 (setenv "MT_MEG
0e80: 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 ATEST" megatest
0e90: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
0ea0: 5f 54 41 52 47 45 54 22 20 20 20 20 74 61 72 67 _TARGET" targ
0eb0: 65 74 29 0a 09 20 20 28 69 66 20 6d 74 2d 62 69 et).. (if mt-bi
0ec0: 6e 64 69 72 2d 70 61 74 68 20 28 73 65 74 65 6e ndir-path (seten
0ed0: 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 20 28 v "PATH" (conc (
0ee0: 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 20 22 getenv "PATH") "
0ef0: 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 :" mt-bindir-pat
0f00: 68 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d h))).. (change-
0f10: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 2d 70 61 directory top-pa
0f20: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
0f30: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
0f40: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
0f50: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
0f60: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
0f70: 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 09 3b , exiting") ...;
0f80: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
0f90: 69 7a 65 21 20 64 62 29 0a 09 09 3b 3b 20 28 73 ize! db)...;; (s
0fa0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
0fb0: 20 74 64 62 29 0a 09 09 28 65 78 69 74 20 31 29 tdb)...(exit 1)
0fc0: 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
0fd0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
0fe0: 2a 29 0a 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e *)... (open-run
0ff0: 2d 63 6c 6f 73 65 2d 6d 65 61 73 75 72 65 20 73 -close-measure s
1000: 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d et-megatest-env-
1010: 76 61 72 73 20 23 66 20 72 75 6e 2d 69 64 29 20 vars #f run-id)
1020: 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 62 65 20 ;; these may be
1030: 6e 65 65 64 65 64 20 62 79 20 74 68 65 20 6c 61 needed by the la
1040: 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 73 73 0a unching process.
1050: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
1060: 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 tory work-area)
1070: 0a 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 ... (open-run-c
1080: 6c 6f 73 65 20 73 65 74 2d 72 75 6e 2d 63 6f 6e lose set-run-con
1090: 66 69 67 2d 76 61 72 73 20 23 66 20 72 75 6e 2d fig-vars #f run-
10a0: 69 64 29 0a 09 20 20 3b 3b 20 65 6e 76 69 72 6f id).. ;; enviro
10b0: 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 nment overrides
10c0: 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 are done *before
10d0: 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 * the remaining
10e0: 63 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e critical envars.
10f0: 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d .. (alist->env-
1100: 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 vars env-ovrd)..
1110: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
1120: 65 20 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 e set-megatest-e
1130: 6e 76 2d 76 61 72 73 20 23 66 20 72 75 6e 2d 69 nv-vars #f run-i
1140: 64 29 0a 09 20 20 28 73 65 74 2d 69 74 65 6d 2d d).. (set-item-
1150: 65 6e 76 2d 76 61 72 73 20 69 74 65 6d 64 61 74 env-vars itemdat
1160: 29 0a 09 20 20 28 73 61 76 65 2d 65 6e 76 69 72 ).. (save-envir
1170: 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 onment-as-files
1180: 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 20 28 "megatest").. (
1190: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
11a0: 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 est-set-meta-inf
11b0: 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e o #f test-id run
11c0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
11d0: 65 6d 64 61 74 20 30 29 0a 09 20 20 28 6f 70 65 emdat 0).. (ope
11e0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 n-run-close test
11f0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 -set-status! #f
1200: 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 test-id "REMOTEH
1210: 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 20 OSTSTART" "n/a"
1220: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
1230: 6d 22 29 20 23 66 29 0a 09 20 20 28 69 66 20 28 m") #f).. (if (
1240: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 args:get-arg "-x
1250: 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 28 73 term").. (s
1260: 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 et! fullrunscrip
1270: 74 20 22 78 74 65 72 6d 22 29 0a 09 20 20 20 20 t "xterm")..
1280: 20 20 28 69 66 20 28 61 6e 64 20 66 75 6c 6c 72 (if (and fullr
1290: 75 6e 73 63 72 69 70 74 20 28 6e 6f 74 20 28 66 unscript (not (f
12a0: 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 ile-execute-acce
12b0: 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ss? fullrunscrip
12c0: 74 29 29 29 0a 09 09 20 20 28 73 79 73 74 65 6d t)))... (system
12d0: 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 (conc "chmod ug
12e0: 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 +x " fullrunscri
12f0: 70 74 29 29 29 29 0a 09 20 20 3b 3b 20 57 65 20 pt)))).. ;; We
1300: 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 are about to act
1310: 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 ually kick off t
1320: 68 65 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f he test.. ;; so
1330: 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 this is a good
1340: 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 place to remove
1350: 74 68 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 the records for
1360: 0a 09 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 .. ;; any previ
1370: 6f 75 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 ous runs.. ;; (
1380: 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 db:test-remove-s
1390: 74 65 70 73 20 64 62 20 72 75 6e 2d 69 64 20 74 teps db run-id t
13a0: 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 estname itemdat)
13b0: 0a 09 20 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 .. .. (let* ((
13c0: 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 m (ma
13d0: 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 28 6b ke-mutex))... (k
13e0: 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a ill-job? #f).
13f0: 09 09 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 .. (exit-info
1400: 20 28 76 65 63 74 6f 72 20 23 74 20 23 74 20 23 (vector #t #t #
1410: 74 29 29 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 t))... (job-thre
1420: 61 64 20 20 20 23 66 29 0a 09 09 20 28 72 75 6e ad #f)... (run
1430: 69 74 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 it (lambd
1440: 61 20 28 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 a ()..... ;; (le
1450: 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b t-values..... ;;
1460: 20 20 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 (((pid exit-st
1470: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a atus exit-code).
1480: 09 09 09 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d .... ;; (run-
1490: 6e 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 n-wait fullrunsc
14a0: 72 69 70 74 29 29 29 0a 09 09 09 09 20 0a 09 09 ript)))..... ...
14b0: 09 09 20 3b 3b 20 69 66 20 74 68 65 72 65 20 69 .. ;; if there i
14c0: 73 20 61 20 72 75 6e 73 63 72 69 70 74 20 64 6f s a runscript do
14d0: 20 69 74 20 66 69 72 73 74 0a 09 09 09 09 20 28 it first..... (
14e0: 69 66 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 if fullrunscript
14f0: 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 ..... (let (
1500: 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 (pid (process-ru
1510: 6e 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 n fullrunscript)
1520: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c ))..... (l
1530: 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a et loop ((i 0)).
1540: 09 09 09 09 09 20 28 6c 65 74 2d 76 61 6c 75 65 ..... (let-value
1550: 73 0a 09 09 09 09 09 20 20 28 28 28 70 69 64 2d s...... (((pid-
1560: 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 val exit-status
1570: 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 exit-code) (proc
1580: 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 ess-wait pid #t)
1590: 29 29 0a 09 09 09 09 09 20 20 28 6d 75 74 65 78 ))...... (mutex
15a0: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 -lock! m)......
15b0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
15c0: 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 it-info 0 pid)..
15d0: 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 .... (vector-se
15e0: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 t! exit-info 1 e
15f0: 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 xit-status).....
1600: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
1610: 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 exit-info 2 exit
1620: 2d 63 6f 64 65 29 0a 09 09 09 09 09 20 20 28 73 -code)...... (s
1630: 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 et! rollup-statu
1640: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 0a 09 09 s exit-code) ...
1650: 09 09 09 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f ... (mutex-unlo
1660: 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 69 ck! m)...... (i
1670: 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 f (eq? pid-val 0
1680: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 62 65 )...... (be
1690: 67 69 6e 0a 09 09 09 09 09 09 28 74 68 72 65 61 gin.......(threa
16a0: 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 d-sleep! 2).....
16b0: 09 09 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 ..(loop (+ i 1))
16c0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 29 29 29 )...... )))
16d0: 29 29 0a 09 09 09 09 20 3b 3b 20 74 68 65 6e 2c ))..... ;; then,
16e0: 20 69 66 20 72 75 6e 73 63 72 69 70 74 20 72 61 if runscript ra
16f0: 6e 20 6f 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 n ok (or did not
1700: 20 67 65 74 20 63 61 6c 6c 65 64 29 0a 09 09 09 get called)....
1710: 09 20 3b 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 . ;; do all the
1720: 65 7a 73 74 65 70 73 20 28 69 66 20 61 6e 79 29 ezsteps (if any)
1730: 0a 09 09 09 09 20 28 69 66 20 65 7a 73 74 65 70 ..... (if ezstep
1740: 73 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a s..... (let*
1750: 20 28 28 74 65 73 74 63 6f 6e 66 69 67 20 28 72 ((testconfig (r
1760: 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 ead-config (conc
1770: 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f 74 65 73 work-area "/tes
1780: 74 63 6f 6e 66 69 67 22 29 20 23 66 20 23 74 20 tconfig") #f #t
1790: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 70 environ-patt: "p
17a0: 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 re-launch-env-va
17b0: 72 73 22 29 29 20 3b 3b 20 46 49 58 4d 45 3f 3f rs")) ;; FIXME??
17c0: 3f 20 69 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 ? is allow-syste
17d0: 6d 20 6f 6b 20 68 65 72 65 3f 0a 09 09 09 09 09 m ok here?......
17e0: 20 20 20 20 28 65 7a 73 74 65 70 73 6c 73 74 20 (ezstepslst
17f0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
1800: 64 65 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 default testconf
1810: 69 67 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 ig "ezsteps" '()
1820: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 )))..... (
1830: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 if (not (file-ex
1840: 69 73 74 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 ists? ".ezsteps"
1850: 29 29 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ))(create-direct
1860: 6f 72 79 20 22 2e 65 7a 73 74 65 70 73 22 29 29 ory ".ezsteps"))
1870: 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 69 ..... ;; i
1880: 66 20 65 7a 73 74 65 70 73 20 77 61 73 20 64 65 f ezsteps was de
1890: 66 69 6e 65 64 20 74 68 65 6e 20 77 65 20 61 72 fined then we ar
18a0: 65 20 73 75 72 65 20 74 6f 20 68 61 76 65 20 61 e sure to have a
18b0: 74 20 6c 65 61 73 74 20 6f 6e 65 20 73 74 65 70 t least one step
18c0: 20 62 75 74 20 63 68 65 63 6b 20 61 6e 79 77 61 but check anywa
18d0: 79 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 y..... (if
18e0: 20 28 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 (not (> (length
18f0: 20 65 7a 73 74 65 70 73 6c 73 74 29 20 30 29 29 ezstepslst) 0))
1900: 0a 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a ...... (debug:
1910: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
1920: 65 7a 73 74 65 70 73 20 64 65 66 69 6e 65 64 20 ezsteps defined
1930: 62 75 74 20 65 7a 73 74 65 70 73 6c 73 74 20 69 but ezstepslst i
1940: 73 20 7a 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a s zero length").
1950: 09 09 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f ..... (let loo
1960: 70 20 28 28 65 7a 73 74 65 70 20 28 63 61 72 20 p ((ezstep (car
1970: 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 ezstepslst))....
1980: 09 09 09 20 20 20 20 20 20 28 74 61 6c 20 20 20 ... (tal
1990: 20 28 63 64 72 20 65 7a 73 74 65 70 73 6c 73 74 (cdr ezstepslst
19a0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 ))....... (
19b0: 70 72 65 76 73 74 65 70 20 23 66 29 29 0a 09 09 prevstep #f))...
19c0: 09 09 09 20 20 20 20 20 3b 3b 20 63 68 65 63 6b ... ;; check
19d0: 20 65 78 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 exit-info (vect
19e0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
19f0: 20 31 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 1)...... (i
1a00: 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 f (vector-ref ex
1a10: 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 it-info 1)......
1a20: 09 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 . (let* ((stepna
1a30: 6d 65 20 20 28 63 61 72 20 65 7a 73 74 65 70 29 me (car ezstep)
1a40: 29 20 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 ) ;; do stuff t
1a50: 6f 20 72 75 6e 20 74 68 65 20 73 74 65 70 0a 09 o run the step..
1a60: 09 09 09 09 09 09 28 73 74 65 70 69 6e 66 6f 20 ......(stepinfo
1a70: 20 28 63 61 64 72 20 65 7a 73 74 65 70 29 29 0a (cadr ezstep)).
1a80: 09 09 09 09 09 09 09 28 73 74 65 70 70 61 72 74 .......(steppart
1a90: 73 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 s (string-match
1aa0: 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 7b 28 5b (regexp "^(\\{([
1ab0: 5e 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 ^\\}]*)\\}\\s*|)
1ac0: 28 2e 2a 29 24 22 29 20 73 74 65 70 69 6e 66 6f (.*)$") stepinfo
1ad0: 29 29 0a 09 09 09 09 09 09 09 28 73 74 65 70 70 ))........(stepp
1ae0: 61 72 6d 73 20 28 6c 69 73 74 2d 72 65 66 20 73 arms (list-ref s
1af0: 74 65 70 70 61 72 74 73 20 32 29 29 20 3b 3b 20 tepparts 2)) ;;
1b00: 66 6f 72 20 66 75 74 75 72 65 20 75 73 65 2c 20 for future use,
1b10: 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e {VAR=1,2,3}, run
1b20: 20 73 74 65 70 20 66 6f 72 20 65 61 63 68 20 0a step for each .
1b30: 09 09 09 09 09 09 09 28 73 74 65 70 63 6d 64 20 .......(stepcmd
1b40: 20 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 (list-ref step
1b50: 70 61 72 74 73 20 33 29 29 0a 09 09 09 09 09 09 parts 3)).......
1b60: 09 28 73 63 72 69 70 74 20 20 20 20 22 22 29 20 .(script "")
1b70: 3b 20 22 23 21 2f 62 69 6e 2f 62 61 73 68 5c 6e ; "#!/bin/bash\n
1b80: 22 29 20 3b 3b 20 79 65 70 2c 20 77 65 20 64 65 ") ;; yep, we de
1b90: 70 65 6e 64 20 6f 6e 20 62 69 6e 2f 62 61 73 68 pend on bin/bash
1ba0: 20 46 49 58 4d 45 21 21 21 0a 09 09 09 09 09 09 FIXME!!!.......
1bb0: 09 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 66 .(logpro-used #f
1bc0: 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 4e ))....... ;; N
1bd0: 42 2f 2f 20 63 61 6e 20 73 61 66 65 6c 79 20 61 B// can safely a
1be0: 73 73 75 6d 65 20 77 65 20 61 72 65 20 69 6e 20 ssume we are in
1bf0: 74 65 73 74 2d 61 72 65 61 20 64 69 72 65 63 74 test-area direct
1c00: 6f 72 79 0a 09 09 09 09 09 09 20 20 20 28 64 65 ory....... (de
1c10: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 65 7a 73 bug:print 4 "ezs
1c20: 74 65 70 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 teps:\n stepname
1c30: 3a 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 73 : " stepname " s
1c40: 74 65 70 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 tepinfo: " stepi
1c50: 6e 66 6f 20 22 20 73 74 65 70 70 61 72 74 73 3a nfo " stepparts:
1c60: 20 22 20 73 74 65 70 70 61 72 74 73 0a 09 09 09 " stepparts....
1c70: 09 09 09 09 09 22 20 73 74 65 70 70 61 72 6d 73 ....." stepparms
1c80: 3a 20 22 20 73 74 65 70 70 61 72 6d 73 20 22 20 : " stepparms "
1c90: 73 74 65 70 63 6d 64 3a 20 22 20 73 74 65 70 63 stepcmd: " stepc
1ca0: 6d 64 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 md)....... ...
1cb0: 09 09 09 09 20 20 20 28 69 66 20 28 66 69 6c 65 .... (if (file
1cc0: 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 -exists? (conc s
1cd0: 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f tepname ".logpro
1ce0: 22 29 29 28 73 65 74 21 20 6c 6f 67 70 72 6f 2d "))(set! logpro-
1cf0: 75 73 65 64 20 23 74 29 29 0a 0a 09 09 09 09 09 used #t)).......
1d00: 09 20 20 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 . ;; ;; first
1d10: 73 6f 75 72 63 65 20 74 68 65 20 70 72 65 76 69 source the previ
1d20: 6f 75 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a ous environment.
1d30: 09 09 09 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 ...... ;; (let
1d40: 20 28 28 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e ((prev-env (con
1d50: 63 20 22 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 c ".ezsteps/" pr
1d60: 65 76 73 74 65 70 20 28 69 66 20 28 73 74 72 69 evstep (if (stri
1d70: 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 ng-search (regex
1d80: 70 20 22 63 73 68 22 29 20 0a 09 09 09 09 09 09 p "csh") .......
1d90: 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 09 ;; .....
1da0: 09 09 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d .. (get-environm
1db0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 ent-variable "SH
1dc0: 45 4c 4c 22 29 29 20 22 2e 63 73 68 22 20 22 2e ELL")) ".csh" ".
1dd0: 73 68 22 29 29 29 29 0a 09 09 09 09 09 09 20 20 sh")))).......
1de0: 20 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 70 ;; (if (and p
1df0: 72 65 76 73 74 65 70 20 28 66 69 6c 65 2d 65 78 revstep (file-ex
1e00: 69 73 74 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 ists? prev-env))
1e10: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 ....... ;;
1e20: 20 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 (set! script
1e30: 28 63 6f 6e 63 20 73 63 72 69 70 74 20 22 73 6f (conc script "so
1e40: 75 72 63 65 20 22 20 70 72 65 76 2d 65 6e 76 29 urce " prev-env)
1e50: 29 29 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 )))....... ...
1e60: 09 09 09 09 20 20 20 3b 3b 20 63 61 6c 6c 20 74 .... ;; call t
1e70: 68 65 20 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 he command using
1e80: 20 6d 74 5f 65 7a 73 74 65 70 0a 09 09 09 09 09 mt_ezstep......
1e90: 09 20 20 20 28 73 65 74 21 20 73 63 72 69 70 74 . (set! script
1ea0: 20 28 63 6f 6e 63 20 22 6d 74 5f 65 7a 73 74 65 (conc "mt_ezste
1eb0: 70 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 22 p " stepname " "
1ec0: 20 28 69 66 20 70 72 65 76 73 74 65 70 20 70 72 (if prevstep pr
1ed0: 65 76 73 74 65 70 20 22 2d 22 29 20 22 20 22 20 evstep "-") " "
1ee0: 73 74 65 70 63 6d 64 29 29 0a 0a 09 09 09 09 09 stepcmd)).......
1ef0: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
1f00: 20 34 20 22 73 63 72 69 70 74 3a 20 22 20 73 63 4 "script: " sc
1f10: 72 69 70 74 29 0a 0a 09 09 09 09 09 09 20 20 20 ript)........
1f20: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
1f30: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
1f40: 73 74 61 74 75 73 21 20 23 66 20 74 65 73 74 2d status! #f test-
1f50: 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 id stepname "sta
1f60: 72 74 22 20 22 2d 22 20 69 74 65 6d 64 61 74 20 rt" "-" itemdat
1f70: 23 66 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 #f #f).......
1f80: 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 0a 09 09 ;; now launch...
1f90: 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 .... (let ((pi
1fa0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 73 d (process-run s
1fb0: 63 72 69 70 74 29 29 29 0a 09 09 09 09 09 09 20 cript))).......
1fc0: 20 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 (let process
1fd0: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
1fe0: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
1ff0: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
2000: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
2010: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
2020: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
2030: 09 09 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 ....... (mutex
2040: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 -lock! m).......
2050: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
2060: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
2070: 64 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 d)......... (v
2080: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
2090: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
20a0: 75 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 us)......... (
20b0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
20c0: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
20d0: 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d e)......... (m
20e0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
20f0: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ........ (if (
2100: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
2110: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 62 ....... (b
2120: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 28 egin.......... (
2130: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 thread-sleep! 2)
2140: 0a 09 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 .......... (proc
2150: 65 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 essloop (+ i 1))
2160: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 29 29 ))......... ))
2170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21a0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 69 (let ((exi
21b0: 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nfo (vector-ref
21c0: 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 20 20 exit-info 2)).
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2200: 20 20 20 20 20 20 20 20 20 28 6c 6f 67 66 6e 61 (logfna
2210: 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 (if logpro-used
2220: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
2230: 22 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 0a 20 ".html") ""))).
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 69 6e ;; testin
2280: 67 20 69 66 20 70 72 6f 63 65 64 75 72 65 73 20 g if procedures
2290: 63 61 6c 6c 65 64 20 69 6e 20 61 20 72 65 6d 6f called in a remo
22a0: 74 65 20 63 61 6c 6c 20 63 61 75 73 65 20 70 72 te call cause pr
22b0: 6f 62 6c 65 6d 73 20 28 61 6e 73 3a 20 6e 6f 20 oblems (ans: no
22c0: 6f 72 20 73 6f 20 49 20 73 75 73 70 65 63 74 29 or so I suspect)
22d0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 20 28 ....... (
22e0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
22f0: 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 b:teststep-set-s
2300: 74 61 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 tatus! #f test-i
2310: 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 d stepname "end"
2320: 20 65 78 69 6e 66 6f 20 69 74 65 6d 64 61 74 20 exinfo itemdat
2330: 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 09 09 09 #f logfna)).....
2340: 09 09 20 20 20 20 20 28 69 66 20 6c 6f 67 70 72 .. (if logpr
2350: 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 09 20 28 o-used........ (
2360: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
2370: 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 b:test-set-log!
2380: 23 66 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 #f test-id (conc
2390: 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c stepname ".html
23a0: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 "))).......
23b0: 3b 3b 20 73 65 74 20 74 68 65 20 74 65 73 74 20 ;; set the test
23c0: 66 69 6e 61 6c 20 73 74 61 74 75 73 0a 09 09 09 final status....
23d0: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
23e0: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
23f0: 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 (cond..........
2400: 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 ((and (eq
2410: 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 ? (vector-ref ex
2420: 69 74 2d 69 6e 66 6f 20 32 29 20 32 29 20 6c 6f it-info 2) 2) lo
2430: 67 70 72 6f 2d 75 73 65 64 29 20 27 77 61 72 6e gpro-used) 'warn
2440: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
2450: 20 20 28 28 65 71 3f 20 28 76 65 63 74 6f 72 2d ((eq? (vector-
2460: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
2470: 20 30 29 20 20 20 20 20 20 20 20 20 20 20 20 20 0)
2480: 20 20 20 20 20 20 27 70 61 73 73 29 0a 09 09 09 'pass)....
2490: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 6c ...... (el
24a0: 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 09 09 se 'fail))).....
24b0: 09 09 09 20 20 20 20 28 6f 76 65 72 61 6c 6c 2d ... (overall-
24c0: 73 74 61 74 75 73 20 20 20 28 63 6f 6e 64 0a 09 status (cond..
24d0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
24e0: 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 (eq? rollup-stat
24f0: 75 73 20 32 29 20 27 77 61 72 6e 29 0a 09 09 09 us 2) 'warn)....
2500: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 ...... ((e
2510: 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 q? rollup-status
2520: 20 30 29 20 27 70 61 73 73 29 0a 09 09 09 09 09 0) 'pass)......
2530: 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 .... (else
2540: 20 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 09 'fail))).......
2550: 09 20 20 20 20 28 6e 65 78 74 2d 73 74 61 74 75 . (next-statu
2560: 73 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 s (cond ...
2570: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 ....... ((
2580: 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 eq? overall-stat
2590: 75 73 20 27 70 61 73 73 29 20 74 68 69 73 2d 73 us 'pass) this-s
25a0: 74 65 70 2d 73 74 61 74 75 73 29 0a 09 09 09 09 tep-status).....
25b0: 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 ..... ((eq
25c0: 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 ? overall-status
25d0: 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 'warn).........
25e0: 09 09 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d ..(if (eq? this-
25f0: 73 74 65 70 2d 73 74 61 74 75 73 20 27 66 61 69 step-status 'fai
2600: 6c 29 20 27 66 61 69 6c 20 27 77 61 72 6e 29 29 l) 'fail 'warn))
2610: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2620: 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 29 (else 'fail))))
2630: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 ....... (d
2640: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 45 78 ebug:print 4 "Ex
2650: 69 74 20 76 61 6c 75 65 20 72 65 63 65 69 76 65 it value receive
2660: 64 3a 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 d: " (vector-ref
2670: 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 22 20 exit-info 2) "
2680: 6c 6f 67 70 72 6f 2d 75 73 65 64 3a 20 22 20 6c logpro-used: " l
2690: 6f 67 70 72 6f 2d 75 73 65 64 20 0a 09 09 09 09 ogpro-used .....
26a0: 09 09 09 09 20 20 20 20 22 20 74 68 69 73 2d 73 .... " this-s
26b0: 74 65 70 2d 73 74 61 74 75 73 3a 20 22 20 74 68 tep-status: " th
26c0: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 22 is-step-status "
26d0: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a overall-status:
26e0: 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 " overall-statu
26f0: 73 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 s ......... "
2700: 20 6e 65 78 74 2d 73 74 61 74 75 73 3a 20 22 20 next-status: "
2710: 6e 65 78 74 2d 73 74 61 74 75 73 20 22 20 72 6f next-status " ro
2720: 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 22 20 72 llup-status: " r
2730: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 ollup-status)...
2740: 09 09 09 09 20 20 20 20 20 20 20 28 63 61 73 65 .... (case
2750: 20 6e 65 78 74 2d 73 74 61 74 75 73 0a 09 09 09 next-status....
2760: 09 09 09 09 20 28 28 77 61 72 6e 29 0a 09 09 09 .... ((warn)....
2770: 09 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c .... (set! roll
2780: 75 70 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 up-status 2)....
2790: 09 09 09 09 20 20 3b 3b 20 4e 42 2f 2f 20 74 65 .... ;; NB// te
27a0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
27b0: 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e oes rdb calls un
27c0: 64 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 09 09 der the hood....
27d0: 09 09 09 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d .... (open-run-
27e0: 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 2d 73 close test-set-s
27f0: 74 61 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 tatus! #f test-i
2800: 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 57 41 52 d "RUNNING" "WAR
2810: 4e 22 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 N" ..........
2820: 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 (if (eq? this-s
2830: 74 65 70 2d 73 74 61 74 75 73 20 27 77 61 72 6e tep-status 'warn
2840: 29 20 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 6e ) "Logpro warnin
2850: 67 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 g found" #f)....
2860: 09 09 09 09 09 09 20 20 20 20 23 66 29 29 0a 09 ...... #f))..
2870: 09 09 09 09 09 09 20 28 28 70 61 73 73 29 0a 09 ...... ((pass)..
2880: 09 09 09 09 09 09 20 20 28 6f 70 65 6e 2d 72 75 ...... (open-ru
2890: 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 n-close test-set
28a0: 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 73 74 -status! #f test
28b0: 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 50 -id "RUNNING" "P
28c0: 41 53 53 22 20 23 66 20 23 66 29 29 0a 09 09 09 ASS" #f #f))....
28d0: 09 09 09 09 20 28 65 6c 73 65 20 3b 3b 20 27 66 .... (else ;; 'f
28e0: 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 73 65 ail........ (se
28f0: 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 t! rollup-status
2900: 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 66 61 69 1) ;; force fai
2910: 6c 0a 09 09 09 09 09 09 09 20 20 28 6f 70 65 6e l........ (open
2920: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d -run-close test-
2930: 73 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 set-status! #f t
2940: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2950: 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 22 46 "FAIL" (conc "F
2960: 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 22 20 ailed at step "
2970: 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a 09 09 stepname) #f)...
2980: 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 09 09 ..... )))).....
2990: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 .. (if (and (s
29a0: 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 teprun-good? log
29b0: 70 72 6f 2d 75 73 65 64 20 28 76 65 63 74 6f 72 pro-used (vector
29c0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
29d0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e ))........ (n
29e0: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 ot (null? tal)))
29f0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ....... (l
2a00: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 28 63 oop (car tal) (c
2a10: 64 72 20 74 61 6c 29 20 73 74 65 70 6e 61 6d 65 dr tal) stepname
2a20: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 64 )))...... (d
2a30: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 57 41 ebug:print 4 "WA
2a40: 52 4e 49 4e 47 3a 20 61 20 70 72 69 6f 72 20 73 RNING: a prior s
2a50: 74 65 70 20 66 61 69 6c 65 64 2c 20 73 74 6f 70 tep failed, stop
2a60: 70 69 6e 67 20 61 74 20 22 20 65 7a 73 74 65 70 ping at " ezstep
2a70: 29 29 29 29 29 29 29 29 0a 09 09 20 28 6d 6f 6e ))))))))... (mon
2a80: 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 itorjob (lambd
2a90: 61 20 28 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 a ()..... (let*
2aa0: 28 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 ((start-seconds
2ab0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
2ac0: 29 29 0a 09 09 09 09 09 28 63 61 6c 63 2d 6d 69 ))......(calc-mi
2ad0: 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 28 nutes (lambda (
2ae0: 29 0a 09 09 09 09 09 09 09 20 28 69 6e 65 78 61 )........ (inexa
2af0: 63 74 2d 3e 65 78 61 63 74 20 0a 09 09 09 09 09 ct->exact ......
2b00: 09 09 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 .. (round .....
2b10: 09 09 09 20 20 20 28 2d 20 0a 09 09 09 09 09 09 ... (- .......
2b20: 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 . (current-se
2b30: 63 6f 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 conds) ........
2b40: 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 start-seconds
2b50: 29 29 29 29 29 0a 09 09 09 09 09 28 6b 69 6c 6c )))))......(kill
2b60: 2d 74 72 69 65 73 20 30 29 29 0a 09 09 09 09 20 -tries 0)).....
2b70: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 (let loop ((mi
2b80: 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 nutes (calc-mi
2b90: 6e 75 74 65 73 29 29 29 0a 09 09 09 09 20 20 20 nutes))).....
2ba0: 20 20 3b 3b 20 28 6c 65 74 2a 20 28 3b 3b 20 28 ;; (let* (;; (
2bb0: 64 62 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 db (open-d
2bc0: 62 29 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 b))...... ;;
2bd0: 28 63 70 75 6c 6f 61 64 20 20 28 67 65 74 2d 63 (cpuload (get-c
2be0: 70 75 2d 6c 6f 61 64 29 29 0a 09 09 09 09 09 20 pu-load))......
2bf0: 20 20 20 3b 3b 20 28 64 69 73 6b 66 72 65 65 20 ;; (diskfree
2c00: 28 67 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 (get-df (current
2c10: 2d 64 69 72 65 63 74 6f 72 79 29 29 29 0a 09 09 -directory)))...
2c20: 09 09 09 20 20 20 20 3b 3b 20 28 74 6d 70 66 72 ... ;; (tmpfr
2c30: 65 65 20 20 28 67 65 74 2d 64 66 20 22 2f 74 6d ee (get-df "/tm
2c40: 70 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 p")))..... (
2c50: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 begin.....
2c60: 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 28 61 72 ;; (if (not (ar
2c70: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 gs:get-arg "-ser
2c80: 76 65 72 22 29 29 0a 09 09 09 09 20 20 20 20 20 ver")).....
2c90: 20 20 3b 3b 09 20 20 20 28 73 65 72 76 65 72 3a ;;. (server:
2ca0: 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 29 client-setup db)
2cb0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 )..... ;;
2cc0: 28 69 66 20 28 6e 6f 74 20 63 70 75 6c 6f 61 64 (if (not cpuload
2cd0: 29 20 20 28 62 65 67 69 6e 20 28 64 65 62 75 67 ) (begin (debug
2ce0: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
2cf0: 47 3a 20 43 50 55 4c 4f 41 44 20 6e 6f 74 20 66 G: CPULOAD not f
2d00: 6f 75 6e 64 2e 22 29 20 20 28 73 65 74 21 20 63 ound.") (set! c
2d10: 70 75 6c 6f 61 64 20 22 6e 2f 61 22 29 29 29 0a puload "n/a"))).
2d20: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 .... ;; (i
2d30: 66 20 28 6e 6f 74 20 64 69 73 6b 66 72 65 65 29 f (not diskfree)
2d40: 20 28 62 65 67 69 6e 20 28 64 65 62 75 67 3a 70 (begin (debug:p
2d50: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
2d60: 20 44 49 53 4b 46 52 45 45 20 6e 6f 74 20 66 6f DISKFREE not fo
2d70: 75 6e 64 2e 22 29 20 28 73 65 74 21 20 64 69 73 und.") (set! dis
2d80: 6b 66 72 65 65 20 22 6e 2f 61 22 29 29 29 0a 09 kfree "n/a")))..
2d90: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ... (set!
2da0: 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 6f 70 65 6e 2d kill-job? (open-
2db0: 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d 67 run-close test-g
2dc0: 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 et-kill-request
2dd0: 23 66 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 #f test-id)) ;;
2de0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
2df0: 20 69 74 65 6d 64 61 74 29 29 0a 09 09 09 09 20 itemdat)).....
2e00: 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d (open-run-
2e10: 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 2d 6d close test-set-m
2e20: 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 eta-info #f test
2e30: 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d -id run-id test-
2e40: 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 6d 69 6e name itemdat min
2e50: 75 74 65 73 29 0a 09 09 09 09 20 20 20 20 20 20 utes).....
2e60: 20 3b 3b 20 28 72 64 62 3a 74 65 73 74 2d 75 70 ;; (rdb:test-up
2e70: 64 61 74 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 date-meta-info d
2e80: 62 20 74 65 73 74 2d 69 64 20 6d 69 6e 75 74 65 b test-id minute
2e90: 73 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 s cpuload diskfr
2ea0: 65 65 20 74 6d 70 66 72 65 65 29 0a 09 09 09 09 ee tmpfree).....
2eb0: 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d (if kill-
2ec0: 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 28 62 job? ...... (b
2ed0: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 egin...... (
2ee0: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 mutex-lock! m)..
2ef0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
2f00: 28 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 (pid (vector-ref
2f10: 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a exit-info 0))).
2f20: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
2f30: 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 (number? pid)...
2f40: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
2f50: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
2f60: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
2f70: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
2f80: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 ed to kill job (
2f90: 61 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c attempt # " kill
2fa0: 2d 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 -tries ")").....
2fb0: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 .. (let ((pr
2fc0: 6f 63 65 73 73 65 73 20 28 63 6d 64 2d 72 75 6e ocesses (cmd-run
2fd0: 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 70 67 ->list (conc "pg
2fe0: 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 64 29 rep -l -P " pid)
2ff0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ))).......
3000: 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 (for-each .....
3010: 09 09 09 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 ...(lambda (p)..
3020: 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 ...... (let* ((
3030: 70 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 parts (string-s
3040: 70 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 09 plit p))........
3050: 09 20 28 70 2d 69 64 20 20 20 28 69 66 20 28 3e . (p-id (if (>
3060: 20 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 20 (length parts)
3070: 30 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 0)..........
3080: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
3090: 20 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 (car parts))...
30a0: 09 09 09 09 09 09 09 20 20 20 20 20 23 66 29 29 ....... #f))
30b0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 )........ (if
30c0: 20 70 2d 69 64 0a 09 09 09 09 09 09 09 09 28 62 p-id.........(b
30d0: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 20 28 egin......... (
30e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4b debug:print 0 "K
30f0: 69 6c 6c 69 6e 67 20 22 20 28 63 61 64 72 20 70 illing " (cadr p
3100: 61 72 74 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 arts) "; kill -9
3110: 20 20 22 20 70 2d 69 64 29 0a 09 09 09 09 09 09 " p-id).......
3120: 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e .. (system (con
3130: 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 c "kill -9 " p-i
3140: 64 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 28 d))))))........(
3150: 63 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 0a car processes)).
3160: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 79 ...... (sy
3170: 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c stem (conc "kill
3180: 20 2d 39 20 22 20 70 69 64 29 29 29 29 0a 09 09 -9 " pid))))...
3190: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
31a0: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
31b0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
31c0: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
31d0: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 ed to kill job b
31e0: 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 ut problem with
31f0: 70 72 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 74 process, attempt
3200: 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 ing to kill mana
3210: 67 65 72 20 70 72 6f 63 65 73 73 22 29 0a 09 09 ger process")...
3220: 09 09 09 09 20 20 20 20 20 28 6f 70 65 6e 2d 72 .... (open-r
3230: 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 un-close test-se
3240: 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 73 t-status! #f tes
3250: 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 22 t-id "KILLED" "
3260: 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09 20 20 FAIL".........
3270: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
3280: 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 rg "-m") #f)....
3290: 09 09 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 ... (sqlite3
32a0: 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a :finalize! tdb).
32b0: 09 09 09 09 09 09 20 20 20 20 20 28 65 78 69 74 ...... (exit
32c0: 20 31 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 1))))......
32d0: 20 28 73 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 (set! kill-trie
32e0: 73 20 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 s (+ 1 kill-trie
32f0: 73 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 6d s))...... (m
3300: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 utex-unlock! m))
3310: 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 )..... ;;
3320: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
3330: 65 21 20 64 62 29 0a 09 09 09 09 20 20 20 20 20 e! db).....
3340: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
3350: 20 28 2b 20 31 30 20 28 72 61 6e 64 6f 6d 20 31 (+ 10 (random 1
3360: 30 29 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 0))) ;; add some
3370: 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 20 63 jitter to the c
3380: 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f all home time to
3390: 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 65 20 spread out the
33a0: 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 09 09 db accesses.....
33b0: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 (loop (ca
33c0: 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 29 29 lc-minutes))))))
33d0: 29 0a 09 09 20 28 74 68 31 20 20 20 20 20 20 20 )... (th1
33e0: 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 (make-thread
33f0: 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 09 20 monitorjob))...
3400: 28 74 68 32 20 20 20 20 20 20 20 20 20 20 28 6d (th2 (m
3410: 61 6b 65 2d 74 68 72 65 61 64 20 72 75 6e 69 74 ake-thread runit
3420: 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 6a ))).. (set! j
3430: 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 0a 09 ob-thread th2)..
3440: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
3450: 74 21 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 t! th1).. (th
3460: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 read-start! th2)
3470: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f .. (thread-jo
3480: 69 6e 21 20 74 68 32 29 0a 09 20 20 20 20 28 6d in! th2).. (m
3490: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 utex-lock! m)..
34a0: 20 20 20 3b 3b 20 28 73 65 74 21 20 64 62 20 28 ;; (set! db (
34b0: 6f 70 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 3b open-db)).. ;
34c0: 3b 20 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73 ; (if (not (args
34d0: 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 :get-arg "-serve
34e0: 72 22 29 29 0a 09 20 20 20 20 3b 3b 09 28 73 65 r")).. ;;.(se
34f0: 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 rver:client-setu
3500: 70 20 64 62 29 29 0a 09 20 20 20 20 28 6c 65 74 p db)).. (let
3510: 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 * ((item-path (i
3520: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
3530: 74 65 6d 64 61 74 29 29 0a 09 09 20 20 20 28 74 temdat))... (t
3540: 65 73 74 69 6e 66 6f 20 20 28 6f 70 65 6e 2d 72 estinfo (open-r
3550: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d un-close db:get-
3560: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 test-info-by-id
3570: 23 66 20 74 65 73 74 2d 69 64 29 29 29 20 3b 3b #f test-id))) ;;
3580: 20 29 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 )) ;; run-id te
3590: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
35a0: 68 29 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 h))).. (if
35b0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
35c0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
35d0: 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c testinfo) "COMPL
35e0: 45 54 45 44 22 29 29 0a 09 09 20 20 28 62 65 67 ETED"))... (beg
35f0: 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a in... (debug:
3600: 70 72 69 6e 74 20 32 20 22 54 65 73 74 20 4e 4f print 2 "Test NO
3610: 54 20 6c 6f 67 67 65 64 20 61 73 20 43 4f 4d 50 T logged as COMP
3620: 4c 45 54 45 44 2c 20 28 73 74 61 74 65 3d 22 20 LETED, (state="
3630: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
3640: 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 29 2c te testinfo) "),
3650: 20 75 70 64 61 74 69 6e 67 20 72 65 73 75 6c 74 updating result
3660: 2c 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 , rollup-status
3670: 69 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 is " rollup-stat
3680: 75 73 29 0a 09 09 20 20 20 20 28 6f 70 65 6e 2d us)... (open-
3690: 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 run-close test-s
36a0: 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 et-status! #f te
36b0: 73 74 2d 69 64 20 0a 09 09 09 09 20 20 20 20 20 st-id .....
36c0: 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 (if kill-job? "
36d0: 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 KILLED" "COMPLET
36e0: 45 44 22 29 0a 09 09 09 09 20 20 20 20 20 20 3b ED")..... ;
36f0: 3b 20 4f 6c 64 20 6c 6f 67 69 63 3a 0a 09 09 09 ; Old logic:....
3700: 09 20 20 20 20 20 20 3b 3b 20 28 69 66 20 28 76 . ;; (if (v
3710: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
3720: 6e 66 6f 20 31 29 20 3b 3b 20 6c 6f 6f 6b 20 61 nfo 1) ;; look a
3730: 74 20 74 68 65 20 65 78 69 74 2d 73 74 61 74 75 t the exit-statu
3740: 73 2c 20 23 74 20 6d 65 61 6e 73 20 69 74 20 61 s, #t means it a
3750: 74 20 6c 65 61 73 74 20 72 61 6e 0a 09 09 09 09 t least ran.....
3760: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 28 69 66 ;; (if
3770: 20 28 61 6e 64 20 28 6e 6f 74 20 6b 69 6c 6c 2d (and (not kill-
3780: 6a 6f 62 3f 29 20 0a 09 09 09 09 20 20 20 20 20 job?) .....
3790: 20 3b 3b 20 20 20 20 20 20 20 20 20 28 65 71 3f ;; (eq?
37a0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
37b0: 74 2d 69 6e 66 6f 20 32 29 20 30 29 29 20 3b 3b t-info 2) 0)) ;;
37c0: 20 77 65 20 63 61 6e 20 6e 6f 77 20 75 73 65 20 we can now use
37d0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 69 6e rollup-status in
37e0: 73 74 65 61 64 0a 09 09 09 09 20 20 20 20 20 20 stead.....
37f0: 3b 3b 20 20 20 20 20 20 20 20 20 22 50 41 53 53 ;; "PASS
3800: 22 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 "..... ;;
3810: 20 20 20 20 20 20 20 22 46 41 49 4c 22 29 0a 09 "FAIL")..
3820: 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ... ;;
3830: 22 46 41 49 4c 22 29 20 0a 09 09 09 09 20 20 20 "FAIL") .....
3840: 20 20 20 3b 3b 20 4e 65 77 20 6c 6f 67 69 63 20 ;; New logic
3850: 62 61 73 65 64 20 6f 6e 20 72 6f 6c 6c 75 70 2d based on rollup-
3860: 73 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 20 status.....
3870: 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 20 (cond.....
3880: 20 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d ((not (vector-
3890: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
38a0: 29 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 ) "FAIL") ;; job
38b0: 20 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 0a 09 failed to run..
38c0: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
38d0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 rollup-status 0)
38e0: 0a 09 09 09 09 09 3b 3b 20 69 66 20 74 68 65 20 ......;; if the
38f0: 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 current status i
3900: 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 s AUTO the defer
3910: 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 to the calculat
3920: 65 64 20 76 61 6c 75 65 20 28 69 2e 65 2e 20 6c ed value (i.e. l
3930: 65 61 76 65 20 74 68 69 73 20 41 55 54 4f 29 0a eave this AUTO).
3940: 09 09 09 09 09 28 69 66 20 28 65 71 75 61 6c 3f .....(if (equal?
3950: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
3960: 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 atus testinfo) "
3970: 41 55 54 4f 22 29 20 22 41 55 54 4f 22 20 22 50 AUTO") "AUTO" "P
3980: 41 53 53 22 29 29 0a 09 09 09 09 20 20 20 20 20 ASS")).....
3990: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
39a0: 74 61 74 75 73 20 31 29 20 22 46 41 49 4c 22 29 tatus 1) "FAIL")
39b0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 ..... ((eq
39c0: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
39d0: 32 29 0a 09 09 09 09 09 3b 3b 20 69 66 20 74 68 2)......;; if th
39e0: 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 e current status
39f0: 20 69 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 is AUTO the def
3a00: 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c er to the calcul
3a10: 61 74 65 64 20 76 61 6c 75 65 20 62 75 74 20 71 ated value but q
3a20: 75 61 6c 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b ualify (i.e. mak
3a30: 65 20 74 68 69 73 20 41 55 54 4f 2d 57 41 52 4e e this AUTO-WARN
3a40: 29 0a 09 09 09 09 09 28 69 66 20 28 65 71 75 61 )......(if (equa
3a50: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3a60: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 status testinfo)
3a70: 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 "AUTO") "AUTO-W
3a80: 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 09 ARN" "WARN"))...
3a90: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 .. (else "
3aa0: 46 41 49 4c 22 29 29 0a 09 09 09 09 20 20 20 20 FAIL")).....
3ab0: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
3ac0: 22 2d 6d 22 29 20 23 66 29 29 29 0a 09 20 20 20 "-m") #f)))..
3ad0: 20 20 20 3b 3b 20 66 6f 72 20 61 75 74 6f 6d 61 ;; for automa
3ae0: 74 65 64 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 ted creation of
3af0: 74 68 65 20 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 the rollup html
3b00: 66 69 6c 65 20 74 68 69 73 20 69 73 20 61 20 67 file this is a g
3b10: 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e 0a 09 20 20 ood place.....
3b20: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
3b30: 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 ual? item-path "
3b40: 22 29 29 0a 09 09 20 20 28 6f 70 65 6e 2d 72 75 "))... (open-ru
3b50: 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 73 75 n-close tests:su
3b60: 6d 6d 61 72 69 7a 65 2d 69 74 65 6d 73 20 23 66 mmarize-items #f
3b70: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3b80: 65 20 23 66 29 29 20 3b 3b 20 64 6f 6e 27 74 20 e #f)) ;; don't
3b90: 66 6f 72 63 65 20 2d 20 6a 75 73 74 20 75 70 64 force - just upd
3ba0: 61 74 65 20 69 66 20 6e 6f 0a 09 20 20 20 20 20 ate if no..
3bb0: 20 29 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 75 ).. (mutex-u
3bc0: 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 3b nlock! m).. ;
3bd0: 3b 20 28 65 78 65 63 2d 72 65 73 75 6c 74 73 20 ; (exec-results
3be0: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 (cmd-run->list f
3bf0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 20 3b ullrunscript)) ;
3c00: 3b 20 20 28 6c 69 73 74 20 22 3e 22 20 28 63 6f ; (list ">" (co
3c10: 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 2d 72 nc test-name "-r
3c20: 75 6e 2e 6c 6f 67 22 29 29 29 29 0a 09 20 20 20 un.log"))))..
3c30: 20 3b 3b 20 28 73 75 63 63 65 73 73 20 20 20 20 ;; (success
3c40: 20 20 65 78 65 63 2d 72 65 73 75 6c 74 73 29 29 exec-results))
3c50: 20 3b 3b 20 28 65 71 3f 20 28 63 61 64 72 20 65 ;; (eq? (cadr e
3c60: 78 65 63 2d 72 65 73 75 6c 74 73 29 20 30 29 29 xec-results) 0))
3c70: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
3c80: 69 6e 74 20 32 20 22 4f 75 74 70 75 74 20 66 72 int 2 "Output fr
3c90: 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c om running " ful
3ca0: 6c 72 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 lrunscript ", pi
3cb0: 64 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 d " (vector-ref
3cc0: 65 78 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 exit-info 0) " i
3cd0: 6e 20 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 n work area " ..
3ce0: 09 09 20 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c .. work-area ":\
3cf0: 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 n====\n exit cod
3d00: 65 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 e " (vector-ref
3d10: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 22 5c 6e exit-info 2) "\n
3d20: 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 " "====\n")..
3d30: 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ;; (sqlite3:fin
3d40: 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 alize! db)..
3d50: 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ;; (sqlite3:fina
3d60: 6c 69 7a 65 21 20 74 64 62 29 0a 09 20 20 20 20 lize! tdb)..
3d70: 28 69 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 (if (not (vector
3d80: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 -ref exit-info 1
3d90: 29 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 ))...(exit 4))))
3da0: 29 29 29 0a 0a 3b 3b 20 73 65 74 20 75 70 20 74 )))..;; set up t
3db0: 68 65 20 76 65 72 79 20 62 61 73 69 63 73 20 6e he very basics n
3dc0: 65 65 64 65 64 20 66 6f 72 20 64 6f 69 6e 67 20 eeded for doing
3dd0: 61 6e 79 74 68 69 6e 67 20 68 65 72 65 2e 0a 28 anything here..(
3de0: 64 65 66 69 6e 65 20 28 73 65 74 75 70 2d 66 6f define (setup-fo
3df0: 72 2d 72 75 6e 29 0a 20 20 3b 3b 20 77 6f 75 6c r-run). ;; woul
3e00: 64 20 73 65 74 20 76 61 6c 75 65 73 20 66 6f 72 d set values for
3e10: 20 4b 45 59 53 20 69 6e 20 74 68 65 20 65 6e 76 KEYS in the env
3e20: 69 72 6f 6e 6d 65 6e 74 20 68 65 72 65 20 66 6f ironment here fo
3e30: 72 20 62 65 74 74 65 72 20 73 75 70 70 6f 72 74 r better support
3e40: 20 6f 66 20 65 6e 76 2d 6f 76 65 72 72 69 64 65 of env-override
3e50: 20 62 75 74 20 0a 20 20 3b 3b 20 68 61 76 65 20 but . ;; have
3e60: 63 68 69 63 6b 65 6e 2f 65 67 67 20 73 63 65 6e chicken/egg scen
3e70: 61 72 69 6f 2e 20 6e 65 65 64 20 74 6f 20 72 65 ario. need to re
3e80: 61 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 ad megatest.conf
3e90: 69 67 20 74 68 65 6e 20 72 65 61 64 20 69 74 20 ig then read it
3ea0: 61 67 61 69 6e 2e 20 47 6f 69 6e 67 20 74 6f 20 again. Going to
3eb0: 0a 20 20 3b 3b 20 70 61 73 73 20 6f 6e 20 74 68 . ;; pass on th
3ec0: 61 74 20 69 64 65 61 20 66 6f 72 20 6e 6f 77 0a at idea for now.
3ed0: 20 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 ;; special cas
3ee0: 65 0a 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 e. (set! *confi
3ef0: 67 69 6e 66 6f 2a 20 28 66 69 6e 64 2d 61 6e 64 ginfo* (find-and
3f00: 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 0a 09 09 -read-config ...
3f10: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
3f20: 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 get-arg "-config
3f30: 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 ")(args:get-arg
3f40: 22 2d 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 "-config") "mega
3f50: 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 09 test.config")...
3f60: 20 20 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 environ-pa
3f70: 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 tt: "env-overrid
3f80: 65 22 0a 09 09 20 20 20 20 20 20 67 69 76 65 6e e"... given
3f90: 2d 74 6f 70 70 61 74 68 3a 20 28 67 65 74 2d 65 -toppath: (get-e
3fa0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
3fb0: 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ble "MT_RUN_AREA
3fc0: 5f 48 4f 4d 45 22 29 29 29 0a 20 20 28 73 65 74 _HOME"))). (set
3fd0: 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 28 ! *configdat* (
3fe0: 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 if (car *configi
3ff0: 6e 66 6f 2a 29 28 63 61 72 20 2a 63 6f 6e 66 69 nfo*)(car *confi
4000: 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 ginfo*) #f)). (
4010: 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 set! *toppath*
4020: 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 (if (car *conf
4030: 69 67 69 6e 66 6f 2a 29 28 63 61 64 72 20 2a 63 iginfo*)(cadr *c
4040: 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 onfiginfo*) #f))
4050: 0a 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a . (if *toppath*
4060: 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 . (setenv "
4070: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
4080: 22 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b 20 " *toppath*) ;;
4090: 74 6f 20 62 65 20 64 65 70 72 65 63 61 74 65 64 to be deprecated
40a0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
40b0: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 66 61 int 0 "ERROR: fa
40c0: 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 68 65 iled to find the
40d0: 20 74 6f 70 20 70 61 74 68 20 74 6f 20 79 6f 75 top path to you
40e0: 72 20 72 75 6e 20 73 65 74 75 70 2e 22 29 29 0a r run setup.")).
40f0: 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 0a 28 64 *toppath*)..(d
4100: 65 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d efine (get-best-
4110: 64 69 73 6b 20 63 6f 6e 66 64 61 74 29 0a 20 20 disk confdat).
4120: 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 20 20 (let* ((disks
4130: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
4140: 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 /default confdat
4150: 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 20 "disks" #f))..
4160: 28 62 65 73 74 20 20 20 20 20 23 66 29 0a 09 20 (best #f)..
4170: 28 62 65 73 74 73 69 7a 65 20 30 29 29 0a 20 20 (bestsize 0)).
4180: 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 28 66 (if disks ..(f
4190: 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 or-each .. (lamb
41a0: 64 61 20 28 64 69 73 6b 2d 6e 75 6d 29 0a 09 20 da (disk-num)..
41b0: 20 20 28 6c 65 74 2a 20 28 28 64 69 72 70 61 74 (let* ((dirpat
41c0: 68 20 20 20 20 28 63 61 64 72 20 28 61 73 73 6f h (cadr (asso
41d0: 63 20 64 69 73 6b 2d 6e 75 6d 20 64 69 73 6b 73 c disk-num disks
41e0: 29 29 29 0a 09 09 20 20 28 66 72 65 65 73 70 63 )))... (freespc
41f0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 64 69 (if (and (di
4200: 72 65 63 74 6f 72 79 3f 20 64 69 72 70 61 74 68 rectory? dirpath
4210: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 66 69 )..... (fi
4220: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
4230: 20 64 69 72 70 61 74 68 29 29 0a 09 09 09 09 20 dirpath)).....
4240: 20 28 67 65 74 2d 64 66 20 64 69 72 70 61 74 68 (get-df dirpath
4250: 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 )..... (begin..
4260: 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
4270: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
4280: 70 61 74 68 20 22 20 64 69 72 70 61 74 68 20 22 path " dirpath "
4290: 20 69 6e 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 in [disks] sect
42a0: 69 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 20 6f 72 ion not valid or
42b0: 20 77 72 69 74 61 62 6c 65 22 29 0a 09 09 09 09 writable").....
42c0: 20 20 20 20 30 29 29 29 29 0a 09 20 20 20 20 20 0))))..
42d0: 28 69 66 20 28 3e 20 66 72 65 65 73 70 63 20 62 (if (> freespc b
42e0: 65 73 74 73 69 7a 65 29 0a 09 09 20 28 62 65 67 estsize)... (beg
42f0: 69 6e 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 in... (set! be
4300: 73 74 20 20 20 20 20 64 69 72 70 61 74 68 29 0a st dirpath).
4310: 09 09 20 20 20 28 73 65 74 21 20 62 65 73 74 73 .. (set! bests
4320: 69 7a 65 20 66 72 65 65 73 70 63 29 29 29 29 29 ize freespc)))))
4330: 0a 09 20 28 6d 61 70 20 63 61 72 20 64 69 73 6b .. (map car disk
4340: 73 29 29 29 0a 20 20 20 20 28 69 66 20 62 65 73 s))). (if bes
4350: 74 0a 09 62 65 73 74 0a 09 28 62 65 67 69 6e 0a t..best..(begin.
4360: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
4370: 30 20 22 45 52 52 4f 52 3a 20 4e 6f 20 76 61 6c 0 "ERROR: No val
4380: 69 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 69 id disks found i
4390: 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 n megatest.confi
43a0: 67 2e 20 50 6c 65 61 73 65 20 61 64 64 20 73 6f g. Please add so
43b0: 6d 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 6b me to your [disk
43c0: 73 5d 20 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 s] section")..
43d0: 28 65 78 69 74 20 31 29 29 29 29 29 0a 0a 3b 3b (exit 1)))))..;;
43e0: 20 44 65 73 69 72 65 64 20 64 69 72 65 63 74 6f Desired directo
43f0: 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b 3b ry structure:.;;
4400: 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d .;; <linkdir> -
4410: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
4420: 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 20 tname> -..;;
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 |.;;
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 20 v.;;
4480: 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 61 <rundir> - <ta
4490: 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 73 rget> - <tes
44a0: 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 6d tname> -|- <item
44b0: 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 path(s)>.;;.;;
44c0: 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 65 dir stored in te
44d0: 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c st is:.;; .;; <
44e0: 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 linkdir> - <targ
44f0: 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e et> - <testname>
4500: 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 [ - <itempath>
4510: 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 ].;; .;; All log
4520: 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f 75 file links shou
4530: 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 6c ld be stored rel
4540: 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f 70 ative to the top
4550: 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b 3b of link path.;;
4560: 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 2d .;; <target> -
4570: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
4580: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b 3b <itempath> ] .;;
4590: 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 65 .(define (create
45a0: 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 -work-area db ru
45b0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
45c0: 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d t-src-path disk-
45d0: 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 path testname it
45e0: 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 emdat). (let* (
45f0: 28 72 75 6e 2d 69 6e 66 6f 20 28 64 62 3a 67 65 (run-info (db:ge
4600: 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 t-run-info db ru
4610: 6e 2d 69 64 29 29 0a 09 20 28 69 74 65 6d 2d 70 n-id)).. (item-p
4620: 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e ath (item-list->
4630: 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 path itemdat))..
4640: 20 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a 67 (runname (db:g
4650: 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 et-value-by-head
4660: 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 er (db:get-row r
4670: 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 un-info)......
4680: 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 (db:get-header
4690: 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 run-info)......
46a0: 20 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 "runname"))..
46b0: 3b 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 ;; convert back
46c0: 74 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a to db: from rdb:
46d0: 20 2d 20 74 68 69 73 20 69 73 20 61 6c 77 61 79 - this is alway
46e0: 73 20 72 75 6e 20 61 74 20 73 65 72 76 65 72 20 s run at server
46f0: 65 6e 64 0a 09 20 28 6b 65 79 2d 76 61 6c 73 20 end.. (key-vals
4700: 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 (db:get-key-vals
4710: 20 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 db run-id)).. (
4720: 74 61 72 67 65 74 20 20 20 28 73 74 72 69 6e 67 target (string
4730: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
4740: 2d 76 61 6c 73 20 22 2f 22 29 29 0a 0a 09 20 28 -vals "/"))... (
4750: 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 not-iterated (e
4760: 71 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 qual? "" item-pa
4770: 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 th))... ;; all t
4780: 65 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 ests are found a
4790: 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d t <rundir>/test-
47a0: 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 base or <linkdir
47b0: 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 >/test-base.. (t
47c0: 65 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e esttop-base (con
47d0: 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e c target "/" run
47e0: 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d name "/" testnam
47f0: 65 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 e)).. (test-base
4800: 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f (conc testto
4810: 70 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 p-base (if not-i
4820: 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 terated "" "/")
4830: 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b item-path))... ;
4840: 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 ; nb// if itempa
4850: 74 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 th is not "" the
4860: 6e 20 69 74 20 69 73 20 70 72 65 66 69 78 65 64 n it is prefixed
4870: 20 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 with "/".. (top
4880: 74 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 test-path (conc
4890: 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 disk-path "/" te
48a0: 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 sttop-base)).. (
48b0: 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f test-path (co
48c0: 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 nc disk-path "/"
48d0: 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 test-base))...
48e0: 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 65 ;; ensure this e
48f0: 78 69 73 74 73 20 66 69 72 73 74 20 61 73 20 6c xists first as l
4900: 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 73 inks to subtests
4910: 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 64 must be created
4920: 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 there.. (linktr
4930: 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 63 ee (let ((rd (c
4940: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
4950: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
4960: 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 "linktree")))..
4970: 09 20 20 20 20 20 28 69 66 20 72 64 20 72 64 20 . (if rd rd
4980: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
4990: 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 28 "/runs"))))... (
49a0: 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 6c lnkbase (conc l
49b0: 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 inktree "/" targ
49c0: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 et "/" runname))
49d0: 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 6f .. (lnkpath (co
49e0: 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 74 nc lnkbase "/" t
49f0: 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b estname)).. (lnk
4a00: 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b 70 pathf (conc lnkp
4a10: 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 ath (if not-iter
4a20: 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 ated "" "/") ite
4a30: 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 3b m-path))).. ;
4a40: 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 75 6e ; Update the run
4a50: 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 20 dir path in the
4a60: 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 test record for
4a70: 61 6c 6c 0a 20 20 20 20 28 64 62 3a 74 65 73 74 all. (db:test
4a80: 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 64 62 20 -set-rundir! db
4a90: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
4aa0: 69 74 65 6d 2d 70 61 74 68 20 6c 6e 6b 70 61 74 item-path lnkpat
4ab0: 68 66 29 0a 0a 20 20 20 20 28 64 65 62 75 67 3a hf).. (debug:
4ac0: 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 5c 6e print 2 "INFO:\n
4ad0: 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d 22 lnkbase="
4ae0: 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 20 lnkbase "\n
4af0: 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b lnkpath=" lnk
4b00: 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 73 path "\n toptes
4b10: 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 74 t-path=" toptest
4b20: 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 65 -path "\n te
4b30: 73 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d 70 st-path=" test-p
4b40: 61 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e 6f ath). (if (no
4b50: 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 t (file-exists?
4b60: 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 67 linktree))..(beg
4b70: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
4b80: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 6c nt 0 "WARNING: l
4b90: 69 6e 6b 74 72 65 65 20 64 69 64 20 6e 6f 74 20 inktree did not
4ba0: 65 78 69 73 74 21 20 43 72 65 61 74 69 6e 67 20 exist! Creating
4bb0: 69 74 20 6e 6f 77 20 61 74 20 22 20 6c 69 6e 6b it now at " link
4bc0: 74 72 65 65 29 0a 09 20 20 28 63 72 65 61 74 65 tree).. (create
4bd0: 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b 74 -directory linkt
4be0: 72 65 65 20 23 74 29 29 29 20 3b 3b 20 28 73 79 ree #t))) ;; (sy
4bf0: 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 69 stem (conc "mkdi
4c00: 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 65 65 29 r -p " linktree)
4c10: 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 65 61 74 ))). ;; creat
4c20: 65 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 e the directory
4c30: 66 6f 72 20 74 68 65 20 74 65 73 74 73 20 64 69 for the tests di
4c40: 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 20 69 73 r links, this is
4c50: 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 74 74 65 needed no matte
4c60: 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 20 28 69 r what.... (i
4c70: 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 f (not (director
4c80: 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 y-exists? lnkbas
4c90: 65 29 29 0a 09 28 63 72 65 61 74 65 2d 64 69 72 e))..(create-dir
4ca0: 65 63 74 6f 72 79 20 6c 6e 6b 62 61 73 65 20 23 ectory lnkbase #
4cb0: 74 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 t)). . ;;
4cc0: 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 74 65 update the topte
4cd0: 73 74 20 72 65 63 6f 72 64 20 77 69 74 68 20 69 st record with i
4ce0: 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 75 6e 64 ts location rund
4cf0: 69 72 2c 20 63 61 63 68 65 20 74 68 65 20 70 61 ir, cache the pa
4d00: 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 73 20 77 th. ;; This w
4d10: 61 73 73 20 68 69 67 68 6c 79 20 69 6e 65 66 66 ass highly ineff
4d20: 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 62 20 77 icient, one db w
4d30: 72 69 74 65 20 66 6f 72 20 65 76 65 72 79 20 73 rite for every s
4d40: 75 62 74 65 73 74 2c 20 70 6f 74 65 6e 74 69 61 ubtest, potentia
4d50: 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 6f 75 73 lly. ;; thous
4d60: 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 65 73 73 ands of unnecess
4d70: 61 72 79 20 75 70 64 61 74 65 73 2c 20 63 61 63 ary updates, cac
4d80: 68 65 20 74 68 65 20 66 61 63 74 20 69 74 20 77 he the fact it w
4d90: 61 73 20 73 65 74 20 61 6e 64 20 64 6f 6e 27 74 as set and don't
4da0: 20 73 65 74 20 69 74 20 0a 20 20 20 20 3b 3b 20 set it . ;;
4db0: 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 again. .. ;;
4dc0: 4e 42 20 2d 20 54 68 69 73 20 69 73 20 6e 6f 74 NB - This is not
4dd0: 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 2d working right -
4de0: 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 20 some top tests
4df0: 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 are not getting
4e00: 74 68 65 20 70 61 74 68 20 73 65 74 21 21 21 0a the path set!!!.
4e10: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 . (if (not (h
4e20: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
4e30: 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 74 2d 70 fault *toptest-p
4e40: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 23 aths* testname #
4e50: 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 f))..(let* ((tes
4e60: 74 69 6e 66 6f 20 20 20 20 20 20 20 28 64 62 3a tinfo (db:
4e70: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
4e80: 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 -id db test-id))
4e90: 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 ;; run-id test
4ea0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
4eb0: 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 2d 74 .. (curr-t
4ec0: 65 73 74 2d 70 61 74 68 20 28 69 66 20 74 65 73 est-path (if tes
4ed0: 74 69 6e 66 6f 20 28 64 62 3a 74 65 73 74 2d 67 tinfo (db:test-g
4ee0: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e et-rundir testin
4ef0: 66 6f 29 20 23 66 29 29 29 0a 09 20 20 28 68 61 fo) #f))).. (ha
4f00: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
4f10: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
4f20: 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 74 stname curr-test
4f30: 2d 70 61 74 68 29 0a 09 20 20 28 64 62 3a 74 65 -path).. (db:te
4f40: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 64 st-set-rundir! d
4f50: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d b run-id testnam
4f60: 65 20 22 22 20 6c 6e 6b 70 61 74 68 29 20 3b 3b e "" lnkpath) ;;
4f70: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 0a 09 toptest-path)..
4f80: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 63 (if (or (not c
4f90: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 urr-test-path)..
4fa0: 09 20 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f . (not (directo
4fb0: 72 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 74 65 ry-exists? topte
4fc0: 73 74 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 st-path)))..
4fd0: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
4fe0: 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a g:print 2 "INFO:
4ff0: 20 43 72 65 61 74 69 6e 67 20 22 20 74 6f 70 74 Creating " topt
5000: 65 73 74 2d 70 61 74 68 20 22 20 61 6e 64 20 6c est-path " and l
5010: 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 29 0a 09 ink " lnkpath)..
5020: 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f .(create-directo
5030: 72 79 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 ry toptest-path
5040: 23 74 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c #t)...(hash-tabl
5050: 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d e-set! *toptest-
5060: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
5070: 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 29 toptest-path))))
5080: 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f 77 20 63 72 ).. ;; Now cr
5090: 65 61 74 65 20 74 68 65 20 6c 69 6e 6b 20 66 72 eate the link fr
50a0: 6f 6d 20 74 68 65 20 74 65 73 74 20 70 61 74 68 om the test path
50b0: 20 74 6f 20 74 68 65 20 6c 69 6e 6b 20 74 72 65 to the link tre
50c0: 65 2c 20 68 6f 77 65 76 65 72 0a 20 20 20 20 3b e, however. ;
50d0: 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 69 73 ; if the test is
50e0: 20 69 74 65 72 61 74 65 64 20 69 74 20 69 73 20 iterated it is
50f0: 6e 65 63 65 73 73 61 72 79 20 74 6f 20 63 72 65 necessary to cre
5100: 61 74 65 20 74 68 65 20 70 61 72 65 6e 74 20 70 ate the parent p
5110: 61 74 68 0a 20 20 20 20 3b 3b 20 74 6f 20 74 68 ath. ;; to th
5120: 65 20 69 74 65 72 61 74 69 6f 6e 2e 20 75 73 65 e iteration. use
5130: 20 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 pathname-direct
5140: 6f 72 79 20 74 6f 20 74 72 69 6d 20 74 68 65 20 ory to trim the
5150: 70 61 74 68 20 62 79 20 6f 6e 65 0a 20 20 20 20 path by one.
5160: 3b 3b 20 6c 65 76 65 6c 0a 20 20 20 20 28 69 66 ;; level. (if
5170: 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 (not not-iterat
5180: 65 64 29 20 3b 3b 20 69 2e 65 2e 20 69 74 65 72 ed) ;; i.e. iter
5190: 61 74 65 64 0a 09 28 6c 65 74 20 28 28 69 74 65 ated..(let ((ite
51a0: 72 61 74 65 64 2d 70 61 72 65 6e 74 20 20 28 70 rated-parent (p
51b0: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
51c0: 79 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 y (conc lnkpath
51d0: 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 "/" item-path)))
51e0: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
51f0: 74 20 32 20 22 49 4e 46 4f 3a 20 43 72 65 61 74 t 2 "INFO: Creat
5200: 69 6e 67 20 69 74 65 72 61 74 65 64 20 70 61 72 ing iterated par
5210: 65 6e 74 20 22 20 69 74 65 72 61 74 65 64 2d 70 ent " iterated-p
5220: 61 72 65 6e 74 29 0a 09 20 20 28 63 72 65 61 74 arent).. (creat
5230: 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 65 72 e-directory iter
5240: 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 29 29 ated-parent #t))
5250: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
5260: 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f or (file-exists?
5270: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 lnkpath)... (sy
5280: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b mbolic-link? lnk
5290: 70 61 74 68 29 29 29 0a 09 28 63 72 65 61 74 65 path)))..(create
52a0: 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 -symbolic-link t
52b0: 6f 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 optest-path lnkp
52c0: 61 74 68 29 29 0a 20 20 20 20 0a 20 20 20 20 3b ath)). . ;
52d0: 3b 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 ; The toptest pa
52e0: 74 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 th has been crea
52f0: 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f ted, the link to
5300: 20 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 the test in the
5310: 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 linktree has.
5320: 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 ;; been create
5330: 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 d. Now, if this
5340: 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 is an iterated t
5350: 65 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 est the real tes
5360: 74 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 t dir must be cr
5370: 65 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e eated. (if (n
5380: 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 ot not-iterated)
5390: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 ;; this is an i
53a0: 74 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 6c terated test..(l
53b0: 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 et ((lnktarget (
53c0: 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 conc lnkpath "/"
53d0: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 item-path)))..
53e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
53f0: 22 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 20 "Setting up sub
5400: 74 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 0a test run area").
5410: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
5420: 32 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 72 2 " - creating r
5430: 75 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 73 un area in " tes
5440: 74 2d 70 61 74 68 29 0a 09 20 20 28 63 72 65 61 t-path).. (crea
5450: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 te-directory tes
5460: 74 2d 70 61 74 68 20 23 74 29 20 3b 3b 20 28 73 t-path #t) ;; (s
5470: 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d 6b ystem (conc "mk
5480: 64 69 72 20 2d 70 20 22 20 74 65 73 74 2d 70 61 dir -p " test-pa
5490: 74 68 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 th)).. (debug:p
54a0: 72 69 6e 74 20 32 20 0a 09 09 20 20 20 20 20 20 rint 2 ...
54b0: 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c 69 " - creating li
54c0: 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 2d nk from: " test-
54d0: 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 20 path "\n"...
54e0: 20 20 20 22 20 20 20 20 20 20 20 20 20 20 20 20 "
54f0: 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e 6b to: " lnk
5500: 74 61 72 67 65 74 29 0a 09 20 20 3b 3b 20 28 63 target).. ;; (c
5510: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
5520: 6c 6e 6b 70 61 74 68 20 23 74 29 20 3b 3b 20 28 lnkpath #t) ;; (
5530: 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d system (conc "m
5540: 6b 64 69 72 20 2d 70 20 22 20 6c 6e 6b 70 61 74 kdir -p " lnkpat
5550: 68 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 h)).. (if (not
5560: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e (file-exists? ln
5570: 6b 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 20 ktarget))..
5580: 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 (create-symboli
5590: 63 2d 6c 69 6e 6b 20 74 65 73 74 2d 70 61 74 68 c-link test-path
55a0: 20 6c 6e 6b 74 61 72 67 65 74 29 29 29 29 0a 0a lnktarget))))..
55b0: 20 20 20 20 3b 3b 20 49 20 73 75 73 70 65 63 74 ;; I suspect
55c0: 20 74 68 69 73 20 73 65 63 74 69 6f 6e 20 77 61 this section wa
55d0: 73 20 64 65 6c 65 74 69 6e 67 20 74 65 73 74 20 s deleting test
55e0: 64 69 72 65 63 74 6f 72 69 65 73 20 75 6e 64 65 directories unde
55f0: 72 20 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 77 r some . ;; w
5600: 69 65 72 64 20 73 69 74 61 74 69 6f 6e 73 3f 20 ierd sitations?
5610: 54 68 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 6b This doesn't mak
5620: 65 20 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 62 e sense - reenab
5630: 6c 69 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 0a ling the rm -f .
5640: 20 20 20 20 3b 3b 20 49 20 68 6f 6e 65 73 74 6c ;; I honestl
5650: 79 20 64 6f 6e 27 74 20 72 65 6d 65 6d 62 65 72 y don't remember
5660: 20 2a 77 68 79 2a 20 74 68 69 73 20 63 68 75 6e *why* this chun
5670: 6b 20 77 61 73 20 6e 65 65 64 65 64 2e 2e 2e 0a k was needed....
5680: 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 74 65 ;; (let ((te
5690: 73 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e 6b stlink (conc lnk
56a0: 70 61 74 68 20 22 2f 22 20 74 65 73 74 6e 61 6d path "/" testnam
56b0: 65 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 69 e))). ;; (i
56c0: 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 f (and (file-exi
56d0: 73 74 73 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 sts? testlink).
56e0: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
56f0: 20 28 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 69 (or (regular-fi
5700: 6c 65 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 le? testlink).
5710: 20 20 3b 3b 20 20 20 20 20 09 20 20 20 28 73 79 ;; . (sy
5720: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 74 65 73 mbolic-link? tes
5730: 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 tlink))). ;;
5740: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 (system (c
5750: 6f 6e 63 20 22 72 6d 20 2d 66 20 22 20 74 65 73 onc "rm -f " tes
5760: 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 tlink))). ;;
5770: 20 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 (system (conc
5780: 20 22 6c 6e 20 2d 73 66 20 22 20 74 65 73 74 2d "ln -sf " test-
5790: 70 61 74 68 20 22 20 22 20 74 65 73 74 6c 69 6e path " " testlin
57a0: 6b 29 29 29 0a 20 20 20 20 28 69 66 20 28 64 69 k))). (if (di
57b0: 72 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 61 rectory? test-pa
57c0: 74 68 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 th)..(begin.. (
57d0: 6c 65 74 2a 20 28 28 63 6d 64 20 20 20 20 28 63 let* ((cmd (c
57e0: 6f 6e 63 20 22 72 73 79 6e 63 20 2d 61 76 22 20 onc "rsync -av"
57f0: 28 69 66 20 28 3e 20 2a 76 65 72 62 6f 73 69 74 (if (> *verbosit
5800: 79 2a 20 31 29 20 22 22 20 22 71 22 29 20 22 20 y* 1) "" "q") "
5810: 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 " test-src-path
5820: 22 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 "/ " test-path "
5830: 2f 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 20 /"))... (status
5840: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a 09 (system cmd)))..
5850: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
5860: 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 28 ? status 0))...(
5870: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 debug:print 2 "E
5880: 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 RROR: problem wi
5890: 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 th running \"" c
58a0: 6d 64 20 22 5c 22 22 29 29 29 0a 09 20 20 28 6c md "\""))).. (l
58b0: 69 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e 6b ist lnkpathf lnk
58c0: 70 61 74 68 20 29 29 0a 09 28 6c 69 73 74 20 23 path ))..(list #
58d0: 66 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 f #f))))..;; 1.
58e0: 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 6b look though disk
58f0: 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b 20 s list for disk
5900: 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 0a with most space.
5910: 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 6e ;; 2. create run
5920: 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 61 dir on disk, pa
5930: 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e 69 th name is meani
5940: 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 ngful.;; 3. crea
5950: 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 6e te link from run
5960: 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 74 dir to megatest
5970: 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 34 runs area .;; 4
5980: 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 74 . remotely run t
5990: 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 he test on alloc
59a0: 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 20 ated host.;;
59b0: 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 74 - could be ssh t
59c0: 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 74 o host from host
59d0: 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 20 s table (update
59e0: 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 6c regularly with l
59f0: 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 oad).;; - cou
5a00: 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a 3b ld be netbatch.;
5a10: 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 ; (launch-t
5a20: 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 61 est db (cadr sta
5a30: 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 29 tus) test-conf))
5a40: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
5a50: 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 -test db run-id
5a60: 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e runname test-con
5a70: 66 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 f keyvallst test
5a80: 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 -name test-path
5a90: 69 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 0a itemdat params).
5aa0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
5ab0: 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 ory *toppath*).
5ac0: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
5ad0: 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 s ;; consolidate
5ae0: 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 this code with
5af0: 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 the code in mega
5b00: 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 test.scm for "-e
5b10: 78 65 63 75 74 65 22 0a 20 20 20 28 6c 69 73 74 xecute". (list
5b20: 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 ;; (list "MT_TE
5b30: 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b ST_RUN_DIR" work
5b40: 2d 61 72 65 61 29 0a 09 20 28 6c 69 73 74 20 22 -area).. (list "
5b50: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
5b60: 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 20 28 " *toppath*).. (
5b70: 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e 41 list "MT_TEST_NA
5b80: 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 ME" test-name)..
5b90: 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 ;; (list "MT_IT
5ba0: 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 EM_INFO" (conc i
5bb0: 74 65 6d 64 61 74 29 29 20 0a 09 20 28 6c 69 73 temdat)) .. (lis
5bc0: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
5bd0: 20 72 75 6e 6e 61 6d 65 29 0a 09 20 3b 3b 20 28 runname).. ;; (
5be0: 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 list "MT_TARGET"
5bf0: 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 mt_target)..
5c00: 20 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 )). (let* ((us
5c10: 65 73 68 65 6c 6c 20 20 20 28 63 6f 6e 66 69 67 eshell (config
5c20: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
5c30: 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
5c40: 20 20 20 22 75 73 65 73 68 65 6c 6c 22 29 29 0a "useshell")).
5c50: 09 20 28 6c 61 75 6e 63 68 65 72 20 20 20 28 63 . (launcher (c
5c60: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
5c70: 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f nfigdat* "jobtoo
5c80: 6c 73 22 20 20 20 20 20 22 6c 61 75 6e 63 68 65 ls" "launche
5c90: 72 22 29 29 0a 09 20 28 72 75 6e 73 63 72 69 70 r")).. (runscrip
5ca0: 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 t (config-looku
5cb0: 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 73 p test-conf "s
5cc0: 65 74 75 70 22 20 20 20 20 20 20 20 20 22 72 75 etup" "ru
5cd0: 6e 73 63 72 69 70 74 22 29 29 0a 09 20 28 65 7a nscript")).. (ez
5ce0: 73 74 65 70 73 20 20 20 20 28 3e 20 28 6c 65 6e steps (> (len
5cf0: 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d gth (hash-table-
5d00: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
5d10: 2d 63 6f 6e 66 20 22 65 7a 73 74 65 70 73 22 20 -conf "ezsteps"
5d20: 27 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f 6e '())) 0)) ;; don
5d30: 27 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 20 't send all the
5d40: 73 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 20 steps, could be
5d50: 62 69 67 0a 09 20 28 64 69 73 6b 73 70 61 63 65 big.. (diskspace
5d60: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
5d70: 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 test-conf "re
5d80: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 64 69 73 quirements" "dis
5d90: 6b 73 70 61 63 65 22 29 29 0a 09 20 28 6d 65 6d kspace")).. (mem
5da0: 6f 72 79 20 20 20 20 20 28 63 6f 6e 66 69 67 2d ory (config-
5db0: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
5dc0: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
5dd0: 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 20 28 " "memory")).. (
5de0: 68 6f 73 74 73 20 20 20 20 20 20 28 63 6f 6e 66 hosts (conf
5df0: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
5e00: 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 gdat* "jobtools"
5e10: 20 20 20 20 20 22 77 6f 72 6b 68 6f 73 74 73 22 "workhosts"
5e20: 29 29 0a 09 20 28 72 65 6d 6f 74 65 2d 6d 65 67 )).. (remote-meg
5e30: 61 74 65 73 74 20 28 63 6f 6e 66 69 67 2d 6c 6f atest (config-lo
5e40: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
5e50: 20 22 73 65 74 75 70 22 20 22 65 78 65 63 75 74 "setup" "execut
5e60: 61 62 6c 65 22 29 29 0a 09 20 3b 3b 20 46 49 58 able")).. ;; FIX
5e70: 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 ME SOMEDAY: not
5e80: 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 69 73 good how this is
5e90: 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 69 73 so obtuse, this
5ea0: 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 20 3b hack is to .. ;
5eb0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
5ec0: 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 66 allow running f
5ed0: 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e 20 45 rom dashboard. E
5ee0: 78 74 72 61 63 74 20 74 68 65 20 70 61 74 68 0a xtract the path.
5ef0: 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 . ;;
5f00: 20 20 20 20 66 72 6f 6d 20 74 68 65 20 63 61 6c from the cal
5f10: 6c 65 64 20 6d 65 67 61 74 65 73 74 20 61 6e 64 led megatest and
5f20: 20 63 6f 6e 76 65 72 74 20 64 61 73 68 62 6f 61 convert dashboa
5f30: 72 64 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 rd.. ;;
5f40: 20 20 20 20 09 20 20 6f 72 20 64 62 6f 61 72 64 . or dboard
5f50: 20 74 6f 20 6d 65 67 61 74 65 73 74 0a 09 20 28 to megatest.. (
5f60: 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 local-megatest
5f70: 28 6c 65 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 (let* ((lm (car
5f80: 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 20 28 (argv)))..... (
5f90: 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 dir (pathname-di
5fa0: 72 65 63 74 6f 72 79 20 6c 6d 29 29 0a 09 09 09 rectory lm))....
5fb0: 09 20 28 65 78 65 20 28 70 61 74 68 6e 61 6d 65 . (exe (pathname
5fc0: 2d 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 -strip-directory
5fd0: 20 6c 6d 29 29 29 0a 09 09 09 20 20 20 20 28 63 lm))).... (c
5fe0: 6f 6e 63 20 28 69 66 20 64 69 72 20 28 63 6f 6e onc (if dir (con
5ff0: 63 20 64 69 72 20 22 2f 22 29 20 22 22 29 0a 09 c dir "/") "")..
6000: 09 09 09 20 20 28 63 61 73 65 20 28 73 74 72 69 ... (case (stri
6010: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 65 78 65 29 0a ng->symbol exe).
6020: 09 09 09 09 20 20 20 20 28 28 64 62 6f 61 72 64 .... ((dboard
6030: 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 ) "megatest")...
6040: 09 09 20 20 20 20 28 28 64 61 73 68 62 6f 61 72 .. ((dashboar
6050: 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 d) "megatest")..
6060: 09 09 09 20 20 20 20 28 65 6c 73 65 20 65 78 65 ... (else exe
6070: 29 29 29 29 29 0a 09 20 28 74 65 73 74 2d 73 69 ))))).. (test-si
6080: 67 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e g (conc test-n
6090: 61 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c 69 ame ":" (item-li
60a0: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
60b0: 29 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 68 ))) ;; test-path
60c0: 20 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 74 is the full pat
60d0: 68 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 20 h including the
60e0: 69 74 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f 72 item-path.. (wor
60f0: 6b 2d 61 72 65 61 20 20 23 66 29 0a 09 20 28 74 k-area #f).. (t
6100: 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 optest-work-area
6110: 20 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 #f) ;; for iter
6120: 61 74 65 64 20 74 65 73 74 73 20 74 68 65 20 74 ated tests the t
6130: 6f 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 op test contains
6140: 20 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 66 data relevant f
6150: 6f 72 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 61 or all.. (diskpa
6160: 74 68 20 20 20 23 66 29 0a 09 20 28 63 6d 64 70 th #f).. (cmdp
6170: 61 72 6d 73 20 20 20 23 66 29 0a 09 20 28 66 75 arms #f).. (fu
6180: 6c 6c 63 6d 64 20 20 20 20 23 66 29 20 3b 3b 20 llcmd #f) ;;
6190: 28 64 65 66 69 6e 65 20 61 20 28 77 69 74 68 2d (define a (with-
61a0: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
61b0: 20 28 6c 61 6d 62 64 61 20 28 29 28 77 72 69 74 (lambda ()(writ
61c0: 65 20 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 69 e x)))).. (mt-bi
61d0: 6e 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 20 ndir-path #f)..
61e0: 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d (item-path (item
61f0: 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
6200: 64 61 74 29 29 0a 09 20 28 74 65 73 74 2d 69 64 dat)).. (test-id
6210: 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c (open-run-cl
6220: 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 73 74 2d ose db:get-test-
6230: 69 64 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 id db run-id tes
6240: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
6250: 29 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 20 )).. (testinfo
6260: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
6270: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 db:get-test-inf
6280: 6f 2d 62 79 2d 69 64 20 64 62 20 74 65 73 74 2d o-by-id db test-
6290: 69 64 29 29 0a 09 20 28 6d 74 5f 74 61 72 67 65 id)).. (mt_targe
62a0: 74 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 t (string-inter
62b0: 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 64 72 sperse (map cadr
62c0: 20 6b 65 79 76 61 6c 6c 73 74 29 20 22 2f 22 29 keyvallst) "/")
62d0: 29 0a 09 20 28 64 65 62 75 67 2d 70 61 72 61 6d ).. (debug-param
62e0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
62f0: 72 67 20 22 2d 64 65 62 75 67 22 29 28 6c 69 73 rg "-debug")(lis
6300: 74 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 t "-debug" (args
6310: 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 :get-arg "-debug
6320: 22 29 29 20 27 28 29 29 29 29 0a 20 20 20 20 28 ")) '()))). (
6330: 69 66 20 68 6f 73 74 73 20 28 73 65 74 21 20 68 if hosts (set! h
6340: 6f 73 74 73 20 28 73 74 72 69 6e 67 2d 73 70 6c osts (string-spl
6350: 69 74 20 68 6f 73 74 73 29 29 29 0a 20 20 20 20 it hosts))).
6360: 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 67 61 74 ;; set the megat
6370: 65 73 74 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 est to be called
6380: 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 65 20 68 on the remote h
6390: 6f 73 74 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ost. (if (not
63a0: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
63b0: 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d 6d 65 )(set! remote-me
63c0: 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 67 gatest local-meg
63d0: 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 67 61 atest)) ;; "mega
63e0: 74 65 73 74 22 29 29 0a 20 20 20 20 28 73 65 74 test")). (set
63f0: 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 ! mt-bindir-path
6400: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
6410: 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 67 61 tory remote-mega
6420: 74 65 73 74 29 29 0a 20 20 20 20 28 69 66 20 6c test)). (if l
6430: 61 75 6e 63 68 65 72 20 28 73 65 74 21 20 6c 61 auncher (set! la
6440: 75 6e 63 68 65 72 20 28 73 74 72 69 6e 67 2d 73 uncher (string-s
6450: 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 29 29 29 plit launcher)))
6460: 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 70 20 74 . ;; set up t
6470: 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 72 65 61 he run work area
6480: 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 20 for this test.
6490: 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 61 74 (set! diskpat
64a0: 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b h (get-best-disk
64b0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 0a 20 *configdat*)).
64c0: 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 68 0a (if diskpath.
64d0: 09 28 6c 65 74 20 28 28 64 61 74 20 20 28 6f 70 .(let ((dat (op
64e0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 63 72 65 en-run-close cre
64f0: 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 ate-work-area db
6500: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
6510: 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b 70 61 test-path diskpa
6520: 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 th test-name ite
6530: 6d 64 61 74 29 29 29 0a 09 20 20 28 73 65 74 21 mdat))).. (set!
6540: 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 72 20 work-area (car
6550: 64 61 74 29 29 0a 09 20 20 28 73 65 74 21 20 74 dat)).. (set! t
6560: 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 optest-work-area
6570: 20 28 63 61 64 72 20 64 61 74 29 29 0a 09 20 20 (cadr dat))..
6580: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
6590: 49 4e 46 4f 3a 20 55 73 69 6e 67 20 77 6f 72 6b INFO: Using work
65a0: 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 65 area " work-are
65b0: 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 a))..(begin.. (
65c0: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
65d0: 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 20 22 conc test-path "
65e0: 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 28 /tmp_run")).. (
65f0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
6600: 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 work-area #t)..
6610: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6620: 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 "WARNING: No di
6630: 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 73 70 65 sk work area spe
6640: 63 69 66 69 65 64 20 2d 20 72 75 6e 6e 69 6e 67 cified - running
6650: 20 69 6e 20 74 68 65 20 74 65 73 74 20 64 69 72 in the test dir
6660: 65 63 74 6f 72 79 20 75 6e 64 65 72 20 74 6d 70 ectory under tmp
6670: 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 28 73 65 _run"))). (se
6680: 74 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 73 t! cmdparms (bas
6690: 65 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 e64:base64-encod
66a0: 65 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 e (with-output-t
66b0: 6f 2d 73 74 72 69 6e 67 0a 09 09 09 09 09 20 20 o-string......
66c0: 20 28 6c 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 (lambda () ;; (
66d0: 6c 69 73 74 20 27 68 6f 73 74 73 20 20 20 20 20 list 'hosts
66e0: 68 6f 73 74 73 29 0a 09 09 09 09 09 20 20 20 20 hosts)......
66f0: 20 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 6c (write (list (l
6700: 69 73 74 20 27 74 65 73 74 70 61 74 68 20 20 74 ist 'testpath t
6710: 65 73 74 2d 70 61 74 68 29 0a 09 09 09 09 09 09 est-path).......
6720: 09 20 20 28 6c 69 73 74 20 27 74 6f 70 70 61 74 . (list 'toppat
6730: 68 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 h *toppath*)..
6740: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 77 ...... (list 'w
6750: 6f 72 6b 2d 61 72 65 61 20 77 6f 72 6b 2d 61 72 ork-area work-ar
6760: 65 61 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 ea)........ (li
6770: 73 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 74 65 st 'test-name te
6780: 73 74 2d 6e 61 6d 65 29 20 0a 09 09 09 09 09 09 st-name) .......
6790: 09 20 20 28 6c 69 73 74 20 27 72 75 6e 73 63 72 . (list 'runscr
67a0: 69 70 74 20 72 75 6e 73 63 72 69 70 74 29 20 0a ipt runscript) .
67b0: 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 ....... (list '
67c0: 72 75 6e 2d 69 64 20 20 20 20 72 75 6e 2d 69 64 run-id run-id
67d0: 20 20 20 29 0a 09 09 09 09 09 09 09 20 20 28 6c )........ (l
67e0: 69 73 74 20 27 74 65 73 74 2d 69 64 20 20 20 74 ist 'test-id t
67f0: 65 73 74 2d 69 64 20 20 29 0a 09 09 09 09 09 09 est-id ).......
6800: 09 20 20 28 6c 69 73 74 20 27 69 74 65 6d 64 61 . (list 'itemda
6810: 74 20 20 20 69 74 65 6d 64 61 74 20 20 29 0a 09 t itemdat )..
6820: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 6d ...... (list 'm
6830: 65 67 61 74 65 73 74 20 20 72 65 6d 6f 74 65 2d egatest remote-
6840: 6d 65 67 61 74 65 73 74 29 0a 09 09 09 09 09 09 megatest).......
6850: 09 20 20 28 6c 69 73 74 20 27 65 7a 73 74 65 70 . (list 'ezstep
6860: 73 20 20 20 65 7a 73 74 65 70 73 29 20 0a 09 09 s ezsteps) ...
6870: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 74 61 ..... (list 'ta
6880: 72 67 65 74 20 20 20 20 6d 74 5f 74 61 72 67 65 rget mt_targe
6890: 74 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 t)........ (lis
68a0: 74 20 27 65 6e 76 2d 6f 76 72 64 20 20 28 68 61 t 'env-ovrd (ha
68b0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
68c0: 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a ault *configdat*
68d0: 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 "env-override"
68e0: 27 28 29 29 29 20 0a 09 09 09 09 09 09 09 20 20 '())) ........
68f0: 28 6c 69 73 74 20 27 73 65 74 2d 76 61 72 73 20 (list 'set-vars
6900: 20 28 69 66 20 70 61 72 61 6d 73 20 28 68 61 73 (if params (has
6910: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
6920: 75 6c 74 20 70 61 72 61 6d 73 20 22 2d 73 65 74 ult params "-set
6930: 76 61 72 73 22 20 23 66 29 29 29 0a 09 09 09 09 vars" #f))).....
6940: 09 09 09 20 20 28 6c 69 73 74 20 27 72 75 6e 6e ... (list 'runn
6950: 61 6d 65 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 ame runname)..
6960: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 6d ...... (list 'm
6970: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 6d 74 t-bindir-path mt
6980: 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 29 -bindir-path))))
6990: 29 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 69 ))) ;; (string-i
69a0: 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 76 61 ntersperse keyva
69b0: 6c 6c 73 74 20 22 20 22 29 29 29 29 0a 20 20 20 llst " ")))).
69c0: 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 74 20 73 74 ;; clean out st
69d0: 65 70 20 72 65 63 6f 72 64 73 20 66 72 6f 6d 20 ep records from
69e0: 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 66 20 previous run if
69f0: 74 68 65 79 20 65 78 69 73 74 0a 20 20 20 20 28 they exist. (
6a00: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 49 debug:print 4 "I
6a10: 4e 46 4f 3a 20 46 49 58 4d 45 45 45 45 45 21 21 NFO: FIXMEEEEE!!
6a20: 21 21 20 54 68 69 73 20 63 61 6e 20 62 65 20 72 !! This can be r
6a30: 65 6d 6f 76 65 64 20 73 6f 6d 65 20 64 61 79 2c emoved some day,
6a40: 20 70 65 72 68 61 70 73 20 6d 6f 76 65 20 61 6c perhaps move al
6a50: 6c 20 74 65 73 74 20 72 65 63 6f 72 64 73 20 74 l test records t
6a60: 6f 20 74 68 65 20 74 65 73 74 20 64 62 3f 22 29 o the test db?")
6a70: 0a 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 . (open-run-c
6a80: 6c 6f 73 65 20 64 62 3a 64 65 6c 65 74 65 2d 74 lose db:delete-t
6a90: 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 est-step-records
6aa0: 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 20 db test-id).
6ab0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
6ac0: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b ry work-area) ;;
6ad0: 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c so that log fil
6ae0: 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e es from the laun
6af0: 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 ch process don't
6b00: 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 clutter the tes
6b10: 74 20 64 69 72 0a 20 20 20 20 28 6f 70 65 6e 2d t dir. (open-
6b20: 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 run-close test-s
6b30: 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 et-status! db te
6b40: 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 22 st-id "LAUNCHED"
6b50: 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b 3b "n/a" #f #f) ;;
6b60: 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 75 (if launch-resu
6b70: 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c lts launch-resul
6b80: 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 20 ts "FAILED")).
6b90: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 (cond. ((a
6ba0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 74 nd launcher host
6bb0: 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 73 s) ;; must be us
6bc0: 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d 65 ing ssh hostname
6bd0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
6be0: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
6bf0: 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 73 ncher (car hosts
6c00: 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 )(list remote-me
6c10: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
6c20: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
6c30: 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d rms) debug-param
6c40: 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 74 ))). ;; (set
6c50: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6c60: 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 d launcher (car
6c70: 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f hosts)(list remo
6c80: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
6c90: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
6ca0: 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 cmdparms)))).
6cb0: 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 20 20 (launcher.
6cc0: 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 (set! fullcmd
6cd0: 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 (append launcher
6ce0: 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
6cf0: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
6d00: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
6d10: 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d rms) debug-param
6d20: 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 74 ))). ;; (set
6d30: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6d40: 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 d launcher (list
6d50: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
6d60: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
6d70: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 ute" cmdparms)))
6d80: 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 ). (else.
6d90: 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 65 73 (if (not uses
6da0: 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 6e hell)(debug:prin
6db0: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 69 6e t 0 "WARNING: in
6dc0: 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e 67 ternal launching
6dd0: 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 77 will not work w
6de0: 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 73 ell without \"us
6df0: 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e 20 eshell yes\" in
6e00: 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 your [jobtools]
6e10: 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 20 20 section")).
6e20: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
6e30: 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 65 6d append (list rem
6e40: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 ote-megatest tes
6e50: 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 t-sig "-execute"
6e60: 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 cmdparms) debug
6e70: 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 69 66 -param (list (if
6e80: 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 useshell "&" ""
6e90: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 )))))). ;; (s
6ea0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 et! fullcmd (lis
6eb0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
6ec0: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
6ed0: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 20 28 cute" cmdparms (
6ee0: 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 if useshell "&"
6ef0: 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 ""))))). (if
6f00: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6f10: 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 75 6c xterm")(set! ful
6f20: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 75 6c lcmd (append ful
6f30: 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 74 65 lcmd (list "-xte
6f40: 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 65 62 rm")))). (deb
6f50: 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 75 6e ug:print 1 "Laun
6f60: 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 72 65 ching " work-are
6f70: 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 72 a). ;; set pr
6f80: 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 e-launch-env-var
6f90: 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 69 s before launchi
6fa0: 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 61 72 ng, keep the var
6fb0: 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 61 6e s in prevvals an
6fc0: 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 6f 6e d put the envion
6fd0: 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 64 ment back when d
6fe0: 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 3a 70 one. (debug:p
6ff0: 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 3a rint 4 "fullcmd:
7000: 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 20 " fullcmd).
7010: 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 (let* ((commonpr
7020: 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e 65 evvals (alist->e
7030: 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 nv-vars.... (
7040: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
7050: 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 efault *configda
7060: 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t* "env-override
7070: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 74 65 " '()))).. (te
7080: 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c stprevvals (al
7090: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 ist->env-vars...
70a0: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
70b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 -ref/default tes
70c0: 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 6e t-conf "pre-laun
70d0: 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 73 ch-env-overrides
70e0: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 6d 69 " '()))).. (mi
70f0: 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c scprevvals (al
7100: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b ist->env-vars ;;
7110: 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 consolidate thi
7120: 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 s code with the
7130: 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 code in megatest
7140: 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 .scm for "-execu
7150: 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 70 65 te".... (appe
7160: 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 22 nd (list (list "
7170: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
7180: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
7190: 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 . (list "MT_TES
71a0: 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d T_NAME" test-nam
71b0: 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 e)...... (list
71c0: 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 "MT_ITEM_INFO" (
71d0: 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 0a conc itemdat)) .
71e0: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
71f0: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
7200: 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 ame)...... (lis
7210: 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 t "MT_TARGET"
7220: 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 mt_target).....
7230: 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 74 65 . )..... ite
7240: 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c 61 75 mdat))).. (lau
7250: 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 70 nch-results (app
7260: 6c 79 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d ly cmd-run-proc-
7270: 65 61 63 68 2d 6c 69 6e 65 0a 09 09 09 09 20 20 each-line.....
7280: 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 (if useshell....
7290: 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 . (string-i
72a0: 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
72b0: 6d 64 20 22 20 22 29 0a 09 09 09 09 20 20 20 20 md " ").....
72c0: 20 20 28 63 61 72 20 66 75 6c 6c 63 6d 64 29 29 (car fullcmd))
72d0: 0a 09 09 09 09 20 20 70 72 69 6e 74 0a 09 09 09 ..... print....
72e0: 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a . (if useshell.
72f0: 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 .... '()...
7300: 09 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c .. (cdr ful
7310: 6c 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c 61 lcmd))))) ;; la
7320: 75 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 29 uncher fullcmd))
7330: 29 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 );; (apply cmd-r
7340: 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e un-proc-each-lin
7350: 65 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e 74 e launcher print
7360: 20 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 28 fullcmd))) ;; (
7370: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 cmd-run->list fu
7380: 6c 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 77 llcmd)). (w
7390: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
73a0: 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f le "mt_launch.lo
73b0: 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 g"..(lambda ()..
73c0: 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 6c (apply print l
73d0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 29 aunch-results)))
73e0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
73f0: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 int 2 "Launching
7400: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 completed, upda
7410: 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 20 ting db").
7420: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
7430: 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 Launch results:
7440: 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 " launch-results
7450: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
7460: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
7470: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
7480: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 (print "ERROR: F
7490: 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 ailed to run " (
74a0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
74b0: 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 se fullcmd " ")
74c0: 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 ", exiting now")
74d0: 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 .. ;; (sqlite
74e0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
74f0: 09 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 . ;; good ole
7500: 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e 6f "exit" seems no
7510: 74 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 3b t to work.. ;
7520: 3b 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 20 ; (_exit 9)..
7530: 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
7540: 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
7550: 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
7560: 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
7570: 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 en email list..
7580: 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 68 ;; NB// Is th
7590: 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f is still needed?
75a0: 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 20 Should be safe
75b0: 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 65 to go back to "e
75c0: 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 20 28 xit" now?.. (
75d0: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 process-signal (
75e0: 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d current-process-
75f0: 69 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 id) signal/kill)
7600: 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 28 .. )). (
7610: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
7620: 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 20 miscprevvals).
7630: 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d (alist->env-
7640: 76 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c vars testprevval
7650: 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d s). (alist-
7660: 3e 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e >env-vars common
7670: 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 prevvals).
7680: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 launch-results))
7690: 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
76a0: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 tory *toppath*))
76b0: 0a 0a ..