Artifact
9c1957ce23c2a341ec7207cc5e2ab628152e2508:
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 3b 3b 20 69 66 20 68 61 6e 64 65 64 20 61 20 .;; if handed a
05d0: 73 74 72 69 6e 67 2c 20 70 72 6f 63 65 73 73 20 string, process
05e0: 69 74 2c 20 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f it, else look fo
05f0: 72 20 4d 54 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 r MT_CMDINFO.(de
0600: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 fine (launch:get
0610: 2d 63 6d 64 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c -cmdinfo-assoc-l
0620: 69 73 74 20 23 21 6b 65 79 20 28 65 6e 63 6f 64 ist #!key (encod
0630: 65 64 2d 63 6d 64 20 23 66 29 29 0a 20 20 28 6c ed-cmd #f)). (l
0640: 65 74 20 28 28 65 6e 63 63 6d 64 20 28 69 66 20 et ((enccmd (if
0650: 65 6e 63 6f 64 65 64 2d 63 6d 64 20 65 6e 63 6f encoded-cmd enco
0660: 64 65 64 2d 63 6d 64 20 28 67 65 74 65 6e 76 20 ded-cmd (getenv
0670: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
0680: 0a 20 20 20 20 28 69 66 20 65 6e 63 63 64 6d 0a . (if enccdm.
0690: 09 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 .(read (open-inp
06a0: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
06b0: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
06c0: 65 6e 63 63 6d 64 29 29 29 0a 09 27 28 29 29 29 enccmd)))..'()))
06d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
06e0: 63 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 ch:execute encod
06f0: 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ed-cmd). (let*
0700: 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 ((cmdinfo (rea
0710: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
0720: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
0730: 65 36 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 e64-decode encod
0740: 65 64 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 ed-cmd))))).
0750: 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (setenv "MT_CMDI
0760: 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 NFO" encoded-cmd
0770: 29 0a 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f ). (if (list?
0780: 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 cmdinfo) ;; ((t
0790: 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 estpath /tmp/mrw
07a0: 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 ellan/jazzmind/s
07b0: 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 rc/example_run/t
07c0: 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 ests/sqlitespeed
07d0: 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e 61 6d 65 )..;; (test-name
07e0: 20 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 72 sqlitespeed) (r
07f0: 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
0800: 70 74 2e 72 62 29 20 28 64 62 2d 68 6f 73 74 20 pt.rb) (db-host
0810: 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d localhost) (run-
0820: 69 64 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 id 1))..(let* ((
0830: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
0840: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
0850: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b th cmdinfo)) ;
0860: 3b 20 48 6f 77 20 69 73 20 74 65 73 74 70 61 74 ; How is testpat
0870: 68 20 64 69 66 66 65 72 65 6e 74 20 66 72 6f 6d h different from
0880: 20 77 6f 72 6b 2d 61 72 65 61 20 3f 3f 0a 09 20 work-area ??..
0890: 20 20 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 (top-path
08a0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
08b0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
08c0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f fo)).. (wo
08d0: 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
08e0: 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
08f0: 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
0900: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
0910: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0920: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
0930: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
0940: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
0950: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
0960: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
0970: 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 73 (ezsteps (as
0980: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a 73 soc/default 'ezs
0990: 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 29 teps cmdinfo))
09a0: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 72 65 6d .. (runrem
09b0: 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ote (assoc/defau
09c0: 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d lt 'runremote cm
09d0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
09e0: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
09f0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
0a00: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
0a10: 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
0a20: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0a30: 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
0a40: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
0a50: 61 72 67 65 74 20 20 20 20 28 61 73 73 6f 63 2f arget (assoc/
0a60: 64 65 66 61 75 6c 74 20 27 74 61 72 67 65 74 20 default 'target
0a70: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
0a80: 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 (itemdat
0a90: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0aa0: 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 itemdat cmdinf
0ab0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 65 6e 76 o)).. (env
0ac0: 2d 6f 76 72 64 20 20 28 61 73 73 6f 63 2f 64 65 -ovrd (assoc/de
0ad0: 66 61 75 6c 74 20 27 65 6e 76 2d 6f 76 72 64 20 fault 'env-ovrd
0ae0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0af0: 20 20 20 28 73 65 74 2d 76 61 72 73 20 20 28 61 (set-vars (a
0b00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 73 65 ssoc/default 'se
0b10: 74 2d 76 61 72 73 20 20 63 6d 64 69 6e 66 6f 29 t-vars cmdinfo)
0b20: 29 20 3b 3b 20 70 72 65 2d 6f 76 65 72 72 69 64 ) ;; pre-overrid
0b30: 65 73 20 66 72 6f 6d 20 2d 73 65 74 76 61 72 0a es from -setvar.
0b40: 09 20 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 . (runname
0b50: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0b60: 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 63 6d 64 t 'runname cmd
0b70: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0b80: 6d 65 67 61 74 65 73 74 20 20 28 61 73 73 6f 63 megatest (assoc
0b90: 2f 64 65 66 61 75 6c 74 20 27 6d 65 67 61 74 65 /default 'megate
0ba0: 73 74 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 st cmdinfo))..
0bb0: 20 20 20 20 20 20 28 6d 74 2d 62 69 6e 64 69 72 (mt-bindir
0bc0: 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64 65 66 -path (assoc/def
0bd0: 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d ault 'mt-bindir-
0be0: 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29 0a 09 path cmdinfo))..
0bf0: 20 20 20 20 20 20 20 28 66 75 6c 6c 72 75 6e 73 (fullruns
0c00: 63 72 69 70 74 20 28 69 66 20 28 6e 6f 74 20 72 cript (if (not r
0c10: 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 unscript).
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c30: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 #f.
0c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c60: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
0c70: 69 6e 64 65 78 20 22 2f 22 20 72 75 6e 73 63 72 index "/" runscr
0c80: 69 70 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ipt).
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
0cb0: 72 69 70 74 20 3b 3b 20 75 73 65 20 75 6e 61 64 ript ;; use unad
0cc0: 75 6c 74 65 72 65 64 20 69 66 20 63 6f 6e 74 61 ultered if conta
0cd0: 69 6e 73 20 73 6c 61 73 68 65 73 0a 20 20 20 20 ins slashes.
0ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d00: 20 20 28 6c 65 74 20 28 28 66 75 6c 6c 6e 20 28 (let ((fulln (
0d10: 63 6f 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f conc testpath "/
0d20: 22 20 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 " runscript)))..
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 20 20 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 (if (and (file
0d60: 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 6e 29 0a -exists? fulln).
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0da0: 20 20 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 (file-execute
0db0: 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 6e 29 29 -access? fulln))
0dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
0df0: 75 6c 6c 6e 0a 20 20 20 20 20 20 20 20 20 20 20 ulln.
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 20 20 20 72 75 6e 73 63 72 69 70 74 29 29 29 29 runscript))))
0e30: 29 20 3b 3b 20 61 73 73 75 6d 65 20 69 74 20 69 ) ;; assume it i
0e40: 73 20 6f 6e 20 74 68 65 20 70 61 74 68 0a 09 20 s on the path..
0e50: 20 20 20 20 20 20 28 72 6f 6c 6c 75 70 2d 73 74 (rollup-st
0e60: 61 74 75 73 20 30 29 29 0a 09 20 20 28 64 65 62 atus 0)).. (deb
0e70: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 ug:print 2 "Exec
0e80: 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d tuing " test-nam
0e90: 65 20 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d e " (id: " test-
0ea0: 69 64 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d id ") on " (get-
0eb0: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 3b host-name)).. ;
0ec0: 3b 20 53 65 74 75 70 20 74 68 65 20 2a 72 75 6e ; Setup the *run
0ed0: 72 65 6d 6f 74 65 2a 20 67 6c 6f 62 61 6c 20 76 remote* global v
0ee0: 61 72 0a 09 20 20 28 69 66 20 2a 72 75 6e 72 65 ar.. (if *runre
0ef0: 6d 6f 74 65 2a 20 28 64 65 62 75 67 3a 70 72 69 mote* (debug:pri
0f00: 6e 74 20 32 20 22 45 52 52 4f 52 3a 20 49 27 6d nt 2 "ERROR: I'm
0f10: 20 6e 6f 74 20 65 78 70 65 63 74 69 6e 67 20 2a not expecting *
0f20: 72 75 6e 72 65 6d 6f 74 65 2a 20 74 6f 20 62 65 runremote* to be
0f30: 20 73 65 74 20 61 74 20 74 68 69 73 20 74 69 6d set at this tim
0f40: 65 22 29 29 0a 09 20 20 28 73 65 74 21 20 2a 72 e")).. (set! *r
0f50: 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d unremote* runrem
0f60: 6f 74 65 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 ote).. ;; apply
0f70: 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 pre-overrides b
0f80: 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 efore other vari
0f90: 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f ables. The pre-o
0fa0: 76 65 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 verride vars mus
0fb0: 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 t not.. ;; clob
0fc0: 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d bers things from
0fd0: 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f the official so
0fe0: 75 72 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 urces such as me
0ff0: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e gatest.config an
1000: 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e d runconfigs.con
1010: 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 fig.. (if (stri
1020: 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 ng? set-vars)..
1030: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 (let ((varp
1040: 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c airs (string-spl
1050: 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 it set-vars ",")
1060: 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e ))...(debug:prin
1070: 74 20 34 20 22 76 61 72 70 61 69 72 73 3a 20 22 t 4 "varpairs: "
1080: 20 76 61 72 70 61 69 72 73 29 0a 09 09 28 6d 61 varpairs)...(ma
1090: 70 20 28 6c 61 6d 62 64 61 20 28 76 61 72 70 61 p (lambda (varpa
10a0: 69 72 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 ir)... (le
10b0: 74 20 28 28 76 61 72 76 61 6c 20 28 73 74 72 69 t ((varval (stri
10c0: 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 61 69 72 ng-split varpair
10d0: 20 22 3d 22 29 29 29 0a 09 09 09 20 28 69 66 20 "="))).... (if
10e0: 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 61 72 (eq? (length var
10f0: 76 61 6c 29 20 32 29 0a 09 09 09 20 20 20 20 20 val) 2)....
1100: 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 (let ((var (car
1110: 76 61 72 76 61 6c 29 29 0a 09 09 09 09 20 20 20 varval)).....
1120: 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 (val (cadr varva
1130: 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 l))).... (
1140: 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 41 debug:print 1 "A
1150: 64 64 69 6e 67 20 70 72 65 2d 76 61 72 2f 76 61 dding pre-var/va
1160: 6c 20 22 20 76 61 72 20 22 20 3d 20 22 20 76 61 l " var " = " va
1170: 6c 20 22 20 74 6f 20 74 68 65 20 65 6e 76 69 72 l " to the envir
1180: 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 20 20 onment")....
1190: 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 (setenv var v
11a0: 61 6c 29 29 29 29 29 0a 09 09 20 20 20 20 20 76 al)))))... v
11b0: 61 72 70 61 69 72 73 29 29 29 0a 09 20 20 28 73 arpairs))).. (s
11c0: 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52 etenv "MT_TEST_R
11d0: 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 UN_DIR" work-are
11e0: 61 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d a).. (setenv "M
11f0: 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes
1200: 74 2d 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 t-name).. (sete
1210: 6e 76 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f nv "MT_ITEM_INFO
1220: 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 " (conc itemdat)
1230: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
1240: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
1250: 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e 76 20 ame).. (setenv
1260: 22 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 20 6d "MT_MEGATEST" m
1270: 65 67 61 74 65 73 74 29 0a 09 20 20 28 73 65 74 egatest).. (set
1280: 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 22 20 env "MT_TARGET"
1290: 20 20 20 74 61 72 67 65 74 29 0a 09 20 20 28 69 target).. (i
12a0: 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 f mt-bindir-path
12b0: 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 22 20 (setenv "PATH"
12c0: 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 50 (conc (getenv "P
12d0: 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e ATH") ":" mt-bin
12e0: 64 69 72 2d 70 61 74 68 29 29 29 0a 09 20 20 28 dir-path))).. (
12f0: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
1300: 20 74 6f 70 2d 70 61 74 68 29 0a 09 20 20 28 69 top-path).. (i
1310: 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f f (not (setup-fo
1320: 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 r-run)).. (
1330: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
1340: 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 rint 0 "Failed t
1350: 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 o setup, exiting
1360: 22 29 20 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 ") ...;; (sqlite
1370: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
1380: 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 ..;; (sqlite3:fi
1390: 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 28 nalize! tdb)...(
13a0: 65 78 69 74 20 31 29 29 29 0a 09 20 20 3b 3b 20 exit 1))).. ;;
13b0: 43 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 Can setup as cli
13c0: 65 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d ent for server m
13d0: 6f 64 65 20 6e 6f 77 0a 09 20 20 28 73 65 72 76 ode now.. (serv
13e0: 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 29 er:client-setup)
13f0: 0a 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 ... (change-dir
1400: 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a ectory *toppath*
1410: 29 20 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 ) .. (set-megat
1420: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e est-env-vars run
1430: 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 20 6d 61 -id) ;; these ma
1440: 79 20 62 65 20 6e 65 65 64 65 64 20 62 79 20 74 y be needed by t
1450: 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 6f he launching pro
1460: 63 65 73 73 0a 09 20 20 28 63 68 61 6e 67 65 2d cess.. (change-
1470: 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 directory work-a
1480: 72 65 61 29 20 0a 0a 09 20 20 28 6f 70 65 6e 2d rea) ... (open-
1490: 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 2d 72 75 run-close set-ru
14a0: 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 23 66 n-config-vars #f
14b0: 20 72 75 6e 2d 69 64 29 0a 09 20 20 3b 3b 20 65 run-id).. ;; e
14c0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 nvironment overr
14d0: 69 64 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 ides are done *b
14e0: 65 66 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 efore* the remai
14f0: 6e 69 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e ning critical en
1500: 76 61 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 2d vars... (alist-
1510: 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 >env-vars env-ov
1520: 72 64 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 rd).. (set-mega
1530: 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 test-env-vars ru
1540: 6e 2d 69 64 29 0a 09 20 20 28 73 65 74 2d 69 74 n-id).. (set-it
1550: 65 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d em-env-vars item
1560: 64 61 74 29 0a 09 20 20 28 73 61 76 65 2d 65 6e dat).. (save-en
1570: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
1580: 65 73 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 es "megatest")..
1590: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
15a0: 65 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d e test-set-meta-
15b0: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
15c0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
15d0: 20 69 74 65 6d 64 61 74 20 30 29 0a 09 20 20 28 itemdat 0).. (
15e0: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
15f0: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 tatus! test-id "
1600: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART"
1610: 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 "n/a" (args:get
1620: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
1630: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
1640: 61 72 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 20 arg "-xterm")..
1650: 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 72 (set! fullr
1660: 75 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 unscript "xterm"
1670: 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e ).. (if (an
1680: 64 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 d fullrunscript
1690: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 63 75 (not (file-execu
16a0: 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 72 te-access? fullr
16b0: 75 6e 73 63 72 69 70 74 29 29 29 0a 09 09 20 20 unscript)))...
16c0: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 63 (system (conc "c
16d0: 68 6d 6f 64 20 75 67 2b 78 20 22 20 66 75 6c 6c hmod ug+x " full
16e0: 72 75 6e 73 63 72 69 70 74 29 29 29 29 0a 09 20 runscript))))..
16f0: 20 3b 3b 20 57 65 20 61 72 65 20 61 62 6f 75 74 ;; We are about
1700: 20 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 to actually kic
1710: 6b 20 6f 66 66 20 74 68 65 20 74 65 73 74 0a 09 k off the test..
1720: 20 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 73 20 ;; so this is
1730: 61 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 6f 20 a good place to
1740: 72 65 6d 6f 76 65 20 74 68 65 20 72 65 63 6f 72 remove the recor
1750: 64 73 20 66 6f 72 20 0a 09 20 20 3b 3b 20 61 6e ds for .. ;; an
1760: 79 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a y previous runs.
1770: 09 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 . ;; (db:test-r
1780: 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 emove-steps db r
1790: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
17a0: 74 65 6d 64 61 74 29 0a 09 20 20 0a 09 20 20 28 temdat).. .. (
17b0: 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 let* ((m
17c0: 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 (make-mutex)
17d0: 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 )... (kill-job?
17e0: 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d #f)... (exit-
17f0: 69 6e 66 6f 20 20 20 20 28 76 65 63 74 6f 72 20 info (vector
1800: 23 74 20 23 74 20 23 74 29 29 0a 09 09 20 28 6a #t #t #t))... (j
1810: 6f 62 2d 74 68 72 65 61 64 20 20 20 23 66 29 0a ob-thread #f).
1820: 09 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 20 .. (runit
1830: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
1840: 20 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a ;; (let-values.
1850: 09 09 09 09 20 3b 3b 20 20 28 28 28 70 69 64 20 .... ;; (((pid
1860: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
1870: 2d 63 6f 64 65 29 0a 09 09 09 09 20 3b 3b 20 20 -code)..... ;;
1880: 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 75 (run-n-wait fu
1890: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 llrunscript)))..
18a0: 09 09 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d ... (tests:test-
18b0: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test
18c0: 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e -id "RUNNING" "n
18d0: 2f 61 22 20 23 66 20 23 66 29 0a 09 09 09 09 20 /a" #f #f).....
18e0: 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 61 ;; if there is a
18f0: 20 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 74 runscript do it
1900: 20 66 69 72 73 74 0a 09 09 09 09 20 28 69 66 20 first..... (if
1910: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 09 09 fullrunscript...
1920: 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 .. (let ((pi
1930: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 d (process-run f
1940: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
1950: 09 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 .... (let
1960: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
1970: 09 09 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 .. (let-values..
1980: 09 09 09 09 20 20 28 28 28 70 69 64 2d 76 61 6c .... (((pid-val
1990: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
19a0: 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 t-code) (process
19b0: 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a -wait pid #t))).
19c0: 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d 6c 6f ..... (mutex-lo
19d0: 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 76 ck! m)...... (v
19e0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
19f0: 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 info 0 pid).....
1a00: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
1a10: 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 exit-info 1 exit
1a20: 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 -status)......
1a30: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 (vector-set! exi
1a40: 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f t-info 2 exit-co
1a50: 64 65 29 0a 09 09 09 09 09 20 20 28 73 65 74 21 de)...... (set!
1a60: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 rollup-status e
1a70: 78 69 74 2d 63 6f 64 65 29 20 0a 09 09 09 09 09 xit-code) ......
1a80: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
1a90: 20 6d 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 m)...... (if (
1aa0: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
1ab0: 09 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e .... (begin
1ac0: 0a 09 09 09 09 09 09 28 74 68 72 65 61 64 2d 73 .......(thread-s
1ad0: 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 28 leep! 2).......(
1ae0: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a 09 loop (+ i 1)))..
1af0: 09 09 09 09 20 20 20 20 20 20 29 29 29 29 29 0a .... ))))).
1b00: 09 09 09 09 20 3b 3b 20 74 68 65 6e 2c 20 69 66 .... ;; then, if
1b10: 20 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 6f runscript ran o
1b20: 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 65 k (or did not ge
1b30: 74 20 63 61 6c 6c 65 64 29 0a 09 09 09 09 20 3b t called)..... ;
1b40: 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 ; do all the ezs
1b50: 74 65 70 73 20 28 69 66 20 61 6e 79 29 0a 09 09 teps (if any)...
1b60: 09 09 20 28 69 66 20 65 7a 73 74 65 70 73 0a 09 .. (if ezsteps..
1b70: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
1b80: 74 65 73 74 63 6f 6e 66 69 67 20 28 72 65 61 64 testconfig (read
1b90: 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f -config (conc wo
1ba0: 72 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f rk-area "/testco
1bb0: 6e 66 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 nfig") #f #t env
1bc0: 69 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d iron-patt: "pre-
1bd0: 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 launch-env-vars"
1be0: 29 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 )) ;; FIXME??? i
1bf0: 73 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f s allow-system o
1c00: 6b 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 20 k here?......
1c10: 20 28 65 7a 73 74 65 70 73 6c 73 74 20 28 68 61 (ezstepslst (ha
1c20: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
1c30: 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 ault testconfig
1c40: 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 29 "ezsteps" '())))
1c50: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
1c60: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
1c70: 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 29 28 s? ".ezsteps"))(
1c80: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
1c90: 20 22 2e 65 7a 73 74 65 70 73 22 29 29 0a 09 09 ".ezsteps"))...
1ca0: 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 65 .. ;; if e
1cb0: 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 69 6e zsteps was defin
1cc0: 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 73 ed then we are s
1cd0: 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 6c ure to have at l
1ce0: 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 75 east one step bu
1cf0: 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a 09 t check anyway..
1d00: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ... (if (n
1d10: 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a ot (> (length ez
1d20: 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 09 stepslst) 0))...
1d30: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
1d40: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 65 7a 73 nt 0 "ERROR: ezs
1d50: 74 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 teps defined but
1d60: 20 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a ezstepslst is z
1d70: 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 09 09 ero length")....
1d80: 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 .. (let loop (
1d90: 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a 73 (ezstep (car ezs
1da0: 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 09 tepslst)).......
1db0: 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 (tal (c
1dc0: 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a dr ezstepslst)).
1dd0: 09 09 09 09 09 09 20 20 20 20 20 20 28 70 72 65 ...... (pre
1de0: 76 73 74 65 70 20 23 66 29 29 0a 09 09 09 09 09 vstep #f))......
1df0: 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 ;; check ex
1e00: 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d it-info (vector-
1e10: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
1e20: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
1e30: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
1e40: 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 09 20 28 info 1)....... (
1e50: 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 let* ((stepname
1e60: 20 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 20 (car ezstep))
1e70: 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 72 ;; do stuff to r
1e80: 75 6e 20 74 68 65 20 73 74 65 70 0a 09 09 09 09 un the step.....
1e90: 09 09 09 28 73 74 65 70 69 6e 66 6f 20 20 28 63 ...(stepinfo (c
1ea0: 61 64 72 20 65 7a 73 74 65 70 29 29 0a 09 09 09 adr ezstep))....
1eb0: 09 09 09 09 28 73 74 65 70 70 61 72 74 73 20 28 ....(stepparts (
1ec0: 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 string-match (re
1ed0: 67 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c gexp "^(\\{([^\\
1ee0: 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a }]*)\\}\\s*|)(.*
1ef0: 29 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a )$") stepinfo)).
1f00: 09 09 09 09 09 09 09 28 73 74 65 70 70 61 72 6d .......(stepparm
1f10: 73 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 s (list-ref step
1f20: 70 61 72 74 73 20 32 29 29 20 3b 3b 20 66 6f 72 parts 2)) ;; for
1f30: 20 66 75 74 75 72 65 20 75 73 65 2c 20 7b 56 41 future use, {VA
1f40: 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 74 R=1,2,3}, run st
1f50: 65 70 20 66 6f 72 20 65 61 63 68 20 0a 09 09 09 ep for each ....
1f60: 09 09 09 09 28 73 74 65 70 63 6d 64 20 20 20 28 ....(stepcmd (
1f70: 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 list-ref steppar
1f80: 74 73 20 33 29 29 0a 09 09 09 09 09 09 09 28 73 ts 3))........(s
1f90: 63 72 69 70 74 20 20 20 20 22 22 29 20 3b 20 22 cript "") ; "
1fa0: 23 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 20 #!/bin/bash\n")
1fb0: 3b 3b 20 79 65 70 2c 20 77 65 20 64 65 70 65 6e ;; yep, we depen
1fc0: 64 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 49 d on bin/bash FI
1fd0: 58 4d 45 21 21 21 0a 09 09 09 09 09 09 09 28 6c XME!!!........(l
1fe0: 6f 67 70 72 6f 2d 75 73 65 64 20 23 66 29 29 0a ogpro-used #f)).
1ff0: 09 09 09 09 09 09 20 20 20 3b 3b 20 4e 42 2f 2f ...... ;; NB//
2000: 20 63 61 6e 20 73 61 66 65 6c 79 20 61 73 73 75 can safely assu
2010: 6d 65 20 77 65 20 61 72 65 20 69 6e 20 74 65 73 me we are in tes
2020: 74 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 t-area directory
2030: 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 ....... (debug
2040: 3a 70 72 69 6e 74 20 34 20 22 65 7a 73 74 65 70 :print 4 "ezstep
2050: 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a 20 22 s:\n stepname: "
2060: 20 73 74 65 70 6e 61 6d 65 20 22 20 73 74 65 70 stepname " step
2070: 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e 66 6f info: " stepinfo
2080: 20 22 20 73 74 65 70 70 61 72 74 73 3a 20 22 20 " stepparts: "
2090: 73 74 65 70 70 61 72 74 73 0a 09 09 09 09 09 09 stepparts.......
20a0: 09 09 22 20 73 74 65 70 70 61 72 6d 73 3a 20 22 .." stepparms: "
20b0: 20 73 74 65 70 70 61 72 6d 73 20 22 20 73 74 65 stepparms " ste
20c0: 70 63 6d 64 3a 20 22 20 73 74 65 70 63 6d 64 29 pcmd: " stepcmd)
20d0: 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 ....... ......
20e0: 09 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 . (if (file-ex
20f0: 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 65 70 ists? (conc step
2100: 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 29 name ".logpro"))
2110: 28 73 65 74 21 20 6c 6f 67 70 72 6f 2d 75 73 65 (set! logpro-use
2120: 64 20 23 74 29 29 0a 0a 09 09 09 09 09 09 20 20 d #t))........
2130: 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 6f 75 ;; ;; first sou
2140: 72 63 65 20 74 68 65 20 70 72 65 76 69 6f 75 73 rce the previous
2150: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 09 environment....
2160: 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 ... ;; (let ((
2170: 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 20 22 prev-env (conc "
2180: 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 65 76 73 .ezsteps/" prevs
2190: 74 65 70 20 28 69 66 20 28 73 74 72 69 6e 67 2d tep (if (string-
21a0: 73 65 61 72 63 68 20 28 72 65 67 65 78 70 20 22 search (regexp "
21b0: 63 73 68 22 29 20 0a 09 09 09 09 09 09 20 20 20 csh") .......
21c0: 3b 3b 20 20 20 20 20 20 09 09 09 09 09 09 09 20 ;; .......
21d0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
21e0: 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c -variable "SHELL
21f0: 22 29 29 20 22 2e 63 73 68 22 20 22 2e 73 68 22 ")) ".csh" ".sh"
2200: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b ))))....... ;;
2210: 20 20 20 28 69 66 20 28 61 6e 64 20 70 72 65 76 (if (and prev
2220: 73 74 65 70 20 28 66 69 6c 65 2d 65 78 69 73 74 step (file-exist
2230: 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a 09 09 s? prev-env))...
2240: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 20 .... ;;
2250: 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 6f (set! script (co
2260: 6e 63 20 73 63 72 69 70 74 20 22 73 6f 75 72 63 nc script "sourc
2270: 65 20 22 20 70 72 65 76 2d 65 6e 76 29 29 29 29 e " prev-env))))
2280: 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 ....... ......
2290: 09 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 20 . ;; call the
22a0: 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d 74 command using mt
22b0: 5f 65 7a 73 74 65 70 0a 09 09 09 09 09 09 20 20 _ezstep.......
22c0: 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 (set! script (c
22d0: 6f 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 20 22 onc "mt_ezstep "
22e0: 20 73 74 65 70 6e 61 6d 65 20 22 20 22 20 28 69 stepname " " (i
22f0: 66 20 70 72 65 76 73 74 65 70 20 70 72 65 76 73 f prevstep prevs
2300: 74 65 70 20 22 2d 22 29 20 22 20 22 20 73 74 65 tep "-") " " ste
2310: 70 63 6d 64 29 29 0a 0a 09 09 09 09 09 09 20 20 pcmd))........
2320: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
2330: 22 73 63 72 69 70 74 3a 20 22 20 73 63 72 69 70 "script: " scrip
2340: 74 29 0a 0a 09 09 09 09 09 09 20 20 20 28 63 64 t)........ (cd
2350: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
2360: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
2370: 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 tus! #f test-id
2380: 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 stepname "start"
2390: 20 22 2d 22 20 23 66 20 23 66 29 0a 09 09 09 09 "-" #f #f).....
23a0: 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 6e .. ;; now laun
23b0: 63 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 74 ch....... (let
23c0: 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d ((pid (process-
23d0: 72 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 09 run script)))...
23e0: 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 72 .... (let pr
23f0: 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 29 ocessloop ((i 0)
2400: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
2410: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 let-values (((pi
2420: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
2430: 73 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 6f s exit-code)(pro
2440: 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 cess-wait pid #t
2450: 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 )))......... (
2460: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 mutex-lock! m)..
2470: 09 09 09 09 09 09 09 20 20 20 28 76 65 63 74 6f ....... (vecto
2480: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
2490: 20 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 09 0 pid).........
24a0: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
24b0: 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 exit-info 1 exit
24c0: 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 -status)........
24d0: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
24e0: 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 exit-info 2 exi
24f0: 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 09 t-code).........
2500: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
2510: 21 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 20 ! m).........
2520: 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c (if (eq? pid-val
2530: 20 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 0).........
2540: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 (begin.......
2550: 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ... (thread-slee
2560: 70 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 20 p! 2)..........
2570: 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b 20 (processloop (+
2580: 69 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 09 i 1)))).........
2590: 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 )).
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25c0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
25d0: 28 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f 72 ((exinfo (vector
25e0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
25f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2630: 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 6f ogfna (if logpro
2640: 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 70 -used (conc step
2650: 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 22 name ".html") ""
2660: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 ))).......
2670: 20 3b 3b 20 74 65 73 74 69 6e 67 20 69 66 20 70 ;; testing if p
2680: 72 6f 63 65 64 75 72 65 73 20 63 61 6c 6c 65 64 rocedures called
2690: 20 69 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 6c in a remote cal
26a0: 6c 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d 73 l cause problems
26b0: 20 28 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f 20 (ans: no or so
26c0: 49 20 73 75 73 70 65 63 74 29 0a 09 09 09 09 09 I suspect)......
26d0: 09 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d . (cdb:rem
26e0: 6f 74 65 2d 72 75 6e 20 64 62 3a 74 65 73 74 73 ote-run db:tests
26f0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
2700: 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e #f test-id stepn
2710: 61 6d 65 20 22 65 6e 64 22 20 65 78 69 6e 66 6f ame "end" exinfo
2720: 20 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 09 09 #f logfna))....
2730: 09 09 09 20 20 20 20 20 28 69 66 20 6c 6f 67 70 ... (if logp
2740: 72 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 09 20 ro-used........
2750: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f (cdb:test-set-lo
2760: 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 20 g! *runremote*
2770: 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 test-id (conc st
2780: 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 epname ".html"))
2790: 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 )....... ;;
27a0: 73 65 74 20 74 68 65 20 74 65 73 74 20 66 69 6e set the test fin
27b0: 61 6c 20 73 74 61 74 75 73 0a 09 09 09 09 09 09 al status.......
27c0: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 68 69 (let* ((thi
27d0: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 28 63 s-step-status (c
27e0: 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 ond..........
27f0: 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f 20 28 ((and (eq? (
2800: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
2810: 69 6e 66 6f 20 32 29 20 32 29 20 6c 6f 67 70 72 info 2) 2) logpr
2820: 6f 2d 75 73 65 64 29 20 27 77 61 72 6e 29 0a 09 o-used) 'warn)..
2830: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2840: 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 (eq? (vector-ref
2850: 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 29 exit-info 2) 0)
2860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2870: 20 20 20 27 70 61 73 73 29 0a 09 09 09 09 09 09 'pass).......
2880: 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 ... (else
2890: 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 09 09 'fail)))........
28a0: 20 20 20 20 28 6f 76 65 72 61 6c 6c 2d 73 74 61 (overall-sta
28b0: 74 75 73 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 tus (cond.....
28c0: 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 ..... ((eq
28d0: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
28e0: 32 29 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 2) 'warn).......
28f0: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
2900: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 rollup-status 0)
2910: 20 27 70 61 73 73 29 0a 09 09 09 09 09 09 09 09 'pass).........
2920: 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 . (else 'f
2930: 61 69 6c 29 29 29 0a 09 09 09 09 09 09 09 20 20 ail)))........
2940: 20 20 28 6e 65 78 74 2d 73 74 61 74 75 73 20 20 (next-status
2950: 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 09 09 (cond ......
2960: 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f .... ((eq?
2970: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 overall-status
2980: 27 70 61 73 73 29 20 74 68 69 73 2d 73 74 65 70 'pass) this-step
2990: 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 -status)........
29a0: 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 6f .. ((eq? o
29b0: 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 77 verall-status 'w
29c0: 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 09 28 arn)...........(
29d0: 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 65 if (eq? this-ste
29e0: 70 2d 73 74 61 74 75 73 20 27 66 61 69 6c 29 20 p-status 'fail)
29f0: 27 66 61 69 6c 20 27 77 61 72 6e 29 29 0a 09 09 'fail 'warn))...
2a00: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 ....... (e
2a10: 6c 73 65 20 27 66 61 69 6c 29 29 29 29 0a 09 09 lse 'fail))))...
2a20: 09 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 .... (debu
2a30: 67 3a 70 72 69 6e 74 20 34 20 22 45 78 69 74 20 g:print 4 "Exit
2a40: 76 61 6c 75 65 20 72 65 63 65 69 76 65 64 3a 20 value received:
2a50: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 " (vector-ref ex
2a60: 69 74 2d 69 6e 66 6f 20 32 29 20 22 20 6c 6f 67 it-info 2) " log
2a70: 70 72 6f 2d 75 73 65 64 3a 20 22 20 6c 6f 67 70 pro-used: " logp
2a80: 72 6f 2d 75 73 65 64 20 0a 09 09 09 09 09 09 09 ro-used ........
2a90: 09 20 20 20 20 22 20 74 68 69 73 2d 73 74 65 70 . " this-step
2aa0: 2d 73 74 61 74 75 73 3a 20 22 20 74 68 69 73 2d -status: " this-
2ab0: 73 74 65 70 2d 73 74 61 74 75 73 20 22 20 6f 76 step-status " ov
2ac0: 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a 20 22 20 erall-status: "
2ad0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 0a overall-status .
2ae0: 09 09 09 09 09 09 09 09 20 20 20 20 22 20 6e 65 ........ " ne
2af0: 78 74 2d 73 74 61 74 75 73 3a 20 22 20 6e 65 78 xt-status: " nex
2b00: 74 2d 73 74 61 74 75 73 20 22 20 72 6f 6c 6c 75 t-status " rollu
2b10: 70 2d 73 74 61 74 75 73 3a 20 22 20 72 6f 6c 6c p-status: " roll
2b20: 75 70 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 up-status)......
2b30: 09 20 20 20 20 20 20 20 28 63 61 73 65 20 6e 65 . (case ne
2b40: 78 74 2d 73 74 61 74 75 73 0a 09 09 09 09 09 09 xt-status.......
2b50: 09 20 28 28 77 61 72 6e 29 0a 09 09 09 09 09 09 . ((warn).......
2b60: 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d . (set! rollup-
2b70: 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 09 09 status 2).......
2b80: 09 20 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d . ;; NB// test-
2b90: 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 set-status! does
2ba0: 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 rdb calls under
2bb0: 20 74 68 65 20 68 6f 6f 64 0a 09 09 09 09 09 09 the hood.......
2bc0: 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 . (tests:test-s
2bd0: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
2be0: 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 57 41 id "RUNNING" "WA
2bf0: 52 4e 22 20 0a 09 09 09 09 09 09 09 09 09 20 20 RN" ..........
2c00: 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 (if (eq? this-st
2c10: 65 70 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 ep-status 'warn)
2c20: 20 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 6e 67 "Logpro warning
2c30: 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 found" #f).....
2c40: 09 09 09 09 09 20 20 23 66 29 29 0a 09 09 09 09 ..... #f)).....
2c50: 09 09 09 20 28 28 70 61 73 73 29 0a 09 09 09 09 ... ((pass).....
2c60: 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 ... (tests:test
2c70: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 -set-status! tes
2c80: 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 t-id "RUNNING" "
2c90: 50 41 53 53 22 20 23 66 20 23 66 29 29 0a 09 09 PASS" #f #f))...
2ca0: 09 09 09 09 09 20 28 65 6c 73 65 20 3b 3b 20 27 ..... (else ;; '
2cb0: 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 73 fail........ (s
2cc0: 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 et! rollup-statu
2cd0: 73 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 66 61 s 1) ;; force fa
2ce0: 69 6c 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 il........ (tes
2cf0: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
2d00: 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e us! test-id "RUN
2d10: 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 28 63 6f NING" "FAIL" (co
2d20: 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 73 74 nc "Failed at st
2d30: 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 20 23 ep " stepname) #
2d40: 66 29 0a 09 09 09 09 09 09 09 20 20 29 29 29 29 f)........ ))))
2d50: 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 28 61 ....... (if (a
2d60: 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 nd (steprun-good
2d70: 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 76 ? logpro-used (v
2d80: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
2d90: 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 09 09 20 nfo 2))........
2da0: 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 (not (null? t
2db0: 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 al))).......
2dc0: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
2dd0: 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 74 65 l) (cdr tal) ste
2de0: 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 20 pname))).......
2df0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
2e00: 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 6f 72 WARNING: a prior
2e10: 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 73 74 step failed, st
2e20: 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a 73 74 opping at " ezst
2e30: 65 70 29 29 29 29 29 29 29 29 0a 09 09 20 28 6d ep))))))))... (m
2e40: 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d onitorjob (lam
2e50: 62 64 61 20 28 29 0a 09 09 09 09 20 28 6c 65 74 bda ()..... (let
2e60: 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 * ((start-second
2e70: 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e s (current-secon
2e80: 64 73 29 29 0a 09 09 09 09 09 28 63 61 6c 63 2d ds))......(calc-
2e90: 6d 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 minutes (lambda
2ea0: 20 28 29 0a 09 09 09 09 09 09 09 20 28 69 6e 65 ()........ (ine
2eb0: 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 09 09 xact->exact ....
2ec0: 09 09 09 09 20 20 28 72 6f 75 6e 64 20 0a 09 09 .... (round ...
2ed0: 09 09 09 09 09 20 20 20 28 2d 20 0a 09 09 09 09 ..... (- .....
2ee0: 09 09 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d ... (current-
2ef0: 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 09 09 seconds) .......
2f00: 09 20 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e . start-secon
2f10: 64 73 29 29 29 29 29 0a 09 09 09 09 09 28 6b 69 ds)))))......(ki
2f20: 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 09 09 ll-tries 0))....
2f30: 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 . (let loop ((
2f40: 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d minutes (calc-
2f50: 6d 69 6e 75 74 65 73 29 29 29 0a 09 09 09 09 20 minutes))).....
2f60: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 (begin.....
2f70: 20 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c (set! kill
2f80: 2d 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 74 2d -job? (test-get-
2f90: 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 74 65 73 kill-request tes
2fa0: 74 2d 69 64 29 29 20 3b 3b 20 72 75 6e 2d 69 64 t-id)) ;; run-id
2fb0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 test-name itemd
2fc0: 61 74 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 at)).....
2fd0: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
2fe0: 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e test-set-meta-in
2ff0: 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 fo #f test-id ru
3000: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
3010: 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 73 29 0a temdat minutes).
3020: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 6b .... (if k
3030: 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 20 ill-job? ......
3040: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 (begin......
3050: 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 (mutex-lock!
3060: 6d 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 m)...... (le
3070: 74 2a 20 28 28 70 69 64 20 28 76 65 63 74 6f 72 t* ((pid (vector
3080: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 -ref exit-info 0
3090: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 )))......
30a0: 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 (if (number? pid
30b0: 29 0a 09 09 09 09 09 09 20 20 20 28 62 65 67 69 )....... (begi
30c0: 6e 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 65 n....... (de
30d0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
30e0: 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 NING: Request re
30f0: 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a ceived to kill j
3100: 6f 62 20 28 61 74 74 65 6d 70 74 20 23 20 22 20 ob (attempt # "
3110: 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 0a kill-tries ")").
3120: 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let
3130: 28 28 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64 ((processes (cmd
3140: 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 -run->list (conc
3150: 20 22 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 "pgrep -l -P "
3160: 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 pid)))).......
3170: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a (for-each .
3180: 09 09 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 .......(lambda (
3190: 70 29 0a 09 09 09 09 09 09 09 20 20 28 6c 65 74 p)........ (let
31a0: 2a 20 28 28 70 61 72 74 73 20 20 28 73 74 72 69 * ((parts (stri
31b0: 6e 67 2d 73 70 6c 69 74 20 70 29 29 0a 09 09 09 ng-split p))....
31c0: 09 09 09 09 09 20 28 70 2d 69 64 20 20 20 28 69 ..... (p-id (i
31d0: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 f (> (length par
31e0: 74 73 29 20 30 29 0a 09 09 09 09 09 09 09 09 09 ts) 0)..........
31f0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (string->nu
3200: 6d 62 65 72 20 28 63 61 72 20 70 61 72 74 73 29 mber (car parts)
3210: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
3220: 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 #f)))........
3230: 20 28 69 66 20 70 2d 69 64 0a 09 09 09 09 09 09 (if p-id.......
3240: 09 09 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 ..(begin........
3250: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
3260: 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 63 61 0 "Killing " (ca
3270: 64 72 20 70 61 72 74 73 29 20 22 3b 20 6b 69 6c dr parts) "; kil
3280: 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 0a 09 09 l -9 " p-id)...
3290: 09 09 09 09 09 09 20 20 28 73 79 73 74 65 6d 20 ...... (system
32a0: 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 (conc "kill -9 "
32b0: 20 70 2d 69 64 29 29 29 29 29 29 0a 09 09 09 09 p-id)))))).....
32c0: 09 09 09 28 63 61 72 20 70 72 6f 63 65 73 73 65 ...(car processe
32d0: 73 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 s)).......
32e0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
32f0: 6b 69 6c 6c 20 2d 39 20 2d 22 20 70 69 64 29 29 kill -9 -" pid))
3300: 29 29 0a 09 09 09 09 09 09 20 20 20 28 62 65 67 ))....... (beg
3310: 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 in....... (d
3320: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
3330: 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72 RNING: Request r
3340: 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 eceived to kill
3350: 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 6d 20 job but problem
3360: 77 69 74 68 20 70 72 6f 63 65 73 73 2c 20 61 74 with process, at
3370: 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c tempting to kill
3380: 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 73 73 manager process
3390: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 74 ")....... (t
33a0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
33b0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 4b atus! test-id "K
33c0: 49 4c 4c 45 44 22 20 20 22 46 41 49 4c 22 0a 09 ILLED" "FAIL"..
33d0: 09 09 09 09 09 09 09 20 20 20 20 20 28 61 72 67 ....... (arg
33e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 s:get-arg "-m")
33f0: 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 #f)....... (
3400: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
3410: 21 20 74 64 62 29 0a 09 09 09 09 09 09 20 20 20 ! tdb).......
3420: 20 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 09 (exit 1))))...
3430: 09 09 09 20 20 20 20 20 28 73 65 74 21 20 6b 69 ... (set! ki
3440: 6c 6c 2d 74 72 69 65 73 20 28 2b 20 31 20 6b 69 ll-tries (+ 1 ki
3450: 6c 6c 2d 74 72 69 65 73 29 29 0a 09 09 09 09 09 ll-tries))......
3460: 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f (mutex-unlo
3470: 63 6b 21 20 6d 29 29 29 0a 09 09 09 09 20 20 20 ck! m))).....
3480: 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a ;; (sqlite3:
3490: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 finalize! db)...
34a0: 09 09 20 20 20 20 20 20 20 28 74 68 72 65 61 64 .. (thread
34b0: 2d 73 6c 65 65 70 21 20 28 2b 20 31 30 20 28 72 -sleep! (+ 10 (r
34c0: 61 6e 64 6f 6d 20 31 30 29 29 29 20 3b 3b 20 61 andom 10))) ;; a
34d0: 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 dd some jitter t
34e0: 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 o the call home
34f0: 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f time to spread o
3500: 75 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73 ut the db access
3510: 65 73 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c es..... (l
3520: 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 oop (calc-minute
3530: 73 29 29 29 29 29 29 29 0a 09 09 20 28 74 68 31 s)))))))... (th1
3540: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
3550: 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f thread monitorjo
3560: 62 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 20 b))... (th2
3570: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
3580: 64 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 20 d runit)))..
3590: 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 (set! job-thread
35a0: 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 th2).. (thre
35b0: 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 ad-start! th1)..
35c0: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
35d0: 74 21 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 t! th2).. (th
35e0: 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a read-join! th2).
35f0: 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b . (mutex-lock
3600: 21 20 6d 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 ! m).. (let*
3610: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 ((item-path (ite
3620: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
3630: 6d 64 61 74 29 29 0a 09 09 20 20 20 28 74 65 73 mdat))... (tes
3640: 74 69 6e 66 6f 20 20 28 63 64 62 3a 67 65 74 2d tinfo (cdb:get-
3650: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 test-info-by-id
3660: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 *runremote* test
3670: 2d 69 64 29 29 29 20 3b 3b 20 29 29 20 3b 3b 20 -id))) ;; )) ;;
3680: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
3690: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 item-path)))..
36a0: 20 20 20 20 20 3b 3b 20 41 6d 20 49 20 63 6f 6d ;; Am I com
36b0: 70 6c 65 74 65 64 3f 0a 09 20 20 20 20 20 20 28 pleted?.. (
36c0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
36d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
36e0: 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 43 4f te testinfo) "CO
36f0: 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 28 MPLETED"))... (
3700: 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 begin... (deb
3710: 75 67 3a 70 72 69 6e 74 20 32 20 22 54 65 73 74 ug:print 2 "Test
3720: 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 NOT logged as C
3730: 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 OMPLETED, (state
3740: 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d =" (db:test-get-
3750: 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 state testinfo)
3760: 22 29 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 "), updating res
3770: 75 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 74 61 74 ult, rollup-stat
3780: 75 73 20 69 73 20 22 20 72 6f 6c 6c 75 70 2d 73 us is " rollup-s
3790: 74 61 74 75 73 29 0a 09 09 20 20 20 20 28 74 65 tatus)... (te
37a0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
37b0: 74 75 73 21 20 74 65 73 74 2d 69 64 20 0a 09 09 tus! test-id ...
37c0: 09 09 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a .. (if kill-j
37d0: 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 4f ob? "KILLED" "CO
37e0: 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 09 20 20 MPLETED").....
37f0: 20 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 (cond.....
3800: 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 ((not (vector-r
3810: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 ef exit-info 1))
3820: 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 20 "FAIL") ;; job
3830: 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 0a 09 09 failed to run...
3840: 09 09 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c .. ((eq? rol
3850: 6c 75 70 2d 73 74 61 74 75 73 20 30 29 0a 09 09 lup-status 0)...
3860: 09 09 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 .. ;; if th
3870: 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 e current status
3880: 20 69 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 is AUTO the def
3890: 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c er to the calcul
38a0: 61 74 65 64 20 76 61 6c 75 65 20 28 69 2e 65 2e ated value (i.e.
38b0: 20 6c 65 61 76 65 20 74 68 69 73 20 41 55 54 4f leave this AUTO
38c0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 )..... (if
38d0: 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 (equal? (db:test
38e0: 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
38f0: 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 info) "AUTO") "A
3900: 55 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 09 UTO" "PASS"))...
3910: 09 09 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c .. ((eq? rol
3920: 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 22 46 lup-status 1) "F
3930: 41 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 28 AIL")..... (
3940: 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 (eq? rollup-stat
3950: 75 73 20 32 29 0a 09 09 09 09 20 20 20 20 20 20 us 2).....
3960: 3b 3b 20 69 66 20 74 68 65 20 63 75 72 72 65 6e ;; if the curren
3970: 74 20 73 74 61 74 75 73 20 69 73 20 41 55 54 4f t status is AUTO
3980: 20 74 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 the defer to th
3990: 65 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c e calculated val
39a0: 75 65 20 62 75 74 20 71 75 61 6c 69 66 79 20 28 ue but qualify (
39b0: 69 2e 65 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 i.e. make this A
39c0: 55 54 4f 2d 57 41 52 4e 29 0a 09 09 09 09 20 20 UTO-WARN).....
39d0: 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 (if (equal?
39e0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
39f0: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 tus testinfo) "A
3a00: 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 41 52 4e UTO") "AUTO-WARN
3a10: 22 20 22 57 41 52 4e 22 29 29 0a 09 09 09 09 20 " "WARN")).....
3a20: 20 20 20 20 28 65 6c 73 65 20 22 46 41 49 4c 22 (else "FAIL"
3a30: 29 29 0a 09 09 09 09 20 20 20 20 28 61 72 67 73 ))..... (args
3a40: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 :get-arg "-m") #
3a50: 66 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 f))).. ;; f
3a60: 6f 72 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 or automated cre
3a70: 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c ation of the rol
3a80: 6c 75 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 lup html file th
3a90: 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 is is a good pla
3aa0: 63 65 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 ce..... (if
3ab0: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 (not (equal? it
3ac0: 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 em-path ""))...
3ad0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
3ae0: 20 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 tests:summarize
3af0: 2d 69 74 65 6d 73 20 23 66 20 72 75 6e 2d 69 64 -items #f run-id
3b00: 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 test-name #f))
3b10: 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d ;; don't force -
3b20: 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 20 just update if
3b30: 6e 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 no.. )..
3b40: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
3b50: 6d 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 65 63 m).. ;; (exec
3b60: 2d 72 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 -results (cmd-ru
3b70: 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 n->list fullruns
3b80: 63 72 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 cript)) ;; (lis
3b90: 74 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 t ">" (conc test
3ba0: 2d 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 -name "-run.log"
3bb0: 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 73 75 )))).. ;; (su
3bc0: 63 63 65 73 73 20 20 20 20 20 20 65 78 65 63 2d ccess exec-
3bd0: 72 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 results)) ;; (eq
3be0: 3f 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 ? (cadr exec-res
3bf0: 75 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 ults) 0)))..
3c00: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
3c10: 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e Output from runn
3c20: 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 ing " fullrunscr
3c30: 69 70 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 ipt ", pid " (ve
3c40: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3c50: 66 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 fo 0) " in work
3c60: 61 72 65 61 20 22 20 0a 09 09 09 20 77 6f 72 6b area " .... work
3c70: 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e -area ":\n====\n
3c80: 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 exit code " (ve
3c90: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3ca0: 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d fo 2) "\n" "====
3cb0: 5c 6e 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 \n").. ;; (sq
3cc0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
3cd0: 64 62 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c db).. ;; (sql
3ce0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 ite3:finalize! t
3cf0: 64 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f db).. (if (no
3d00: 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 t (vector-ref ex
3d10: 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 28 65 it-info 1))...(e
3d20: 78 69 74 20 34 29 29 29 29 29 29 29 0a 0a 3b 3b xit 4)))))))..;;
3d30: 20 73 65 74 20 75 70 20 74 68 65 20 76 65 72 79 set up the very
3d40: 20 62 61 73 69 63 73 20 6e 65 65 64 65 64 20 66 basics needed f
3d50: 6f 72 20 64 6f 69 6e 67 20 61 6e 79 74 68 69 6e or doing anythin
3d60: 67 20 68 65 72 65 2e 0a 28 64 65 66 69 6e 65 20 g here..(define
3d70: 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 0a (setup-for-run).
3d80: 20 20 3b 3b 20 77 6f 75 6c 64 20 73 65 74 20 76 ;; would set v
3d90: 61 6c 75 65 73 20 66 6f 72 20 4b 45 59 53 20 69 alues for KEYS i
3da0: 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e n the environmen
3db0: 74 20 68 65 72 65 20 66 6f 72 20 62 65 74 74 65 t here for bette
3dc0: 72 20 73 75 70 70 6f 72 74 20 6f 66 20 65 6e 76 r support of env
3dd0: 2d 6f 76 65 72 72 69 64 65 20 62 75 74 20 0a 20 -override but .
3de0: 20 3b 3b 20 68 61 76 65 20 63 68 69 63 6b 65 6e ;; have chicken
3df0: 2f 65 67 67 20 73 63 65 6e 61 72 69 6f 2e 20 6e /egg scenario. n
3e00: 65 65 64 20 74 6f 20 72 65 61 64 20 6d 65 67 61 eed to read mega
3e10: 74 65 73 74 2e 63 6f 6e 66 69 67 20 74 68 65 6e test.config then
3e20: 20 72 65 61 64 20 69 74 20 61 67 61 69 6e 2e 20 read it again.
3e30: 47 6f 69 6e 67 20 74 6f 20 0a 20 20 3b 3b 20 70 Going to . ;; p
3e40: 61 73 73 20 6f 6e 20 74 68 61 74 20 69 64 65 61 ass on that idea
3e50: 20 66 6f 72 20 6e 6f 77 0a 20 20 3b 3b 20 73 70 for now. ;; sp
3e60: 65 63 69 61 6c 20 63 61 73 65 0a 20 20 28 73 65 ecial case. (se
3e70: 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 t! *configinfo*
3e80: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c
3e90: 6f 6e 66 69 67 20 0a 09 09 20 20 20 20 20 20 28 onfig ... (
3ea0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
3eb0: 20 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 67 73 "-config")(args
3ec0: 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 :get-arg "-confi
3ed0: 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f g") "megatest.co
3ee0: 6e 66 69 67 22 29 0a 09 09 20 20 20 20 20 20 65 nfig")... e
3ef0: 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e nviron-patt: "en
3f00: 76 2d 6f 76 65 72 72 69 64 65 22 0a 09 09 20 20 v-override"...
3f10: 20 20 20 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 given-toppat
3f20: 68 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d h: (get-environm
3f30: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
3f40: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
3f50: 0a 09 09 20 20 20 20 20 20 70 61 74 68 65 6e 76 ... pathenv
3f60: 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 var: "MT_RUN_ARE
3f70: 41 5f 48 4f 4d 45 22 29 29 0a 20 20 28 73 65 74 A_HOME")). (set
3f80: 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 28 ! *configdat* (
3f90: 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 if (car *configi
3fa0: 6e 66 6f 2a 29 28 63 61 72 20 2a 63 6f 6e 66 69 nfo*)(car *confi
3fb0: 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 ginfo*) #f)). (
3fc0: 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 set! *toppath*
3fd0: 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 (if (car *conf
3fe0: 69 67 69 6e 66 6f 2a 29 28 63 61 64 72 20 2a 63 iginfo*)(cadr *c
3ff0: 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 onfiginfo*) #f))
4000: 0a 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a . (if *toppath*
4010: 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 . (setenv "
4020: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
4030: 22 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b 20 " *toppath*) ;;
4040: 74 6f 20 62 65 20 64 65 70 72 65 63 61 74 65 64 to be deprecated
4050: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
4060: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 66 61 int 0 "ERROR: fa
4070: 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 68 65 iled to find the
4080: 20 74 6f 70 20 70 61 74 68 20 74 6f 20 79 6f 75 top path to you
4090: 72 20 72 75 6e 20 73 65 74 75 70 2e 22 29 29 0a r run setup.")).
40a0: 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 0a 28 64 *toppath*)..(d
40b0: 65 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d efine (get-best-
40c0: 64 69 73 6b 20 63 6f 6e 66 64 61 74 29 0a 20 20 disk confdat).
40d0: 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 20 20 (let* ((disks
40e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
40f0: 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 /default confdat
4100: 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 20 "disks" #f))..
4110: 28 62 65 73 74 20 20 20 20 20 23 66 29 0a 09 20 (best #f)..
4120: 28 62 65 73 74 73 69 7a 65 20 30 29 29 0a 20 20 (bestsize 0)).
4130: 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 28 66 (if disks ..(f
4140: 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 or-each .. (lamb
4150: 64 61 20 28 64 69 73 6b 2d 6e 75 6d 29 0a 09 20 da (disk-num)..
4160: 20 20 28 6c 65 74 2a 20 28 28 64 69 72 70 61 74 (let* ((dirpat
4170: 68 20 20 20 20 28 63 61 64 72 20 28 61 73 73 6f h (cadr (asso
4180: 63 20 64 69 73 6b 2d 6e 75 6d 20 64 69 73 6b 73 c disk-num disks
4190: 29 29 29 0a 09 09 20 20 28 66 72 65 65 73 70 63 )))... (freespc
41a0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 64 69 (if (and (di
41b0: 72 65 63 74 6f 72 79 3f 20 64 69 72 70 61 74 68 rectory? dirpath
41c0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 66 69 )..... (fi
41d0: 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f le-write-access?
41e0: 20 64 69 72 70 61 74 68 29 29 0a 09 09 09 09 20 dirpath)).....
41f0: 20 28 67 65 74 2d 64 66 20 64 69 72 70 61 74 68 (get-df dirpath
4200: 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 )..... (begin..
4210: 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
4220: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
4230: 70 61 74 68 20 22 20 64 69 72 70 61 74 68 20 22 path " dirpath "
4240: 20 69 6e 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 in [disks] sect
4250: 69 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 20 6f 72 ion not valid or
4260: 20 77 72 69 74 61 62 6c 65 22 29 0a 09 09 09 09 writable").....
4270: 20 20 20 20 30 29 29 29 29 0a 09 20 20 20 20 20 0))))..
4280: 28 69 66 20 28 3e 20 66 72 65 65 73 70 63 20 62 (if (> freespc b
4290: 65 73 74 73 69 7a 65 29 0a 09 09 20 28 62 65 67 estsize)... (beg
42a0: 69 6e 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 in... (set! be
42b0: 73 74 20 20 20 20 20 64 69 72 70 61 74 68 29 0a st dirpath).
42c0: 09 09 20 20 20 28 73 65 74 21 20 62 65 73 74 73 .. (set! bests
42d0: 69 7a 65 20 66 72 65 65 73 70 63 29 29 29 29 29 ize freespc)))))
42e0: 0a 09 20 28 6d 61 70 20 63 61 72 20 64 69 73 6b .. (map car disk
42f0: 73 29 29 29 0a 20 20 20 20 28 69 66 20 62 65 73 s))). (if bes
4300: 74 0a 09 62 65 73 74 0a 09 28 62 65 67 69 6e 0a t..best..(begin.
4310: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
4320: 30 20 22 45 52 52 4f 52 3a 20 4e 6f 20 76 61 6c 0 "ERROR: No val
4330: 69 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 69 id disks found i
4340: 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 n megatest.confi
4350: 67 2e 20 50 6c 65 61 73 65 20 61 64 64 20 73 6f g. Please add so
4360: 6d 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 6b me to your [disk
4370: 73 5d 20 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 s] section")..
4380: 28 65 78 69 74 20 31 29 29 29 29 29 0a 0a 3b 3b (exit 1)))))..;;
4390: 20 44 65 73 69 72 65 64 20 64 69 72 65 63 74 6f Desired directo
43a0: 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b 3b ry structure:.;;
43b0: 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d .;; <linkdir> -
43c0: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
43d0: 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 20 tname> -..;;
43e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 |.;;
4410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4420: 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 20 v.;;
4430: 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 61 <rundir> - <ta
4440: 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 73 rget> - <tes
4450: 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 6d tname> -|- <item
4460: 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 path(s)>.;;.;;
4470: 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 65 dir stored in te
4480: 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c st is:.;; .;; <
4490: 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 linkdir> - <targ
44a0: 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e et> - <testname>
44b0: 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 [ - <itempath>
44c0: 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 ].;; .;; All log
44d0: 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f 75 file links shou
44e0: 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 6c ld be stored rel
44f0: 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f 70 ative to the top
4500: 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b 3b of link path.;;
4510: 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 2d .;; <target> -
4520: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
4530: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b 3b <itempath> ] .;;
4540: 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 65 .(define (create
4550: 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 -work-area db ru
4560: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
4570: 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d t-src-path disk-
4580: 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 path testname it
4590: 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 emdat). (let* (
45a0: 28 72 75 6e 2d 69 6e 66 6f 20 28 63 64 62 3a 72 (run-info (cdb:r
45b0: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
45c0: 2d 72 75 6e 2d 69 6e 66 6f 20 23 66 20 72 75 6e -run-info #f run
45d0: 2d 69 64 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 -id)).. (item-pa
45e0: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
45f0: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
4600: 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a 67 65 (runname (db:ge
4610: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
4620: 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 r (db:get-row ru
4630: 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 n-info)......
4640: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
4650: 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 un-info)......
4660: 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 3b "runname")).. ;
4670: 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 ; convert back t
4680: 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 o db: from rdb:
4690: 2d 20 74 68 69 73 20 69 73 20 61 6c 77 61 79 73 - this is always
46a0: 20 72 75 6e 20 61 74 20 73 65 72 76 65 72 20 65 run at server e
46b0: 6e 64 0a 09 20 28 6b 65 79 2d 76 61 6c 73 20 28 nd.. (key-vals (
46c0: 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cdb:remote-run d
46d0: 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 23 b:get-key-vals #
46e0: 66 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 74 61 f run-id)).. (ta
46f0: 72 67 65 74 20 20 20 28 73 74 72 69 6e 67 2d 69 rget (string-i
4700: 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 2d 76 ntersperse key-v
4710: 61 6c 73 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f als "/"))... (no
4720: 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 71 75 t-iterated (equ
4730: 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 al? "" item-path
4740: 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 ))... ;; all tes
4750: 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 ts are found at
4760: 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 <rundir>/test-ba
4770: 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f se or <linkdir>/
4780: 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 test-base.. (tes
4790: 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 ttop-base (conc
47a0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
47b0: 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 me "/" testname)
47c0: 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 ).. (test-base
47d0: 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d (conc testtop-
47e0: 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 base (if not-ite
47f0: 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 rated "" "/") it
4800: 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 em-path))... ;;
4810: 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 nb// if itempath
4820: 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 is not "" then
4830: 69 74 20 69 73 20 70 72 65 66 69 78 65 64 20 77 it is prefixed w
4840: 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 ith "/".. (topte
4850: 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 st-path (conc di
4860: 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 sk-path "/" test
4870: 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 74 65 top-base)).. (te
4880: 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e 63 st-path (conc
4890: 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 disk-path "/" t
48a0: 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 3b 3b est-base))... ;;
48b0: 20 65 6e 73 75 72 65 20 74 68 69 73 20 65 78 69 ensure this exi
48c0: 73 74 73 20 66 69 72 73 74 20 61 73 20 6c 69 6e sts first as lin
48d0: 6b 73 20 74 6f 20 73 75 62 74 65 73 74 73 20 6d ks to subtests m
48e0: 75 73 74 20 62 65 20 63 72 65 61 74 65 64 20 74 ust be created t
48f0: 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 65 65 here.. (linktree
4900: 20 20 28 6c 65 74 20 28 28 72 64 20 28 63 6f 6e (let ((rd (con
4910: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
4920: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
4930: 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 20 linktree")))...
4940: 20 20 20 20 20 28 69 66 20 72 64 20 72 64 20 28 (if rd rd (
4950: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 conc *toppath* "
4960: 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 28 6c /runs"))))... (l
4970: 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 6c 69 nkbase (conc li
4980: 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 nktree "/" targe
4990: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a t "/" runname)).
49a0: 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 6f 6e . (lnkpath (con
49b0: 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 74 65 c lnkbase "/" te
49c0: 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 stname)).. (lnkp
49d0: 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 athf (conc lnkpa
49e0: 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 th (if not-itera
49f0: 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d ted "" "/") item
4a00: 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 3b 3b -path))).. ;;
4a10: 20 55 70 64 61 74 65 20 74 68 65 20 72 75 6e 64 Update the rund
4a20: 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 20 74 ir path in the t
4a30: 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 61 est record for a
4a40: 6c 6c 0a 20 20 20 20 28 63 64 62 3a 74 65 73 74 ll. (cdb:test
4a50: 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d 74 -set-rundir-by-t
4a60: 65 73 74 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 est-id *runremot
4a70: 65 2a 20 74 65 73 74 2d 69 64 20 6c 6e 6b 70 61 e* test-id lnkpa
4a80: 74 68 66 29 0a 0a 20 20 20 20 28 64 65 62 75 67 thf).. (debug
4a90: 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 5c :print 2 "INFO:\
4aa0: 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d n lnkbase=
4ab0: 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 " lnkbase "\n
4ac0: 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e lnkpath=" ln
4ad0: 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 kpath "\n topte
4ae0: 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 st-path=" toptes
4af0: 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 t-path "\n t
4b00: 65 73 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d est-path=" test-
4b10: 70 61 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e path). (if (n
4b20: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
4b30: 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 linktree))..(be
4b40: 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 gin.. (debug:pr
4b50: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
4b60: 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 6e 6f 74 linktree did not
4b70: 20 65 78 69 73 74 21 20 43 72 65 61 74 69 6e 67 exist! Creating
4b80: 20 69 74 20 6e 6f 77 20 61 74 20 22 20 6c 69 6e it now at " lin
4b90: 6b 74 72 65 65 29 0a 09 20 20 28 63 72 65 61 74 ktree).. (creat
4ba0: 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b e-directory link
4bb0: 74 72 65 65 20 23 74 29 29 29 20 3b 3b 20 28 73 tree #t))) ;; (s
4bc0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 ystem (conc "mkd
4bd0: 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 65 65 ir -p " linktree
4be0: 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 65 61 )))). ;; crea
4bf0: 74 65 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 te the directory
4c00: 20 66 6f 72 20 74 68 65 20 74 65 73 74 73 20 64 for the tests d
4c10: 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 20 69 ir links, this i
4c20: 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 74 74 s needed no matt
4c30: 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 20 28 er what.... (
4c40: 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f if (not (directo
4c50: 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 ry-exists? lnkba
4c60: 73 65 29 29 0a 09 28 63 72 65 61 74 65 2d 64 69 se))..(create-di
4c70: 72 65 63 74 6f 72 79 20 6c 6e 6b 62 61 73 65 20 rectory lnkbase
4c80: 23 74 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b #t)). . ;;
4c90: 20 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 74 update the topt
4ca0: 65 73 74 20 72 65 63 6f 72 64 20 77 69 74 68 20 est record with
4cb0: 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 75 6e its location run
4cc0: 64 69 72 2c 20 63 61 63 68 65 20 74 68 65 20 70 dir, cache the p
4cd0: 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 73 20 ath. ;; This
4ce0: 77 61 73 73 20 68 69 67 68 6c 79 20 69 6e 65 66 wass highly inef
4cf0: 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 62 20 ficient, one db
4d00: 77 72 69 74 65 20 66 6f 72 20 65 76 65 72 79 20 write for every
4d10: 73 75 62 74 65 73 74 2c 20 70 6f 74 65 6e 74 69 subtest, potenti
4d20: 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 6f 75 ally. ;; thou
4d30: 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 65 73 sands of unneces
4d40: 73 61 72 79 20 75 70 64 61 74 65 73 2c 20 63 61 sary updates, ca
4d50: 63 68 65 20 74 68 65 20 66 61 63 74 20 69 74 20 che the fact it
4d60: 77 61 73 20 73 65 74 20 61 6e 64 20 64 6f 6e 27 was set and don'
4d70: 74 20 73 65 74 20 69 74 20 0a 20 20 20 20 3b 3b t set it . ;;
4d80: 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b again. .. ;;
4d90: 20 4e 42 20 2d 20 54 68 69 73 20 69 73 20 6e 6f NB - This is no
4da0: 74 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 t working right
4db0: 2d 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 - some top tests
4dc0: 20 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 are not getting
4dd0: 20 74 68 65 20 70 61 74 68 20 73 65 74 21 21 21 the path set!!!
4de0: 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
4df0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
4e00: 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 74 2d efault *toptest-
4e10: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
4e20: 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 #f))..(let* ((te
4e30: 73 74 69 6e 66 6f 20 20 20 20 20 20 20 28 63 64 stinfo (cd
4e40: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
4e50: 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 by-id *runremote
4e60: 2a 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 * test-id)) ;;
4e70: 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 run-id testname
4e80: 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 item-path))..
4e90: 20 20 20 20 28 63 75 72 72 2d 74 65 73 74 2d 70 (curr-test-p
4ea0: 61 74 68 20 28 69 66 20 74 65 73 74 69 6e 66 6f ath (if testinfo
4eb0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
4ec0: 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 20 23 ndir testinfo) #
4ed0: 66 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 f))).. (hash-ta
4ee0: 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 ble-set! *toptes
4ef0: 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d t-paths* testnam
4f00: 65 20 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 e curr-test-path
4f10: 29 0a 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 73 ).. ;; NB// Was
4f20: 20 74 68 69 73 20 66 6f 72 20 74 68 65 20 74 65 this for the te
4f30: 73 74 20 6f 72 20 66 6f 72 20 74 68 65 20 70 61 st or for the pa
4f40: 72 65 6e 74 20 69 6e 20 61 6e 20 69 74 65 72 61 rent in an itera
4f50: 74 65 64 20 74 65 73 74 3f 0a 09 20 20 28 63 64 ted test?.. (cd
4f60: 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 b:test-set-rundi
4f70: 72 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 r! *runremote* r
4f80: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 22 un-id testname "
4f90: 22 20 6c 6e 6b 70 61 74 68 29 20 3b 3b 20 74 6f " lnkpath) ;; to
4fa0: 70 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 ptest-path).. (
4fb0: 69 66 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 if (or (not curr
4fc0: 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 09 20 20 -test-path)...
4fd0: 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d (not (directory-
4fe0: 65 78 69 73 74 73 3f 20 74 6f 70 74 65 73 74 2d exists? toptest-
4ff0: 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 20 28 path))).. (
5000: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
5010: 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 rint-info 2 "Cre
5020: 61 74 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d ating " toptest-
5030: 70 61 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 path " and link
5040: 22 20 6c 6e 6b 70 61 74 68 29 0a 09 09 28 63 72 " lnkpath)...(cr
5050: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 eate-directory t
5060: 6f 70 74 65 73 74 2d 70 61 74 68 20 23 74 29 0a optest-path #t).
5070: 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 ..(hash-table-se
5080: 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 t! *toptest-path
5090: 73 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 74 s* testname topt
50a0: 65 73 74 2d 70 61 74 68 29 29 29 29 29 0a 0a 20 est-path)))))..
50b0: 20 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 ;; Now create
50c0: 20 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 the link from t
50d0: 68 65 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 he test path to
50e0: 74 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 the link tree, h
50f0: 6f 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 owever. ;; if
5100: 20 74 68 65 20 74 65 73 74 20 69 73 20 69 74 65 the test is ite
5110: 72 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 rated it is nece
5120: 73 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 ssary to create
5130: 74 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a the parent path.
5140: 20 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 ;; to the it
5150: 65 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 eration. use pat
5160: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory
5170: 74 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 to trim the path
5180: 20 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c by one. ;; l
5190: 65 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f evel. (if (no
51a0: 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 t not-iterated)
51b0: 3b 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 ;; i.e. iterated
51c0: 0a 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 ..(let ((iterate
51d0: 64 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e d-parent (pathn
51e0: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 ame-directory (c
51f0: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
5200: 69 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 item-path))))..
5210: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
5220: 66 6f 20 32 20 22 43 72 65 61 74 69 6e 67 20 69 fo 2 "Creating i
5230: 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 terated parent "
5240: 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 iterated-parent
5250: 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 ).. (create-dir
5260: 65 63 74 6f 72 79 20 69 74 65 72 61 74 65 64 2d ectory iterated-
5270: 70 61 72 65 6e 74 20 23 74 29 29 29 0a 0a 20 20 parent #t)))..
5280: 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d (if (symbolic-
5290: 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 20 28 link? lnkpath) (
52a0: 64 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 70 delete-file lnkp
52b0: 61 74 68 29 29 0a 20 20 20 20 28 69 66 20 28 6e ath)). (if (n
52c0: 6f 74 20 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 ot (or (file-exi
52d0: 73 74 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 sts? lnkpath)...
52e0: 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f (symbolic-link?
52f0: 20 6c 6e 6b 70 61 74 68 29 29 29 0a 09 28 63 72 lnkpath)))..(cr
5300: 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 eate-symbolic-li
5310: 6e 6b 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 nk toptest-path
5320: 6c 6e 6b 70 61 74 68 29 29 0a 20 20 20 20 0a 20 lnkpath)). .
5330: 20 20 20 3b 3b 20 54 68 65 20 74 6f 70 74 65 73 ;; The toptes
5340: 74 20 70 61 74 68 20 68 61 73 20 62 65 65 6e 20 t path has been
5350: 63 72 65 61 74 65 64 2c 20 74 68 65 20 6c 69 6e created, the lin
5360: 6b 20 74 6f 20 74 68 65 20 74 65 73 74 20 69 6e k to the test in
5370: 20 74 68 65 20 6c 69 6e 6b 74 72 65 65 20 68 61 the linktree ha
5380: 73 0a 20 20 20 20 3b 3b 20 62 65 65 6e 20 63 72 s. ;; been cr
5390: 65 61 74 65 64 2e 20 4e 6f 77 2c 20 69 66 20 74 eated. Now, if t
53a0: 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 61 74 his is an iterat
53b0: 65 64 20 74 65 73 74 20 74 68 65 20 72 65 61 6c ed test the real
53c0: 20 74 65 73 74 20 64 69 72 20 6d 75 73 74 20 62 test dir must b
53d0: 65 20 63 72 65 61 74 65 64 0a 20 20 20 20 28 69 e created. (i
53e0: 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 f (not not-itera
53f0: 74 65 64 29 20 3b 3b 20 74 68 69 73 20 69 73 20 ted) ;; this is
5400: 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 an iterated test
5410: 0a 09 28 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 ..(let ((lnktarg
5420: 65 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 et (conc lnkpath
5430: 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 "/" item-path))
5440: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
5450: 74 20 32 20 22 53 65 74 74 69 6e 67 20 75 70 20 t 2 "Setting up
5460: 73 75 62 20 74 65 73 74 20 72 75 6e 20 61 72 65 sub test run are
5470: 61 22 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 a").. (debug:pr
5480: 69 6e 74 20 32 20 22 20 2d 20 63 72 65 61 74 69 int 2 " - creati
5490: 6e 67 20 72 75 6e 20 61 72 65 61 20 69 6e 20 22 ng run area in "
54a0: 20 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 test-path).. (
54b0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
54c0: 20 74 65 73 74 2d 70 61 74 68 20 23 74 29 20 3b test-path #t) ;
54d0: 3b 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 ; (system (conc
54e0: 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 73 "mkdir -p " tes
54f0: 74 2d 70 61 74 68 29 29 0a 09 20 20 28 64 65 62 t-path)).. (deb
5500: 75 67 3a 70 72 69 6e 74 20 32 20 0a 09 09 20 20 ug:print 2 ...
5510: 20 20 20 20 20 22 20 2d 20 63 72 65 61 74 69 6e " - creatin
5520: 67 20 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 g link from: " t
5530: 65 73 74 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 est-path "\n"...
5540: 20 20 20 20 20 20 20 22 20 20 20 20 20 20 20 20 "
5550: 20 20 20 20 20 20 20 20 20 20 20 74 6f 3a 20 22 to: "
5560: 20 6c 6e 6b 74 61 72 67 65 74 29 0a 09 20 20 3b lnktarget).. ;
5570: 3b 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ; (create-direct
5580: 6f 72 79 20 6c 6e 6b 70 61 74 68 20 23 74 29 20 ory lnkpath #t)
5590: 3b 3b 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e ;; (system (con
55a0: 63 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c 6e c "mkdir -p " ln
55b0: 6b 70 61 74 68 29 29 0a 0a 09 20 20 3b 3b 20 49 kpath))... ;; I
55c0: 66 20 74 68 65 72 65 20 69 73 20 61 6c 72 65 61 f there is alrea
55d0: 64 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 6c dy a symlink del
55e0: 65 74 65 20 69 74 20 61 6e 64 20 72 65 63 72 65 ete it and recre
55f0: 61 74 65 20 69 74 2e 0a 09 20 20 28 69 66 20 28 ate it... (if (
5600: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
5610: 6e 6b 74 61 72 67 65 74 29 20 20 20 20 20 28 64 nktarget) (d
5620: 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 74 61 elete-file lnkta
5630: 72 67 65 74 29 29 0a 09 20 20 28 69 66 20 28 6e rget)).. (if (n
5640: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
5650: 20 6c 6e 6b 74 61 72 67 65 74 29 29 20 28 63 72 lnktarget)) (cr
5660: 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 eate-symbolic-li
5670: 6e 6b 20 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b nk test-path lnk
5680: 74 61 72 67 65 74 29 29 29 29 0a 0a 20 20 20 20 target))))..
5690: 3b 3b 20 49 20 73 75 73 70 65 63 74 20 74 68 69 ;; I suspect thi
56a0: 73 20 73 65 63 74 69 6f 6e 20 77 61 73 20 64 65 s section was de
56b0: 6c 65 74 69 6e 67 20 74 65 73 74 20 64 69 72 65 leting test dire
56c0: 63 74 6f 72 69 65 73 20 75 6e 64 65 72 20 73 6f ctories under so
56d0: 6d 65 20 0a 20 20 20 20 3b 3b 20 77 69 65 72 64 me . ;; wierd
56e0: 20 73 69 74 61 74 69 6f 6e 73 3f 20 54 68 69 73 sitations? This
56f0: 20 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 doesn't make se
5700: 6e 73 65 20 2d 20 72 65 65 6e 61 62 6c 69 6e 67 nse - reenabling
5710: 20 74 68 65 20 72 6d 20 2d 66 20 0a 20 20 20 20 the rm -f .
5720: 3b 3b 20 49 20 68 6f 6e 65 73 74 6c 79 20 64 6f ;; I honestly do
5730: 6e 27 74 20 72 65 6d 65 6d 62 65 72 20 2a 77 68 n't remember *wh
5740: 79 2a 20 74 68 69 73 20 63 68 75 6e 6b 20 77 61 y* this chunk wa
5750: 73 20 6e 65 65 64 65 64 2e 2e 2e 0a 20 20 20 20 s needed....
5760: 3b 3b 20 28 6c 65 74 20 28 28 74 65 73 74 6c 69 ;; (let ((testli
5770: 6e 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 nk (conc lnkpath
5780: 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 29 "/" testname)))
5790: 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 . ;; (if (a
57a0: 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f nd (file-exists?
57b0: 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b testlink). ;
57c0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 ; (or
57d0: 20 28 72 65 67 75 6c 61 72 2d 66 69 6c 65 3f 20 (regular-file?
57e0: 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b testlink). ;;
57f0: 20 20 20 20 20 09 20 20 20 28 73 79 6d 62 6f 6c . (symbol
5800: 69 63 2d 6c 69 6e 6b 3f 20 74 65 73 74 6c 69 6e ic-link? testlin
5810: 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 k))). ;;
5820: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
5830: 22 72 6d 20 2d 66 20 22 20 74 65 73 74 6c 69 6e "rm -f " testlin
5840: 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 73 k))). ;; (s
5850: 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e ystem (conc "ln
5860: 20 2d 73 66 20 22 20 74 65 73 74 2d 70 61 74 68 -sf " test-path
5870: 20 22 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 " " testlink)))
5880: 0a 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 . (if (direct
5890: 6f 72 79 3f 20 74 65 73 74 2d 70 61 74 68 29 0a ory? test-path).
58a0: 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 65 74 2a .(begin.. (let*
58b0: 20 28 28 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 ((cmd (conc
58c0: 22 72 73 79 6e 63 20 2d 61 76 22 20 28 69 66 20 "rsync -av" (if
58d0: 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 (debug:debug-mod
58e0: 65 20 31 29 20 22 22 20 22 71 22 29 20 22 20 22 e 1) "" "q") " "
58f0: 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 22 test-src-path "
5900: 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f / " test-path "/
5910: 22 29 29 0a 09 09 20 28 73 74 61 74 75 73 20 28 "))... (status (
5920: 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a 09 20 system cmd)))..
5930: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f (if (not (eq?
5940: 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 28 64 status 0))...(d
5950: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 ebug:print 2 "ER
5960: 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 ROR: problem wit
5970: 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d h running \"" cm
5980: 64 20 22 5c 22 22 29 29 29 0a 09 20 20 28 6c 69 d "\""))).. (li
5990: 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e 6b 70 st lnkpathf lnkp
59a0: 61 74 68 20 29 29 0a 09 28 6c 69 73 74 20 23 66 ath ))..(list #f
59b0: 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c #f))))..;; 1. l
59c0: 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 6b 73 ook though disks
59d0: 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b 20 77 list for disk w
59e0: 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b ith most space.;
59f0: 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 6e 20 ; 2. create run
5a00: 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 dir on disk, pat
5a10: 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e h name is meanin
5a20: 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 gful.;; 3. creat
5a30: 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 e link from run
5a40: 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 74 20 dir to megatest
5a50: 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e runs area .;; 4.
5a60: 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 remotely run th
5a70: 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 e test on alloca
5a80: 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d ted host.;; -
5a90: 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 74 6f could be ssh to
5aa0: 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 host from hosts
5ab0: 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 20 72 table (update r
5ac0: 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f egularly with lo
5ad0: 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c ad).;; - coul
5ae0: 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b d be netbatch.;;
5af0: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 (launch-te
5b00: 73 74 20 64 62 20 28 63 61 64 72 20 73 74 61 74 st db (cadr stat
5b10: 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a us) test-conf)).
5b20: 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d (define (launch-
5b30: 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 72 test db run-id r
5b40: 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 unname test-conf
5b50: 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 2d keyvallst test-
5b60: 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 name test-path i
5b70: 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 0a 20 temdat params).
5b80: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5b90: 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 ry *toppath*).
5ba0: 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
5bb0: 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 ;; consolidate
5bc0: 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 this code with t
5bd0: 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 he code in megat
5be0: 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 est.scm for "-ex
5bf0: 65 63 75 74 65 22 0a 20 20 20 28 6c 69 73 74 20 ecute". (list
5c00: 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 ;; (list "MT_TES
5c10: 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d T_RUN_DIR" work-
5c20: 61 72 65 61 29 0a 20 20 20 20 28 6c 69 73 74 20 area). (list
5c30: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
5c40: 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 E" *toppath*).
5c50: 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 (list "MT_TEST
5c60: 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 _NAME" test-name
5c70: 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 22 ). ;; (list "
5c80: 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 MT_ITEM_INFO" (c
5c90: 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 0a 20 onc itemdat)) .
5ca0: 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e (list "MT_RUN
5cb0: 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 NAME" runname)
5cc0: 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 22 4d . ;; (list "M
5cd0: 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d 74 5f T_TARGET" mt_
5ce0: 74 61 72 67 65 74 29 0a 20 20 20 20 29 29 0a 20 target). )).
5cf0: 20 28 6c 65 74 2a 20 28 28 75 73 65 73 68 65 6c (let* ((useshel
5d00: 6c 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b l (config-look
5d10: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
5d20: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 jobtools" "u
5d30: 73 65 73 68 65 6c 6c 22 29 29 0a 09 20 28 6c 61 seshell")).. (la
5d40: 75 6e 63 68 65 72 20 20 20 28 63 6f 6e 66 69 67 uncher (config
5d50: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
5d60: 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
5d70: 20 20 20 22 6c 61 75 6e 63 68 65 72 22 29 29 0a "launcher")).
5d80: 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 28 63 . (runscript (c
5d90: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
5da0: 74 2d 63 6f 6e 66 20 20 20 22 73 65 74 75 70 22 t-conf "setup"
5db0: 20 20 20 20 20 20 20 20 22 72 75 6e 73 63 72 69 "runscri
5dc0: 70 74 22 29 29 0a 09 20 28 65 7a 73 74 65 70 73 pt")).. (ezsteps
5dd0: 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 (> (length (
5de0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
5df0: 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 efault test-conf
5e00: 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 "ezsteps" '()))
5e10: 20 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 73 65 0)) ;; don't se
5e20: 6e 64 20 61 6c 6c 20 74 68 65 20 73 74 65 70 73 nd all the steps
5e30: 2c 20 63 6f 75 6c 64 20 62 65 20 62 69 67 0a 09 , could be big..
5e40: 20 28 64 69 73 6b 73 70 61 63 65 20 20 28 63 6f (diskspace (co
5e50: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 nfig-lookup test
5e60: 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 65 -conf "require
5e70: 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 61 63 ments" "diskspac
5e80: 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 20 20 e")).. (memory
5e90: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
5ea0: 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 p test-conf "r
5eb0: 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 6d 65 equirements" "me
5ec0: 6d 6f 72 79 22 29 29 0a 09 20 28 68 6f 73 74 73 mory")).. (hosts
5ed0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f (config-lo
5ee0: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
5ef0: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
5f00: 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a 09 20 "workhosts"))..
5f10: 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 (remote-megatest
5f20: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
5f30: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
5f40: 75 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 22 up" "executable"
5f50: 29 29 0a 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f )).. ;; FIXME SO
5f60: 4d 45 44 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 MEDAY: not good
5f70: 68 6f 77 20 74 68 69 73 20 69 73 20 73 6f 20 6f how this is so o
5f80: 62 74 75 73 65 2c 20 74 68 69 73 20 68 61 63 6b btuse, this hack
5f90: 20 69 73 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 is to .. ;;
5fa0: 20 20 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f allo
5fb0: 77 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 w running from d
5fc0: 61 73 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 ashboard. Extrac
5fd0: 74 20 74 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 t the path.. ;;
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
5ff0: 72 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d rom the called m
6000: 65 67 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 egatest and conv
6010: 65 72 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 ert dashboard..
6020: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 09 ;; .
6030: 20 20 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 6d or dboard to m
6040: 65 67 61 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c egatest.. (local
6050: 2d 6d 65 67 61 74 65 73 74 20 20 28 6c 65 74 2a -megatest (let*
6060: 20 28 28 6c 6d 20 20 28 63 61 72 20 28 61 72 67 ((lm (car (arg
6070: 76 29 29 29 0a 09 09 09 09 20 28 64 69 72 20 28 v)))..... (dir (
6080: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
6090: 72 79 20 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 ry lm))..... (ex
60a0: 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 e (pathname-stri
60b0: 70 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 p-directory lm))
60c0: 29 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 20 28 ).... (conc (
60d0: 69 66 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 if dir (conc dir
60e0: 20 22 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 "/") "").....
60f0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
6100: 79 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 ymbol exe).....
6110: 20 20 20 28 28 64 62 6f 61 72 64 29 20 20 20 20 ((dboard)
6120: 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 "megatest").....
6130: 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 20 20 ((mtest)
6140: 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 "megatest")....
6150: 09 20 20 20 20 28 28 64 61 73 68 62 6f 61 72 64 . ((dashboard
6160: 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 ) "megatest")...
6170: 09 09 20 20 20 20 28 65 6c 73 65 20 65 78 65 29 .. (else exe)
6180: 29 29 29 29 0a 09 20 28 74 65 73 74 2d 73 69 67 )))).. (test-sig
6190: 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 (conc test-na
61a0: 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c 69 73 me ":" (item-lis
61b0: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
61c0: 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 68 20 )) ;; test-path
61d0: 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 74 68 is the full path
61e0: 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 20 69 including the i
61f0: 74 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f 72 6b tem-path.. (work
6200: 2d 61 72 65 61 20 20 23 66 29 0a 09 20 28 74 6f -area #f).. (to
6210: 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 ptest-work-area
6220: 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 61 #f) ;; for itera
6230: 74 65 64 20 74 65 73 74 73 20 74 68 65 20 74 6f ted tests the to
6240: 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 20 p test contains
6250: 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 66 6f data relevant fo
6260: 72 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 61 74 r all.. (diskpat
6270: 68 20 20 20 23 66 29 0a 09 20 28 63 6d 64 70 61 h #f).. (cmdpa
6280: 72 6d 73 20 20 20 23 66 29 0a 09 20 28 66 75 6c rms #f).. (ful
6290: 6c 63 6d 64 20 20 20 20 23 66 29 20 3b 3b 20 28 lcmd #f) ;; (
62a0: 64 65 66 69 6e 65 20 61 20 28 77 69 74 68 2d 6f define a (with-o
62b0: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 utput-to-string
62c0: 28 6c 61 6d 62 64 61 20 28 29 28 77 72 69 74 65 (lambda ()(write
62d0: 20 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 69 6e x)))).. (mt-bin
62e0: 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 20 28 dir-path #f).. (
62f0: 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d item-path (item-
6300: 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 list->path itemd
6310: 61 74 29 29 0a 09 20 28 74 65 73 74 2d 69 64 20 at)).. (test-id
6320: 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 (cdb:remote-r
6330: 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 un db:get-test-i
6340: 64 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 d #f run-id test
6350: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
6360: 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 20 20 ).. (testinfo
6370: 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e (cdb:get-test-in
6380: 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d fo-by-id *runrem
6390: 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 0a 09 ote* test-id))..
63a0: 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 73 74 (mt_target (st
63b0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
63c0: 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 (map cadr keyva
63d0: 6c 6c 73 74 29 20 22 2f 22 29 29 0a 09 20 28 64 llst) "/")).. (d
63e0: 65 62 75 67 2d 70 61 72 61 6d 20 28 61 70 70 65 ebug-param (appe
63f0: 6e 64 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 nd (if (args:get
6400: 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 20 20 -arg "-debug")
6410: 28 6c 69 73 74 20 22 2d 64 65 62 75 67 22 20 28 (list "-debug" (
6420: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
6430: 65 62 75 67 22 29 29 20 27 28 29 29 0a 09 09 09 ebug")) '())....
6440: 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a (if (args:
6450: 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e get-arg "-loggin
6460: 67 22 29 28 6c 69 73 74 20 22 2d 6c 6f 67 67 69 g")(list "-loggi
6470: 6e 67 22 29 20 27 28 29 29 29 29 29 0a 20 20 20 ng") '())))).
6480: 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 21 (if hosts (set!
6490: 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d 73 hosts (string-s
64a0: 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 20 plit hosts))).
64b0: 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 67 ;; set the meg
64c0: 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c 6c atest to be call
64d0: 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 65 ed on the remote
64e0: 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 6e host. (if (n
64f0: 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 ot remote-megate
6500: 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d st)(set! remote-
6510: 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d megatest local-m
6520: 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 egatest)) ;; "me
6530: 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 73 gatest")). (s
6540: 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 et! mt-bindir-pa
6550: 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 th (pathname-dir
6560: 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 ectory remote-me
6570: 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 66 gatest)). (if
6580: 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 20 launcher (set!
6590: 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e 67 launcher (string
65a0: 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 29 -split launcher)
65b0: 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 70 )). ;; set up
65c0: 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 72 the run work ar
65d0: 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 ea for this test
65e0: 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 . (set! diskp
65f0: 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 ath (get-best-di
6600: 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 sk *configdat*))
6610: 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 . (if diskpat
6620: 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 20 28 h..(let ((dat (
6630: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 63 open-run-close c
6640: 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 reate-work-area
6650: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 db run-id test-i
6660: 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b d test-path disk
6670: 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 path test-name i
6680: 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 73 65 temdat))).. (se
6690: 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 t! work-area (ca
66a0: 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 74 21 r dat)).. (set!
66b0: 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 toptest-work-ar
66c0: 65 61 20 28 63 61 64 72 20 64 61 74 29 29 0a 09 ea (cadr dat))..
66d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
66e0: 6e 66 6f 20 32 20 22 55 73 69 6e 67 20 77 6f 72 nfo 2 "Using wor
66f0: 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 k area " work-ar
6700: 65 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ea))..(begin..
6710: 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 (set! work-area
6720: 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 20 (conc test-path
6730: 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 "/tmp_run"))..
6740: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
6750: 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a y work-area #t).
6760: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
6770: 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 0 "WARNING: No d
6780: 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 73 70 isk work area sp
6790: 65 63 69 66 69 65 64 20 2d 20 72 75 6e 6e 69 6e ecified - runnin
67a0: 67 20 69 6e 20 74 68 65 20 74 65 73 74 20 64 69 g in the test di
67b0: 72 65 63 74 6f 72 79 20 75 6e 64 65 72 20 74 6d rectory under tm
67c0: 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 28 73 p_run"))). (s
67d0: 65 74 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 et! cmdparms (ba
67e0: 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f se64:base64-enco
67f0: 64 65 20 0a 09 09 20 20 20 20 28 77 69 74 68 2d de ... (with-
6800: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
6810: 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
6820: 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f () ;; (list 'ho
6830: 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 sts hosts)..
6840: 09 09 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 ..(write (list (
6850: 6c 69 73 74 20 27 74 65 73 74 70 61 74 68 20 20 list 'testpath
6860: 74 65 73 74 2d 70 61 74 68 29 0a 09 09 09 09 20 test-path).....
6870: 20 20 20 20 28 6c 69 73 74 20 27 72 75 6e 72 65 (list 'runre
6880: 6d 6f 74 65 20 2a 72 75 6e 72 65 6d 6f 74 65 2a mote *runremote*
6890: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
68a0: 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f 70 'toppath *top
68b0: 70 61 74 68 2a 29 0a 09 09 09 09 20 20 20 20 20 path*).....
68c0: 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 (list 'work-area
68d0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
68e0: 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 (list 'test
68f0: 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 -name test-name)
6900: 20 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 ..... (list
6910: 20 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 'runscript runs
6920: 63 72 69 70 74 29 20 0a 09 09 09 09 20 20 20 20 cript) .....
6930: 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 (list 'run-id
6940: 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 run-id )....
6950: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 . (list 'tes
6960: 74 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 t-id test-id
6970: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
6980: 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 'itemdat item
6990: 64 61 74 20 20 29 0a 09 09 09 09 20 20 20 20 20 dat ).....
69a0: 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 (list 'megatest
69b0: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
69c0: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
69d0: 20 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 'ezsteps ezst
69e0: 65 70 73 29 20 0a 09 09 09 09 20 20 20 20 20 28 eps) ..... (
69f0: 6c 69 73 74 20 27 74 61 72 67 65 74 20 20 20 20 list 'target
6a00: 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 20 mt_target).....
6a10: 20 20 20 20 28 6c 69 73 74 20 27 65 6e 76 2d 6f (list 'env-o
6a20: 76 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c 65 vrd (hash-table
6a30: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
6a40: 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 nfigdat* "env-ov
6a50: 65 72 72 69 64 65 22 20 27 28 29 29 29 20 0a 09 erride" '())) ..
6a60: 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 73 ... (list 's
6a70: 65 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 72 et-vars (if par
6a80: 61 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ams (hash-table-
6a90: 72 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 61 ref/default para
6aa0: 6d 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 66 ms "-setvars" #f
6ab0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 )))..... (li
6ac0: 73 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 st 'runname ru
6ad0: 6e 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 nname).....
6ae0: 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 (list 'mt-bindir
6af0: 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d -path mt-bindir-
6b00: 70 61 74 68 29 29 29 29 29 29 29 20 3b 3b 20 28 path))))))) ;; (
6b10: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
6b20: 73 65 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 22 se keyvallst " "
6b30: 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 6c 65 61 )))). ;; clea
6b40: 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f 72 n out step recor
6b50: 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 73 ds from previous
6b60: 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 69 run if they exi
6b70: 73 74 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 st. ;; (debug
6b80: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 46 :print-info 4 "F
6b90: 49 58 4d 45 45 45 45 45 21 21 21 21 20 54 68 69 IXMEEEEE!!!! Thi
6ba0: 73 20 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 64 s can be removed
6bb0: 20 73 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 61 some day, perha
6bc0: 70 73 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 74 ps move all test
6bd0: 20 72 65 63 6f 72 64 73 20 74 6f 20 74 68 65 20 records to the
6be0: 74 65 73 74 20 64 62 3f 22 29 0a 20 20 20 20 3b test db?"). ;
6bf0: 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ; (open-run-clos
6c00: 65 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 e db:delete-test
6c10: 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 62 -step-records db
6c20: 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 28 63 test-id). (c
6c30: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
6c40: 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b 20 73 6f work-area) ;; so
6c50: 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 20 that log files
6c60: 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 20 from the launch
6c70: 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 6c process don't cl
6c80: 75 74 74 65 72 20 74 68 65 20 74 65 73 74 20 64 utter the test d
6c90: 69 72 0a 20 20 20 20 28 74 65 73 74 73 3a 74 65 ir. (tests:te
6ca0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
6cb0: 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 est-id "LAUNCHED
6cc0: 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b " "n/a" #f #f) ;
6cd0: 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 ; (if launch-res
6ce0: 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 ults launch-resu
6cf0: 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 lts "FAILED")).
6d00: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
6d10: 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 and launcher hos
6d20: 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 ts) ;; must be u
6d30: 73 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d sing ssh hostnam
6d40: 65 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 e. (set! fu
6d50: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 llcmd (append la
6d60: 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 uncher (car host
6d70: 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d s)(list remote-m
6d80: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6d90: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6da0: 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
6db0: 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 m))). ;; (se
6dc0: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
6dd0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 nd launcher (car
6de0: 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d hosts)(list rem
6df0: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 ote-megatest tes
6e00: 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 t-sig "-execute"
6e10: 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 cmdparms)))).
6e20: 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 20 (launcher.
6e30: 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
6e40: 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
6e50: 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d r (list remote-m
6e60: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6e70: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6e80: 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
6e90: 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 m))). ;; (se
6ea0: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
6eb0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 nd launcher (lis
6ec0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
6ed0: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
6ee0: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 cute" cmdparms))
6ef0: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
6f00: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 65 (if (not use
6f10: 73 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 shell)(debug:pri
6f20: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 69 nt 0 "WARNING: i
6f30: 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e nternal launchin
6f40: 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 g will not work
6f50: 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 well without \"u
6f60: 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e seshell yes\" in
6f70: 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d your [jobtools]
6f80: 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 20 section")).
6f90: 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 (set! fullcmd
6fa0: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 65 (append (list re
6fb0: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
6fc0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
6fd0: 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 " cmdparms) debu
6fe0: 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 69 g-param (list (i
6ff0: 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 f useshell "&" "
7000: 22 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 ")))))). ;; (
7010: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c 69 set! fullcmd (li
7020: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
7030: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
7040: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 20 ecute" cmdparms
7050: 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 (if useshell "&"
7060: 20 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 66 ""))))). (if
7070: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
7080: 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 75 -xterm")(set! fu
7090: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 75 llcmd (append fu
70a0: 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 74 llcmd (list "-xt
70b0: 65 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 65 erm")))). (de
70c0: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 75 bug:print 1 "Lau
70d0: 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 72 nching " work-ar
70e0: 65 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 ea). ;; set p
70f0: 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 re-launch-env-va
7100: 72 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 rs before launch
7110: 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 61 ing, keep the va
7120: 72 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 61 rs in prevvals a
7130: 6e 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 6f nd put the envio
7140: 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 nment back when
7150: 64 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 3a done. (debug:
7160: 70 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 print 4 "fullcmd
7170: 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 : " fullcmd).
7180: 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 (let* ((commonp
7190: 72 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e revvals (alist->
71a0: 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 env-vars....
71b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
71c0: 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 default *configd
71d0: 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 at* "env-overrid
71e0: 65 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 74 e" '()))).. (t
71f0: 65 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 estprevvals (a
7200: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 list->env-vars..
7210: 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
7220: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
7230: 73 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 st-conf "pre-lau
7240: 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 nch-env-override
7250: 73 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 6d s" '()))).. (m
7260: 69 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 iscprevvals (a
7270: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b list->env-vars ;
7280: 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 ; consolidate th
7290: 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 is code with the
72a0: 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 code in megates
72b0: 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 t.scm for "-exec
72c0: 75 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 70 ute".... (app
72d0: 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 end (list (list
72e0: 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 "MT_TEST_RUN_DIR
72f0: 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 " work-area)....
7300: 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 .. (list "MT_TE
7310: 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 ST_NAME" test-na
7320: 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 me)...... (list
7330: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
7340: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 (conc itemdat))
7350: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
7360: 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
7370: 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 name)...... (li
7380: 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 st "MT_TARGET"
7390: 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 mt_target)....
73a0: 09 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 74 .. )..... it
73b0: 65 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c 61 emdat))).. (la
73c0: 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 unch-results (ap
73d0: 70 6c 79 20 63 6d 64 2d 72 75 6e 2d 77 69 74 68 ply cmd-run-with
73e0: 2d 73 74 64 65 72 72 2d 3e 6c 69 73 74 20 3b 3b -stderr->list ;;
73f0: 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 61 cmd-run-proc-ea
7400: 63 68 2d 6c 69 6e 65 0a 09 09 09 09 20 20 28 69 ch-line..... (i
7410: 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 f useshell.....
7420: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 (string-int
7430: 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 ersperse fullcmd
7440: 20 22 20 22 29 0a 09 09 09 09 20 20 20 20 20 20 " ").....
7450: 28 63 61 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 (car fullcmd))..
7460: 09 09 09 20 20 3b 3b 20 63 6f 6e 63 0a 09 09 09 ... ;; conc....
7470: 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a . (if useshell.
7480: 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 .... '()...
7490: 09 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c .. (cdr ful
74a0: 6c 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c 61 lcmd))))) ;; la
74b0: 75 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 29 uncher fullcmd))
74c0: 29 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 );; (apply cmd-r
74d0: 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e un-proc-each-lin
74e0: 65 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e 74 e launcher print
74f0: 20 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 28 fullcmd))) ;; (
7500: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 cmd-run->list fu
7510: 6c 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 77 llcmd)). (w
7520: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
7530: 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f le "mt_launch.lo
7540: 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 g"..(lambda ()..
7550: 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 6c (apply print l
7560: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 29 aunch-results)))
7570: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
7580: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 int 2 "Launching
7590: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 completed, upda
75a0: 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 20 ting db").
75b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
75c0: 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 Launch results:
75d0: 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 " launch-results
75e0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
75f0: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
7600: 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
7610: 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 (print "ERROR: F
7620: 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 ailed to run " (
7630: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
7640: 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 se fullcmd " ")
7650: 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 ", exiting now")
7660: 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 .. ;; (sqlite
7670: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
7680: 09 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 . ;; good ole
7690: 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e 6f "exit" seems no
76a0: 74 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 3b t to work.. ;
76b0: 3b 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 20 ; (_exit 9)..
76c0: 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
76d0: 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
76e0: 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
76f0: 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
7700: 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 en email list..
7710: 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 68 ;; NB// Is th
7720: 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f is still needed?
7730: 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 20 Should be safe
7740: 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 65 to go back to "e
7750: 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 20 28 xit" now?.. (
7760: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 process-signal (
7770: 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d current-process-
7780: 69 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 id) signal/kill)
7790: 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 28 .. )). (
77a0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
77b0: 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 20 miscprevvals).
77c0: 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d (alist->env-
77d0: 76 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c vars testprevval
77e0: 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d s). (alist-
77f0: 3e 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e >env-vars common
7800: 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 prevvals).
7810: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 launch-results))
7820: 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
7830: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 tory *toppath*))
7840: 0a 0a ..