Artifact
9d5e223a7b070864e81e515b71f5bdd9695c9dfb
File
launch.scm
— part of check-in
[c6cee5cbb1]
at
2013-02-28 23:28:11
on branch network-only-transport
— Converted couple more calls in runs.scm to full remote
(user:
matt
size: 30977)
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 6b 65 79 73 20 20 20 20 (keys
0c00: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 6b #f).. (k
0c10: 65 79 76 61 6c 73 20 20 20 23 66 29 0a 09 20 20 eyvals #f)..
0c20: 20 20 20 20 20 28 66 75 6c 6c 72 75 6e 73 63 72 (fullrunscr
0c30: 69 70 74 20 28 69 66 20 28 6e 6f 74 20 72 75 6e ipt (if (not run
0c40: 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 20 20 script).
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c60: 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 20 #f.
0c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0c90: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
0ca0: 64 65 78 20 22 2f 22 20 72 75 6e 73 63 72 69 70 dex "/" runscrip
0cb0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
0cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cd0: 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 runscri
0ce0: 70 74 20 3b 3b 20 75 73 65 20 75 6e 61 64 75 6c pt ;; use unadul
0cf0: 74 65 72 65 64 20 69 66 20 63 6f 6e 74 61 69 6e tered if contain
0d00: 73 20 73 6c 61 73 68 65 73 0a 20 20 20 20 20 20 s slashes.
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 28 6c 65 74 20 28 28 66 75 6c 6c 6e 20 28 63 6f (let ((fulln (co
0d40: 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 22 20 nc testpath "/"
0d50: 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 20 20 runscript)))..
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 (if (and (file-e
0d90: 78 69 73 74 73 3f 20 66 75 6c 6c 6e 29 0a 20 20 xists? fulln).
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dd0: 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 (file-execute-a
0de0: 63 63 65 73 73 3f 20 66 75 6c 6c 6e 29 29 0a 20 ccess? fulln)).
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 66 75 6c ful
0e20: 6c 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ln.
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 72 75 6e 73 63 72 69 70 74 29 29 29 29 29 20 runscript)))))
0e60: 3b 3b 20 61 73 73 75 6d 65 20 69 74 20 69 73 20 ;; assume it is
0e70: 6f 6e 20 74 68 65 20 70 61 74 68 0a 09 20 20 20 on the path..
0e80: 20 20 20 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 (rollup-stat
0e90: 75 73 20 30 29 29 0a 09 20 20 28 64 65 62 75 67 us 0)).. (debug
0ea0: 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 74 75 :print 2 "Exectu
0eb0: 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 ing " test-name
0ec0: 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d 69 64 " (id: " test-id
0ed0: 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d 68 6f ") on " (get-ho
0ee0: 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 3b 3b 20 st-name)).. ;;
0ef0: 53 65 74 75 70 20 74 68 65 20 2a 72 75 6e 72 65 Setup the *runre
0f00: 6d 6f 74 65 2a 20 67 6c 6f 62 61 6c 20 76 61 72 mote* global var
0f10: 0a 09 20 20 28 69 66 20 2a 72 75 6e 72 65 6d 6f .. (if *runremo
0f20: 74 65 2a 20 28 64 65 62 75 67 3a 70 72 69 6e 74 te* (debug:print
0f30: 20 32 20 22 45 52 52 4f 52 3a 20 49 27 6d 20 6e 2 "ERROR: I'm n
0f40: 6f 74 20 65 78 70 65 63 74 69 6e 67 20 2a 72 75 ot expecting *ru
0f50: 6e 72 65 6d 6f 74 65 2a 20 74 6f 20 62 65 20 73 nremote* to be s
0f60: 65 74 20 61 74 20 74 68 69 73 20 74 69 6d 65 22 et at this time"
0f70: 29 29 0a 09 20 20 28 73 65 74 21 20 2a 72 75 6e )).. (set! *run
0f80: 72 65 6d 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 remote* runremot
0f90: 65 29 0a 09 20 20 28 73 65 74 21 20 6b 65 79 73 e).. (set! keys
0fa0: 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f (cdb:remo
0fb0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
0fc0: 79 73 20 23 66 29 29 0a 09 20 20 28 73 65 74 21 ys #f)).. (set!
0fd0: 20 6b 65 79 76 61 6c 73 20 20 20 20 28 69 66 20 keyvals (if
0fe0: 72 75 6e 2d 69 64 20 28 63 64 62 3a 72 65 6d 6f run-id (cdb:remo
0ff0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
1000: 79 2d 76 61 6c 73 20 23 66 20 72 75 6e 2d 69 64 y-vals #f run-id
1010: 29 20 23 66 29 29 0a 09 20 20 3b 3b 20 61 70 70 ) #f)).. ;; app
1020: 6c 79 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 ly pre-overrides
1030: 20 62 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 before other va
1040: 72 69 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 riables. The pre
1050: 2d 6f 76 65 72 72 69 64 65 20 76 61 72 73 20 6d -override vars m
1060: 75 73 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c ust not.. ;; cl
1070: 6f 62 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 obbers things fr
1080: 6f 6d 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 om the official
1090: 73 6f 75 72 63 65 73 20 73 75 63 68 20 61 73 20 sources such as
10a0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
10b0: 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 and runconfigs.c
10c0: 6f 6e 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 onfig.. (if (st
10d0: 72 69 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a ring? set-vars).
10e0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 . (let ((va
10f0: 72 70 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 rpairs (string-s
1100: 70 6c 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c plit set-vars ",
1110: 22 29 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 ")))...(debug:pr
1120: 69 6e 74 20 34 20 22 76 61 72 70 61 69 72 73 3a int 4 "varpairs:
1130: 20 22 20 76 61 72 70 61 69 72 73 29 0a 09 09 28 " varpairs)...(
1140: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 72 map (lambda (var
1150: 70 61 69 72 29 0a 09 09 20 20 20 20 20 20 20 28 pair)... (
1160: 6c 65 74 20 28 28 76 61 72 76 61 6c 20 28 73 74 let ((varval (st
1170: 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 61 ring-split varpa
1180: 69 72 20 22 3d 22 29 29 29 0a 09 09 09 20 28 69 ir "="))).... (i
1190: 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 f (eq? (length v
11a0: 61 72 76 61 6c 29 20 32 29 0a 09 09 09 20 20 20 arval) 2)....
11b0: 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 (let ((var (ca
11c0: 72 20 76 61 72 76 61 6c 29 29 0a 09 09 09 09 20 r varval)).....
11d0: 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 (val (cadr var
11e0: 76 61 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 val)))....
11f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
1200: 22 41 64 64 69 6e 67 20 70 72 65 2d 76 61 72 2f "Adding pre-var/
1210: 76 61 6c 20 22 20 76 61 72 20 22 20 3d 20 22 20 val " var " = "
1220: 76 61 6c 20 22 20 74 6f 20 74 68 65 20 65 6e 76 val " to the env
1230: 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 ironment")....
1240: 20 20 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 (setenv var
1250: 20 76 61 6c 29 29 29 29 29 0a 09 09 20 20 20 20 val)))))...
1260: 20 76 61 72 70 61 69 72 73 29 29 29 0a 09 20 20 varpairs)))..
1270: 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 (setenv "MT_TEST
1280: 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 _RUN_DIR" work-a
1290: 72 65 61 29 0a 09 20 20 28 73 65 74 65 6e 76 20 rea).. (setenv
12a0: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
12b0: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 28 73 65 est-name).. (se
12c0: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 5f 49 4e tenv "MT_ITEM_IN
12d0: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
12e0: 74 29 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 t)).. (setenv "
12f0: 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
1300: 6e 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e nname).. (seten
1310: 76 20 22 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 v "MT_MEGATEST"
1320: 20 6d 65 67 61 74 65 73 74 29 0a 09 20 20 28 73 megatest).. (s
1330: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
1340: 22 20 20 20 20 74 61 72 67 65 74 29 0a 09 20 20 " target)..
1350: 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 (if mt-bindir-pa
1360: 74 68 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 th (setenv "PATH
1370: 22 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 " (conc (getenv
1380: 22 50 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 "PATH") ":" mt-b
1390: 69 6e 64 69 72 2d 70 61 74 68 29 29 29 0a 09 20 indir-path)))..
13a0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
13b0: 72 79 20 74 6f 70 2d 70 61 74 68 29 0a 09 20 20 ry top-path)..
13c0: 28 69 66 20 28 6e 6f 74 20 28 73 65 74 75 70 2d (if (not (setup-
13d0: 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 for-run))..
13e0: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
13f0: 3a 70 72 69 6e 74 20 30 20 22 46 61 69 6c 65 64 :print 0 "Failed
1400: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
1410: 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 71 6c 69 ng") ...;; (sqli
1420: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
1430: 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a )...;; (sqlite3:
1440: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
1450: 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 20 3b .(exit 1))).. ;
1460: 3b 20 43 61 6e 20 73 65 74 75 70 20 61 73 20 63 ; Can setup as c
1470: 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 76 65 72 lient for server
1480: 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 28 73 65 mode now.. (se
1490: 72 76 65 72 3a 63 6c 69 65 6e 74 2d 73 65 74 75 rver:client-setu
14a0: 70 29 0a 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 p)... (change-d
14b0: 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
14c0: 68 2a 29 20 0a 09 20 20 28 73 65 74 2d 6d 65 67 h*) .. (set-meg
14d0: 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 atest-env-vars r
14e0: 75 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 20 un-id) ;; these
14f0: 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 79 may be needed by
1500: 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 70 the launching p
1510: 72 6f 63 65 73 73 0a 09 20 20 28 63 68 61 6e 67 rocess.. (chang
1520: 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
1530: 2d 61 72 65 61 29 20 0a 0a 09 20 20 28 6f 70 65 -area) ... (ope
1540: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 2d n-run-close set-
1550: 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 run-config-vars
1560: 23 66 20 72 75 6e 2d 69 64 20 6b 65 79 73 20 6b #f run-id keys k
1570: 65 79 76 61 6c 73 29 0a 09 20 20 3b 3b 20 65 6e eyvals).. ;; en
1580: 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 69 vironment overri
1590: 64 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 65 des are done *be
15a0: 66 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 6e fore* the remain
15b0: 69 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e 76 ing critical env
15c0: 61 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 2d 3e ars... (alist->
15d0: 65 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 env-vars env-ovr
15e0: 64 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 d).. (set-megat
15f0: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e est-env-vars run
1600: 2d 69 64 29 0a 09 20 20 28 73 65 74 2d 69 74 65 -id).. (set-ite
1610: 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d 64 m-env-vars itemd
1620: 61 74 29 0a 09 20 20 28 73 61 76 65 2d 65 6e 76 at).. (save-env
1630: 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 ironment-as-file
1640: 73 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 s "megatest")..
1650: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
1660: 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 test-set-meta-i
1670: 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 nfo #f test-id r
1680: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
1690: 69 74 65 6d 64 61 74 20 30 29 0a 09 20 20 28 74 itemdat 0).. (t
16a0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
16b0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
16c0: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 EMOTEHOSTSTART"
16d0: 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 2d "n/a" (args:get-
16e0: 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 20 arg "-m") #f)..
16f0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
1700: 72 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 20 20 rg "-xterm")..
1710: 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 72 75 (set! fullru
1720: 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 29 nscript "xterm")
1730: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
1740: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 fullrunscript (
1750: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 63 75 74 not (file-execut
1760: 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 72 75 e-access? fullru
1770: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 20 20 28 nscript)))... (
1780: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 63 68 system (conc "ch
1790: 6d 6f 64 20 75 67 2b 78 20 22 20 66 75 6c 6c 72 mod ug+x " fullr
17a0: 75 6e 73 63 72 69 70 74 29 29 29 29 0a 09 20 20 unscript))))..
17b0: 3b 3b 20 57 65 20 61 72 65 20 61 62 6f 75 74 20 ;; We are about
17c0: 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 6b to actually kick
17d0: 20 6f 66 66 20 74 68 65 20 74 65 73 74 0a 09 20 off the test..
17e0: 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 73 20 61 ;; so this is a
17f0: 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 good place to r
1800: 65 6d 6f 76 65 20 74 68 65 20 72 65 63 6f 72 64 emove the record
1810: 73 20 66 6f 72 20 0a 09 20 20 3b 3b 20 61 6e 79 s for .. ;; any
1820: 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 previous runs..
1830: 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 65 ;; (db:test-re
1840: 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 75 move-steps db ru
1850: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 n-id testname it
1860: 65 6d 64 61 74 29 0a 09 20 20 0a 09 20 20 28 6c emdat).. .. (l
1870: 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 20 et* ((m
1880: 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 (make-mutex))
1890: 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 ... (kill-job?
18a0: 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d 69 #f)... (exit-i
18b0: 6e 66 6f 20 20 20 20 28 76 65 63 74 6f 72 20 23 nfo (vector #
18c0: 74 20 23 74 20 23 74 29 29 0a 09 09 20 28 6a 6f t #t #t))... (jo
18d0: 62 2d 74 68 72 65 61 64 20 20 20 23 66 29 0a 09 b-thread #f)..
18e0: 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 20 20 . (runit
18f0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 (lambda ().....
1900: 3b 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 ;; (let-values..
1910: 09 09 09 20 3b 3b 20 20 28 28 28 70 69 64 20 65 ... ;; (((pid e
1920: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
1930: 63 6f 64 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 code)..... ;;
1940: 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 75 6c (run-n-wait ful
1950: 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 09 lrunscript)))...
1960: 09 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 .. (tests:test-s
1970: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
1980: 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e 2f id "RUNNING" "n/
1990: 61 22 20 23 66 20 23 66 29 0a 09 09 09 09 20 3b a" #f #f)..... ;
19a0: 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 61 20 ; if there is a
19b0: 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 74 20 runscript do it
19c0: 66 69 72 73 74 0a 09 09 09 09 20 28 69 66 20 66 first..... (if f
19d0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 09 09 09 ullrunscript....
19e0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 64 . (let ((pid
19f0: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 75 (process-run fu
1a00: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 llrunscript)))..
1a10: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 6c ... (let l
1a20: 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 09 oop ((i 0)).....
1a30: 09 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 . (let-values...
1a40: 09 09 09 20 20 28 28 28 70 69 64 2d 76 61 6c 20 ... (((pid-val
1a50: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
1a60: 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 2d -code) (process-
1a70: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
1a80: 09 09 09 09 20 20 28 6d 75 74 65 78 2d 6c 6f 63 .... (mutex-loc
1a90: 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 76 65 k! m)...... (ve
1aa0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
1ab0: 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 nfo 0 pid)......
1ac0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 (vector-set! e
1ad0: 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d xit-info 1 exit-
1ae0: 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 28 status)...... (
1af0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
1b00: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
1b10: 65 29 0a 09 09 09 09 09 20 20 28 73 65 74 21 20 e)...... (set!
1b20: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
1b30: 69 74 2d 63 6f 64 65 29 20 0a 09 09 09 09 09 20 it-code) ......
1b40: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
1b50: 6d 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 65 m)...... (if (e
1b60: 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 q? pid-val 0)...
1b70: 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ... (begin.
1b80: 09 09 09 09 09 09 28 74 68 72 65 61 64 2d 73 6c ......(thread-sl
1b90: 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 28 6c eep! 2).......(l
1ba0: 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a 09 09 oop (+ i 1)))...
1bb0: 09 09 09 20 20 20 20 20 20 29 29 29 29 29 0a 09 ... )))))..
1bc0: 09 09 09 20 3b 3b 20 74 68 65 6e 2c 20 69 66 20 ... ;; then, if
1bd0: 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 6f 6b runscript ran ok
1be0: 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 65 74 (or did not get
1bf0: 20 63 61 6c 6c 65 64 29 0a 09 09 09 09 20 3b 3b called)..... ;;
1c00: 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 do all the ezst
1c10: 65 70 73 20 28 69 66 20 61 6e 79 29 0a 09 09 09 eps (if any)....
1c20: 09 20 28 69 66 20 65 7a 73 74 65 70 73 0a 09 09 . (if ezsteps...
1c30: 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 .. (let* ((t
1c40: 65 73 74 63 6f 6e 66 69 67 20 28 72 65 61 64 2d estconfig (read-
1c50: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f 72 config (conc wor
1c60: 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f 6e k-area "/testcon
1c70: 66 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 69 fig") #f #t envi
1c80: 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d 6c ron-patt: "pre-l
1c90: 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 aunch-env-vars")
1ca0: 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 73 ) ;; FIXME??? is
1cb0: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f 6b allow-system ok
1cc0: 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 20 20 here?......
1cd0: 28 65 7a 73 74 65 70 73 6c 73 74 20 28 68 61 73 (ezstepslst (has
1ce0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
1cf0: 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 ult testconfig "
1d00: 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 29 0a ezsteps" '()))).
1d10: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
1d20: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 not (file-exists
1d30: 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 29 28 63 ? ".ezsteps"))(c
1d40: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
1d50: 22 2e 65 7a 73 74 65 70 73 22 29 29 0a 09 09 09 ".ezsteps"))....
1d60: 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 65 7a . ;; if ez
1d70: 73 74 65 70 73 20 77 61 73 20 64 65 66 69 6e 65 steps was define
1d80: 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 73 75 d then we are su
1d90: 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 6c 65 re to have at le
1da0: 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 75 74 ast one step but
1db0: 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a 09 09 check anyway...
1dc0: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f .. (if (no
1dd0: 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a 73 t (> (length ezs
1de0: 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 09 09 tepslst) 0))....
1df0: 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
1e00: 74 20 30 20 22 45 52 52 4f 52 3a 20 65 7a 73 74 t 0 "ERROR: ezst
1e10: 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 20 eps defined but
1e20: 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a 65 ezstepslst is ze
1e30: 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 09 09 09 ro length").....
1e40: 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 . (let loop ((
1e50: 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a 73 74 ezstep (car ezst
1e60: 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 09 20 epslst)).......
1e70: 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 64 (tal (cd
1e80: 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 r ezstepslst))..
1e90: 09 09 09 09 09 20 20 20 20 20 20 28 70 72 65 76 ..... (prev
1ea0: 73 74 65 70 20 23 66 29 29 0a 09 09 09 09 09 20 step #f))......
1eb0: 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 69 ;; check exi
1ec0: 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 t-info (vector-r
1ed0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a ef exit-info 1).
1ee0: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 76 ..... (if (v
1ef0: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
1f00: 6e 66 6f 20 31 29 0a 09 09 09 09 09 09 20 28 6c nfo 1)....... (l
1f10: 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 et* ((stepname
1f20: 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 20 3b (car ezstep)) ;
1f30: 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 72 75 ; do stuff to ru
1f40: 6e 20 74 68 65 20 73 74 65 70 0a 09 09 09 09 09 n the step......
1f50: 09 09 28 73 74 65 70 69 6e 66 6f 20 20 28 63 61 ..(stepinfo (ca
1f60: 64 72 20 65 7a 73 74 65 70 29 29 0a 09 09 09 09 dr ezstep)).....
1f70: 09 09 09 28 73 74 65 70 70 61 72 74 73 20 28 73 ...(stepparts (s
1f80: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
1f90: 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d exp "^(\\{([^\\}
1fa0: 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 ]*)\\}\\s*|)(.*)
1fb0: 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a 09 $") stepinfo))..
1fc0: 09 09 09 09 09 09 28 73 74 65 70 70 61 72 6d 73 ......(stepparms
1fd0: 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 (list-ref stepp
1fe0: 61 72 74 73 20 32 29 29 20 3b 3b 20 66 6f 72 20 arts 2)) ;; for
1ff0: 66 75 74 75 72 65 20 75 73 65 2c 20 7b 56 41 52 future use, {VAR
2000: 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 74 65 =1,2,3}, run ste
2010: 70 20 66 6f 72 20 65 61 63 68 20 0a 09 09 09 09 p for each .....
2020: 09 09 09 28 73 74 65 70 63 6d 64 20 20 20 28 6c ...(stepcmd (l
2030: 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 ist-ref steppart
2040: 73 20 33 29 29 0a 09 09 09 09 09 09 09 28 73 63 s 3))........(sc
2050: 72 69 70 74 20 20 20 20 22 22 29 20 3b 20 22 23 ript "") ; "#
2060: 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 20 3b !/bin/bash\n") ;
2070: 3b 20 79 65 70 2c 20 77 65 20 64 65 70 65 6e 64 ; yep, we depend
2080: 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 49 58 on bin/bash FIX
2090: 4d 45 21 21 21 0a 09 09 09 09 09 09 09 28 6c 6f ME!!!........(lo
20a0: 67 70 72 6f 2d 75 73 65 64 20 23 66 29 29 0a 09 gpro-used #f))..
20b0: 09 09 09 09 09 20 20 20 3b 3b 20 4e 42 2f 2f 20 ..... ;; NB//
20c0: 63 61 6e 20 73 61 66 65 6c 79 20 61 73 73 75 6d can safely assum
20d0: 65 20 77 65 20 61 72 65 20 69 6e 20 74 65 73 74 e we are in test
20e0: 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 0a -area directory.
20f0: 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a ...... (debug:
2100: 70 72 69 6e 74 20 34 20 22 65 7a 73 74 65 70 73 print 4 "ezsteps
2110: 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a 20 22 20 :\n stepname: "
2120: 73 74 65 70 6e 61 6d 65 20 22 20 73 74 65 70 69 stepname " stepi
2130: 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e 66 6f 20 nfo: " stepinfo
2140: 22 20 73 74 65 70 70 61 72 74 73 3a 20 22 20 73 " stepparts: " s
2150: 74 65 70 70 61 72 74 73 0a 09 09 09 09 09 09 09 tepparts........
2160: 09 22 20 73 74 65 70 70 61 72 6d 73 3a 20 22 20 ." stepparms: "
2170: 73 74 65 70 70 61 72 6d 73 20 22 20 73 74 65 70 stepparms " step
2180: 63 6d 64 3a 20 22 20 73 74 65 70 63 6d 64 29 0a cmd: " stepcmd).
2190: 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 09 ...... .......
21a0: 20 20 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 (if (file-exi
21b0: 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 65 70 6e sts? (conc stepn
21c0: 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 29 28 ame ".logpro"))(
21d0: 73 65 74 21 20 6c 6f 67 70 72 6f 2d 75 73 65 64 set! logpro-used
21e0: 20 23 74 29 29 0a 0a 09 09 09 09 09 09 20 20 20 #t))........
21f0: 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 6f 75 72 ;; ;; first sour
2200: 63 65 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 ce the previous
2210: 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 09 09 09 environment.....
2220: 09 09 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 70 .. ;; (let ((p
2230: 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 20 22 2e rev-env (conc ".
2240: 65 7a 73 74 65 70 73 2f 22 20 70 72 65 76 73 74 ezsteps/" prevst
2250: 65 70 20 28 69 66 20 28 73 74 72 69 6e 67 2d 73 ep (if (string-s
2260: 65 61 72 63 68 20 28 72 65 67 65 78 70 20 22 63 earch (regexp "c
2270: 73 68 22 29 20 0a 09 09 09 09 09 09 20 20 20 3b sh") ....... ;
2280: 3b 20 20 20 20 20 20 09 09 09 09 09 09 09 20 28 ; ....... (
2290: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
22a0: 76 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 variable "SHELL"
22b0: 29 29 20 22 2e 63 73 68 22 20 22 2e 73 68 22 29 )) ".csh" ".sh")
22c0: 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 )))....... ;;
22d0: 20 20 28 69 66 20 28 61 6e 64 20 70 72 65 76 73 (if (and prevs
22e0: 74 65 70 20 28 66 69 6c 65 2d 65 78 69 73 74 73 tep (file-exists
22f0: 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a 09 09 09 ? prev-env))....
2300: 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 20 28 ... ;; (
2310: 73 65 74 21 20 73 63 72 69 70 74 20 28 63 6f 6e set! script (con
2320: 63 20 73 63 72 69 70 74 20 22 73 6f 75 72 63 65 c script "source
2330: 20 22 20 70 72 65 76 2d 65 6e 76 29 29 29 29 0a " prev-env)))).
2340: 09 09 09 09 09 09 20 20 20 0a 09 09 09 09 09 09 ...... .......
2350: 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 20 63 ;; call the c
2360: 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d 74 5f ommand using mt_
2370: 65 7a 73 74 65 70 0a 09 09 09 09 09 09 20 20 20 ezstep.......
2380: 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 6f (set! script (co
2390: 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 20 22 20 nc "mt_ezstep "
23a0: 73 74 65 70 6e 61 6d 65 20 22 20 22 20 28 69 66 stepname " " (if
23b0: 20 70 72 65 76 73 74 65 70 20 70 72 65 76 73 74 prevstep prevst
23c0: 65 70 20 22 2d 22 29 20 22 20 22 20 73 74 65 70 ep "-") " " step
23d0: 63 6d 64 29 29 0a 0a 09 09 09 09 09 09 20 20 20 cmd))........
23e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
23f0: 73 63 72 69 70 74 3a 20 22 20 73 63 72 69 70 74 script: " script
2400: 29 0a 0a 09 09 09 09 09 09 20 20 20 28 63 64 62 )........ (cdb
2410: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 74 :remote-run db:t
2420: 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 eststep-set-stat
2430: 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 73 us! #f test-id s
2440: 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 22 20 tepname "start"
2450: 22 2d 22 20 23 66 20 23 66 29 0a 09 09 09 09 09 "-" #f #f)......
2460: 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 . ;; now launc
2470: 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 74 20 h....... (let
2480: 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 ((pid (process-r
2490: 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 09 09 un script)))....
24a0: 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 72 6f ... (let pro
24b0: 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 29 29 cessloop ((i 0))
24c0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ....... (l
24d0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 et-values (((pid
24e0: 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 -val exit-status
24f0: 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 6f 63 exit-code)(proc
2500: 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 ess-wait pid #t)
2510: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d ))......... (m
2520: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
2530: 09 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 ...... (vector
2540: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
2550: 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 09 20 0 pid).........
2560: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 (vector-set! e
2570: 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d xit-info 1 exit-
2580: 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 09 status).........
2590: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
25a0: 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 exit-info 2 exit
25b0: 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 09 20 -code).........
25c0: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
25d0: 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 m)......... (
25e0: 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 if (eq? pid-val
25f0: 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 0).........
2600: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 (begin........
2610: 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 .. (thread-sleep
2620: 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 20 28 ! 2).......... (
2630: 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b 20 69 processloop (+ i
2640: 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 09 20 1)))).........
2650: 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )).
2660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2680: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
2690: 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d (exinfo (vector-
26a0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
26b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
26f0: 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 6f 2d gfna (if logpro-
2700: 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 70 6e used (conc stepn
2710: 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 22 29 ame ".html") "")
2720: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2730: 3b 3b 20 74 65 73 74 69 6e 67 20 69 66 20 70 72 ;; testing if pr
2740: 6f 63 65 64 75 72 65 73 20 63 61 6c 6c 65 64 20 ocedures called
2750: 69 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 6c 6c in a remote call
2760: 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d 73 20 cause problems
2770: 28 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f 20 49 (ans: no or so I
2780: 20 73 75 73 70 65 63 74 29 0a 09 09 09 09 09 09 suspect).......
2790: 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f (cdb:remo
27a0: 74 65 2d 72 75 6e 20 64 62 3a 74 65 73 74 73 74 te-run db:testst
27b0: 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 23 ep-set-status! #
27c0: 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 f test-id stepna
27d0: 6d 65 20 22 65 6e 64 22 20 65 78 69 6e 66 6f 20 me "end" exinfo
27e0: 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 09 09 09 #f logfna)).....
27f0: 09 09 20 20 20 20 20 28 69 66 20 6c 6f 67 70 72 .. (if logpr
2800: 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 09 20 28 o-used........ (
2810: 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 cdb:test-set-log
2820: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 20 74 ! *runremote* t
2830: 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 65 est-id (conc ste
2840: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 29 pname ".html")))
2850: 0a 09 09 09 09 09 09 20 20 20 20 20 3b 3b 20 73 ....... ;; s
2860: 65 74 20 74 68 65 20 74 65 73 74 20 66 69 6e 61 et the test fina
2870: 6c 20 73 74 61 74 75 73 0a 09 09 09 09 09 09 20 l status.......
2880: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 68 69 73 (let* ((this
2890: 2d 73 74 65 70 2d 73 74 61 74 75 73 20 28 63 6f -step-status (co
28a0: 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 nd..........
28b0: 20 20 20 28 28 61 6e 64 20 28 65 71 3f 20 28 76 ((and (eq? (v
28c0: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
28d0: 6e 66 6f 20 32 29 20 32 29 20 6c 6f 67 70 72 6f nfo 2) 2) logpro
28e0: 2d 75 73 65 64 29 20 27 77 61 72 6e 29 0a 09 09 -used) 'warn)...
28f0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 ....... ((
2900: 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 eq? (vector-ref
2910: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 29 20 exit-info 2) 0)
2920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2930: 20 20 27 70 61 73 73 29 0a 09 09 09 09 09 09 09 'pass)........
2940: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 .. (else '
2950: 66 61 69 6c 29 29 29 0a 09 09 09 09 09 09 09 20 fail)))........
2960: 20 20 20 28 6f 76 65 72 61 6c 6c 2d 73 74 61 74 (overall-stat
2970: 75 73 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 09 us (cond......
2980: 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f .... ((eq?
2990: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 rollup-status 2
29a0: 29 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 ) 'warn)........
29b0: 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 .. ((eq? r
29c0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 20 ollup-status 0)
29d0: 27 70 61 73 73 29 0a 09 09 09 09 09 09 09 09 09 'pass)..........
29e0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 (else 'fa
29f0: 69 6c 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 il)))........
2a00: 20 28 6e 65 78 74 2d 73 74 61 74 75 73 20 20 20 (next-status
2a10: 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 09 09 09 (cond .......
2a20: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
2a30: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 overall-status '
2a40: 70 61 73 73 29 20 74 68 69 73 2d 73 74 65 70 2d pass) this-step-
2a50: 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 09 09 status).........
2a60: 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 . ((eq? ov
2a70: 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 77 61 erall-status 'wa
2a80: 72 6e 29 0a 09 09 09 09 09 09 09 09 09 09 28 69 rn)...........(i
2a90: 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 65 70 f (eq? this-step
2aa0: 2d 73 74 61 74 75 73 20 27 66 61 69 6c 29 20 27 -status 'fail) '
2ab0: 66 61 69 6c 20 27 77 61 72 6e 29 29 0a 09 09 09 fail 'warn))....
2ac0: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 6c ...... (el
2ad0: 73 65 20 27 66 61 69 6c 29 29 29 29 0a 09 09 09 se 'fail))))....
2ae0: 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
2af0: 3a 70 72 69 6e 74 20 34 20 22 45 78 69 74 20 76 :print 4 "Exit v
2b00: 61 6c 75 65 20 72 65 63 65 69 76 65 64 3a 20 22 alue received: "
2b10: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
2b20: 74 2d 69 6e 66 6f 20 32 29 20 22 20 6c 6f 67 70 t-info 2) " logp
2b30: 72 6f 2d 75 73 65 64 3a 20 22 20 6c 6f 67 70 72 ro-used: " logpr
2b40: 6f 2d 75 73 65 64 20 0a 09 09 09 09 09 09 09 09 o-used .........
2b50: 20 20 20 20 22 20 74 68 69 73 2d 73 74 65 70 2d " this-step-
2b60: 73 74 61 74 75 73 3a 20 22 20 74 68 69 73 2d 73 status: " this-s
2b70: 74 65 70 2d 73 74 61 74 75 73 20 22 20 6f 76 65 tep-status " ove
2b80: 72 61 6c 6c 2d 73 74 61 74 75 73 3a 20 22 20 6f rall-status: " o
2b90: 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 0a 09 verall-status ..
2ba0: 09 09 09 09 09 09 09 20 20 20 20 22 20 6e 65 78 ....... " nex
2bb0: 74 2d 73 74 61 74 75 73 3a 20 22 20 6e 65 78 74 t-status: " next
2bc0: 2d 73 74 61 74 75 73 20 22 20 72 6f 6c 6c 75 70 -status " rollup
2bd0: 2d 73 74 61 74 75 73 3a 20 22 20 72 6f 6c 6c 75 -status: " rollu
2be0: 70 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 p-status).......
2bf0: 20 20 20 20 20 20 20 28 63 61 73 65 20 6e 65 78 (case nex
2c00: 74 2d 73 74 61 74 75 73 0a 09 09 09 09 09 09 09 t-status........
2c10: 20 28 28 77 61 72 6e 29 0a 09 09 09 09 09 09 09 ((warn)........
2c20: 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 (set! rollup-s
2c30: 74 61 74 75 73 20 32 29 0a 09 09 09 09 09 09 09 tatus 2)........
2c40: 20 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 ;; NB// test-s
2c50: 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 20 et-status! does
2c60: 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 rdb calls under
2c70: 74 68 65 20 68 6f 6f 64 0a 09 09 09 09 09 09 09 the hood........
2c80: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
2c90: 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 t-status! test-i
2ca0: 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 57 41 52 d "RUNNING" "WAR
2cb0: 4e 22 20 0a 09 09 09 09 09 09 09 09 09 20 20 28 N" .......... (
2cc0: 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 65 if (eq? this-ste
2cd0: 70 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 20 p-status 'warn)
2ce0: 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 6e 67 20 "Logpro warning
2cf0: 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 09 found" #f)......
2d00: 09 09 09 09 20 20 23 66 29 29 0a 09 09 09 09 09 .... #f))......
2d10: 09 09 20 28 28 70 61 73 73 29 0a 09 09 09 09 09 .. ((pass)......
2d20: 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d .. (tests:test-
2d30: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test
2d40: 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 50 -id "RUNNING" "P
2d50: 41 53 53 22 20 23 66 20 23 66 29 29 0a 09 09 09 ASS" #f #f))....
2d60: 09 09 09 09 20 28 65 6c 73 65 20 3b 3b 20 27 66 .... (else ;; 'f
2d70: 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 73 65 ail........ (se
2d80: 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 t! rollup-status
2d90: 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 66 61 69 1) ;; force fai
2da0: 6c 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 74 l........ (test
2db0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
2dc0: 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e s! test-id "RUNN
2dd0: 49 4e 47 22 20 22 46 41 49 4c 22 20 28 63 6f 6e ING" "FAIL" (con
2de0: 63 20 22 46 61 69 6c 65 64 20 61 74 20 73 74 65 c "Failed at ste
2df0: 70 20 22 20 73 74 65 70 6e 61 6d 65 29 20 23 66 p " stepname) #f
2e00: 29 0a 09 09 09 09 09 09 09 20 20 29 29 29 29 0a )........ )))).
2e10: 09 09 09 09 09 09 20 20 20 28 69 66 20 28 61 6e ...... (if (an
2e20: 64 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f d (steprun-good?
2e30: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 76 65 logpro-used (ve
2e40: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2e50: 66 6f 20 32 29 29 0a 09 09 09 09 09 09 09 20 20 fo 2))........
2e60: 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 (not (null? ta
2e70: 6c 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 l))).......
2e80: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
2e90: 29 20 28 63 64 72 20 74 61 6c 29 20 73 74 65 70 ) (cdr tal) step
2ea0: 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 09 20 28 name)))....... (
2eb0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 57 debug:print 4 "W
2ec0: 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 6f 72 20 ARNING: a prior
2ed0: 73 74 65 70 20 66 61 69 6c 65 64 2c 20 73 74 6f step failed, sto
2ee0: 70 70 69 6e 67 20 61 74 20 22 20 65 7a 73 74 65 pping at " ezste
2ef0: 70 29 29 29 29 29 29 29 29 0a 09 09 20 28 6d 6f p))))))))... (mo
2f00: 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 nitorjob (lamb
2f10: 64 61 20 28 29 0a 09 09 09 09 20 28 6c 65 74 2a da ()..... (let*
2f20: 20 28 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 ((start-seconds
2f30: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
2f40: 73 29 29 0a 09 09 09 09 09 28 63 61 6c 63 2d 6d s))......(calc-m
2f50: 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 inutes (lambda
2f60: 28 29 0a 09 09 09 09 09 09 09 20 28 69 6e 65 78 ()........ (inex
2f70: 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 09 09 09 act->exact .....
2f80: 09 09 09 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 ... (round ....
2f90: 09 09 09 09 20 20 20 28 2d 20 0a 09 09 09 09 09 .... (- ......
2fa0: 09 09 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 .. (current-s
2fb0: 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 09 09 09 econds) ........
2fc0: 20 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 start-second
2fd0: 73 29 29 29 29 29 0a 09 09 09 09 09 28 6b 69 6c s)))))......(kil
2fe0: 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 09 09 09 l-tries 0)).....
2ff0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d (let loop ((m
3000: 69 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d 6d inutes (calc-m
3010: 69 6e 75 74 65 73 29 29 29 0a 09 09 09 09 20 20 inutes))).....
3020: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 (begin.....
3030: 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d (set! kill-
3040: 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 74 2d 6b job? (test-get-k
3050: 69 6c 6c 2d 72 65 71 75 65 73 74 20 74 65 73 74 ill-request test
3060: 2d 69 64 29 29 20 3b 3b 20 72 75 6e 2d 69 64 20 -id)) ;; run-id
3070: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
3080: 74 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 t))..... (
3090: 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 open-run-close t
30a0: 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 est-set-meta-inf
30b0: 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e o #f test-id run
30c0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
30d0: 65 6d 64 61 74 20 6d 69 6e 75 74 65 73 29 0a 09 emdat minutes)..
30e0: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 6b 69 ... (if ki
30f0: 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 09 09 09 20 20 ll-job? ......
3100: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 20 20 (begin......
3110: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
3120: 29 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 )...... (let
3130: 2a 20 28 28 70 69 64 20 28 76 65 63 74 6f 72 2d * ((pid (vector-
3140: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3150: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ))...... (
3160: 69 66 20 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 if (number? pid)
3170: 0a 09 09 09 09 09 09 20 20 20 28 62 65 67 69 6e ....... (begin
3180: 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 65 62 ....... (deb
3190: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
31a0: 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 ING: Request rec
31b0: 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f eived to kill jo
31c0: 62 20 28 61 74 74 65 6d 70 74 20 23 20 22 20 6b b (attempt # " k
31d0: 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 0a 09 ill-tries ")")..
31e0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 ..... (let (
31f0: 28 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d (processes (cmd-
3200: 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 run->list (conc
3210: 22 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 "pgrep -l -P " p
3220: 69 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 id)))).......
3230: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 09 (for-each ..
3240: 09 09 09 09 09 09 28 6c 61 6d 62 64 61 20 28 70 ......(lambda (p
3250: 29 0a 09 09 09 09 09 09 09 20 20 28 6c 65 74 2a )........ (let*
3260: 20 28 28 70 61 72 74 73 20 20 28 73 74 72 69 6e ((parts (strin
3270: 67 2d 73 70 6c 69 74 20 70 29 29 0a 09 09 09 09 g-split p)).....
3280: 09 09 09 09 20 28 70 2d 69 64 20 20 20 28 69 66 .... (p-id (if
3290: 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 74 (> (length part
32a0: 73 29 20 30 29 0a 09 09 09 09 09 09 09 09 09 20 s) 0)..........
32b0: 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d (string->num
32c0: 62 65 72 20 28 63 61 72 20 70 61 72 74 73 29 29 ber (car parts))
32d0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 23 .......... #
32e0: 66 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 f)))........
32f0: 28 69 66 20 70 2d 69 64 0a 09 09 09 09 09 09 09 (if p-id........
3300: 09 28 62 65 67 69 6e 0a 09 09 09 09 09 09 09 09 .(begin.........
3310: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3320: 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 63 61 64 "Killing " (cad
3330: 72 20 70 61 72 74 73 29 20 22 3b 20 6b 69 6c 6c r parts) "; kill
3340: 20 2d 39 20 20 22 20 70 2d 69 64 29 0a 09 09 09 -9 " p-id)....
3350: 09 09 09 09 09 20 20 28 73 79 73 74 65 6d 20 28 ..... (system (
3360: 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 conc "kill -9 "
3370: 70 2d 69 64 29 29 29 29 29 29 0a 09 09 09 09 09 p-id))))))......
3380: 09 09 28 63 61 72 20 70 72 6f 63 65 73 73 65 73 ..(car processes
3390: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
33a0: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b (system (conc "k
33b0: 69 6c 6c 20 2d 39 20 2d 22 20 70 69 64 29 29 29 ill -9 -" pid)))
33c0: 29 0a 09 09 09 09 09 09 20 20 20 28 62 65 67 69 )....... (begi
33d0: 6e 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 65 n....... (de
33e0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
33f0: 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 NING: Request re
3400: 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a ceived to kill j
3410: 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 6d 20 77 ob but problem w
3420: 69 74 68 20 70 72 6f 63 65 73 73 2c 20 61 74 74 ith process, att
3430: 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 empting to kill
3440: 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 73 73 22 manager process"
3450: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 74 65 )....... (te
3460: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
3470: 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 4b 49 tus! test-id "KI
3480: 4c 4c 45 44 22 20 20 22 46 41 49 4c 22 0a 09 09 LLED" "FAIL"...
3490: 09 09 09 09 09 09 20 20 20 20 20 28 61 72 67 73 ...... (args
34a0: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 :get-arg "-m") #
34b0: 66 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 73 f)....... (s
34c0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
34d0: 20 74 64 62 29 0a 09 09 09 09 09 09 20 20 20 20 tdb).......
34e0: 20 28 65 78 69 74 20 31 29 29 29 29 0a 09 09 09 (exit 1))))....
34f0: 09 09 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c .. (set! kil
3500: 6c 2d 74 72 69 65 73 20 28 2b 20 31 20 6b 69 6c l-tries (+ 1 kil
3510: 6c 2d 74 72 69 65 73 29 29 0a 09 09 09 09 09 20 l-tries))......
3520: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
3530: 6b 21 20 6d 29 29 29 0a 09 09 09 09 20 20 20 20 k! m))).....
3540: 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 ;; (sqlite3:f
3550: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 09 inalize! db)....
3560: 09 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d . (thread-
3570: 73 6c 65 65 70 21 20 28 2b 20 31 30 20 28 72 61 sleep! (+ 10 (ra
3580: 6e 64 6f 6d 20 31 30 29 29 29 20 3b 3b 20 61 64 ndom 10))) ;; ad
3590: 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 6f d some jitter to
35a0: 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 74 the call home t
35b0: 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f 75 ime to spread ou
35c0: 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73 65 t the db accesse
35d0: 73 0a 09 09 09 09 20 20 20 20 20 20 20 28 6c 6f s..... (lo
35e0: 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 op (calc-minutes
35f0: 29 29 29 29 29 29 29 0a 09 09 20 28 74 68 31 20 )))))))... (th1
3600: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 (make-t
3610: 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 hread monitorjob
3620: 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 20 20 ))... (th2
3630: 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 (make-thread
3640: 20 72 75 6e 69 74 29 29 29 0a 09 20 20 20 20 28 runit))).. (
3650: 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 20 set! job-thread
3660: 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 th2).. (threa
3670: 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 d-start! th1)..
3680: 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 (thread-start
3690: 21 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 ! th2).. (thr
36a0: 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 ead-join! th2)..
36b0: 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 (mutex-lock!
36c0: 20 6d 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 m).. (let* (
36d0: 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d (item-path (item
36e0: 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
36f0: 64 61 74 29 29 0a 09 09 20 20 20 28 74 65 73 74 dat))... (test
3700: 69 6e 66 6f 20 20 28 63 64 62 3a 67 65 74 2d 74 info (cdb:get-t
3710: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 2a est-info-by-id *
3720: 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d runremote* test-
3730: 69 64 29 29 29 20 3b 3b 20 29 29 20 3b 3b 20 72 id))) ;; )) ;; r
3740: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
3750: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 item-path)))..
3760: 20 20 20 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 ;; Am I comp
3770: 6c 65 74 65 64 3f 0a 09 20 20 20 20 20 20 28 69 leted?.. (i
3780: 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 f (not (equal? (
3790: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
37a0: 65 20 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d e testinfo) "COM
37b0: 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 28 62 PLETED"))... (b
37c0: 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 62 75 egin... (debu
37d0: 67 3a 70 72 69 6e 74 20 32 20 22 54 65 73 74 20 g:print 2 "Test
37e0: 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 4f NOT logged as CO
37f0: 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 3d MPLETED, (state=
3800: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 " (db:test-get-s
3810: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) "
3820: 29 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 75 ), updating resu
3830: 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 lt, rollup-statu
3840: 73 20 69 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 s is " rollup-st
3850: 61 74 75 73 29 0a 09 09 20 20 20 20 28 74 65 73 atus)... (tes
3860: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
3870: 75 73 21 20 74 65 73 74 2d 69 64 20 0a 09 09 09 us! test-id ....
3880: 09 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f . (if kill-jo
3890: 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d b? "KILLED" "COM
38a0: 50 4c 45 54 45 44 22 29 0a 09 09 09 09 20 20 20 PLETED").....
38b0: 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 20 (cond.....
38c0: 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 ((not (vector-re
38d0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 20 f exit-info 1))
38e0: 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 20 66 "FAIL") ;; job f
38f0: 61 69 6c 65 64 20 74 6f 20 72 75 6e 0a 09 09 09 ailed to run....
3900: 09 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c . ((eq? roll
3910: 75 70 2d 73 74 61 74 75 73 20 30 29 0a 09 09 09 up-status 0)....
3920: 09 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 . ;; if the
3930: 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 current status
3940: 69 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 is AUTO the defe
3950: 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 r to the calcula
3960: 74 65 64 20 76 61 6c 75 65 20 28 69 2e 65 2e 20 ted value (i.e.
3970: 6c 65 61 76 65 20 74 68 69 73 20 41 55 54 4f 29 leave this AUTO)
3980: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
3990: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
39a0: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 get-status testi
39b0: 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 nfo) "AUTO") "AU
39c0: 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 09 09 TO" "PASS"))....
39d0: 09 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c . ((eq? roll
39e0: 75 70 2d 73 74 61 74 75 73 20 31 29 20 22 46 41 up-status 1) "FA
39f0: 49 4c 22 29 0a 09 09 09 09 20 20 20 20 20 28 28 IL")..... ((
3a00: 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 eq? rollup-statu
3a10: 73 20 32 29 0a 09 09 09 09 20 20 20 20 20 20 3b s 2)..... ;
3a20: 3b 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 ; if the current
3a30: 20 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 status is AUTO
3a40: 74 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 the defer to the
3a50: 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 calculated valu
3a60: 65 20 62 75 74 20 71 75 61 6c 69 66 79 20 28 69 e but qualify (i
3a70: 2e 65 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 55 .e. make this AU
3a80: 54 4f 2d 57 41 52 4e 29 0a 09 09 09 09 20 20 20 TO-WARN).....
3a90: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
3aa0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
3ab0: 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 us testinfo) "AU
3ac0: 54 4f 22 29 20 22 41 55 54 4f 2d 57 41 52 4e 22 TO") "AUTO-WARN"
3ad0: 20 22 57 41 52 4e 22 29 29 0a 09 09 09 09 20 20 "WARN")).....
3ae0: 20 20 20 28 65 6c 73 65 20 22 46 41 49 4c 22 29 (else "FAIL")
3af0: 29 0a 09 09 09 09 20 20 20 20 28 61 72 67 73 3a )..... (args:
3b00: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 get-arg "-m") #f
3b10: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f ))).. ;; fo
3b20: 72 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 r automated crea
3b30: 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c tion of the roll
3b40: 75 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 up html file thi
3b50: 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 s is a good plac
3b60: 65 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 e..... (if
3b70: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 (not (equal? ite
3b80: 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 m-path ""))...
3b90: 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 (open-run-close
3ba0: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
3bb0: 69 74 65 6d 73 20 23 66 20 72 75 6e 2d 69 64 20 items #f run-id
3bc0: 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 20 3b test-name #f)) ;
3bd0: 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 ; don't force -
3be0: 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e just update if n
3bf0: 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 20 o.. )..
3c00: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
3c10: 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 65 63 2d ).. ;; (exec-
3c20: 72 65 73 75 6c 74 73 20 28 63 6d 64 2d 72 75 6e results (cmd-run
3c30: 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 6e 73 63 ->list fullrunsc
3c40: 72 69 70 74 29 29 20 3b 3b 20 20 28 6c 69 73 74 ript)) ;; (list
3c50: 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 73 74 2d ">" (conc test-
3c60: 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 name "-run.log")
3c70: 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 73 75 63 ))).. ;; (suc
3c80: 63 65 73 73 20 20 20 20 20 20 65 78 65 63 2d 72 cess exec-r
3c90: 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 65 71 3f esults)) ;; (eq?
3ca0: 20 28 63 61 64 72 20 65 78 65 63 2d 72 65 73 75 (cadr exec-resu
3cb0: 6c 74 73 29 20 30 29 29 29 0a 09 20 20 20 20 28 lts) 0))).. (
3cc0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4f debug:print 2 "O
3cd0: 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 utput from runni
3ce0: 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 ng " fullrunscri
3cf0: 70 74 20 22 2c 20 70 69 64 20 22 20 28 76 65 63 pt ", pid " (vec
3d00: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3d10: 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 o 0) " in work a
3d20: 72 65 61 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d rea " .... work-
3d30: 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 area ":\n====\n
3d40: 65 78 69 74 20 63 6f 64 65 20 22 20 28 76 65 63 exit code " (vec
3d50: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3d60: 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c o 2) "\n" "====\
3d70: 6e 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c n").. ;; (sql
3d80: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
3d90: 62 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 b).. ;; (sqli
3da0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 te3:finalize! td
3db0: 62 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 b).. (if (not
3dc0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
3dd0: 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 28 65 78 t-info 1))...(ex
3de0: 69 74 20 34 29 29 29 29 29 29 29 0a 0a 3b 3b 20 it 4)))))))..;;
3df0: 73 65 74 20 75 70 20 74 68 65 20 76 65 72 79 20 set up the very
3e00: 62 61 73 69 63 73 20 6e 65 65 64 65 64 20 66 6f basics needed fo
3e10: 72 20 64 6f 69 6e 67 20 61 6e 79 74 68 69 6e 67 r doing anything
3e20: 20 68 65 72 65 2e 0a 28 64 65 66 69 6e 65 20 28 here..(define (
3e30: 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 setup-for-run).
3e40: 20 3b 3b 20 77 6f 75 6c 64 20 73 65 74 20 76 61 ;; would set va
3e50: 6c 75 65 73 20 66 6f 72 20 4b 45 59 53 20 69 6e lues for KEYS in
3e60: 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 the environment
3e70: 20 68 65 72 65 20 66 6f 72 20 62 65 74 74 65 72 here for better
3e80: 20 73 75 70 70 6f 72 74 20 6f 66 20 65 6e 76 2d support of env-
3e90: 6f 76 65 72 72 69 64 65 20 62 75 74 20 0a 20 20 override but .
3ea0: 3b 3b 20 68 61 76 65 20 63 68 69 63 6b 65 6e 2f ;; have chicken/
3eb0: 65 67 67 20 73 63 65 6e 61 72 69 6f 2e 20 6e 65 egg scenario. ne
3ec0: 65 64 20 74 6f 20 72 65 61 64 20 6d 65 67 61 74 ed to read megat
3ed0: 65 73 74 2e 63 6f 6e 66 69 67 20 74 68 65 6e 20 est.config then
3ee0: 72 65 61 64 20 69 74 20 61 67 61 69 6e 2e 20 47 read it again. G
3ef0: 6f 69 6e 67 20 74 6f 20 0a 20 20 3b 3b 20 70 61 oing to . ;; pa
3f00: 73 73 20 6f 6e 20 74 68 61 74 20 69 64 65 61 20 ss on that idea
3f10: 66 6f 72 20 6e 6f 77 0a 20 20 3b 3b 20 73 70 65 for now. ;; spe
3f20: 63 69 61 6c 20 63 61 73 65 0a 20 20 28 73 65 74 cial case. (set
3f30: 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 ! *configinfo* (
3f40: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
3f50: 6e 66 69 67 20 0a 09 09 20 20 20 20 20 20 28 69 nfig ... (i
3f60: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
3f70: 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 67 73 3a "-config")(args:
3f80: 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 get-arg "-config
3f90: 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e ") "megatest.con
3fa0: 66 69 67 22 29 0a 09 09 20 20 20 20 20 20 65 6e fig")... en
3fb0: 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 viron-patt: "env
3fc0: 2d 6f 76 65 72 72 69 64 65 22 0a 09 09 20 20 20 -override"...
3fd0: 20 20 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 given-toppath
3fe0: 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 : (get-environme
3ff0: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f nt-variable "MT_
4000: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 0a RUN_AREA_HOME").
4010: 09 09 20 20 20 20 20 20 70 61 74 68 65 6e 76 76 .. pathenvv
4020: 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ar: "MT_RUN_AREA
4030: 5f 48 4f 4d 45 22 29 29 0a 20 20 28 73 65 74 21 _HOME")). (set!
4040: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 28 69 *configdat* (i
4050: 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e f (car *configin
4060: 66 6f 2a 29 28 63 61 72 20 2a 63 6f 6e 66 69 67 fo*)(car *config
4070: 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 73 info*) #f)). (s
4080: 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 et! *toppath*
4090: 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 (if (car *confi
40a0: 67 69 6e 66 6f 2a 29 28 63 61 64 72 20 2a 63 6f ginfo*)(cadr *co
40b0: 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a nfiginfo*) #f)).
40c0: 20 20 28 69 66 20 2a 74 6f 70 70 61 74 68 2a 0a (if *toppath*.
40d0: 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d (setenv "M
40e0: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
40f0: 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b 20 74 *toppath*) ;; t
4100: 6f 20 62 65 20 64 65 70 72 65 63 61 74 65 64 0a o be deprecated.
4110: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
4120: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 66 61 69 nt 0 "ERROR: fai
4130: 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 68 65 20 led to find the
4140: 74 6f 70 20 70 61 74 68 20 74 6f 20 79 6f 75 72 top path to your
4150: 20 72 75 6e 20 73 65 74 75 70 2e 22 29 29 0a 20 run setup.")).
4160: 20 2a 74 6f 70 70 61 74 68 2a 29 0a 0a 28 64 65 *toppath*)..(de
4170: 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d 64 fine (get-best-d
4180: 69 73 6b 20 63 6f 6e 66 64 61 74 29 0a 20 20 28 isk confdat). (
4190: 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 20 20 20 let* ((disks
41a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
41b0: 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 20 default confdat
41c0: 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 20 28 "disks" #f)).. (
41d0: 62 65 73 74 20 20 20 20 20 23 66 29 0a 09 20 28 best #f).. (
41e0: 62 65 73 74 73 69 7a 65 20 30 29 29 0a 20 20 20 bestsize 0)).
41f0: 20 28 69 66 20 64 69 73 6b 73 20 0a 09 28 66 6f (if disks ..(fo
4200: 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 6d 62 64 r-each .. (lambd
4210: 61 20 28 64 69 73 6b 2d 6e 75 6d 29 0a 09 20 20 a (disk-num)..
4220: 20 28 6c 65 74 2a 20 28 28 64 69 72 70 61 74 68 (let* ((dirpath
4230: 20 20 20 20 28 63 61 64 72 20 28 61 73 73 6f 63 (cadr (assoc
4240: 20 64 69 73 6b 2d 6e 75 6d 20 64 69 73 6b 73 29 disk-num disks)
4250: 29 29 0a 09 09 20 20 28 66 72 65 65 73 70 63 20 ))... (freespc
4260: 20 20 20 28 69 66 20 28 61 6e 64 20 28 64 69 72 (if (and (dir
4270: 65 63 74 6f 72 79 3f 20 64 69 72 70 61 74 68 29 ectory? dirpath)
4280: 0a 09 09 09 09 20 20 20 20 20 20 20 28 66 69 6c ..... (fil
4290: 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 e-write-access?
42a0: 64 69 72 70 61 74 68 29 29 0a 09 09 09 09 20 20 dirpath)).....
42b0: 28 67 65 74 2d 64 66 20 64 69 72 70 61 74 68 29 (get-df dirpath)
42c0: 0a 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 ..... (begin...
42d0: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
42e0: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 70 nt 0 "WARNING: p
42f0: 61 74 68 20 22 20 64 69 72 70 61 74 68 20 22 20 ath " dirpath "
4300: 69 6e 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 69 in [disks] secti
4310: 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 20 6f 72 20 on not valid or
4320: 77 72 69 74 61 62 6c 65 22 29 0a 09 09 09 09 20 writable").....
4330: 20 20 20 30 29 29 29 29 0a 09 20 20 20 20 20 28 0)))).. (
4340: 69 66 20 28 3e 20 66 72 65 65 73 70 63 20 62 65 if (> freespc be
4350: 73 74 73 69 7a 65 29 0a 09 09 20 28 62 65 67 69 stsize)... (begi
4360: 6e 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 73 n... (set! bes
4370: 74 20 20 20 20 20 64 69 72 70 61 74 68 29 0a 09 t dirpath)..
4380: 09 20 20 20 28 73 65 74 21 20 62 65 73 74 73 69 . (set! bestsi
4390: 7a 65 20 66 72 65 65 73 70 63 29 29 29 29 29 0a ze freespc))))).
43a0: 09 20 28 6d 61 70 20 63 61 72 20 64 69 73 6b 73 . (map car disks
43b0: 29 29 29 0a 20 20 20 20 28 69 66 20 62 65 73 74 ))). (if best
43c0: 0a 09 62 65 73 74 0a 09 28 62 65 67 69 6e 0a 09 ..best..(begin..
43d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
43e0: 20 22 45 52 52 4f 52 3a 20 4e 6f 20 76 61 6c 69 "ERROR: No vali
43f0: 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 69 6e d disks found in
4400: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
4410: 2e 20 50 6c 65 61 73 65 20 61 64 64 20 73 6f 6d . Please add som
4420: 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 6b 73 e to your [disks
4430: 5d 20 73 65 63 74 69 6f 6e 22 29 0a 09 20 20 28 ] section").. (
4440: 65 78 69 74 20 31 29 29 29 29 29 0a 0a 3b 3b 20 exit 1)))))..;;
4450: 44 65 73 69 72 65 64 20 64 69 72 65 63 74 6f 72 Desired director
4460: 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b 3b 0a y structure:.;;.
4470: 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 ;; <linkdir> -
4480: 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 <target> - <test
4490: 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 20 20 name> -..;;
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44c0: 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 |.;;
44d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44e0: 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 20 3c v.;; <
44f0: 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 61 72 rundir> - <tar
4500: 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 73 74 get> - <test
4510: 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 6d 70 name> -|- <itemp
4520: 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 ath(s)>.;;.;; d
4530: 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 65 73 ir stored in tes
4540: 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c t is:.;; .;; <l
4550: 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 65 inkdir> - <targe
4560: 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 t> - <testname>
4570: 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d [ - <itempath> ]
4580: 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 20 .;; .;; All log
4590: 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f 75 6c file links shoul
45a0: 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 6c 61 d be stored rela
45b0: 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f 70 20 tive to the top
45c0: 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b 3b 20 of link path.;;
45d0: 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 2d 20 .;; <target> -
45e0: 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c <testname> [ - <
45f0: 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b 3b 0a itempath> ] .;;.
4600: 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 65 2d (define (create-
4610: 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 6e work-area db run
4620: 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 -id test-id test
4630: 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d 70 -src-path disk-p
4640: 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 ath testname ite
4650: 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 mdat). (let* ((
4660: 72 75 6e 2d 69 6e 66 6f 20 28 63 64 62 3a 72 65 run-info (cdb:re
4670: 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d mote-run db:get-
4680: 72 75 6e 2d 69 6e 66 6f 20 23 66 20 72 75 6e 2d run-info #f run-
4690: 69 64 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 id)).. (item-pat
46a0: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
46b0: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 28 th itemdat)).. (
46c0: 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a 67 65 74 runname (db:get
46d0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
46e0: 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e (db:get-row run
46f0: 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 28 -info)...... (
4700: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
4710: 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 n-info)......
4720: 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 3b 3b "runname")).. ;;
4730: 20 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 6f convert back to
4740: 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d db: from rdb: -
4750: 20 74 68 69 73 20 69 73 20 61 6c 77 61 79 73 20 this is always
4760: 72 75 6e 20 61 74 20 73 65 72 76 65 72 20 65 6e run at server en
4770: 64 0a 09 20 28 6b 65 79 2d 76 61 6c 73 20 28 63 d.. (key-vals (c
4780: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
4790: 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 20 23 66 :get-key-vals #f
47a0: 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 74 61 72 run-id)).. (tar
47b0: 67 65 74 20 20 20 28 73 74 72 69 6e 67 2d 69 6e get (string-in
47c0: 74 65 72 73 70 65 72 73 65 20 6b 65 79 2d 76 61 tersperse key-va
47d0: 6c 73 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 ls "/"))... (not
47e0: 2d 69 74 65 72 61 74 65 64 20 20 28 65 71 75 61 -iterated (equa
47f0: 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 29 l? "" item-path)
4800: 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 74 )... ;; all test
4810: 73 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 3c s are found at <
4820: 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 rundir>/test-bas
4830: 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 e or <linkdir>/t
4840: 65 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 74 est-base.. (test
4850: 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 74 top-base (conc t
4860: 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d arget "/" runnam
4870: 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 e "/" testname))
4880: 0a 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 20 .. (test-base
4890: 20 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d 62 (conc testtop-b
48a0: 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 ase (if not-iter
48b0: 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 ated "" "/") ite
48c0: 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 6e m-path))... ;; n
48d0: 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 20 b// if itempath
48e0: 69 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 69 is not "" then i
48f0: 74 20 69 73 20 70 72 65 66 69 78 65 64 20 77 69 t is prefixed wi
4900: 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 73 th "/".. (toptes
4910: 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 73 t-path (conc dis
4920: 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 74 k-path "/" testt
4930: 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 74 65 73 op-base)).. (tes
4940: 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 t-path (conc
4950: 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 disk-path "/" te
4960: 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 3b 3b 20 st-base))... ;;
4970: 65 6e 73 75 72 65 20 74 68 69 73 20 65 78 69 73 ensure this exis
4980: 74 73 20 66 69 72 73 74 20 61 73 20 6c 69 6e 6b ts first as link
4990: 73 20 74 6f 20 73 75 62 74 65 73 74 73 20 6d 75 s to subtests mu
49a0: 73 74 20 62 65 20 63 72 65 61 74 65 64 20 74 68 st be created th
49b0: 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 65 65 20 ere.. (linktree
49c0: 20 28 6c 65 74 20 28 28 72 64 20 28 63 6f 6e 66 (let ((rd (conf
49d0: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
49e0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c gdat* "setup" "l
49f0: 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 20 20 inktree")))...
4a00: 20 20 20 20 28 69 66 20 72 64 20 72 64 20 28 63 (if rd rd (c
4a10: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
4a20: 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 28 6c 6e runs"))))... (ln
4a30: 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 6c 69 6e kbase (conc lin
4a40: 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 74 ktree "/" target
4a50: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 "/" runname))..
4a60: 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 6f 6e 63 (lnkpath (conc
4a70: 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 74 65 73 lnkbase "/" tes
4a80: 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 61 tname)).. (lnkpa
4a90: 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 thf (conc lnkpat
4aa0: 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 h (if not-iterat
4ab0: 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d ed "" "/") item-
4ac0: 70 61 74 68 29 29 29 0a 0a 20 20 20 20 3b 3b 20 path))).. ;;
4ad0: 55 70 64 61 74 65 20 74 68 65 20 72 75 6e 64 69 Update the rundi
4ae0: 72 20 70 61 74 68 20 69 6e 20 74 68 65 20 74 65 r path in the te
4af0: 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 61 6c st record for al
4b00: 6c 0a 20 20 20 20 28 63 64 62 3a 74 65 73 74 2d l. (cdb:test-
4b10: 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d 74 65 set-rundir-by-te
4b20: 73 74 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 st-id *runremote
4b30: 2a 20 74 65 73 74 2d 69 64 20 6c 6e 6b 70 61 74 * test-id lnkpat
4b40: 68 66 29 0a 0a 20 20 20 20 28 64 65 62 75 67 3a hf).. (debug:
4b50: 70 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 5c 6e print 2 "INFO:\n
4b60: 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d 22 lnkbase="
4b70: 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 20 lnkbase "\n
4b80: 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b lnkpath=" lnk
4b90: 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 73 path "\n toptes
4ba0: 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 74 t-path=" toptest
4bb0: 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 65 -path "\n te
4bc0: 73 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d 70 st-path=" test-p
4bd0: 61 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e 6f ath). (if (no
4be0: 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 t (file-exists?
4bf0: 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 67 linktree))..(beg
4c00: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
4c10: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 6c nt 0 "WARNING: l
4c20: 69 6e 6b 74 72 65 65 20 64 69 64 20 6e 6f 74 20 inktree did not
4c30: 65 78 69 73 74 21 20 43 72 65 61 74 69 6e 67 20 exist! Creating
4c40: 69 74 20 6e 6f 77 20 61 74 20 22 20 6c 69 6e 6b it now at " link
4c50: 74 72 65 65 29 0a 09 20 20 28 63 72 65 61 74 65 tree).. (create
4c60: 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b 74 -directory linkt
4c70: 72 65 65 20 23 74 29 29 29 20 3b 3b 20 28 73 79 ree #t))) ;; (sy
4c80: 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 69 stem (conc "mkdi
4c90: 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 65 65 29 r -p " linktree)
4ca0: 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 65 61 74 ))). ;; creat
4cb0: 65 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 e the directory
4cc0: 66 6f 72 20 74 68 65 20 74 65 73 74 73 20 64 69 for the tests di
4cd0: 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 20 69 73 r links, this is
4ce0: 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 74 74 65 needed no matte
4cf0: 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 20 28 69 r what.... (i
4d00: 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 f (not (director
4d10: 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 y-exists? lnkbas
4d20: 65 29 29 0a 09 28 63 72 65 61 74 65 2d 64 69 72 e))..(create-dir
4d30: 65 63 74 6f 72 79 20 6c 6e 6b 62 61 73 65 20 23 ectory lnkbase #
4d40: 74 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 t)). . ;;
4d50: 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 74 65 update the topte
4d60: 73 74 20 72 65 63 6f 72 64 20 77 69 74 68 20 69 st record with i
4d70: 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 75 6e 64 ts location rund
4d80: 69 72 2c 20 63 61 63 68 65 20 74 68 65 20 70 61 ir, cache the pa
4d90: 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 73 20 77 th. ;; This w
4da0: 61 73 73 20 68 69 67 68 6c 79 20 69 6e 65 66 66 ass highly ineff
4db0: 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 62 20 77 icient, one db w
4dc0: 72 69 74 65 20 66 6f 72 20 65 76 65 72 79 20 73 rite for every s
4dd0: 75 62 74 65 73 74 2c 20 70 6f 74 65 6e 74 69 61 ubtest, potentia
4de0: 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 6f 75 73 lly. ;; thous
4df0: 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 65 73 73 ands of unnecess
4e00: 61 72 79 20 75 70 64 61 74 65 73 2c 20 63 61 63 ary updates, cac
4e10: 68 65 20 74 68 65 20 66 61 63 74 20 69 74 20 77 he the fact it w
4e20: 61 73 20 73 65 74 20 61 6e 64 20 64 6f 6e 27 74 as set and don't
4e30: 20 73 65 74 20 69 74 20 0a 20 20 20 20 3b 3b 20 set it . ;;
4e40: 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 again. .. ;;
4e50: 4e 42 20 2d 20 54 68 69 73 20 69 73 20 6e 6f 74 NB - This is not
4e60: 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 2d working right -
4e70: 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 20 some top tests
4e80: 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 are not getting
4e90: 74 68 65 20 70 61 74 68 20 73 65 74 21 21 21 0a the path set!!!.
4ea0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 . (if (not (h
4eb0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
4ec0: 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 74 2d 70 fault *toptest-p
4ed0: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 23 aths* testname #
4ee0: 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 f))..(let* ((tes
4ef0: 74 69 6e 66 6f 20 20 20 20 20 20 20 28 63 64 62 tinfo (cdb
4f00: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
4f10: 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a y-id *runremote*
4f20: 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 test-id)) ;; r
4f30: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
4f40: 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 tem-path))..
4f50: 20 20 20 28 63 75 72 72 2d 74 65 73 74 2d 70 61 (curr-test-pa
4f60: 74 68 20 28 69 66 20 74 65 73 74 69 6e 66 6f 20 th (if testinfo
4f70: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e (db:test-get-run
4f80: 64 69 72 20 74 65 73 74 69 6e 66 6f 29 20 23 66 dir testinfo) #f
4f90: 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 ))).. (hash-tab
4fa0: 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 le-set! *toptest
4fb0: 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 -paths* testname
4fc0: 20 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 curr-test-path)
4fd0: 0a 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 .. ;; NB// Was
4fe0: 74 68 69 73 20 66 6f 72 20 74 68 65 20 74 65 73 this for the tes
4ff0: 74 20 6f 72 20 66 6f 72 20 74 68 65 20 70 61 72 t or for the par
5000: 65 6e 74 20 69 6e 20 61 6e 20 69 74 65 72 61 74 ent in an iterat
5010: 65 64 20 74 65 73 74 3f 0a 09 20 20 28 63 64 62 ed test?.. (cdb
5020: 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 :test-set-rundir
5030: 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 ! *runremote* ru
5040: 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 22 22 n-id testname ""
5050: 20 6c 6e 6b 70 61 74 68 29 20 3b 3b 20 74 6f 70 lnkpath) ;; top
5060: 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 69 test-path).. (i
5070: 66 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d f (or (not curr-
5080: 74 65 73 74 2d 70 61 74 68 29 0a 09 09 20 20 28 test-path)... (
5090: 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 not (directory-e
50a0: 78 69 73 74 73 3f 20 74 6f 70 74 65 73 74 2d 70 xists? toptest-p
50b0: 61 74 68 29 29 29 0a 09 20 20 20 20 20 20 28 62 ath))).. (b
50c0: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
50d0: 69 6e 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 int-info 2 "Crea
50e0: 74 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 ting " toptest-p
50f0: 61 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 ath " and link "
5100: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 28 63 72 65 lnkpath)...(cre
5110: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f ate-directory to
5120: 70 74 65 73 74 2d 70 61 74 68 20 23 74 29 0a 09 ptest-path #t)..
5130: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set
5140: 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 ! *toptest-paths
5150: 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 * testname topte
5160: 73 74 2d 70 61 74 68 29 29 29 29 29 0a 0a 20 20 st-path)))))..
5170: 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 ;; Now create
5180: 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 the link from th
5190: 65 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 e test path to t
51a0: 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f he link tree, ho
51b0: 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 wever. ;; if
51c0: 74 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 the test is iter
51d0: 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 ated it is neces
51e0: 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 sary to create t
51f0: 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 he parent path.
5200: 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 ;; to the ite
5210: 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 ration. use path
5220: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 name-directory t
5230: 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 o trim the path
5240: 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 by one. ;; le
5250: 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 vel. (if (not
5260: 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b not-iterated) ;
5270: 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a ; i.e. iterated.
5280: 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 .(let ((iterated
5290: 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 -parent (pathna
52a0: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f me-directory (co
52b0: 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 nc lnkpath "/" i
52c0: 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 tem-path))))..
52d0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
52e0: 6f 20 32 20 22 43 72 65 61 74 69 6e 67 20 69 74 o 2 "Creating it
52f0: 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 20 erated parent "
5300: 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 29 iterated-parent)
5310: 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
5320: 63 74 6f 72 79 20 69 74 65 72 61 74 65 64 2d 70 ctory iterated-p
5330: 61 72 65 6e 74 20 23 74 29 29 29 0a 0a 20 20 20 arent #t)))..
5340: 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d 6c (if (symbolic-l
5350: 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 20 28 64 ink? lnkpath) (d
5360: 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 70 61 elete-file lnkpa
5370: 74 68 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f th)). (if (no
5380: 74 20 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 t (or (file-exis
5390: 74 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 ts? lnkpath)...
53a0: 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 (symbolic-link?
53b0: 6c 6e 6b 70 61 74 68 29 29 29 0a 09 28 63 72 65 lnkpath)))..(cre
53c0: 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ate-symbolic-lin
53d0: 6b 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 6c k toptest-path l
53e0: 6e 6b 70 61 74 68 29 29 0a 20 20 20 20 0a 20 20 nkpath)). .
53f0: 20 20 3b 3b 20 54 68 65 20 74 6f 70 74 65 73 74 ;; The toptest
5400: 20 70 61 74 68 20 68 61 73 20 62 65 65 6e 20 63 path has been c
5410: 72 65 61 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b reated, the link
5420: 20 74 6f 20 74 68 65 20 74 65 73 74 20 69 6e 20 to the test in
5430: 74 68 65 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 the linktree has
5440: 0a 20 20 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 . ;; been cre
5450: 61 74 65 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 ated. Now, if th
5460: 69 73 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 is is an iterate
5470: 64 20 74 65 73 74 20 74 68 65 20 72 65 61 6c 20 d test the real
5480: 74 65 73 74 20 64 69 72 20 6d 75 73 74 20 62 65 test dir must be
5490: 20 63 72 65 61 74 65 64 0a 20 20 20 20 28 69 66 created. (if
54a0: 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 (not not-iterat
54b0: 65 64 29 20 3b 3b 20 74 68 69 73 20 69 73 20 61 ed) ;; this is a
54c0: 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 0a n iterated test.
54d0: 09 28 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 .(let ((lnktarge
54e0: 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 t (conc lnkpath
54f0: 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 "/" item-path)))
5500: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
5510: 20 32 20 22 53 65 74 74 69 6e 67 20 75 70 20 73 2 "Setting up s
5520: 75 62 20 74 65 73 74 20 72 75 6e 20 61 72 65 61 ub test run area
5530: 22 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 ").. (debug:pri
5540: 6e 74 20 32 20 22 20 2d 20 63 72 65 61 74 69 6e nt 2 " - creatin
5550: 67 20 72 75 6e 20 61 72 65 61 20 69 6e 20 22 20 g run area in "
5560: 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 63 test-path).. (c
5570: 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
5580: 74 65 73 74 2d 70 61 74 68 20 23 74 29 20 3b 3b test-path #t) ;;
5590: 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 (system (conc
55a0: 22 6d 6b 64 69 72 20 2d 70 20 22 20 74 65 73 74 "mkdir -p " test
55b0: 2d 70 61 74 68 29 29 0a 09 20 20 28 64 65 62 75 -path)).. (debu
55c0: 67 3a 70 72 69 6e 74 20 32 20 0a 09 09 20 20 20 g:print 2 ...
55d0: 20 20 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 " - creating
55e0: 20 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 link from: " te
55f0: 73 74 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 st-path "\n"...
5600: 20 20 20 20 20 20 22 20 20 20 20 20 20 20 20 20 "
5610: 20 20 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 to: "
5620: 6c 6e 6b 74 61 72 67 65 74 29 0a 09 20 20 3b 3b lnktarget).. ;;
5630: 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f (create-directo
5640: 72 79 20 6c 6e 6b 70 61 74 68 20 23 74 29 20 3b ry lnkpath #t) ;
5650: 3b 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 ; (system (conc
5660: 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c 6e 6b "mkdir -p " lnk
5670: 70 61 74 68 29 29 0a 0a 09 20 20 3b 3b 20 49 66 path))... ;; If
5680: 20 74 68 65 72 65 20 69 73 20 61 6c 72 65 61 64 there is alread
5690: 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 6c 65 y a symlink dele
56a0: 74 65 20 69 74 20 61 6e 64 20 72 65 63 72 65 61 te it and recrea
56b0: 74 65 20 69 74 2e 0a 09 20 20 28 69 66 20 28 73 te it... (if (s
56c0: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e ymbolic-link? ln
56d0: 6b 74 61 72 67 65 74 29 20 20 20 20 20 28 64 65 ktarget) (de
56e0: 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 lete-file lnktar
56f0: 67 65 74 29 29 0a 09 20 20 28 69 66 20 28 6e 6f get)).. (if (no
5700: 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 t (file-exists?
5710: 6c 6e 6b 74 61 72 67 65 74 29 29 20 28 63 72 65 lnktarget)) (cre
5720: 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ate-symbolic-lin
5730: 6b 20 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 k test-path lnkt
5740: 61 72 67 65 74 29 29 29 29 0a 0a 20 20 20 20 3b arget)))).. ;
5750: 3b 20 49 20 73 75 73 70 65 63 74 20 74 68 69 73 ; I suspect this
5760: 20 73 65 63 74 69 6f 6e 20 77 61 73 20 64 65 6c section was del
5770: 65 74 69 6e 67 20 74 65 73 74 20 64 69 72 65 63 eting test direc
5780: 74 6f 72 69 65 73 20 75 6e 64 65 72 20 73 6f 6d tories under som
5790: 65 20 0a 20 20 20 20 3b 3b 20 77 69 65 72 64 20 e . ;; wierd
57a0: 73 69 74 61 74 69 6f 6e 73 3f 20 54 68 69 73 20 sitations? This
57b0: 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 6e doesn't make sen
57c0: 73 65 20 2d 20 72 65 65 6e 61 62 6c 69 6e 67 20 se - reenabling
57d0: 74 68 65 20 72 6d 20 2d 66 20 0a 20 20 20 20 3b the rm -f . ;
57e0: 3b 20 49 20 68 6f 6e 65 73 74 6c 79 20 64 6f 6e ; I honestly don
57f0: 27 74 20 72 65 6d 65 6d 62 65 72 20 2a 77 68 79 't remember *why
5800: 2a 20 74 68 69 73 20 63 68 75 6e 6b 20 77 61 73 * this chunk was
5810: 20 6e 65 65 64 65 64 2e 2e 2e 0a 20 20 20 20 3b needed.... ;
5820: 3b 20 28 6c 65 74 20 28 28 74 65 73 74 6c 69 6e ; (let ((testlin
5830: 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 k (conc lnkpath
5840: 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 29 0a "/" testname))).
5850: 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 6e ;; (if (an
5860: 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 d (file-exists?
5870: 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b testlink). ;;
5880: 20 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 (or
5890: 28 72 65 67 75 6c 61 72 2d 66 69 6c 65 3f 20 74 (regular-file? t
58a0: 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 estlink). ;;
58b0: 20 20 20 20 09 20 20 20 28 73 79 6d 62 6f 6c 69 . (symboli
58c0: 63 2d 6c 69 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b c-link? testlink
58d0: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 ))). ;;
58e0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
58f0: 72 6d 20 2d 66 20 22 20 74 65 73 74 6c 69 6e 6b rm -f " testlink
5900: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 73 79 ))). ;; (sy
5910: 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 stem (conc "ln
5920: 2d 73 66 20 22 20 74 65 73 74 2d 70 61 74 68 20 -sf " test-path
5930: 22 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a " " testlink))).
5940: 20 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f (if (directo
5950: 72 79 3f 20 74 65 73 74 2d 70 61 74 68 29 0a 09 ry? test-path)..
5960: 28 62 65 67 69 6e 0a 09 20 20 28 6c 65 74 2a 20 (begin.. (let*
5970: 28 28 63 6d 64 20 20 20 20 28 63 6f 6e 63 20 22 ((cmd (conc "
5980: 72 73 79 6e 63 20 2d 61 76 22 20 28 69 66 20 28 rsync -av" (if (
5990: 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 debug:debug-mode
59a0: 20 31 29 20 22 22 20 22 71 22 29 20 22 20 22 20 1) "" "q") " "
59b0: 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 22 2f test-src-path "/
59c0: 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f 22 " test-path "/"
59d0: 29 29 0a 09 09 20 28 73 74 61 74 75 73 20 28 73 ))... (status (s
59e0: 79 73 74 65 6d 20 63 6d 64 29 29 29 0a 09 20 20 ystem cmd)))..
59f0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 (if (not (eq?
5a00: 73 74 61 74 75 73 20 30 29 29 0a 09 09 28 64 65 status 0))...(de
5a10: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 bug:print 2 "ERR
5a20: 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 OR: problem with
5a30: 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 running \"" cmd
5a40: 20 22 5c 22 22 29 29 29 0a 09 20 20 28 6c 69 73 "\""))).. (lis
5a50: 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e 6b 70 61 t lnkpathf lnkpa
5a60: 74 68 20 29 29 0a 09 28 6c 69 73 74 20 23 66 20 th ))..(list #f
5a70: 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f #f))))..;; 1. lo
5a80: 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 6b 73 20 ok though disks
5a90: 6c 69 73 74 20 66 6f 72 20 64 69 73 6b 20 77 69 list for disk wi
5aa0: 74 68 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b th most space.;;
5ab0: 20 32 2e 20 63 72 65 61 74 65 20 72 75 6e 20 64 2. create run d
5ac0: 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 ir on disk, path
5ad0: 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 name is meaning
5ae0: 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 ful.;; 3. create
5af0: 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 link from run d
5b00: 69 72 20 74 6f 20 6d 65 67 61 74 65 73 74 20 72 ir to megatest r
5b10: 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 uns area .;; 4.
5b20: 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 remotely run the
5b30: 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 test on allocat
5b40: 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 ed host.;; -
5b50: 63 6f 75 6c 64 20 62 65 20 73 73 68 20 74 6f 20 could be ssh to
5b60: 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 host from hosts
5b70: 74 61 62 6c 65 20 28 75 70 64 61 74 65 20 72 65 table (update re
5b80: 67 75 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 gularly with loa
5b90: 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 d).;; - could
5ba0: 20 62 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 be netbatch.;;
5bb0: 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 (launch-tes
5bc0: 74 20 64 62 20 28 63 61 64 72 20 73 74 61 74 75 t db (cadr statu
5bd0: 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 s) test-conf)).(
5be0: 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 define (launch-t
5bf0: 65 73 74 20 64 62 20 72 75 6e 2d 69 64 20 72 75 est db run-id ru
5c00: 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 20 nname test-conf
5c10: 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 74 2d 6e keyvallst test-n
5c20: 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 74 ame test-path it
5c30: 65 6d 64 61 74 20 70 61 72 61 6d 73 29 0a 20 20 emdat params).
5c40: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
5c50: 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 28 y *toppath*). (
5c60: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
5c70: 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 ;; consolidate t
5c80: 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 his code with th
5c90: 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 e code in megate
5ca0: 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 st.scm for "-exe
5cb0: 63 75 74 65 22 0a 20 20 20 28 6c 69 73 74 20 3b cute". (list ;
5cc0: 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 ; (list "MT_TEST
5cd0: 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 _RUN_DIR" work-a
5ce0: 72 65 61 29 0a 20 20 20 20 28 6c 69 73 74 20 22 rea). (list "
5cf0: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
5d00: 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 " *toppath*).
5d10: 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f (list "MT_TEST_
5d20: 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 NAME" test-name)
5d30: 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 22 4d . ;; (list "M
5d40: 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f T_ITEM_INFO" (co
5d50: 6e 63 20 69 74 65 6d 64 61 74 29 29 20 0a 20 20 nc itemdat)) .
5d60: 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e (list "MT_RUNN
5d70: 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a AME" runname).
5d80: 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 ;; (list "MT
5d90: 5f 54 41 52 47 45 54 22 20 20 20 20 6d 74 5f 74 _TARGET" mt_t
5da0: 61 72 67 65 74 29 0a 20 20 20 20 29 29 0a 20 20 arget). )).
5db0: 28 6c 65 74 2a 20 28 28 75 73 65 73 68 65 6c 6c (let* ((useshell
5dc0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
5dd0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
5de0: 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 73 obtools" "us
5df0: 65 73 68 65 6c 6c 22 29 29 0a 09 20 28 6c 61 75 eshell")).. (lau
5e00: 6e 63 68 65 72 20 20 20 28 63 6f 6e 66 69 67 2d ncher (config-
5e10: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
5e20: 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 t* "jobtools"
5e30: 20 20 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 "launcher"))..
5e40: 20 28 72 75 6e 73 63 72 69 70 74 20 20 28 63 6f (runscript (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 73 65 74 75 70 22 20 -conf "setup"
5e70: 20 20 20 20 20 20 20 22 72 75 6e 73 63 72 69 70 "runscrip
5e80: 74 22 29 29 0a 09 20 28 65 7a 73 74 65 70 73 20 t")).. (ezsteps
5e90: 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 (> (length (h
5ea0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
5eb0: 66 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 fault test-conf
5ec0: 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 20 "ezsteps" '()))
5ed0: 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 0)) ;; don't sen
5ee0: 64 20 61 6c 6c 20 74 68 65 20 73 74 65 70 73 2c d all the steps,
5ef0: 20 63 6f 75 6c 64 20 62 65 20 62 69 67 0a 09 20 could be big..
5f00: 28 64 69 73 6b 73 70 61 63 65 20 20 28 63 6f 6e (diskspace (con
5f10: 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d fig-lookup test-
5f20: 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 65 6d conf "requirem
5f30: 65 6e 74 73 22 20 22 64 69 73 6b 73 70 61 63 65 ents" "diskspace
5f40: 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 20 20 20 ")).. (memory
5f50: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
5f60: 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 test-conf "re
5f70: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 6d 65 6d quirements" "mem
5f80: 6f 72 79 22 29 29 0a 09 20 28 68 6f 73 74 73 20 ory")).. (hosts
5f90: 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f (config-loo
5fa0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
5fb0: 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 "jobtools" "
5fc0: 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a 09 20 28 workhosts")).. (
5fd0: 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 remote-megatest
5fe0: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a (config-lookup *
5ff0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
6000: 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 22 29 p" "executable")
6010: 29 0a 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f 4d ).. ;; FIXME SOM
6020: 45 44 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 EDAY: not good h
6030: 6f 77 20 74 68 69 73 20 69 73 20 73 6f 20 6f 62 ow this is so ob
6040: 74 75 73 65 2c 20 74 68 69 73 20 68 61 63 6b 20 tuse, this hack
6050: 69 73 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 20 is to .. ;;
6060: 20 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 allow
6070: 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 running from da
6080: 73 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 shboard. Extract
6090: 20 74 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 20 the path.. ;;
60a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 fr
60b0: 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 om the called me
60c0: 67 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 gatest and conve
60d0: 72 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 3b rt dashboard.. ;
60e0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 ; .
60f0: 20 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 6d 65 or dboard to me
6100: 67 61 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c 2d gatest.. (local-
6110: 6d 65 67 61 74 65 73 74 20 20 28 6c 65 74 2a 20 megatest (let*
6120: 28 28 6c 6d 20 20 28 63 61 72 20 28 61 72 67 76 ((lm (car (argv
6130: 29 29 29 0a 09 09 09 09 20 28 64 69 72 20 28 70 )))..... (dir (p
6140: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
6150: 79 20 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 65 y lm))..... (exe
6160: 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 (pathname-strip
6170: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 29 -directory lm)))
6180: 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 20 28 69 .... (conc (i
6190: 66 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 20 f dir (conc dir
61a0: 22 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 28 "/") "")..... (
61b0: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
61c0: 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 20 mbol exe).....
61d0: 20 20 28 28 64 62 6f 61 72 64 29 20 20 20 20 22 ((dboard) "
61e0: 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 megatest").....
61f0: 20 20 20 28 28 6d 74 65 73 74 29 20 20 20 20 20 ((mtest)
6200: 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 "megatest").....
6210: 20 20 20 20 28 28 64 61 73 68 62 6f 61 72 64 29 ((dashboard)
6220: 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 "megatest")....
6230: 09 20 20 20 20 28 65 6c 73 65 20 65 78 65 29 29 . (else exe))
6240: 29 29 29 0a 09 20 28 74 65 73 74 2d 73 69 67 20 ))).. (test-sig
6250: 20 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d (conc test-nam
6260: 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c 69 73 74 e ":" (item-list
6270: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
6280: 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 68 20 69 ) ;; test-path i
6290: 73 20 74 68 65 20 66 75 6c 6c 20 70 61 74 68 20 s the full path
62a0: 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 20 69 74 including the it
62b0: 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f 72 6b 2d em-path.. (work-
62c0: 61 72 65 61 20 20 23 66 29 0a 09 20 28 74 6f 70 area #f).. (top
62d0: 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 23 test-work-area #
62e0: 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 61 74 f) ;; for iterat
62f0: 65 64 20 74 65 73 74 73 20 74 68 65 20 74 6f 70 ed tests the top
6300: 20 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 20 64 test contains d
6310: 61 74 61 20 72 65 6c 65 76 61 6e 74 20 66 6f 72 ata relevant for
6320: 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 61 74 68 all.. (diskpath
6330: 20 20 20 23 66 29 0a 09 20 28 63 6d 64 70 61 72 #f).. (cmdpar
6340: 6d 73 20 20 20 23 66 29 0a 09 20 28 66 75 6c 6c ms #f).. (full
6350: 63 6d 64 20 20 20 20 23 66 29 20 3b 3b 20 28 64 cmd #f) ;; (d
6360: 65 66 69 6e 65 20 61 20 28 77 69 74 68 2d 6f 75 efine a (with-ou
6370: 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 tput-to-string (
6380: 6c 61 6d 62 64 61 20 28 29 28 77 72 69 74 65 20 lambda ()(write
6390: 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 69 6e 64 x)))).. (mt-bind
63a0: 69 72 2d 70 61 74 68 20 23 66 29 0a 09 20 28 69 ir-path #f).. (i
63b0: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
63c0: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
63d0: 74 29 29 0a 09 20 28 74 65 73 74 2d 69 64 20 20 t)).. (test-id
63e0: 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 (cdb:remote-ru
63f0: 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 n db:get-test-id
6400: 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d #f run-id test-
6410: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
6420: 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 20 20 28 .. (testinfo (
6430: 63 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 cdb:get-test-inf
6440: 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f o-by-id *runremo
6450: 74 65 2a 20 74 65 73 74 2d 69 64 29 29 0a 09 20 te* test-id))..
6460: 28 6d 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 (mt_target (str
6470: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
6480: 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c (map cadr keyval
6490: 6c 73 74 29 20 22 2f 22 29 29 0a 09 20 28 64 65 lst) "/")).. (de
64a0: 62 75 67 2d 70 61 72 61 6d 20 28 61 70 70 65 6e bug-param (appen
64b0: 64 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d d (if (args:get-
64c0: 61 72 67 20 22 2d 64 65 62 75 67 22 29 20 20 28 arg "-debug") (
64d0: 6c 69 73 74 20 22 2d 64 65 62 75 67 22 20 28 61 list "-debug" (a
64e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 rgs:get-arg "-de
64f0: 62 75 67 22 29 29 20 27 28 29 29 0a 09 09 09 20 bug")) '())....
6500: 20 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 (if (args:g
6510: 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 et-arg "-logging
6520: 22 29 28 6c 69 73 74 20 22 2d 6c 6f 67 67 69 6e ")(list "-loggin
6530: 67 22 29 20 27 28 29 29 29 29 29 0a 20 20 20 20 g") '())))).
6540: 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 21 20 (if hosts (set!
6550: 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d 73 70 hosts (string-sp
6560: 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 20 20 lit hosts))).
6570: 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 67 61 ;; set the mega
6580: 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c 6c 65 test to be calle
6590: 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 65 20 d on the remote
65a0: 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 6e 6f host. (if (no
65b0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
65c0: 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d 6d t)(set! remote-m
65d0: 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 egatest local-me
65e0: 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 67 gatest)) ;; "meg
65f0: 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 73 65 atest")). (se
6600: 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 t! mt-bindir-pat
6610: 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 h (pathname-dire
6620: 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 67 ctory remote-meg
6630: 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 66 20 atest)). (if
6640: 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 20 6c launcher (set! l
6650: 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e 67 2d auncher (string-
6660: 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 29 29 split launcher))
6670: 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 70 20 ). ;; set up
6680: 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 72 65 the run work are
6690: 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a a for this test.
66a0: 20 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 61 (set! diskpa
66b0: 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 th (get-best-dis
66c0: 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 0a k *configdat*)).
66d0: 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 68 (if diskpath
66e0: 0a 09 28 6c 65 74 20 28 28 64 61 74 20 20 28 6f ..(let ((dat (o
66f0: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 63 72 pen-run-close cr
6700: 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 64 eate-work-area d
6710: 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 b run-id test-id
6720: 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b 70 test-path diskp
6730: 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 ath test-name it
6740: 65 6d 64 61 74 29 29 29 0a 09 20 20 28 73 65 74 emdat))).. (set
6750: 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 72 ! work-area (car
6760: 20 64 61 74 29 29 0a 09 20 20 28 73 65 74 21 20 dat)).. (set!
6770: 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 toptest-work-are
6780: 61 20 28 63 61 64 72 20 64 61 74 29 29 0a 09 20 a (cadr dat))..
6790: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
67a0: 66 6f 20 32 20 22 55 73 69 6e 67 20 77 6f 72 6b fo 2 "Using work
67b0: 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 65 area " work-are
67c0: 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 a))..(begin.. (
67d0: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
67e0: 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 20 22 conc test-path "
67f0: 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 28 /tmp_run")).. (
6800: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
6810: 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 work-area #t)..
6820: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6830: 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 "WARNING: No di
6840: 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 73 70 65 sk work area spe
6850: 63 69 66 69 65 64 20 2d 20 72 75 6e 6e 69 6e 67 cified - running
6860: 20 69 6e 20 74 68 65 20 74 65 73 74 20 64 69 72 in the test dir
6870: 65 63 74 6f 72 79 20 75 6e 64 65 72 20 74 6d 70 ectory under tmp
6880: 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 28 73 65 _run"))). (se
6890: 74 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 73 t! cmdparms (bas
68a0: 65 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 e64:base64-encod
68b0: 65 20 0a 09 09 20 20 20 20 28 77 69 74 68 2d 6f e ... (with-o
68c0: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a utput-to-string.
68d0: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
68e0: 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f 73 () ;; (list 'hos
68f0: 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 09 ts hosts)...
6900: 09 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 6c .(write (list (l
6910: 69 73 74 20 27 74 65 73 74 70 61 74 68 20 20 74 ist 'testpath t
6920: 65 73 74 2d 70 61 74 68 29 0a 09 09 09 09 20 20 est-path).....
6930: 20 20 20 28 6c 69 73 74 20 27 72 75 6e 72 65 6d (list 'runrem
6940: 6f 74 65 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 ote *runremote*)
6950: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
6960: 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f 70 70 'toppath *topp
6970: 61 74 68 2a 29 0a 09 09 09 09 20 20 20 20 20 28 ath*)..... (
6980: 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 list 'work-area
6990: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 20 work-area).....
69a0: 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d (list 'test-
69b0: 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 20 name test-name)
69c0: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
69d0: 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 'runscript runsc
69e0: 72 69 70 74 29 20 0a 09 09 09 09 20 20 20 20 20 ript) .....
69f0: 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 20 (list 'run-id
6a00: 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 09 run-id ).....
6a10: 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 (list 'test
6a20: 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 -id test-id )
6a30: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
6a40: 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 64 'itemdat itemd
6a50: 61 74 20 20 29 0a 09 09 09 09 20 20 20 20 20 28 at )..... (
6a60: 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 20 list 'megatest
6a70: 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 remote-megatest)
6a80: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
6a90: 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 65 'ezsteps ezste
6aa0: 70 73 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c ps) ..... (l
6ab0: 69 73 74 20 27 74 61 72 67 65 74 20 20 20 20 6d ist 'target m
6ac0: 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 20 20 t_target).....
6ad0: 20 20 20 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 (list 'env-ov
6ae0: 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d rd (hash-table-
6af0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e ref/default *con
6b00: 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 figdat* "env-ove
6b10: 72 72 69 64 65 22 20 27 28 29 29 29 20 0a 09 09 rride" '())) ...
6b20: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 73 65 .. (list 'se
6b30: 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 72 61 t-vars (if para
6b40: 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ms (hash-table-r
6b50: 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 61 6d ef/default param
6b60: 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 66 29 s "-setvars" #f)
6b70: 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 ))..... (lis
6b80: 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e t 'runname run
6b90: 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 name)..... (
6ba0: 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d list 'mt-bindir-
6bb0: 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 path mt-bindir-p
6bc0: 61 74 68 29 29 29 29 29 29 29 20 3b 3b 20 28 73 ath))))))) ;; (s
6bd0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
6be0: 65 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 22 29 e keyvallst " ")
6bf0: 29 29 29 0a 20 20 20 20 3b 3b 20 63 6c 65 61 6e ))). ;; clean
6c00: 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f 72 64 out step record
6c10: 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 s from previous
6c20: 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 69 73 run if they exis
6c30: 74 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a t. ;; (debug:
6c40: 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 46 49 print-info 4 "FI
6c50: 58 4d 45 45 45 45 45 21 21 21 21 20 54 68 69 73 XMEEEEE!!!! This
6c60: 20 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 64 20 can be removed
6c70: 73 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 61 70 some day, perhap
6c80: 73 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 74 20 s move all test
6c90: 72 65 63 6f 72 64 73 20 74 6f 20 74 68 65 20 74 records to the t
6ca0: 65 73 74 20 64 62 3f 22 29 0a 20 20 20 20 3b 3b est db?"). ;;
6cb0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
6cc0: 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d db:delete-test-
6cd0: 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 62 20 step-records db
6ce0: 74 65 73 74 2d 69 64 29 0a 20 20 20 20 28 63 68 test-id). (ch
6cf0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
6d00: 6f 72 6b 2d 61 72 65 61 29 20 3b 3b 20 73 6f 20 ork-area) ;; so
6d10: 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 20 66 that log files f
6d20: 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 20 70 rom the launch p
6d30: 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 6c 75 rocess don't clu
6d40: 74 74 65 72 20 74 68 65 20 74 65 73 74 20 64 69 tter the test di
6d50: 72 0a 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 r. (tests:tes
6d60: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 t-set-status! te
6d70: 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 22 st-id "LAUNCHED"
6d80: 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b 3b "n/a" #f #f) ;;
6d90: 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 75 (if launch-resu
6da0: 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c lts launch-resul
6db0: 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 20 ts "FAILED")).
6dc0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 (cond. ((a
6dd0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 74 nd launcher host
6de0: 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 73 s) ;; must be us
6df0: 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d 65 ing ssh hostname
6e00: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
6e10: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
6e20: 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 73 ncher (car hosts
6e30: 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 )(list remote-me
6e40: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
6e50: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
6e60: 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d rms) debug-param
6e70: 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 74 ))). ;; (set
6e80: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6e90: 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 d launcher (car
6ea0: 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f hosts)(list remo
6eb0: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
6ec0: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
6ed0: 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 cmdparms)))).
6ee0: 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 20 20 (launcher.
6ef0: 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 (set! fullcmd
6f00: 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 (append launcher
6f10: 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
6f20: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
6f30: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
6f40: 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d rms) debug-param
6f50: 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 74 ))). ;; (set
6f60: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6f70: 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 d launcher (list
6f80: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
6f90: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
6fa0: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 ute" cmdparms)))
6fb0: 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 ). (else.
6fc0: 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 65 73 (if (not uses
6fd0: 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 6e hell)(debug:prin
6fe0: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 69 6e t 0 "WARNING: in
6ff0: 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e 67 ternal launching
7000: 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 77 will not work w
7010: 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 73 ell without \"us
7020: 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e 20 eshell yes\" in
7030: 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 your [jobtools]
7040: 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 20 20 section")).
7050: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
7060: 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 65 6d append (list rem
7070: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 ote-megatest tes
7080: 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 t-sig "-execute"
7090: 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 cmdparms) debug
70a0: 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 69 66 -param (list (if
70b0: 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 useshell "&" ""
70c0: 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 73 )))))). ;; (s
70d0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 et! fullcmd (lis
70e0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
70f0: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
7100: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 20 28 cute" cmdparms (
7110: 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 if useshell "&"
7120: 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 ""))))). (if
7130: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
7140: 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 75 6c xterm")(set! ful
7150: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 75 6c lcmd (append ful
7160: 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 74 65 lcmd (list "-xte
7170: 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 65 62 rm")))). (deb
7180: 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 75 6e ug:print 1 "Laun
7190: 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 72 65 ching " work-are
71a0: 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 70 72 a). ;; set pr
71b0: 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 e-launch-env-var
71c0: 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 69 s before launchi
71d0: 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 61 72 ng, keep the var
71e0: 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 61 6e s in prevvals an
71f0: 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 6f 6e d put the envion
7200: 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 64 ment back when d
7210: 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 3a 70 one. (debug:p
7220: 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d 64 3a rint 4 "fullcmd:
7230: 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 20 " fullcmd).
7240: 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 (let* ((commonpr
7250: 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e 65 evvals (alist->e
7260: 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 nv-vars.... (
7270: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
7280: 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 efault *configda
7290: 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t* "env-override
72a0: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 74 65 " '()))).. (te
72b0: 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c stprevvals (al
72c0: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 ist->env-vars...
72d0: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
72e0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 -ref/default tes
72f0: 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 75 6e t-conf "pre-laun
7300: 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 73 ch-env-overrides
7310: 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 6d 69 " '()))).. (mi
7320: 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c scprevvals (al
7330: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b ist->env-vars ;;
7340: 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 consolidate thi
7350: 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 s code with the
7360: 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 code in megatest
7370: 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 .scm for "-execu
7380: 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 70 65 te".... (appe
7390: 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 22 nd (list (list "
73a0: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
73b0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 work-area).....
73c0: 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 . (list "MT_TES
73d0: 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d T_NAME" test-nam
73e0: 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 e)...... (list
73f0: 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 "MT_ITEM_INFO" (
7400: 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 0a conc itemdat)) .
7410: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
7420: 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e _RUNNAME" runn
7430: 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 ame)...... (lis
7440: 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 t "MT_TARGET"
7450: 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 mt_target).....
7460: 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 74 65 . )..... ite
7470: 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c 61 75 mdat))).. (lau
7480: 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 70 nch-results (app
7490: 6c 79 20 63 6d 64 2d 72 75 6e 2d 77 69 74 68 2d ly cmd-run-with-
74a0: 73 74 64 65 72 72 2d 3e 6c 69 73 74 20 3b 3b 20 stderr->list ;;
74b0: 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 61 63 cmd-run-proc-eac
74c0: 68 2d 6c 69 6e 65 0a 09 09 09 09 20 20 28 69 66 h-line..... (if
74d0: 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 20 useshell.....
74e0: 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 (string-inte
74f0: 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 rsperse fullcmd
7500: 22 20 22 29 0a 09 09 09 09 20 20 20 20 20 20 28 " ")..... (
7510: 63 61 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 car fullcmd))...
7520: 09 09 20 20 3b 3b 20 63 6f 6e 63 0a 09 09 09 09 .. ;; conc.....
7530: 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 (if useshell..
7540: 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 ... '()....
7550: 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c . (cdr full
7560: 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c 61 75 cmd))))) ;; lau
7570: 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 29 29 ncher fullcmd)))
7580: 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 75 ;; (apply cmd-ru
7590: 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e 65 n-proc-each-line
75a0: 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e 74 20 launcher print
75b0: 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 28 63 fullcmd))) ;; (c
75c0: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c md-run->list ful
75d0: 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 77 69 lcmd)). (wi
75e0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
75f0: 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 e "mt_launch.log
7600: 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 "..(lambda ()..
7610: 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 6c 61 (apply print la
7620: 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 29 0a unch-results))).
7630: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
7640: 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 20 nt 2 "Launching
7650: 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 74 completed, updat
7660: 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 20 28 ing db"). (
7670: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c debug:print 2 "L
7680: 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 22 aunch results: "
7690: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
76a0: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
76b0: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a launch-results).
76c0: 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 . (begin.. (
76d0: 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 print "ERROR: Fa
76e0: 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 73 iled to run " (s
76f0: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
7700: 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 22 e fullcmd " ") "
7710: 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 0a , exiting now").
7720: 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 . ;; (sqlite3
7730: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
7740: 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 ;; good ole
7750: 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 "exit" seems not
7760: 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 3b 3b to work.. ;;
7770: 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 20 20 (_exit 9)..
7780: 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 6b ;; but this hack
7790: 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 6e will work! Than
77a0: 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 6f ks go to Alan Po
77b0: 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b 65 st of the Chicke
77c0: 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 20 n email list..
77d0: 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 68 69 ;; NB// Is thi
77e0: 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 3f 20 s still needed?
77f0: 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 20 74 Should be safe t
7800: 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 65 78 o go back to "ex
7810: 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 20 28 70 it" now?.. (p
7820: 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 rocess-signal (c
7830: 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
7840: 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a d) signal/kill).
7850: 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 28 61 . )). (a
7860: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 6d list->env-vars m
7870: 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 20 20 iscprevvals).
7880: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
7890: 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c 73 ars testprevvals
78a0: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e ). (alist->
78b0: 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 env-vars commonp
78c0: 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 6c revvals). l
78d0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 0a aunch-results)).
78e0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
78f0: 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a ory *toppath*)).
7900: 0a .