Artifact
203b993021f2de427a3f52cc409cd95908182549
File
launch.scm
— part of check-in
[cc1b5a10b2]
at
2012-09-28 16:23:54
on branch test-specific-db
— Refactored more db stuff to use open-run-close
(user:
mrwellan
size: 30531)
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 20 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 73 3a 74 65 73 74 2d 73 ose tests:test-s
11f0: 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 et-status! #f te
1200: 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 st-id "REMOTEHOS
1210: 54 53 54 41 52 54 22 20 22 6e 2f 61 22 20 28 61 TSTART" "n/a" (a
1220: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
1230: 29 20 23 66 29 0a 09 20 20 28 69 66 20 28 61 72 ) #f).. (if (ar
1240: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 gs:get-arg "-xte
1250: 72 6d 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 rm").. (set
1260: 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 ! fullrunscript
1270: 22 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 "xterm")..
1280: 28 69 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e (if (and fullrun
1290: 73 63 72 69 70 74 20 28 6e 6f 74 20 28 66 69 6c script (not (fil
12a0: 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 e-execute-access
12b0: 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 ? fullrunscript)
12c0: 29 29 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 ))... (system (
12d0: 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 conc "chmod ug+x
12e0: 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 " fullrunscript
12f0: 29 29 29 29 0a 09 20 20 3b 3b 20 57 65 20 61 72 )))).. ;; We ar
1300: 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 e about to actua
1310: 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 lly kick off the
1320: 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 test.. ;; so t
1330: 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c his is a good pl
1340: 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 ace to remove th
1350: 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 e records for ..
1360: 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 ;; any previou
1370: 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 s runs.. ;; (db
1380: 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 :test-remove-ste
1390: 70 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ps db run-id tes
13a0: 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 tname itemdat)..
13b0: 20 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 .. (let* ((m
13c0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 (make
13d0: 2d 6d 75 74 65 78 29 29 0a 09 09 20 28 6b 69 6c -mutex))... (kil
13e0: 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 l-job? #f)...
13f0: 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 (exit-info (
1400: 76 65 63 74 6f 72 20 23 74 20 23 74 20 23 74 29 vector #t #t #t)
1410: 29 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 )... (job-thread
1420: 20 20 20 23 66 29 0a 09 09 20 28 72 75 6e 69 74 #f)... (runit
1430: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1440: 28 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d ()..... ;; (let-
1450: 76 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 values..... ;;
1460: 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 (((pid exit-stat
1470: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 us exit-code)...
1480: 09 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d .. ;; (run-n-
1490: 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 wait fullrunscri
14a0: 70 74 29 29 29 0a 09 09 09 09 20 28 6f 70 65 6e pt)))..... (open
14b0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 -run-close tests
14c0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
14d0: 21 20 23 66 20 74 65 73 74 2d 69 64 20 22 52 55 ! #f test-id "RU
14e0: 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 20 NNING" "n/a" #f
14f0: 23 66 29 0a 09 09 09 09 20 3b 3b 20 69 66 20 74 #f)..... ;; if t
1500: 68 65 72 65 20 69 73 20 61 20 72 75 6e 73 63 72 here is a runscr
1510: 69 70 74 20 64 6f 20 69 74 20 66 69 72 73 74 0a ipt do it first.
1520: 09 09 09 09 20 28 69 66 20 66 75 6c 6c 72 75 6e .... (if fullrun
1530: 73 63 72 69 70 74 0a 09 09 09 09 20 20 20 20 20 script.....
1540: 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 (let ((pid (proc
1550: 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 6e 73 ess-run fullruns
1560: 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 20 20 cript))).....
1570: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
1580: 69 20 30 29 29 0a 09 09 09 09 09 20 28 6c 65 74 i 0))...... (let
1590: 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 20 20 28 -values...... (
15a0: 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 ((pid-val exit-s
15b0: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 tatus exit-code)
15c0: 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 (process-wait p
15d0: 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 20 20 id #t)))......
15e0: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
15f0: 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 ..... (vector-s
1600: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 et! exit-info 0
1610: 70 69 64 29 0a 09 09 09 09 09 20 20 28 76 65 63 pid)...... (vec
1620: 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e tor-set! exit-in
1630: 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 75 73 fo 1 exit-status
1640: 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 )...... (vector
1650: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1660: 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 2 exit-code)....
1670: 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 .. (set! rollup
1680: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
1690: 65 29 20 0a 09 09 09 09 09 20 20 28 6d 75 74 65 e) ...... (mute
16a0: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 x-unlock! m)....
16b0: 09 09 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 .. (if (eq? pid
16c0: 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 20 20 20 -val 0)......
16d0: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 (begin.......
16e0: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 (thread-sleep! 2
16f0: 29 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b ).......(loop (+
1700: 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 i 1)))......
1710: 20 20 20 29 29 29 29 29 0a 09 09 09 09 20 3b 3b )))))..... ;;
1720: 20 74 68 65 6e 2c 20 69 66 20 72 75 6e 73 63 72 then, if runscr
1730: 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f 72 20 64 ipt ran ok (or d
1740: 69 64 20 6e 6f 74 20 67 65 74 20 63 61 6c 6c 65 id not get calle
1750: 64 29 0a 09 09 09 09 20 3b 3b 20 64 6f 20 61 6c d)..... ;; do al
1760: 6c 20 74 68 65 20 65 7a 73 74 65 70 73 20 28 69 l the ezsteps (i
1770: 66 20 61 6e 79 29 0a 09 09 09 09 20 28 69 66 20 f any)..... (if
1780: 65 7a 73 74 65 70 73 0a 09 09 09 09 20 20 20 20 ezsteps.....
1790: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 6f 6e (let* ((testcon
17a0: 66 69 67 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 fig (read-config
17b0: 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 (conc work-area
17c0: 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 20 "/testconfig")
17d0: 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 #f #t environ-pa
17e0: 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d tt: "pre-launch-
17f0: 65 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b 20 46 env-vars")) ;; F
1800: 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 IXME??? is allow
1810: 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 65 3f -system ok here?
1820: 0a 09 09 09 09 09 20 20 20 20 28 65 7a 73 74 65 ...... (ezste
1830: 70 73 6c 73 74 20 28 68 61 73 68 2d 74 61 62 6c pslst (hash-tabl
1840: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
1850: 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 stconfig "ezstep
1860: 73 22 20 27 28 29 29 29 29 0a 09 09 09 09 20 20 s" '()))).....
1870: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 (if (not (f
1880: 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a ile-exists? ".ez
1890: 73 74 65 70 73 22 29 29 28 63 72 65 61 74 65 2d steps"))(create-
18a0: 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 directory ".ezst
18b0: 65 70 73 22 29 29 0a 09 09 09 09 20 20 20 20 20 eps")).....
18c0: 20 20 3b 3b 20 69 66 20 65 7a 73 74 65 70 73 20 ;; if ezsteps
18d0: 77 61 73 20 64 65 66 69 6e 65 64 20 74 68 65 6e was defined then
18e0: 20 77 65 20 61 72 65 20 73 75 72 65 20 74 6f 20 we are sure to
18f0: 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 6f 6e have at least on
1900: 65 20 73 74 65 70 20 62 75 74 20 63 68 65 63 6b e step but check
1910: 20 61 6e 79 77 61 79 0a 09 09 09 09 20 20 20 20 anyway.....
1920: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 3e 20 28 (if (not (> (
1930: 6c 65 6e 67 74 68 20 65 7a 73 74 65 70 73 6c 73 length ezstepsls
1940: 74 29 20 30 29 29 0a 09 09 09 09 09 20 20 20 28 t) 0))...... (
1950: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
1960: 52 52 4f 52 3a 20 65 7a 73 74 65 70 73 20 64 65 RROR: ezsteps de
1970: 66 69 6e 65 64 20 62 75 74 20 65 7a 73 74 65 70 fined but ezstep
1980: 73 6c 73 74 20 69 73 20 7a 65 72 6f 20 6c 65 6e slst is zero len
1990: 67 74 68 22 29 0a 09 09 09 09 09 20 20 20 28 6c gth")...... (l
19a0: 65 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 65 70 et loop ((ezstep
19b0: 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c 73 74 (car ezstepslst
19c0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 ))....... (
19d0: 74 61 6c 20 20 20 20 28 63 64 72 20 65 7a 73 74 tal (cdr ezst
19e0: 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 09 20 epslst)).......
19f0: 20 20 20 20 20 28 70 72 65 76 73 74 65 70 20 23 (prevstep #
1a00: 66 29 29 0a 09 09 09 09 09 20 20 20 20 20 3b 3b f))...... ;;
1a10: 20 63 68 65 63 6b 20 65 78 69 74 2d 69 6e 66 6f check exit-info
1a20: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
1a30: 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 20 t-info 1)......
1a40: 20 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 2d (if (vector-
1a50: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
1a60: 0a 09 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28 ....... (let* ((
1a70: 73 74 65 70 6e 61 6d 65 20 20 28 63 61 72 20 65 stepname (car e
1a80: 7a 73 74 65 70 29 29 20 20 3b 3b 20 64 6f 20 73 zstep)) ;; do s
1a90: 74 75 66 66 20 74 6f 20 72 75 6e 20 74 68 65 20 tuff to run the
1aa0: 73 74 65 70 0a 09 09 09 09 09 09 09 28 73 74 65 step........(ste
1ab0: 70 69 6e 66 6f 20 20 28 63 61 64 72 20 65 7a 73 pinfo (cadr ezs
1ac0: 74 65 70 29 29 0a 09 09 09 09 09 09 09 28 73 74 tep))........(st
1ad0: 65 70 70 61 72 74 73 20 28 73 74 72 69 6e 67 2d epparts (string-
1ae0: 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 22 5e match (regexp "^
1af0: 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c 5c 7d (\\{([^\\}]*)\\}
1b00: 5c 5c 73 2a 7c 29 28 2e 2a 29 24 22 29 20 73 74 \\s*|)(.*)$") st
1b10: 65 70 69 6e 66 6f 29 29 0a 09 09 09 09 09 09 09 epinfo))........
1b20: 28 73 74 65 70 70 61 72 6d 73 20 28 6c 69 73 74 (stepparms (list
1b30: 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 20 32 -ref stepparts 2
1b40: 29 29 20 3b 3b 20 66 6f 72 20 66 75 74 75 72 65 )) ;; for future
1b50: 20 75 73 65 2c 20 7b 56 41 52 3d 31 2c 32 2c 33 use, {VAR=1,2,3
1b60: 7d 2c 20 72 75 6e 20 73 74 65 70 20 66 6f 72 20 }, run step for
1b70: 65 61 63 68 20 0a 09 09 09 09 09 09 09 28 73 74 each ........(st
1b80: 65 70 63 6d 64 20 20 20 28 6c 69 73 74 2d 72 65 epcmd (list-re
1b90: 66 20 73 74 65 70 70 61 72 74 73 20 33 29 29 0a f stepparts 3)).
1ba0: 09 09 09 09 09 09 09 28 73 63 72 69 70 74 20 20 .......(script
1bb0: 20 20 22 22 29 20 3b 20 22 23 21 2f 62 69 6e 2f "") ; "#!/bin/
1bc0: 62 61 73 68 5c 6e 22 29 20 3b 3b 20 79 65 70 2c bash\n") ;; yep,
1bd0: 20 77 65 20 64 65 70 65 6e 64 20 6f 6e 20 62 69 we depend on bi
1be0: 6e 2f 62 61 73 68 20 46 49 58 4d 45 21 21 21 0a n/bash FIXME!!!.
1bf0: 09 09 09 09 09 09 09 28 6c 6f 67 70 72 6f 2d 75 .......(logpro-u
1c00: 73 65 64 20 23 66 29 29 0a 09 09 09 09 09 09 20 sed #f)).......
1c10: 20 20 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 73 61 ;; NB// can sa
1c20: 66 65 6c 79 20 61 73 73 75 6d 65 20 77 65 20 61 fely assume we a
1c30: 72 65 20 69 6e 20 74 65 73 74 2d 61 72 65 61 20 re in test-area
1c40: 64 69 72 65 63 74 6f 72 79 0a 09 09 09 09 09 09 directory.......
1c50: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
1c60: 34 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 73 74 4 "ezsteps:\n st
1c70: 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e 61 epname: " stepna
1c80: 6d 65 20 22 20 73 74 65 70 69 6e 66 6f 3a 20 22 me " stepinfo: "
1c90: 20 73 74 65 70 69 6e 66 6f 20 22 20 73 74 65 70 stepinfo " step
1ca0: 70 61 72 74 73 3a 20 22 20 73 74 65 70 70 61 72 parts: " steppar
1cb0: 74 73 0a 09 09 09 09 09 09 09 09 22 20 73 74 65 ts........." ste
1cc0: 70 70 61 72 6d 73 3a 20 22 20 73 74 65 70 70 61 pparms: " steppa
1cd0: 72 6d 73 20 22 20 73 74 65 70 63 6d 64 3a 20 22 rms " stepcmd: "
1ce0: 20 73 74 65 70 63 6d 64 29 0a 09 09 09 09 09 09 stepcmd).......
1cf0: 20 20 20 0a 09 09 09 09 09 09 20 20 20 28 69 66 ....... (if
1d00: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 (file-exists? (
1d10: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
1d20: 6c 6f 67 70 72 6f 22 29 29 28 73 65 74 21 20 6c logpro"))(set! l
1d30: 6f 67 70 72 6f 2d 75 73 65 64 20 23 74 29 29 0a ogpro-used #t)).
1d40: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 3b 3b 20 ....... ;; ;;
1d50: 66 69 72 73 74 20 73 6f 75 72 63 65 20 74 68 65 first source the
1d60: 20 70 72 65 76 69 6f 75 73 20 65 6e 76 69 72 6f previous enviro
1d70: 6e 6d 65 6e 74 0a 09 09 09 09 09 09 20 20 20 3b nment....... ;
1d80: 3b 20 28 6c 65 74 20 28 28 70 72 65 76 2d 65 6e ; (let ((prev-en
1d90: 76 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 65 70 v (conc ".ezstep
1da0: 73 2f 22 20 70 72 65 76 73 74 65 70 20 28 69 66 s/" prevstep (if
1db0: 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 (string-search
1dc0: 28 72 65 67 65 78 70 20 22 63 73 68 22 29 20 0a (regexp "csh") .
1dd0: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 ...... ;;
1de0: 20 09 09 09 09 09 09 09 20 28 67 65 74 2d 65 6e ....... (get-en
1df0: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
1e00: 6c 65 20 22 53 48 45 4c 4c 22 29 29 20 22 2e 63 le "SHELL")) ".c
1e10: 73 68 22 20 22 2e 73 68 22 29 29 29 29 0a 09 09 sh" ".sh"))))...
1e20: 09 09 09 09 20 20 20 3b 3b 20 20 20 28 69 66 20 .... ;; (if
1e30: 28 61 6e 64 20 70 72 65 76 73 74 65 70 20 28 66 (and prevstep (f
1e40: 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 72 65 76 ile-exists? prev
1e50: 2d 65 6e 76 29 29 0a 09 09 09 09 09 09 20 20 20 -env)).......
1e60: 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 20 73 ;; (set! s
1e70: 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 72 69 cript (conc scri
1e80: 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 72 65 pt "source " pre
1e90: 76 2d 65 6e 76 29 29 29 29 0a 09 09 09 09 09 09 v-env)))).......
1ea0: 20 20 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 ....... ;;
1eb0: 63 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 call the command
1ec0: 20 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 65 70 using mt_ezstep
1ed0: 0a 09 09 09 09 09 09 20 20 20 28 73 65 74 21 20 ....... (set!
1ee0: 73 63 72 69 70 74 20 28 63 6f 6e 63 20 22 6d 74 script (conc "mt
1ef0: 5f 65 7a 73 74 65 70 20 22 20 73 74 65 70 6e 61 _ezstep " stepna
1f00: 6d 65 20 22 20 22 20 28 69 66 20 70 72 65 76 73 me " " (if prevs
1f10: 74 65 70 20 70 72 65 76 73 74 65 70 20 22 2d 22 tep prevstep "-"
1f20: 29 20 22 20 22 20 73 74 65 70 63 6d 64 29 29 0a ) " " stepcmd)).
1f30: 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 ....... (debug
1f40: 3a 70 72 69 6e 74 20 34 20 22 73 63 72 69 70 74 :print 4 "script
1f50: 3a 20 22 20 73 63 72 69 70 74 29 0a 0a 09 09 09 : " script).....
1f60: 09 09 09 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d ... (open-run-
1f70: 63 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 74 65 close db:testste
1f80: 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 66 p-set-status! #f
1f90: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
1fa0: 65 20 22 73 74 61 72 74 22 20 22 2d 22 20 69 74 e "start" "-" it
1fb0: 65 6d 64 61 74 20 23 66 20 23 66 29 0a 09 09 09 emdat #f #f)....
1fc0: 09 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 ... ;; now lau
1fd0: 6e 63 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 nch....... (le
1fe0: 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 t ((pid (process
1ff0: 2d 72 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 -run script)))..
2000: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 ..... (let p
2010: 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 rocessloop ((i 0
2020: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2030: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 (let-values (((p
2040: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat
2050: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 us exit-code)(pr
2060: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
2070: 74 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 t))).........
2080: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
2090: 09 09 09 09 09 09 09 09 20 20 20 28 76 65 63 74 ........ (vect
20a0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
20b0: 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 o 0 pid)........
20c0: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
20d0: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
20e0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 t-status).......
20f0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
2100: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
2110: 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 it-code)........
2120: 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 . (mutex-unloc
2130: 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 k! m).........
2140: 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 (if (eq? pid-va
2150: 6c 20 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 l 0).........
2160: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 (begin......
2170: 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 .... (thread-sle
2180: 65 70 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 ep! 2)..........
2190: 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b (processloop (+
21a0: 20 69 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 i 1))))........
21b0: 09 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 . )).
21c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6c 65 74 (let
21f0: 20 28 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f ((exinfo (vecto
2200: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2210: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
2220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2230: 20 20 20 20 20 20 20 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 28 (
2250: 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 logfna (if logpr
2260: 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 o-used (conc ste
2270: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
2280: 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 "))).
2290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
22c0: 74 65 73 74 69 6e 67 20 69 66 20 70 72 6f 63 65 testing if proce
22d0: 64 75 72 65 73 20 63 61 6c 6c 65 64 20 69 6e 20 dures called in
22e0: 61 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 63 61 a remote call ca
22f0: 75 73 65 20 70 72 6f 62 6c 65 6d 73 20 28 61 6e use problems (an
2300: 73 3a 20 6e 6f 20 6f 72 20 73 6f 20 49 20 73 75 s: no or so I su
2310: 73 70 65 63 74 29 0a 09 09 09 09 09 09 20 20 20 spect).......
2320: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
2330: 6c 6f 73 65 20 64 62 3a 74 65 73 74 73 74 65 70 lose db:teststep
2340: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 -set-status! #f
2350: 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
2360: 20 22 65 6e 64 22 20 65 78 69 6e 66 6f 20 69 74 "end" exinfo it
2370: 65 6d 64 61 74 20 23 66 20 6c 6f 67 66 6e 61 29 emdat #f logfna)
2380: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 66 )....... (if
2390: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 09 09 logpro-used....
23a0: 09 09 09 09 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 .... (open-run-c
23b0: 6c 6f 73 65 20 64 62 3a 74 65 73 74 2d 73 65 74 lose db:test-set
23c0: 2d 6c 6f 67 21 20 23 66 20 74 65 73 74 2d 69 64 -log! #f test-id
23d0: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
23e0: 22 2e 68 74 6d 6c 22 29 29 29 0a 09 09 09 09 09 ".html")))......
23f0: 09 20 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 . ;; set the
2400: 20 74 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 test final stat
2410: 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c us....... (l
2420: 65 74 2a 20 28 28 74 68 69 73 2d 73 74 65 70 2d et* ((this-step-
2430: 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
2440: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 61 ...... ((a
2450: 6e 64 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d nd (eq? (vector-
2460: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
2470: 20 32 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 2) logpro-used)
2480: 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 'warn).........
2490: 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 28 76 . ((eq? (v
24a0: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
24b0: 6e 66 6f 20 32 29 20 30 29 20 20 20 20 20 20 20 nfo 2) 0)
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 27 70 61 73 'pas
24d0: 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 s)..........
24e0: 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 (else 'fail))
24f0: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6f 76 )........ (ov
2500: 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 erall-status (
2510: 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 cond..........
2520: 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 ((eq? rollu
2530: 70 2d 73 74 61 74 75 73 20 32 29 20 27 77 61 72 p-status 2) 'war
2540: 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 n)..........
2550: 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d ((eq? rollup-
2560: 73 74 61 74 75 73 20 30 29 20 27 70 61 73 73 29 status 0) 'pass)
2570: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2580: 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a (else 'fail))).
2590: 09 09 09 09 09 09 09 20 20 20 20 28 6e 65 78 74 ....... (next
25a0: 2d 73 74 61 74 75 73 20 20 20 20 20 20 28 63 6f -status (co
25b0: 6e 64 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 nd ..........
25c0: 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c ((eq? overal
25d0: 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 29 20 l-status 'pass)
25e0: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
25f0: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
2600: 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d ((eq? overall-
2610: 73 74 61 74 75 73 20 27 77 61 72 6e 29 0a 09 09 status 'warn)...
2620: 09 09 09 09 09 09 09 09 28 69 66 20 28 65 71 3f ........(if (eq?
2630: 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 this-step-statu
2640: 73 20 27 66 61 69 6c 29 20 27 66 61 69 6c 20 27 s 'fail) 'fail '
2650: 77 61 72 6e 29 29 0a 09 09 09 09 09 09 09 09 09 warn))..........
2660: 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 (else 'fa
2670: 69 6c 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 il)))).......
2680: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
2690: 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 20 72 4 "Exit value r
26a0: 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 63 74 eceived: " (vect
26b0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
26c0: 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 2) " logpro-use
26d0: 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 d: " logpro-used
26e0: 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 20 ......... "
26f0: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
2700: 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 : " this-step-st
2710: 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 atus " overall-s
2720: 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c tatus: " overall
2730: 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 09 09 -status ........
2740: 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 61 74 . " next-stat
2750: 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 75 us: " next-statu
2760: 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 s " rollup-statu
2770: 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 s: " rollup-stat
2780: 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 us).......
2790: 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 61 74 (case next-stat
27a0: 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 61 72 us........ ((war
27b0: 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 65 74 n)........ (set
27c0: 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ! rollup-status
27d0: 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b 20 4e 2)........ ;; N
27e0: 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 B// test-set-sta
27f0: 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 tus! does rdb ca
2800: 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f lls under the ho
2810: 6f 64 0a 09 09 09 09 09 09 09 20 20 28 6f 70 65 od........ (ope
2820: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 n-run-close test
2830: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
2840: 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 22 52 s! #f test-id "R
2850: 55 4e 4e 49 4e 47 22 20 22 57 41 52 4e 22 20 0a UNNING" "WARN" .
2860: 09 09 09 09 09 09 09 09 09 20 20 20 20 28 69 66 ......... (if
2870: 20 28 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d (eq? this-step-
2880: 73 74 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c status 'warn) "L
2890: 6f 67 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f ogpro warning fo
28a0: 75 6e 64 22 20 23 66 29 0a 09 09 09 09 09 09 09 und" #f)........
28b0: 09 09 20 20 20 20 23 66 29 29 0a 09 09 09 09 09 .. #f))......
28c0: 09 09 20 28 28 70 61 73 73 29 0a 09 09 09 09 09 .. ((pass)......
28d0: 09 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c .. (open-run-cl
28e0: 6f 73 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 ose tests:test-s
28f0: 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 et-status! #f te
2900: 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 st-id "RUNNING"
2910: 22 50 41 53 53 22 20 23 66 20 23 66 29 29 0a 09 "PASS" #f #f))..
2920: 09 09 09 09 09 09 20 28 65 6c 73 65 20 3b 3b 20 ...... (else ;;
2930: 27 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 'fail........ (
2940: 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 set! rollup-stat
2950: 75 73 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 66 us 1) ;; force f
2960: 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 6f 70 ail........ (op
2970: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 en-run-close tes
2980: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
2990: 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 22 us! #f test-id "
29a0: 52 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 RUNNING" "FAIL"
29b0: 28 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 (conc "Failed at
29c0: 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 step " stepname
29d0: 29 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 ) #f)........ )
29e0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 )))....... (if
29f0: 20 28 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 (and (steprun-g
2a00: 6f 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 ood? logpro-used
2a10: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
2a20: 74 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 t-info 2))......
2a30: 09 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c .. (not (null
2a40: 3f 20 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 ? tal))).......
2a50: 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 (loop (car
2a60: 20 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 tal) (cdr tal)
2a70: 73 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 stepname))).....
2a80: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
2a90: 6e 74 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 nt 4 "WARNING: a
2aa0: 20 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c prior step fail
2ab0: 65 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 ed, stopping at
2ac0: 22 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 " ezstep))))))))
2ad0: 0a 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 ... (monitorjob
2ae0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
2af0: 09 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d . (let* ((start-
2b00: 73 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 seconds (current
2b10: 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 -seconds))......
2b20: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 (calc-minutes (
2b30: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 lambda ().......
2b40: 09 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 . (inexact->exac
2b50: 74 20 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 t ........ (rou
2b60: 6e 64 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d nd ........ (-
2b70: 20 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 75 ........ (cu
2b80: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a rrent-seconds) .
2b90: 09 09 09 09 09 09 09 20 20 20 20 73 74 61 72 74 ....... start
2ba0: 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 -seconds)))))...
2bb0: 09 09 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 ...(kill-tries 0
2bc0: 29 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 6c ))..... (let l
2bd0: 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 oop ((minutes
2be0: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 (calc-minutes)))
2bf0: 0a 09 09 09 09 20 20 20 20 20 3b 3b 20 28 6c 65 ..... ;; (le
2c00: 74 2a 20 28 3b 3b 20 28 64 62 20 20 20 20 20 20 t* (;; (db
2c10: 20 28 6f 70 65 6e 2d 64 62 29 29 0a 09 09 09 09 (open-db)).....
2c20: 09 20 20 20 20 3b 3b 20 28 63 70 75 6c 6f 61 64 . ;; (cpuload
2c30: 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 (get-cpu-load)
2c40: 29 0a 09 09 09 09 09 20 20 20 20 3b 3b 20 28 64 )...... ;; (d
2c50: 69 73 6b 66 72 65 65 20 28 67 65 74 2d 64 66 20 iskfree (get-df
2c60: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
2c70: 72 79 29 29 29 0a 09 09 09 09 09 20 20 20 20 3b ry)))...... ;
2c80: 3b 20 28 74 6d 70 66 72 65 65 20 20 28 67 65 74 ; (tmpfree (get
2c90: 2d 64 66 20 22 2f 74 6d 70 22 29 29 29 0a 09 09 -df "/tmp")))...
2ca0: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
2cb0: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 69 66 20 .. ;; (if
2cc0: 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d 61 (not (args:get-a
2cd0: 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a 09 rg "-server"))..
2ce0: 09 09 09 20 20 20 20 20 20 20 3b 3b 09 20 20 20 ... ;;.
2cf0: 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 (server:client-s
2d00: 65 74 75 70 20 64 62 29 29 0a 09 09 09 09 20 20 etup db)).....
2d10: 20 20 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 ;; (if (not
2d20: 20 63 70 75 6c 6f 61 64 29 20 20 28 62 65 67 69 cpuload) (begi
2d30: 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 n (debug:print 0
2d40: 20 22 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 4f "WARNING: CPULO
2d50: 41 44 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 AD not found.")
2d60: 20 28 73 65 74 21 20 63 70 75 6c 6f 61 64 20 22 (set! cpuload "
2d70: 6e 2f 61 22 29 29 29 0a 09 09 09 09 20 20 20 20 n/a"))).....
2d80: 20 20 20 3b 3b 20 28 69 66 20 28 6e 6f 74 20 64 ;; (if (not d
2d90: 69 73 6b 66 72 65 65 29 20 28 62 65 67 69 6e 20 iskfree) (begin
2da0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
2db0: 57 41 52 4e 49 4e 47 3a 20 44 49 53 4b 46 52 45 WARNING: DISKFRE
2dc0: 45 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 28 E not found.") (
2dd0: 73 65 74 21 20 64 69 73 6b 66 72 65 65 20 22 6e set! diskfree "n
2de0: 2f 61 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 /a"))).....
2df0: 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 (set! kill-job
2e00: 3f 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ? (open-run-clos
2e10: 65 20 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d e test-get-kill-
2e20: 72 65 71 75 65 73 74 20 23 66 20 74 65 73 74 2d request #f test-
2e30: 69 64 29 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 id)) ;; run-id t
2e40: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
2e50: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 6f ))..... (o
2e60: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 pen-run-close te
2e70: 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f st-set-meta-info
2e80: 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d #f test-id run-
2e90: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
2ea0: 6d 64 61 74 20 6d 69 6e 75 74 65 73 29 0a 09 09 mdat minutes)...
2eb0: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 72 64 62 .. ;; (rdb
2ec0: 3a 74 65 73 74 2d 75 70 64 61 74 65 2d 6d 65 74 :test-update-met
2ed0: 61 2d 69 6e 66 6f 20 64 62 20 74 65 73 74 2d 69 a-info db test-i
2ee0: 64 20 6d 69 6e 75 74 65 73 20 63 70 75 6c 6f 61 d minutes cpuloa
2ef0: 64 20 64 69 73 6b 66 72 65 65 20 74 6d 70 66 72 d diskfree tmpfr
2f00: 65 65 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 ee)..... (
2f10: 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 if kill-job? ...
2f20: 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ... (begin....
2f30: 09 09 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f .. (mutex-lo
2f40: 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 ck! m)......
2f50: 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 (let* ((pid (ve
2f60: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2f70: 66 6f 20 30 29 29 29 0a 09 09 09 09 09 20 20 20 fo 0)))......
2f80: 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f (if (number?
2f90: 20 70 69 64 29 0a 09 09 09 09 09 09 20 20 20 28 pid)....... (
2fa0: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
2fb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
2fc0: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
2fd0: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
2fe0: 6c 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 ll job (attempt
2ff0: 23 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 # " kill-tries "
3000: 29 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 )")....... (
3010: 6c 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 20 let ((processes
3020: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 (cmd-run->list (
3030: 63 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 2d conc "pgrep -l -
3040: 50 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 P " pid)))).....
3050: 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 .. (for-ea
3060: 63 68 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 ch ........(lamb
3070: 64 61 20 28 70 29 0a 09 09 09 09 09 09 09 20 20 da (p)........
3080: 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 (let* ((parts (
3090: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 string-split p))
30a0: 0a 09 09 09 09 09 09 09 09 20 28 70 2d 69 64 20 ......... (p-id
30b0: 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 (if (> (length
30c0: 20 70 61 72 74 73 29 20 30 29 0a 09 09 09 09 09 parts) 0)......
30d0: 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 .... (string
30e0: 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 ->number (car pa
30f0: 72 74 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 rts))..........
3100: 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 #f))).......
3110: 09 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 09 . (if p-id...
3120: 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ......(begin....
3130: 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ..... (debug:pr
3140: 69 6e 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 int 0 "Killing "
3150: 20 28 63 61 64 72 20 70 61 72 74 73 29 20 22 3b (cadr parts) ";
3160: 20 6b 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 kill -9 " p-id
3170: 29 0a 09 09 09 09 09 09 09 09 20 20 28 73 79 73 )......... (sys
3180: 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 tem (conc "kill
3190: 2d 39 20 22 20 70 2d 69 64 29 29 29 29 29 29 0a -9 " p-id)))))).
31a0: 09 09 09 09 09 09 09 28 63 61 72 20 70 72 6f 63 .......(car proc
31b0: 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 20 20 esses)).......
31c0: 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f (system (co
31d0: 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 69 nc "kill -9 " pi
31e0: 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 d))))....... (
31f0: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
3200: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
3210: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
3220: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
3230: 6c 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c ll job but probl
3240: 65 6d 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c em with process,
3250: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b attempting to k
3260: 69 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 ill manager proc
3270: 65 73 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 ess").......
3280: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
3290: 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d tests:test-set-
32a0: 73 74 61 74 75 73 21 20 23 66 20 74 65 73 74 2d status! #f test-
32b0: 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 id "KILLED" "FA
32c0: 49 4c 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 IL".........
32d0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
32e0: 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 09 "-m") #f)......
32f0: 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 . (sqlite3:f
3300: 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 inalize! tdb)...
3310: 09 09 09 09 20 20 20 20 20 28 65 78 69 74 20 31 .... (exit 1
3320: 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 ))))...... (
3330: 73 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 set! kill-tries
3340: 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 (+ 1 kill-tries)
3350: 29 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 74 )...... (mut
3360: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a ex-unlock! m))).
3370: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 73 .... ;; (s
3380: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
3390: 20 64 62 29 0a 09 09 09 09 20 20 20 20 20 20 20 db).....
33a0: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 (thread-sleep! (
33b0: 2b 20 31 30 20 28 72 61 6e 64 6f 6d 20 31 30 29 + 10 (random 10)
33c0: 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a )) ;; add some j
33d0: 69 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c itter to the cal
33e0: 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 l home time to s
33f0: 70 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 pread out the db
3400: 20 61 63 63 65 73 73 65 73 0a 09 09 09 09 20 20 accesses.....
3410: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 6c 63 (loop (calc
3420: 2d 6d 69 6e 75 74 65 73 29 29 29 29 29 29 29 0a -minutes))))))).
3430: 09 09 20 28 74 68 31 20 20 20 20 20 20 20 20 20 .. (th1
3440: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f (make-thread mo
3450: 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 09 20 28 74 nitorjob))... (t
3460: 68 32 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b h2 (mak
3470: 65 2d 74 68 72 65 61 64 20 72 75 6e 69 74 29 29 e-thread runit))
3480: 29 0a 09 20 20 20 20 28 73 65 74 21 20 6a 6f 62 ).. (set! job
3490: 2d 74 68 72 65 61 64 20 74 68 32 29 0a 09 20 20 -thread th2)..
34a0: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
34b0: 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 th1).. (thre
34c0: 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 ad-start! th2)..
34d0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
34e0: 21 20 74 68 32 29 0a 09 20 20 20 20 28 6d 75 74 ! th2).. (mut
34f0: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 ex-lock! m)..
3500: 20 3b 3b 20 28 73 65 74 21 20 64 62 20 28 6f 70 ;; (set! db (op
3510: 65 6e 2d 64 62 29 29 0a 09 20 20 20 20 3b 3b 20 en-db)).. ;;
3520: 28 69 66 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 (if (not (args:g
3530: 65 74 2d 61 72 67 20 22 2d 73 65 72 76 65 72 22 et-arg "-server"
3540: 29 29 0a 09 20 20 20 20 3b 3b 09 28 73 65 72 76 )).. ;;.(serv
3550: 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 er:client-setup
3560: 64 62 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 db)).. (let*
3570: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 ((item-path (ite
3580: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
3590: 6d 64 61 74 29 29 0a 09 09 20 20 20 28 74 65 73 mdat))... (tes
35a0: 74 69 6e 66 6f 20 20 28 6f 70 65 6e 2d 72 75 6e tinfo (open-run
35b0: 2d 63 6c 6f 73 65 20 64 62 3a 67 65 74 2d 74 65 -close db:get-te
35c0: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 23 66 st-info-by-id #f
35d0: 20 74 65 73 74 2d 69 64 29 29 29 20 3b 3b 20 29 test-id))) ;; )
35e0: 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 ) ;; run-id test
35f0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
3600: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e )).. (if (n
3610: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
3620: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
3630: 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c 45 54 stinfo) "COMPLET
3640: 45 44 22 29 29 0a 09 09 20 20 28 62 65 67 69 6e ED"))... (begin
3650: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
3660: 69 6e 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 int 2 "Test NOT
3670: 6c 6f 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 logged as COMPLE
3680: 54 45 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 TED, (state=" (d
3690: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
36a0: 20 74 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 testinfo) "), u
36b0: 70 64 61 74 69 6e 67 20 72 65 73 75 6c 74 2c 20 pdating result,
36c0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 69 73 rollup-status is
36d0: 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 " rollup-status
36e0: 29 0a 09 09 20 20 20 20 28 6f 70 65 6e 2d 72 75 )... (open-ru
36f0: 6e 2d 63 6c 6f 73 65 20 74 65 73 74 73 3a 74 65 n-close tests:te
3700: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 st-set-status! #
3710: 66 20 74 65 73 74 2d 69 64 20 0a 09 09 09 09 20 f test-id .....
3720: 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f (if kill-jo
3730: 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d b? "KILLED" "COM
3740: 50 4c 45 54 45 44 22 29 0a 09 09 09 09 20 20 20 PLETED").....
3750: 20 20 20 3b 3b 20 4f 6c 64 20 6c 6f 67 69 63 3a ;; Old logic:
3760: 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 69 ..... ;; (i
3770: 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 f (vector-ref ex
3780: 69 74 2d 69 6e 66 6f 20 31 29 20 3b 3b 20 6c 6f it-info 1) ;; lo
3790: 6f 6b 20 61 74 20 74 68 65 20 65 78 69 74 2d 73 ok at the exit-s
37a0: 74 61 74 75 73 2c 20 23 74 20 6d 65 61 6e 73 20 tatus, #t means
37b0: 69 74 20 61 74 20 6c 65 61 73 74 20 72 61 6e 0a it at least ran.
37c0: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 .... ;;
37d0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 6b (if (and (not k
37e0: 69 6c 6c 2d 6a 6f 62 3f 29 20 0a 09 09 09 09 20 ill-job?) .....
37f0: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
3800: 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 (eq? (vector-ref
3810: 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 29 exit-info 2) 0)
3820: 29 20 3b 3b 20 77 65 20 63 61 6e 20 6e 6f 77 20 ) ;; we can now
3830: 75 73 65 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 use rollup-statu
3840: 73 20 69 6e 73 74 65 61 64 0a 09 09 09 09 20 20 s instead.....
3850: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 22 ;; "
3860: 50 41 53 53 22 0a 09 09 09 09 20 20 20 20 20 20 PASS".....
3870: 3b 3b 20 20 20 20 20 20 20 20 20 22 46 41 49 4c ;; "FAIL
3880: 22 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 ")..... ;;
3890: 20 20 20 20 22 46 41 49 4c 22 29 20 0a 09 09 09 "FAIL") ....
38a0: 09 20 20 20 20 20 20 3b 3b 20 4e 65 77 20 6c 6f . ;; New lo
38b0: 67 69 63 20 62 61 73 65 64 20 6f 6e 20 72 6f 6c gic based on rol
38c0: 6c 75 70 2d 73 74 61 74 75 73 0a 09 09 09 09 20 lup-status.....
38d0: 20 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 20 (cond.....
38e0: 20 20 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 ((not (vec
38f0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3900: 6f 20 31 29 29 20 22 46 41 49 4c 22 29 20 3b 3b o 1)) "FAIL") ;;
3910: 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 72 job failed to r
3920: 75 6e 0a 09 09 09 09 20 20 20 20 20 20 20 28 28 un..... ((
3930: 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 eq? rollup-statu
3940: 73 20 30 29 0a 09 09 09 09 09 3b 3b 20 69 66 20 s 0)......;; if
3950: 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 the current stat
3960: 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 20 64 us is AUTO the d
3970: 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 efer to the calc
3980: 75 6c 61 74 65 64 20 76 61 6c 75 65 20 28 69 2e ulated value (i.
3990: 65 2e 20 6c 65 61 76 65 20 74 68 69 73 20 41 55 e. leave this AU
39a0: 54 4f 29 0a 09 09 09 09 09 28 69 66 20 28 65 71 TO)......(if (eq
39b0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
39c0: 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 t-status testinf
39d0: 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f o) "AUTO") "AUTO
39e0: 22 20 22 50 41 53 53 22 29 29 0a 09 09 09 09 20 " "PASS")).....
39f0: 20 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c ((eq? roll
3a00: 75 70 2d 73 74 61 74 75 73 20 31 29 20 22 46 41 up-status 1) "FA
3a10: 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 IL").....
3a20: 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 ((eq? rollup-sta
3a30: 74 75 73 20 32 29 0a 09 09 09 09 09 3b 3b 20 69 tus 2)......;; i
3a40: 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 f the current st
3a50: 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 atus is AUTO the
3a60: 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 defer to the ca
3a70: 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 62 lculated value b
3a80: 75 74 20 71 75 61 6c 69 66 79 20 28 69 2e 65 2e ut qualify (i.e.
3a90: 20 6d 61 6b 65 20 74 68 69 73 20 41 55 54 4f 2d make this AUTO-
3aa0: 57 41 52 4e 29 0a 09 09 09 09 09 28 69 66 20 28 WARN)......(if (
3ab0: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
3ac0: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 get-status testi
3ad0: 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 nfo) "AUTO") "AU
3ae0: 54 4f 2d 57 41 52 4e 22 20 22 57 41 52 4e 22 29 TO-WARN" "WARN")
3af0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 65 6c )..... (el
3b00: 73 65 20 22 46 41 49 4c 22 29 29 0a 09 09 09 09 se "FAIL")).....
3b10: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
3b20: 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 29 0a arg "-m") #f))).
3b30: 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 . ;; for au
3b40: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
3b50: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
3b60: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
3b70: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
3b80: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
3b90: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
3ba0: 74 68 20 22 22 29 29 0a 09 09 20 20 28 6f 70 65 th ""))... (ope
3bb0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 n-run-close test
3bc0: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d s:summarize-item
3bd0: 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 s #f run-id test
3be0: 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 64 6f -name #f)) ;; do
3bf0: 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74 n't force - just
3c00: 20 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 20 update if no..
3c10: 20 20 20 20 20 29 0a 09 20 20 20 20 28 6d 75 74 ).. (mut
3c20: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
3c30: 20 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 ;; (exec-resu
3c40: 6c 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 lts (cmd-run->li
3c50: 73 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 st fullrunscript
3c60: 29 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 )) ;; (list ">"
3c70: 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 (conc test-name
3c80: 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a "-run.log")))).
3c90: 09 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 73 . ;; (success
3ca0: 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 6c exec-resul
3cb0: 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 61 ts)) ;; (eq? (ca
3cc0: 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 29 dr exec-results)
3cd0: 20 30 29 29 29 0a 09 20 20 20 20 28 64 65 62 75 0))).. (debu
3ce0: 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 74 70 75 g:print 2 "Outpu
3cf0: 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 t from running "
3d00: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 fullrunscript "
3d10: 2c 20 70 69 64 20 22 20 28 76 65 63 74 6f 72 2d , pid " (vector-
3d20: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3d30: 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 20 " in work area
3d40: 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 61 " .... work-area
3d50: 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 ":\n====\n exit
3d60: 20 63 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d code " (vector-
3d70: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
3d80: 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a "\n" "====\n").
3d90: 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 . ;; (sqlite3
3da0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
3db0: 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a ;; (sqlite3:
3dc0: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
3dd0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 (if (not (ve
3de0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3df0: 66 6f 20 31 29 29 0a 09 09 28 65 78 69 74 20 34 fo 1))...(exit 4
3e00: 29 29 29 29 29 29 29 0a 0a 3b 3b 20 73 65 74 20 )))))))..;; set
3e10: 75 70 20 74 68 65 20 76 65 72 79 20 62 61 73 69 up the very basi
3e20: 63 73 20 6e 65 65 64 65 64 20 66 6f 72 20 64 6f cs needed for do
3e30: 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 68 65 72 ing anything her
3e40: 65 2e 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 e..(define (setu
3e50: 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 20 3b 3b 20 p-for-run). ;;
3e60: 77 6f 75 6c 64 20 73 65 74 20 76 61 6c 75 65 73 would set values
3e70: 20 66 6f 72 20 4b 45 59 53 20 69 6e 20 74 68 65 for KEYS in the
3e80: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 65 72 environment her
3e90: 65 20 66 6f 72 20 62 65 74 74 65 72 20 73 75 70 e for better sup
3ea0: 70 6f 72 74 20 6f 66 20 65 6e 76 2d 6f 76 65 72 port of env-over
3eb0: 72 69 64 65 20 62 75 74 20 0a 20 20 3b 3b 20 68 ride but . ;; h
3ec0: 61 76 65 20 63 68 69 63 6b 65 6e 2f 65 67 67 20 ave chicken/egg
3ed0: 73 63 65 6e 61 72 69 6f 2e 20 6e 65 65 64 20 74 scenario. need t
3ee0: 6f 20 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e o read megatest.
3ef0: 63 6f 6e 66 69 67 20 74 68 65 6e 20 72 65 61 64 config then read
3f00: 20 69 74 20 61 67 61 69 6e 2e 20 47 6f 69 6e 67 it again. Going
3f10: 20 74 6f 20 0a 20 20 3b 3b 20 70 61 73 73 20 6f to . ;; pass o
3f20: 6e 20 74 68 61 74 20 69 64 65 61 20 66 6f 72 20 n that idea for
3f30: 6e 6f 77 0a 20 20 3b 3b 20 73 70 65 63 69 61 6c now. ;; special
3f40: 20 63 61 73 65 0a 20 20 28 73 65 74 21 20 2a 63 case. (set! *c
3f50: 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 6e 64 onfiginfo* (find
3f60: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
3f70: 20 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 61 ... (if (a
3f80: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
3f90: 6e 66 69 67 22 29 28 61 72 67 73 3a 67 65 74 2d nfig")(args:get-
3fa0: 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 arg "-config") "
3fb0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
3fc0: 29 0a 09 09 20 20 20 20 20 20 65 6e 76 69 72 6f )... enviro
3fd0: 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 n-patt: "env-ove
3fe0: 72 72 69 64 65 22 0a 09 09 20 20 20 20 20 20 67 rride"... g
3ff0: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 iven-toppath: (g
4000: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
4010: 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f ariable "MT_RUN_
4020: 41 52 45 41 5f 48 4f 4d 45 22 29 0a 09 09 20 20 AREA_HOME")...
4030: 20 20 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 pathenvvar:
4040: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
4050: 45 22 29 29 0a 20 20 28 73 65 74 21 20 2a 63 6f E")). (set! *co
4060: 6e 66 69 67 64 61 74 2a 20 20 28 69 66 20 28 63 nfigdat* (if (c
4070: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
4080: 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f (car *configinfo
4090: 2a 29 20 23 66 29 29 0a 20 20 28 73 65 74 21 20 *) #f)). (set!
40a0: 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 28 69 66 *toppath* (if
40b0: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
40c0: 6f 2a 29 28 63 61 64 72 20 2a 63 6f 6e 66 69 67 o*)(cadr *config
40d0: 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 69 info*) #f)). (i
40e0: 66 20 2a 74 6f 70 70 61 74 68 2a 0a 20 20 20 20 f *toppath*.
40f0: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 (setenv "MT_RU
4100: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f N_AREA_HOME" *to
4110: 70 70 61 74 68 2a 29 20 3b 3b 20 74 6f 20 62 65 ppath*) ;; to be
4120: 20 64 65 70 72 65 63 61 74 65 64 0a 20 20 20 20 deprecated.
4130: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4140: 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 "ERROR: failed
4150: 74 6f 20 66 69 6e 64 20 74 68 65 20 74 6f 70 20 to find the top
4160: 70 61 74 68 20 74 6f 20 79 6f 75 72 20 72 75 6e path to your run
4170: 20 73 65 74 75 70 2e 22 29 29 0a 20 20 2a 74 6f setup.")). *to
4180: 70 70 61 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 ppath*)..(define
4190: 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 (get-best-disk
41a0: 63 6f 6e 66 64 61 74 29 0a 20 20 28 6c 65 74 2a confdat). (let*
41b0: 20 28 28 64 69 73 6b 73 20 20 20 20 28 68 61 73 ((disks (has
41c0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
41d0: 75 6c 74 20 63 6f 6e 66 64 61 74 20 22 64 69 73 ult confdat "dis
41e0: 6b 73 22 20 23 66 29 29 0a 09 20 28 62 65 73 74 ks" #f)).. (best
41f0: 20 20 20 20 20 23 66 29 0a 09 20 28 62 65 73 74 #f).. (best
4200: 73 69 7a 65 20 30 29 29 0a 20 20 20 20 28 69 66 size 0)). (if
4210: 20 64 69 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 disks ..(for-ea
4220: 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 ch .. (lambda (d
4230: 69 73 6b 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 isk-num).. (le
4240: 74 2a 20 28 28 64 69 72 70 61 74 68 20 20 20 20 t* ((dirpath
4250: 28 63 61 64 72 20 28 61 73 73 6f 63 20 64 69 73 (cadr (assoc dis
4260: 6b 2d 6e 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 k-num disks)))..
4270: 09 20 20 28 66 72 65 65 73 70 63 20 20 20 20 28 . (freespc (
4280: 69 66 20 28 61 6e 64 20 28 64 69 72 65 63 74 6f if (and (directo
4290: 72 79 3f 20 64 69 72 70 61 74 68 29 0a 09 09 09 ry? dirpath)....
42a0: 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 . (file-wr
42b0: 69 74 65 2d 61 63 63 65 73 73 3f 20 64 69 72 70 ite-access? dirp
42c0: 61 74 68 29 29 0a 09 09 09 09 20 20 28 67 65 74 ath))..... (get
42d0: 2d 64 66 20 64 69 72 70 61 74 68 29 0a 09 09 09 -df dirpath)....
42e0: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 . (begin.....
42f0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4300: 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 "WARNING: path
4310: 22 20 64 69 72 70 61 74 68 20 22 20 69 6e 20 5b " dirpath " in [
4320: 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e disks] section n
4330: 6f 74 20 76 61 6c 69 64 20 6f 72 20 77 72 69 74 ot valid or writ
4340: 61 62 6c 65 22 29 0a 09 09 09 09 20 20 20 20 30 able")..... 0
4350: 29 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 )))).. (if (
4360: 3e 20 66 72 65 65 73 70 63 20 62 65 73 74 73 69 > freespc bestsi
4370: 7a 65 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 ze)... (begin...
4380: 20 20 20 28 73 65 74 21 20 62 65 73 74 20 20 20 (set! best
4390: 20 20 64 69 72 70 61 74 68 29 0a 09 09 20 20 20 dirpath)...
43a0: 28 73 65 74 21 20 62 65 73 74 73 69 7a 65 20 66 (set! bestsize f
43b0: 72 65 65 73 70 63 29 29 29 29 29 0a 09 20 28 6d reespc))))).. (m
43c0: 61 70 20 63 61 72 20 64 69 73 6b 73 29 29 29 0a ap car disks))).
43d0: 20 20 20 20 28 69 66 20 62 65 73 74 0a 09 62 65 (if best..be
43e0: 73 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 st..(begin.. (d
43f0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4400: 52 4f 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 ROR: No valid di
4410: 73 6b 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 sks found in meg
4420: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c atest.config. Pl
4430: 65 61 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f ease add some to
4440: 20 79 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 your [disks] se
4450: 63 74 69 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 ction").. (exit
4460: 20 31 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 1)))))..;; Desi
4470: 72 65 64 20 64 69 72 65 63 74 6f 72 79 20 73 74 red directory st
4480: 72 75 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 ructure:.;;.;;
4490: 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 <linkdir> - <tar
44a0: 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 get> - <testname
44b0: 3e 20 2d 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 > -..;;
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b |.;;
44e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 v.;; <rund
4510: 69 72 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 3e ir> - <target>
4520: 20 20 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 - <testname
4530: 3e 20 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 > -|- <itempath(
4540: 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 s)>.;;.;; dir s
4550: 74 6f 72 65 64 20 69 6e 20 74 65 73 74 20 69 73 tored in test is
4560: 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 :.;; .;; <linkd
4570: 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d ir> - <target> -
4580: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
4590: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 <itempath> ].;;
45a0: 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 .;; All log file
45b0: 20 6c 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 links should be
45c0: 20 73 74 6f 72 65 64 20 72 65 6c 61 74 69 76 65 stored relative
45d0: 20 74 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 6c to the top of l
45e0: 69 6e 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b ink path.;; .;;
45f0: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
4600: 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d tname> [ - <item
4610: 70 61 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 path> ] .;;.(def
4620: 69 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b ine (create-work
4630: 2d 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 -area db run-id
4640: 74 65 73 74 2d 69 64 20 74 65 73 74 2d 73 72 63 test-id test-src
4650: 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 74 68 20 -path disk-path
4660: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 testname itemdat
4670: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d ). (let* ((run-
4680: 69 6e 66 6f 20 28 64 62 3a 67 65 74 2d 72 75 6e info (db:get-run
4690: 2d 69 6e 66 6f 20 64 62 20 72 75 6e 2d 69 64 29 -info db run-id)
46a0: 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 28 ).. (item-path (
46b0: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
46c0: 69 74 65 6d 64 61 74 29 29 0a 09 20 28 72 75 6e itemdat)).. (run
46d0: 6e 61 6d 65 20 20 28 64 62 3a 67 65 74 2d 76 61 name (db:get-va
46e0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 lue-by-header (d
46f0: 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e 2d 69 6e b:get-row run-in
4700: 66 6f 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a fo)...... (db:
4710: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 get-header run-i
4720: 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 22 72 75 nfo)...... "ru
4730: 6e 6e 61 6d 65 22 29 29 0a 09 20 3b 3b 20 63 6f nname")).. ;; co
4740: 6e 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 62 nvert back to db
4750: 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 : from rdb: - th
4760: 69 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 6e is is always run
4770: 20 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a 09 at server end..
4780: 20 28 6b 65 79 2d 76 61 6c 73 20 28 64 62 3a 67 (key-vals (db:g
4790: 65 74 2d 6b 65 79 2d 76 61 6c 73 20 64 62 20 72 et-key-vals db r
47a0: 75 6e 2d 69 64 29 29 0a 09 20 28 74 61 72 67 65 un-id)).. (targe
47b0: 74 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 t (string-inte
47c0: 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 rsperse key-vals
47d0: 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 2d 69 "/"))... (not-i
47e0: 74 65 72 61 74 65 64 20 20 28 65 71 75 61 6c 3f terated (equal?
47f0: 20 22 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a "" item-path)).
4800: 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 74 73 20 .. ;; all tests
4810: 61 72 65 20 66 6f 75 6e 64 20 61 74 20 3c 72 75 are found at <ru
4820: 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 20 ndir>/test-base
4830: 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 73 or <linkdir>/tes
4840: 74 2d 62 61 73 65 0a 09 20 28 74 65 73 74 74 6f t-base.. (testto
4850: 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 74 61 72 p-base (conc tar
4860: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 get "/" runname
4870: 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 "/" testname))..
4880: 20 28 74 65 73 74 2d 62 61 73 65 20 20 20 20 28 (test-base (
4890: 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d 62 61 73 conc testtop-bas
48a0: 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 e (if not-iterat
48b0: 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d ed "" "/") item-
48c0: 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 2f path))... ;; nb/
48d0: 2f 20 69 66 20 69 74 65 6d 70 61 74 68 20 69 73 / if itempath is
48e0: 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 69 74 20 not "" then it
48f0: 69 73 20 70 72 65 66 69 78 65 64 20 77 69 74 68 is prefixed with
4900: 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 73 74 2d "/".. (toptest-
4910: 70 61 74 68 20 28 63 6f 6e 63 20 64 69 73 6b 2d path (conc disk-
4920: 70 61 74 68 20 22 2f 22 20 74 65 73 74 74 6f 70 path "/" testtop
4930: 2d 62 61 73 65 29 29 0a 09 20 28 74 65 73 74 2d -base)).. (test-
4940: 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 64 69 path (conc di
4950: 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 sk-path "/" test
4960: 2d 62 61 73 65 29 29 0a 0a 09 20 3b 3b 20 65 6e -base))... ;; en
4970: 73 75 72 65 20 74 68 69 73 20 65 78 69 73 74 73 sure this exists
4980: 20 66 69 72 73 74 20 61 73 20 6c 69 6e 6b 73 20 first as links
4990: 74 6f 20 73 75 62 74 65 73 74 73 20 6d 75 73 74 to subtests must
49a0: 20 62 65 20 63 72 65 61 74 65 64 20 74 68 65 72 be created ther
49b0: 65 0a 09 20 28 6c 69 6e 6b 74 72 65 65 20 20 28 e.. (linktree (
49c0: 6c 65 74 20 28 28 72 64 20 28 63 6f 6e 66 69 67 let ((rd (config
49d0: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
49e0: 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e at* "setup" "lin
49f0: 6b 74 72 65 65 22 29 29 29 0a 09 09 20 20 20 20 ktree")))...
4a00: 20 28 69 66 20 72 64 20 72 64 20 28 63 6f 6e 63 (if rd rd (conc
4a10: 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e *toppath* "/run
4a20: 73 22 29 29 29 29 0a 0a 09 20 28 6c 6e 6b 62 61 s"))))... (lnkba
4a30: 73 65 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 se (conc linktr
4a40: 65 65 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f ee "/" target "/
4a50: 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c " runname)).. (l
4a60: 6e 6b 70 61 74 68 20 20 28 63 6f 6e 63 20 6c 6e nkpath (conc ln
4a70: 6b 62 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 kbase "/" testna
4a80: 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 me)).. (lnkpathf
4a90: 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 (conc lnkpath (
4aa0: 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 if not-iterated
4ab0: 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 "" "/") item-pat
4ac0: 68 29 29 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 h))).. ;; Upd
4ad0: 61 74 65 20 74 68 65 20 72 75 6e 64 69 72 20 70 ate the rundir p
4ae0: 61 74 68 20 69 6e 20 74 68 65 20 74 65 73 74 20 ath in the test
4af0: 72 65 63 6f 72 64 20 66 6f 72 20 61 6c 6c 0a 20 record for all.
4b00: 20 20 20 28 64 62 3a 74 65 73 74 2d 73 65 74 2d (db:test-set-
4b10: 72 75 6e 64 69 72 21 20 64 62 20 72 75 6e 2d 69 rundir! db run-i
4b20: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
4b30: 70 61 74 68 20 6c 6e 6b 70 61 74 68 66 29 0a 0a path lnkpathf)..
4b40: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4b50: 20 32 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 20 2 "INFO:\n
4b60: 20 20 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b 62 lnkbase=" lnkb
4b70: 61 73 65 20 22 5c 6e 20 20 20 20 20 20 20 6c 6e ase "\n ln
4b80: 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 20 kpath=" lnkpath
4b90: 22 5c 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 74 "\n toptest-pat
4ba0: 68 3d 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 h=" toptest-path
4bb0: 20 22 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 61 "\n test-pa
4bc0: 74 68 3d 22 20 74 65 73 74 2d 70 61 74 68 29 0a th=" test-path).
4bd0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 (if (not (fi
4be0: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 le-exists? linkt
4bf0: 72 65 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 ree))..(begin..
4c00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4c10: 22 57 41 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 72 "WARNING: linktr
4c20: 65 65 20 64 69 64 20 6e 6f 74 20 65 78 69 73 74 ee did not exist
4c30: 21 20 43 72 65 61 74 69 6e 67 20 69 74 20 6e 6f ! Creating it no
4c40: 77 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 w at " linktree)
4c50: 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
4c60: 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 ctory linktree #
4c70: 74 29 29 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 t))) ;; (system
4c80: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
4c90: 22 20 6c 69 6e 6b 74 72 65 65 29 29 29 29 0a 20 " linktree)))).
4ca0: 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 65 ;; create the
4cb0: 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 74 directory for t
4cc0: 68 65 20 74 65 73 74 73 20 64 69 72 20 6c 69 6e he tests dir lin
4cd0: 6b 73 2c 20 74 68 69 73 20 69 73 20 6e 65 65 64 ks, this is need
4ce0: 65 64 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 ed no matter wha
4cf0: 74 2e 2e 2e 0a 20 20 20 20 28 69 66 20 28 6e 6f t.... (if (no
4d00: 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 t (directory-exi
4d10: 73 74 73 3f 20 6c 6e 6b 62 61 73 65 29 29 0a 09 sts? lnkbase))..
4d20: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
4d30: 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 0a 20 y lnkbase #t)).
4d40: 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 61 74 . ;; updat
4d50: 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 72 65 e the toptest re
4d60: 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 6c 6f cord with its lo
4d70: 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c 20 63 cation rundir, c
4d80: 61 63 68 65 20 74 68 65 20 70 61 74 68 0a 20 20 ache the path.
4d90: 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 20 68 ;; This wass h
4da0: 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 65 6e ighly inefficien
4db0: 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 65 20 t, one db write
4dc0: 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 65 73 for every subtes
4dd0: 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 0a 20 t, potentially.
4de0: 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 73 20 ;; thousands
4df0: 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 20 75 of unnecessary u
4e00: 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 74 68 pdates, cache th
4e10: 65 20 66 61 63 74 20 69 74 20 77 61 73 20 73 65 e fact it was se
4e20: 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 74 20 t and don't set
4e30: 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 69 6e it . ;; again
4e40: 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 42 20 2d 20 . .. ;; NB -
4e50: 54 68 69 73 20 69 73 20 6e 6f 74 20 77 6f 72 6b This is not work
4e60: 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f 6d 65 ing right - some
4e70: 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 20 6e top tests are n
4e80: 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 20 70 ot getting the p
4e90: 61 74 68 20 73 65 74 21 21 21 0a 0a 20 20 20 20 ath set!!!..
4ea0: 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 (if (not (hash-t
4eb0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
4ec0: 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a *toptest-paths*
4ed0: 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a 09 testname #f))..
4ee0: 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e 66 6f (let* ((testinfo
4ef0: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 74 (db:get-t
4f00: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 64 est-info-by-id d
4f10: 62 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 b test-id)) ;;
4f20: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
4f30: 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 item-path))..
4f40: 20 20 20 20 28 63 75 72 72 2d 74 65 73 74 2d 70 (curr-test-p
4f50: 61 74 68 20 28 69 66 20 74 65 73 74 69 6e 66 6f ath (if testinfo
4f60: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
4f70: 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 20 23 ndir testinfo) #
4f80: 66 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 f))).. (hash-ta
4f90: 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 ble-set! *toptes
4fa0: 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d t-paths* testnam
4fb0: 65 20 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 e curr-test-path
4fc0: 29 0a 09 20 20 28 64 62 3a 74 65 73 74 2d 73 65 ).. (db:test-se
4fd0: 74 2d 72 75 6e 64 69 72 21 20 64 62 20 72 75 6e t-rundir! db run
4fe0: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 22 22 20 -id testname ""
4ff0: 6c 6e 6b 70 61 74 68 29 20 3b 3b 20 74 6f 70 74 lnkpath) ;; topt
5000: 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 69 66 est-path).. (if
5010: 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 (or (not curr-t
5020: 65 73 74 2d 70 61 74 68 29 0a 09 09 20 20 28 6e est-path)... (n
5030: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
5040: 69 73 74 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 ists? toptest-pa
5050: 74 68 29 29 29 0a 09 20 20 20 20 20 20 28 62 65 th))).. (be
5060: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
5070: 6e 74 20 32 20 22 49 4e 46 4f 3a 20 43 72 65 61 nt 2 "INFO: Crea
5080: 74 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 ting " toptest-p
5090: 61 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 ath " and link "
50a0: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 28 63 72 65 lnkpath)...(cre
50b0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f ate-directory to
50c0: 70 74 65 73 74 2d 70 61 74 68 20 23 74 29 0a 09 ptest-path #t)..
50d0: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set
50e0: 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 ! *toptest-paths
50f0: 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 * testname topte
5100: 73 74 2d 70 61 74 68 29 29 29 29 29 0a 0a 20 20 st-path)))))..
5110: 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 ;; Now create
5120: 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 the link from th
5130: 65 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 e test path to t
5140: 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f he link tree, ho
5150: 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 wever. ;; if
5160: 74 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 the test is iter
5170: 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 ated it is neces
5180: 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 sary to create t
5190: 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 he parent path.
51a0: 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 ;; to the ite
51b0: 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 ration. use path
51c0: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 name-directory t
51d0: 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 o trim the path
51e0: 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 by one. ;; le
51f0: 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 vel. (if (not
5200: 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b not-iterated) ;
5210: 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a ; i.e. iterated.
5220: 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 .(let ((iterated
5230: 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 -parent (pathna
5240: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f me-directory (co
5250: 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 nc lnkpath "/" i
5260: 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 tem-path))))..
5270: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
5280: 49 4e 46 4f 3a 20 43 72 65 61 74 69 6e 67 20 69 INFO: Creating i
5290: 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 terated parent "
52a0: 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 iterated-parent
52b0: 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 ).. (create-dir
52c0: 65 63 74 6f 72 79 20 69 74 65 72 61 74 65 64 2d ectory iterated-
52d0: 70 61 72 65 6e 74 20 23 74 29 29 29 0a 20 20 20 parent #t))).
52e0: 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 66 (if (not (or (f
52f0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 ile-exists? lnkp
5300: 61 74 68 29 0a 09 09 20 28 73 79 6d 62 6f 6c 69 ath)... (symboli
5310: 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 c-link? lnkpath)
5320: 29 29 0a 09 28 63 72 65 61 74 65 2d 73 79 6d 62 ))..(create-symb
5330: 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 olic-link toptes
5340: 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 t-path lnkpath))
5350: 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 54 68 65 . . ;; The
5360: 20 74 6f 70 74 65 73 74 20 70 61 74 68 20 68 61 toptest path ha
5370: 73 20 62 65 65 6e 20 63 72 65 61 74 65 64 2c 20 s been created,
5380: 74 68 65 20 6c 69 6e 6b 20 74 6f 20 74 68 65 20 the link to the
5390: 74 65 73 74 20 69 6e 20 74 68 65 20 6c 69 6e 6b test in the link
53a0: 74 72 65 65 20 68 61 73 0a 20 20 20 20 3b 3b 20 tree has. ;;
53b0: 62 65 65 6e 20 63 72 65 61 74 65 64 2e 20 4e 6f been created. No
53c0: 77 2c 20 69 66 20 74 68 69 73 20 69 73 20 61 6e w, if this is an
53d0: 20 69 74 65 72 61 74 65 64 20 74 65 73 74 20 74 iterated test t
53e0: 68 65 20 72 65 61 6c 20 74 65 73 74 20 64 69 72 he real test dir
53f0: 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 64 must be created
5400: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f . (if (not no
5410: 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 74 t-iterated) ;; t
5420: 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 61 74 his is an iterat
5430: 65 64 20 74 65 73 74 0a 09 28 6c 65 74 20 28 28 ed test..(let ((
5440: 6c 6e 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 20 lnktarget (conc
5450: 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d lnkpath "/" item
5460: 2d 70 61 74 68 29 29 29 0a 09 20 20 28 64 65 62 -path))).. (deb
5470: 75 67 3a 70 72 69 6e 74 20 32 20 22 53 65 74 74 ug:print 2 "Sett
5480: 69 6e 67 20 75 70 20 73 75 62 20 74 65 73 74 20 ing up sub test
5490: 72 75 6e 20 61 72 65 61 22 29 0a 09 20 20 28 64 run area").. (d
54a0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 20 2d ebug:print 2 " -
54b0: 20 63 72 65 61 74 69 6e 67 20 72 75 6e 20 61 72 creating run ar
54c0: 65 61 20 69 6e 20 22 20 74 65 73 74 2d 70 61 74 ea in " test-pat
54d0: 68 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 h).. (create-di
54e0: 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 74 rectory test-pat
54f0: 68 20 23 74 29 20 3b 3b 20 28 73 79 73 74 65 6d h #t) ;; (system
5500: 20 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d (conc "mkdir -
5510: 70 20 22 20 74 65 73 74 2d 70 61 74 68 29 29 0a p " test-path)).
5520: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
5530: 32 20 0a 09 09 20 20 20 20 20 20 20 22 20 2d 20 2 ... " -
5540: 63 72 65 61 74 69 6e 67 20 6c 69 6e 6b 20 66 72 creating link fr
5550: 6f 6d 3a 20 22 20 74 65 73 74 2d 70 61 74 68 20 om: " test-path
5560: 22 5c 6e 22 0a 09 09 20 20 20 20 20 20 20 22 20 "\n"... "
5570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5580: 20 20 74 6f 3a 20 22 20 6c 6e 6b 74 61 72 67 65 to: " lnktarge
5590: 74 29 0a 09 20 20 3b 3b 20 28 63 72 65 61 74 65 t).. ;; (create
55a0: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b 70 61 -directory lnkpa
55b0: 74 68 20 23 74 29 20 3b 3b 20 28 73 79 73 74 65 th #t) ;; (syste
55c0: 6d 20 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 m (conc "mkdir
55d0: 2d 70 20 22 20 6c 6e 6b 70 61 74 68 29 29 0a 09 -p " lnkpath))..
55e0: 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 (if (not (file
55f0: 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 74 61 72 67 -exists? lnktarg
5600: 65 74 29 29 0a 09 20 20 20 20 20 20 28 63 72 65 et)).. (cre
5610: 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ate-symbolic-lin
5620: 6b 20 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 k test-path lnkt
5630: 61 72 67 65 74 29 29 29 29 0a 0a 20 20 20 20 3b arget)))).. ;
5640: 3b 20 49 20 73 75 73 70 65 63 74 20 74 68 69 73 ; I suspect this
5650: 20 73 65 63 74 69 6f 6e 20 77 61 73 20 64 65 6c section was del
5660: 65 74 69 6e 67 20 74 65 73 74 20 64 69 72 65 63 eting test direc
5670: 74 6f 72 69 65 73 20 75 6e 64 65 72 20 73 6f 6d tories under som
5680: 65 20 0a 20 20 20 20 3b 3b 20 77 69 65 72 64 20 e . ;; wierd
5690: 73 69 74 61 74 69 6f 6e 73 3f 20 54 68 69 73 20 sitations? This
56a0: 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 6e doesn't make sen
56b0: 73 65 20 2d 20 72 65 65 6e 61 62 6c 69 6e 67 20 se - reenabling
56c0: 74 68 65 20 72 6d 20 2d 66 20 0a 20 20 20 20 3b the rm -f . ;
56d0: 3b 20 49 20 68 6f 6e 65 73 74 6c 79 20 64 6f 6e ; I honestly don
56e0: 27 74 20 72 65 6d 65 6d 62 65 72 20 2a 77 68 79 't remember *why
56f0: 2a 20 74 68 69 73 20 63 68 75 6e 6b 20 77 61 73 * this chunk was
5700: 20 6e 65 65 64 65 64 2e 2e 2e 0a 20 20 20 20 3b needed.... ;
5710: 3b 20 28 6c 65 74 20 28 28 74 65 73 74 6c 69 6e ; (let ((testlin
5720: 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 k (conc lnkpath
5730: 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 29 0a "/" testname))).
5740: 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 6e ;; (if (an
5750: 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 d (file-exists?
5760: 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b testlink). ;;
5770: 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 (or
5780: 28 72 65 67 75 6c 61 72 2d 66 69 6c 65 3f 20 74 (regular-file? t
5790: 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 estlink). ;;
57a0: 20 20 20 20 09 20 20 20 28 73 79 6d 62 6f 6c 69 . (symboli
57b0: 63 2d 6c 69 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b c-link? testlink
57c0: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 ))). ;;
57d0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
57e0: 72 6d 20 2d 66 20 22 20 74 65 73 74 6c 69 6e 6b rm -f " testlink
57f0: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 73 79 ))). ;; (sy
5800: 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 stem (conc "ln
5810: 2d 73 66 20 22 20 74 65 73 74 2d 70 61 74 68 20 -sf " test-path
5820: 22 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a " " testlink))).
5830: 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f (if (directo
5840: 72 79 3f 20 74 65 73 74 2d 70 61 74 68 29 0a 09 ry? test-path)..
5850: 28 62 65 67 69 6e 0a 09 20 20 28 6c 65 74 2a 20 (begin.. (let*
5860: 28 28 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 ((cmd (conc "
5870: 72 73 79 6e 63 20 2d 61 76 22 20 28 69 66 20 28 rsync -av" (if (
5880: 3e 20 2a 76 65 72 62 6f 73 69 74 79 2a 20 31 29 > *verbosity* 1)
5890: 20 22 22 20 22 71 22 29 20 22 20 22 20 74 65 73 "" "q") " " tes
58a0: 74 2d 73 72 63 2d 70 61 74 68 20 22 2f 20 22 20 t-src-path "/ "
58b0: 74 65 73 74 2d 70 61 74 68 20 22 2f 22 29 29 0a test-path "/")).
58c0: 09 09 20 28 73 74 61 74 75 73 20 28 73 79 73 74 .. (status (syst
58d0: 65 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 20 28 em cmd))).. (
58e0: 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 if (not (eq? sta
58f0: 74 75 73 20 30 29 29 0a 09 09 28 64 65 62 75 67 tus 0))...(debug
5900: 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 3a :print 2 "ERROR:
5910: 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 problem with ru
5920: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
5930: 22 22 29 29 29 0a 09 20 20 28 6c 69 73 74 20 6c ""))).. (list l
5940: 6e 6b 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 nkpathf lnkpath
5950: 29 29 0a 09 28 6c 69 73 74 20 23 66 20 23 66 29 ))..(list #f #f)
5960: 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 )))..;; 1. look
5970: 74 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 73 though disks lis
5980: 74 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 20 t for disk with
5990: 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e most space.;; 2.
59a0: 20 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 20 create run dir
59b0: 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 on disk, path na
59c0: 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c me is meaningful
59d0: 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c 69 .;; 3. create li
59e0: 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 nk from run dir
59f0: 74 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e 73 to megatest runs
5a00: 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d area .;; 4. rem
5a10: 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 65 otely run the te
5a20: 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 st on allocated
5a30: 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 host.;; - cou
5a40: 6c 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f 73 ld be ssh to hos
5a50: 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 t from hosts tab
5a60: 6c 65 20 28 75 70 64 61 74 65 20 72 65 67 75 6c le (update regul
5a70: 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 0a arly with load).
5a80: 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 ;; - could be
5a90: 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 netbatch.;;
5aa0: 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 (launch-test d
5ab0: 62 20 28 63 61 64 72 20 73 74 61 74 75 73 29 20 b (cadr status)
5ac0: 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 test-conf)).(def
5ad0: 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 ine (launch-test
5ae0: 20 64 62 20 72 75 6e 2d 69 64 20 72 75 6e 6e 61 db run-id runna
5af0: 6d 65 20 74 65 73 74 2d 63 6f 6e 66 20 6b 65 79 me test-conf key
5b00: 76 61 6c 6c 73 74 20 74 65 73 74 2d 6e 61 6d 65 vallst test-name
5b10: 20 74 65 73 74 2d 70 61 74 68 20 69 74 65 6d 64 test-path itemd
5b20: 61 74 20 70 61 72 61 6d 73 29 0a 20 20 28 63 68 at params). (ch
5b30: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a ange-directory *
5b40: 74 6f 70 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 toppath*). (ali
5b50: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 st->env-vars ;;
5b60: 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 73 consolidate this
5b70: 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 63 code with the c
5b80: 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 2e ode in megatest.
5b90: 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 74 scm for "-execut
5ba0: 65 22 0a 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 e". (list ;; (
5bb0: 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 list "MT_TEST_RU
5bc0: 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 N_DIR" work-area
5bd0: 29 0a 09 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 ).. (list "MT_RU
5be0: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f N_AREA_HOME" *to
5bf0: 70 70 61 74 68 2a 29 0a 09 20 28 6c 69 73 74 20 ppath*).. (list
5c00: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
5c10: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 3b 3b 20 28 est-name).. ;; (
5c20: 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e list "MT_ITEM_IN
5c30: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
5c40: 74 29 29 20 0a 09 20 28 6c 69 73 74 20 22 4d 54 t)) .. (list "MT
5c50: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
5c60: 61 6d 65 29 0a 09 20 3b 3b 20 28 6c 69 73 74 20 ame).. ;; (list
5c70: 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d "MT_TARGET" m
5c80: 74 5f 74 61 72 67 65 74 29 0a 09 20 29 29 0a 20 t_target).. )).
5c90: 20 28 6c 65 74 2a 20 28 28 75 73 65 73 68 65 6c (let* ((useshel
5ca0: 6c 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b l (config-look
5cb0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
5cc0: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 jobtools" "u
5cd0: 73 65 73 68 65 6c 6c 22 29 29 0a 09 20 28 6c 61 seshell")).. (la
5ce0: 75 6e 63 68 65 72 20 20 20 28 63 6f 6e 66 69 67 uncher (config
5cf0: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
5d00: 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
5d10: 20 20 20 22 6c 61 75 6e 63 68 65 72 22 29 29 0a "launcher")).
5d20: 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 28 63 . (runscript (c
5d30: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
5d40: 74 2d 63 6f 6e 66 20 20 20 22 73 65 74 75 70 22 t-conf "setup"
5d50: 20 20 20 20 20 20 20 20 22 72 75 6e 73 63 72 69 "runscri
5d60: 70 74 22 29 29 0a 09 20 28 65 7a 73 74 65 70 73 pt")).. (ezsteps
5d70: 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 (> (length (
5d80: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
5d90: 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 efault test-conf
5da0: 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 "ezsteps" '()))
5db0: 20 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 73 65 0)) ;; don't se
5dc0: 6e 64 20 61 6c 6c 20 74 68 65 20 73 74 65 70 73 nd all the steps
5dd0: 2c 20 63 6f 75 6c 64 20 62 65 20 62 69 67 0a 09 , could be big..
5de0: 20 28 64 69 73 6b 73 70 61 63 65 20 20 28 63 6f (diskspace (co
5df0: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 nfig-lookup test
5e00: 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 65 -conf "require
5e10: 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 61 63 ments" "diskspac
5e20: 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 20 20 e")).. (memory
5e30: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
5e40: 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 p test-conf "r
5e50: 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 6d 65 equirements" "me
5e60: 6d 6f 72 79 22 29 29 0a 09 20 28 68 6f 73 74 73 mory")).. (hosts
5e70: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f (config-lo
5e80: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
5e90: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
5ea0: 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a 09 20 "workhosts"))..
5eb0: 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 (remote-megatest
5ec0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
5ed0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
5ee0: 75 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 22 up" "executable"
5ef0: 29 29 0a 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f )).. ;; FIXME SO
5f00: 4d 45 44 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 MEDAY: not good
5f10: 68 6f 77 20 74 68 69 73 20 69 73 20 73 6f 20 6f how this is so o
5f20: 62 74 75 73 65 2c 20 74 68 69 73 20 68 61 63 6b btuse, this hack
5f30: 20 69 73 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 is to .. ;;
5f40: 20 20 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f allo
5f50: 77 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 w running from d
5f60: 61 73 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 ashboard. Extrac
5f70: 74 20 74 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 t the path.. ;;
5f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
5f90: 72 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d rom the called m
5fa0: 65 67 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 egatest and conv
5fb0: 65 72 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 ert dashboard..
5fc0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 09 ;; .
5fd0: 20 20 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 6d or dboard to m
5fe0: 65 67 61 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c egatest.. (local
5ff0: 2d 6d 65 67 61 74 65 73 74 20 20 28 6c 65 74 2a -megatest (let*
6000: 20 28 28 6c 6d 20 20 28 63 61 72 20 28 61 72 67 ((lm (car (arg
6010: 76 29 29 29 0a 09 09 09 09 20 28 64 69 72 20 28 v)))..... (dir (
6020: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
6030: 72 79 20 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 ry lm))..... (ex
6040: 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 e (pathname-stri
6050: 70 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 p-directory lm))
6060: 29 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 20 28 ).... (conc (
6070: 69 66 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 if dir (conc dir
6080: 20 22 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 "/") "").....
6090: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
60a0: 79 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 ymbol exe).....
60b0: 20 20 20 28 28 64 62 6f 61 72 64 29 20 22 6d 65 ((dboard) "me
60c0: 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 gatest").....
60d0: 20 28 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d ((dashboard) "m
60e0: 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 egatest").....
60f0: 20 20 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 (else exe)))))
6100: 0a 09 20 28 74 65 73 74 2d 73 69 67 20 20 20 28 .. (test-sig (
6110: 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 conc test-name "
6120: 3a 22 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 :" (item-list->p
6130: 61 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b ath itemdat))) ;
6140: 3b 20 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 ; test-path is t
6150: 68 65 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 he full path inc
6160: 6c 75 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d luding the item-
6170: 70 61 74 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 path.. (work-are
6180: 61 20 20 23 66 29 0a 09 20 28 74 6f 70 74 65 73 a #f).. (toptes
6190: 74 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 t-work-area #f)
61a0: 3b 3b 20 66 6f 72 20 69 74 65 72 61 74 65 64 20 ;; for iterated
61b0: 74 65 73 74 73 20 74 68 65 20 74 6f 70 20 74 65 tests the top te
61c0: 73 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 st contains data
61d0: 20 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c relevant for al
61e0: 6c 0a 09 20 28 64 69 73 6b 70 61 74 68 20 20 20 l.. (diskpath
61f0: 23 66 29 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 #f).. (cmdparms
6200: 20 20 23 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 #f).. (fullcmd
6210: 20 20 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 #f) ;; (defi
6220: 6e 65 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 ne a (with-outpu
6230: 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d t-to-string (lam
6240: 62 64 61 20 28 29 28 77 72 69 74 65 20 78 29 29 bda ()(write x))
6250: 29 29 0a 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d )).. (mt-bindir-
6260: 70 61 74 68 20 23 66 29 0a 09 20 28 69 74 65 6d path #f).. (item
6270: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
6280: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
6290: 0a 09 20 28 74 65 73 74 2d 69 64 20 20 20 20 28 .. (test-id (
62a0: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 open-run-close d
62b0: 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 64 62 b:get-test-id db
62c0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
62d0: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 e item-path))..
62e0: 28 74 65 73 74 69 6e 66 6f 20 20 20 28 6f 70 65 (testinfo (ope
62f0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 67 n-run-close db:g
6300: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
6310: 69 64 20 64 62 20 74 65 73 74 2d 69 64 29 29 0a id db test-id)).
6320: 09 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 73 . (mt_target (s
6330: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
6340: 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 e (map cadr keyv
6350: 61 6c 6c 73 74 29 20 22 2f 22 29 29 0a 09 20 28 allst) "/")).. (
6360: 64 65 62 75 67 2d 70 61 72 61 6d 20 28 69 66 20 debug-param (if
6370: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
6380: 64 65 62 75 67 22 29 28 6c 69 73 74 20 22 2d 64 debug")(list "-d
6390: 65 62 75 67 22 20 28 61 72 67 73 3a 67 65 74 2d ebug" (args:get-
63a0: 61 72 67 20 22 2d 64 65 62 75 67 22 29 29 20 27 arg "-debug")) '
63b0: 28 29 29 29 29 0a 20 20 20 20 28 69 66 20 68 6f ()))). (if ho
63c0: 73 74 73 20 28 73 65 74 21 20 68 6f 73 74 73 20 sts (set! hosts
63d0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 68 6f (string-split ho
63e0: 73 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 sts))). ;; se
63f0: 74 20 74 68 65 20 6d 65 67 61 74 65 73 74 20 74 t the megatest t
6400: 6f 20 62 65 20 63 61 6c 6c 65 64 20 6f 6e 20 74 o be called on t
6410: 68 65 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 20 he remote host.
6420: 20 20 20 28 69 66 20 28 6e 6f 74 20 72 65 6d 6f (if (not remo
6430: 74 65 2d 6d 65 67 61 74 65 73 74 29 28 73 65 74 te-megatest)(set
6440: 21 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 ! remote-megates
6450: 74 20 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 t local-megatest
6460: 29 29 20 3b 3b 20 22 6d 65 67 61 74 65 73 74 22 )) ;; "megatest"
6470: 29 29 0a 20 20 20 20 28 73 65 74 21 20 6d 74 2d )). (set! mt-
6480: 62 69 6e 64 69 72 2d 70 61 74 68 20 28 70 61 74 bindir-path (pat
6490: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory
64a0: 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 remote-megatest)
64b0: 29 0a 20 20 20 20 28 69 66 20 6c 61 75 6e 63 68 ). (if launch
64c0: 65 72 20 28 73 65 74 21 20 6c 61 75 6e 63 68 65 er (set! launche
64d0: 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 r (string-split
64e0: 6c 61 75 6e 63 68 65 72 29 29 29 0a 20 20 20 20 launcher))).
64f0: 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 72 75 ;; set up the ru
6500: 6e 20 77 6f 72 6b 20 61 72 65 61 20 66 6f 72 20 n work area for
6510: 74 68 69 73 20 74 65 73 74 0a 20 20 20 20 28 73 this test. (s
6520: 65 74 21 20 64 69 73 6b 70 61 74 68 20 28 67 65 et! diskpath (ge
6530: 74 2d 62 65 73 74 2d 64 69 73 6b 20 2a 63 6f 6e t-best-disk *con
6540: 66 69 67 64 61 74 2a 29 29 0a 20 20 20 20 28 69 figdat*)). (i
6550: 66 20 64 69 73 6b 70 61 74 68 0a 09 28 6c 65 74 f diskpath..(let
6560: 20 28 28 64 61 74 20 20 28 6f 70 65 6e 2d 72 75 ((dat (open-ru
6570: 6e 2d 63 6c 6f 73 65 20 63 72 65 61 74 65 2d 77 n-close create-w
6580: 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 6e 2d ork-area db run-
6590: 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d id test-id test-
65a0: 70 61 74 68 20 64 69 73 6b 70 61 74 68 20 74 65 path diskpath te
65b0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 st-name itemdat)
65c0: 29 29 0a 09 20 20 28 73 65 74 21 20 77 6f 72 6b )).. (set! work
65d0: 2d 61 72 65 61 20 28 63 61 72 20 64 61 74 29 29 -area (car dat))
65e0: 0a 09 20 20 28 73 65 74 21 20 74 6f 70 74 65 73 .. (set! toptes
65f0: 74 2d 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 64 t-work-area (cad
6600: 72 20 64 61 74 29 29 0a 09 20 20 28 64 65 62 75 r dat)).. (debu
6610: 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a g:print 2 "INFO:
6620: 20 55 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 61 Using work area
6630: 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 " work-area))..
6640: 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 (begin.. (set!
6650: 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f 6e 63 20 work-area (conc
6660: 74 65 73 74 2d 70 61 74 68 20 22 2f 74 6d 70 5f test-path "/tmp_
6670: 72 75 6e 22 29 29 0a 09 20 20 28 63 72 65 61 74 run")).. (creat
6680: 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
6690: 2d 61 72 65 61 20 23 74 29 0a 09 20 20 28 64 65 -area #t).. (de
66a0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
66b0: 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 77 6f NING: No disk wo
66c0: 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 69 65 rk area specifie
66d0: 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e 20 74 d - running in t
66e0: 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 he test director
66f0: 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 6e 22 y under tmp_run"
6700: 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 63 6d ))). (set! cm
6710: 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 3a 62 dparms (base64:b
6720: 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 28 77 69 ase64-encode (wi
6730: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 th-output-to-str
6740: 69 6e 67 0a 09 09 09 09 09 20 20 20 28 6c 61 6d ing...... (lam
6750: 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 bda () ;; (list
6760: 27 68 6f 73 74 73 20 20 20 20 20 68 6f 73 74 73 'hosts hosts
6770: 29 0a 09 09 09 09 09 20 20 20 20 20 28 77 72 69 )...... (wri
6780: 74 65 20 28 6c 69 73 74 20 28 6c 69 73 74 20 27 te (list (list '
6790: 74 65 73 74 70 61 74 68 20 20 74 65 73 74 2d 70 testpath test-p
67a0: 61 74 68 29 0a 09 09 09 09 09 09 09 20 20 28 6c ath)........ (l
67b0: 69 73 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a ist 'toppath *
67c0: 74 6f 70 70 61 74 68 2a 29 0a 09 09 09 09 09 09 toppath*).......
67d0: 09 20 20 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 . (list 'work-a
67e0: 72 65 61 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 rea work-area)..
67f0: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 74 ...... (list 't
6800: 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 est-name test-na
6810: 6d 65 29 20 0a 09 09 09 09 09 09 09 20 20 28 6c me) ........ (l
6820: 69 73 74 20 27 72 75 6e 73 63 72 69 70 74 20 72 ist 'runscript r
6830: 75 6e 73 63 72 69 70 74 29 20 0a 09 09 09 09 09 unscript) ......
6840: 09 09 20 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 .. (list 'run-i
6850: 64 20 20 20 20 72 75 6e 2d 69 64 20 20 20 29 0a d run-id ).
6860: 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 ....... (list '
6870: 74 65 73 74 2d 69 64 20 20 20 74 65 73 74 2d 69 test-id test-i
6880: 64 20 20 29 0a 09 09 09 09 09 09 09 20 20 28 6c d )........ (l
6890: 69 73 74 20 27 69 74 65 6d 64 61 74 20 20 20 69 ist 'itemdat i
68a0: 74 65 6d 64 61 74 20 20 29 0a 09 09 09 09 09 09 temdat ).......
68b0: 09 20 20 28 6c 69 73 74 20 27 6d 65 67 61 74 65 . (list 'megate
68c0: 73 74 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 st remote-megat
68d0: 65 73 74 29 0a 09 09 09 09 09 09 09 20 20 28 6c est)........ (l
68e0: 69 73 74 20 27 65 7a 73 74 65 70 73 20 20 20 65 ist 'ezsteps e
68f0: 7a 73 74 65 70 73 29 20 0a 09 09 09 09 09 09 09 zsteps) ........
6900: 20 20 28 6c 69 73 74 20 27 74 61 72 67 65 74 20 (list 'target
6910: 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 mt_target)...
6920: 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 65 6e ..... (list 'en
6930: 76 2d 6f 76 72 64 20 20 28 68 61 73 68 2d 74 61 v-ovrd (hash-ta
6940: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
6950: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 *configdat* "env
6960: 2d 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 29 -override" '()))
6970: 20 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 ........ (list
6980: 20 27 73 65 74 2d 76 61 72 73 20 20 28 69 66 20 'set-vars (if
6990: 70 61 72 61 6d 73 20 28 68 61 73 68 2d 74 61 62 params (hash-tab
69a0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 70 le-ref/default p
69b0: 61 72 61 6d 73 20 22 2d 73 65 74 76 61 72 73 22 arams "-setvars"
69c0: 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 20 #f)))........
69d0: 28 6c 69 73 74 20 27 72 75 6e 6e 61 6d 65 20 20 (list 'runname
69e0: 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 09 runname).......
69f0: 09 20 20 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e . (list 'mt-bin
6a00: 64 69 72 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 dir-path mt-bind
6a10: 69 72 2d 70 61 74 68 29 29 29 29 29 29 29 20 3b ir-path))))))) ;
6a20: 3b 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 ; (string-inters
6a30: 70 65 72 73 65 20 6b 65 79 76 61 6c 6c 73 74 20 perse keyvallst
6a40: 22 20 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 " ")))). ;; c
6a50: 6c 65 61 6e 20 6f 75 74 20 73 74 65 70 20 72 65 lean out step re
6a60: 63 6f 72 64 73 20 66 72 6f 6d 20 70 72 65 76 69 cords from previ
6a70: 6f 75 73 20 72 75 6e 20 69 66 20 74 68 65 79 20 ous run if they
6a80: 65 78 69 73 74 0a 20 20 20 20 28 64 65 62 75 67 exist. (debug
6a90: 3a 70 72 69 6e 74 20 34 20 22 49 4e 46 4f 3a 20 :print 4 "INFO:
6aa0: 46 49 58 4d 45 45 45 45 45 21 21 21 21 20 54 68 FIXMEEEEE!!!! Th
6ab0: 69 73 20 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 is can be remove
6ac0: 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 d some day, perh
6ad0: 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 aps move all tes
6ae0: 74 20 72 65 63 6f 72 64 73 20 74 6f 20 74 68 65 t records to the
6af0: 20 74 65 73 74 20 64 62 3f 22 29 0a 20 20 20 20 test db?").
6b00: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
6b10: 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 db:delete-test-s
6b20: 74 65 70 2d 72 65 63 6f 72 64 73 20 64 62 20 74 tep-records db t
6b30: 65 73 74 2d 69 64 29 0a 20 20 20 20 28 63 68 61 est-id). (cha
6b40: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
6b50: 72 6b 2d 61 72 65 61 29 20 3b 3b 20 73 6f 20 74 rk-area) ;; so t
6b60: 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 20 66 72 hat log files fr
6b70: 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 20 70 72 om the launch pr
6b80: 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 6c 75 74 ocess don't clut
6b90: 74 65 72 20 74 68 65 20 74 65 73 74 20 64 69 72 ter the test dir
6ba0: 0a 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 . (open-run-c
6bb0: 6c 6f 73 65 20 74 65 73 74 73 3a 74 65 73 74 2d lose tests:test-
6bc0: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
6bd0: 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 est-id "LAUNCHED
6be0: 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b " "n/a" #f #f) ;
6bf0: 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 ; (if launch-res
6c00: 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 ults launch-resu
6c10: 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 lts "FAILED")).
6c20: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
6c30: 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 and launcher hos
6c40: 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 ts) ;; must be u
6c50: 73 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d sing ssh hostnam
6c60: 65 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 e. (set! fu
6c70: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 llcmd (append la
6c80: 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 uncher (car host
6c90: 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d s)(list remote-m
6ca0: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6cb0: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6cc0: 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
6cd0: 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 m))). ;; (se
6ce0: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
6cf0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 nd launcher (car
6d00: 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d hosts)(list rem
6d10: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 ote-megatest tes
6d20: 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 t-sig "-execute"
6d30: 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 cmdparms)))).
6d40: 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 20 (launcher.
6d50: 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
6d60: 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
6d70: 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d r (list remote-m
6d80: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6d90: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6da0: 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
6db0: 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 m))). ;; (se
6dc0: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
6dd0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 nd launcher (lis
6de0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
6df0: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
6e00: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 cute" cmdparms))
6e10: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
6e20: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 65 (if (not use
6e30: 73 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 shell)(debug:pri
6e40: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 69 nt 0 "WARNING: i
6e50: 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e nternal launchin
6e60: 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 g will not work
6e70: 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 well without \"u
6e80: 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e seshell yes\" in
6e90: 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d your [jobtools]
6ea0: 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 20 section")).
6eb0: 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 (set! fullcmd
6ec0: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 65 (append (list re
6ed0: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
6ee0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
6ef0: 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 " cmdparms) debu
6f00: 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 69 g-param (list (i
6f10: 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 f useshell "&" "
6f20: 22 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 ")))))). ;; (
6f30: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c 69 set! fullcmd (li
6f40: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
6f50: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
6f60: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 20 ecute" cmdparms
6f70: 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 (if useshell "&"
6f80: 20 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 66 ""))))). (if
6f90: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6fa0: 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 75 -xterm")(set! fu
6fb0: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 75 llcmd (append fu
6fc0: 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 74 llcmd (list "-xt
6fd0: 65 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 65 erm")))). (de
6fe0: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 75 bug:print 1 "Lau
6ff0: 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 72 nching " work-ar
7000: 65 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 ea). ;; set p
7010: 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 re-launch-env-va
7020: 72 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 rs before launch
7030: 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 61 ing, keep the va
7040: 72 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 61 rs in prevvals a
7050: 6e 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 6f nd put the envio
7060: 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 nment back when
7070: 64 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 3a done. (debug:
7080: 70 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 print 4 "fullcmd
7090: 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 : " fullcmd).
70a0: 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 (let* ((commonp
70b0: 72 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e revvals (alist->
70c0: 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 env-vars....
70d0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
70e0: 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 default *configd
70f0: 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 at* "env-overrid
7100: 65 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 74 e" '()))).. (t
7110: 65 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 estprevvals (a
7120: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 list->env-vars..
7130: 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
7140: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
7150: 73 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 st-conf "pre-lau
7160: 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 nch-env-override
7170: 73 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 6d s" '()))).. (m
7180: 69 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 iscprevvals (a
7190: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b list->env-vars ;
71a0: 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 ; consolidate th
71b0: 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 is code with the
71c0: 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 code in megates
71d0: 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 t.scm for "-exec
71e0: 75 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 70 ute".... (app
71f0: 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 end (list (list
7200: 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 "MT_TEST_RUN_DIR
7210: 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 " work-area)....
7220: 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 .. (list "MT_TE
7230: 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 ST_NAME" test-na
7240: 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 me)...... (list
7250: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
7260: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 (conc itemdat))
7270: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
7280: 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
7290: 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 name)...... (li
72a0: 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 st "MT_TARGET"
72b0: 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 mt_target)....
72c0: 09 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 74 .. )..... it
72d0: 65 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c 61 emdat))).. (la
72e0: 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 unch-results (ap
72f0: 70 6c 79 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 ply cmd-run-proc
7300: 2d 65 61 63 68 2d 6c 69 6e 65 0a 09 09 09 09 20 -each-line.....
7310: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 (if useshell...
7320: 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d .. (string-
7330: 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c intersperse full
7340: 63 6d 64 20 22 20 22 29 0a 09 09 09 09 20 20 20 cmd " ").....
7350: 20 20 20 28 63 61 72 20 66 75 6c 6c 63 6d 64 29 (car fullcmd)
7360: 29 0a 09 09 09 09 20 20 70 72 69 6e 74 0a 09 09 )..... print...
7370: 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c .. (if useshell
7380: 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 ..... '()..
7390: 09 09 09 20 20 20 20 20 20 28 63 64 72 20 66 75 ... (cdr fu
73a0: 6c 6c 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c llcmd))))) ;; l
73b0: 61 75 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 auncher fullcmd)
73c0: 29 29 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d ));; (apply cmd-
73d0: 72 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 run-proc-each-li
73e0: 6e 65 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e ne launcher prin
73f0: 74 20 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 t fullcmd))) ;;
7400: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 (cmd-run->list f
7410: 75 6c 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 ullcmd)). (
7420: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
7430: 69 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c ile "mt_launch.l
7440: 6f 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a og"..(lambda ().
7450: 09 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 . (apply print
7460: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 launch-results))
7470: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7480: 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e rint 2 "Launchin
7490: 67 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 g completed, upd
74a0: 61 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 ating db").
74b0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
74c0: 22 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a "Launch results:
74d0: 20 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 " launch-result
74e0: 73 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f s). (if (no
74f0: 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 t launch-results
7500: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
7510: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
7520: 46 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 Failed to run "
7530: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7540: 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 rse fullcmd " ")
7550: 20 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 ", exiting now"
7560: 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 ).. ;; (sqlit
7570: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
7580: 0a 09 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c .. ;; good ol
7590: 65 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e e "exit" seems n
75a0: 6f 74 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 ot to work..
75b0: 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 ;; (_exit 9)..
75c0: 20 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 ;; but this ha
75d0: 63 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 ck will work! Th
75e0: 61 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 anks go to Alan
75f0: 50 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 Post of the Chic
7600: 6b 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 ken email list..
7610: 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 ;; NB// Is t
7620: 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 his still needed
7630: 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 ? Should be safe
7640: 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 to go back to "
7650: 65 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 20 exit" now?..
7660: 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 (process-signal
7670: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
7680: 2d 69 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c -id) signal/kill
7690: 29 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 ).. )).
76a0: 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
76b0: 20 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 miscprevvals).
76c0: 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 (alist->env
76d0: 2d 76 61 72 73 20 74 65 73 74 70 72 65 76 76 61 -vars testprevva
76e0: 6c 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 ls). (alist
76f0: 2d 3e 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f ->env-vars commo
7700: 6e 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 nprevvals).
7710: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
7720: 29 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ). (change-dire
7730: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
7740: 29 0a 0a )..