Artifact
15622d4d14c6a87d8704fc6f6586e54323c908be
File
launch.scm
— part of check-in
[598e97c160]
at
2012-03-11 23:01:53
on branch servermode
— Fixed bad params on test status calls
(user:
matt
size: 25436)
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 31 2c 20 4d 61 74 74 68 65 77 06-2011, 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 77 6f 72 6b )).. (work
0770: 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
0780: 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
0790: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
07a0: 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 (test-name (as
07b0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
07c0: 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 t-name cmdinfo))
07d0: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 .. (runscr
07e0: 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ipt (assoc/defau
07f0: 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d lt 'runscript cm
0800: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
0810: 28 65 7a 73 74 65 70 73 20 20 20 28 61 73 73 6f (ezsteps (asso
0820: 63 2f 64 65 66 61 75 6c 74 20 27 65 7a 73 74 65 c/default 'ezste
0830: 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ps cmdinfo))..
0840: 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 74 20 (db-host
0850: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0860: 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d 64 69 'db-host cmdi
0870: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 nfo)).. (r
0880: 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f un-id (assoc/
0890: 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 default 'run-id
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 74 65 73 74 2d 69 64 20 20 20 (test-id
08c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
08d0: 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 test-id cmdinf
08e0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
08f0: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
0900: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
0910: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0920: 20 20 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 (env-ovrd (a
0930: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e ssoc/default 'en
0940: 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 v-ovrd cmdinfo)
0950: 29 0a 09 20 20 20 20 20 20 20 28 73 65 74 2d 76 ).. (set-v
0960: 61 72 73 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ars (assoc/defa
0970: 75 6c 74 20 27 73 65 74 2d 76 61 72 73 20 20 63 ult 'set-vars c
0980: 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d mdinfo)) ;; pre-
0990: 6f 76 65 72 72 69 64 65 73 20 66 72 6f 6d 20 2d overrides from -
09a0: 73 65 74 76 61 72 0a 09 20 20 20 20 20 20 20 28 setvar.. (
09b0: 72 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 runname (assoc
09c0: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d /default 'runnam
09d0: 65 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 e cmdinfo))..
09e0: 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 20 (megatest
09f0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0a00: 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 'megatest cmdin
0a10: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 fo)).. (mt
0a20: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 -bindir-path (as
0a30: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d soc/default 'mt-
0a40: 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 bindir-path cmdi
0a50: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 66 nfo)).. (f
0a60: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 ullrunscript (if
0a70: 20 72 75 6e 73 63 72 69 70 74 20 28 63 6f 6e 63 runscript (conc
0a80: 20 74 65 73 74 70 61 74 68 20 22 2f 22 20 72 75 testpath "/" ru
0a90: 6e 73 63 72 69 70 74 29 20 23 66 29 29 0a 09 20 nscript) #f))..
0aa0: 20 20 20 20 20 20 28 64 62 20 20 20 20 20 20 20 (db
0ab0: 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 72 6f #f).. (ro
0ac0: 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a llup-status 0)).
0ad0: 09 20 20 0a 09 20 20 28 64 65 62 75 67 3a 70 72 . .. (debug:pr
0ae0: 69 6e 74 20 32 20 22 45 78 65 63 74 75 69 6e 67 int 2 "Exectuing
0af0: 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 6f " test-name " o
0b00: 6e 20 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 n " (get-host-na
0b10: 6d 65 29 29 0a 09 20 20 28 63 68 61 6e 67 65 2d me)).. (change-
0b20: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 70 61 directory testpa
0b30: 74 68 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 20 th).. ;; apply
0b40: 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 65 pre-overrides be
0b50: 66 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 61 fore other varia
0b60: 62 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f 76 bles. The pre-ov
0b70: 65 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 74 erride vars must
0b80: 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 62 not.. ;; clobb
0b90: 65 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d 20 ers things from
0ba0: 74 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f 75 the official sou
0bb0: 72 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 67 rces such as meg
0bc0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 atest.config and
0bd0: 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 runconfigs.conf
0be0: 69 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 6e ig.. (if (strin
0bf0: 67 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 20 g? set-vars)..
0c00: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 61 (let ((varpa
0c10: 69 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 irs (string-spli
0c20: 74 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 29 t set-vars ","))
0c30: 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 )...(debug:print
0c40: 20 34 20 22 76 61 72 70 61 69 72 73 3a 20 22 20 4 "varpairs: "
0c50: 76 61 72 70 61 69 72 73 29 0a 09 09 28 6d 61 70 varpairs)...(map
0c60: 20 28 6c 61 6d 62 64 61 20 28 76 61 72 70 61 69 (lambda (varpai
0c70: 72 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 r)... (let
0c80: 20 28 28 76 61 72 76 61 6c 20 28 73 74 72 69 6e ((varval (strin
0c90: 67 2d 73 70 6c 69 74 20 76 61 72 70 61 69 72 20 g-split varpair
0ca0: 22 3d 22 29 29 29 0a 09 09 09 20 28 69 66 20 28 "="))).... (if (
0cb0: 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 61 72 76 eq? (length varv
0cc0: 61 6c 29 20 32 29 0a 09 09 09 20 20 20 20 20 28 al) 2).... (
0cd0: 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 76 let ((var (car v
0ce0: 61 72 76 61 6c 29 29 0a 09 09 09 09 20 20 20 28 arval))..... (
0cf0: 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 6c val (cadr varval
0d00: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 ))).... (d
0d10: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 41 64 ebug:print 1 "Ad
0d20: 64 69 6e 67 20 70 72 65 2d 76 61 72 2f 76 61 6c ding pre-var/val
0d30: 20 22 20 76 61 72 20 22 20 3d 20 22 20 76 61 6c " var " = " val
0d40: 20 22 20 74 6f 20 74 68 65 20 65 6e 76 69 72 6f " to the enviro
0d50: 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 20 20 20 nment")....
0d60: 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 61 (setenv var va
0d70: 6c 29 29 29 29 29 0a 09 09 20 20 20 20 20 76 61 l)))))... va
0d80: 72 70 61 69 72 73 29 29 29 0a 09 20 20 28 73 65 rpairs))).. (se
0d90: 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52 55 tenv "MT_TEST_RU
0da0: 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 N_DIR" work-area
0db0: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
0dc0: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
0dd0: 2d 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e -name).. (seten
0de0: 76 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 v "MT_ITEM_INFO"
0df0: 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 (conc itemdat))
0e00: 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f .. (setenv "MT_
0e10: 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 RUNNAME" runna
0e20: 6d 65 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 me).. (setenv "
0e30: 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 20 6d 65 MT_MEGATEST" me
0e40: 67 61 74 65 73 74 29 0a 09 20 20 28 69 66 20 6d gatest).. (if m
0e50: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 73 t-bindir-path (s
0e60: 65 74 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f etenv "PATH" (co
0e70: 6e 63 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 nc (getenv "PATH
0e80: 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 ") ":" mt-bindir
0e90: 2d 70 61 74 68 29 29 29 0a 09 20 20 0a 09 20 20 -path))).. ..
0ea0: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
0eb0: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
0ec0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
0ed0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
0ee0: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
0ef0: 6e 67 22 29 20 0a 09 09 28 65 78 69 74 20 31 29 ng") ...(exit 1)
0f00: 29 29 0a 09 20 20 3b 3b 20 6e 6f 77 20 63 61 6e )).. ;; now can
0f10: 20 66 69 6e 64 20 6f 75 72 20 64 62 0a 09 20 20 find our db..
0f20: 28 73 65 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 (set! db (open-d
0f30: 62 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 b)).. (if (not
0f40: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
0f50: 73 65 72 76 65 72 22 29 29 0a 09 20 20 20 20 20 server"))..
0f60: 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e 74 2d (server:client-
0f70: 73 65 74 75 70 20 64 62 29 29 0a 09 20 20 28 73 setup db)).. (s
0f80: 65 74 21 20 2a 63 61 63 68 65 2d 6f 6e 2a 20 23 et! *cache-on* #
0f90: 74 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 t).. (set-megat
0fa0: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 64 62 20 est-env-vars db
0fb0: 72 75 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 run-id) ;; these
0fc0: 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 may be needed b
0fd0: 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 y the launching
0fe0: 70 72 6f 63 65 73 73 0a 09 20 20 28 63 68 61 6e process.. (chan
0ff0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 ge-directory wor
1000: 6b 2d 61 72 65 61 29 20 0a 09 20 20 28 73 65 74 k-area) .. (set
1010: 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 -run-config-vars
1020: 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 20 20 3b db run-id).. ;
1030: 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 ; environment ov
1040: 65 72 72 69 64 65 73 20 61 72 65 20 64 6f 6e 65 errides are done
1050: 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 72 65 *before* the re
1060: 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 61 6c maining critical
1070: 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 61 6c 69 envars... (ali
1080: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 st->env-vars env
1090: 2d 6f 76 72 64 29 0a 09 20 20 28 73 65 74 2d 6d -ovrd).. (set-m
10a0: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
10b0: 20 64 62 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 db run-id).. (
10c0: 73 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 set-item-env-var
10d0: 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 73 s itemdat).. (s
10e0: 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d ave-environment-
10f0: 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 65 as-files "megate
1100: 73 74 22 29 0a 09 20 20 28 74 65 73 74 2d 73 65 st").. (test-se
1110: 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 t-meta-info db r
1120: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
1130: 69 74 65 6d 64 61 74 29 0a 09 20 20 28 74 65 73 itemdat).. (tes
1140: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db
1150: 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 test-id "REMOTE
1160: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
1170: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
1180: 2d 6d 22 29 20 23 66 29 0a 09 20 20 28 69 66 20 -m") #f).. (if
1190: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
11a0: 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 28 xterm").. (
11b0: 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 set! fullrunscri
11c0: 70 74 20 22 78 74 65 72 6d 22 29 0a 09 20 20 20 pt "xterm")..
11d0: 20 20 20 28 69 66 20 28 61 6e 64 20 66 75 6c 6c (if (and full
11e0: 72 75 6e 73 63 72 69 70 74 20 28 6e 6f 74 20 28 runscript (not (
11f0: 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 63 file-execute-acc
1200: 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 ess? fullrunscri
1210: 70 74 29 29 29 0a 09 09 20 20 28 73 79 73 74 65 pt)))... (syste
1220: 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 m (conc "chmod u
1230: 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 g+x " fullrunscr
1240: 69 70 74 29 29 29 29 0a 09 20 20 3b 3b 20 57 65 ipt)))).. ;; We
1250: 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 are about to ac
1260: 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 tually kick off
1270: 74 68 65 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 the test.. ;; s
1280: 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 o this is a good
1290: 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 place to remove
12a0: 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 6f 72 the records for
12b0: 20 0a 09 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 .. ;; any prev
12c0: 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 ious runs.. ;;
12d0: 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d (db:test-remove-
12e0: 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 64 20 steps db run-id
12f0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 testname itemdat
1300: 29 0a 09 20 20 0a 09 20 20 3b 3b 20 66 72 6f 6d ).. .. ;; from
1310: 20 68 65 72 65 20 6f 6e 20 6f 75 74 20 77 65 20 here on out we
1320: 77 69 6c 6c 20 6f 70 65 6e 20 61 6e 64 20 63 6c will open and cl
1330: 6f 73 65 20 74 68 65 20 64 62 0a 09 20 20 3b 3b ose the db.. ;;
1340: 20 6f 6e 20 65 76 65 72 79 20 61 63 63 65 73 73 on every access
1350: 20 74 6f 20 72 65 64 75 63 65 20 74 68 65 20 70 to reduce the p
1360: 72 6f 62 61 62 6c 69 74 69 79 20 6f 66 20 0a 09 robablitiy of ..
1370: 20 20 3b 3b 20 63 6f 6e 74 65 6e 74 69 6f 6e 20 ;; contention
1380: 6f 72 20 73 74 75 63 6b 20 61 63 63 65 73 73 20 or stuck access
1390: 6f 6e 20 6e 66 73 2e 0a 09 20 20 28 73 71 6c 69 on nfs... (sqli
13a0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
13b0: 29 0a 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 0a 09 09 09 09 pt)))..... .....
14b0: 20 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 ;; if there is
14c0: 61 20 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 a runscript do i
14d0: 74 20 66 69 72 73 74 0a 09 09 09 09 20 28 69 66 t first..... (if
14e0: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 09 fullrunscript..
14f0: 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 ... (let ((p
1500: 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 id (process-run
1510: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
1520: 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 ..... (let
1530: 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 loop ((i 0))...
1540: 09 09 09 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a ... (let-values.
1550: 09 09 09 09 09 20 20 28 28 28 70 69 64 2d 76 61 ..... (((pid-va
1560: 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 l exit-status ex
1570: 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 it-code) (proces
1580: 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 s-wait pid #t)))
1590: 0a 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d 6c ...... (mutex-l
15a0: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 ock! m)...... (
15b0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
15c0: 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 -info 0 pid)....
15d0: 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 .. (vector-set!
15e0: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
15f0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 t-status)......
1600: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
1610: 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 it-info 2 exit-c
1620: 6f 64 65 29 0a 09 09 09 09 09 20 20 28 73 65 74 ode)...... (set
1630: 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ! rollup-status
1640: 65 78 69 74 2d 63 6f 64 65 29 20 0a 09 09 09 09 exit-code) .....
1650: 09 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b . (mutex-unlock
1660: 21 20 6d 29 0a 09 09 09 09 09 20 20 28 69 66 20 ! m)...... (if
1670: 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a (eq? pid-val 0).
1680: 09 09 09 09 09 20 20 20 20 20 20 28 62 65 67 69 ..... (begi
1690: 6e 0a 09 09 09 09 09 09 28 74 68 72 65 61 64 2d n.......(thread-
16a0: 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 sleep! 2).......
16b0: 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a (loop (+ i 1))).
16c0: 09 09 09 09 09 20 20 20 20 20 20 29 29 29 29 29 ..... )))))
16d0: 0a 09 09 09 09 20 3b 3b 20 74 68 65 6e 2c 20 69 ..... ;; then, i
16e0: 66 20 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 f runscript ran
16f0: 6f 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 ok (or did not g
1700: 65 74 20 63 61 6c 6c 65 64 29 0a 09 09 09 09 20 et called).....
1710: 3b 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a ;; do all the ez
1720: 73 74 65 70 73 20 28 69 66 20 61 6e 79 29 0a 09 steps (if any)..
1730: 09 09 09 20 28 69 66 20 65 7a 73 74 65 70 73 0a ... (if ezsteps.
1740: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
1750: 28 74 65 73 74 63 6f 6e 66 69 67 20 28 72 65 61 (testconfig (rea
1760: 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 d-config (conc w
1770: 6f 72 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 ork-area "/testc
1780: 6f 6e 66 69 67 22 29 20 23 66 20 23 74 20 65 6e onfig") #f #t en
1790: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 viron-patt: "pre
17a0: 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 -launch-env-vars
17b0: 22 29 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 ")) ;; FIXME???
17c0: 69 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 is allow-system
17d0: 6f 6b 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 ok here?......
17e0: 20 20 28 65 7a 73 74 65 70 73 6c 73 74 20 28 68 (ezstepslst (h
17f0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
1800: 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 fault testconfig
1810: 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 "ezsteps" '()))
1820: 0a 09 09 09 09 09 20 20 20 20 28 64 62 20 20 20 ...... (db
1830: 20 20 20 20 20 20 28 6f 70 65 6e 2d 64 62 29 29 (open-db))
1840: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 )..... (if
1850: 20 28 6e 6f 74 20 28 61 72 67 73 3a 67 65 74 2d (not (args:get-
1860: 61 72 67 20 22 2d 73 65 72 76 65 72 22 29 29 0a arg "-server")).
1870: 09 09 09 09 09 20 20 20 28 73 65 72 76 65 72 3a ..... (server:
1880: 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 64 62 29 client-setup db)
1890: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 )..... (if
18a0: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
18b0: 74 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 29 ts? ".ezsteps"))
18c0: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
18d0: 79 20 22 2e 65 7a 73 74 65 70 73 22 29 29 0a 09 y ".ezsteps"))..
18e0: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 ... ;; if
18f0: 65 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 69 ezsteps was defi
1900: 6e 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 ned then we are
1910: 73 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 sure to have at
1920: 6c 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 least one step b
1930: 75 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a ut check anyway.
1940: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
1950: 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 not (> (length e
1960: 7a 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 zstepslst) 0))..
1970: 09 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 .... (debug:pr
1980: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 65 7a int 0 "ERROR: ez
1990: 73 74 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 steps defined bu
19a0: 74 20 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 t ezstepslst is
19b0: 7a 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 09 zero length")...
19c0: 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ... (let loop
19d0: 28 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a ((ezstep (car ez
19e0: 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 stepslst))......
19f0: 09 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 . (tal (
1a00: 63 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 cdr ezstepslst))
1a10: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 70 72 ....... (pr
1a20: 65 76 73 74 65 70 20 23 66 29 29 0a 09 09 09 09 evstep #f)).....
1a30: 09 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 . ;; check e
1a40: 78 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 xit-info (vector
1a50: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 -ref exit-info 1
1a60: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
1a70: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
1a80: 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 09 20 -info 1).......
1a90: 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 (let* ((stepname
1aa0: 20 20 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 (car ezstep))
1ab0: 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 ;; do stuff to
1ac0: 72 75 6e 20 74 68 65 20 73 74 65 70 0a 09 09 09 run the step....
1ad0: 09 09 09 09 28 73 74 65 70 69 6e 66 6f 20 20 28 ....(stepinfo (
1ae0: 63 61 64 72 20 65 7a 73 74 65 70 29 29 0a 09 09 cadr ezstep))...
1af0: 09 09 09 09 09 28 73 74 65 70 70 61 72 74 73 20 .....(stepparts
1b00: 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 (string-match (r
1b10: 65 67 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c egexp "^(\\{([^\
1b20: 5c 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e \}]*)\\}\\s*|)(.
1b30: 2a 29 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 *)$") stepinfo))
1b40: 0a 09 09 09 09 09 09 09 28 73 74 65 70 70 61 72 ........(steppar
1b50: 6d 73 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 ms (list-ref ste
1b60: 70 70 61 72 74 73 20 32 29 29 20 3b 3b 20 66 6f pparts 2)) ;; fo
1b70: 72 20 66 75 74 75 72 65 20 75 73 65 2c 20 7b 56 r future use, {V
1b80: 41 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 AR=1,2,3}, run s
1b90: 74 65 70 20 66 6f 72 20 65 61 63 68 20 0a 09 09 tep for each ...
1ba0: 09 09 09 09 09 28 73 74 65 70 63 6d 64 20 20 20 .....(stepcmd
1bb0: 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 (list-ref steppa
1bc0: 72 74 73 20 33 29 29 0a 09 09 09 09 09 09 09 28 rts 3))........(
1bd0: 73 63 72 69 70 74 20 20 20 20 22 22 29 20 3b 20 script "") ;
1be0: 22 23 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 "#!/bin/bash\n")
1bf0: 20 3b 3b 20 79 65 70 2c 20 77 65 20 64 65 70 65 ;; yep, we depe
1c00: 6e 64 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 nd on bin/bash F
1c10: 49 58 4d 45 21 21 21 0a 09 09 09 09 09 09 09 28 IXME!!!........(
1c20: 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 66 29 29 logpro-used #f))
1c30: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 4e 42 2f ....... ;; NB/
1c40: 2f 20 63 61 6e 20 73 61 66 65 6c 79 20 61 73 73 / can safely ass
1c50: 75 6d 65 20 77 65 20 61 72 65 20 69 6e 20 74 65 ume we are in te
1c60: 73 74 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 st-area director
1c70: 79 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 75 y....... (debu
1c80: 67 3a 70 72 69 6e 74 20 34 20 22 65 7a 73 74 65 g:print 4 "ezste
1c90: 70 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a 20 ps:\n stepname:
1ca0: 22 20 73 74 65 70 6e 61 6d 65 20 22 20 73 74 65 " stepname " ste
1cb0: 70 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e 66 pinfo: " stepinf
1cc0: 6f 20 22 20 73 74 65 70 70 61 72 74 73 3a 20 22 o " stepparts: "
1cd0: 20 73 74 65 70 70 61 72 74 73 0a 09 09 09 09 09 stepparts......
1ce0: 09 09 09 22 20 73 74 65 70 70 61 72 6d 73 3a 20 ..." stepparms:
1cf0: 22 20 73 74 65 70 70 61 72 6d 73 20 22 20 73 74 " stepparms " st
1d00: 65 70 63 6d 64 3a 20 22 20 73 74 65 70 63 6d 64 epcmd: " stepcmd
1d10: 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 )....... .....
1d20: 09 09 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 .. (if (file-e
1d30: 78 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 65 xists? (conc ste
1d40: 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 pname ".logpro")
1d50: 29 28 73 65 74 21 20 6c 6f 67 70 72 6f 2d 75 73 )(set! logpro-us
1d60: 65 64 20 23 74 29 29 0a 0a 09 09 09 09 09 09 20 ed #t))........
1d70: 20 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 6f ;; ;; first so
1d80: 75 72 63 65 20 74 68 65 20 70 72 65 76 69 6f 75 urce the previou
1d90: 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 s environment...
1da0: 09 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 20 28 .... ;; (let (
1db0: 28 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 20 (prev-env (conc
1dc0: 22 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 65 76 ".ezsteps/" prev
1dd0: 73 74 65 70 20 28 69 66 20 28 73 74 72 69 6e 67 step (if (string
1de0: 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 70 20 -search (regexp
1df0: 22 63 73 68 22 29 20 0a 09 09 09 09 09 09 20 20 "csh") .......
1e00: 20 3b 3b 20 20 20 20 20 20 09 09 09 09 09 09 09 ;; .......
1e10: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
1e20: 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c t-variable "SHEL
1e30: 4c 22 29 29 20 22 2e 63 73 68 22 20 22 2e 73 68 L")) ".csh" ".sh
1e40: 22 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b "))))....... ;
1e50: 3b 20 20 20 28 69 66 20 28 61 6e 64 20 70 72 65 ; (if (and pre
1e60: 76 73 74 65 70 20 28 66 69 6c 65 2d 65 78 69 73 vstep (file-exis
1e70: 74 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a 09 ts? prev-env))..
1e80: 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 ..... ;;
1e90: 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 (set! script (c
1ea0: 6f 6e 63 20 73 63 72 69 70 74 20 22 73 6f 75 72 onc script "sour
1eb0: 63 65 20 22 20 70 72 65 76 2d 65 6e 76 29 29 29 ce " prev-env)))
1ec0: 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 )....... .....
1ed0: 09 09 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 .. ;; call the
1ee0: 20 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d command using m
1ef0: 74 5f 65 7a 73 74 65 70 0a 09 09 09 09 09 09 20 t_ezstep.......
1f00: 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 (set! script (
1f10: 63 6f 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 20 conc "mt_ezstep
1f20: 22 20 73 74 65 70 6e 61 6d 65 20 22 20 22 20 28 " stepname " " (
1f30: 69 66 20 70 72 65 76 73 74 65 70 20 70 72 65 76 if prevstep prev
1f40: 73 74 65 70 20 22 2d 22 29 20 22 20 22 20 73 74 step "-") " " st
1f50: 65 70 63 6d 64 29 29 0a 0a 09 09 09 09 09 09 20 epcmd))........
1f60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
1f70: 20 22 73 63 72 69 70 74 3a 20 22 20 73 63 72 69 "script: " scri
1f80: 70 74 29 0a 0a 09 09 09 09 09 09 20 20 20 28 72 pt)........ (r
1f90: 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d db:teststep-set-
1fa0: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
1fb0: 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 id stepname "sta
1fc0: 72 74 22 20 22 2d 22 20 69 74 65 6d 64 61 74 20 rt" "-" itemdat
1fd0: 23 66 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 #f #f).......
1fe0: 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 0a 09 09 ;; now launch...
1ff0: 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 .... (let ((pi
2000: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 73 d (process-run s
2010: 63 72 69 70 74 29 29 29 0a 09 09 09 09 09 09 20 cript))).......
2020: 20 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 (let process
2030: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
2040: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
2050: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
2060: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
2070: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
2080: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
2090: 09 09 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 ....... (mutex
20a0: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 -lock! m).......
20b0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
20c0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
20d0: 64 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 d)......... (v
20e0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
20f0: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
2100: 75 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 us)......... (
2110: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
2120: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
2130: 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d e)......... (m
2140: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
2150: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ........ (if (
2160: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
2170: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 62 ....... (b
2180: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 28 egin.......... (
2190: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 thread-sleep! 2)
21a0: 0a 09 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 .......... (proc
21b0: 65 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 essloop (+ i 1))
21c0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 29 29 ))......... ))
21d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2200: 20 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 69 (let ((exi
2210: 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nfo (vector-ref
2220: 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 20 20 exit-info 2)).
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 20
2250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2260: 20 20 20 20 20 20 20 20 20 28 6c 6f 67 66 6e 61 (logfna
2270: 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 (if logpro-used
2280: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
2290: 22 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 0a 20 ".html") ""))).
22a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 20 20 20 20 20 3b 3b 20 74 65 73 74 69 6e ;; testin
22e0: 67 20 69 66 20 70 72 6f 63 65 64 75 72 65 73 20 g if procedures
22f0: 63 61 6c 6c 65 64 20 69 6e 20 61 20 72 65 6d 6f called in a remo
2300: 74 65 20 63 61 6c 6c 20 63 61 75 73 65 20 70 72 te call cause pr
2310: 6f 62 6c 65 6d 73 20 28 61 6e 73 3a 20 6e 6f 20 oblems (ans: no
2320: 6f 72 20 73 6f 20 49 20 73 75 73 70 65 63 74 29 or so I suspect)
2330: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 20 28 ....... (
2340: 72 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rdb:teststep-set
2350: 2d 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 -status! db test
2360: 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e -id stepname "en
2370: 64 22 20 65 78 69 6e 66 6f 20 69 74 65 6d 64 61 d" exinfo itemda
2380: 74 20 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 09 t #f logfna))...
2390: 09 09 09 09 20 20 20 20 20 28 69 66 20 6c 6f 67 .... (if log
23a0: 70 72 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 09 pro-used........
23b0: 20 28 72 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c (rdb:test-set-l
23c0: 6f 67 21 20 64 62 20 74 65 73 74 2d 69 64 20 28 og! db test-id (
23d0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
23e0: 68 74 6d 6c 22 29 29 29 0a 09 09 09 09 09 09 20 html"))).......
23f0: 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 74 ;; set the t
2400: 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 73 est final status
2410: 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 ....... (let
2420: 2a 20 28 28 74 68 69 73 2d 73 74 65 70 2d 73 74 * ((this-step-st
2430: 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 09 atus (cond......
2440: 09 09 09 09 20 20 20 20 20 20 20 28 28 61 6e 64 .... ((and
2450: 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 (eq? (vector-re
2460: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 32 f exit-info 2) 2
2470: 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 ) logpro-used) '
2480: 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 warn)..........
2490: 20 20 20 20 20 20 28 28 65 71 3f 20 28 76 65 63 ((eq? (vec
24a0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
24b0: 6f 20 32 29 20 30 29 20 20 20 20 20 20 20 20 20 o 2) 0)
24c0: 20 20 20 20 20 20 20 20 20 20 27 70 61 73 73 29 'pass)
24d0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
24e0: 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a (else 'fail))).
24f0: 09 09 09 09 09 09 09 20 20 20 20 28 6f 76 65 72 ....... (over
2500: 61 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f all-status (co
2510: 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 nd..........
2520: 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d ((eq? rollup-
2530: 73 74 61 74 75 73 20 32 29 20 27 77 61 72 6e 29 status 2) 'warn)
2540: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2550: 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 ((eq? rollup-st
2560: 61 74 75 73 20 30 29 20 27 70 61 73 73 29 0a 09 atus 0) 'pass)..
2570: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2580: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 else 'fail)))...
2590: 09 09 09 09 09 20 20 20 20 28 6e 65 78 74 2d 73 ..... (next-s
25a0: 74 61 74 75 73 20 20 20 20 20 20 28 63 6f 6e 64 tatus (cond
25b0: 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ..........
25c0: 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d ((eq? overall-
25d0: 73 74 61 74 75 73 20 27 70 61 73 73 29 20 74 68 status 'pass) th
25e0: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 29 0a is-step-status).
25f0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2600: 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 ((eq? overall-st
2610: 61 74 75 73 20 27 77 61 72 6e 29 0a 09 09 09 09 atus 'warn).....
2620: 09 09 09 09 09 09 28 69 66 20 28 65 71 3f 20 74 ......(if (eq? t
2630: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
2640: 27 66 61 69 6c 29 20 27 66 61 69 6c 20 27 77 61 'fail) 'fail 'wa
2650: 72 6e 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 rn))..........
2660: 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c (else 'fail
2670: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 )))).......
2680: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 (debug:print 4
2690: 20 22 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 "Exit value rec
26a0: 65 69 76 65 64 3a 20 22 20 28 76 65 63 74 6f 72 eived: " (vector
26b0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
26c0: 29 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 3a ) " logpro-used:
26d0: 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 0a " logpro-used .
26e0: 09 09 09 09 09 09 09 09 20 20 20 20 22 20 74 68 ........ " th
26f0: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 3a 20 is-step-status:
2700: 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 " this-step-stat
2710: 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 us " overall-sta
2720: 74 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c 2d 73 tus: " overall-s
2730: 74 61 74 75 73 20 0a 09 09 09 09 09 09 09 09 20 tatus .........
2740: 20 20 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 " next-status
2750: 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 20 : " next-status
2760: 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a " rollup-status:
2770: 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 " rollup-status
2780: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
2790: 63 61 73 65 20 6e 65 78 74 2d 73 74 61 74 75 73 case next-status
27a0: 0a 09 09 09 09 09 09 09 20 28 28 77 61 72 6e 29 ........ ((warn)
27b0: 0a 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 ........ (set!
27c0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 29 rollup-status 2)
27d0: 0a 09 09 09 09 09 09 09 20 20 3b 3b 20 4e 42 2f ........ ;; NB/
27e0: 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 / test-set-statu
27f0: 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c s! does rdb call
2800: 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 s under the hood
2810: 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 74 2d ........ (test-
2820: 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 20 74 set-status! db t
2830: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2840: 20 22 57 41 52 4e 22 20 0a 09 09 09 09 09 09 09 "WARN" ........
2850: 09 09 20 20 20 20 28 69 66 20 28 65 71 3f 20 74 .. (if (eq? t
2860: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
2870: 27 77 61 72 6e 29 20 22 4c 6f 67 70 72 6f 20 77 'warn) "Logpro w
2880: 61 72 6e 69 6e 67 20 66 6f 75 6e 64 22 20 23 66 arning found" #f
2890: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 23 ).......... #
28a0: 66 29 29 0a 09 09 09 09 09 09 09 20 28 28 70 61 f))........ ((pa
28b0: 73 73 29 0a 09 09 09 09 09 09 09 20 20 28 74 65 ss)........ (te
28c0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
28d0: 62 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 b test-id "RUNNI
28e0: 4e 47 22 20 22 50 41 53 53 22 20 23 66 20 23 66 NG" "PASS" #f #f
28f0: 29 29 0a 09 09 09 09 09 09 09 20 28 65 6c 73 65 ))........ (else
2900: 20 3b 3b 20 27 66 61 69 6c 0a 09 09 09 09 09 09 ;; 'fail.......
2910: 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d . (set! rollup-
2920: 73 74 61 74 75 73 20 31 29 20 3b 3b 20 66 6f 72 status 1) ;; for
2930: 63 65 20 66 61 69 6c 0a 09 09 09 09 09 09 09 20 ce fail........
2940: 20 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 (test-set-statu
2950: 73 21 20 64 62 20 74 65 73 74 2d 69 64 20 22 52 s! db test-id "R
2960: 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 28 UNNING" "FAIL" (
2970: 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 conc "Failed at
2980: 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 step " stepname)
2990: 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 29 #f)........ ))
29a0: 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 ))....... (if
29b0: 28 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 6f (and (steprun-go
29c0: 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 od? logpro-used
29d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
29e0: 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 09 -info 2)).......
29f0: 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f . (not (null?
2a00: 20 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 tal))).......
2a10: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
2a20: 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 tal) (cdr tal) s
2a30: 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 tepname)))......
2a40: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
2a50: 74 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 t 4 "WARNING: a
2a60: 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c 65 prior step faile
2a70: 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 22 d, stopping at "
2a80: 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 0a ezstep)))))))).
2a90: 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 .. (monitorjob
2aa0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
2ab0: 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 73 (let* ((start-s
2ac0: 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 2d econds (current-
2ad0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 seconds))......(
2ae0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c calc-minutes (l
2af0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 ambda ()........
2b00: 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 (inexact->exact
2b10: 20 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 6e ........ (roun
2b20: 64 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d 20 d ........ (-
2b30: 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 75 72 ........ (cur
2b40: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 rent-seconds) ..
2b50: 09 09 09 09 09 09 20 20 20 20 73 74 61 72 74 2d ...... start-
2b60: 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 seconds)))))....
2b70: 09 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 ..(kill-tries 0)
2b80: 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 6c 6f )..... (let lo
2b90: 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28 op ((minutes (
2ba0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a calc-minutes))).
2bb0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
2bc0: 28 64 62 20 20 20 20 20 20 20 28 6f 70 65 6e 2d (db (open-
2bd0: 64 62 29 29 0a 09 09 09 09 09 20 20 20 20 28 63 db))...... (c
2be0: 70 75 6c 6f 61 64 20 20 28 67 65 74 2d 63 70 75 puload (get-cpu
2bf0: 2d 6c 6f 61 64 29 29 0a 09 09 09 09 09 20 20 20 -load))......
2c00: 20 28 64 69 73 6b 66 72 65 65 20 28 67 65 74 2d (diskfree (get-
2c10: 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 df (current-dire
2c20: 63 74 6f 72 79 29 29 29 0a 09 09 09 09 09 20 20 ctory)))......
2c30: 20 20 28 74 6d 70 66 72 65 65 20 20 28 67 65 74 (tmpfree (get
2c40: 2d 64 66 20 22 2f 74 6d 70 22 29 29 29 0a 09 09 -df "/tmp")))...
2c50: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
2c60: 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 t (args:get-arg
2c70: 22 2d 73 65 72 76 65 72 22 29 29 0a 09 09 09 09 "-server")).....
2c80: 09 20 20 20 28 73 65 72 76 65 72 3a 63 6c 69 65 . (server:clie
2c90: 6e 74 2d 73 65 74 75 70 20 64 62 29 29 0a 09 09 nt-setup db))...
2ca0: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
2cb0: 74 20 63 70 75 6c 6f 61 64 29 20 20 28 62 65 67 t cpuload) (beg
2cc0: 69 6e 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 in (debug:print
2cd0: 30 20 22 57 41 52 4e 49 4e 47 3a 20 43 50 55 4c 0 "WARNING: CPUL
2ce0: 4f 41 44 20 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 OAD not found.")
2cf0: 20 20 28 73 65 74 21 20 63 70 75 6c 6f 61 64 20 (set! cpuload
2d00: 22 6e 2f 61 22 29 29 29 0a 09 09 09 09 20 20 20 "n/a"))).....
2d10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 64 69 73 (if (not dis
2d20: 6b 66 72 65 65 29 20 28 62 65 67 69 6e 20 28 64 kfree) (begin (d
2d30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
2d40: 52 4e 49 4e 47 3a 20 44 49 53 4b 46 52 45 45 20 RNING: DISKFREE
2d50: 6e 6f 74 20 66 6f 75 6e 64 2e 22 29 20 28 73 65 not found.") (se
2d60: 74 21 20 64 69 73 6b 66 72 65 65 20 22 6e 2f 61 t! diskfree "n/a
2d70: 22 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 "))).....
2d80: 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 (set! kill-job?
2d90: 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 (test-get-kill-r
2da0: 65 71 75 65 73 74 20 64 62 20 72 75 6e 2d 69 64 equest db run-id
2db0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 test-name itemd
2dc0: 61 74 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 at)).....
2dd0: 28 72 64 62 3a 74 65 73 74 2d 75 70 64 61 74 65 (rdb:test-update
2de0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 64 62 20 72 75 -meta-info db ru
2df0: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
2e00: 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 73 20 63 temdat minutes c
2e10: 70 75 6c 6f 61 64 20 64 69 73 6b 66 72 65 65 20 puload diskfree
2e20: 74 6d 70 66 72 65 65 29 0a 09 09 09 09 20 20 20 tmpfree).....
2e30: 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 (if kill-job
2e40: 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 67 69 ? ...... (begi
2e50: 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 74 n...... (mut
2e60: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 ex-lock! m).....
2e70: 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 69 . (let* ((pi
2e80: 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 d (vector-ref ex
2e90: 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a 09 09 09 it-info 0)))....
2ea0: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 .. (if (nu
2eb0: 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 09 09 09 mber? pid)......
2ec0: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
2ed0: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
2ee0: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 nt 0 "WARNING: R
2ef0: 65 71 75 65 73 74 20 72 65 63 65 69 76 65 64 20 equest received
2f00: 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 61 74 74 to kill job (att
2f10: 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d 74 72 empt # " kill-tr
2f20: 69 65 73 20 22 29 22 29 0a 09 09 09 09 09 09 20 ies ")").......
2f30: 20 20 20 20 28 6c 65 74 20 28 28 70 72 6f 63 65 (let ((proce
2f40: 73 73 65 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c sses (cmd-run->l
2f50: 69 73 74 20 28 63 6f 6e 63 20 22 70 67 72 65 70 ist (conc "pgrep
2f60: 20 2d 6c 20 2d 50 20 22 20 70 69 64 29 29 29 29 -l -P " pid))))
2f70: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 66 ....... (f
2f80: 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09 09 09 or-each ........
2f90: 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 09 09 (lambda (p).....
2fa0: 09 09 09 20 20 28 6c 65 74 2a 20 28 28 70 61 72 ... (let* ((par
2fb0: 74 73 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 ts (string-spli
2fc0: 74 20 70 29 29 0a 09 09 09 09 09 09 09 09 20 28 t p))......... (
2fd0: 70 2d 69 64 20 20 20 28 69 66 20 28 3e 20 28 6c p-id (if (> (l
2fe0: 65 6e 67 74 68 20 70 61 72 74 73 29 20 30 29 0a ength parts) 0).
2ff0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 28 73 ......... (s
3000: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
3010: 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 09 09 ar parts))......
3020: 09 09 09 09 20 20 20 20 20 23 66 29 29 29 0a 09 .... #f)))..
3030: 09 09 09 09 09 09 20 20 20 20 28 69 66 20 70 2d ...... (if p-
3040: 69 64 0a 09 09 09 09 09 09 09 09 28 62 65 67 69 id.........(begi
3050: 6e 0a 09 09 09 09 09 09 09 09 20 20 28 64 65 62 n......... (deb
3060: 75 67 3a 70 72 69 6e 74 20 30 20 22 4b 69 6c 6c ug:print 0 "Kill
3070: 69 6e 67 20 22 20 28 63 61 64 72 20 70 61 72 74 ing " (cadr part
3080: 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20 20 22 s) "; kill -9 "
3090: 20 70 2d 69 64 29 0a 09 09 09 09 09 09 09 09 20 p-id).........
30a0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
30b0: 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 29 29 kill -9 " p-id))
30c0: 29 29 29 29 0a 09 09 09 09 09 09 09 28 63 61 72 ))))........(car
30d0: 20 70 72 6f 63 65 73 73 65 73 29 29 0a 09 09 09 processes))....
30e0: 09 09 09 20 20 20 20 20 20 20 28 73 79 73 74 65 ... (syste
30f0: 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 m (conc "kill -9
3100: 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 " pid))))......
3110: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
3120: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
3130: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 nt 0 "WARNING: R
3140: 65 71 75 65 73 74 20 72 65 63 65 69 76 65 64 20 equest received
3150: 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 75 74 20 to kill job but
3160: 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 70 72 6f problem with pro
3170: 63 65 73 73 2c 20 61 74 74 65 6d 70 74 69 6e 67 cess, attempting
3180: 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 67 65 72 to kill manager
3190: 20 70 72 6f 63 65 73 73 22 29 0a 09 09 09 09 09 process")......
31a0: 09 20 20 20 20 20 28 74 65 73 74 2d 73 65 74 2d . (test-set-
31b0: 73 74 61 74 75 73 21 20 64 62 20 74 65 73 74 2d status! db test-
31c0: 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 id "KILLED" "FA
31d0: 49 4c 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 IL".........
31e0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
31f0: 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 09 "-m") #f)......
3200: 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 . (sqlite3:f
3210: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 inalize! db)....
3220: 09 09 09 20 20 20 20 20 28 65 78 69 74 20 31 29 ... (exit 1)
3230: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 73 )))...... (s
3240: 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 et! kill-tries (
3250: 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 + 1 kill-tries))
3260: 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 74 65 ...... (mute
3270: 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 x-unlock! m)))..
3280: 09 09 09 20 20 20 20 20 20 20 28 73 71 6c 69 74 ... (sqlit
3290: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
32a0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 68 72 ..... (thr
32b0: 65 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 30 ead-sleep! (+ 10
32c0: 20 28 72 61 6e 64 6f 6d 20 31 30 29 29 29 20 3b (random 10))) ;
32d0: 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 ; add some jitte
32e0: 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f r to the call ho
32f0: 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 65 61 me time to sprea
3300: 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 63 63 d out the db acc
3310: 65 73 73 65 73 0a 09 09 09 09 20 20 20 20 20 20 esses.....
3320: 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e (loop (calc-min
3330: 75 74 65 73 29 29 29 29 29 29 29 0a 09 09 20 28 utes)))))))... (
3340: 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 th1 (ma
3350: 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f ke-thread monito
3360: 72 6a 6f 62 29 29 0a 09 09 20 28 74 68 32 20 20 rjob))... (th2
3370: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 (make-th
3380: 72 65 61 64 20 72 75 6e 69 74 29 29 29 0a 09 20 read runit)))..
3390: 20 20 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 (set! job-thr
33a0: 65 61 64 20 74 68 32 29 0a 09 20 20 20 20 28 74 ead th2).. (t
33b0: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 hread-start! th1
33c0: 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 ).. (thread-s
33d0: 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 tart! th2)..
33e0: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
33f0: 32 29 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 2).. (mutex-l
3400: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 28 73 65 ock! m).. (se
3410: 74 21 20 64 62 20 28 6f 70 65 6e 2d 64 62 29 29 t! db (open-db))
3420: 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
3430: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 73 args:get-arg "-s
3440: 65 72 76 65 72 22 29 29 0a 09 09 28 73 65 72 76 erver"))...(serv
3450: 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 20 er:client-setup
3460: 64 62 29 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 db)).. (let*
3470: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 ((item-path (ite
3480: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
3490: 6d 64 61 74 29 29 0a 09 09 20 20 20 28 74 65 73 mdat))... (tes
34a0: 74 69 6e 66 6f 20 20 28 72 64 62 3a 67 65 74 2d tinfo (rdb:get-
34b0: 74 65 73 74 2d 69 6e 66 6f 20 64 62 20 72 75 6e test-info db run
34c0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
34d0: 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 em-path)))..
34e0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
34f0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3500: 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 state testinfo)
3510: 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 "COMPLETED"))...
3520: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
3530: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 54 debug:print 2 "T
3540: 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 est NOT logged a
3550: 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 s COMPLETED, (st
3560: 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 ate=" (db:test-g
3570: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
3580: 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 o) "), updating
3590: 72 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 result, rollup-s
35a0: 74 61 74 75 73 20 69 73 20 22 20 72 6f 6c 6c 75 tatus is " rollu
35b0: 70 2d 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 p-status)...
35c0: 28 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 (test-set-status
35d0: 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 ! db run-id test
35e0: 2d 6e 61 6d 65 0a 09 09 09 09 20 20 20 20 20 20 -name.....
35f0: 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b (if kill-job? "K
3600: 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 ILLED" "COMPLETE
3610: 44 22 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b D")..... ;;
3620: 20 4f 6c 64 20 6c 6f 67 69 63 3a 0a 09 09 09 09 Old logic:.....
3630: 20 20 20 20 20 20 3b 3b 20 28 69 66 20 28 76 65 ;; (if (ve
3640: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3650: 66 6f 20 31 29 20 3b 3b 20 6c 6f 6f 6b 20 61 74 fo 1) ;; look at
3660: 20 74 68 65 20 65 78 69 74 2d 73 74 61 74 75 73 the exit-status
3670: 2c 20 23 74 20 6d 65 61 6e 73 20 69 74 20 61 74 , #t means it at
3680: 20 6c 65 61 73 74 20 72 61 6e 0a 09 09 09 09 20 least ran.....
3690: 20 20 20 20 20 3b 3b 20 20 20 20 20 28 69 66 20 ;; (if
36a0: 28 61 6e 64 20 28 6e 6f 74 20 6b 69 6c 6c 2d 6a (and (not kill-j
36b0: 6f 62 3f 29 20 0a 09 09 09 09 20 20 20 20 20 20 ob?) .....
36c0: 3b 3b 20 20 20 20 20 20 20 20 20 28 65 71 3f 20 ;; (eq?
36d0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
36e0: 2d 69 6e 66 6f 20 32 29 20 30 29 29 20 3b 3b 20 -info 2) 0)) ;;
36f0: 77 65 20 63 61 6e 20 6e 6f 77 20 75 73 65 20 72 we can now use r
3700: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 69 6e 73 ollup-status ins
3710: 74 65 61 64 0a 09 09 09 09 20 20 20 20 20 20 3b tead..... ;
3720: 3b 20 20 20 20 20 20 20 20 20 22 50 41 53 53 22 ; "PASS"
3730: 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 20 20 ..... ;;
3740: 20 20 20 20 20 20 22 46 41 49 4c 22 29 0a 09 09 "FAIL")...
3750: 09 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 22 .. ;; "
3760: 46 41 49 4c 22 29 20 0a 09 09 09 09 20 20 20 20 FAIL") .....
3770: 20 20 3b 3b 20 4e 65 77 20 6c 6f 67 69 63 20 62 ;; New logic b
3780: 61 73 65 64 20 6f 6e 20 72 6f 6c 6c 75 70 2d 73 ased on rollup-s
3790: 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 20 20 tatus.....
37a0: 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 20 20 (cond.....
37b0: 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 ((not (vector-r
37c0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 ef exit-info 1))
37d0: 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 20 "FAIL") ;; job
37e0: 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 0a 09 09 failed to run...
37f0: 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 .. ((eq? r
3800: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 0a ollup-status 0).
3810: 09 09 09 09 09 3b 3b 20 69 66 20 74 68 65 20 63 .....;; if the c
3820: 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 urrent status is
3830: 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 AUTO the defer
3840: 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 to the calculate
3850: 64 20 76 61 6c 75 65 20 28 69 2e 65 2e 20 6c 65 d value (i.e. le
3860: 61 76 65 20 74 68 69 73 20 41 55 54 4f 29 0a 09 ave this AUTO)..
3870: 09 09 09 09 28 69 66 20 28 65 71 75 61 6c 3f 20 ....(if (equal?
3880: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
3890: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 tus testinfo) "A
38a0: 55 54 4f 22 29 20 22 41 55 54 4f 22 20 22 50 41 UTO") "AUTO" "PA
38b0: 53 53 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 SS")).....
38c0: 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 ((eq? rollup-st
38d0: 61 74 75 73 20 31 29 20 22 46 41 49 4c 22 29 0a atus 1) "FAIL").
38e0: 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f .... ((eq?
38f0: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 rollup-status 2
3900: 29 0a 09 09 09 09 09 3b 3b 20 69 66 20 74 68 65 )......;; if the
3910: 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 current status
3920: 69 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 is AUTO the defe
3930: 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 r to the calcula
3940: 74 65 64 20 76 61 6c 75 65 20 62 75 74 20 71 75 ted value but qu
3950: 61 6c 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 alify (i.e. make
3960: 20 74 68 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 this AUTO-WARN)
3970: 0a 09 09 09 09 09 28 69 66 20 28 65 71 75 61 6c ......(if (equal
3980: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
3990: 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 tatus testinfo)
39a0: 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 41 "AUTO") "AUTO-WA
39b0: 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 09 09 RN" "WARN"))....
39c0: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 22 46 . (else "F
39d0: 41 49 4c 22 29 29 0a 09 09 09 09 20 20 20 20 20 AIL")).....
39e0: 20 69 74 65 6d 64 61 74 20 28 61 72 67 73 3a 67 itemdat (args:g
39f0: 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 et-arg "-m") #f)
3a00: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 )).. ;; for
3a10: 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 automated creat
3a20: 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 ion of the rollu
3a30: 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 p html file this
3a40: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
3a50: 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
3a60: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d not (equal? item
3a70: 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 -path ""))... (
3a80: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
3a90: 69 74 65 6d 73 20 64 62 20 72 75 6e 2d 69 64 20 items db run-id
3aa0: 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 3b test-name #f)) ;
3ab0: 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 ; don't force -
3ac0: 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e just update if n
3ad0: 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 o.. )..
3ae0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
3af0: 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 65 63 2d ).. ;; (exec-
3b00: 72 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e results (cmd-run
3b10: 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 ->list fullrunsc
3b20: 72 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 ript)) ;; (list
3b30: 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ">" (conc test-
3b40: 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 name "-run.log")
3b50: 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 73 75 63 ))).. ;; (suc
3b60: 63 65 73 73 20 20 20 20 20 20 65 78 65 63 2d 72 cess exec-r
3b70: 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f esults)) ;; (eq?
3b80: 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 75 (cadr exec-resu
3b90: 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 28 lts) 0))).. (
3ba0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f debug:print 2 "O
3bb0: 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 utput from runni
3bc0: 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 ng " fullrunscri
3bd0: 70 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 pt ", pid " (vec
3be0: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3bf0: 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 o 0) " in work a
3c00: 72 65 61 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d rea " .... work-
3c10: 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 area ":\n====\n
3c20: 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 63 exit code " (vec
3c30: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3c40: 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c o 2) "\n" "====\
3c50: 6e 22 29 0a 09 20 20 20 20 28 73 71 6c 69 74 65 n").. (sqlite
3c60: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
3c70: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 . (if (not (v
3c80: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
3c90: 6e 66 6f 20 31 29 29 0a 09 09 28 65 78 69 74 20 nfo 1))...(exit
3ca0: 34 29 29 29 29 29 29 29 0a 0a 3b 3b 20 73 65 74 4)))))))..;; set
3cb0: 20 75 70 20 74 68 65 20 76 65 72 79 20 62 61 73 up the very bas
3cc0: 69 63 73 20 6e 65 65 64 65 64 20 66 6f 72 20 64 ics needed for d
3cd0: 6f 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 68 65 oing anything he
3ce0: 72 65 2e 0a 28 64 65 66 69 6e 65 20 28 73 65 74 re..(define (set
3cf0: 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 20 3b 3b up-for-run). ;;
3d00: 20 77 6f 75 6c 64 20 73 65 74 20 76 61 6c 75 65 would set value
3d10: 73 20 66 6f 72 20 4b 45 59 53 20 69 6e 20 74 68 s for KEYS in th
3d20: 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 65 e environment he
3d30: 72 65 20 66 6f 72 20 62 65 74 74 65 72 20 73 75 re for better su
3d40: 70 70 6f 72 74 20 6f 66 20 65 6e 76 2d 6f 76 65 pport of env-ove
3d50: 72 72 69 64 65 20 62 75 74 20 0a 20 20 3b 3b 20 rride but . ;;
3d60: 68 61 76 65 20 63 68 69 63 6b 65 6e 2f 65 67 67 have chicken/egg
3d70: 20 73 63 65 6e 61 72 69 6f 2e 20 6e 65 65 64 20 scenario. need
3d80: 74 6f 20 72 65 61 64 20 6d 65 67 61 74 65 73 74 to read megatest
3d90: 2e 63 6f 6e 66 69 67 20 74 68 65 6e 20 72 65 61 .config then rea
3da0: 64 20 69 74 20 61 67 61 69 6e 2e 20 47 6f 69 6e d it again. Goin
3db0: 67 20 74 6f 20 0a 20 20 3b 3b 20 70 61 73 73 20 g to . ;; pass
3dc0: 6f 6e 20 74 68 61 74 20 69 64 65 61 20 66 6f 72 on that idea for
3dd0: 20 6e 6f 77 2e 0a 20 20 28 73 65 74 21 20 2a 63 now.. (set! *c
3de0: 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 6e 64 onfiginfo* (find
3df0: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
3e00: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
3e10: 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 rg "-config")(ar
3e20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e gs:get-arg "-con
3e30: 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e fig") "megatest.
3e40: 63 6f 6e 66 69 67 22 29 20 65 6e 76 69 72 6f 6e config") environ
3e50: 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 -patt: "env-over
3e60: 72 69 64 65 22 29 29 0a 20 20 28 73 65 74 21 20 ride")). (set!
3e70: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 28 69 66 *configdat* (if
3e80: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
3e90: 6f 2a 29 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 o*)(car *configi
3ea0: 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 73 65 nfo*) #f)). (se
3eb0: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 t! *toppath*
3ec0: 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 (if (car *config
3ed0: 69 6e 66 6f 2a 29 28 63 61 64 72 20 2a 63 6f 6e info*)(cadr *con
3ee0: 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 figinfo*) #f)).
3ef0: 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a 0a 20 (if *toppath*.
3f00: 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 (setenv "MT
3f10: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 _RUN_AREA_HOME"
3f20: 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b 20 74 6f *toppath*) ;; to
3f30: 20 62 65 20 64 65 70 72 65 63 61 74 65 64 0a 20 be deprecated.
3f40: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
3f50: 74 20 30 20 22 45 52 52 4f 52 3a 20 66 61 69 6c t 0 "ERROR: fail
3f60: 65 64 20 74 6f 20 66 69 6e 64 20 74 68 65 20 74 ed to find the t
3f70: 6f 70 20 70 61 74 68 20 74 6f 20 79 6f 75 72 20 op path to your
3f80: 72 75 6e 20 73 65 74 75 70 2e 22 29 29 0a 20 20 run setup.")).
3f90: 2a 74 6f 70 70 61 74 68 2a 29 0a 0a 28 64 65 66 *toppath*)..(def
3fa0: 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d 64 69 ine (get-best-di
3fb0: 73 6b 20 63 6f 6e 66 64 61 74 29 0a 20 20 28 6c sk confdat). (l
3fc0: 65 74 2a 20 28 28 64 69 73 6b 73 20 20 20 20 28 et* ((disks (
3fd0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
3fe0: 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 20 22 efault confdat "
3ff0: 64 69 73 6b 73 22 20 23 66 29 29 0a 09 20 28 62 disks" #f)).. (b
4000: 65 73 74 20 20 20 20 20 23 66 29 0a 09 20 28 62 est #f).. (b
4010: 65 73 74 73 69 7a 65 20 30 29 29 0a 20 20 20 20 estsize 0)).
4020: 28 69 66 20 64 69 73 6b 73 20 0a 09 28 66 6f 72 (if disks ..(for
4030: 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 -each .. (lambda
4040: 20 28 64 69 73 6b 2d 6e 75 6d 29 0a 09 20 20 20 (disk-num)..
4050: 28 6c 65 74 2a 20 28 28 64 69 72 70 61 74 68 20 (let* ((dirpath
4060: 20 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 20 (cadr (assoc
4070: 64 69 73 6b 2d 6e 75 6d 20 64 69 73 6b 73 29 29 disk-num disks))
4080: 29 0a 09 09 20 20 28 66 72 65 65 73 70 63 20 20 )... (freespc
4090: 20 20 28 69 66 20 28 61 6e 64 20 28 64 69 72 65 (if (and (dire
40a0: 63 74 6f 72 79 3f 20 64 69 72 70 61 74 68 29 0a ctory? dirpath).
40b0: 09 09 09 09 20 20 20 20 20 20 20 28 66 69 6c 65 .... (file
40c0: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 64 -write-access? d
40d0: 69 72 70 61 74 68 29 29 0a 09 09 09 09 20 20 28 irpath))..... (
40e0: 67 65 74 2d 64 66 20 64 69 72 70 61 74 68 29 0a get-df dirpath).
40f0: 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 .... (begin....
4100: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
4110: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 t 0 "WARNING: pa
4120: 74 68 20 22 20 64 69 72 70 61 74 68 20 22 20 69 th " dirpath " i
4130: 6e 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 69 6f n [disks] sectio
4140: 6e 20 6e 6f 74 20 76 61 6c 69 64 20 6f 72 20 77 n not valid or w
4150: 72 69 74 61 62 6c 65 22 29 0a 09 09 09 09 20 20 ritable").....
4160: 20 20 30 29 29 29 29 0a 09 20 20 20 20 20 28 69 0)))).. (i
4170: 66 20 28 3e 20 66 72 65 65 73 70 63 20 62 65 73 f (> freespc bes
4180: 74 73 69 7a 65 29 0a 09 09 20 28 62 65 67 69 6e tsize)... (begin
4190: 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 73 74 ... (set! best
41a0: 20 20 20 20 20 64 69 72 70 61 74 68 29 0a 09 09 dirpath)...
41b0: 20 20 20 28 73 65 74 21 20 62 65 73 74 73 69 7a (set! bestsiz
41c0: 65 20 66 72 65 65 73 70 63 29 29 29 29 29 0a 09 e freespc)))))..
41d0: 20 28 6d 61 70 20 63 61 72 20 64 69 73 6b 73 29 (map car disks)
41e0: 29 29 0a 20 20 20 20 28 69 66 20 62 65 73 74 0a )). (if best.
41f0: 09 62 65 73 74 0a 09 28 62 65 67 69 6e 0a 09 20 .best..(begin..
4200: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
4210: 22 45 52 52 4f 52 3a 20 4e 6f 20 76 61 6c 69 64 "ERROR: No valid
4220: 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 69 6e 20 disks found in
4230: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2e megatest.config.
4240: 20 50 6c 65 61 73 65 20 61 64 64 20 73 6f 6d 65 Please add some
4250: 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 6b 73 5d to your [disks]
4260: 20 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 28 65 section").. (e
4270: 78 69 74 20 31 29 29 29 29 29 0a 0a 28 64 65 66 xit 1)))))..(def
4280: 69 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b ine (create-work
4290: 2d 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 -area db run-id
42a0: 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b 2d 70 test-path disk-p
42b0: 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 ath testname ite
42c0: 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 mdat). (let* ((
42d0: 72 75 6e 2d 69 6e 66 6f 20 28 64 62 3a 67 65 74 run-info (db:get
42e0: 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 20 72 75 6e -run-info db run
42f0: 2d 69 64 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 -id)).. (item-pa
4300: 74 68 20 28 6c 65 74 20 28 28 69 70 20 28 69 74 th (let ((ip (it
4310: 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 em-list->path it
4320: 65 6d 64 61 74 29 29 29 0a 09 09 20 20 20 20 20 emdat)))...
4330: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 70 20 (if (equal? ip
4340: 22 22 29 20 22 22 20 28 63 6f 6e 63 20 22 2f 22 "") "" (conc "/"
4350: 20 69 70 29 29 29 29 0a 09 20 28 72 75 6e 6e 61 ip)))).. (runna
4360: 6d 65 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 me (db:get-valu
4370: 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a e-by-header (db:
4380: 67 65 74 2d 72 6f 77 20 72 75 6e 2d 69 6e 66 6f get-row run-info
4390: 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a 67 65 )...... (db:ge
43a0: 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 6e 66 t-header run-inf
43b0: 6f 29 0a 09 09 09 09 09 20 20 20 22 72 75 6e 6e o)...... "runn
43c0: 61 6d 65 22 29 29 0a 09 20 28 6b 65 79 2d 76 61 ame")).. (key-va
43d0: 6c 73 20 28 72 64 62 3a 67 65 74 2d 6b 65 79 2d ls (rdb:get-key-
43e0: 76 61 6c 73 20 64 62 20 72 75 6e 2d 69 64 29 29 vals db run-id))
43f0: 0a 09 20 28 6b 65 79 2d 73 74 72 20 20 28 73 74 .. (key-str (st
4400: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
4410: 20 6b 65 79 2d 76 61 6c 73 20 22 2f 22 29 29 0a key-vals "/")).
4420: 09 20 28 64 66 75 6c 6c 70 20 20 20 28 63 6f 6e . (dfullp (con
4430: 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 c disk-path "/"
4440: 6b 65 79 2d 73 74 72 20 22 2f 22 20 72 75 6e 6e key-str "/" runn
4450: 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ame "/" testname
4460: 0a 09 09 09 20 69 74 65 6d 2d 70 61 74 68 29 29 .... item-path))
4470: 0a 09 20 28 74 6f 70 74 65 73 74 2d 70 61 74 68 .. (toptest-path
4480: 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 (conc disk-path
4490: 20 22 2f 22 20 6b 65 79 2d 73 74 72 20 22 2f 22 "/" key-str "/"
44a0: 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 runname "/" tes
44b0: 74 6e 61 6d 65 29 29 0a 09 20 28 6c 69 6e 6b 74 tname)).. (linkt
44c0: 72 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 ree (let ((rd (
44d0: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
44e0: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
44f0: 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a " "linktree"))).
4500: 09 09 20 20 20 20 20 28 69 66 20 72 64 20 72 64 .. (if rd rd
4510: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
4520: 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 09 20 28 "/runs")))).. (
4530: 6c 6e 6b 70 61 74 68 20 20 28 63 6f 6e 63 20 6c lnkpath (conc l
4540: 69 6e 6b 74 72 65 65 20 22 2f 22 20 6b 65 79 2d inktree "/" key-
4550: 73 74 72 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 str "/" runname
4560: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 20 20 20 item-path))).
4570: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file-
4580: 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 exists? linktree
4590: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
45a0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
45b0: 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 72 65 65 20 RNING: linktree
45c0: 64 69 64 20 6e 6f 74 20 65 78 69 73 74 21 20 43 did not exist! C
45d0: 72 65 61 74 69 6e 67 20 69 74 20 6e 6f 77 20 61 reating it now a
45e0: 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 0a 09 20 t " linktree)..
45f0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
4600: 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 mkdir -p " linkt
4610: 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 73 ree)))). ;; s
4620: 69 6e 63 65 20 74 68 69 73 20 69 73 20 61 6e 20 ince this is an
4630: 69 74 65 72 61 74 65 64 20 74 65 73 74 20 74 68 iterated test th
4640: 69 73 20 69 73 20 61 73 20 67 6f 6f 64 20 61 20 is is as good a
4650: 70 6c 61 63 65 20 61 73 20 61 6e 79 20 74 6f 0a place as any to.
4660: 20 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 68 ;; update th
4670: 65 20 74 6f 70 74 65 73 74 20 72 65 63 6f 72 64 e toptest record
4680: 20 77 69 74 68 20 69 74 73 20 6c 6f 63 61 74 69 with its locati
4690: 6f 6e 20 72 75 6e 64 69 72 0a 20 20 20 20 28 69 on rundir. (i
46a0: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 f (not (equal? i
46b0: 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 28 tem-path ""))..(
46c0: 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 db:test-set-rund
46d0: 69 72 21 20 64 62 20 72 75 6e 2d 69 64 20 74 65 ir! db run-id te
46e0: 73 74 6e 61 6d 65 20 22 22 20 74 6f 70 74 65 73 stname "" toptes
46f0: 74 2d 70 61 74 68 29 29 0a 20 20 20 20 28 64 65 t-path)). (de
4700: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 53 65 74 bug:print 2 "Set
4710: 74 69 6e 67 20 75 70 20 74 65 73 74 20 72 75 6e ting up test run
4720: 20 61 72 65 61 22 29 0a 20 20 20 20 28 64 65 62 area"). (deb
4730: 75 67 3a 70 72 69 6e 74 20 32 20 22 20 2d 20 63 ug:print 2 " - c
4740: 72 65 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 reating run area
4750: 20 69 6e 20 22 20 64 66 75 6c 6c 70 29 0a 20 20 in " dfullp).
4760: 20 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 (system (conc
4770: 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 64 66 75 "mkdir -p " dfu
4780: 6c 6c 70 29 29 0a 20 20 20 20 28 64 65 62 75 67 llp)). (debug
4790: 3a 70 72 69 6e 74 20 32 20 22 20 2d 20 63 72 65 :print 2 " - cre
47a0: 61 74 69 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d 20 ating link from
47b0: 22 20 64 66 75 6c 6c 70 20 22 2f 22 20 74 65 73 " dfullp "/" tes
47c0: 74 6e 61 6d 65 20 22 20 74 6f 20 22 20 6c 6e 6b tname " to " lnk
47d0: 70 61 74 68 29 0a 20 20 20 20 28 73 79 73 74 65 path). (syste
47e0: 6d 20 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 m (conc "mkdir
47f0: 2d 70 20 22 20 6c 6e 6b 70 61 74 68 29 29 0a 0a -p " lnkpath))..
4800: 20 20 20 20 3b 3b 20 49 20 73 75 73 70 65 63 74 ;; I suspect
4810: 20 74 68 69 73 20 73 65 63 74 69 6f 6e 20 77 61 this section wa
4820: 73 20 64 65 6c 65 74 69 6e 67 20 74 65 73 74 20 s deleting test
4830: 64 69 72 65 63 74 6f 72 69 65 73 20 75 6e 64 65 directories unde
4840: 72 20 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 77 r some . ;; w
4850: 69 65 72 64 20 73 69 74 61 74 69 6f 6e 73 3f 20 ierd sitations?
4860: 54 68 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 6b This doesn't mak
4870: 65 20 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 62 e sense - reenab
4880: 6c 69 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 0a ling the rm -f .
4890: 0a 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 74 . (let ((test
48a0: 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 link (conc lnkpa
48b0: 74 68 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 th "/" testname)
48c0: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 61 6e )). (if (an
48d0: 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 d (file-exists?
48e0: 74 65 73 74 6c 69 6e 6b 29 0a 09 20 20 20 20 20 testlink)..
48f0: 20 20 28 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 (or (regular-f
4900: 69 6c 65 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 09 ile? testlink)..
4910: 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 . (symbolic-li
4920: 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a nk? testlink))).
4930: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
4940: 20 22 72 6d 20 2d 66 20 22 20 74 65 73 74 6c 69 "rm -f " testli
4950: 6e 6b 29 29 29 0a 20 20 20 20 20 20 28 73 79 73 nk))). (sys
4960: 74 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d tem (conc "ln -
4970: 73 66 20 22 20 64 66 75 6c 6c 70 20 22 20 22 20 sf " dfullp " "
4980: 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 testlink))).
4990: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 (if (directory?
49a0: 64 66 75 6c 6c 70 29 0a 09 28 62 65 67 69 6e 0a dfullp)..(begin.
49b0: 09 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 20 20 . (let* ((cmd
49c0: 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d (conc "rsync -
49d0: 61 76 22 20 28 69 66 20 28 3e 20 2a 76 65 72 62 av" (if (> *verb
49e0: 6f 73 69 74 79 2a 20 31 29 20 22 22 20 22 71 22 osity* 1) "" "q"
49f0: 29 20 22 20 22 20 74 65 73 74 2d 70 61 74 68 20 ) " " test-path
4a00: 22 2f 20 22 20 64 66 75 6c 6c 70 20 22 2f 22 29 "/ " dfullp "/")
4a10: 29 0a 09 09 20 28 73 74 61 74 75 73 20 28 73 79 )... (status (sy
4a20: 73 74 65 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 stem cmd)))..
4a30: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 (if (not (eq? s
4a40: 74 61 74 75 73 20 30 29 29 0a 09 09 28 64 65 62 tatus 0))...(deb
4a50: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f ug:print 2 "ERRO
4a60: 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 R: problem with
4a70: 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 running \"" cmd
4a80: 22 5c 22 22 29 29 29 0a 09 20 20 28 6c 69 73 74 "\""))).. (list
4a90: 20 64 66 75 6c 6c 70 20 74 6f 70 74 65 73 74 2d dfullp toptest-
4aa0: 70 61 74 68 29 29 0a 09 28 6c 69 73 74 20 23 66 path))..(list #f
4ab0: 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c #f))))..;; 1. l
4ac0: 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 6b 73 ook though disks
4ad0: 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b 20 77 list for disk w
4ae0: 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b ith most space.;
4af0: 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 6e 20 ; 2. create run
4b00: 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 dir on disk, pat
4b10: 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e h name is meanin
4b20: 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 gful.;; 3. creat
4b30: 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 e link from run
4b40: 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 74 20 dir to megatest
4b50: 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e runs area .;; 4.
4b60: 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 remotely run th
4b70: 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 e test on alloca
4b80: 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d ted host.;; -
4b90: 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 74 6f could be ssh to
4ba0: 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 host from hosts
4bb0: 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 20 72 table (update r
4bc0: 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f egularly with lo
4bd0: 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c ad).;; - coul
4be0: 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b d be netbatch.;;
4bf0: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 (launch-te
4c00: 73 74 20 64 62 20 28 63 61 64 72 20 73 74 61 74 st db (cadr stat
4c10: 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a us) test-conf)).
4c20: 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d (define (launch-
4c30: 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 72 test db run-id r
4c40: 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 unname test-conf
4c50: 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 2d keyvallst test-
4c60: 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 name test-path i
4c70: 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 0a 20 temdat params).
4c80: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
4c90: 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 ry *toppath*).
4ca0: 28 6c 65 74 2a 20 28 28 75 73 65 73 68 65 6c 6c (let* ((useshell
4cb0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
4cc0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
4cd0: 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 73 obtools" "us
4ce0: 65 73 68 65 6c 6c 22 29 29 0a 09 28 6c 61 75 6e eshell"))..(laun
4cf0: 63 68 65 72 20 20 20 28 63 6f 6e 66 69 67 2d 6c cher (config-l
4d00: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
4d10: 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 * "jobtools"
4d20: 20 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 28 "launcher"))..(
4d30: 72 75 6e 73 63 72 69 70 74 20 20 28 63 6f 6e 66 runscript (conf
4d40: 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 ig-lookup test-c
4d50: 6f 6e 66 20 20 20 22 73 65 74 75 70 22 20 20 20 onf "setup"
4d60: 20 20 20 20 20 22 72 75 6e 73 63 72 69 70 74 22 "runscript"
4d70: 29 29 0a 09 28 65 7a 73 74 65 70 73 20 20 20 20 ))..(ezsteps
4d80: 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 (> (length (hash
4d90: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
4da0: 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 7a lt test-conf "ez
4db0: 73 74 65 70 73 22 20 27 28 29 29 29 20 30 29 29 steps" '())) 0))
4dc0: 20 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 ;; don't send a
4dd0: 6c 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 6f ll the steps, co
4de0: 75 6c 64 20 62 65 20 62 69 67 0a 09 28 64 69 73 uld be big..(dis
4df0: 6b 73 70 61 63 65 20 20 28 63 6f 6e 66 69 67 2d kspace (config-
4e00: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
4e10: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
4e20: 22 20 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a " "diskspace")).
4e30: 09 28 6d 65 6d 6f 72 79 20 20 20 20 20 28 63 6f .(memory (co
4e40: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 nfig-lookup test
4e50: 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 65 -conf "require
4e60: 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 22 29 ments" "memory")
4e70: 29 0a 09 28 68 6f 73 74 73 20 20 20 20 20 20 28 )..(hosts (
4e80: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
4e90: 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f onfigdat* "jobto
4ea0: 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b 68 6f ols" "workho
4eb0: 73 74 73 22 29 29 0a 09 28 72 65 6d 6f 74 65 2d sts"))..(remote-
4ec0: 6d 65 67 61 74 65 73 74 20 28 63 6f 6e 66 69 67 megatest (config
4ed0: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
4ee0: 61 74 2a 20 22 73 65 74 75 70 22 20 22 65 78 65 at* "setup" "exe
4ef0: 63 75 74 61 62 6c 65 22 29 29 0a 09 3b 3b 20 46 cutable"))..;; F
4f00: 49 58 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f IXME SOMEDAY: no
4f10: 74 20 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 t good how this
4f20: 69 73 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 is so obtuse, th
4f30: 69 73 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 is hack is to ..
4f40: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
4f50: 20 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 allow running
4f60: 66 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e 20 from dashboard.
4f70: 45 78 74 72 61 63 74 20 74 68 65 20 70 61 74 68 Extract the path
4f80: 0a 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 . ;;
4f90: 20 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 from
4fa0: 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 the called megat
4fb0: 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 est and convert
4fc0: 64 61 73 68 62 6f 61 72 64 0a 20 20 09 3b 3b 20 dashboard. .;;
4fd0: 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 6f . o
4fe0: 72 20 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 r dboard to mega
4ff0: 74 65 73 74 0a 09 28 6c 6f 63 61 6c 2d 6d 65 67 test..(local-meg
5000: 61 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 6c atest (let* ((l
5010: 6d 20 20 28 63 61 72 20 28 61 72 67 76 29 29 29 m (car (argv)))
5020: 0a 09 09 09 09 28 64 69 72 20 28 70 61 74 68 6e .....(dir (pathn
5030: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d ame-directory lm
5040: 29 29 0a 09 09 09 09 28 65 78 65 20 28 70 61 74 )).....(exe (pat
5050: 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 65 hname-strip-dire
5060: 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 20 ctory lm)))....
5070: 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 72 20 (conc (if dir
5080: 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 20 22 (conc dir "/") "
5090: 22 29 0a 09 09 09 09 20 28 63 61 73 65 20 28 73 ")..... (case (s
50a0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 65 78 tring->symbol ex
50b0: 65 29 0a 09 09 09 09 20 20 20 28 28 64 62 6f 61 e)..... ((dboa
50c0: 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a rd) "megatest").
50d0: 09 09 09 09 20 20 20 28 28 64 61 73 68 62 6f 61 .... ((dashboa
50e0: 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a rd) "megatest").
50f0: 09 09 09 09 20 20 20 28 65 6c 73 65 20 65 78 65 .... (else exe
5100: 29 29 29 29 29 0a 09 28 74 65 73 74 2d 73 69 67 )))))..(test-sig
5110: 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 (conc test-na
5120: 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c 69 73 me ":" (item-lis
5130: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
5140: 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 68 20 )) ;; test-path
5150: 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 74 68 is the full path
5160: 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 20 69 including the i
5170: 74 65 6d 2d 70 61 74 68 0a 09 28 77 6f 72 6b 2d tem-path..(work-
5180: 61 72 65 61 20 20 23 66 29 0a 09 28 74 6f 70 74 area #f)..(topt
5190: 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 est-work-area #f
51a0: 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 61 74 65 ) ;; for iterate
51b0: 64 20 74 65 73 74 73 20 74 68 65 20 74 6f 70 20 d tests the top
51c0: 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 test contains da
51d0: 74 61 20 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 ta relevant for
51e0: 61 6c 6c 0a 09 28 64 69 73 6b 70 61 74 68 20 20 all..(diskpath
51f0: 20 23 66 29 0a 09 28 63 6d 64 70 61 72 6d 73 20 #f)..(cmdparms
5200: 20 20 23 66 29 0a 09 28 66 75 6c 6c 63 6d 64 20 #f)..(fullcmd
5210: 20 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e #f) ;; (defin
5220: 65 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 e a (with-output
5230: 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 -to-string (lamb
5240: 64 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 da ()(write x)))
5250: 29 0a 09 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 )..(mt-bindir-pa
5260: 74 68 20 23 66 29 0a 09 28 69 74 65 6d 2d 70 61 th #f)..(item-pa
5270: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
5280: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 28 ath itemdat))..(
5290: 74 65 73 74 69 6e 66 6f 20 20 20 28 72 64 62 3a testinfo (rdb:
52a0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 20 64 62 get-test-info db
52b0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
52c0: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 28 e item-path))..(
52d0: 74 65 73 74 2d 69 64 20 20 20 20 28 64 62 3a 74 test-id (db:t
52e0: 65 73 74 2d 67 65 74 2d 69 64 20 74 65 73 74 69 est-get-id testi
52f0: 6e 66 6f 29 29 29 0a 20 20 28 69 66 20 68 6f 73 nfo))). (if hos
5300: 74 73 20 28 73 65 74 21 20 68 6f 73 74 73 20 28 ts (set! hosts (
5310: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 68 6f 73 string-split hos
5320: 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 ts))). ;; set
5330: 20 74 68 65 20 6d 65 67 61 74 65 73 74 20 74 6f the megatest to
5340: 20 62 65 20 63 61 6c 6c 65 64 20 6f 6e 20 74 68 be called on th
5350: 65 20 72 65 6d 6f 74 65 20 68 6f 73 74 0a 20 20 e remote host.
5360: 20 20 28 69 66 20 28 6e 6f 74 20 72 65 6d 6f 74 (if (not remot
5370: 65 2d 6d 65 67 61 74 65 73 74 29 28 73 65 74 21 e-megatest)(set!
5380: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
5390: 20 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 local-megatest)
53a0: 29 20 3b 3b 20 22 6d 65 67 61 74 65 73 74 22 29 ) ;; "megatest")
53b0: 29 0a 20 20 20 20 28 73 65 74 21 20 6d 74 2d 62 ). (set! mt-b
53c0: 69 6e 64 69 72 2d 70 61 74 68 20 28 70 61 74 68 indir-path (path
53d0: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 72 name-directory r
53e0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 29 emote-megatest))
53f0: 0a 20 20 20 20 28 69 66 20 6c 61 75 6e 63 68 65 . (if launche
5400: 72 20 28 73 65 74 21 20 6c 61 75 6e 63 68 65 72 r (set! launcher
5410: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 6c (string-split l
5420: 61 75 6e 63 68 65 72 29 29 29 0a 20 20 20 20 3b auncher))). ;
5430: 3b 20 73 65 74 20 75 70 20 74 68 65 20 72 75 6e ; set up the run
5440: 20 77 6f 72 6b 20 61 72 65 61 20 66 6f 72 20 74 work area for t
5450: 68 69 73 20 74 65 73 74 0a 20 20 20 20 28 73 65 his test. (se
5460: 74 21 20 64 69 73 6b 70 61 74 68 20 28 67 65 74 t! diskpath (get
5470: 2d 62 65 73 74 2d 64 69 73 6b 20 2a 63 6f 6e 66 -best-disk *conf
5480: 69 67 64 61 74 2a 29 29 0a 20 20 20 20 28 69 66 igdat*)). (if
5490: 20 64 69 73 6b 70 61 74 68 0a 09 28 6c 65 74 20 diskpath..(let
54a0: 28 28 64 61 74 20 20 28 63 72 65 61 74 65 2d 77 ((dat (create-w
54b0: 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 6e 2d ork-area db run-
54c0: 69 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 id test-path dis
54d0: 6b 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 kpath test-name
54e0: 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 73 itemdat))).. (s
54f0: 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 et! work-area (c
5500: 61 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 74 ar dat)).. (set
5510: 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 ! toptest-work-a
5520: 72 65 61 20 28 63 61 64 72 20 64 61 74 29 29 29 rea (cadr dat)))
5530: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 ..(begin.. (set
5540: 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f 6e ! work-area (con
5550: 63 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 6d c test-path "/tm
5560: 70 5f 72 75 6e 22 29 29 0a 09 20 20 28 63 72 65 p_run")).. (cre
5570: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f ate-directory wo
5580: 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 20 20 28 rk-area #t).. (
5590: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
55a0: 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 ARNING: No disk
55b0: 77 6f 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 work area specif
55c0: 69 65 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e ied - running in
55d0: 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 the test direct
55e0: 6f 72 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 ory under tmp_ru
55f0: 6e 22 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 n"))). (set!
5600: 63 6d 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 cmdparms (base64
5610: 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 28 :base64-encode (
5620: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
5630: 74 72 69 6e 67 0a 09 09 09 09 20 20 20 20 28 6c tring..... (l
5640: 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 ambda () ;; (lis
5650: 74 20 27 68 6f 73 74 73 20 20 20 20 20 68 6f 73 t 'hosts hos
5660: 74 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 77 ts)..... (w
5670: 72 69 74 65 20 28 6c 69 73 74 20 28 6c 69 73 74 rite (list (list
5680: 20 27 74 65 73 74 70 61 74 68 20 20 74 65 73 74 'testpath test
5690: 2d 70 61 74 68 29 0a 09 09 09 09 09 09 20 20 20 -path).......
56a0: 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 (list 'work-area
56b0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
56c0: 09 09 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 .. (list 'test
56d0: 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 -name test-name)
56e0: 20 0a 09 09 09 09 09 09 20 20 20 28 6c 69 73 74 ....... (list
56f0: 20 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 'runscript runs
5700: 63 72 69 70 74 29 20 0a 09 09 09 09 09 09 20 20 cript) .......
5710: 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 (list 'run-id
5720: 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 run-id )....
5730: 09 09 09 20 20 20 28 6c 69 73 74 20 27 74 65 73 ... (list 'tes
5740: 74 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 t-id test-id
5750: 29 0a 09 09 09 09 09 09 20 20 20 28 6c 69 73 74 )....... (list
5760: 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 'itemdat item
5770: 64 61 74 20 20 29 0a 09 09 09 09 09 09 20 20 20 dat ).......
5780: 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 (list 'megatest
5790: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
57a0: 29 0a 09 09 09 09 09 09 20 20 20 28 6c 69 73 74 )....... (list
57b0: 20 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 'ezsteps ezst
57c0: 65 70 73 29 20 0a 20 09 09 09 09 09 09 20 20 20 eps) . ......
57d0: 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 (list 'env-ovrd
57e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
57f0: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
5800: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
5810: 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 09 de" '())) ......
5820: 09 20 20 20 28 6c 69 73 74 20 27 73 65 74 2d 76 . (list 'set-v
5830: 61 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 20 ars (if params
5840: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
5850: 64 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 22 default params "
5860: 2d 73 65 74 76 61 72 73 22 20 23 66 29 29 29 0a -setvars" #f))).
5870: 09 09 09 09 09 09 20 20 20 28 6c 69 73 74 20 27 ...... (list '
5880: 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 6d runname runnam
5890: 65 29 0a 09 09 09 09 09 09 20 20 20 28 6c 69 73 e)....... (lis
58a0: 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 t 'mt-bindir-pat
58b0: 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 h mt-bindir-path
58c0: 29 29 29 29 29 29 29 20 3b 3b 20 28 73 74 72 69 ))))))) ;; (stri
58d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b ng-intersperse k
58e0: 65 79 76 61 6c 6c 73 74 20 22 20 22 29 29 29 29 eyvallst " "))))
58f0: 0a 20 20 20 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 . ;; clean ou
5900: 74 20 73 74 65 70 20 72 65 63 6f 72 64 73 20 66 t step records f
5910: 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 72 75 6e rom previous run
5920: 20 69 66 20 74 68 65 79 20 65 78 69 73 74 0a 20 if they exist.
5930: 20 20 20 28 64 62 3a 64 65 6c 65 74 65 2d 74 65 (db:delete-te
5940: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 st-step-records
5950: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e db run-id test-n
5960: 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 20 ame itemdat).
5970: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5980: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b ry work-area) ;;
5990: 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c so that log fil
59a0: 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e es from the laun
59b0: 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 ch process don't
59c0: 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 clutter the tes
59d0: 74 20 64 69 72 0a 20 20 20 20 28 63 6f 6e 64 0a t dir. (cond.
59e0: 20 20 20 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 ((and launc
59f0: 68 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 her hosts) ;; mu
5a00: 73 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 20 st be using ssh
5a10: 68 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 hostname. (
5a20: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
5a30: 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 pend launcher (c
5a40: 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 ar hosts)(list r
5a50: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
5a60: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
5a70: 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a e" cmdparms)))).
5a80: 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 (launcher.
5a90: 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 (set! fullc
5aa0: 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 md (append launc
5ab0: 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 her (list remote
5ac0: 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 -megatest test-s
5ad0: 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d ig "-execute" cm
5ae0: 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 dparms)))).
5af0: 28 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 (else. (if
5b00: 28 6e 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 64 (not useshell)(d
5b10: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
5b20: 52 4e 49 4e 47 3a 20 69 6e 74 65 72 6e 61 6c 20 RNING: internal
5b30: 6c 61 75 6e 63 68 69 6e 67 20 77 69 6c 6c 20 6e launching will n
5b40: 6f 74 20 77 6f 72 6b 20 77 65 6c 6c 20 77 69 74 ot work well wit
5b50: 68 6f 75 74 20 5c 22 75 73 65 73 68 65 6c 6c 20 hout \"useshell
5b60: 79 65 73 5c 22 20 69 6e 20 79 6f 75 72 20 5b 6a yes\" in your [j
5b70: 6f 62 74 6f 6f 6c 73 5d 20 73 65 63 74 69 6f 6e obtools] section
5b80: 22 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 ")). (set!
5b90: 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 72 65 fullcmd (list re
5ba0: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
5bb0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
5bc0: 22 20 63 6d 64 70 61 72 6d 73 20 28 69 66 20 75 " cmdparms (if u
5bd0: 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 29 29 seshell "&" ""))
5be0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 72 67 ))). (if (arg
5bf0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 s:get-arg "-xter
5c00: 6d 22 29 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 m")(set! fullcmd
5c10: 20 28 61 70 70 65 6e 64 20 66 75 6c 6c 63 6d 64 (append fullcmd
5c20: 20 28 6c 69 73 74 20 22 2d 78 74 65 72 6d 22 29 (list "-xterm")
5c30: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
5c40: 72 69 6e 74 20 31 20 22 4c 61 75 6e 63 68 69 6e rint 1 "Launchin
5c50: 67 20 6d 65 67 61 74 65 73 74 20 66 6f 72 20 74 g megatest for t
5c60: 65 73 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 est " test-name
5c70: 22 20 69 6e 20 22 20 77 6f 72 6b 2d 61 72 65 61 " in " work-area
5c80: 22 20 2e 2e 2e 22 29 0a 20 20 20 20 28 74 65 73 " ..."). (tes
5c90: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 62 t-set-status! db
5ca0: 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 test-id "LAUNCH
5cb0: 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 ED" "n/a" #f #f)
5cc0: 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 ;; (if launch-r
5cd0: 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 esults launch-re
5ce0: 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 sults "FAILED"))
5cf0: 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 72 65 2d . ;; set pre-
5d00: 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 20 launch-env-vars
5d10: 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 69 6e 67 before launching
5d20: 2c 20 6b 65 65 70 20 74 68 65 20 76 61 72 73 20 , keep the vars
5d30: 69 6e 20 70 72 65 76 76 61 6c 73 20 61 6e 64 20 in prevvals and
5d40: 70 75 74 20 74 68 65 20 65 6e 76 69 6f 6e 6d 65 put the envionme
5d50: 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 64 6f 6e nt back when don
5d60: 65 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 e. (debug:pri
5d70: 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 3a 20 22 nt 4 "fullcmd: "
5d80: 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 20 28 6c fullcmd). (l
5d90: 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 65 76 et* ((commonprev
5da0: 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e 65 6e 76 vals (alist->env
5db0: 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 -vars.... (ha
5dc0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
5dd0: 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a ault *configdat*
5de0: 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 "env-override"
5df0: 27 28 29 29 29 29 0a 09 20 20 20 28 74 65 73 74 '()))).. (test
5e00: 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c 69 73 prevvals (alis
5e10: 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 t->env-vars....
5e20: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
5e30: 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d ef/default test-
5e40: 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 6e 63 68 conf "pre-launch
5e50: 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 73 22 20 -env-overrides"
5e60: 27 28 29 29 29 29 0a 09 20 20 20 28 6d 69 73 63 '()))).. (misc
5e70: 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c 69 73 prevvals (alis
5e80: 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 t->env-vars ;; c
5e90: 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 onsolidate this
5ea0: 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 63 6f code with the co
5eb0: 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 de in megatest.s
5ec0: 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 cm for "-execute
5ed0: 22 0a 09 09 09 20 20 20 20 28 61 70 70 65 6e 64 ".... (append
5ee0: 20 28 6c 69 73 74 20 28 6c 69 73 74 20 22 4d 54 (list (list "MT
5ef0: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
5f00: 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c -name)...... (l
5f10: 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 ist "MT_ITEM_INF
5f20: 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 O" (conc itemdat
5f30: 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 73 74 )) ...... (list
5f40: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 "MT_RUNNAME"
5f50: 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 20 20 runname)).....
5f60: 20 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 itemdat)))..
5f70: 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 (launch-results
5f80: 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 75 6e 2d (apply cmd-run-
5f90: 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e 65 0a 09 proc-each-line..
5fa0: 09 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c ... (if useshel
5fb0: 6c 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 72 l..... (str
5fc0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
5fd0: 66 75 6c 6c 63 6d 64 20 22 20 22 29 0a 09 09 09 fullcmd " ")....
5fe0: 09 20 20 20 20 20 20 28 63 61 72 20 66 75 6c 6c . (car full
5ff0: 63 6d 64 29 29 0a 09 09 09 09 20 20 70 72 69 6e cmd))..... prin
6000: 74 0a 09 09 09 09 20 20 28 69 66 20 75 73 65 73 t..... (if uses
6010: 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 20 20 27 hell..... '
6020: 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 64 ()..... (cd
6030: 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 29 20 3b r fullcmd))))) ;
6040: 3b 20 20 6c 61 75 6e 63 68 65 72 20 66 75 6c 6c ; launcher full
6050: 63 6d 64 29 29 29 3b 3b 20 28 61 70 70 6c 79 20 cmd)));; (apply
6060: 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 61 63 cmd-run-proc-eac
6070: 68 2d 6c 69 6e 65 20 6c 61 75 6e 63 68 65 72 20 h-line launcher
6080: 70 72 69 6e 74 20 66 75 6c 6c 63 6d 64 29 29 29 print fullcmd)))
6090: 20 3b 3b 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 ;; (cmd-run->li
60a0: 73 74 20 66 75 6c 6c 63 6d 64 29 29 0a 20 20 20 st fullcmd)).
60b0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
60c0: 32 20 22 4c 61 75 6e 63 68 69 6e 67 20 63 6f 6d 2 "Launching com
60d0: 70 6c 65 74 65 64 2c 20 75 70 64 61 74 69 6e 67 pleted, updating
60e0: 20 64 62 22 29 0a 20 20 20 20 20 20 28 64 65 62 db"). (deb
60f0: 75 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 6e ug:print 2 "Laun
6100: 63 68 20 72 65 73 75 6c 74 73 3a 20 22 20 6c 61 ch results: " la
6110: 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 20 20 unch-results).
6120: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6c 61 75 (if (not lau
6130: 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 nch-results)..
6140: 28 62 65 67 69 6e 0a 09 20 20 20 20 28 70 72 69 (begin.. (pri
6150: 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 nt "ERROR: Faile
6160: 64 20 74 6f 20 72 75 6e 20 22 20 28 73 74 72 69 d to run " (stri
6170: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 ng-intersperse f
6180: 75 6c 6c 63 6d 64 20 22 20 22 29 20 22 2c 20 65 ullcmd " ") ", e
6190: 78 69 74 69 6e 67 20 6e 6f 77 22 29 0a 09 20 20 xiting now")..
61a0: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
61b0: 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 3b 3b ize! db).. ;;
61c0: 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 69 74 22 good ole "exit"
61d0: 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f 20 77 6f seems not to wo
61e0: 72 6b 0a 09 20 20 20 20 3b 3b 20 28 5f 65 78 69 rk.. ;; (_exi
61f0: 74 20 39 29 0a 09 20 20 20 20 3b 3b 20 62 75 74 t 9).. ;; but
6200: 20 74 68 69 73 20 68 61 63 6b 20 77 69 6c 6c 20 this hack will
6210: 77 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f 20 work! Thanks go
6220: 74 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 20 to Alan Post of
6230: 74 68 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 69 the Chicken emai
6240: 6c 20 6c 69 73 74 0a 09 20 20 20 20 3b 3b 20 4e l list.. ;; N
6250: 42 2f 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c B// Is this stil
6260: 6c 20 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 l needed? Should
6270: 20 62 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 be safe to go b
6280: 61 63 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f ack to "exit" no
6290: 77 3f 0a 09 20 20 20 20 28 70 72 6f 63 65 73 73 w?.. (process
62a0: 2d 73 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 -signal (current
62b0: 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 -process-id) sig
62c0: 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 20 20 20 29 nal/kill).. )
62d0: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e ). (alist->
62e0: 65 6e 76 2d 76 61 72 73 20 6d 69 73 63 70 72 65 env-vars miscpre
62f0: 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 61 6c vvals). (al
6300: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 74 65 ist->env-vars te
6310: 73 74 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 stprevvals).
6320: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
6330: 72 73 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c rs commonprevval
6340: 73 29 0a 20 20 20 20 20 20 6c 61 75 6e 63 68 2d s). launch-
6350: 72 65 73 75 6c 74 73 29 29 29 0a 0a results)))..