Artifact
908cebfd40680697686d1a8ae2c8bbd3844c42b7
File
launch.scm
— part of check-in
[94f8ba30bd]
at
2012-09-21 14:38:33
on branch test-specific-db
— Cleaned up most fallout from migration to test specific data file
(user:
mrwellan
size: 30367)
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 64 62 20 20 20 20 20 20 20 20 23 (db #
0b20: 66 29 0a 09 20 20 20 20 20 20 20 28 74 64 62 20 f).. (tdb
0b30: 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 #f)..
0b40: 20 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 (rollup-status
0b50: 20 30 29 29 0a 09 20 20 0a 09 20 20 28 64 65 62 0)).. .. (deb
0b60: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 ug:print 2 "Exec
0b70: 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d tuing " test-nam
0b80: 65 20 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d e " (id: " test-
0b90: 69 64 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d id ") on " (get-
0ba0: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 3b host-name)).. ;
0bb0: 3b 20 61 70 70 6c 79 20 70 72 65 2d 6f 76 65 72 ; apply pre-over
0bc0: 72 69 64 65 73 20 62 65 66 6f 72 65 20 6f 74 68 rides before oth
0bd0: 65 72 20 76 61 72 69 61 62 6c 65 73 2e 20 54 68 er variables. Th
0be0: 65 20 70 72 65 2d 6f 76 65 72 72 69 64 65 20 76 e pre-override v
0bf0: 61 72 73 20 6d 75 73 74 20 6e 6f 74 0a 09 20 20 ars must not..
0c00: 3b 3b 20 63 6c 6f 62 62 65 72 73 20 74 68 69 6e ;; clobbers thin
0c10: 67 73 20 66 72 6f 6d 20 74 68 65 20 6f 66 66 69 gs from the offi
0c20: 63 69 61 6c 20 73 6f 75 72 63 65 73 20 73 75 63 cial sources suc
0c30: 68 20 61 73 20 6d 65 67 61 74 65 73 74 2e 63 6f h as megatest.co
0c40: 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 nfig and runconf
0c50: 69 67 73 2e 63 6f 6e 66 69 67 0a 09 20 20 28 69 igs.config.. (i
0c60: 66 20 28 73 74 72 69 6e 67 3f 20 73 65 74 2d 76 f (string? set-v
0c70: 61 72 73 29 0a 09 20 20 20 20 20 20 28 6c 65 74 ars).. (let
0c80: 20 28 28 76 61 72 70 61 69 72 73 20 28 73 74 72 ((varpairs (str
0c90: 69 6e 67 2d 73 70 6c 69 74 20 73 65 74 2d 76 61 ing-split set-va
0ca0: 72 73 20 22 2c 22 29 29 29 0a 09 09 28 64 65 62 rs ",")))...(deb
0cb0: 75 67 3a 70 72 69 6e 74 20 34 20 22 76 61 72 70 ug:print 4 "varp
0cc0: 61 69 72 73 3a 20 22 20 76 61 72 70 61 69 72 73 airs: " varpairs
0cd0: 29 0a 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 )...(map (lambda
0ce0: 20 28 76 61 72 70 61 69 72 29 0a 09 09 20 20 20 (varpair)...
0cf0: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 76 61 (let ((varva
0d00: 6c 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 l (string-split
0d10: 76 61 72 70 61 69 72 20 22 3d 22 29 29 29 0a 09 varpair "=")))..
0d20: 09 09 20 28 69 66 20 28 65 71 3f 20 28 6c 65 6e .. (if (eq? (len
0d30: 67 74 68 20 76 61 72 76 61 6c 29 20 32 29 0a 09 gth varval) 2)..
0d40: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 .. (let ((va
0d50: 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 0a r (car varval)).
0d60: 09 09 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 .... (val (cad
0d70: 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 09 20 r varval)))....
0d80: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
0d90: 6e 74 20 31 20 22 41 64 64 69 6e 67 20 70 72 65 nt 1 "Adding pre
0da0: 2d 76 61 72 2f 76 61 6c 20 22 20 76 61 72 20 22 -var/val " var "
0db0: 20 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 74 68 = " val " to th
0dc0: 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a e environment").
0dd0: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 65 6e ... (seten
0de0: 76 20 76 61 72 20 76 61 6c 29 29 29 29 29 0a 09 v var val)))))..
0df0: 09 20 20 20 20 20 76 61 72 70 61 69 72 73 29 29 . varpairs))
0e00: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
0e10: 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 _TEST_RUN_DIR" w
0e20: 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 73 65 ork-area).. (se
0e30: 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e 41 tenv "MT_TEST_NA
0e40: 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 ME" test-name)..
0e50: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 49 54 (setenv "MT_IT
0e60: 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 EM_INFO" (conc i
0e70: 74 65 6d 64 61 74 29 29 0a 09 20 20 28 73 65 74 temdat)).. (set
0e80: 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 env "MT_RUNNAME"
0e90: 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 28 runname).. (
0ea0: 73 65 74 65 6e 76 20 22 4d 54 5f 4d 45 47 41 54 setenv "MT_MEGAT
0eb0: 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 29 0a EST" megatest).
0ec0: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 . (setenv "MT_T
0ed0: 41 52 47 45 54 22 20 20 20 20 74 61 72 67 65 74 ARGET" target
0ee0: 29 0a 09 20 20 28 69 66 20 6d 74 2d 62 69 6e 64 ).. (if mt-bind
0ef0: 69 72 2d 70 61 74 68 20 28 73 65 74 65 6e 76 20 ir-path (setenv
0f00: 22 50 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 "PATH" (conc (ge
0f10: 74 65 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 tenv "PATH") ":"
0f20: 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 mt-bindir-path)
0f30: 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
0f40: 72 65 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 rectory top-path
0f50: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 ).. (if (not (s
0f60: 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 etup-for-run))..
0f70: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
0f80: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 debug:print 0 "F
0f90: 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 ailed to setup,
0fa0: 65 78 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 exiting") ...;;
0fb0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
0fc0: 65 21 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c e! db)...;; (sql
0fd0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
0fe0: 64 62 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 db)...(exit 1)))
0ff0: 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
1000: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
1010: 0a 09 20 20 3b 3b 20 6e 6f 77 20 63 61 6e 20 66 .. ;; now can f
1020: 69 6e 64 20 6f 75 72 20 64 62 0a 09 20 20 28 73 ind our db.. (s
1030: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db)
1040: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 61 ).. (if (not (a
1050: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 65 rgs:get-arg "-se
1060: 72 76 65 72 22 29 29 0a 09 20 20 20 20 20 20 28 rver")).. (
1070: 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 server:client-se
1080: 74 75 70 20 64 62 29 29 0a 09 20 20 3b 3b 20 28 tup db)).. ;; (
1090: 73 65 74 21 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 set! *cache-on*
10a0: 23 74 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 #t).. (set-mega
10b0: 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 64 62 test-env-vars db
10c0: 20 72 75 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 run-id) ;; thes
10d0: 65 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 e may be needed
10e0: 62 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 by the launching
10f0: 20 70 72 6f 63 65 73 73 0a 09 20 20 28 63 68 61 process.. (cha
1100: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
1110: 72 6b 2d 61 72 65 61 29 20 0a 0a 09 20 20 28 6f rk-area) ... (o
1120: 6e 2d 65 78 69 74 20 28 6c 61 6d 62 64 61 20 28 n-exit (lambda (
1130: 29 0a 09 09 20 20 20 20 20 28 64 65 62 75 67 3a )... (debug:
1140: 70 72 69 6e 74 20 30 20 22 46 69 6e 61 6c 69 7a print 0 "Finaliz
1150: 69 6e 67 20 64 62 21 21 21 22 29 0a 09 09 20 20 ing db!!!")...
1160: 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 (sqlite3:fina
1170: 6c 69 7a 65 21 20 64 62 29 29 29 0a 0a 09 20 20 lize! db)))...
1180: 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d (set-run-config-
1190: 76 61 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vars db run-id).
11a0: 09 20 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e . ;; environmen
11b0: 74 20 6f 76 65 72 72 69 64 65 73 20 61 72 65 20 t overrides are
11c0: 64 6f 6e 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 done *before* th
11d0: 65 20 72 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 e remaining crit
11e0: 69 63 61 6c 20 65 6e 76 61 72 73 2e 0a 09 20 20 ical envars...
11f0: 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
1200: 20 65 6e 76 2d 6f 76 72 64 29 0a 09 20 20 28 73 env-ovrd).. (s
1210: 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d et-megatest-env-
1220: 76 61 72 73 20 64 62 20 72 75 6e 2d 69 64 29 0a vars db run-id).
1230: 09 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 . (set-item-env
1240: 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a 09 -vars itemdat)..
1250: 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d (save-environm
1260: 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 ent-as-files "me
1270: 67 61 74 65 73 74 22 29 0a 09 20 20 28 74 65 73 gatest").. (tes
1280: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
1290: 64 62 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 db test-id run-i
12a0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
12b0: 64 61 74 29 0a 09 20 20 28 74 65 73 74 2d 73 65 dat).. (test-se
12c0: 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 t-status! db tes
12d0: 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 t-id "REMOTEHOST
12e0: 53 54 41 52 54 22 20 22 6e 2f 61 22 20 28 61 72 START" "n/a" (ar
12f0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
1300: 20 23 66 29 0a 09 20 20 28 69 66 20 28 61 72 67 #f).. (if (arg
1310: 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 s:get-arg "-xter
1320: 6d 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 m").. (set!
1330: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 fullrunscript "
1340: 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 28 xterm").. (
1350: 69 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e 73 if (and fullruns
1360: 63 72 69 70 74 20 28 6e 6f 74 20 28 66 69 6c 65 cript (not (file
1370: 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f -execute-access?
1380: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
1390: 29 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 )... (system (c
13a0: 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 onc "chmod ug+x
13b0: 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 " fullrunscript)
13c0: 29 29 29 0a 09 20 20 3b 3b 20 57 65 20 61 72 65 ))).. ;; We are
13d0: 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c about to actual
13e0: 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 ly kick off the
13f0: 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 68 test.. ;; so th
1400: 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 is is a good pla
1410: 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 65 ce to remove the
1420: 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 20 records for ..
1430: 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 73 ;; any previous
1440: 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 3a runs.. ;; (db:
1450: 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 test-remove-step
1460: 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 s db run-id test
1470: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 name itemdat)..
1480: 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 .. (let* ((m
1490: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
14a0: 6d 75 74 65 78 29 29 0a 09 09 20 28 6b 69 6c 6c mutex))... (kill
14b0: 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 20 -job? #f)...
14c0: 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 76 (exit-info (v
14d0: 65 63 74 6f 72 20 23 74 20 23 74 20 23 74 29 29 ector #t #t #t))
14e0: 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 20 ... (job-thread
14f0: 20 20 23 66 29 0a 09 09 20 28 72 75 6e 69 74 20 #f)... (runit
1500: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
1510: 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d 76 )..... ;; (let-v
1520: 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 28 alues..... ;; (
1530: 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 75 ((pid exit-statu
1540: 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 s exit-code)....
1550: 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 . ;; (run-n-w
1560: 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ait fullrunscrip
1570: 74 29 29 29 0a 09 09 09 09 20 0a 09 09 09 09 20 t)))..... .....
1580: 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 61 ;; if there is a
1590: 20 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 74 runscript do it
15a0: 20 66 69 72 73 74 0a 09 09 09 09 20 28 69 66 20 first..... (if
15b0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 09 09 fullrunscript...
15c0: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 .. (let ((pi
15d0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 d (process-run f
15e0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
15f0: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
1600: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
1610: 09 09 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 .. (let-values..
1620: 09 09 09 09 20 20 28 28 28 70 69 64 2d 76 61 6c .... (((pid-val
1630: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
1640: 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 t-code) (process
1650: 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a -wait pid #t))).
1660: 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d 6c 6f ..... (mutex-lo
1670: 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 76 ck! m)...... (v
1680: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
1690: 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 info 0 pid).....
16a0: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
16b0: 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 exit-info 1 exit
16c0: 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 -status)......
16d0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 (vector-set! exi
16e0: 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f t-info 2 exit-co
16f0: 64 65 29 0a 09 09 09 09 09 20 20 28 73 65 74 21 de)...... (set!
1700: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 rollup-status e
1710: 78 69 74 2d 63 6f 64 65 29 20 0a 09 09 09 09 09 xit-code) ......
1720: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
1730: 20 6d 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 m)...... (if (
1740: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
1750: 09 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e .... (begin
1760: 0a 09 09 09 09 09 09 28 74 68 72 65 61 64 2d 73 .......(thread-s
1770: 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 28 leep! 2).......(
1780: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a 09 loop (+ i 1)))..
1790: 09 09 09 09 20 20 20 20 20 20 29 29 29 29 29 0a .... ))))).
17a0: 09 09 09 09 20 3b 3b 20 74 68 65 6e 2c 20 69 66 .... ;; then, if
17b0: 20 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 6f runscript ran o
17c0: 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 65 k (or did not ge
17d0: 74 20 63 61 6c 6c 65 64 29 0a 09 09 09 09 20 3b t called)..... ;
17e0: 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 ; do all the ezs
17f0: 74 65 70 73 20 28 69 66 20 61 6e 79 29 0a 09 09 teps (if any)...
1800: 09 09 20 28 69 66 20 65 7a 73 74 65 70 73 0a 09 .. (if ezsteps..
1810: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
1820: 74 65 73 74 63 6f 6e 66 69 67 20 28 72 65 61 64 testconfig (read
1830: 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f -config (conc wo
1840: 72 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f rk-area "/testco
1850: 6e 66 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 nfig") #f #t env
1860: 69 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d iron-patt: "pre-
1870: 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 launch-env-vars"
1880: 29 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 )) ;; FIXME??? i
1890: 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f s allow-system o
18a0: 6b 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 20 k here?......
18b0: 20 28 65 7a 73 74 65 70 73 6c 73 74 20 28 68 61 (ezstepslst (ha
18c0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
18d0: 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 ault testconfig
18e0: 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 0a "ezsteps" '())).
18f0: 09 09 09 09 09 20 20 20 20 28 64 62 20 20 20 20 ..... (db
1900: 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 29 (open-db)))
1910: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
1920: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
1930: 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 rg "-server"))..
1940: 09 09 09 09 20 20 20 28 73 65 72 76 65 72 3a 63 .... (server:c
1950: 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 29 29 lient-setup db))
1960: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
1970: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
1980: 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 29 28 s? ".ezsteps"))(
1990: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
19a0: 20 22 2e 65 7a 73 74 65 70 73 22 29 29 0a 09 09 ".ezsteps"))...
19b0: 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 65 .. ;; if e
19c0: 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 69 6e zsteps was defin
19d0: 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 73 ed then we are s
19e0: 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 6c ure to have at l
19f0: 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 75 east one step bu
1a00: 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a 09 t check anyway..
1a10: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ... (if (n
1a20: 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a ot (> (length ez
1a30: 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 09 stepslst) 0))...
1a40: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
1a50: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 65 7a 73 nt 0 "ERROR: ezs
1a60: 74 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 teps defined but
1a70: 20 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a ezstepslst is z
1a80: 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 09 09 ero length")....
1a90: 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 .. (let loop (
1aa0: 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a 73 (ezstep (car ezs
1ab0: 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 09 tepslst)).......
1ac0: 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 (tal (c
1ad0: 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a dr ezstepslst)).
1ae0: 09 09 09 09 09 09 20 20 20 20 20 20 28 70 72 65 ...... (pre
1af0: 76 73 74 65 70 20 23 66 29 29 0a 09 09 09 09 09 vstep #f))......
1b00: 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 ;; check ex
1b10: 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d it-info (vector-
1b20: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
1b30: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
1b40: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
1b50: 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 09 20 28 info 1)....... (
1b60: 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 let* ((stepname
1b70: 20 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 20 (car ezstep))
1b80: 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 72 ;; do stuff to r
1b90: 75 6e 20 74 68 65 20 73 74 65 70 0a 09 09 09 09 un the step.....
1ba0: 09 09 09 28 73 74 65 70 69 6e 66 6f 20 20 28 63 ...(stepinfo (c
1bb0: 61 64 72 20 65 7a 73 74 65 70 29 29 0a 09 09 09 adr ezstep))....
1bc0: 09 09 09 09 28 73 74 65 70 70 61 72 74 73 20 28 ....(stepparts (
1bd0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 string-match (re
1be0: 67 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c gexp "^(\\{([^\\
1bf0: 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a }]*)\\}\\s*|)(.*
1c00: 29 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a )$") stepinfo)).
1c10: 09 09 09 09 09 09 09 28 73 74 65 70 70 61 72 6d .......(stepparm
1c20: 73 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 s (list-ref step
1c30: 70 61 72 74 73 20 32 29 29 20 3b 3b 20 66 6f 72 parts 2)) ;; for
1c40: 20 66 75 74 75 72 65 20 75 73 65 2c 20 7b 56 41 future use, {VA
1c50: 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 74 R=1,2,3}, run st
1c60: 65 70 20 66 6f 72 20 65 61 63 68 20 0a 09 09 09 ep for each ....
1c70: 09 09 09 09 28 73 74 65 70 63 6d 64 20 20 20 28 ....(stepcmd (
1c80: 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 list-ref steppar
1c90: 74 73 20 33 29 29 0a 09 09 09 09 09 09 09 28 73 ts 3))........(s
1ca0: 63 72 69 70 74 20 20 20 20 22 22 29 20 3b 20 22 cript "") ; "
1cb0: 23 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 20 #!/bin/bash\n")
1cc0: 3b 3b 20 79 65 70 2c 20 77 65 20 64 65 70 65 6e ;; yep, we depen
1cd0: 64 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 49 d on bin/bash FI
1ce0: 58 4d 45 21 21 21 0a 09 09 09 09 09 09 09 28 6c XME!!!........(l
1cf0: 6f 67 70 72 6f 2d 75 73 65 64 20 23 66 29 29 0a ogpro-used #f)).
1d00: 09 09 09 09 09 09 20 20 20 3b 3b 20 4e 42 2f 2f ...... ;; NB//
1d10: 20 63 61 6e 20 73 61 66 65 6c 79 20 61 73 73 75 can safely assu
1d20: 6d 65 20 77 65 20 61 72 65 20 69 6e 20 74 65 73 me we are in tes
1d30: 74 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 t-area directory
1d40: 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 ....... (debug
1d50: 3a 70 72 69 6e 74 20 34 20 22 65 7a 73 74 65 70 :print 4 "ezstep
1d60: 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a 20 22 s:\n stepname: "
1d70: 20 73 74 65 70 6e 61 6d 65 20 22 20 73 74 65 70 stepname " step
1d80: 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e 66 6f info: " stepinfo
1d90: 20 22 20 73 74 65 70 70 61 72 74 73 3a 20 22 20 " stepparts: "
1da0: 73 74 65 70 70 61 72 74 73 0a 09 09 09 09 09 09 stepparts.......
1db0: 09 09 22 20 73 74 65 70 70 61 72 6d 73 3a 20 22 .." stepparms: "
1dc0: 20 73 74 65 70 70 61 72 6d 73 20 22 20 73 74 65 stepparms " ste
1dd0: 70 63 6d 64 3a 20 22 20 73 74 65 70 63 6d 64 29 pcmd: " stepcmd)
1de0: 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 ....... ......
1df0: 09 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 . (if (file-ex
1e00: 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 65 70 ists? (conc step
1e10: 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 29 name ".logpro"))
1e20: 28 73 65 74 21 20 6c 6f 67 70 72 6f 2d 75 73 65 (set! logpro-use
1e30: 64 20 23 74 29 29 0a 0a 09 09 09 09 09 09 20 20 d #t))........
1e40: 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 6f 75 ;; ;; first sou
1e50: 72 63 65 20 74 68 65 20 70 72 65 76 69 6f 75 73 rce the previous
1e60: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 09 environment....
1e70: 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 ... ;; (let ((
1e80: 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 20 22 prev-env (conc "
1e90: 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 65 76 73 .ezsteps/" prevs
1ea0: 74 65 70 20 28 69 66 20 28 73 74 72 69 6e 67 2d tep (if (string-
1eb0: 73 65 61 72 63 68 20 28 72 65 67 65 78 70 20 22 search (regexp "
1ec0: 63 73 68 22 29 20 0a 09 09 09 09 09 09 20 20 20 csh") .......
1ed0: 3b 3b 20 20 20 20 20 20 09 09 09 09 09 09 09 20 ;; .......
1ee0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
1ef0: 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c -variable "SHELL
1f00: 22 29 29 20 22 2e 63 73 68 22 20 22 2e 73 68 22 ")) ".csh" ".sh"
1f10: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b ))))....... ;;
1f20: 20 20 20 28 69 66 20 28 61 6e 64 20 70 72 65 76 (if (and prev
1f30: 73 74 65 70 20 28 66 69 6c 65 2d 65 78 69 73 74 step (file-exist
1f40: 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a 09 09 s? prev-env))...
1f50: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 20 .... ;;
1f60: 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 6f (set! script (co
1f70: 6e 63 20 73 63 72 69 70 74 20 22 73 6f 75 72 63 nc script "sourc
1f80: 65 20 22 20 70 72 65 76 2d 65 6e 76 29 29 29 29 e " prev-env))))
1f90: 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 ....... ......
1fa0: 09 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 20 . ;; call the
1fb0: 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d 74 command using mt
1fc0: 5f 65 7a 73 74 65 70 0a 09 09 09 09 09 09 20 20 _ezstep.......
1fd0: 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 (set! script (c
1fe0: 6f 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 20 22 onc "mt_ezstep "
1ff0: 20 73 74 65 70 6e 61 6d 65 20 22 20 22 20 28 69 stepname " " (i
2000: 66 20 70 72 65 76 73 74 65 70 20 70 72 65 76 73 f prevstep prevs
2010: 74 65 70 20 22 2d 22 29 20 22 20 22 20 73 74 65 tep "-") " " ste
2020: 70 63 6d 64 29 29 0a 0a 09 09 09 09 09 09 20 20 pcmd))........
2030: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
2040: 22 73 63 72 69 70 74 3a 20 22 20 73 63 72 69 70 "script: " scrip
2050: 74 29 0a 0a 09 09 09 09 09 09 20 20 20 28 72 64 t)........ (rd
2060: 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 b:teststep-set-s
2070: 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d 69 tatus! db test-i
2080: 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 d stepname "star
2090: 74 22 20 22 2d 22 20 69 74 65 6d 64 61 74 20 23 t" "-" itemdat #
20a0: 66 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 3b f #f)....... ;
20b0: 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 0a 09 09 09 ; now launch....
20c0: 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 64 ... (let ((pid
20d0: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 73 63 (process-run sc
20e0: 72 69 70 74 29 29 29 0a 09 09 09 09 09 09 20 20 ript))).......
20f0: 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 6c (let processl
2100: 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 09 oop ((i 0)).....
2110: 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 61 .. (let-va
2120: 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 lues (((pid-val
2130: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
2140: 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d 77 -code)(process-w
2150: 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 ait pid #t)))...
2160: 09 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d ...... (mutex-
2170: 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 lock! m)........
2180: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
2190: 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 exit-info 0 pid
21a0: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 65 )......... (ve
21b0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
21c0: 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 75 nfo 1 exit-statu
21d0: 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 s)......... (v
21e0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
21f0: 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 info 2 exit-code
2200: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d 75 )......... (mu
2210: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
2220: 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 65 ....... (if (e
2230: 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 q? pid-val 0)...
2240: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 62 65 ...... (be
2250: 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 28 74 gin.......... (t
2260: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
2270: 09 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 65 ......... (proce
2280: 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 ssloop (+ i 1)))
2290: 29 0a 09 09 09 09 09 09 09 09 20 20 20 29 29 0a )......... )).
22a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 69 6e (let ((exin
22e0: 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 fo (vector-ref e
22f0: 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 20 20 20 xit-info 2)).
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2330: 20 20 20 20 20 20 20 20 28 6c 6f 67 66 6e 61 20 (logfna
2340: 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 (if logpro-used
2350: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
2360: 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 0a 20 20 .html") ""))).
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 20 20 20 20 20 3b 3b 20 74 65 73 74 69 6e 67 ;; testing
23b0: 20 69 66 20 70 72 6f 63 65 64 75 72 65 73 20 63 if procedures c
23c0: 61 6c 6c 65 64 20 69 6e 20 61 20 72 65 6d 6f 74 alled in a remot
23d0: 65 20 63 61 6c 6c 20 63 61 75 73 65 20 70 72 6f e call cause pro
23e0: 62 6c 65 6d 73 20 28 61 6e 73 3a 20 6e 6f 20 6f blems (ans: no o
23f0: 72 20 73 6f 20 49 20 73 75 73 70 65 63 74 29 0a r so I suspect).
2400: 09 09 09 09 09 09 20 20 20 20 20 20 20 20 28 72 ...... (r
2410: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
2420: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
2430: 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 id stepname "end
2440: 22 20 65 78 69 6e 66 6f 20 69 74 65 6d 64 61 74 " exinfo itemdat
2450: 20 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 09 09 #f logfna))....
2460: 09 09 09 20 20 20 20 20 28 69 66 20 6c 6f 67 70 ... (if logp
2470: 72 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 09 20 ro-used........
2480: 28 72 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (rdb:test-set-lo
2490: 67 21 20 64 62 20 74 65 73 74 2d 69 64 20 28 63 g! db test-id (c
24a0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 onc stepname ".h
24b0: 74 6d 6c 22 29 29 29 0a 09 09 09 09 09 09 20 20 tml"))).......
24c0: 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 74 65 ;; set the te
24d0: 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 73 0a st final status.
24e0: 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a ...... (let*
24f0: 20 28 28 74 68 69 73 2d 73 74 65 70 2d 73 74 61 ((this-step-sta
2500: 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 tus (cond.......
2510: 09 09 09 20 20 20 20 20 20 20 28 28 61 6e 64 20 ... ((and
2520: 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 (eq? (vector-ref
2530: 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 32 29 exit-info 2) 2)
2540: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 77 logpro-used) 'w
2550: 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 arn)..........
2560: 20 20 20 20 20 28 28 65 71 3f 20 28 76 65 63 74 ((eq? (vect
2570: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
2580: 20 32 29 20 30 29 20 20 20 20 20 20 20 20 20 20 2) 0)
2590: 20 20 20 20 20 20 20 20 20 27 70 61 73 73 29 0a 'pass).
25a0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
25b0: 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 (else 'fail)))..
25c0: 09 09 09 09 09 09 20 20 20 20 28 6f 76 65 72 61 ...... (overa
25d0: 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f 6e ll-status (con
25e0: 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 d..........
25f0: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
2600: 74 61 74 75 73 20 32 29 20 27 77 61 72 6e 29 0a tatus 2) 'warn).
2610: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2620: 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 ((eq? rollup-sta
2630: 74 75 73 20 30 29 20 27 70 61 73 73 29 0a 09 09 tus 0) 'pass)...
2640: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 ....... (e
2650: 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 09 lse 'fail)))....
2660: 09 09 09 09 20 20 20 20 28 6e 65 78 74 2d 73 74 .... (next-st
2670: 61 74 75 73 20 20 20 20 20 20 28 63 6f 6e 64 20 atus (cond
2680: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2690: 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 ((eq? overall-s
26a0: 74 61 74 75 73 20 27 70 61 73 73 29 20 74 68 69 tatus 'pass) thi
26b0: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 29 0a 09 s-step-status)..
26c0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
26d0: 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 (eq? overall-sta
26e0: 74 75 73 20 27 77 61 72 6e 29 0a 09 09 09 09 09 tus 'warn)......
26f0: 09 09 09 09 09 28 69 66 20 28 65 71 3f 20 74 68 .....(if (eq? th
2700: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 is-step-status '
2710: 66 61 69 6c 29 20 27 66 61 69 6c 20 27 77 61 72 fail) 'fail 'war
2720: 6e 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 n))..........
2730: 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 (else 'fail)
2740: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ))).......
2750: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
2760: 22 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 65 "Exit value rece
2770: 69 76 65 64 3a 20 22 20 28 76 65 63 74 6f 72 2d ived: " (vector-
2780: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
2790: 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 3a 20 " logpro-used:
27a0: 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 0a 09 " logpro-used ..
27b0: 09 09 09 09 09 09 09 20 20 20 20 22 20 74 68 69 ....... " thi
27c0: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 3a 20 22 s-step-status: "
27d0: 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 this-step-statu
27e0: 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 s " overall-stat
27f0: 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 us: " overall-st
2800: 61 74 75 73 20 0a 09 09 09 09 09 09 09 09 20 20 atus .........
2810: 20 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 3a " next-status:
2820: 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 20 22 " next-status "
2830: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 rollup-status:
2840: 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 29 " rollup-status)
2850: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
2860: 61 73 65 20 6e 65 78 74 2d 73 74 61 74 75 73 0a ase next-status.
2870: 09 09 09 09 09 09 09 20 28 28 77 61 72 6e 29 0a ....... ((warn).
2880: 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 72 ....... (set! r
2890: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 29 0a ollup-status 2).
28a0: 09 09 09 09 09 09 09 20 20 3b 3b 20 4e 42 2f 2f ....... ;; NB//
28b0: 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 test-set-status
28c0: 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 ! does rdb calls
28d0: 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 0a under the hood.
28e0: 09 09 09 09 09 09 09 20 20 28 74 65 73 74 2d 73 ....... (test-s
28f0: 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 et-status! db te
2900: 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 st-id "RUNNING"
2910: 22 57 41 52 4e 22 20 0a 09 09 09 09 09 09 09 09 "WARN" .........
2920: 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 74 68 . (if (eq? th
2930: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 is-step-status '
2940: 77 61 72 6e 29 20 22 4c 6f 67 70 72 6f 20 77 61 warn) "Logpro wa
2950: 72 6e 69 6e 67 20 66 6f 75 6e 64 22 20 23 66 29 rning found" #f)
2960: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 23 66 .......... #f
2970: 29 29 0a 09 09 09 09 09 09 09 20 28 28 70 61 73 ))........ ((pas
2980: 73 29 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 s)........ (tes
2990: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db
29a0: 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e test-id "RUNNIN
29b0: 47 22 20 22 50 41 53 53 22 20 23 66 20 23 66 29 G" "PASS" #f #f)
29c0: 29 0a 09 09 09 09 09 09 09 20 28 65 6c 73 65 20 )........ (else
29d0: 3b 3b 20 27 66 61 69 6c 0a 09 09 09 09 09 09 09 ;; 'fail........
29e0: 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 (set! rollup-s
29f0: 74 61 74 75 73 20 31 29 20 3b 3b 20 66 6f 72 63 tatus 1) ;; forc
2a00: 65 20 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 e fail........
2a10: 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 (test-set-status
2a20: 21 20 64 62 20 74 65 73 74 2d 69 64 20 22 52 55 ! db test-id "RU
2a30: 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 28 63 NNING" "FAIL" (c
2a40: 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 73 onc "Failed at s
2a50: 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 20 tep " stepname)
2a60: 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 29 29 #f)........ )))
2a70: 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 28 )....... (if (
2a80: 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f and (steprun-goo
2a90: 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 d? logpro-used (
2aa0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
2ab0: 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 09 09 info 2))........
2ac0: 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (not (null?
2ad0: 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 tal))).......
2ae0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
2af0: 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 74 al) (cdr tal) st
2b00: 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 20 epname)))......
2b10: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2b20: 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 4 "WARNING: a p
2b30: 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c 65 64 rior step failed
2b40: 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 22 20 , stopping at "
2b50: 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 0a 09 ezstep))))))))..
2b60: 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 . (monitorjob
2b70: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
2b80: 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 (let* ((start-se
2b90: 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 conds (current-s
2ba0: 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 63 econds))......(c
2bb0: 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 alc-minutes (la
2bc0: 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 mbda ()........
2bd0: 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 (inexact->exact
2be0: 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 6e 64 ........ (round
2bf0: 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d 20 0a ........ (- .
2c00: 09 09 09 09 09 09 09 20 20 20 20 28 63 75 72 72 ....... (curr
2c10: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 ent-seconds) ...
2c20: 09 09 09 09 09 20 20 20 20 73 74 61 72 74 2d 73 ..... start-s
2c30: 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 09 econds))))).....
2c40: 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 .(kill-tries 0))
2c50: 0a 09 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f ..... (let loo
2c60: 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 p ((minutes (c
2c70: 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a 09 alc-minutes)))..
2c80: 09 09 09 20 20 20 20 20 3b 3b 20 28 6c 65 74 2a ... ;; (let*
2c90: 20 28 3b 3b 20 28 64 62 20 20 20 20 20 20 20 28 (;; (db (
2ca0: 6f 70 65 6e 2d 64 62 29 29 0a 09 09 09 09 09 20 open-db))......
2cb0: 20 20 20 3b 3b 20 28 63 70 75 6c 6f 61 64 20 20 ;; (cpuload
2cc0: 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 29 0a (get-cpu-load)).
2cd0: 09 09 09 09 09 20 20 20 20 3b 3b 20 28 64 69 73 ..... ;; (dis
2ce0: 6b 66 72 65 65 20 28 67 65 74 2d 64 66 20 28 63 kfree (get-df (c
2cf0: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
2d00: 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 )))...... ;;
2d10: 28 74 6d 70 66 72 65 65 20 20 28 67 65 74 2d 64 (tmpfree (get-d
2d20: 66 20 22 2f 74 6d 70 22 29 29 29 0a 09 09 09 09 f "/tmp"))).....
2d30: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
2d40: 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6e ;; (if (n
2d50: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
2d60: 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 09 09 "-server"))....
2d70: 09 20 20 20 20 20 20 20 3b 3b 09 20 20 20 28 73 . ;;. (s
2d80: 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 erver:client-set
2d90: 75 70 20 64 62 29 29 0a 09 09 09 09 20 20 20 20 up db)).....
2da0: 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 63 ;; (if (not c
2db0: 70 75 6c 6f 61 64 29 20 20 28 62 65 67 69 6e 20 puload) (begin
2dc0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2dd0: 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 4f 41 44 WARNING: CPULOAD
2de0: 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 20 28 not found.") (
2df0: 73 65 74 21 20 63 70 75 6c 6f 61 64 20 22 6e 2f set! cpuload "n/
2e00: 61 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 a"))).....
2e10: 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 64 69 73 ;; (if (not dis
2e20: 6b 66 72 65 65 29 20 28 62 65 67 69 6e 20 28 64 kfree) (begin (d
2e30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
2e40: 52 4e 49 4e 47 3a 20 44 49 53 4b 46 52 45 45 20 RNING: DISKFREE
2e50: 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 28 73 65 not found.") (se
2e60: 74 21 20 64 69 73 6b 66 72 65 65 20 22 6e 2f 61 t! diskfree "n/a
2e70: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 "))).....
2e80: 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 (set! kill-job?
2e90: 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 (test-get-kill-r
2ea0: 65 71 75 65 73 74 20 64 62 20 74 65 73 74 2d 69 equest db test-i
2eb0: 64 29 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 d)) ;; run-id te
2ec0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 st-name itemdat)
2ed0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 65 )..... (te
2ee0: 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f st-set-meta-info
2ef0: 20 64 62 20 74 65 73 74 2d 69 64 20 72 75 6e 2d db test-id run-
2f00: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
2f10: 6d 64 61 74 20 6d 69 6e 75 74 65 73 3a 20 6d 69 mdat minutes: mi
2f20: 6e 75 74 65 73 29 0a 09 09 09 09 20 20 20 20 20 nutes).....
2f30: 20 20 3b 3b 20 28 72 64 62 3a 74 65 73 74 2d 75 ;; (rdb:test-u
2f40: 70 64 61 74 65 2d 6d 65 74 61 2d 69 6e 66 6f 20 pdate-meta-info
2f50: 64 62 20 74 65 73 74 2d 69 64 20 6d 69 6e 75 74 db test-id minut
2f60: 65 73 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 es cpuload diskf
2f70: 72 65 65 20 74 6d 70 66 72 65 65 29 0a 09 09 09 ree tmpfree)....
2f80: 09 20 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c . (if kill
2f90: 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 28 -job? ...... (
2fa0: 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 begin......
2fb0: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
2fc0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ..... (let*
2fd0: 28 28 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 ((pid (vector-re
2fe0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 f exit-info 0)))
2ff0: 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 ...... (if
3000: 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 (number? pid)..
3010: 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ..... (begin..
3020: 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 ..... (debug
3030: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
3040: 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 G: Request recei
3050: 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 ved to kill job
3060: 28 61 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c (attempt # " kil
3070: 6c 2d 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 l-tries ")")....
3080: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 ... (let ((p
3090: 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d 72 75 rocesses (cmd-ru
30a0: 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 70 n->list (conc "p
30b0: 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 64 grep -l -P " pid
30c0: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 )))).......
30d0: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 (for-each ....
30e0: 09 09 09 09 28 6c 61 6d 62 64 61 20 28 70 29 0a ....(lambda (p).
30f0: 09 09 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 ....... (let* (
3100: 28 70 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d (parts (string-
3110: 73 70 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 split p)).......
3120: 09 09 20 28 70 2d 69 64 20 20 20 28 69 66 20 28 .. (p-id (if (
3130: 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 > (length parts)
3140: 20 30 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 0)..........
3150: 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 (string->numbe
3160: 72 20 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 r (car parts))..
3170: 09 09 09 09 09 09 09 09 20 20 20 20 20 23 66 29 ........ #f)
3180: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 ))........ (i
3190: 66 20 70 2d 69 64 0a 09 09 09 09 09 09 09 09 28 f p-id.........(
31a0: 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 20 20 begin.........
31b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
31c0: 4b 69 6c 6c 69 6e 67 20 22 20 28 63 61 64 72 20 Killing " (cadr
31d0: 70 61 72 74 73 29 20 22 3b 20 6b 69 6c 6c 20 2d parts) "; kill -
31e0: 39 20 20 22 20 70 2d 69 64 29 0a 09 09 09 09 09 9 " p-id)......
31f0: 09 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f ... (system (co
3200: 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d nc "kill -9 " p-
3210: 69 64 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 id))))))........
3220: 28 63 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 (car processes))
3230: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s
3240: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c ystem (conc "kil
3250: 6c 20 2d 39 20 22 20 70 69 64 29 29 29 29 0a 09 l -9 " pid))))..
3260: 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ..... (begin..
3270: 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 ..... (debug
3280: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
3290: 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 G: Request recei
32a0: 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 ved to kill job
32b0: 62 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 but problem with
32c0: 20 70 72 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 process, attemp
32d0: 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e ting to kill man
32e0: 61 67 65 72 20 70 72 6f 63 65 73 73 22 29 0a 09 ager process")..
32f0: 09 09 09 09 09 20 20 20 20 20 28 74 65 73 74 2d ..... (test-
3300: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
3310: 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 est-id "KILLED"
3320: 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09 "FAIL".........
3330: 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 (args:get
3340: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
3350: 09 09 09 09 09 20 20 20 20 20 28 73 71 6c 69 74 ..... (sqlit
3360: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
3370: 0a 09 09 09 09 09 09 20 20 20 20 20 28 73 71 6c ....... (sql
3380: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
3390: 64 62 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 db)....... (
33a0: 65 78 69 74 20 31 29 29 29 29 0a 09 09 09 09 09 exit 1))))......
33b0: 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d (set! kill-
33c0: 74 72 69 65 73 20 28 2b 20 31 20 6b 69 6c 6c 2d tries (+ 1 kill-
33d0: 74 72 69 65 73 29 29 0a 09 09 09 09 09 20 20 20 tries))......
33e0: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
33f0: 20 6d 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 m))).....
3400: 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ;; (sqlite3:fin
3410: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 09 20 alize! db).....
3420: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c (thread-sl
3430: 65 65 70 21 20 28 2b 20 31 30 20 28 72 61 6e 64 eep! (+ 10 (rand
3440: 6f 6d 20 31 30 29 29 29 20 3b 3b 20 61 64 64 20 om 10))) ;; add
3450: 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 6f 20 74 some jitter to t
3460: 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d he call home tim
3470: 65 20 74 6f 20 73 70 72 65 61 64 20 6f 75 74 20 e to spread out
3480: 74 68 65 20 64 62 20 61 63 63 65 73 73 65 73 0a the db accesses.
3490: 09 09 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 .... (loop
34a0: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 (calc-minutes))
34b0: 29 29 29 29 29 0a 09 09 20 28 74 68 31 20 20 20 )))))... (th1
34c0: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 (make-thr
34d0: 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 ead monitorjob))
34e0: 0a 09 09 20 28 74 68 32 20 20 20 20 20 20 20 20 ... (th2
34f0: 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 (make-thread r
3500: 75 6e 69 74 29 29 29 0a 09 20 20 20 20 28 73 65 unit))).. (se
3510: 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 t! job-thread th
3520: 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 2).. (thread-
3530: 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 start! th1)..
3540: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
3550: 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 th2).. (threa
3560: 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 d-join! th2)..
3570: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
3580: 29 0a 09 20 20 20 20 3b 3b 20 28 73 65 74 21 20 ).. ;; (set!
3590: 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 20 db (open-db))..
35a0: 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 28 ;; (if (not (
35b0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
35c0: 65 72 76 65 72 22 29 29 0a 09 20 20 20 20 3b 3b erver")).. ;;
35d0: 09 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d .(server:client-
35e0: 73 65 74 75 70 20 64 62 29 29 0a 09 20 20 20 20 setup db))..
35f0: 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 (let* ((item-pat
3600: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
3610: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20 th itemdat))...
3620: 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28 64 62 (testinfo (db
3630: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
3640: 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 y-id db test-id)
3650: 29 29 20 3b 3b 20 29 29 20 3b 3b 20 72 75 6e 2d )) ;; )) ;; run-
3660: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
3670: 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 m-path)))..
3680: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
3690: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
36a0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) "
36b0: 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 COMPLETED"))...
36c0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 (begin... (d
36d0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 54 65 ebug:print 2 "Te
36e0: 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 st NOT logged as
36f0: 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 COMPLETED, (sta
3700: 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 te=" (db:test-ge
3710: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
3720: 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 72 ) "), updating r
3730: 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 74 esult, rollup-st
3740: 61 74 75 73 20 69 73 20 22 20 72 6f 6c 6c 75 70 atus is " rollup
3750: 2d 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 28 -status)... (
3760: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
3770: 20 64 62 20 74 65 73 74 2d 69 64 20 0a 09 09 09 db test-id ....
3780: 09 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d . (if kill-
3790: 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 job? "KILLED" "C
37a0: 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 09 20 OMPLETED").....
37b0: 20 20 20 20 20 3b 3b 20 4f 6c 64 20 6c 6f 67 69 ;; Old logi
37c0: 63 3a 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 c:..... ;;
37d0: 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (if (vector-ref
37e0: 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b 3b 20 exit-info 1) ;;
37f0: 6c 6f 6f 6b 20 61 74 20 74 68 65 20 65 78 69 74 look at the exit
3800: 2d 73 74 61 74 75 73 2c 20 23 74 20 6d 65 61 6e -status, #t mean
3810: 73 20 69 74 20 61 74 20 6c 65 61 73 74 20 72 61 s it at least ra
3820: 6e 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 n..... ;;
3830: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
3840: 20 6b 69 6c 6c 2d 6a 6f 62 3f 29 20 0a 09 09 09 kill-job?) ....
3850: 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 . ;;
3860: 20 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 (eq? (vector-r
3870: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
3880: 30 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 6e 6f 0)) ;; we can no
3890: 77 20 75 73 65 20 72 6f 6c 6c 75 70 2d 73 74 61 w use rollup-sta
38a0: 74 75 73 20 69 6e 73 74 65 61 64 0a 09 09 09 09 tus instead.....
38b0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
38c0: 20 22 50 41 53 53 22 0a 09 09 09 09 20 20 20 20 "PASS".....
38d0: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 22 46 41 ;; "FA
38e0: 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 20 3b IL")..... ;
38f0: 3b 20 20 20 20 20 22 46 41 49 4c 22 29 20 0a 09 ; "FAIL") ..
3900: 09 09 09 20 20 20 20 20 20 3b 3b 20 4e 65 77 20 ... ;; New
3910: 6c 6f 67 69 63 20 62 61 73 65 64 20 6f 6e 20 72 logic based on r
3920: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a 09 09 09 ollup-status....
3930: 09 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 . (cond....
3940: 09 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 76 . ((not (v
3950: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
3960: 6e 66 6f 20 31 29 29 20 22 46 41 49 4c 22 29 20 nfo 1)) "FAIL")
3970: 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f ;; job failed to
3980: 20 72 75 6e 0a 09 09 09 09 20 20 20 20 20 20 20 run.....
3990: 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 ((eq? rollup-sta
39a0: 74 75 73 20 30 29 0a 09 09 09 09 09 3b 3b 20 69 tus 0)......;; i
39b0: 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 f the current st
39c0: 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 atus is AUTO the
39d0: 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 defer to the ca
39e0: 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 28 lculated value (
39f0: 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 73 20 i.e. leave this
3a00: 41 55 54 4f 29 0a 09 09 09 09 09 28 69 66 20 28 AUTO)......(if (
3a10: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
3a20: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 get-status testi
3a30: 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 nfo) "AUTO") "AU
3a40: 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 09 09 TO" "PASS"))....
3a50: 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 6f . ((eq? ro
3a60: 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 22 llup-status 1) "
3a70: 46 41 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 FAIL").....
3a80: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
3a90: 74 61 74 75 73 20 32 29 0a 09 09 09 09 09 3b 3b tatus 2)......;;
3aa0: 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 if the current
3ab0: 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 status is AUTO t
3ac0: 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 he defer to the
3ad0: 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 calculated value
3ae0: 20 62 75 74 20 71 75 61 6c 69 66 79 20 28 69 2e but qualify (i.
3af0: 65 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 55 54 e. make this AUT
3b00: 4f 2d 57 41 52 4e 29 0a 09 09 09 09 09 28 69 66 O-WARN)......(if
3b10: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes
3b20: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
3b30: 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 tinfo) "AUTO") "
3b40: 41 55 54 4f 2d 57 41 52 4e 22 20 22 57 41 52 4e AUTO-WARN" "WARN
3b50: 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 "))..... (
3b60: 65 6c 73 65 20 22 46 41 49 4c 22 29 29 0a 09 09 else "FAIL"))...
3b70: 09 09 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 .. (args:ge
3b80: 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 t-arg "-m") #f))
3b90: 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 ).. ;; for
3ba0: 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 automated creati
3bb0: 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 on of the rollup
3bc0: 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 html file this
3bd0: 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e is a good place.
3be0: 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e .... (if (n
3bf0: 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d ot (equal? item-
3c00: 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 74 path ""))... (t
3c10: 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 ests:summarize-i
3c20: 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 74 tems db run-id t
3c30: 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b est-name #f)) ;;
3c40: 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a don't force - j
3c50: 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e 6f ust update if no
3c60: 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 28 .. ).. (
3c70: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 mutex-unlock! m)
3c80: 0a 09 20 20 20 20 3b 3b 20 28 65 78 65 63 2d 72 .. ;; (exec-r
3c90: 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e 2d esults (cmd-run-
3ca0: 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 72 >list fullrunscr
3cb0: 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 20 ipt)) ;; (list
3cc0: 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e ">" (conc test-n
3cd0: 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 ame "-run.log"))
3ce0: 29 29 0a 09 20 20 20 20 3b 3b 20 28 73 75 63 63 )).. ;; (succ
3cf0: 65 73 73 20 20 20 20 20 20 65 78 65 63 2d 72 65 ess exec-re
3d00: 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 sults)) ;; (eq?
3d10: 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 75 6c (cadr exec-resul
3d20: 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 28 64 ts) 0))).. (d
3d30: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 ebug:print 2 "Ou
3d40: 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e tput from runnin
3d50: 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 g " fullrunscrip
3d60: 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 74 t ", pid " (vect
3d70: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
3d80: 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 0) " in work ar
3d90: 65 61 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 ea " .... work-a
3da0: 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 rea ":\n====\n e
3db0: 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 63 74 xit code " (vect
3dc0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
3dd0: 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 2) "\n" "====\n
3de0: 22 29 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 ").. (sqlite3
3df0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
3e00: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
3e10: 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 20 20 20 alize! tdb)..
3e20: 20 28 69 66 20 28 6e 6f 74 20 28 76 65 63 74 6f (if (not (vecto
3e30: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
3e40: 31 29 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 1))...(exit 4)))
3e50: 29 29 29 29 0a 0a 3b 3b 20 73 65 74 20 75 70 20 ))))..;; set up
3e60: 74 68 65 20 76 65 72 79 20 62 61 73 69 63 73 20 the very basics
3e70: 6e 65 65 64 65 64 20 66 6f 72 20 64 6f 69 6e 67 needed for doing
3e80: 20 61 6e 79 74 68 69 6e 67 20 68 65 72 65 2e 0a anything here..
3e90: 28 64 65 66 69 6e 65 20 28 73 65 74 75 70 2d 66 (define (setup-f
3ea0: 6f 72 2d 72 75 6e 29 0a 20 20 3b 3b 20 77 6f 75 or-run). ;; wou
3eb0: 6c 64 20 73 65 74 20 76 61 6c 75 65 73 20 66 6f ld set values fo
3ec0: 72 20 4b 45 59 53 20 69 6e 20 74 68 65 20 65 6e r KEYS in the en
3ed0: 76 69 72 6f 6e 6d 65 6e 74 20 68 65 72 65 20 66 vironment here f
3ee0: 6f 72 20 62 65 74 74 65 72 20 73 75 70 70 6f 72 or better suppor
3ef0: 74 20 6f 66 20 65 6e 76 2d 6f 76 65 72 72 69 64 t of env-overrid
3f00: 65 20 62 75 74 20 0a 20 20 3b 3b 20 68 61 76 65 e but . ;; have
3f10: 20 63 68 69 63 6b 65 6e 2f 65 67 67 20 73 63 65 chicken/egg sce
3f20: 6e 61 72 69 6f 2e 20 6e 65 65 64 20 74 6f 20 72 nario. need to r
3f30: 65 61 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e ead megatest.con
3f40: 66 69 67 20 74 68 65 6e 20 72 65 61 64 20 69 74 fig then read it
3f50: 20 61 67 61 69 6e 2e 20 47 6f 69 6e 67 20 74 6f again. Going to
3f60: 20 0a 20 20 3b 3b 20 70 61 73 73 20 6f 6e 20 74 . ;; pass on t
3f70: 68 61 74 20 69 64 65 61 20 66 6f 72 20 6e 6f 77 hat idea for now
3f80: 0a 20 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 . ;; special ca
3f90: 73 65 0a 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 se. (set! *conf
3fa0: 69 67 69 6e 66 6f 2a 20 28 66 69 6e 64 2d 61 6e iginfo* (find-an
3fb0: 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 0a 09 d-read-config ..
3fc0: 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 . (if (args
3fd0: 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 :get-arg "-confi
3fe0: 67 22 29 28 61 72 67 73 3a 67 65 74 2d 61 72 67 g")(args:get-arg
3ff0: 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 "-config") "meg
4000: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 atest.config")..
4010: 09 20 20 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 . environ-p
4020: 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 att: "env-overri
4030: 64 65 22 0a 09 09 20 20 20 20 20 20 67 69 76 65 de"... give
4040: 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 65 74 2d n-toppath: (get-
4050: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
4060: 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 able "MT_RUN_ARE
4070: 41 5f 48 4f 4d 45 22 29 29 29 0a 20 20 28 73 65 A_HOME"))). (se
4080: 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 t! *configdat*
4090: 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 (if (car *config
40a0: 69 6e 66 6f 2a 29 28 63 61 72 20 2a 63 6f 6e 66 info*)(car *conf
40b0: 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 iginfo*) #f)).
40c0: 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 (set! *toppath*
40d0: 20 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e (if (car *con
40e0: 66 69 67 69 6e 66 6f 2a 29 28 63 61 64 72 20 2a figinfo*)(cadr *
40f0: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 configinfo*) #f)
4100: 29 0a 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 ). (if *toppath
4110: 2a 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 *. (setenv
4120: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
4130: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b E" *toppath*) ;;
4140: 20 74 6f 20 62 65 20 64 65 70 72 65 63 61 74 65 to be deprecate
4150: 64 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 d. (debug:p
4160: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 66 rint 0 "ERROR: f
4170: 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 68 ailed to find th
4180: 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 79 6f e top path to yo
4190: 75 72 20 72 75 6e 20 73 65 74 75 70 2e 22 29 29 ur run setup."))
41a0: 0a 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 0a 28 . *toppath*)..(
41b0: 64 65 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 define (get-best
41c0: 2d 64 69 73 6b 20 63 6f 6e 66 64 61 74 29 0a 20 -disk confdat).
41d0: 20 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 20 (let* ((disks
41e0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
41f0: 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 f/default confda
4200: 74 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 t "disks" #f))..
4210: 20 28 62 65 73 74 20 20 20 20 20 23 66 29 0a 09 (best #f)..
4220: 20 28 62 65 73 74 73 69 7a 65 20 30 29 29 0a 20 (bestsize 0)).
4230: 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 28 (if disks ..(
4240: 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d for-each .. (lam
4250: 62 64 61 20 28 64 69 73 6b 2d 6e 75 6d 29 0a 09 bda (disk-num)..
4260: 20 20 20 28 6c 65 74 2a 20 28 28 64 69 72 70 61 (let* ((dirpa
4270: 74 68 20 20 20 20 28 63 61 64 72 20 28 61 73 73 th (cadr (ass
4280: 6f 63 20 64 69 73 6b 2d 6e 75 6d 20 64 69 73 6b oc disk-num disk
4290: 73 29 29 29 0a 09 09 20 20 28 66 72 65 65 73 70 s)))... (freesp
42a0: 63 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 64 c (if (and (d
42b0: 69 72 65 63 74 6f 72 79 3f 20 64 69 72 70 61 74 irectory? dirpat
42c0: 68 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 66 h)..... (f
42d0: 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 ile-write-access
42e0: 3f 20 64 69 72 70 61 74 68 29 29 0a 09 09 09 09 ? dirpath)).....
42f0: 20 20 28 67 65 74 2d 64 66 20 64 69 72 70 61 74 (get-df dirpat
4300: 68 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a h)..... (begin.
4310: 09 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 .... (debug:p
4320: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
4330: 20 70 61 74 68 20 22 20 64 69 72 70 61 74 68 20 path " dirpath
4340: 22 20 69 6e 20 5b 64 69 73 6b 73 5d 20 73 65 63 " in [disks] sec
4350: 74 69 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 20 6f tion not valid o
4360: 72 20 77 72 69 74 61 62 6c 65 22 29 0a 09 09 09 r writable")....
4370: 09 20 20 20 20 30 29 29 29 29 0a 09 20 20 20 20 . 0))))..
4380: 20 28 69 66 20 28 3e 20 66 72 65 65 73 70 63 20 (if (> freespc
4390: 62 65 73 74 73 69 7a 65 29 0a 09 09 20 28 62 65 bestsize)... (be
43a0: 67 69 6e 0a 09 09 20 20 20 28 73 65 74 21 20 62 gin... (set! b
43b0: 65 73 74 20 20 20 20 20 64 69 72 70 61 74 68 29 est dirpath)
43c0: 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 73 74 ... (set! best
43d0: 73 69 7a 65 20 66 72 65 65 73 70 63 29 29 29 29 size freespc))))
43e0: 29 0a 09 20 28 6d 61 70 20 63 61 72 20 64 69 73 ).. (map car dis
43f0: 6b 73 29 29 29 0a 20 20 20 20 28 69 66 20 62 65 ks))). (if be
4400: 73 74 0a 09 62 65 73 74 0a 09 28 62 65 67 69 6e st..best..(begin
4410: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
4420: 20 30 20 22 45 52 52 4f 52 3a 20 4e 6f 20 76 61 0 "ERROR: No va
4430: 6c 69 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 lid disks found
4440: 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 in megatest.conf
4450: 69 67 2e 20 50 6c 65 61 73 65 20 61 64 64 20 73 ig. Please add s
4460: 6f 6d 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 ome to your [dis
4470: 6b 73 5d 20 73 65 63 74 69 6f 6e 22 29 0a 09 20 ks] section")..
4480: 20 28 65 78 69 74 20 31 29 29 29 29 29 0a 0a 3b (exit 1)))))..;
4490: 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 63 74 ; Desired direct
44a0: 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b ory structure:.;
44b0: 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 ;.;; <linkdir>
44c0: 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 - <target> - <te
44d0: 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 stname> -..;;
44e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 |.;;
4510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4520: 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 v.;;
4530: 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 <rundir> - <t
4540: 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 arget> - <te
4550: 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 stname> -|- <ite
4560: 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 mpath(s)>.;;.;;
4570: 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 dir stored in t
4580: 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 est is:.;; .;;
4590: 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 <linkdir> - <tar
45a0: 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 get> - <testname
45b0: 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e > [ - <itempath>
45c0: 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f ].;; .;; All lo
45d0: 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f g file links sho
45e0: 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 uld be stored re
45f0: 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f lative to the to
4600: 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b p of link path.;
4610: 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 ; .;; <target>
4620: 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d - <testname> [ -
4630: 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b <itempath> ] .;
4640: 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 ;.(define (creat
4650: 65 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 e-work-area db r
4660: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 un-id test-id te
4670: 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b st-src-path disk
4680: 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 -path testname i
4690: 74 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 temdat). (let*
46a0: 28 28 72 75 6e 2d 69 6e 66 6f 20 28 64 62 3a 67 ((run-info (db:g
46b0: 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 et-run-info db r
46c0: 75 6e 2d 69 64 29 29 0a 09 20 28 69 74 65 6d 2d un-id)).. (item-
46d0: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
46e0: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
46f0: 09 20 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a . (runname (db:
4700: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
4710: 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 der (db:get-row
4720: 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 run-info)......
4730: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header
4740: 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 run-info)......
4750: 20 20 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 "runname"))..
4760: 20 3b 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 6b ;; convert back
4770: 20 74 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 to db: from rdb
4780: 3a 20 2d 20 74 68 69 73 20 69 73 20 61 6c 77 61 : - this is alwa
4790: 79 73 20 72 75 6e 20 61 74 20 73 65 72 76 65 72 ys run at server
47a0: 20 65 6e 64 0a 09 20 28 6b 65 79 2d 76 61 6c 73 end.. (key-vals
47b0: 20 28 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c (db:get-key-val
47c0: 73 20 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 20 s db run-id))..
47d0: 28 74 61 72 67 65 74 20 20 20 28 73 74 72 69 6e (target (strin
47e0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
47f0: 79 2d 76 61 6c 73 20 22 2f 22 29 29 0a 0a 09 20 y-vals "/"))...
4800: 28 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 (not-iterated (
4810: 65 71 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 equal? "" item-p
4820: 61 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 ath))... ;; all
4830: 74 65 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 tests are found
4840: 61 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 at <rundir>/test
4850: 2d 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 -base or <linkdi
4860: 72 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 r>/test-base.. (
4870: 74 65 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f testtop-base (co
4880: 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 nc target "/" ru
4890: 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
48a0: 6d 65 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 me)).. (test-bas
48b0: 65 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 e (conc testt
48c0: 6f 70 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d op-base (if not-
48d0: 69 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 iterated "" "/")
48e0: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 item-path))...
48f0: 3b 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 ;; nb// if itemp
4900: 61 74 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 ath is not "" th
4910: 65 6e 20 69 74 20 69 73 20 70 72 65 66 69 78 65 en it is prefixe
4920: 64 20 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f d with "/".. (to
4930: 70 74 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 ptest-path (conc
4940: 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 disk-path "/" t
4950: 65 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 esttop-base))..
4960: 28 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 (test-path (c
4970: 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f onc disk-path "/
4980: 22 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 " test-base))...
4990: 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 ;; ensure this
49a0: 65 78 69 73 74 73 20 66 69 72 73 74 20 61 73 20 exists first as
49b0: 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 links to subtest
49c0: 73 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 s must be create
49d0: 64 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 d there.. (linkt
49e0: 72 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 ree (let ((rd (
49f0: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
4a00: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
4a10: 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a " "linktree"))).
4a20: 09 09 20 20 20 20 20 28 69 66 20 72 64 20 72 64 .. (if rd rd
4a30: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
4a40: 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 "/runs"))))...
4a50: 28 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 (lnkbase (conc
4a60: 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 linktree "/" tar
4a70: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 get "/" runname)
4a80: 29 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 ).. (lnkpath (c
4a90: 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 onc lnkbase "/"
4aa0: 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e testname)).. (ln
4ab0: 6b 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b kpathf (conc lnk
4ac0: 70 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 path (if not-ite
4ad0: 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 rated "" "/") it
4ae0: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 em-path)))..
4af0: 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 75 ;; Update the ru
4b00: 6e 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 ndir path in the
4b10: 20 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 test record for
4b20: 20 61 6c 6c 0a 20 20 20 20 28 64 62 3a 74 65 73 all. (db:tes
4b30: 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 64 62 t-set-rundir! db
4b40: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
4b50: 20 69 74 65 6d 2d 70 61 74 68 20 6c 6e 6b 70 61 item-path lnkpa
4b60: 74 68 66 29 0a 0a 20 20 20 20 28 64 65 62 75 67 thf).. (debug
4b70: 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 5c :print 2 "INFO:\
4b80: 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d n lnkbase=
4b90: 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 " lnkbase "\n
4ba0: 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e lnkpath=" ln
4bb0: 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 kpath "\n topte
4bc0: 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 st-path=" toptes
4bd0: 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 t-path "\n t
4be0: 65 73 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d est-path=" test-
4bf0: 70 61 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e path). (if (n
4c00: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
4c10: 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 linktree))..(be
4c20: 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 gin.. (debug:pr
4c30: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
4c40: 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 6e 6f 74 linktree did not
4c50: 20 65 78 69 73 74 21 20 43 72 65 61 74 69 6e 67 exist! Creating
4c60: 20 69 74 20 6e 6f 77 20 61 74 20 22 20 6c 69 6e it now at " lin
4c70: 6b 74 72 65 65 29 0a 09 20 20 28 63 72 65 61 74 ktree).. (creat
4c80: 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b e-directory link
4c90: 74 72 65 65 20 23 74 29 29 29 20 3b 3b 20 28 73 tree #t))) ;; (s
4ca0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 ystem (conc "mkd
4cb0: 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 65 65 ir -p " linktree
4cc0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 65 61 )))). ;; crea
4cd0: 74 65 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 te the directory
4ce0: 20 66 6f 72 20 74 68 65 20 74 65 73 74 73 20 64 for the tests d
4cf0: 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 20 69 ir links, this i
4d00: 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 74 74 s needed no matt
4d10: 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 20 28 er what.... (
4d20: 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f if (not (directo
4d30: 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 ry-exists? lnkba
4d40: 73 65 29 29 0a 09 28 63 72 65 61 74 65 2d 64 69 se))..(create-di
4d50: 72 65 63 74 6f 72 79 20 6c 6e 6b 62 61 73 65 20 rectory lnkbase
4d60: 23 74 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b #t)). . ;;
4d70: 20 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 74 update the topt
4d80: 65 73 74 20 72 65 63 6f 72 64 20 77 69 74 68 20 est record with
4d90: 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 75 6e its location run
4da0: 64 69 72 2c 20 63 61 63 68 65 20 74 68 65 20 70 dir, cache the p
4db0: 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 73 20 ath. ;; This
4dc0: 77 61 73 73 20 68 69 67 68 6c 79 20 69 6e 65 66 wass highly inef
4dd0: 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 62 20 ficient, one db
4de0: 77 72 69 74 65 20 66 6f 72 20 65 76 65 72 79 20 write for every
4df0: 73 75 62 74 65 73 74 2c 20 70 6f 74 65 6e 74 69 subtest, potenti
4e00: 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 6f 75 ally. ;; thou
4e10: 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 65 73 sands of unneces
4e20: 73 61 72 79 20 75 70 64 61 74 65 73 2c 20 63 61 sary updates, ca
4e30: 63 68 65 20 74 68 65 20 66 61 63 74 20 69 74 20 che the fact it
4e40: 77 61 73 20 73 65 74 20 61 6e 64 20 64 6f 6e 27 was set and don'
4e50: 74 20 73 65 74 20 69 74 20 0a 20 20 20 20 3b 3b t set it . ;;
4e60: 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b again. .. ;;
4e70: 20 4e 42 20 2d 20 54 68 69 73 20 69 73 20 6e 6f NB - This is no
4e80: 74 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 t working right
4e90: 2d 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 - some top tests
4ea0: 20 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 are not getting
4eb0: 20 74 68 65 20 70 61 74 68 20 73 65 74 21 21 21 the path set!!!
4ec0: 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
4ed0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
4ee0: 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 74 2d efault *toptest-
4ef0: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
4f00: 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 #f))..(let* ((te
4f10: 73 74 69 6e 66 6f 20 20 20 20 20 20 20 28 64 62 stinfo (db
4f20: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
4f30: 79 2d 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 y-id db test-id)
4f40: 29 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 ) ;; run-id tes
4f50: 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 tname item-path)
4f60: 29 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 2d ).. (curr-
4f70: 74 65 73 74 2d 70 61 74 68 20 28 69 66 20 74 65 test-path (if te
4f80: 73 74 69 6e 66 6f 20 28 64 62 3a 74 65 73 74 2d stinfo (db:test-
4f90: 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 69 get-rundir testi
4fa0: 6e 66 6f 29 20 23 66 29 29 29 0a 09 20 20 28 68 nfo) #f))).. (h
4fb0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
4fc0: 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 toptest-paths* t
4fd0: 65 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 estname curr-tes
4fe0: 74 2d 70 61 74 68 29 0a 09 20 20 28 64 62 3a 74 t-path).. (db:t
4ff0: 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 est-set-rundir!
5000: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
5010: 6d 65 20 22 22 20 6c 6e 6b 70 61 74 68 29 20 3b me "" lnkpath) ;
5020: 3b 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 0a ; toptest-path).
5030: 09 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 . (if (or (not
5040: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a curr-test-path).
5050: 09 09 20 20 28 6e 6f 74 20 28 64 69 72 65 63 74 .. (not (direct
5060: 6f 72 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 74 ory-exists? topt
5070: 65 73 74 2d 70 61 74 68 29 29 29 0a 09 20 20 20 est-path)))..
5080: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
5090: 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f ug:print 2 "INFO
50a0: 3a 20 43 72 65 61 74 69 6e 67 20 22 20 74 6f 70 : Creating " top
50b0: 74 65 73 74 2d 70 61 74 68 20 22 20 61 6e 64 20 test-path " and
50c0: 6c 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 29 0a link " lnkpath).
50d0: 09 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ..(create-direct
50e0: 6f 72 79 20 74 6f 70 74 65 73 74 2d 70 61 74 68 ory toptest-path
50f0: 20 23 74 29 0a 09 09 28 68 61 73 68 2d 74 61 62 #t)...(hash-tab
5100: 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 le-set! *toptest
5110: 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 -paths* testname
5120: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 toptest-path)))
5130: 29 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f 77 20 63 )).. ;; Now c
5140: 72 65 61 74 65 20 74 68 65 20 6c 69 6e 6b 20 66 reate the link f
5150: 72 6f 6d 20 74 68 65 20 74 65 73 74 20 70 61 74 rom the test pat
5160: 68 20 74 6f 20 74 68 65 20 6c 69 6e 6b 20 74 72 h to the link tr
5170: 65 65 2c 20 68 6f 77 65 76 65 72 0a 20 20 20 20 ee, however.
5180: 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 69 ;; if the test i
5190: 73 20 69 74 65 72 61 74 65 64 20 69 74 20 69 73 s iterated it is
51a0: 20 6e 65 63 65 73 73 61 72 79 20 74 6f 20 63 72 necessary to cr
51b0: 65 61 74 65 20 74 68 65 20 70 61 72 65 6e 74 20 eate the parent
51c0: 70 61 74 68 0a 20 20 20 20 3b 3b 20 74 6f 20 74 path. ;; to t
51d0: 68 65 20 69 74 65 72 61 74 69 6f 6e 2e 20 75 73 he iteration. us
51e0: 65 20 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 e pathname-direc
51f0: 74 6f 72 79 20 74 6f 20 74 72 69 6d 20 74 68 65 tory to trim the
5200: 20 70 61 74 68 20 62 79 20 6f 6e 65 0a 20 20 20 path by one.
5210: 20 3b 3b 20 6c 65 76 65 6c 0a 20 20 20 20 28 69 ;; level. (i
5220: 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 f (not not-itera
5230: 74 65 64 29 20 3b 3b 20 69 2e 65 2e 20 69 74 65 ted) ;; i.e. ite
5240: 72 61 74 65 64 0a 09 28 6c 65 74 20 28 28 69 74 rated..(let ((it
5250: 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 20 28 erated-parent (
5260: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
5270: 72 79 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 ry (conc lnkpath
5280: 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 "/" item-path))
5290: 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
52a0: 6e 74 20 32 20 22 49 4e 46 4f 3a 20 43 72 65 61 nt 2 "INFO: Crea
52b0: 74 69 6e 67 20 69 74 65 72 61 74 65 64 20 70 61 ting iterated pa
52c0: 72 65 6e 74 20 22 20 69 74 65 72 61 74 65 64 2d rent " iterated-
52d0: 70 61 72 65 6e 74 29 0a 09 20 20 28 63 72 65 61 parent).. (crea
52e0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 65 te-directory ite
52f0: 72 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 29 rated-parent #t)
5300: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
5310: 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (or (file-exists
5320: 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 ? lnkpath)... (s
5330: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e ymbolic-link? ln
5340: 6b 70 61 74 68 29 29 29 0a 09 28 63 72 65 61 74 kpath)))..(creat
5350: 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 e-symbolic-link
5360: 74 6f 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b toptest-path lnk
5370: 70 61 74 68 29 29 0a 20 20 20 20 0a 20 20 20 20 path)). .
5380: 3b 3b 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 ;; The toptest p
5390: 61 74 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 ath has been cre
53a0: 61 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 ated, the link t
53b0: 6f 20 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 o the test in th
53c0: 65 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 e linktree has.
53d0: 20 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 ;; been creat
53e0: 65 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 ed. Now, if this
53f0: 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 is an iterated
5400: 74 65 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 test the real te
5410: 73 74 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 st dir must be c
5420: 72 65 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 reated. (if (
5430: 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 not not-iterated
5440: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 ) ;; this is an
5450: 69 74 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 iterated test..(
5460: 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 let ((lnktarget
5470: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
5480: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 " item-path)))..
5490: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
54a0: 20 22 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 "Setting up sub
54b0: 20 74 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 test run area")
54c0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
54d0: 20 32 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 2 " - creating
54e0: 72 75 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 run area in " te
54f0: 73 74 2d 70 61 74 68 29 0a 09 20 20 28 63 72 65 st-path).. (cre
5500: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 ate-directory te
5510: 73 74 2d 70 61 74 68 20 23 74 29 20 3b 3b 20 28 st-path #t) ;; (
5520: 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d system (conc "m
5530: 6b 64 69 72 20 2d 70 20 22 20 74 65 73 74 2d 70 kdir -p " test-p
5540: 61 74 68 29 29 0a 09 20 20 28 64 65 62 75 67 3a ath)).. (debug:
5550: 70 72 69 6e 74 20 32 20 0a 09 09 20 20 20 20 20 print 2 ...
5560: 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c " - creating l
5570: 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 ink from: " test
5580: 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 -path "\n"...
5590: 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 20 "
55a0: 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e to: " ln
55b0: 6b 74 61 72 67 65 74 29 0a 09 20 20 3b 3b 20 28 ktarget).. ;; (
55c0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
55d0: 20 6c 6e 6b 70 61 74 68 20 23 74 29 20 3b 3b 20 lnkpath #t) ;;
55e0: 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 (system (conc "
55f0: 6d 6b 64 69 72 20 2d 70 20 22 20 6c 6e 6b 70 61 mkdir -p " lnkpa
5600: 74 68 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 th)).. (if (not
5610: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c (file-exists? l
5620: 6e 6b 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 nktarget))..
5630: 20 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c (create-symbol
5640: 69 63 2d 6c 69 6e 6b 20 74 65 73 74 2d 70 61 74 ic-link test-pat
5650: 68 20 6c 6e 6b 74 61 72 67 65 74 29 29 29 29 0a h lnktarget)))).
5660: 0a 20 20 20 20 3b 3b 20 49 20 73 75 73 70 65 63 . ;; I suspec
5670: 74 20 74 68 69 73 20 73 65 63 74 69 6f 6e 20 77 t this section w
5680: 61 73 20 64 65 6c 65 74 69 6e 67 20 74 65 73 74 as deleting test
5690: 20 64 69 72 65 63 74 6f 72 69 65 73 20 75 6e 64 directories und
56a0: 65 72 20 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 er some . ;;
56b0: 77 69 65 72 64 20 73 69 74 61 74 69 6f 6e 73 3f wierd sitations?
56c0: 20 54 68 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 This doesn't ma
56d0: 6b 65 20 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 ke sense - reena
56e0: 62 6c 69 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 bling the rm -f
56f0: 0a 20 20 20 20 3b 3b 20 49 20 68 6f 6e 65 73 74 . ;; I honest
5700: 6c 79 20 64 6f 6e 27 74 20 72 65 6d 65 6d 62 65 ly don't remembe
5710: 72 20 2a 77 68 79 2a 20 74 68 69 73 20 63 68 75 r *why* this chu
5720: 6e 6b 20 77 61 73 20 6e 65 65 64 65 64 2e 2e 2e nk was needed...
5730: 0a 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 74 . ;; (let ((t
5740: 65 73 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e estlink (conc ln
5750: 6b 70 61 74 68 20 22 2f 22 20 74 65 73 74 6e 61 kpath "/" testna
5760: 6d 65 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 me))). ;; (
5770: 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 if (and (file-ex
5780: 69 73 74 73 3f 20 74 65 73 74 6c 69 6e 6b 29 0a ists? testlink).
5790: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
57a0: 20 20 28 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 (or (regular-f
57b0: 69 6c 65 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 ile? testlink).
57c0: 20 20 20 3b 3b 20 20 20 20 20 09 20 20 20 28 73 ;; . (s
57d0: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 74 65 ymbolic-link? te
57e0: 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b stlink))). ;;
57f0: 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 (system (
5800: 63 6f 6e 63 20 22 72 6d 20 2d 66 20 22 20 74 65 conc "rm -f " te
5810: 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b stlink))). ;;
5820: 20 20 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e (system (con
5830: 63 20 22 6c 6e 20 2d 73 66 20 22 20 74 65 73 74 c "ln -sf " test
5840: 2d 70 61 74 68 20 22 20 22 20 74 65 73 74 6c 69 -path " " testli
5850: 6e 6b 29 29 29 0a 20 20 20 20 28 69 66 20 28 64 nk))). (if (d
5860: 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 irectory? test-p
5870: 61 74 68 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ath)..(begin..
5880: 28 6c 65 74 2a 20 28 28 63 6d 64 20 20 20 20 28 (let* ((cmd (
5890: 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d 61 76 22 conc "rsync -av"
58a0: 20 28 69 66 20 28 3e 20 2a 76 65 72 62 6f 73 69 (if (> *verbosi
58b0: 74 79 2a 20 31 29 20 22 22 20 22 71 22 29 20 22 ty* 1) "" "q") "
58c0: 20 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 " test-src-path
58d0: 20 22 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 "/ " test-path
58e0: 22 2f 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 "/"))... (status
58f0: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a (system cmd))).
5900: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
5910: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))...
5920: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
5930: 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 ERROR: problem w
5940: 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 ith running \""
5950: 63 6d 64 20 22 5c 22 22 29 29 29 0a 09 20 20 28 cmd "\""))).. (
5960: 6c 69 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e list lnkpathf ln
5970: 6b 70 61 74 68 20 29 29 0a 09 28 6c 69 73 74 20 kpath ))..(list
5980: 23 66 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e #f #f))))..;; 1.
5990: 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 look though dis
59a0: 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b ks list for disk
59b0: 20 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 with most space
59c0: 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 .;; 2. create ru
59d0: 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 n dir on disk, p
59e0: 61 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e ath name is mean
59f0: 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 ingful.;; 3. cre
5a00: 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 ate link from ru
5a10: 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 n dir to megates
5a20: 74 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 t runs area .;;
5a30: 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 4. remotely run
5a40: 74 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f the test on allo
5a50: 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 cated host.;;
5a60: 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 - could be ssh
5a70: 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 to host from hos
5a80: 74 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 ts table (update
5a90: 20 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 regularly with
5aa0: 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f load).;; - co
5ab0: 75 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a uld be netbatch.
5ac0: 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d ;; (launch-
5ad0: 74 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 test db (cadr st
5ae0: 61 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 atus) test-conf)
5af0: 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ).(define (launc
5b00: 68 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 h-test db run-id
5b10: 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f runname test-co
5b20: 6e 66 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 nf keyvallst tes
5b30: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 t-name test-path
5b40: 20 69 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 itemdat params)
5b50: 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
5b60: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a tory *toppath*).
5b70: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
5b80: 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 rs ;; consolidat
5b90: 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 e this code with
5ba0: 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 the code in meg
5bb0: 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d atest.scm for "-
5bc0: 65 78 65 63 75 74 65 22 0a 20 20 20 28 6c 69 73 execute". (lis
5bd0: 74 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 t ;; (list "MT_T
5be0: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
5bf0: 6b 2d 61 72 65 61 29 0a 09 20 28 6c 69 73 74 20 k-area).. (list
5c00: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
5c10: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 20 E" *toppath*)..
5c20: 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e (list "MT_TEST_N
5c30: 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a AME" test-name).
5c40: 09 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 . ;; (list "MT_I
5c50: 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 TEM_INFO" (conc
5c60: 69 74 65 6d 64 61 74 29 29 20 0a 09 20 28 6c 69 itemdat)) .. (li
5c70: 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 st "MT_RUNNAME"
5c80: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 3b 3b 20 runname).. ;;
5c90: 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 (list "MT_TARGET
5ca0: 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a " mt_target).
5cb0: 09 20 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 75 . )). (let* ((u
5cc0: 73 65 73 68 65 6c 6c 20 20 20 28 63 6f 6e 66 69 seshell (confi
5cd0: 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 g-lookup *config
5ce0: 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 dat* "jobtools"
5cf0: 20 20 20 20 22 75 73 65 73 68 65 6c 6c 22 29 29 "useshell"))
5d00: 0a 09 20 28 6c 61 75 6e 63 68 65 72 20 20 20 28 .. (launcher (
5d10: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
5d20: 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f onfigdat* "jobto
5d30: 6f 6c 73 22 20 20 20 20 20 22 6c 61 75 6e 63 68 ols" "launch
5d40: 65 72 22 29 29 0a 09 20 28 72 75 6e 73 63 72 69 er")).. (runscri
5d50: 70 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b pt (config-look
5d60: 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 up test-conf "
5d70: 73 65 74 75 70 22 20 20 20 20 20 20 20 20 22 72 setup" "r
5d80: 75 6e 73 63 72 69 70 74 22 29 29 0a 09 20 28 65 unscript")).. (e
5d90: 7a 73 74 65 70 73 20 20 20 20 28 3e 20 28 6c 65 zsteps (> (le
5da0: 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 ngth (hash-table
5db0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 -ref/default tes
5dc0: 74 2d 63 6f 6e 66 20 22 65 7a 73 74 65 70 73 22 t-conf "ezsteps"
5dd0: 20 27 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f '())) 0)) ;; do
5de0: 6e 27 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 n't send all the
5df0: 20 73 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 steps, could be
5e00: 20 62 69 67 0a 09 20 28 64 69 73 6b 73 70 61 63 big.. (diskspac
5e10: 65 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 e (config-looku
5e20: 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 p test-conf "r
5e30: 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 64 69 equirements" "di
5e40: 73 6b 73 70 61 63 65 22 29 29 0a 09 20 28 6d 65 skspace")).. (me
5e50: 6d 6f 72 79 20 20 20 20 20 28 63 6f 6e 66 69 67 mory (config
5e60: 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e -lookup test-con
5e70: 66 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 f "requirement
5e80: 73 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 20 s" "memory"))..
5e90: 28 68 6f 73 74 73 20 20 20 20 20 20 28 63 6f 6e (hosts (con
5ea0: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
5eb0: 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 igdat* "jobtools
5ec0: 22 20 20 20 20 20 22 77 6f 72 6b 68 6f 73 74 73 " "workhosts
5ed0: 22 29 29 0a 09 20 28 72 65 6d 6f 74 65 2d 6d 65 ")).. (remote-me
5ee0: 67 61 74 65 73 74 20 28 63 6f 6e 66 69 67 2d 6c gatest (config-l
5ef0: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
5f00: 2a 20 22 73 65 74 75 70 22 20 22 65 78 65 63 75 * "setup" "execu
5f10: 74 61 62 6c 65 22 29 29 0a 09 20 3b 3b 20 46 49 table")).. ;; FI
5f20: 58 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 XME SOMEDAY: not
5f30: 20 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 69 good how this i
5f40: 73 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 69 s so obtuse, thi
5f50: 73 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 20 s hack is to ..
5f60: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
5f70: 20 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 allow running
5f80: 66 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e 20 from dashboard.
5f90: 45 78 74 72 61 63 74 20 74 68 65 20 70 61 74 68 Extract the path
5fa0: 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 .. ;;
5fb0: 20 20 20 20 20 66 72 6f 6d 20 74 68 65 20 63 61 from the ca
5fc0: 6c 6c 65 64 20 6d 65 67 61 74 65 73 74 20 61 6e lled megatest an
5fd0: 64 20 63 6f 6e 76 65 72 74 20 64 61 73 68 62 6f d convert dashbo
5fe0: 61 72 64 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 ard.. ;;
5ff0: 20 20 20 20 20 09 20 20 6f 72 20 64 62 6f 61 72 . or dboar
6000: 64 20 74 6f 20 6d 65 67 61 74 65 73 74 0a 09 20 d to megatest..
6010: 28 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 20 (local-megatest
6020: 20 28 6c 65 74 2a 20 28 28 6c 6d 20 20 28 63 61 (let* ((lm (ca
6030: 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 20 r (argv))).....
6040: 28 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 (dir (pathname-d
6050: 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 0a 09 09 irectory lm))...
6060: 09 09 20 28 65 78 65 20 28 70 61 74 68 6e 61 6d .. (exe (pathnam
6070: 65 2d 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 e-strip-director
6080: 79 20 6c 6d 29 29 29 0a 09 09 09 20 20 20 20 28 y lm))).... (
6090: 63 6f 6e 63 20 28 69 66 20 64 69 72 20 28 63 6f conc (if dir (co
60a0: 6e 63 20 64 69 72 20 22 2f 22 29 20 22 22 29 0a nc dir "/") "").
60b0: 09 09 09 09 20 20 28 63 61 73 65 20 28 73 74 72 .... (case (str
60c0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 65 78 65 29 ing->symbol exe)
60d0: 0a 09 09 09 09 20 20 20 20 28 28 64 62 6f 61 72 ..... ((dboar
60e0: 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 d) "megatest")..
60f0: 09 09 09 20 20 20 20 28 28 64 61 73 68 62 6f 61 ... ((dashboa
6100: 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a rd) "megatest").
6110: 09 09 09 09 20 20 20 20 28 65 6c 73 65 20 65 78 .... (else ex
6120: 65 29 29 29 29 29 0a 09 20 28 74 65 73 74 2d 73 e))))).. (test-s
6130: 69 67 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d ig (conc test-
6140: 6e 61 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c name ":" (item-l
6150: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
6160: 74 29 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 t))) ;; test-pat
6170: 68 20 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 h is the full pa
6180: 74 68 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 th including the
6190: 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f item-path.. (wo
61a0: 72 6b 2d 61 72 65 61 20 20 23 66 29 0a 09 20 28 rk-area #f).. (
61b0: 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 toptest-work-are
61c0: 61 20 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 a #f) ;; for ite
61d0: 72 61 74 65 64 20 74 65 73 74 73 20 74 68 65 20 rated tests the
61e0: 74 6f 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e top test contain
61f0: 73 20 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 s data relevant
6200: 66 6f 72 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 for all.. (diskp
6210: 61 74 68 20 20 20 23 66 29 0a 09 20 28 63 6d 64 ath #f).. (cmd
6220: 70 61 72 6d 73 20 20 20 23 66 29 0a 09 20 28 66 parms #f).. (f
6230: 75 6c 6c 63 6d 64 20 20 20 20 23 66 29 20 3b 3b ullcmd #f) ;;
6240: 20 28 64 65 66 69 6e 65 20 61 20 28 77 69 74 68 (define a (with
6250: 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e -output-to-strin
6260: 67 20 28 6c 61 6d 62 64 61 20 28 29 28 77 72 69 g (lambda ()(wri
6270: 74 65 20 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 te x)))).. (mt-b
6280: 69 6e 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 indir-path #f)..
6290: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 (item-path (ite
62a0: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
62b0: 6d 64 61 74 29 29 0a 09 20 28 74 65 73 74 2d 69 mdat)).. (test-i
62c0: 64 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 d (db:get-tes
62d0: 74 2d 69 64 20 64 62 20 72 75 6e 2d 69 64 20 74 t-id db run-id t
62e0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
62f0: 74 68 29 29 0a 09 20 28 74 65 73 74 69 6e 66 6f th)).. (testinfo
6300: 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 2d (db:get-test-
6310: 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 20 74 65 info-by-id db te
6320: 73 74 2d 69 64 29 29 0a 09 20 28 6d 74 5f 74 61 st-id)).. (mt_ta
6330: 72 67 65 74 20 20 28 73 74 72 69 6e 67 2d 69 6e rget (string-in
6340: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c
6350: 61 64 72 20 6b 65 79 76 61 6c 6c 73 74 29 20 22 adr keyvallst) "
6360: 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d 70 61 /")).. (debug-pa
6370: 72 61 6d 20 28 69 66 20 28 61 72 67 73 3a 67 65 ram (if (args:ge
6380: 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 28 t-arg "-debug")(
6390: 6c 69 73 74 20 22 2d 64 65 62 75 67 22 20 28 61 list "-debug" (a
63a0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 rgs:get-arg "-de
63b0: 62 75 67 22 29 29 20 27 28 29 29 29 29 0a 20 20 bug")) '()))).
63c0: 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 (if hosts (set
63d0: 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d ! hosts (string-
63e0: 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 split hosts))).
63f0: 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 ;; set the me
6400: 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c gatest to be cal
6410: 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 led on the remot
6420: 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 e host. (if (
6430: 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 not remote-megat
6440: 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 est)(set! remote
6450: 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d -megatest local-
6460: 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d megatest)) ;; "m
6470: 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 egatest")). (
6480: 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 set! mt-bindir-p
6490: 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 ath (pathname-di
64a0: 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d rectory remote-m
64b0: 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 egatest)). (i
64c0: 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 f launcher (set!
64d0: 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e launcher (strin
64e0: 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 g-split launcher
64f0: 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 ))). ;; set u
6500: 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 p the run work a
6510: 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 rea for this tes
6520: 74 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 6b t. (set! disk
6530: 70 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 path (get-best-d
6540: 69 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 isk *configdat*)
6550: 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 ). (if diskpa
6560: 74 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 20 th..(let ((dat
6570: 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 (create-work-are
6580: 61 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 a db run-id test
6590: 2d 69 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 -id test-path di
65a0: 73 6b 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 skpath test-name
65b0: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 itemdat))).. (
65c0: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
65d0: 63 61 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 car dat)).. (se
65e0: 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d t! toptest-work-
65f0: 61 72 65 61 20 28 63 61 64 72 20 64 61 74 29 29 area (cadr dat))
6600: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
6610: 20 32 20 22 49 4e 46 4f 3a 20 55 73 69 6e 67 20 2 "INFO: Using
6620: 77 6f 72 6b 20 61 72 65 61 20 22 20 77 6f 72 6b work area " work
6630: 2d 61 72 65 61 29 29 0a 09 28 62 65 67 69 6e 0a -area))..(begin.
6640: 09 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 . (set! work-ar
6650: 65 61 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 ea (conc test-pa
6660: 74 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a th "/tmp_run")).
6670: 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 . (create-direc
6680: 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 tory work-area #
6690: 74 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 t).. (debug:pri
66a0: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e nt 0 "WARNING: N
66b0: 6f 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 o disk work area
66c0: 20 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 6e specified - run
66d0: 6e 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 74 ning in the test
66e0: 20 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 72 directory under
66f0: 20 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 tmp_run"))).
6700: 20 28 73 65 74 21 20 63 6d 64 70 61 72 6d 73 20 (set! cmdparms
6710: 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 65 (base64:base64-e
6720: 6e 63 6f 64 65 20 28 77 69 74 68 2d 6f 75 74 70 ncode (with-outp
6730: 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 09 09 09 ut-to-string....
6740: 09 09 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 .. (lambda ()
6750: 3b 3b 20 28 6c 69 73 74 20 27 68 6f 73 74 73 20 ;; (list 'hosts
6760: 20 20 20 20 68 6f 73 74 73 29 0a 09 09 09 09 09 hosts)......
6770: 20 20 20 20 20 28 77 72 69 74 65 20 28 6c 69 73 (write (lis
6780: 74 20 28 6c 69 73 74 20 27 74 65 73 74 70 61 74 t (list 'testpat
6790: 68 20 20 74 65 73 74 2d 70 61 74 68 29 0a 09 09 h test-path)...
67a0: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 74 6f ..... (list 'to
67b0: 70 70 61 74 68 20 20 20 2a 74 6f 70 70 61 74 68 ppath *toppath
67c0: 2a 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 *)........ (lis
67d0: 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 77 6f 72 t 'work-area wor
67e0: 6b 2d 61 72 65 61 29 0a 09 09 09 09 09 09 09 20 k-area)........
67f0: 20 28 6c 69 73 74 20 27 74 65 73 74 2d 6e 61 6d (list 'test-nam
6800: 65 20 74 65 73 74 2d 6e 61 6d 65 29 20 0a 09 09 e test-name) ...
6810: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 72 75 ..... (list 'ru
6820: 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 nscript runscrip
6830: 74 29 20 0a 09 09 09 09 09 09 09 20 20 28 6c 69 t) ........ (li
6840: 73 74 20 27 72 75 6e 2d 69 64 20 20 20 20 72 75 st 'run-id ru
6850: 6e 2d 69 64 20 20 20 29 0a 09 09 09 09 09 09 09 n-id )........
6860: 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d 69 64 (list 'test-id
6870: 20 20 20 74 65 73 74 2d 69 64 20 20 29 0a 09 09 test-id )...
6880: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 69 74 ..... (list 'it
6890: 65 6d 64 61 74 20 20 20 69 74 65 6d 64 61 74 20 emdat itemdat
68a0: 20 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 )........ (lis
68b0: 74 20 27 6d 65 67 61 74 65 73 74 20 20 72 65 6d t 'megatest rem
68c0: 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 0a 09 09 ote-megatest)...
68d0: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 65 7a ..... (list 'ez
68e0: 73 74 65 70 73 20 20 20 65 7a 73 74 65 70 73 29 steps ezsteps)
68f0: 20 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 ........ (list
6900: 20 27 74 61 72 67 65 74 20 20 20 20 6d 74 5f 74 'target mt_t
6910: 61 72 67 65 74 29 0a 09 09 09 09 09 09 09 20 20 arget)........
6920: 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 (list 'env-ovrd
6930: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
6940: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
6950: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
6960: 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 09 de" '())) ......
6970: 09 09 20 20 28 6c 69 73 74 20 27 73 65 74 2d 76 .. (list 'set-v
6980: 61 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 20 ars (if params
6990: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
69a0: 64 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 22 default params "
69b0: 2d 73 65 74 76 61 72 73 22 20 23 66 29 29 29 0a -setvars" #f))).
69c0: 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 ....... (list '
69d0: 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 6d runname runnam
69e0: 65 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 e)........ (lis
69f0: 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 t 'mt-bindir-pat
6a00: 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 h mt-bindir-path
6a10: 29 29 29 29 29 29 29 20 3b 3b 20 28 73 74 72 69 ))))))) ;; (stri
6a20: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b ng-intersperse k
6a30: 65 79 76 61 6c 6c 73 74 20 22 20 22 29 29 29 29 eyvallst " "))))
6a40: 0a 20 20 20 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 . ;; clean ou
6a50: 74 20 73 74 65 70 20 72 65 63 6f 72 64 73 20 66 t step records f
6a60: 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 72 75 6e rom previous run
6a70: 20 69 66 20 74 68 65 79 20 65 78 69 73 74 0a 20 if they exist.
6a80: 20 20 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 (db:delete-te
6a90: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 st-step-records
6aa0: 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 db test-id).
6ab0: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
6ac0: 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b 20 y work-area) ;;
6ad0: 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 so that log file
6ae0: 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 s from the launc
6af0: 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 h process don't
6b00: 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 74 clutter the test
6b10: 20 64 69 72 0a 20 20 20 20 28 63 6f 6e 64 0a 20 dir. (cond.
6b20: 20 20 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 ((and launch
6b30: 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 er hosts) ;; mus
6b40: 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 20 68 t be using ssh h
6b50: 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 73 ostname. (s
6b60: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
6b70: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 end launcher (ca
6b80: 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 r hosts)(list re
6b90: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
6ba0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
6bb0: 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 " cmdparms) debu
6bc0: 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 g-param))).
6bd0: 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
6be0: 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
6bf0: 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 r (car hosts)(li
6c00: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
6c10: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
6c20: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
6c30: 29 29 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 68 ))). (launch
6c40: 65 72 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 er. (set! f
6c50: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c ullcmd (append l
6c60: 61 75 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 auncher (list re
6c70: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
6c80: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
6c90: 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 " cmdparms) debu
6ca0: 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 g-param))).
6cb0: 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
6cc0: 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
6cd0: 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d r (list remote-m
6ce0: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6cf0: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6d00: 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 28 65 arms)))). (e
6d10: 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e lse. (if (n
6d20: 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 64 65 62 ot useshell)(deb
6d30: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
6d40: 49 4e 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c 61 ING: internal la
6d50: 75 6e 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 unching will not
6d60: 20 77 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 6f work well witho
6d70: 75 74 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 65 ut \"useshell ye
6d80: 73 5c 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 s\" in your [job
6d90: 74 6f 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 29 tools] section")
6da0: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 ). (set! fu
6db0: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 28 6c llcmd (append (l
6dc0: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
6dd0: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
6de0: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
6df0: 29 20 64 65 62 75 67 2d 70 61 72 61 6d 20 28 6c ) debug-param (l
6e00: 69 73 74 20 28 69 66 20 75 73 65 73 68 65 6c 6c ist (if useshell
6e10: 20 22 26 22 20 22 22 29 29 29 29 29 29 0a 20 20 "&" "")))))).
6e20: 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 ;; (set! fullc
6e30: 6d 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d md (list remote-
6e40: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
6e50: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
6e60: 70 61 72 6d 73 20 28 69 66 20 75 73 65 73 68 65 parms (if useshe
6e70: 6c 6c 20 22 26 22 20 22 22 29 29 29 29 29 0a 20 ll "&" ""))))).
6e80: 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
6e90: 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 28 73 -arg "-xterm")(s
6ea0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
6eb0: 65 6e 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 end fullcmd (lis
6ec0: 74 20 22 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 t "-xterm")))).
6ed0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6ee0: 31 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 1 "Launching " w
6ef0: 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 28 74 ork-area). (t
6f00: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
6f10: 64 62 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e db test-id "LAUN
6f20: 43 48 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 CHED" "n/a" #f #
6f30: 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 f) ;; (if launch
6f40: 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d -results launch-
6f50: 72 65 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 results "FAILED"
6f60: 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 72 )). ;; set pr
6f70: 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 e-launch-env-var
6f80: 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 69 s before launchi
6f90: 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 61 72 ng, keep the var
6fa0: 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 61 6e s in prevvals an
6fb0: 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 6f 6e d put the envion
6fc0: 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 64 ment back when d
6fd0: 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 3a 70 one. (debug:p
6fe0: 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 3a rint 4 "fullcmd:
6ff0: 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 20 " fullcmd).
7000: 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 (let* ((commonpr
7010: 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e 65 evvals (alist->e
7020: 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 nv-vars.... (
7030: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
7040: 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 efault *configda
7050: 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t* "env-override
7060: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 74 65 " '()))).. (te
7070: 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c stprevvals (al
7080: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 ist->env-vars...
7090: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
70a0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 -ref/default tes
70b0: 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 6e t-conf "pre-laun
70c0: 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 73 ch-env-overrides
70d0: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 6d 69 " '()))).. (mi
70e0: 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c scprevvals (al
70f0: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b ist->env-vars ;;
7100: 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 consolidate thi
7110: 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 s code with the
7120: 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 code in megatest
7130: 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 .scm for "-execu
7140: 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 70 65 te".... (appe
7150: 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 22 nd (list (list "
7160: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
7170: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
7180: 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 . (list "MT_TES
7190: 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d T_NAME" test-nam
71a0: 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 e)...... (list
71b0: 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 "MT_ITEM_INFO" (
71c0: 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 0a conc itemdat)) .
71d0: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
71e0: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
71f0: 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 ame)...... (lis
7200: 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 t "MT_TARGET"
7210: 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 mt_target).....
7220: 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 74 65 . )..... ite
7230: 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c 61 75 mdat))).. (lau
7240: 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 70 nch-results (app
7250: 6c 79 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d ly cmd-run-proc-
7260: 65 61 63 68 2d 6c 69 6e 65 0a 09 09 09 09 20 20 each-line.....
7270: 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 (if useshell....
7280: 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 . (string-i
7290: 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
72a0: 6d 64 20 22 20 22 29 0a 09 09 09 09 20 20 20 20 md " ").....
72b0: 20 20 28 63 61 72 20 66 75 6c 6c 63 6d 64 29 29 (car fullcmd))
72c0: 0a 09 09 09 09 20 20 70 72 69 6e 74 0a 09 09 09 ..... print....
72d0: 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a . (if useshell.
72e0: 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 .... '()...
72f0: 09 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c .. (cdr ful
7300: 6c 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c 61 lcmd))))) ;; la
7310: 75 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 29 uncher fullcmd))
7320: 29 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 );; (apply cmd-r
7330: 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e un-proc-each-lin
7340: 65 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e 74 e launcher print
7350: 20 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 28 fullcmd))) ;; (
7360: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 cmd-run->list fu
7370: 6c 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 77 llcmd)). (w
7380: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
7390: 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f le "mt_launch.lo
73a0: 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 g"..(lambda ()..
73b0: 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 6c (apply print l
73c0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 29 aunch-results)))
73d0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
73e0: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 int 2 "Launching
73f0: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 completed, upda
7400: 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 20 ting db").
7410: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
7420: 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 Launch results:
7430: 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 " launch-results
7440: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
7450: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
7460: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
7470: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 (print "ERROR: F
7480: 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 ailed to run " (
7490: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
74a0: 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 se fullcmd " ")
74b0: 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 ", exiting now")
74c0: 0a 09 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 .. (sqlite3:f
74d0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
74e0: 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 ;; good ole "e
74f0: 78 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 xit" seems not t
7500: 6f 20 77 6f 72 6b 0a 09 20 20 20 20 3b 3b 20 28 o work.. ;; (
7510: 5f 65 78 69 74 20 39 29 0a 09 20 20 20 20 3b 3b _exit 9).. ;;
7520: 20 62 75 74 20 74 68 69 73 20 68 61 63 6b 20 77 but this hack w
7530: 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 6e 6b 73 ill work! Thanks
7540: 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 6f 73 74 go to Alan Post
7550: 20 6f 66 20 74 68 65 20 43 68 69 63 6b 65 6e 20 of the Chicken
7560: 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 20 20 20 email list..
7570: 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 68 69 73 20 ;; NB// Is this
7580: 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f 20 53 68 still needed? Sh
7590: 6f 75 6c 64 20 62 65 20 73 61 66 65 20 74 6f 20 ould be safe to
75a0: 67 6f 20 62 61 63 6b 20 74 6f 20 22 65 78 69 74 go back to "exit
75b0: 22 20 6e 6f 77 3f 0a 09 20 20 20 20 28 70 72 6f " now?.. (pro
75c0: 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 72 cess-signal (cur
75d0: 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 rent-process-id)
75e0: 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 signal/kill)..
75f0: 20 20 20 29 29 0a 20 20 20 20 20 20 28 61 6c 69 )). (ali
7600: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 6d 69 73 st->env-vars mis
7610: 63 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 cprevvals).
7620: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
7630: 73 20 74 65 73 74 70 72 65 76 76 61 6c 73 29 0a s testprevvals).
7640: 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e (alist->en
7650: 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 72 65 v-vars commonpre
7660: 76 76 61 6c 73 29 0a 20 20 20 20 20 20 6c 61 75 vvals). lau
7670: 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 0a 20 20 nch-results)).
7680: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
7690: 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a 0a y *toppath*))..