Artifact
843bb8d0153eba7d28bff00e0da2e78e6ad720a8
File
launch.scm
— part of check-in
[4f517c5576]
at
2012-09-27 08:52:52
on branch test-specific-db
— Moved minutes monitoring from megatest.db to testdat.db
(user:
matt
size: 30378)
[more...]
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
05d0: 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 65 64 :execute encoded
05e0: 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 -cmd). (let* ((
05f0: 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 64 20 cmdinfo (read
0600: 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 72 69 (open-input-stri
0610: 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 ng (base64:base6
0620: 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 65 64 4-decode encoded
0630: 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 28 73 -cmd))))). (s
0640: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
0650: 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a O" encoded-cmd).
0660: 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 63 (if (list? c
0670: 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 65 73 mdinfo) ;; ((tes
0680: 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 65 6c tpath /tmp/mrwel
0690: 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 lan/jazzmind/src
06a0: 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 /example_run/tes
06b0: 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 29 0a ts/sqlitespeed).
06c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
06d0: 20 20 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 ;; (test
06e0: 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 -name sqlitespee
06f0: 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 d) (runscript ru
0700: 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d nscript.rb) (db-
0710: 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 host localhost)
0720: 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c 65 (run-id 1))..(le
0730: 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 28 t* ((testpath (
0740: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0750: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
0760: 29 29 0a 09 20 20 20 20 20 20 20 28 74 6f 70 2d )).. (top-
0770: 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 path (assoc/def
0780: 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 20 ault 'toppath
0790: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
07a0: 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 (work-area (as
07b0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 soc/default 'wor
07c0: 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 k-area cmdinfo))
07d0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
07e0: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
07f0: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
0800: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
0810: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
0820: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
0830: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
0840: 20 20 20 20 20 20 20 28 65 7a 73 74 65 70 73 20 (ezsteps
0850: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0860: 20 27 65 7a 73 74 65 70 73 20 20 20 63 6d 64 69 'ezsteps cmdi
0870: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 64 nfo)).. (d
0880: 62 2d 68 6f 73 74 20 20 20 28 61 73 73 6f 63 2f b-host (assoc/
0890: 64 65 66 61 75 6c 74 20 27 64 62 2d 68 6f 73 74 default 'db-host
08a0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
08b0: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
08c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
08d0: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
08e0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
08f0: 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 t-id (assoc/de
0900: 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 fault 'test-id
0910: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0920: 20 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 (target (a
0930: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 ssoc/default 'ta
0940: 72 67 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 rget cmdinfo)
0950: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 ).. (itemd
0960: 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 at (assoc/defa
0970: 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 ult 'itemdat c
0980: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0990: 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 73 (env-ovrd (ass
09a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 2d oc/default 'env-
09b0: 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 0a ovrd cmdinfo)).
09c0: 09 20 20 20 20 20 20 20 28 73 65 74 2d 76 61 72 . (set-var
09d0: 73 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c s (assoc/defaul
09e0: 74 20 27 73 65 74 2d 76 61 72 73 20 20 63 6d 64 t 'set-vars cmd
09f0: 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f 76 info)) ;; pre-ov
0a00: 65 72 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 65 errides from -se
0a10: 74 76 61 72 0a 09 20 20 20 20 20 20 20 28 72 75 tvar.. (ru
0a20: 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 nname (assoc/d
0a30: 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 efault 'runname
0a40: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
0a50: 20 20 20 20 28 6d 65 67 61 74 65 73 74 20 20 28 (megatest (
0a60: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d assoc/default 'm
0a70: 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 66 6f egatest cmdinfo
0a80: 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 2d 62 )).. (mt-b
0a90: 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 73 6f indir-path (asso
0aa0: 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 c/default 'mt-bi
0ab0: 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 ndir-path cmdinf
0ac0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 66 75 6c o)).. (ful
0ad0: 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 72 lrunscript (if r
0ae0: 75 6e 73 63 72 69 70 74 20 28 63 6f 6e 63 20 74 unscript (conc t
0af0: 65 73 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 estpath "/" runs
0b00: 63 72 69 70 74 29 20 23 66 29 29 0a 09 20 20 20 cript) #f))..
0b10: 20 20 20 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 (rollup-stat
0b20: 75 73 20 30 29 29 0a 09 20 20 0a 09 20 20 28 64 us 0)).. .. (d
0b30: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 ebug:print 2 "Ex
0b40: 65 63 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e ectuing " test-n
0b50: 61 6d 65 20 22 20 28 69 64 3a 20 22 20 74 65 73 ame " (id: " tes
0b60: 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 28 67 65 t-id ") on " (ge
0b70: 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 t-host-name))..
0b80: 20 3b 3b 20 61 70 70 6c 79 20 70 72 65 2d 6f 76 ;; apply pre-ov
0b90: 65 72 72 69 64 65 73 20 62 65 66 6f 72 65 20 6f errides before o
0ba0: 74 68 65 72 20 76 61 72 69 61 62 6c 65 73 2e 20 ther variables.
0bb0: 54 68 65 20 70 72 65 2d 6f 76 65 72 72 69 64 65 The pre-override
0bc0: 20 76 61 72 73 20 6d 75 73 74 20 6e 6f 74 0a 09 vars must not..
0bd0: 20 20 3b 3b 20 63 6c 6f 62 62 65 72 73 20 74 68 ;; clobbers th
0be0: 69 6e 67 73 20 66 72 6f 6d 20 74 68 65 20 6f 66 ings from the of
0bf0: 66 69 63 69 61 6c 20 73 6f 75 72 63 65 73 20 73 ficial sources s
0c00: 75 63 68 20 61 73 20 6d 65 67 61 74 65 73 74 2e uch as megatest.
0c10: 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f config and runco
0c20: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 09 20 20 nfigs.config..
0c30: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 65 74 (if (string? set
0c40: 2d 76 61 72 73 29 0a 09 20 20 20 20 20 20 28 6c -vars).. (l
0c50: 65 74 20 28 28 76 61 72 70 61 69 72 73 20 28 73 et ((varpairs (s
0c60: 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 65 74 2d tring-split set-
0c70: 76 61 72 73 20 22 2c 22 29 29 29 0a 09 09 28 64 vars ",")))...(d
0c80: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 76 61 ebug:print 4 "va
0c90: 72 70 61 69 72 73 3a 20 22 20 76 61 72 70 61 69 rpairs: " varpai
0ca0: 72 73 29 0a 09 09 28 6d 61 70 20 28 6c 61 6d 62 rs)...(map (lamb
0cb0: 64 61 20 28 76 61 72 70 61 69 72 29 0a 09 09 20 da (varpair)...
0cc0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 (let ((var
0cd0: 76 61 6c 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 val (string-spli
0ce0: 74 20 76 61 72 70 61 69 72 20 22 3d 22 29 29 29 t varpair "=")))
0cf0: 0a 09 09 09 20 28 69 66 20 28 65 71 3f 20 28 6c .... (if (eq? (l
0d00: 65 6e 67 74 68 20 76 61 72 76 61 6c 29 20 32 29 ength varval) 2)
0d10: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
0d20: 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 var (car varval)
0d30: 29 0a 09 09 09 09 20 20 20 28 76 61 6c 20 28 63 )..... (val (c
0d40: 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 adr varval)))...
0d50: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
0d60: 72 69 6e 74 20 31 20 22 41 64 64 69 6e 67 20 70 rint 1 "Adding p
0d70: 72 65 2d 76 61 72 2f 76 61 6c 20 22 20 76 61 72 re-var/val " var
0d80: 20 22 20 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 " = " val " to
0d90: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 the environment"
0da0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
0db0: 65 6e 76 20 76 61 72 20 76 61 6c 29 29 29 29 29 env var val)))))
0dc0: 0a 09 09 20 20 20 20 20 76 61 72 70 61 69 72 73 ... varpairs
0dd0: 29 29 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 ))).. (setenv "
0de0: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
0df0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 work-area).. (
0e00: 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f setenv "MT_TEST_
0e10: 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 NAME" test-name)
0e20: 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f .. (setenv "MT_
0e30: 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 ITEM_INFO" (conc
0e40: 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 28 73 itemdat)).. (s
0e50: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d etenv "MT_RUNNAM
0e60: 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 E" runname)..
0e70: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d 45 47 (setenv "MT_MEG
0e80: 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 ATEST" megatest
0e90: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
0ea0: 5f 54 41 52 47 45 54 22 20 20 20 20 74 61 72 67 _TARGET" targ
0eb0: 65 74 29 0a 09 20 20 28 69 66 20 6d 74 2d 62 69 et).. (if mt-bi
0ec0: 6e 64 69 72 2d 70 61 74 68 20 28 73 65 74 65 6e ndir-path (seten
0ed0: 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 20 28 v "PATH" (conc (
0ee0: 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 20 22 getenv "PATH") "
0ef0: 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 :" mt-bindir-pat
0f00: 68 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d h))).. (change-
0f10: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 2d 70 61 directory top-pa
0f20: 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 th).. (if (not
0f30: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 29 (setup-for-run))
0f40: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
0f50: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
0f60: 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 75 70 "Failed to setup
0f70: 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 09 3b , exiting") ...;
0f80: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
0f90: 69 7a 65 21 20 64 62 29 0a 09 09 3b 3b 20 28 73 ize! db)...;; (s
0fa0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
0fb0: 20 74 64 62 29 0a 09 09 28 65 78 69 74 20 31 29 tdb)...(exit 1)
0fc0: 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )).. (change-di
0fd0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
0fe0: 2a 29 0a 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e *)... (open-run
0ff0: 2d 63 6c 6f 73 65 20 73 65 74 2d 6d 65 67 61 74 -close set-megat
1000: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 23 66 20 est-env-vars #f
1010: 72 75 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 run-id) ;; these
1020: 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 may be needed b
1030: 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 y the launching
1040: 70 72 6f 63 65 73 73 0a 09 20 20 28 63 68 61 6e process.. (chan
1050: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
1060: 6b 2d 61 72 65 61 29 20 0a 0a 09 20 20 28 6f 70 k-area) ... (op
1070: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 en-run-close set
1080: 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 -run-config-vars
1090: 20 23 66 20 72 75 6e 2d 69 64 29 0a 09 20 20 3b #f run-id).. ;
10a0: 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 ; environment ov
10b0: 65 72 72 69 64 65 73 20 61 72 65 20 64 6f 6e 65 errides are done
10c0: 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 72 65 *before* the re
10d0: 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 61 6c maining critical
10e0: 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 61 6c 69 envars... (ali
10f0: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 st->env-vars env
1100: 2d 6f 76 72 64 29 0a 09 20 20 28 6f 70 65 6e 2d -ovrd).. (open-
1110: 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 2d 6d 65 run-close set-me
1120: 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 gatest-env-vars
1130: 23 66 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 73 #f run-id).. (s
1140: 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 et-item-env-vars
1150: 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 73 61 itemdat).. (sa
1160: 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 ve-environment-a
1170: 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 65 73 s-files "megates
1180: 74 22 29 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e t").. (open-run
1190: 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 2d -close test-set-
11a0: 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 meta-info #f tes
11b0: 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 t-id run-id test
11c0: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 30 29 -name itemdat 0)
11d0: 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c .. (open-run-cl
11e0: 6f 73 65 20 74 65 73 74 2d 73 65 74 2d 73 74 61 ose test-set-sta
11f0: 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 tus! #f test-id
1200: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
1210: 22 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 " "n/a" (args:ge
1220: 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a t-arg "-m") #f).
1230: 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 . (if (args:get
1240: 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 -arg "-xterm")..
1250: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
1260: 72 75 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d runscript "xterm
1270: 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 ").. (if (a
1280: 6e 64 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 nd fullrunscript
1290: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 63 (not (file-exec
12a0: 75 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c ute-access? full
12b0: 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 09 20 runscript)))...
12c0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
12d0: 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 66 75 6c chmod ug+x " ful
12e0: 6c 72 75 6e 73 63 72 69 70 74 29 29 29 29 0a 09 lrunscript))))..
12f0: 20 20 3b 3b 20 57 65 20 61 72 65 20 61 62 6f 75 ;; We are abou
1300: 74 20 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b 69 t to actually ki
1310: 63 6b 20 6f 66 66 20 74 68 65 20 74 65 73 74 0a ck off the test.
1320: 09 20 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 73 . ;; so this is
1330: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 6f a good place to
1340: 20 72 65 6d 6f 76 65 20 74 68 65 20 72 65 63 6f remove the reco
1350: 72 64 73 20 66 6f 72 20 0a 09 20 20 3b 3b 20 61 rds for .. ;; a
1360: 6e 79 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73 ny previous runs
1370: 0a 09 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d .. ;; (db:test-
1380: 72 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 remove-steps db
1390: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
13a0: 69 74 65 6d 64 61 74 29 0a 09 20 20 0a 09 20 20 itemdat).. ..
13b0: 28 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 (let* ((m
13c0: 20 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 (make-mutex
13d0: 29 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f ))... (kill-job?
13e0: 20 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 #f)... (exit
13f0: 2d 69 6e 66 6f 20 20 20 20 28 76 65 63 74 6f 72 -info (vector
1400: 20 23 74 20 23 74 20 23 74 29 29 0a 09 09 20 28 #t #t #t))... (
1410: 6a 6f 62 2d 74 68 72 65 61 64 20 20 20 23 66 29 job-thread #f)
1420: 0a 09 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 ... (runit
1430: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
1440: 09 20 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 . ;; (let-values
1450: 0a 09 09 09 09 20 3b 3b 20 20 28 28 28 70 69 64 ..... ;; (((pid
1460: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
1470: 74 2d 63 6f 64 65 29 0a 09 09 09 09 20 3b 3b 20 t-code)..... ;;
1480: 20 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 (run-n-wait f
1490: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
14a0: 09 09 09 09 20 0a 09 09 09 09 20 3b 3b 20 69 66 .... ..... ;; if
14b0: 20 74 68 65 72 65 20 69 73 20 61 20 72 75 6e 73 there is a runs
14c0: 63 72 69 70 74 20 64 6f 20 69 74 20 66 69 72 73 cript do it firs
14d0: 74 0a 09 09 09 09 20 28 69 66 20 66 75 6c 6c 72 t..... (if fullr
14e0: 75 6e 73 63 72 69 70 74 0a 09 09 09 09 20 20 20 unscript.....
14f0: 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 (let ((pid (pr
1500: 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 ocess-run fullru
1510: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 nscript))).....
1520: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
1530: 28 28 69 20 30 29 29 0a 09 09 09 09 09 20 28 6c ((i 0))...... (l
1540: 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 20 et-values......
1550: 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 (((pid-val exit
1560: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
1570: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
1580: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 pid #t)))......
1590: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
15a0: 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 )...... (vector
15b0: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
15c0: 30 20 70 69 64 29 0a 09 09 09 09 09 20 20 28 76 0 pid)...... (v
15d0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
15e0: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
15f0: 75 73 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 us)...... (vect
1600: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
1610: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
1620: 09 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c .... (set! roll
1630: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 up-status exit-c
1640: 6f 64 65 29 20 0a 09 09 09 09 09 20 20 28 6d 75 ode) ...... (mu
1650: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
1660: 09 09 09 09 20 20 28 69 66 20 28 65 71 3f 20 70 .... (if (eq? p
1670: 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 20 id-val 0)......
1680: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
1690: 09 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ..(thread-sleep!
16a0: 20 32 29 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 2).......(loop
16b0: 28 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 (+ i 1)))......
16c0: 20 20 20 20 20 29 29 29 29 29 0a 09 09 09 09 20 ))))).....
16d0: 3b 3b 20 74 68 65 6e 2c 20 69 66 20 72 75 6e 73 ;; then, if runs
16e0: 63 72 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f 72 cript ran ok (or
16f0: 20 64 69 64 20 6e 6f 74 20 67 65 74 20 63 61 6c did not get cal
1700: 6c 65 64 29 0a 09 09 09 09 20 3b 3b 20 64 6f 20 led)..... ;; do
1710: 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 70 73 20 all the ezsteps
1720: 28 69 66 20 61 6e 79 29 0a 09 09 09 09 20 28 69 (if any)..... (i
1730: 66 20 65 7a 73 74 65 70 73 0a 09 09 09 09 20 20 f ezsteps.....
1740: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 (let* ((testc
1750: 6f 6e 66 69 67 20 28 72 65 61 64 2d 63 6f 6e 66 onfig (read-conf
1760: 69 67 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 ig (conc work-ar
1770: 65 61 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 ea "/testconfig"
1780: 29 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d ) #f #t environ-
1790: 70 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 patt: "pre-launc
17a0: 68 2d 65 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b h-env-vars")) ;;
17b0: 20 46 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c FIXME??? is all
17c0: 6f 77 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 ow-system ok her
17d0: 65 3f 0a 09 09 09 09 09 20 20 20 20 28 65 7a 73 e?...... (ezs
17e0: 74 65 70 73 6c 73 74 20 28 68 61 73 68 2d 74 61 tepslst (hash-ta
17f0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1800: 74 65 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 testconfig "ezst
1810: 65 70 73 22 20 27 28 29 29 29 29 0a 09 09 09 09 eps" '()))).....
1820: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
1830: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e (file-exists? ".
1840: 65 7a 73 74 65 70 73 22 29 29 28 63 72 65 61 74 ezsteps"))(creat
1850: 65 2d 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a e-directory ".ez
1860: 73 74 65 70 73 22 29 29 0a 09 09 09 09 20 20 20 steps")).....
1870: 20 20 20 20 3b 3b 20 69 66 20 65 7a 73 74 65 70 ;; if ezstep
1880: 73 20 77 61 73 20 64 65 66 69 6e 65 64 20 74 68 s was defined th
1890: 65 6e 20 77 65 20 61 72 65 20 73 75 72 65 20 74 en we are sure t
18a0: 6f 20 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 o have at least
18b0: 6f 6e 65 20 73 74 65 70 20 62 75 74 20 63 68 65 one step but che
18c0: 63 6b 20 61 6e 79 77 61 79 0a 09 09 09 09 20 20 ck anyway.....
18d0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 3e (if (not (>
18e0: 20 28 6c 65 6e 67 74 68 20 65 7a 73 74 65 70 73 (length ezsteps
18f0: 6c 73 74 29 20 30 29 29 0a 09 09 09 09 09 20 20 lst) 0))......
1900: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1910: 22 45 52 52 4f 52 3a 20 65 7a 73 74 65 70 73 20 "ERROR: ezsteps
1920: 64 65 66 69 6e 65 64 20 62 75 74 20 65 7a 73 74 defined but ezst
1930: 65 70 73 6c 73 74 20 69 73 20 7a 65 72 6f 20 6c epslst is zero l
1940: 65 6e 67 74 68 22 29 0a 09 09 09 09 09 20 20 20 ength")......
1950: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 (let loop ((ezst
1960: 65 70 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c ep (car ezstepsl
1970: 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 st)).......
1980: 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 65 7a (tal (cdr ez
1990: 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 stepslst))......
19a0: 09 20 20 20 20 20 20 28 70 72 65 76 73 74 65 70 . (prevstep
19b0: 20 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 20 #f))......
19c0: 3b 3b 20 63 68 65 63 6b 20 65 78 69 74 2d 69 6e ;; check exit-in
19d0: 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 fo (vector-ref e
19e0: 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 xit-info 1).....
19f0: 09 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f . (if (vecto
1a00: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
1a10: 31 29 0a 09 09 09 09 09 09 20 28 6c 65 74 2a 20 1)....... (let*
1a20: 28 28 73 74 65 70 6e 61 6d 65 20 20 28 63 61 72 ((stepname (car
1a30: 20 65 7a 73 74 65 70 29 29 20 20 3b 3b 20 64 6f ezstep)) ;; do
1a40: 20 73 74 75 66 66 20 74 6f 20 72 75 6e 20 74 68 stuff to run th
1a50: 65 20 73 74 65 70 0a 09 09 09 09 09 09 09 28 73 e step........(s
1a60: 74 65 70 69 6e 66 6f 20 20 28 63 61 64 72 20 65 tepinfo (cadr e
1a70: 7a 73 74 65 70 29 29 0a 09 09 09 09 09 09 09 28 zstep))........(
1a80: 73 74 65 70 70 61 72 74 73 20 28 73 74 72 69 6e stepparts (strin
1a90: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
1aa0: 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c "^(\\{([^\\}]*)\
1ab0: 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 24 22 29 20 \}\\s*|)(.*)$")
1ac0: 73 74 65 70 69 6e 66 6f 29 29 0a 09 09 09 09 09 stepinfo))......
1ad0: 09 09 28 73 74 65 70 70 61 72 6d 73 20 28 6c 69 ..(stepparms (li
1ae0: 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 st-ref stepparts
1af0: 20 32 29 29 20 3b 3b 20 66 6f 72 20 66 75 74 75 2)) ;; for futu
1b00: 72 65 20 75 73 65 2c 20 7b 56 41 52 3d 31 2c 32 re use, {VAR=1,2
1b10: 2c 33 7d 2c 20 72 75 6e 20 73 74 65 70 20 66 6f ,3}, run step fo
1b20: 72 20 65 61 63 68 20 0a 09 09 09 09 09 09 09 28 r each ........(
1b30: 73 74 65 70 63 6d 64 20 20 20 28 6c 69 73 74 2d stepcmd (list-
1b40: 72 65 66 20 73 74 65 70 70 61 72 74 73 20 33 29 ref stepparts 3)
1b50: 29 0a 09 09 09 09 09 09 09 28 73 63 72 69 70 74 )........(script
1b60: 20 20 20 20 22 22 29 20 3b 20 22 23 21 2f 62 69 "") ; "#!/bi
1b70: 6e 2f 62 61 73 68 5c 6e 22 29 20 3b 3b 20 79 65 n/bash\n") ;; ye
1b80: 70 2c 20 77 65 20 64 65 70 65 6e 64 20 6f 6e 20 p, we depend on
1b90: 62 69 6e 2f 62 61 73 68 20 46 49 58 4d 45 21 21 bin/bash FIXME!!
1ba0: 21 0a 09 09 09 09 09 09 09 28 6c 6f 67 70 72 6f !........(logpro
1bb0: 2d 75 73 65 64 20 23 66 29 29 0a 09 09 09 09 09 -used #f))......
1bc0: 09 20 20 20 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 . ;; NB// can
1bd0: 73 61 66 65 6c 79 20 61 73 73 75 6d 65 20 77 65 safely assume we
1be0: 20 61 72 65 20 69 6e 20 74 65 73 74 2d 61 72 65 are in test-are
1bf0: 61 20 64 69 72 65 63 74 6f 72 79 0a 09 09 09 09 a directory.....
1c00: 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
1c10: 74 20 34 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 t 4 "ezsteps:\n
1c20: 73 74 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 stepname: " step
1c30: 6e 61 6d 65 20 22 20 73 74 65 70 69 6e 66 6f 3a name " stepinfo:
1c40: 20 22 20 73 74 65 70 69 6e 66 6f 20 22 20 73 74 " stepinfo " st
1c50: 65 70 70 61 72 74 73 3a 20 22 20 73 74 65 70 70 epparts: " stepp
1c60: 61 72 74 73 0a 09 09 09 09 09 09 09 09 22 20 73 arts........." s
1c70: 74 65 70 70 61 72 6d 73 3a 20 22 20 73 74 65 70 tepparms: " step
1c80: 70 61 72 6d 73 20 22 20 73 74 65 70 63 6d 64 3a parms " stepcmd:
1c90: 20 22 20 73 74 65 70 63 6d 64 29 0a 09 09 09 09 " stepcmd).....
1ca0: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 28 .. ....... (
1cb0: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
1cc0: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
1cd0: 22 2e 6c 6f 67 70 72 6f 22 29 29 28 73 65 74 21 ".logpro"))(set!
1ce0: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 74 29 logpro-used #t)
1cf0: 29 0a 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 3b )........ ;; ;
1d00: 3b 20 66 69 72 73 74 20 73 6f 75 72 63 65 20 74 ; first source t
1d10: 68 65 20 70 72 65 76 69 6f 75 73 20 65 6e 76 69 he previous envi
1d20: 72 6f 6e 6d 65 6e 74 0a 09 09 09 09 09 09 20 20 ronment.......
1d30: 20 3b 3b 20 28 6c 65 74 20 28 28 70 72 65 76 2d ;; (let ((prev-
1d40: 65 6e 76 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 env (conc ".ezst
1d50: 65 70 73 2f 22 20 70 72 65 76 73 74 65 70 20 28 eps/" prevstep (
1d60: 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 if (string-searc
1d70: 68 20 28 72 65 67 65 78 70 20 22 63 73 68 22 29 h (regexp "csh")
1d80: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 ....... ;;
1d90: 20 20 20 09 09 09 09 09 09 09 20 28 67 65 74 2d ....... (get-
1da0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
1db0: 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 20 22 able "SHELL")) "
1dc0: 2e 63 73 68 22 20 22 2e 73 68 22 29 29 29 29 0a .csh" ".sh")))).
1dd0: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 28 69 ...... ;; (i
1de0: 66 20 28 61 6e 64 20 70 72 65 76 73 74 65 70 20 f (and prevstep
1df0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 72 (file-exists? pr
1e00: 65 76 2d 65 6e 76 29 29 0a 09 09 09 09 09 09 20 ev-env)).......
1e10: 20 20 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 ;; (set!
1e20: 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 script (conc sc
1e30: 72 69 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 ript "source " p
1e40: 72 65 76 2d 65 6e 76 29 29 29 29 0a 09 09 09 09 rev-env)))).....
1e50: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 3b .. ....... ;
1e60: 3b 20 63 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 ; call the comma
1e70: 6e 64 20 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 nd using mt_ezst
1e80: 65 70 0a 09 09 09 09 09 09 20 20 20 28 73 65 74 ep....... (set
1e90: 21 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 22 ! script (conc "
1ea0: 6d 74 5f 65 7a 73 74 65 70 20 22 20 73 74 65 70 mt_ezstep " step
1eb0: 6e 61 6d 65 20 22 20 22 20 28 69 66 20 70 72 65 name " " (if pre
1ec0: 76 73 74 65 70 20 70 72 65 76 73 74 65 70 20 22 vstep prevstep "
1ed0: 2d 22 29 20 22 20 22 20 73 74 65 70 63 6d 64 29 -") " " stepcmd)
1ee0: 29 0a 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 )........ (deb
1ef0: 75 67 3a 70 72 69 6e 74 20 34 20 22 73 63 72 69 ug:print 4 "scri
1f00: 70 74 3a 20 22 20 73 63 72 69 70 74 29 0a 0a 09 pt: " script)...
1f10: 09 09 09 09 09 20 20 20 28 6f 70 65 6e 2d 72 75 ..... (open-ru
1f20: 6e 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 n-close db:tests
1f30: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
1f40: 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e #f test-id stepn
1f50: 61 6d 65 20 22 73 74 61 72 74 22 20 22 2d 22 20 ame "start" "-"
1f60: 69 74 65 6d 64 61 74 20 23 66 20 23 66 29 0a 09 itemdat #f #f)..
1f70: 09 09 09 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c ..... ;; now l
1f80: 61 75 6e 63 68 0a 09 09 09 09 09 09 20 20 20 28 aunch....... (
1f90: 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 let ((pid (proce
1fa0: 73 73 2d 72 75 6e 20 73 63 72 69 70 74 29 29 29 ss-run script)))
1fb0: 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 ....... (let
1fc0: 20 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 processloop ((i
1fd0: 20 30 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 0)).......
1fe0: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
1ff0: 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 (pid-val exit-st
2000: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 atus exit-code)(
2010: 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 process-wait pid
2020: 20 23 74 29 29 29 0a 09 09 09 09 09 09 09 09 20 #t))).........
2030: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
2040: 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 65 )......... (ve
2050: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
2060: 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 nfo 0 pid)......
2070: 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 ... (vector-se
2080: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 t! exit-info 1 e
2090: 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 xit-status).....
20a0: 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 .... (vector-s
20b0: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 et! exit-info 2
20c0: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 exit-code)......
20d0: 09 09 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c ... (mutex-unl
20e0: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 09 ock! m).........
20f0: 20 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d (if (eq? pid-
2100: 76 61 6c 20 30 29 0a 09 09 09 09 09 09 09 09 20 val 0).........
2110: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
2120: 09 09 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 ...... (thread-s
2130: 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 09 leep! 2)........
2140: 09 09 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 .. (processloop
2150: 28 2b 20 69 20 31 29 29 29 29 0a 09 09 09 09 09 (+ i 1))))......
2160: 09 09 09 20 20 20 29 29 0a 20 20 20 20 20 20 20 ... )).
2170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
21a0: 65 74 20 28 28 65 78 69 6e 66 6f 20 28 76 65 63 et ((exinfo (vec
21b0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
21c0: 6f 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 o 2)).
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2200: 20 28 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 (logfna (if log
2210: 70 72 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 pro-used (conc s
2220: 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 tepname ".html")
2230: 20 22 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 ""))).
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
2270: 3b 20 74 65 73 74 69 6e 67 20 69 66 20 70 72 6f ; testing if pro
2280: 63 65 64 75 72 65 73 20 63 61 6c 6c 65 64 20 69 cedures called i
2290: 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 n a remote call
22a0: 63 61 75 73 65 20 70 72 6f 62 6c 65 6d 73 20 28 cause problems (
22b0: 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f 20 49 20 ans: no or so I
22c0: 73 75 73 70 65 63 74 29 0a 09 09 09 09 09 09 20 suspect).......
22d0: 20 20 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e (open-run
22e0: 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 74 -close db:testst
22f0: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 ep-set-status! #
2300: 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 f test-id stepna
2310: 6d 65 20 22 65 6e 64 22 20 65 78 69 6e 66 6f 20 me "end" exinfo
2320: 69 74 65 6d 64 61 74 20 23 66 20 6c 6f 67 66 6e itemdat #f logfn
2330: 61 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 a))....... (
2340: 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 if logpro-used..
2350: 09 09 09 09 09 09 20 28 6f 70 65 6e 2d 72 75 6e ...... (open-run
2360: 2d 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d 73 -close db:test-s
2370: 65 74 2d 6c 6f 67 21 20 23 66 20 74 65 73 74 2d et-log! #f test-
2380: 69 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d id (conc stepnam
2390: 65 20 22 2e 68 74 6d 6c 22 29 29 29 0a 09 09 09 e ".html")))....
23a0: 09 09 09 20 20 20 20 20 3b 3b 20 73 65 74 20 74 ... ;; set t
23b0: 68 65 20 74 65 73 74 20 66 69 6e 61 6c 20 73 74 he test final st
23c0: 61 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 atus.......
23d0: 28 6c 65 74 2a 20 28 28 74 68 69 73 2d 73 74 65 (let* ((this-ste
23e0: 70 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 p-status (cond..
23f0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2400: 28 61 6e 64 20 28 65 71 3f 20 28 76 65 63 74 6f (and (eq? (vecto
2410: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2420: 32 29 20 32 29 20 6c 6f 67 70 72 6f 2d 75 73 65 2) 2) logpro-use
2430: 64 29 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 d) 'warn).......
2440: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
2450: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
2460: 2d 69 6e 66 6f 20 32 29 20 30 29 20 20 20 20 20 -info 2) 0)
2470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 70 'p
2480: 61 73 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 ass)..........
2490: 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c (else 'fail
24a0: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
24b0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 overall-status
24c0: 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 (cond..........
24d0: 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c ((eq? rol
24e0: 6c 75 70 2d 73 74 61 74 75 73 20 32 29 20 27 77 lup-status 2) 'w
24f0: 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 arn)..........
2500: 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 ((eq? rollu
2510: 70 2d 73 74 61 74 75 73 20 30 29 20 27 70 61 73 p-status 0) 'pas
2520: 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 s)..........
2530: 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 (else 'fail))
2540: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e 65 )........ (ne
2550: 78 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 28 xt-status (
2560: 63 6f 6e 64 20 0a 09 09 09 09 09 09 09 09 09 20 cond ..........
2570: 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 ((eq? over
2580: 61 6c 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 all-status 'pass
2590: 29 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ) this-step-stat
25a0: 75 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 us)..........
25b0: 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c ((eq? overal
25c0: 6c 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 0a l-status 'warn).
25d0: 09 09 09 09 09 09 09 09 09 09 28 69 66 20 28 65 ..........(if (e
25e0: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
25f0: 74 75 73 20 27 66 61 69 6c 29 20 27 66 61 69 6c tus 'fail) 'fail
2600: 20 27 77 61 72 6e 29 29 0a 09 09 09 09 09 09 09 'warn))........
2610: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 .. (else '
2620: 66 61 69 6c 29 29 29 29 0a 09 09 09 09 09 09 20 fail)))).......
2630: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2640: 6e 74 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 nt 4 "Exit value
2650: 20 72 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 received: " (ve
2660: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2670: 66 6f 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 fo 2) " logpro-u
2680: 73 65 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 sed: " logpro-us
2690: 65 64 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 ed .........
26a0: 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 " this-step-stat
26b0: 75 73 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d us: " this-step-
26c0: 73 74 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c status " overall
26d0: 2d 73 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 -status: " overa
26e0: 6c 6c 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 ll-status ......
26f0: 09 09 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 ... " next-st
2700: 61 74 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 atus: " next-sta
2710: 74 75 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 tus " rollup-sta
2720: 74 75 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 tus: " rollup-st
2730: 61 74 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 atus).......
2740: 20 20 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 (case next-st
2750: 61 74 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 atus........ ((w
2760: 61 72 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 arn)........ (s
2770: 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 et! rollup-statu
2780: 73 20 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b s 2)........ ;;
2790: 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 NB// test-set-s
27a0: 74 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 tatus! does rdb
27b0: 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 calls under the
27c0: 68 6f 6f 64 0a 09 09 09 09 09 09 09 20 20 28 6f hood........ (o
27d0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 pen-run-close te
27e0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 st-set-status! #
27f0: 66 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 f test-id "RUNNI
2800: 4e 47 22 20 22 57 41 52 4e 22 20 0a 09 09 09 09 NG" "WARN" .....
2810: 09 09 09 09 09 20 20 20 20 28 69 66 20 28 65 71 ..... (if (eq
2820: 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ? this-step-stat
2830: 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 70 72 us 'warn) "Logpr
2840: 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e 64 22 o warning found"
2850: 20 23 66 29 0a 09 09 09 09 09 09 09 09 09 20 20 #f)..........
2860: 20 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 #f))........ (
2870: 28 70 61 73 73 29 0a 09 09 09 09 09 09 09 20 20 (pass)........
2880: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
2890: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
28a0: 20 23 66 20 74 65 73 74 2d 69 64 20 22 52 55 4e #f test-id "RUN
28b0: 4e 49 4e 47 22 20 22 50 41 53 53 22 20 23 66 20 NING" "PASS" #f
28c0: 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 65 6c #f))........ (el
28d0: 73 65 20 3b 3b 20 27 66 61 69 6c 0a 09 09 09 09 se ;; 'fail.....
28e0: 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 ... (set! rollu
28f0: 70 2d 73 74 61 74 75 73 20 31 29 20 3b 3b 20 66 p-status 1) ;; f
2900: 6f 72 63 65 20 66 61 69 6c 0a 09 09 09 09 09 09 orce fail.......
2910: 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f . (open-run-clo
2920: 73 65 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 se test-set-stat
2930: 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 22 us! #f test-id "
2940: 52 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 RUNNING" "FAIL"
2950: 28 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 (conc "Failed at
2960: 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 step " stepname
2970: 29 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 ) #f)........ )
2980: 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 )))....... (if
2990: 20 28 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 (and (steprun-g
29a0: 6f 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 ood? logpro-used
29b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
29c0: 74 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 t-info 2))......
29d0: 09 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c .. (not (null
29e0: 3f 20 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 ? tal))).......
29f0: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
2a00: 20 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 tal) (cdr tal)
2a10: 73 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 stepname))).....
2a20: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
2a30: 6e 74 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 nt 4 "WARNING: a
2a40: 20 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c prior step fail
2a50: 65 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 ed, stopping at
2a60: 22 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 " ezstep))))))))
2a70: 0a 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 ... (monitorjob
2a80: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
2a90: 09 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d . (let* ((start-
2aa0: 73 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 seconds (current
2ab0: 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 -seconds))......
2ac0: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 (calc-minutes (
2ad0: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 lambda ().......
2ae0: 09 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 . (inexact->exac
2af0: 74 20 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 t ........ (rou
2b00: 6e 64 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d nd ........ (-
2b10: 20 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 75 ........ (cu
2b20: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a rrent-seconds) .
2b30: 09 09 09 09 09 09 09 20 20 20 20 73 74 61 72 74 ....... start
2b40: 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 -seconds)))))...
2b50: 09 09 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 ...(kill-tries 0
2b60: 29 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 6c ))..... (let l
2b70: 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 oop ((minutes
2b80: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 (calc-minutes)))
2b90: 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 28 6c 65 ..... ;; (le
2ba0: 74 2a 20 28 3b 3b 20 28 64 62 20 20 20 20 20 20 t* (;; (db
2bb0: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 09 09 09 (open-db)).....
2bc0: 09 20 20 20 20 3b 3b 20 28 63 70 75 6c 6f 61 64 . ;; (cpuload
2bd0: 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 (get-cpu-load)
2be0: 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 64 )...... ;; (d
2bf0: 69 73 6b 66 72 65 65 20 28 67 65 74 2d 64 66 20 iskfree (get-df
2c00: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
2c10: 72 79 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b ry)))...... ;
2c20: 3b 20 28 74 6d 70 66 72 65 65 20 20 28 67 65 74 ; (tmpfree (get
2c30: 2d 64 66 20 22 2f 74 6d 70 22 29 29 29 0a 09 09 -df "/tmp")))...
2c40: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
2c50: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 .. ;; (if
2c60: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
2c70: 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 rg "-server"))..
2c80: 09 09 09 20 20 20 20 20 20 20 3b 3b 09 20 20 20 ... ;;.
2c90: 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 (server:client-s
2ca0: 65 74 75 70 20 64 62 29 29 0a 09 09 09 09 20 20 etup db)).....
2cb0: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 ;; (if (not
2cc0: 20 63 70 75 6c 6f 61 64 29 20 20 28 62 65 67 69 cpuload) (begi
2cd0: 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 n (debug:print 0
2ce0: 20 22 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 4f "WARNING: CPULO
2cf0: 41 44 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 AD not found.")
2d00: 20 28 73 65 74 21 20 63 70 75 6c 6f 61 64 20 22 (set! cpuload "
2d10: 6e 2f 61 22 29 29 29 0a 09 09 09 09 20 20 20 20 n/a"))).....
2d20: 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 64 ;; (if (not d
2d30: 69 73 6b 66 72 65 65 29 20 28 62 65 67 69 6e 20 iskfree) (begin
2d40: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2d50: 57 41 52 4e 49 4e 47 3a 20 44 49 53 4b 46 52 45 WARNING: DISKFRE
2d60: 45 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 28 E not found.") (
2d70: 73 65 74 21 20 64 69 73 6b 66 72 65 65 20 22 6e set! diskfree "n
2d80: 2f 61 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 /a"))).....
2d90: 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 (set! kill-job
2da0: 3f 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ? (open-run-clos
2db0: 65 20 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d e test-get-kill-
2dc0: 72 65 71 75 65 73 74 20 23 66 20 74 65 73 74 2d request #f test-
2dd0: 69 64 29 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 id)) ;; run-id t
2de0: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
2df0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6f ))..... (o
2e00: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 pen-run-close te
2e10: 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f st-set-meta-info
2e20: 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d #f test-id run-
2e30: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
2e40: 6d 64 61 74 20 6d 69 6e 75 74 65 73 29 0a 09 09 mdat minutes)...
2e50: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 72 64 62 .. ;; (rdb
2e60: 3a 74 65 73 74 2d 75 70 64 61 74 65 2d 6d 65 74 :test-update-met
2e70: 61 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 a-info db test-i
2e80: 64 20 6d 69 6e 75 74 65 73 20 63 70 75 6c 6f 61 d minutes cpuloa
2e90: 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 66 72 d diskfree tmpfr
2ea0: 65 65 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ee)..... (
2eb0: 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 if kill-job? ...
2ec0: 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ... (begin....
2ed0: 09 09 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f .. (mutex-lo
2ee0: 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 ck! m)......
2ef0: 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 (let* ((pid (ve
2f00: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2f10: 66 6f 20 30 29 29 29 0a 09 09 09 09 09 20 20 20 fo 0)))......
2f20: 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f (if (number?
2f30: 20 70 69 64 29 0a 09 09 09 09 09 09 20 20 20 28 pid)....... (
2f40: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
2f50: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
2f60: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
2f70: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
2f80: 6c 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 ll job (attempt
2f90: 23 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 # " kill-tries "
2fa0: 29 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 )")....... (
2fb0: 6c 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 20 let ((processes
2fc0: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 (cmd-run->list (
2fd0: 63 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 2d conc "pgrep -l -
2fe0: 50 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 P " pid)))).....
2ff0: 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 .. (for-ea
3000: 63 68 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 ch ........(lamb
3010: 64 61 20 28 70 29 0a 09 09 09 09 09 09 09 20 20 da (p)........
3020: 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 (let* ((parts (
3030: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 string-split p))
3040: 0a 09 09 09 09 09 09 09 09 20 28 70 2d 69 64 20 ......... (p-id
3050: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
3060: 20 70 61 72 74 73 29 20 30 29 0a 09 09 09 09 09 parts) 0)......
3070: 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 .... (string
3080: 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 ->number (car pa
3090: 72 74 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 rts))..........
30a0: 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 #f))).......
30b0: 09 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 09 . (if p-id...
30c0: 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ......(begin....
30d0: 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ..... (debug:pr
30e0: 69 6e 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 int 0 "Killing "
30f0: 20 28 63 61 64 72 20 70 61 72 74 73 29 20 22 3b (cadr parts) ";
3100: 20 6b 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 kill -9 " p-id
3110: 29 0a 09 09 09 09 09 09 09 09 20 20 28 73 79 73 )......... (sys
3120: 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 tem (conc "kill
3130: 2d 39 20 22 20 70 2d 69 64 29 29 29 29 29 29 0a -9 " p-id)))))).
3140: 09 09 09 09 09 09 09 28 63 61 72 20 70 72 6f 63 .......(car proc
3150: 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 20 20 esses)).......
3160: 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f (system (co
3170: 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 69 nc "kill -9 " pi
3180: 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 d))))....... (
3190: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
31a0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
31b0: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
31c0: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
31d0: 6c 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c ll job but probl
31e0: 65 6d 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c em with process,
31f0: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b attempting to k
3200: 69 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 ill manager proc
3210: 65 73 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 ess").......
3220: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
3230: 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 test-set-status
3240: 21 20 23 66 20 74 65 73 74 2d 69 64 20 22 4b 49 ! #f test-id "KI
3250: 4c 4c 45 44 22 20 20 22 46 41 49 4c 22 0a 09 09 LLED" "FAIL"...
3260: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 61 72 ...... (ar
3270: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
3280: 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 20 #f).......
3290: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
32a0: 65 21 20 74 64 62 29 0a 09 09 09 09 09 09 20 20 e! tdb).......
32b0: 20 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 (exit 1))))..
32c0: 09 09 09 09 20 20 20 20 20 28 73 65 74 21 20 6b .... (set! k
32d0: 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 31 20 6b ill-tries (+ 1 k
32e0: 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 09 09 09 ill-tries)).....
32f0: 09 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c . (mutex-unl
3300: 6f 63 6b 21 20 6d 29 29 29 0a 09 09 09 09 20 20 ock! m))).....
3310: 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 ;; (sqlite3
3320: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
3330: 09 09 09 20 20 20 20 20 20 20 28 74 68 72 65 61 ... (threa
3340: 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 30 20 28 d-sleep! (+ 10 (
3350: 72 61 6e 64 6f 6d 20 31 30 29 29 29 20 3b 3b 20 random 10))) ;;
3360: 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 add some jitter
3370: 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 to the call home
3380: 20 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 time to spread
3390: 6f 75 74 20 74 68 65 20 64 62 20 61 63 63 65 73 out the db acces
33a0: 73 65 73 0a 09 09 09 09 20 20 20 20 20 20 20 28 ses..... (
33b0: 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 loop (calc-minut
33c0: 65 73 29 29 29 29 29 29 29 0a 09 09 20 28 74 68 es)))))))... (th
33d0: 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 1 (make
33e0: 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 6a -thread monitorj
33f0: 6f 62 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 ob))... (th2
3400: 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 (make-thre
3410: 61 64 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 ad runit)))..
3420: 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 (set! job-threa
3430: 64 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 d th2).. (thr
3440: 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a ead-start! th1).
3450: 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 . (thread-sta
3460: 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 28 74 rt! th2).. (t
3470: 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 hread-join! th2)
3480: 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 .. (mutex-loc
3490: 6b 21 20 6d 29 0a 09 20 20 20 20 3b 3b 20 28 73 k! m).. ;; (s
34a0: 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 et! db (open-db)
34b0: 29 0a 09 20 20 20 20 3b 3b 20 28 69 66 20 28 6e ).. ;; (if (n
34c0: 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 ot (args:get-arg
34d0: 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 20 20 "-server"))..
34e0: 20 20 3b 3b 09 28 73 65 72 76 65 72 3a 63 6c 69 ;;.(server:cli
34f0: 65 6e 74 2d 73 65 74 75 70 20 64 62 29 29 0a 09 ent-setup db))..
3500: 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d (let* ((item
3510: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
3520: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
3530: 0a 09 09 20 20 20 28 74 65 73 74 69 6e 66 6f 20 ... (testinfo
3540: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
3550: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 db:get-test-inf
3560: 6f 2d 62 79 2d 69 64 20 23 66 20 74 65 73 74 2d o-by-id #f test-
3570: 69 64 29 29 29 20 3b 3b 20 29 29 20 3b 3b 20 72 id))) ;; )) ;; r
3580: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
3590: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 item-path)))..
35a0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
35b0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
35c0: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
35d0: 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a ) "COMPLETED")).
35e0: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 .. (begin...
35f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
3600: 22 54 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 "Test NOT logged
3610: 20 61 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 as COMPLETED, (
3620: 73 74 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 state=" (db:test
3630: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 -get-state testi
3640: 6e 66 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e nfo) "), updatin
3650: 67 20 72 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 g result, rollup
3660: 2d 73 74 61 74 75 73 20 69 73 20 22 20 72 6f 6c -status is " rol
3670: 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 20 20 lup-status)...
3680: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
3690: 65 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 e test-set-statu
36a0: 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 0a 09 s! #f test-id ..
36b0: 09 09 09 20 20 20 20 20 20 28 69 66 20 6b 69 6c ... (if kil
36c0: 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 l-job? "KILLED"
36d0: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 "COMPLETED")....
36e0: 09 20 20 20 20 20 20 3b 3b 20 4f 6c 64 20 6c 6f . ;; Old lo
36f0: 67 69 63 3a 0a 09 09 09 09 20 20 20 20 20 20 3b gic:..... ;
3700: 3b 20 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 ; (if (vector-re
3710: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b f exit-info 1) ;
3720: 3b 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 65 78 ; look at the ex
3730: 69 74 2d 73 74 61 74 75 73 2c 20 23 74 20 6d 65 it-status, #t me
3740: 61 6e 73 20 69 74 20 61 74 20 6c 65 61 73 74 20 ans it at least
3750: 72 61 6e 0a 09 09 09 09 20 20 20 20 20 20 3b 3b ran..... ;;
3760: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e (if (and (n
3770: 6f 74 20 6b 69 6c 6c 2d 6a 6f 62 3f 29 20 0a 09 ot kill-job?) ..
3780: 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 ... ;;
3790: 20 20 20 20 28 65 71 3f 20 28 76 65 63 74 6f 72 (eq? (vector
37a0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
37b0: 29 20 30 29 29 20 3b 3b 20 77 65 20 63 61 6e 20 ) 0)) ;; we can
37c0: 6e 6f 77 20 75 73 65 20 72 6f 6c 6c 75 70 2d 73 now use rollup-s
37d0: 74 61 74 75 73 20 69 6e 73 74 65 61 64 0a 09 09 tatus instead...
37e0: 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 .. ;;
37f0: 20 20 20 22 50 41 53 53 22 0a 09 09 09 09 20 20 "PASS".....
3800: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 22 ;; "
3810: 46 41 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 FAIL").....
3820: 20 3b 3b 20 20 20 20 20 22 46 41 49 4c 22 29 20 ;; "FAIL")
3830: 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 4e 65 ..... ;; Ne
3840: 77 20 6c 6f 67 69 63 20 62 61 73 65 64 20 6f 6e w logic based on
3850: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a 09 rollup-status..
3860: 09 09 09 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 ... (cond..
3870: 09 09 09 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ... ((not
3880: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
3890: 2d 69 6e 66 6f 20 31 29 29 20 22 46 41 49 4c 22 -info 1)) "FAIL"
38a0: 29 20 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 64 20 ) ;; job failed
38b0: 74 6f 20 72 75 6e 0a 09 09 09 09 20 20 20 20 20 to run.....
38c0: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
38d0: 74 61 74 75 73 20 30 29 0a 09 09 09 09 09 3b 3b tatus 0)......;;
38e0: 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 if the current
38f0: 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 status is AUTO t
3900: 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 he defer to the
3910: 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 calculated value
3920: 20 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 (i.e. leave thi
3930: 73 20 41 55 54 4f 29 0a 09 09 09 09 09 28 69 66 s AUTO)......(if
3940: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes
3950: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
3960: 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 tinfo) "AUTO") "
3970: 41 55 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 AUTO" "PASS"))..
3980: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
3990: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 rollup-status 1)
39a0: 20 22 46 41 49 4c 22 29 0a 09 09 09 09 20 20 20 "FAIL").....
39b0: 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 ((eq? rollup
39c0: 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 09 -status 2)......
39d0: 3b 3b 20 69 66 20 74 68 65 20 63 75 72 72 65 6e ;; if the curren
39e0: 74 20 73 74 61 74 75 73 20 69 73 20 41 55 54 4f t status is AUTO
39f0: 20 74 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 the defer to th
3a00: 65 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c e calculated val
3a10: 75 65 20 62 75 74 20 71 75 61 6c 69 66 79 20 28 ue but qualify (
3a20: 69 2e 65 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 i.e. make this A
3a30: 55 54 4f 2d 57 41 52 4e 29 0a 09 09 09 09 09 28 UTO-WARN)......(
3a40: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
3a50: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
3a60: 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 estinfo) "AUTO")
3a70: 20 22 41 55 54 4f 2d 57 41 52 4e 22 20 22 57 41 "AUTO-WARN" "WA
3a80: 52 4e 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 RN")).....
3a90: 20 28 65 6c 73 65 20 22 46 41 49 4c 22 29 29 0a (else "FAIL")).
3aa0: 09 09 09 09 20 20 20 20 20 20 28 61 72 67 73 3a .... (args:
3ab0: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 get-arg "-m") #f
3ac0: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f ))).. ;; fo
3ad0: 72 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 r automated crea
3ae0: 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c tion of the roll
3af0: 75 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 up html file thi
3b00: 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 s is a good plac
3b10: 65 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 e..... (if
3b20: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 (not (equal? ite
3b30: 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 m-path ""))...
3b40: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
3b50: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
3b60: 69 74 65 6d 73 20 23 66 20 72 75 6e 2d 69 64 20 items #f run-id
3b70: 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 3b test-name #f)) ;
3b80: 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 ; don't force -
3b90: 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e just update if n
3ba0: 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 o.. )..
3bb0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
3bc0: 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 65 63 2d ).. ;; (exec-
3bd0: 72 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e results (cmd-run
3be0: 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 ->list fullrunsc
3bf0: 72 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 ript)) ;; (list
3c00: 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ">" (conc test-
3c10: 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 name "-run.log")
3c20: 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 73 75 63 ))).. ;; (suc
3c30: 63 65 73 73 20 20 20 20 20 20 65 78 65 63 2d 72 cess exec-r
3c40: 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f esults)) ;; (eq?
3c50: 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 75 (cadr exec-resu
3c60: 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 28 lts) 0))).. (
3c70: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f debug:print 2 "O
3c80: 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 utput from runni
3c90: 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 ng " fullrunscri
3ca0: 70 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 pt ", pid " (vec
3cb0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3cc0: 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 o 0) " in work a
3cd0: 72 65 61 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d rea " .... work-
3ce0: 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 area ":\n====\n
3cf0: 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 63 exit code " (vec
3d00: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3d10: 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c o 2) "\n" "====\
3d20: 6e 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c n").. ;; (sql
3d30: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
3d40: 62 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 b).. ;; (sqli
3d50: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 te3:finalize! td
3d60: 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 b).. (if (not
3d70: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
3d80: 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 28 65 78 t-info 1))...(ex
3d90: 69 74 20 34 29 29 29 29 29 29 29 0a 0a 3b 3b 20 it 4)))))))..;;
3da0: 73 65 74 20 75 70 20 74 68 65 20 76 65 72 79 20 set up the very
3db0: 62 61 73 69 63 73 20 6e 65 65 64 65 64 20 66 6f basics needed fo
3dc0: 72 20 64 6f 69 6e 67 20 61 6e 79 74 68 69 6e 67 r doing anything
3dd0: 20 68 65 72 65 2e 0a 28 64 65 66 69 6e 65 20 28 here..(define (
3de0: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 setup-for-run).
3df0: 20 3b 3b 20 77 6f 75 6c 64 20 73 65 74 20 76 61 ;; would set va
3e00: 6c 75 65 73 20 66 6f 72 20 4b 45 59 53 20 69 6e lues for KEYS in
3e10: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 the environment
3e20: 20 68 65 72 65 20 66 6f 72 20 62 65 74 74 65 72 here for better
3e30: 20 73 75 70 70 6f 72 74 20 6f 66 20 65 6e 76 2d support of env-
3e40: 6f 76 65 72 72 69 64 65 20 62 75 74 20 0a 20 20 override but .
3e50: 3b 3b 20 68 61 76 65 20 63 68 69 63 6b 65 6e 2f ;; have chicken/
3e60: 65 67 67 20 73 63 65 6e 61 72 69 6f 2e 20 6e 65 egg scenario. ne
3e70: 65 64 20 74 6f 20 72 65 61 64 20 6d 65 67 61 74 ed to read megat
3e80: 65 73 74 2e 63 6f 6e 66 69 67 20 74 68 65 6e 20 est.config then
3e90: 72 65 61 64 20 69 74 20 61 67 61 69 6e 2e 20 47 read it again. G
3ea0: 6f 69 6e 67 20 74 6f 20 0a 20 20 3b 3b 20 70 61 oing to . ;; pa
3eb0: 73 73 20 6f 6e 20 74 68 61 74 20 69 64 65 61 20 ss on that idea
3ec0: 66 6f 72 20 6e 6f 77 0a 20 20 3b 3b 20 73 70 65 for now. ;; spe
3ed0: 63 69 61 6c 20 63 61 73 65 0a 20 20 28 73 65 74 cial case. (set
3ee0: 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 ! *configinfo* (
3ef0: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
3f00: 6e 66 69 67 20 0a 09 09 20 20 20 20 20 20 28 69 nfig ... (i
3f10: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3f20: 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 67 73 3a "-config")(args:
3f30: 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 get-arg "-config
3f40: 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e ") "megatest.con
3f50: 66 69 67 22 29 0a 09 09 20 20 20 20 20 20 65 6e fig")... en
3f60: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 viron-patt: "env
3f70: 2d 6f 76 65 72 72 69 64 65 22 0a 09 09 20 20 20 -override"...
3f80: 20 20 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 given-toppath
3f90: 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 : (get-environme
3fa0: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f nt-variable "MT_
3fb0: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 RUN_AREA_HOME"))
3fc0: 29 0a 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 ). (set! *confi
3fd0: 67 64 61 74 2a 20 20 28 69 66 20 28 63 61 72 20 gdat* (if (car
3fe0: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 *configinfo*)(ca
3ff0: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 r *configinfo*)
4000: 23 66 29 29 0a 20 20 28 73 65 74 21 20 2a 74 6f #f)). (set! *to
4010: 70 70 61 74 68 2a 20 20 20 20 28 69 66 20 28 63 ppath* (if (c
4020: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
4030: 28 63 61 64 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (cadr *configinf
4040: 6f 2a 29 20 23 66 29 29 0a 20 20 28 69 66 20 2a o*) #f)). (if *
4050: 74 6f 70 70 61 74 68 2a 0a 20 20 20 20 20 20 28 toppath*. (
4060: 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 setenv "MT_RUN_A
4070: 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 REA_HOME" *toppa
4080: 74 68 2a 29 20 3b 3b 20 74 6f 20 62 65 20 64 65 th*) ;; to be de
4090: 70 72 65 63 61 74 65 64 0a 20 20 20 20 20 20 28 precated. (
40a0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
40b0: 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 RROR: failed to
40c0: 66 69 6e 64 20 74 68 65 20 74 6f 70 20 70 61 74 find the top pat
40d0: 68 20 74 6f 20 79 6f 75 72 20 72 75 6e 20 73 65 h to your run se
40e0: 74 75 70 2e 22 29 29 0a 20 20 2a 74 6f 70 70 61 tup.")). *toppa
40f0: 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 th*)..(define (g
4100: 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 63 6f 6e et-best-disk con
4110: 66 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 fdat). (let* ((
4120: 64 69 73 6b 73 20 20 20 20 28 68 61 73 68 2d 74 disks (hash-t
4130: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
4140: 20 63 6f 6e 66 64 61 74 20 22 64 69 73 6b 73 22 confdat "disks"
4150: 20 23 66 29 29 0a 09 20 28 62 65 73 74 20 20 20 #f)).. (best
4160: 20 20 23 66 29 0a 09 20 28 62 65 73 74 73 69 7a #f).. (bestsiz
4170: 65 20 30 29 29 0a 20 20 20 20 28 69 66 20 64 69 e 0)). (if di
4180: 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 63 68 20 sks ..(for-each
4190: 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 69 73 6b .. (lambda (disk
41a0: 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 74 2a 20 -num).. (let*
41b0: 28 28 64 69 72 70 61 74 68 20 20 20 20 28 63 61 ((dirpath (ca
41c0: 64 72 20 28 61 73 73 6f 63 20 64 69 73 6b 2d 6e dr (assoc disk-n
41d0: 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 09 20 20 um disks)))...
41e0: 28 66 72 65 65 73 70 63 20 20 20 20 28 69 66 20 (freespc (if
41f0: 28 61 6e 64 20 28 64 69 72 65 63 74 6f 72 79 3f (and (directory?
4200: 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 20 20 dirpath).....
4210: 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 74 65 (file-write
4220: 2d 61 63 63 65 73 73 3f 20 64 69 72 70 61 74 68 -access? dirpath
4230: 29 29 0a 09 09 09 09 20 20 28 67 65 74 2d 64 66 ))..... (get-df
4240: 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 20 20 dirpath).....
4250: 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 28 (begin..... (
4260: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
4270: 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 22 20 64 ARNING: path " d
4280: 69 72 70 61 74 68 20 22 20 69 6e 20 5b 64 69 73 irpath " in [dis
4290: 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e 6f 74 20 ks] section not
42a0: 76 61 6c 69 64 20 6f 72 20 77 72 69 74 61 62 6c valid or writabl
42b0: 65 22 29 0a 09 09 09 09 20 20 20 20 30 29 29 29 e")..... 0)))
42c0: 29 0a 09 20 20 20 20 20 28 69 66 20 28 3e 20 66 ).. (if (> f
42d0: 72 65 65 73 70 63 20 62 65 73 74 73 69 7a 65 29 reespc bestsize)
42e0: 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 20 ... (begin...
42f0: 28 73 65 74 21 20 62 65 73 74 20 20 20 20 20 64 (set! best d
4300: 69 72 70 61 74 68 29 0a 09 09 20 20 20 28 73 65 irpath)... (se
4310: 74 21 20 62 65 73 74 73 69 7a 65 20 66 72 65 65 t! bestsize free
4320: 73 70 63 29 29 29 29 29 0a 09 20 28 6d 61 70 20 spc))))).. (map
4330: 63 61 72 20 64 69 73 6b 73 29 29 29 0a 20 20 20 car disks))).
4340: 20 28 69 66 20 62 65 73 74 0a 09 62 65 73 74 0a (if best..best.
4350: 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 .(begin.. (debu
4360: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
4370: 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 73 6b 73 : No valid disks
4380: 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 61 74 65 found in megate
4390: 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c 65 61 73 st.config. Pleas
43a0: 65 20 61 64 64 20 73 6f 6d 65 20 74 6f 20 79 6f e add some to yo
43b0: 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 69 ur [disks] secti
43c0: 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 20 31 29 on").. (exit 1)
43d0: 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 72 65 64 ))))..;; Desired
43e0: 20 64 69 72 65 63 74 6f 72 79 20 73 74 72 75 63 directory struc
43f0: 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 3c 6c 69 ture:.;;.;; <li
4400: 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 nkdir> - <target
4410: 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d > - <testname> -
4420: 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ..;;
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b 20 20 20 |.;;
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 69 72 3e v.;; <rundir>
4480: 20 20 2d 20 20 3c 74 61 72 67 65 74 3e 20 20 2d - <target> -
4490: 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d <testname> -
44a0: 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 73 29 3e |- <itempath(s)>
44b0: 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 74 6f 72 .;;.;; dir stor
44c0: 65 64 20 69 6e 20 74 65 73 74 20 69 73 3a 0a 3b ed in test is:.;
44d0: 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e ; .;; <linkdir>
44e0: 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 - <target> - <t
44f0: 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 estname> [ - <it
4500: 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 0a 3b 3b empath> ].;; .;;
4510: 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 20 6c 69 All log file li
4520: 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 20 73 74 nks should be st
4530: 6f 72 65 64 20 72 65 6c 61 74 69 76 65 20 74 6f ored relative to
4540: 20 74 68 65 20 74 6f 70 20 6f 66 20 6c 69 6e 6b the top of link
4550: 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b 20 3c 74 path.;; .;; <t
4560: 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 arget> - <testna
4570: 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 me> [ - <itempat
4580: 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 h> ] .;;.(define
4590: 20 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 (create-work-ar
45a0: 65 61 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ea db run-id tes
45b0: 74 2d 69 64 20 74 65 73 74 2d 73 72 63 2d 70 61 t-id test-src-pa
45c0: 74 68 20 64 69 73 6b 2d 70 61 74 68 20 74 65 73 th disk-path tes
45d0: 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 tname itemdat).
45e0: 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 6e 66 (let* ((run-inf
45f0: 6f 20 28 64 62 3a 67 65 74 2d 72 75 6e 2d 69 6e o (db:get-run-in
4600: 66 6f 20 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 fo db run-id))..
4610: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 (item-path (ite
4620: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
4630: 6d 64 61 74 29 29 0a 09 20 28 72 75 6e 6e 61 6d mdat)).. (runnam
4640: 65 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 e (db:get-value
4650: 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a 67 -by-header (db:g
4660: 65 74 2d 72 6f 77 20 72 75 6e 2d 69 6e 66 6f 29 et-row run-info)
4670: 0a 09 09 09 09 09 20 20 20 28 64 62 3a 67 65 74 ...... (db:get
4680: 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 6e 66 6f -header run-info
4690: 29 0a 09 09 09 09 09 20 20 20 22 72 75 6e 6e 61 )...... "runna
46a0: 6d 65 22 29 29 0a 09 20 3b 3b 20 63 6f 6e 76 65 me")).. ;; conve
46b0: 72 74 20 62 61 63 6b 20 74 6f 20 64 62 3a 20 66 rt back to db: f
46c0: 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 69 73 20 rom rdb: - this
46d0: 69 73 20 61 6c 77 61 79 73 20 72 75 6e 20 61 74 is always run at
46e0: 20 73 65 72 76 65 72 20 65 6e 64 0a 09 20 28 6b server end.. (k
46f0: 65 79 2d 76 61 6c 73 20 28 64 62 3a 67 65 74 2d ey-vals (db:get-
4700: 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 75 6e 2d key-vals db run-
4710: 69 64 29 29 0a 09 20 28 74 61 72 67 65 74 20 20 id)).. (target
4720: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
4730: 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 2f erse key-vals "/
4740: 22 29 29 0a 0a 09 20 28 6e 6f 74 2d 69 74 65 72 "))... (not-iter
4750: 61 74 65 64 20 20 28 65 71 75 61 6c 3f 20 22 22 ated (equal? ""
4760: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 item-path))...
4770: 3b 3b 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 ;; all tests are
4780: 20 66 6f 75 6e 64 20 61 74 20 3c 72 75 6e 64 69 found at <rundi
4790: 72 3e 2f 74 65 73 74 2d 62 61 73 65 20 6f 72 20 r>/test-base or
47a0: 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 73 74 2d 62 <linkdir>/test-b
47b0: 61 73 65 0a 09 20 28 74 65 73 74 74 6f 70 2d 62 ase.. (testtop-b
47c0: 61 73 65 20 28 63 6f 6e 63 20 74 61 72 67 65 74 ase (conc target
47d0: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f 22 "/" runname "/"
47e0: 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 74 testname)).. (t
47f0: 65 73 74 2d 62 61 73 65 20 20 20 20 28 63 6f 6e est-base (con
4800: 63 20 74 65 73 74 74 6f 70 2d 62 61 73 65 20 28 c testtop-base (
4810: 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 if not-iterated
4820: 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 "" "/") item-pat
4830: 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 2f 2f 20 69 h))... ;; nb// i
4840: 66 20 69 74 65 6d 70 61 74 68 20 69 73 20 6e 6f f itempath is no
4850: 74 20 22 22 20 74 68 65 6e 20 69 74 20 69 73 20 t "" then it is
4860: 70 72 65 66 69 78 65 64 20 77 69 74 68 20 22 2f prefixed with "/
4870: 22 0a 09 20 28 74 6f 70 74 65 73 74 2d 70 61 74 ".. (toptest-pat
4880: 68 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 74 h (conc disk-pat
4890: 68 20 22 2f 22 20 74 65 73 74 74 6f 70 2d 62 61 h "/" testtop-ba
48a0: 73 65 29 29 0a 09 20 28 74 65 73 74 2d 70 61 74 se)).. (test-pat
48b0: 68 20 20 20 20 28 63 6f 6e 63 20 64 69 73 6b 2d h (conc disk-
48c0: 70 61 74 68 20 22 2f 22 20 74 65 73 74 2d 62 61 path "/" test-ba
48d0: 73 65 29 29 0a 0a 09 20 3b 3b 20 65 6e 73 75 72 se))... ;; ensur
48e0: 65 20 74 68 69 73 20 65 78 69 73 74 73 20 66 69 e this exists fi
48f0: 72 73 74 20 61 73 20 6c 69 6e 6b 73 20 74 6f 20 rst as links to
4900: 73 75 62 74 65 73 74 73 20 6d 75 73 74 20 62 65 subtests must be
4910: 20 63 72 65 61 74 65 64 20 74 68 65 72 65 0a 09 created there..
4920: 20 28 6c 69 6e 6b 74 72 65 65 20 20 28 6c 65 74 (linktree (let
4930: 20 28 28 72 64 20 28 63 6f 6e 66 69 67 2d 6c 6f ((rd (config-lo
4940: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
4950: 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 "setup" "linktr
4960: 65 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 69 ee")))... (i
4970: 66 20 72 64 20 72 64 20 28 63 6f 6e 63 20 2a 74 f rd rd (conc *t
4980: 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 22 29 oppath* "/runs")
4990: 29 29 29 0a 0a 09 20 28 6c 6e 6b 62 61 73 65 20 )))... (lnkbase
49a0: 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 (conc linktree
49b0: 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 "/" target "/" r
49c0: 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 unname)).. (lnkp
49d0: 61 74 68 20 20 28 63 6f 6e 63 20 6c 6e 6b 62 61 ath (conc lnkba
49e0: 73 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 se "/" testname)
49f0: 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 20 28 63 ).. (lnkpathf (c
4a00: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 69 66 20 onc lnkpath (if
4a10: 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 22 20 not-iterated ""
4a20: 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 29 29 "/") item-path))
4a30: 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 61 74 65 ).. ;; Update
4a40: 20 74 68 65 20 72 75 6e 64 69 72 20 70 61 74 68 the rundir path
4a50: 20 69 6e 20 74 68 65 20 74 65 73 74 20 72 65 63 in the test rec
4a60: 6f 72 64 20 66 6f 72 20 61 6c 6c 0a 20 20 20 20 ord for all.
4a70: 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e (db:test-set-run
4a80: 64 69 72 21 20 64 62 20 72 75 6e 2d 69 64 20 74 dir! db run-id t
4a90: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
4aa0: 68 20 6c 6e 6b 70 61 74 68 66 29 0a 0a 20 20 20 h lnkpathf)..
4ab0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
4ac0: 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 20 20 20 6c "INFO:\n l
4ad0: 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b 62 61 73 65 nkbase=" lnkbase
4ae0: 20 22 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 70 61 "\n lnkpa
4af0: 74 68 3d 22 20 6c 6e 6b 70 61 74 68 20 22 5c 6e th=" lnkpath "\n
4b00: 20 20 74 6f 70 74 65 73 74 2d 70 61 74 68 3d 22 toptest-path="
4b10: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 22 5c toptest-path "\
4b20: 6e 20 20 20 20 20 74 65 73 74 2d 70 61 74 68 3d n test-path=
4b30: 22 20 74 65 73 74 2d 70 61 74 68 29 0a 20 20 20 " test-path).
4b40: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file-
4b50: 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 exists? linktree
4b60: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
4b70: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
4b80: 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 72 65 65 20 RNING: linktree
4b90: 64 69 64 20 6e 6f 74 20 65 78 69 73 74 21 20 43 did not exist! C
4ba0: 72 65 61 74 69 6e 67 20 69 74 20 6e 6f 77 20 61 reating it now a
4bb0: 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 0a 09 20 t " linktree)..
4bc0: 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f (create-directo
4bd0: 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 29 ry linktree #t))
4be0: 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 6f ) ;; (system (co
4bf0: 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c nc "mkdir -p " l
4c00: 69 6e 6b 74 72 65 65 29 29 29 29 0a 20 20 20 20 inktree)))).
4c10: 3b 3b 20 63 72 65 61 74 65 20 74 68 65 20 64 69 ;; create the di
4c20: 72 65 63 74 6f 72 79 20 66 6f 72 20 74 68 65 20 rectory for the
4c30: 74 65 73 74 73 20 64 69 72 20 6c 69 6e 6b 73 2c tests dir links,
4c40: 20 74 68 69 73 20 69 73 20 6e 65 65 64 65 64 20 this is needed
4c50: 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 74 2e 2e no matter what..
4c60: 2e 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
4c70: 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
4c80: 3f 20 6c 6e 6b 62 61 73 65 29 29 0a 09 28 63 72 ? lnkbase))..(cr
4c90: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c eate-directory l
4ca0: 6e 6b 62 61 73 65 20 23 74 29 29 0a 20 20 20 20 nkbase #t)).
4cb0: 0a 20 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 . ;; update t
4cc0: 68 65 20 74 6f 70 74 65 73 74 20 72 65 63 6f 72 he toptest recor
4cd0: 64 20 77 69 74 68 20 69 74 73 20 6c 6f 63 61 74 d with its locat
4ce0: 69 6f 6e 20 72 75 6e 64 69 72 2c 20 63 61 63 68 ion rundir, cach
4cf0: 65 20 74 68 65 20 70 61 74 68 0a 20 20 20 20 3b e the path. ;
4d00: 3b 20 54 68 69 73 20 77 61 73 73 20 68 69 67 68 ; This wass high
4d10: 6c 79 20 69 6e 65 66 66 69 63 69 65 6e 74 2c 20 ly inefficient,
4d20: 6f 6e 65 20 64 62 20 77 72 69 74 65 20 66 6f 72 one db write for
4d30: 20 65 76 65 72 79 20 73 75 62 74 65 73 74 2c 20 every subtest,
4d40: 70 6f 74 65 6e 74 69 61 6c 6c 79 0a 20 20 20 20 potentially.
4d50: 3b 3b 20 74 68 6f 75 73 61 6e 64 73 20 6f 66 20 ;; thousands of
4d60: 75 6e 6e 65 63 65 73 73 61 72 79 20 75 70 64 61 unnecessary upda
4d70: 74 65 73 2c 20 63 61 63 68 65 20 74 68 65 20 66 tes, cache the f
4d80: 61 63 74 20 69 74 20 77 61 73 20 73 65 74 20 61 act it was set a
4d90: 6e 64 20 64 6f 6e 27 74 20 73 65 74 20 69 74 20 nd don't set it
4da0: 0a 20 20 20 20 3b 3b 20 61 67 61 69 6e 2e 20 0a . ;; again. .
4db0: 0a 20 20 20 20 3b 3b 20 4e 42 20 2d 20 54 68 69 . ;; NB - Thi
4dc0: 73 20 69 73 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 s is not working
4dd0: 20 72 69 67 68 74 20 2d 20 73 6f 6d 65 20 74 6f right - some to
4de0: 70 20 74 65 73 74 73 20 61 72 65 20 6e 6f 74 20 p tests are not
4df0: 67 65 74 74 69 6e 67 20 74 68 65 20 70 61 74 68 getting the path
4e00: 20 73 65 74 21 21 21 0a 0a 20 20 20 20 28 69 66 set!!!.. (if
4e10: 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c (not (hash-tabl
4e20: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 e-ref/default *t
4e30: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
4e40: 73 74 6e 61 6d 65 20 23 66 29 29 0a 09 28 6c 65 stname #f))..(le
4e50: 74 2a 20 28 28 74 65 73 74 69 6e 66 6f 20 20 20 t* ((testinfo
4e60: 20 20 20 20 28 64 62 3a 67 65 74 2d 74 65 73 74 (db:get-test
4e70: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 62 20 74 -info-by-id db t
4e80: 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e est-id)) ;; run
4e90: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 -id testname ite
4ea0: 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 m-path))..
4eb0: 20 28 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 (curr-test-path
4ec0: 20 28 69 66 20 74 65 73 74 69 6e 66 6f 20 28 64 (if testinfo (d
4ed0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
4ee0: 72 20 74 65 73 74 69 6e 66 6f 29 20 23 66 29 29 r testinfo) #f))
4ef0: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table
4f00: 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 -set! *toptest-p
4f10: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 63 aths* testname c
4f20: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 urr-test-path)..
4f30: 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 (db:test-set-r
4f40: 75 6e 64 69 72 21 20 64 62 20 72 75 6e 2d 69 64 undir! db run-id
4f50: 20 74 65 73 74 6e 61 6d 65 20 22 22 20 6c 6e 6b testname "" lnk
4f60: 70 61 74 68 29 20 3b 3b 20 74 6f 70 74 65 73 74 path) ;; toptest
4f70: 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f -path).. (if (o
4f80: 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 r (not curr-test
4f90: 2d 70 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 -path)... (not
4fa0: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
4fb0: 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 s? toptest-path)
4fc0: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
4fd0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
4fe0: 32 20 22 49 4e 46 4f 3a 20 43 72 65 61 74 69 6e 2 "INFO: Creatin
4ff0: 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 g " toptest-path
5000: 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c 6e " and link " ln
5010: 6b 70 61 74 68 29 0a 09 09 28 63 72 65 61 74 65 kpath)...(create
5020: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 74 65 -directory topte
5030: 73 74 2d 70 61 74 68 20 23 74 29 0a 09 09 28 68 st-path #t)...(h
5040: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
5050: 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 toptest-paths* t
5060: 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d estname toptest-
5070: 70 61 74 68 29 29 29 29 29 0a 0a 20 20 20 20 3b path))))).. ;
5080: 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 74 68 65 ; Now create the
5090: 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 20 74 link from the t
50a0: 65 73 74 20 70 61 74 68 20 74 6f 20 74 68 65 20 est path to the
50b0: 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 65 76 link tree, howev
50c0: 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 68 65 er. ;; if the
50d0: 20 74 65 73 74 20 69 73 20 69 74 65 72 61 74 65 test is iterate
50e0: 64 20 69 74 20 69 73 20 6e 65 63 65 73 73 61 72 d it is necessar
50f0: 79 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 y to create the
5100: 70 61 72 65 6e 74 20 70 61 74 68 0a 20 20 20 20 parent path.
5110: 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 72 61 74 ;; to the iterat
5120: 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e 61 6d ion. use pathnam
5130: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 20 74 e-directory to t
5140: 72 69 6d 20 74 68 65 20 70 61 74 68 20 62 79 20 rim the path by
5150: 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 65 6c one. ;; level
5160: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f . (if (not no
5170: 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 69 t-iterated) ;; i
5180: 2e 65 2e 20 69 74 65 72 61 74 65 64 0a 09 28 6c .e. iterated..(l
5190: 65 74 20 28 28 69 74 65 72 61 74 65 64 2d 70 61 et ((iterated-pa
51a0: 72 65 6e 74 20 20 28 70 61 74 68 6e 61 6d 65 2d rent (pathname-
51b0: 64 69 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 directory (conc
51c0: 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d lnkpath "/" item
51d0: 2d 70 61 74 68 29 29 29 29 0a 09 20 20 28 64 65 -path)))).. (de
51e0: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 bug:print 2 "INF
51f0: 4f 3a 20 43 72 65 61 74 69 6e 67 20 69 74 65 72 O: Creating iter
5200: 61 74 65 64 20 70 61 72 65 6e 74 20 22 20 69 74 ated parent " it
5210: 65 72 61 74 65 64 2d 70 61 72 65 6e 74 29 0a 09 erated-parent)..
5220: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
5230: 6f 72 79 20 69 74 65 72 61 74 65 64 2d 70 61 72 ory iterated-par
5240: 65 6e 74 20 23 74 29 29 29 0a 20 20 20 20 28 69 ent #t))). (i
5250: 66 20 28 6e 6f 74 20 28 6f 72 20 28 66 69 6c 65 f (not (or (file
5260: 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 61 74 68 -exists? lnkpath
5270: 29 0a 09 09 20 28 73 79 6d 62 6f 6c 69 63 2d 6c )... (symbolic-l
5280: 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 29 29 0a ink? lnkpath))).
5290: 09 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 .(create-symboli
52a0: 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 74 2d 70 c-link toptest-p
52b0: 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 0a 20 20 ath lnkpath)).
52c0: 20 20 0a 20 20 20 20 3b 3b 20 54 68 65 20 74 6f . ;; The to
52d0: 70 74 65 73 74 20 70 61 74 68 20 68 61 73 20 62 ptest path has b
52e0: 65 65 6e 20 63 72 65 61 74 65 64 2c 20 74 68 65 een created, the
52f0: 20 6c 69 6e 6b 20 74 6f 20 74 68 65 20 74 65 73 link to the tes
5300: 74 20 69 6e 20 74 68 65 20 6c 69 6e 6b 74 72 65 t in the linktre
5310: 65 20 68 61 73 0a 20 20 20 20 3b 3b 20 62 65 65 e has. ;; bee
5320: 6e 20 63 72 65 61 74 65 64 2e 20 4e 6f 77 2c 20 n created. Now,
5330: 69 66 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 if this is an it
5340: 65 72 61 74 65 64 20 74 65 73 74 20 74 68 65 20 erated test the
5350: 72 65 61 6c 20 74 65 73 74 20 64 69 72 20 6d 75 real test dir mu
5360: 73 74 20 62 65 20 63 72 65 61 74 65 64 0a 20 20 st be created.
5370: 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 (if (not not-i
5380: 74 65 72 61 74 65 64 29 20 3b 3b 20 74 68 69 73 terated) ;; this
5390: 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 is an iterated
53a0: 74 65 73 74 0a 09 28 6c 65 74 20 28 28 6c 6e 6b test..(let ((lnk
53b0: 74 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e 6b target (conc lnk
53c0: 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 61 path "/" item-pa
53d0: 74 68 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a th))).. (debug:
53e0: 70 72 69 6e 74 20 32 20 22 53 65 74 74 69 6e 67 print 2 "Setting
53f0: 20 75 70 20 73 75 62 20 74 65 73 74 20 72 75 6e up sub test run
5400: 20 61 72 65 61 22 29 0a 09 20 20 28 64 65 62 75 area").. (debu
5410: 67 3a 70 72 69 6e 74 20 32 20 22 20 2d 20 63 72 g:print 2 " - cr
5420: 65 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 20 eating run area
5430: 69 6e 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a in " test-path).
5440: 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 . (create-direc
5450: 74 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 tory test-path #
5460: 74 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 20 28 t) ;; (system (
5470: 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 conc "mkdir -p "
5480: 20 74 65 73 74 2d 70 61 74 68 29 29 0a 09 20 20 test-path))..
5490: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 0a (debug:print 2 .
54a0: 09 09 20 20 20 20 20 20 20 22 20 2d 20 63 72 65 .. " - cre
54b0: 61 74 69 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d 3a ating link from:
54c0: 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 5c 6e " test-path "\n
54d0: 22 0a 09 09 20 20 20 20 20 20 20 22 20 20 20 20 "... "
54e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 t
54f0: 6f 3a 20 22 20 6c 6e 6b 74 61 72 67 65 74 29 0a o: " lnktarget).
5500: 09 20 20 3b 3b 20 28 63 72 65 61 74 65 2d 64 69 . ;; (create-di
5510: 72 65 63 74 6f 72 79 20 6c 6e 6b 70 61 74 68 20 rectory lnkpath
5520: 23 74 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 20 #t) ;; (system
5530: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
5540: 22 20 6c 6e 6b 70 61 74 68 29 29 0a 09 20 20 28 " lnkpath)).. (
5550: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 if (not (file-ex
5560: 69 73 74 73 3f 20 6c 6e 6b 74 61 72 67 65 74 29 ists? lnktarget)
5570: 29 0a 09 20 20 20 20 20 20 28 63 72 65 61 74 65 ).. (create
5580: 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 -symbolic-link t
5590: 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 67 est-path lnktarg
55a0: 65 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 49 et)))).. ;; I
55b0: 20 73 75 73 70 65 63 74 20 74 68 69 73 20 73 65 suspect this se
55c0: 63 74 69 6f 6e 20 77 61 73 20 64 65 6c 65 74 69 ction was deleti
55d0: 6e 67 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 ng test director
55e0: 69 65 73 20 75 6e 64 65 72 20 73 6f 6d 65 20 0a ies under some .
55f0: 20 20 20 20 3b 3b 20 77 69 65 72 64 20 73 69 74 ;; wierd sit
5600: 61 74 69 6f 6e 73 3f 20 54 68 69 73 20 64 6f 65 ations? This doe
5610: 73 6e 27 74 20 6d 61 6b 65 20 73 65 6e 73 65 20 sn't make sense
5620: 2d 20 72 65 65 6e 61 62 6c 69 6e 67 20 74 68 65 - reenabling the
5630: 20 72 6d 20 2d 66 20 0a 20 20 20 20 3b 3b 20 49 rm -f . ;; I
5640: 20 68 6f 6e 65 73 74 6c 79 20 64 6f 6e 27 74 20 honestly don't
5650: 72 65 6d 65 6d 62 65 72 20 2a 77 68 79 2a 20 74 remember *why* t
5660: 68 69 73 20 63 68 75 6e 6b 20 77 61 73 20 6e 65 his chunk was ne
5670: 65 64 65 64 2e 2e 2e 0a 20 20 20 20 3b 3b 20 28 eded.... ;; (
5680: 6c 65 74 20 28 28 74 65 73 74 6c 69 6e 6b 20 28 let ((testlink (
5690: 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 conc lnkpath "/"
56a0: 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 20 20 20 testname))).
56b0: 20 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 28 ;; (if (and (
56c0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 73 file-exists? tes
56d0: 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 tlink). ;;
56e0: 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 72 65 (or (re
56f0: 67 75 6c 61 72 2d 66 69 6c 65 3f 20 74 65 73 74 gular-file? test
5700: 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 20 link). ;;
5710: 20 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 2d 6c . (symbolic-l
5720: 69 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 29 29 ink? testlink)))
5730: 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 73 . ;; (s
5740: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 ystem (conc "rm
5750: 2d 66 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 -f " testlink)))
5760: 0a 20 20 20 20 3b 3b 20 20 20 28 73 79 73 74 65 . ;; (syste
5770: 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d 73 66 m (conc "ln -sf
5780: 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 22 " test-path " "
5790: 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 testlink))).
57a0: 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f (if (directory?
57b0: 20 74 65 73 74 2d 70 61 74 68 29 0a 09 28 62 65 test-path)..(be
57c0: 67 69 6e 0a 09 20 20 28 6c 65 74 2a 20 28 28 63 gin.. (let* ((c
57d0: 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 72 73 79 md (conc "rsy
57e0: 6e 63 20 2d 61 76 22 20 28 69 66 20 28 3e 20 2a nc -av" (if (> *
57f0: 76 65 72 62 6f 73 69 74 79 2a 20 31 29 20 22 22 verbosity* 1) ""
5800: 20 22 71 22 29 20 22 20 22 20 74 65 73 74 2d 73 "q") " " test-s
5810: 72 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 73 rc-path "/ " tes
5820: 74 2d 70 61 74 68 20 22 2f 22 29 29 0a 09 09 20 t-path "/"))...
5830: 28 73 74 61 74 75 73 20 28 73 79 73 74 65 6d 20 (status (system
5840: 63 6d 64 29 29 29 0a 09 20 20 20 20 28 69 66 20 cmd))).. (if
5850: 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 (not (eq? status
5860: 20 30 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 0))...(debug:pr
5870: 69 6e 74 20 32 20 22 45 52 52 4f 52 3a 20 70 72 int 2 "ERROR: pr
5880: 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 6e 6e 69 oblem with runni
5890: 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
58a0: 29 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e 6b 70 )).. (list lnkp
58b0: 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 29 0a athf lnkpath )).
58c0: 09 28 6c 69 73 74 20 23 66 20 23 66 29 29 29 29 .(list #f #f))))
58d0: 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 74 68 6f ..;; 1. look tho
58e0: 75 67 68 20 64 69 73 6b 73 20 6c 69 73 74 20 66 ugh disks list f
58f0: 6f 72 20 64 69 73 6b 20 77 69 74 68 20 6d 6f 73 or disk with mos
5900: 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e 20 63 72 t space.;; 2. cr
5910: 65 61 74 65 20 72 75 6e 20 64 69 72 20 6f 6e 20 eate run dir on
5920: 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 6d 65 20 disk, path name
5930: 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c 0a 3b 3b is meaningful.;;
5940: 20 33 2e 20 63 72 65 61 74 65 20 6c 69 6e 6b 20 3. create link
5950: 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 74 6f 20 from run dir to
5960: 6d 65 67 61 74 65 73 74 20 72 75 6e 73 20 61 72 megatest runs ar
5970: 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d 6f 74 65 ea .;; 4. remote
5980: 6c 79 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 ly run the test
5990: 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 68 6f 73 on allocated hos
59a0: 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 t.;; - could
59b0: 62 65 20 73 73 68 20 74 6f 20 68 6f 73 74 20 66 be ssh to host f
59c0: 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 6c 65 20 rom hosts table
59d0: 28 75 70 64 61 74 65 20 72 65 67 75 6c 61 72 6c (update regularl
59e0: 79 20 77 69 74 68 20 6c 6f 61 64 29 0a 3b 3b 20 y with load).;;
59f0: 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 6e 65 - could be ne
5a00: 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 20 20 28 tbatch.;; (
5a10: 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 62 20 28 launch-test db (
5a20: 63 61 64 72 20 73 74 61 74 75 73 29 20 74 65 73 cadr status) tes
5a30: 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 69 6e 65 t-conf)).(define
5a40: 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 62 (launch-test db
5a50: 20 72 75 6e 2d 69 64 20 72 75 6e 6e 61 6d 65 20 run-id runname
5a60: 74 65 73 74 2d 63 6f 6e 66 20 6b 65 79 76 61 6c test-conf keyval
5a70: 6c 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 lst test-name te
5a80: 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 74 20 st-path itemdat
5a90: 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 6e 67 params). (chang
5aa0: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
5ab0: 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 74 2d path*). (alist-
5ac0: 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e >env-vars ;; con
5ad0: 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f solidate this co
5ae0: 64 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 de with the code
5af0: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d in megatest.scm
5b00: 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a for "-execute".
5b10: 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c 69 73 (list ;; (lis
5b20: 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 t "MT_TEST_RUN_D
5b30: 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 IR" work-area)..
5b40: 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e 5f 41 (list "MT_RUN_A
5b50: 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 REA_HOME" *toppa
5b60: 74 68 2a 29 0a 09 20 28 6c 69 73 74 20 22 4d 54 th*).. (list "MT
5b70: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
5b80: 2d 6e 61 6d 65 29 0a 09 20 3b 3b 20 28 6c 69 73 -name).. ;; (lis
5b90: 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 t "MT_ITEM_INFO"
5ba0: 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 (conc itemdat))
5bb0: 20 0a 09 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 .. (list "MT_RU
5bc0: 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 NNAME" runname
5bd0: 29 0a 09 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 ).. ;; (list "MT
5be0: 5f 54 41 52 47 45 54 22 20 20 20 20 6d 74 5f 74 _TARGET" mt_t
5bf0: 61 72 67 65 74 29 0a 09 20 29 29 0a 20 20 28 6c arget).. )). (l
5c00: 65 74 2a 20 28 28 75 73 65 73 68 65 6c 6c 20 20 et* ((useshell
5c10: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
5c20: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
5c30: 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 73 65 73 tools" "uses
5c40: 68 65 6c 6c 22 29 29 0a 09 20 28 6c 61 75 6e 63 hell")).. (launc
5c50: 68 65 72 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f her (config-lo
5c60: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
5c70: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
5c80: 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 20 28 "launcher")).. (
5c90: 72 75 6e 73 63 72 69 70 74 20 20 28 63 6f 6e 66 runscript (conf
5ca0: 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 ig-lookup test-c
5cb0: 6f 6e 66 20 20 20 22 73 65 74 75 70 22 20 20 20 onf "setup"
5cc0: 20 20 20 20 20 22 72 75 6e 73 63 72 69 70 74 22 "runscript"
5cd0: 29 29 0a 09 20 28 65 7a 73 74 65 70 73 20 20 20 )).. (ezsteps
5ce0: 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 (> (length (has
5cf0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
5d00: 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 ult test-conf "e
5d10: 7a 73 74 65 70 73 22 20 27 28 29 29 29 20 30 29 zsteps" '())) 0)
5d20: 29 20 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 ) ;; don't send
5d30: 61 6c 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 all the steps, c
5d40: 6f 75 6c 64 20 62 65 20 62 69 67 0a 09 20 28 64 ould be big.. (d
5d50: 69 73 6b 73 70 61 63 65 20 20 28 63 6f 6e 66 69 iskspace (confi
5d60: 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f g-lookup test-co
5d70: 6e 66 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e nf "requiremen
5d80: 74 73 22 20 22 64 69 73 6b 73 70 61 63 65 22 29 ts" "diskspace")
5d90: 29 0a 09 20 28 6d 65 6d 6f 72 79 20 20 20 20 20 ).. (memory
5da0: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 (config-lookup t
5db0: 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 est-conf "requ
5dc0: 69 72 65 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 irements" "memor
5dd0: 79 22 29 29 0a 09 20 28 68 6f 73 74 73 20 20 20 y")).. (hosts
5de0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
5df0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
5e00: 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f obtools" "wo
5e10: 72 6b 68 6f 73 74 73 22 29 29 0a 09 20 28 72 65 rkhosts")).. (re
5e20: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 28 63 mote-megatest (c
5e30: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
5e40: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
5e50: 20 22 65 78 65 63 75 74 61 62 6c 65 22 29 29 0a "executable")).
5e60: 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 . ;; FIXME SOMED
5e70: 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 AY: not good how
5e80: 20 74 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 this is so obtu
5e90: 73 65 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 se, this hack is
5ea0: 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 20 to .. ;;
5eb0: 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 allow r
5ec0: 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 unning from dash
5ed0: 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 20 74 board. Extract t
5ee0: 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 20 he path.. ;;
5ef0: 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d from
5f00: 20 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 the called mega
5f10: 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 test and convert
5f20: 20 64 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b 20 dashboard.. ;;
5f30: 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 6f . o
5f40: 72 20 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 r dboard to mega
5f50: 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d 65 test.. (local-me
5f60: 67 61 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 gatest (let* ((
5f70: 6c 6d 20 20 28 63 61 72 20 28 61 72 67 76 29 29 lm (car (argv))
5f80: 29 0a 09 09 09 09 20 28 64 69 72 20 28 70 61 74 )..... (dir (pat
5f90: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory
5fa0: 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 65 20 28 lm))..... (exe (
5fb0: 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 pathname-strip-d
5fc0: 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 irectory lm)))..
5fd0: 09 09 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 .. (conc (if
5fe0: 64 69 72 20 28 63 6f 6e 63 20 64 69 72 20 22 2f dir (conc dir "/
5ff0: 22 29 20 22 22 29 0a 09 09 09 09 20 20 28 63 61 ") "")..... (ca
6000: 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
6010: 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 20 20 20 ol exe).....
6020: 28 28 64 62 6f 61 72 64 29 20 22 6d 65 67 61 74 ((dboard) "megat
6030: 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 28 est")..... ((
6040: 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 67 61 dashboard) "mega
6050: 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 test")..... (
6060: 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a 09 20 else exe)))))..
6070: 28 74 65 73 74 2d 73 69 67 20 20 20 28 63 6f 6e (test-sig (con
6080: 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a 22 20 c test-name ":"
6090: 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 (item-list->path
60a0: 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b 20 74 itemdat))) ;; t
60b0: 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 65 20 est-path is the
60c0: 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c 75 64 full path includ
60d0: 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 61 74 ing the item-pat
60e0: 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 61 20 20 h.. (work-area
60f0: 23 66 29 0a 09 20 28 74 6f 70 74 65 73 74 2d 77 #f).. (toptest-w
6100: 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 3b 3b 20 ork-area #f) ;;
6110: 66 6f 72 20 69 74 65 72 61 74 65 64 20 74 65 73 for iterated tes
6120: 74 73 20 74 68 65 20 74 6f 70 20 74 65 73 74 20 ts the top test
6130: 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 72 65 contains data re
6140: 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c 0a 09 levant for all..
6150: 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 66 29 (diskpath #f)
6160: 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 20 20 23 .. (cmdparms #
6170: 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 f).. (fullcmd
6180: 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e 65 20 #f) ;; (define
6190: 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 a (with-output-t
61a0: 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 o-string (lambda
61b0: 20 28 29 28 77 72 69 74 65 20 78 29 29 29 29 0a ()(write x)))).
61c0: 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 . (mt-bindir-pat
61d0: 68 20 23 66 29 0a 09 20 28 69 74 65 6d 2d 70 61 h #f).. (item-pa
61e0: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
61f0: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
6200: 28 74 65 73 74 2d 69 64 20 20 20 20 28 6f 70 65 (test-id (ope
6210: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
6220: 65 74 2d 74 65 73 74 2d 69 64 20 64 62 20 72 75 et-test-id db ru
6230: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
6240: 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 74 65 tem-path)).. (te
6250: 73 74 69 6e 66 6f 20 20 20 28 6f 70 65 6e 2d 72 stinfo (open-r
6260: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d un-close db:get-
6270: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 test-info-by-id
6280: 64 62 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 db test-id)).. (
6290: 6d 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 69 mt_target (stri
62a0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
62b0: 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 6c map cadr keyvall
62c0: 73 74 29 20 22 2f 22 29 29 0a 09 20 28 64 65 62 st) "/")).. (deb
62d0: 75 67 2d 70 61 72 61 6d 20 28 69 66 20 28 61 72 ug-param (if (ar
62e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 gs:get-arg "-deb
62f0: 75 67 22 29 28 6c 69 73 74 20 22 2d 64 65 62 75 ug")(list "-debu
6300: 67 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 g" (args:get-arg
6310: 20 22 2d 64 65 62 75 67 22 29 29 20 27 28 29 29 "-debug")) '())
6320: 29 29 0a 20 20 20 20 28 69 66 20 68 6f 73 74 73 )). (if hosts
6330: 20 28 73 65 74 21 20 68 6f 73 74 73 20 28 73 74 (set! hosts (st
6340: 72 69 6e 67 2d 73 70 6c 69 74 20 68 6f 73 74 73 ring-split hosts
6350: 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 74 ))). ;; set t
6360: 68 65 20 6d 65 67 61 74 65 73 74 20 74 6f 20 62 he megatest to b
6370: 65 20 63 61 6c 6c 65 64 20 6f 6e 20 74 68 65 20 e called on the
6380: 72 65 6d 6f 74 65 20 68 6f 73 74 0a 20 20 20 20 remote host.
6390: 28 69 66 20 28 6e 6f 74 20 72 65 6d 6f 74 65 2d (if (not remote-
63a0: 6d 65 67 61 74 65 73 74 29 28 73 65 74 21 20 72 megatest)(set! r
63b0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 6c emote-megatest l
63c0: 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 29 20 ocal-megatest))
63d0: 3b 3b 20 22 6d 65 67 61 74 65 73 74 22 29 29 0a ;; "megatest")).
63e0: 20 20 20 20 28 73 65 74 21 20 6d 74 2d 62 69 6e (set! mt-bin
63f0: 64 69 72 2d 70 61 74 68 20 28 70 61 74 68 6e 61 dir-path (pathna
6400: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 72 65 6d me-directory rem
6410: 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 29 0a 20 ote-megatest)).
6420: 20 20 20 28 69 66 20 6c 61 75 6e 63 68 65 72 20 (if launcher
6430: 28 73 65 74 21 20 6c 61 75 6e 63 68 65 72 20 28 (set! launcher (
6440: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6c 61 75 string-split lau
6450: 6e 63 68 65 72 29 29 29 0a 20 20 20 20 3b 3b 20 ncher))). ;;
6460: 73 65 74 20 75 70 20 74 68 65 20 72 75 6e 20 77 set up the run w
6470: 6f 72 6b 20 61 72 65 61 20 66 6f 72 20 74 68 69 ork area for thi
6480: 73 20 74 65 73 74 0a 20 20 20 20 28 73 65 74 21 s test. (set!
6490: 20 64 69 73 6b 70 61 74 68 20 28 67 65 74 2d 62 diskpath (get-b
64a0: 65 73 74 2d 64 69 73 6b 20 2a 63 6f 6e 66 69 67 est-disk *config
64b0: 64 61 74 2a 29 29 0a 20 20 20 20 28 69 66 20 64 dat*)). (if d
64c0: 69 73 6b 70 61 74 68 0a 09 28 6c 65 74 20 28 28 iskpath..(let ((
64d0: 64 61 74 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 dat (open-run-c
64e0: 6c 6f 73 65 20 63 72 65 61 74 65 2d 77 6f 72 6b lose create-work
64f0: 2d 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 -area db run-id
6500: 74 65 73 74 2d 69 64 20 74 65 73 74 2d 70 61 74 test-id test-pat
6510: 68 20 64 69 73 6b 70 61 74 68 20 74 65 73 74 2d h diskpath test-
6520: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 29 0a name itemdat))).
6530: 09 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 . (set! work-ar
6540: 65 61 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 ea (car dat))..
6550: 20 28 73 65 74 21 20 74 6f 70 74 65 73 74 2d 77 (set! toptest-w
6560: 6f 72 6b 2d 61 72 65 61 20 28 63 61 64 72 20 64 ork-area (cadr d
6570: 61 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 at)).. (debug:p
6580: 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 20 55 73 rint 2 "INFO: Us
6590: 69 6e 67 20 77 6f 72 6b 20 61 72 65 61 20 22 20 ing work area "
65a0: 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 28 62 65 work-area))..(be
65b0: 67 69 6e 0a 09 20 20 28 73 65 74 21 20 77 6f 72 gin.. (set! wor
65c0: 6b 2d 61 72 65 61 20 28 63 6f 6e 63 20 74 65 73 k-area (conc tes
65d0: 74 2d 70 61 74 68 20 22 2f 74 6d 70 5f 72 75 6e t-path "/tmp_run
65e0: 22 29 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 ")).. (create-d
65f0: 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
6600: 65 61 20 23 74 29 0a 09 20 20 28 64 65 62 75 67 ea #t).. (debug
6610: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
6620: 47 3a 20 4e 6f 20 64 69 73 6b 20 77 6f 72 6b 20 G: No disk work
6630: 61 72 65 61 20 73 70 65 63 69 66 69 65 64 20 2d area specified -
6640: 20 72 75 6e 6e 69 6e 67 20 69 6e 20 74 68 65 20 running in the
6650: 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 20 75 test directory u
6660: 6e 64 65 72 20 74 6d 70 5f 72 75 6e 22 29 29 29 nder tmp_run")))
6670: 0a 20 20 20 20 28 73 65 74 21 20 63 6d 64 70 61 . (set! cmdpa
6680: 72 6d 73 20 28 62 61 73 65 36 34 3a 62 61 73 65 rms (base64:base
6690: 36 34 2d 65 6e 63 6f 64 65 20 28 77 69 74 68 2d 64-encode (with-
66a0: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
66b0: 0a 09 09 09 09 09 20 20 20 28 6c 61 6d 62 64 61 ...... (lambda
66c0: 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f () ;; (list 'ho
66d0: 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 sts hosts)..
66e0: 09 09 09 09 20 20 20 20 20 28 77 72 69 74 65 20 .... (write
66f0: 28 6c 69 73 74 20 28 6c 69 73 74 20 27 74 65 73 (list (list 'tes
6700: 74 70 61 74 68 20 20 74 65 73 74 2d 70 61 74 68 tpath test-path
6710: 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 )........ (list
6720: 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f 70 'toppath *top
6730: 70 61 74 68 2a 29 0a 09 09 09 09 09 09 09 20 20 path*)........
6740: 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 (list 'work-area
6750: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
6760: 09 09 09 20 20 28 6c 69 73 74 20 27 74 65 73 74 ... (list 'test
6770: 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 -name test-name)
6780: 20 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 ........ (list
6790: 20 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 'runscript runs
67a0: 63 72 69 70 74 29 20 0a 09 09 09 09 09 09 09 20 cript) ........
67b0: 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 (list 'run-id
67c0: 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 run-id )....
67d0: 09 09 09 09 20 20 28 6c 69 73 74 20 27 74 65 73 .... (list 'tes
67e0: 74 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 t-id test-id
67f0: 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 )........ (list
6800: 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 'itemdat item
6810: 64 61 74 20 20 29 0a 09 09 09 09 09 09 09 20 20 dat )........
6820: 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 (list 'megatest
6830: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
6840: 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 )........ (list
6850: 20 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 'ezsteps ezst
6860: 65 70 73 29 20 0a 09 09 09 09 09 09 09 20 20 28 eps) ........ (
6870: 6c 69 73 74 20 27 74 61 72 67 65 74 20 20 20 20 list 'target
6880: 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 09 mt_target)......
6890: 09 09 20 20 28 6c 69 73 74 20 27 65 6e 76 2d 6f .. (list 'env-o
68a0: 76 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c 65 vrd (hash-table
68b0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
68c0: 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 nfigdat* "env-ov
68d0: 65 72 72 69 64 65 22 20 27 28 29 29 29 20 0a 09 erride" '())) ..
68e0: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 73 ...... (list 's
68f0: 65 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 72 et-vars (if par
6900: 61 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ams (hash-table-
6910: 72 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 61 ref/default para
6920: 6d 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 66 ms "-setvars" #f
6930: 29 29 29 0a 09 09 09 09 09 09 09 20 20 28 6c 69 )))........ (li
6940: 73 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 st 'runname ru
6950: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 09 20 20 nname)........
6960: 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 (list 'mt-bindir
6970: 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d -path mt-bindir-
6980: 70 61 74 68 29 29 29 29 29 29 29 20 3b 3b 20 28 path))))))) ;; (
6990: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
69a0: 73 65 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 22 se keyvallst " "
69b0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 6c 65 61 )))). ;; clea
69c0: 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f 72 n out step recor
69d0: 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 73 ds from previous
69e0: 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 69 run if they exi
69f0: 73 74 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 st. (debug:pr
6a00: 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 46 49 58 int 4 "INFO: FIX
6a10: 4d 45 45 45 45 45 21 21 21 21 20 54 68 69 73 20 MEEEEE!!!! This
6a20: 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 64 20 73 can be removed s
6a30: 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 61 70 73 ome day, perhaps
6a40: 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 74 20 72 move all test r
6a50: 65 63 6f 72 64 73 20 74 6f 20 74 68 65 20 74 65 ecords to the te
6a60: 73 74 20 64 62 3f 22 29 0a 20 20 20 20 28 6f 70 st db?"). (op
6a70: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
6a80: 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 delete-test-step
6a90: 2d 72 65 63 6f 72 64 73 20 64 62 20 74 65 73 74 -records db test
6aa0: 2d 69 64 29 0a 20 20 20 20 28 63 68 61 6e 67 65 -id). (change
6ab0: 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d -directory work-
6ac0: 61 72 65 61 29 20 3b 3b 20 73 6f 20 74 68 61 74 area) ;; so that
6ad0: 20 6c 6f 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 log files from
6ae0: 74 68 65 20 6c 61 75 6e 63 68 20 70 72 6f 63 65 the launch proce
6af0: 73 73 20 64 6f 6e 27 74 20 63 6c 75 74 74 65 72 ss don't clutter
6b00: 20 74 68 65 20 74 65 73 74 20 64 69 72 0a 20 20 the test dir.
6b10: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
6b20: 65 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 e test-set-statu
6b30: 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 22 4c s! db test-id "L
6b40: 41 55 4e 43 48 45 44 22 20 22 6e 2f 61 22 20 23 AUNCHED" "n/a" #
6b50: 66 20 23 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 f #f) ;; (if lau
6b60: 6e 63 68 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e nch-results laun
6b70: 63 68 2d 72 65 73 75 6c 74 73 20 22 46 41 49 4c ch-results "FAIL
6b80: 45 44 22 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a ED")). (cond.
6b90: 20 20 20 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 ((and launc
6ba0: 68 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 her hosts) ;; mu
6bb0: 73 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 20 st be using ssh
6bc0: 68 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 hostname. (
6bd0: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
6be0: 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 pend launcher (c
6bf0: 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 ar hosts)(list r
6c00: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
6c10: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
6c20: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
6c30: 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 ug-param))).
6c40: 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d ;; (set! fullcm
6c50: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
6c60: 65 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c er (car hosts)(l
6c70: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
6c80: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
6c90: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
6ca0: 29 29 29 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 )))). (launc
6cb0: 68 65 72 0a 20 20 20 20 20 20 28 73 65 74 21 20 her. (set!
6cc0: 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 fullcmd (append
6cd0: 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 20 72 launcher (list r
6ce0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
6cf0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
6d00: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
6d10: 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 ug-param))).
6d20: 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d ;; (set! fullcm
6d30: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
6d40: 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d er (list remote-
6d50: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
6d60: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
6d70: 70 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 28 parms)))). (
6d80: 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 else. (if (
6d90: 6e 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 64 65 not useshell)(de
6da0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
6db0: 4e 49 4e 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c NING: internal l
6dc0: 61 75 6e 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f aunching will no
6dd0: 74 20 77 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 t work well with
6de0: 6f 75 74 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 out \"useshell y
6df0: 65 73 5c 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f es\" in your [jo
6e00: 62 74 6f 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 btools] section"
6e10: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 )). (set! f
6e20: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 28 ullcmd (append (
6e30: 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 list remote-mega
6e40: 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d test test-sig "-
6e50: 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d execute" cmdparm
6e60: 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d 20 28 s) debug-param (
6e70: 6c 69 73 74 20 28 69 66 20 75 73 65 73 68 65 6c list (if useshel
6e80: 6c 20 22 26 22 20 22 22 29 29 29 29 29 29 0a 20 l "&" "")))))).
6e90: 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c ;; (set! full
6ea0: 63 6d 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 cmd (list remote
6eb0: 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 -megatest test-s
6ec0: 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d ig "-execute" cm
6ed0: 64 70 61 72 6d 73 20 28 69 66 20 75 73 65 73 68 dparms (if usesh
6ee0: 65 6c 6c 20 22 26 22 20 22 22 29 29 29 29 29 0a ell "&" ""))))).
6ef0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
6f00: 74 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 28 t-arg "-xterm")(
6f10: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
6f20: 70 65 6e 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 pend fullcmd (li
6f30: 73 74 20 22 2d 78 74 65 72 6d 22 29 29 29 29 0a st "-xterm")))).
6f40: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
6f50: 20 31 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 1 "Launching "
6f60: 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b work-area). ;
6f70: 3b 20 73 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 ; set pre-launch
6f80: 2d 65 6e 76 2d 76 61 72 73 20 62 65 66 6f 72 65 -env-vars before
6f90: 20 6c 61 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 launching, keep
6fa0: 20 74 68 65 20 76 61 72 73 20 69 6e 20 70 72 65 the vars in pre
6fb0: 76 76 61 6c 73 20 61 6e 64 20 70 75 74 20 74 68 vvals and put th
6fc0: 65 20 65 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 e envionment bac
6fd0: 6b 20 77 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 k when done.
6fe0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
6ff0: 66 75 6c 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 fullcmd: " fullc
7000: 6d 64 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 md). (let* ((
7010: 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 commonprevvals (
7020: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a alist->env-vars.
7030: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
7040: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
7050: 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d configdat* "env-
7060: 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 29 29 override" '())))
7070: 0a 09 20 20 20 28 74 65 73 74 70 72 65 76 76 61 .. (testprevva
7080: 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 ls (alist->env
7090: 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 -vars.... (ha
70a0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
70b0: 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 ault test-conf "
70c0: 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f pre-launch-env-o
70d0: 76 65 72 72 69 64 65 73 22 20 27 28 29 29 29 29 verrides" '())))
70e0: 0a 09 20 20 20 28 6d 69 73 63 70 72 65 76 76 61 .. (miscprevva
70f0: 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 ls (alist->env
7100: 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 -vars ;; consoli
7110: 64 61 74 65 20 74 68 69 73 20 63 6f 64 65 20 77 date this code w
7120: 69 74 68 20 74 68 65 20 63 6f 64 65 20 69 6e 20 ith the code in
7130: 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 megatest.scm for
7140: 20 22 2d 65 78 65 63 75 74 65 22 0a 09 09 09 20 "-execute"....
7150: 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 (append (list
7160: 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f (list "MT_TEST_
7170: 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 RUN_DIR" work-ar
7180: 65 61 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 ea)...... (list
7190: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
71a0: 74 65 73 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 test-name)......
71b0: 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d (list "MT_ITEM
71c0: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
71d0: 6d 64 61 74 29 29 20 0a 09 09 09 09 09 20 20 28 mdat)) ...... (
71e0: 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 list "MT_RUNNAME
71f0: 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 " runname)....
7200: 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 .. (list "MT_TA
7210: 52 47 45 54 22 20 20 20 20 6d 74 5f 74 61 72 67 RGET" mt_targ
7220: 65 74 29 0a 09 09 09 09 09 20 20 29 0a 09 09 09 et)...... )....
7230: 09 20 20 20 20 69 74 65 6d 64 61 74 29 29 29 0a . itemdat))).
7240: 09 20 20 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 . (launch-resu
7250: 6c 74 73 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 lts (apply cmd-r
7260: 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e un-proc-each-lin
7270: 65 0a 09 09 09 09 20 20 28 69 66 20 75 73 65 73 e..... (if uses
7280: 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 20 20 28 hell..... (
7290: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
72a0: 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 0a se fullcmd " ").
72b0: 09 09 09 09 20 20 20 20 20 20 28 63 61 72 20 66 .... (car f
72c0: 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 20 20 70 ullcmd))..... p
72d0: 72 69 6e 74 0a 09 09 09 09 20 20 28 69 66 20 75 rint..... (if u
72e0: 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 seshell.....
72f0: 20 20 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 '().....
7300: 28 63 64 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 (cdr fullcmd))))
7310: 29 20 3b 3b 20 20 6c 61 75 6e 63 68 65 72 20 66 ) ;; launcher f
7320: 75 6c 6c 63 6d 64 29 29 29 3b 3b 20 28 61 70 70 ullcmd)));; (app
7330: 6c 79 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d ly cmd-run-proc-
7340: 65 61 63 68 2d 6c 69 6e 65 20 6c 61 75 6e 63 68 each-line launch
7350: 65 72 20 70 72 69 6e 74 20 66 75 6c 6c 63 6d 64 er print fullcmd
7360: 29 29 29 20 3b 3b 20 28 63 6d 64 2d 72 75 6e 2d ))) ;; (cmd-run-
7370: 3e 6c 69 73 74 20 66 75 6c 6c 63 6d 64 29 29 0a >list fullcmd)).
7380: 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 (with-outp
7390: 75 74 2d 74 6f 2d 66 69 6c 65 20 22 6d 74 5f 6c ut-to-file "mt_l
73a0: 61 75 6e 63 68 2e 6c 6f 67 22 0a 09 28 6c 61 6d aunch.log"..(lam
73b0: 62 64 61 20 28 29 0a 09 20 20 28 61 70 70 6c 79 bda ().. (apply
73c0: 20 70 72 69 6e 74 20 6c 61 75 6e 63 68 2d 72 65 print launch-re
73d0: 73 75 6c 74 73 29 29 29 0a 20 20 20 20 20 20 28 sults))). (
73e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c debug:print 2 "L
73f0: 61 75 6e 63 68 69 6e 67 20 63 6f 6d 70 6c 65 74 aunching complet
7400: 65 64 2c 20 75 70 64 61 74 69 6e 67 20 64 62 22 ed, updating db"
7410: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7420: 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 20 72 rint 2 "Launch r
7430: 65 73 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 68 esults: " launch
7440: 2d 72 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 -results).
7450: 28 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 2d (if (not launch-
7460: 72 65 73 75 6c 74 73 29 0a 09 20 20 28 62 65 67 results).. (beg
7470: 69 6e 0a 09 20 20 20 20 28 70 72 69 6e 74 20 22 in.. (print "
7480: 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f ERROR: Failed to
7490: 20 72 75 6e 20 22 20 28 73 74 72 69 6e 67 2d 69 run " (string-i
74a0: 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
74b0: 6d 64 20 22 20 22 29 20 22 2c 20 65 78 69 74 69 md " ") ", exiti
74c0: 6e 67 20 6e 6f 77 22 29 0a 09 20 20 20 20 3b 3b ng now").. ;;
74d0: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
74e0: 7a 65 21 20 64 62 29 0a 09 20 20 20 20 3b 3b 20 ze! db).. ;;
74f0: 67 6f 6f 64 20 6f 6c 65 20 22 65 78 69 74 22 20 good ole "exit"
7500: 73 65 65 6d 73 20 6e 6f 74 20 74 6f 20 77 6f 72 seems not to wor
7510: 6b 0a 09 20 20 20 20 3b 3b 20 28 5f 65 78 69 74 k.. ;; (_exit
7520: 20 39 29 0a 09 20 20 20 20 3b 3b 20 62 75 74 20 9).. ;; but
7530: 74 68 69 73 20 68 61 63 6b 20 77 69 6c 6c 20 77 this hack will w
7540: 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f 20 74 ork! Thanks go t
7550: 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 20 74 o Alan Post of t
7560: 68 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 69 6c he Chicken email
7570: 20 6c 69 73 74 0a 09 20 20 20 20 3b 3b 20 4e 42 list.. ;; NB
7580: 2f 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c 6c // Is this still
7590: 20 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 needed? Should
75a0: 62 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 61 be safe to go ba
75b0: 63 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 ck to "exit" now
75c0: 3f 0a 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d ?.. (process-
75d0: 73 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d signal (current-
75e0: 70 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e process-id) sign
75f0: 61 6c 2f 6b 69 6c 6c 29 0a 09 20 20 20 20 29 29 al/kill).. ))
7600: 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 . (alist->e
7610: 6e 76 2d 76 61 72 73 20 6d 69 73 63 70 72 65 76 nv-vars miscprev
7620: 76 61 6c 73 29 0a 20 20 20 20 20 20 28 61 6c 69 vals). (ali
7630: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 74 65 73 st->env-vars tes
7640: 74 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 tprevvals).
7650: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
7660: 73 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 s commonprevvals
7670: 29 0a 20 20 20 20 20 20 6c 61 75 6e 63 68 2d 72 ). launch-r
7680: 65 73 75 6c 74 73 29 29 0a 20 20 28 63 68 61 6e esults)). (chan
7690: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f ge-directory *to
76a0: 70 70 61 74 68 2a 29 29 0a 0a ppath*))..