Artifact
ae5b023e357fe80c6303cf0a4cad1d003d02a4a1
File
launch.scm
— part of check-in
[9bf6d9d0fe]
at
2013-03-04 22:27:22
on branch network-only-transport
— Disabled fs and got zmq working again (I think)
(user:
matt
size: 31113)
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 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f (transport (asso
09f0: 63 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 c/default 'trans
0a00: 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 port cmdinfo))..
0a10: 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 (run-id
0a20: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0a30: 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 'run-id cmdi
0a40: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
0a50: 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f est-id (assoc/
0a60: 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 default 'test-id
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 74 61 72 67 65 74 20 20 20 20 (target
0a90: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0aa0: 74 61 72 67 65 74 20 20 20 20 63 6d 64 69 6e 66 target cmdinf
0ab0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 o)).. (ite
0ac0: 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 mdat (assoc/de
0ad0: 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 fault 'itemdat
0ae0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0af0: 20 20 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 (env-ovrd (a
0b00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e ssoc/default 'en
0b10: 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 v-ovrd cmdinfo)
0b20: 29 0a 09 20 20 20 20 20 20 20 28 73 65 74 2d 76 ).. (set-v
0b30: 61 72 73 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ars (assoc/defa
0b40: 75 6c 74 20 27 73 65 74 2d 76 61 72 73 20 20 63 ult 'set-vars c
0b50: 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d mdinfo)) ;; pre-
0b60: 6f 76 65 72 72 69 64 65 73 20 66 72 6f 6d 20 2d overrides from -
0b70: 73 65 74 76 61 72 0a 09 20 20 20 20 20 20 20 28 setvar.. (
0b80: 72 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 runname (assoc
0b90: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d /default 'runnam
0ba0: 65 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 e cmdinfo))..
0bb0: 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 20 (megatest
0bc0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0bd0: 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 'megatest cmdin
0be0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 fo)).. (mt
0bf0: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 -bindir-path (as
0c00: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d soc/default 'mt-
0c10: 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 bindir-path cmdi
0c20: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6b nfo)).. (k
0c30: 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 20 20 eys #f)..
0c40: 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 20 (keyvals
0c50: 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 75 6c #f).. (ful
0c60: 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 28 lrunscript (if (
0c70: 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 0a 20 not runscript).
0c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f.
0cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cc0: 20 20 20 20 20 20 28 69 66 20 28 73 75 62 73 74 (if (subst
0cd0: 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 72 ring-index "/" r
0ce0: 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 unscript).
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d10: 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 65 runscript ;; use
0d20: 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 66 20 unadultered if
0d30: 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 73 contains slashes
0d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d60: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 75 (let ((fu
0d70: 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 74 70 61 lln (conc testpa
0d80: 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 74 th "/" runscript
0d90: 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 20 )))..
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 28 69 66 20 28 61 6e 64 20 (if (and
0dc0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 (file-exists? fu
0dd0: 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 lln).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 66 69 6c 65 2d 65 78 (file-ex
0e10: 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 75 ecute-access? fu
0e20: 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 lln)).
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 20 20 20 66 75 6c 6c 6e 0a 20 20 20 20 20 20 fulln.
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 70 runscrip
0e90: 74 29 29 29 29 29 20 3b 3b 20 61 73 73 75 6d 65 t))))) ;; assume
0ea0: 20 69 74 20 69 73 20 6f 6e 20 74 68 65 20 70 61 it is on the pa
0eb0: 74 68 0a 09 20 20 20 20 20 20 20 28 72 6f 6c 6c th.. (roll
0ec0: 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a 09 20 up-status 0))..
0ed0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0ee0: 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 65 73 "Exectuing " tes
0ef0: 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 t-name " (id: "
0f00: 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 test-id ") on "
0f10: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
0f20: 0a 09 20 20 3b 3b 20 53 65 74 75 70 20 74 68 65 .. ;; Setup the
0f30: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 67 6c 6f *runremote* glo
0f40: 62 61 6c 20 76 61 72 0a 09 20 20 28 69 66 20 2a bal var.. (if *
0f50: 72 75 6e 72 65 6d 6f 74 65 2a 20 28 64 65 62 75 runremote* (debu
0f60: 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 g:print 2 "ERROR
0f70: 3a 20 49 27 6d 20 6e 6f 74 20 65 78 70 65 63 74 : I'm not expect
0f80: 69 6e 67 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 ing *runremote*
0f90: 74 6f 20 62 65 20 73 65 74 20 61 74 20 74 68 69 to be set at thi
0fa0: 73 20 74 69 6d 65 22 29 29 0a 09 20 20 28 73 65 s time")).. (se
0fb0: 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 t! *runremote* r
0fc0: 75 6e 72 65 6d 6f 74 65 29 0a 09 20 20 28 73 65 unremote).. (se
0fd0: 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 t! *transport-ty
0fe0: 70 65 2a 20 74 72 61 6e 73 70 6f 72 74 29 0a 09 pe* transport)..
0ff0: 20 20 28 73 65 74 21 20 6b 65 79 73 20 20 20 20 (set! keys
1000: 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 (cdb:remote-r
1010: 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 73 20 23 un db:get-keys #
1020: 66 29 29 0a 09 20 20 28 73 65 74 21 20 6b 65 79 f)).. (set! key
1030: 76 61 6c 73 20 20 20 20 28 69 66 20 72 75 6e 2d vals (if run-
1040: 69 64 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 id (cdb:remote-r
1050: 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 un db:get-key-va
1060: 6c 73 20 23 66 20 72 75 6e 2d 69 64 29 20 23 66 ls #f run-id) #f
1070: 29 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 20 70 )).. ;; apply p
1080: 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 65 66 re-overrides bef
1090: 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 61 62 ore other variab
10a0: 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f 76 65 les. The pre-ove
10b0: 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 74 20 rride vars must
10c0: 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 62 65 not.. ;; clobbe
10d0: 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d 20 74 rs things from t
10e0: 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f 75 72 he official sour
10f0: 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 67 61 ces such as mega
1100: 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 20 test.config and
1110: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
1120: 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 6e 67 g.. (if (string
1130: 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 20 20 ? set-vars)..
1140: 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 61 69 (let ((varpai
1150: 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 rs (string-split
1160: 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 29 29 set-vars ",")))
1170: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
1180: 34 20 22 76 61 72 70 61 69 72 73 3a 20 22 20 76 4 "varpairs: " v
1190: 61 72 70 61 69 72 73 29 0a 09 09 28 6d 61 70 20 arpairs)...(map
11a0: 28 6c 61 6d 62 64 61 20 28 76 61 72 70 61 69 72 (lambda (varpair
11b0: 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 )... (let
11c0: 28 28 76 61 72 76 61 6c 20 28 73 74 72 69 6e 67 ((varval (string
11d0: 2d 73 70 6c 69 74 20 76 61 72 70 61 69 72 20 22 -split varpair "
11e0: 3d 22 29 29 29 0a 09 09 09 20 28 69 66 20 28 65 ="))).... (if (e
11f0: 71 3f 20 28 6c 65 6e 67 74 68 20 76 61 72 76 61 q? (length varva
1200: 6c 29 20 32 29 0a 09 09 09 20 20 20 20 20 28 6c l) 2).... (l
1210: 65 74 20 28 28 76 61 72 20 28 63 61 72 20 76 61 et ((var (car va
1220: 72 76 61 6c 29 29 0a 09 09 09 09 20 20 20 28 76 rval))..... (v
1230: 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 6c 29 al (cadr varval)
1240: 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 65 )).... (de
1250: 62 75 67 3a 70 72 69 6e 74 20 31 20 22 41 64 64 bug:print 1 "Add
1260: 69 6e 67 20 70 72 65 2d 76 61 72 2f 76 61 6c 20 ing pre-var/val
1270: 22 20 76 61 72 20 22 20 3d 20 22 20 76 61 6c 20 " var " = " val
1280: 22 20 74 6f 20 74 68 65 20 65 6e 76 69 72 6f 6e " to the environ
1290: 6d 65 6e 74 22 29 0a 09 09 09 20 20 20 20 20 20 ment")....
12a0: 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 61 6c (setenv var val
12b0: 29 29 29 29 29 0a 09 09 20 20 20 20 20 76 61 72 )))))... var
12c0: 70 61 69 72 73 29 29 29 0a 09 20 20 28 73 65 74 pairs))).. (set
12d0: 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e env "MT_TEST_RUN
12e0: 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
12f0: 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f .. (setenv "MT_
1300: 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d TEST_NAME" test-
1310: 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e 76 name).. (setenv
1320: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
1330: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 0a (conc itemdat)).
1340: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 . (setenv "MT_R
1350: 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d UNNAME" runnam
1360: 65 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d e).. (setenv "M
1370: 54 5f 4d 45 47 41 54 45 53 54 22 20 20 6d 65 67 T_MEGATEST" meg
1380: 61 74 65 73 74 29 0a 09 20 20 28 73 65 74 65 6e atest).. (seten
1390: 76 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 v "MT_TARGET"
13a0: 20 74 61 72 67 65 74 29 0a 09 20 20 28 69 66 20 target).. (if
13b0: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 mt-bindir-path (
13c0: 73 65 74 65 6e 76 20 22 50 41 54 48 22 20 28 63 setenv "PATH" (c
13d0: 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 50 41 54 onc (getenv "PAT
13e0: 48 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 H") ":" mt-bindi
13f0: 72 2d 70 61 74 68 29 29 29 0a 09 20 20 28 63 68 r-path))).. (ch
1400: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 ange-directory t
1410: 6f 70 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 op-path).. (if
1420: 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 2d (not (setup-for-
1430: 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 65 run)).. (be
1440: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
1450: 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 nt 0 "Failed to
1460: 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 setup, exiting")
1470: 20 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a ...;; (sqlite3:
1480: 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 finalize! db)...
1490: 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ;; (sqlite3:fina
14a0: 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 28 65 78 lize! tdb)...(ex
14b0: 69 74 20 31 29 29 29 0a 09 20 20 3b 3b 20 43 61 it 1))).. ;; Ca
14c0: 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e n setup as clien
14d0: 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 t for server mod
14e0: 65 20 6e 6f 77 0a 09 20 20 28 73 65 72 76 65 72 e now.. (server
14f0: 3a 63 6c 69 65 6e 74 2d 73 65 74 75 70 29 0a 0a :client-setup)..
1500: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
1510: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 20 tory *toppath*)
1520: 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 .. (set-megates
1530: 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 t-env-vars run-i
1540: 64 29 20 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 d) ;; these may
1550: 62 65 20 6e 65 65 64 65 64 20 62 79 20 74 68 65 be needed by the
1560: 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 launching proce
1570: 73 73 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 ss.. (change-di
1580: 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are
1590: 61 29 20 0a 0a 09 20 20 28 6f 70 65 6e 2d 72 75 a) ... (open-ru
15a0: 6e 2d 63 6c 6f 73 65 20 73 65 74 2d 72 75 6e 2d n-close set-run-
15b0: 63 6f 6e 66 69 67 2d 76 61 72 73 20 23 66 20 72 config-vars #f r
15c0: 75 6e 2d 69 64 20 6b 65 79 73 20 6b 65 79 76 61 un-id keys keyva
15d0: 6c 73 29 0a 09 20 20 3b 3b 20 65 6e 76 69 72 6f ls).. ;; enviro
15e0: 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 nment overrides
15f0: 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 are done *before
1600: 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 * the remaining
1610: 63 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e critical envars.
1620: 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d .. (alist->env-
1630: 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 vars env-ovrd)..
1640: 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 2d (set-megatest-
1650: 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 29 env-vars run-id)
1660: 0a 09 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e .. (set-item-en
1670: 76 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a v-vars itemdat).
1680: 09 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e . (save-environ
1690: 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d ment-as-files "m
16a0: 65 67 61 74 65 73 74 22 29 0a 09 20 20 28 6f 70 egatest").. (op
16b0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 en-run-close tes
16c0: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
16d0: 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 #f test-id run-i
16e0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
16f0: 64 61 74 20 30 29 0a 09 20 20 28 74 65 73 74 73 dat 0).. (tests
1700: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
1710: 21 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 ! test-id "REMOT
1720: 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 EHOSTSTART" "n/a
1730: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
1740: 22 2d 6d 22 29 20 23 66 29 0a 09 20 20 28 69 66 "-m") #f).. (if
1750: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
1760: 2d 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 -xterm")..
1770: 28 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 (set! fullrunscr
1780: 69 70 74 20 22 78 74 65 72 6d 22 29 0a 09 20 20 ipt "xterm")..
1790: 20 20 20 20 28 69 66 20 28 61 6e 64 20 66 75 6c (if (and ful
17a0: 6c 72 75 6e 73 63 72 69 70 74 20 28 6e 6f 74 20 lrunscript (not
17b0: 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 (file-execute-ac
17c0: 63 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 cess? fullrunscr
17d0: 69 70 74 29 29 29 0a 09 09 20 20 28 73 79 73 74 ipt)))... (syst
17e0: 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 em (conc "chmod
17f0: 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 ug+x " fullrunsc
1800: 72 69 70 74 29 29 29 29 0a 09 20 20 3b 3b 20 57 ript)))).. ;; W
1810: 65 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 e are about to a
1820: 63 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 ctually kick off
1830: 20 74 68 65 20 74 65 73 74 0a 09 20 20 3b 3b 20 the test.. ;;
1840: 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f so this is a goo
1850: 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 d place to remov
1860: 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 6f e the records fo
1870: 72 20 0a 09 20 20 3b 3b 20 61 6e 79 20 70 72 65 r .. ;; any pre
1880: 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 3b 3b vious runs.. ;;
1890: 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 (db:test-remove
18a0: 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 64 -steps db run-id
18b0: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 testname itemda
18c0: 74 29 0a 09 20 20 0a 09 20 20 28 6c 65 74 2a 20 t).. .. (let*
18d0: 28 28 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 ((m (
18e0: 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 make-mutex))...
18f0: 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 (kill-job? #f
1900: 29 0a 09 09 20 28 65 78 69 74 2d 69 6e 66 6f 20 )... (exit-info
1910: 20 20 20 28 76 65 63 74 6f 72 20 23 74 20 23 74 (vector #t #t
1920: 20 23 74 29 29 0a 09 09 20 28 6a 6f 62 2d 74 68 #t))... (job-th
1930: 72 65 61 64 20 20 20 23 66 29 0a 09 09 20 28 72 read #f)... (r
1940: 75 6e 69 74 20 20 20 20 20 20 20 20 28 6c 61 6d unit (lam
1950: 62 64 61 20 28 29 0a 09 09 09 09 20 3b 3b 20 28 bda ()..... ;; (
1960: 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 20 let-values.....
1970: 3b 3b 20 20 28 28 28 70 69 64 20 65 78 69 74 2d ;; (((pid exit-
1980: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
1990: 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 28 72 75 )..... ;; (ru
19a0: 6e 2d 6e 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e n-n-wait fullrun
19b0: 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 28 script)))..... (
19c0: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
19d0: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 tatus! test-id "
19e0: 52 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 20 23 RUNNING" "n/a" #
19f0: 66 20 23 66 29 0a 09 09 09 09 20 3b 3b 20 69 66 f #f)..... ;; if
1a00: 20 74 68 65 72 65 20 69 73 20 61 20 72 75 6e 73 there is a runs
1a10: 63 72 69 70 74 20 64 6f 20 69 74 20 66 69 72 73 cript do it firs
1a20: 74 0a 09 09 09 09 20 28 69 66 20 66 75 6c 6c 72 t..... (if fullr
1a30: 75 6e 73 63 72 69 70 74 0a 09 09 09 09 20 20 20 unscript.....
1a40: 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 (let ((pid (pr
1a50: 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 ocess-run fullru
1a60: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 nscript))).....
1a70: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
1a80: 28 28 69 20 30 29 29 0a 09 09 09 09 09 20 28 6c ((i 0))...... (l
1a90: 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 20 et-values......
1aa0: 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 (((pid-val exit
1ab0: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
1ac0: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
1ad0: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 pid #t)))......
1ae0: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
1af0: 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 )...... (vector
1b00: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1b10: 30 20 70 69 64 29 0a 09 09 09 09 09 20 20 28 76 0 pid)...... (v
1b20: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
1b30: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
1b40: 75 73 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 us)...... (vect
1b50: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
1b60: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
1b70: 09 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c .... (set! roll
1b80: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 up-status exit-c
1b90: 6f 64 65 29 20 0a 09 09 09 09 09 20 20 28 6d 75 ode) ...... (mu
1ba0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
1bb0: 09 09 09 09 20 20 28 69 66 20 28 65 71 3f 20 70 .... (if (eq? p
1bc0: 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 20 id-val 0)......
1bd0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
1be0: 09 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ..(thread-sleep!
1bf0: 20 32 29 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 2).......(loop
1c00: 28 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 (+ i 1)))......
1c10: 20 20 20 20 20 29 29 29 29 29 0a 09 09 09 09 20 ))))).....
1c20: 3b 3b 20 74 68 65 6e 2c 20 69 66 20 72 75 6e 73 ;; then, if runs
1c30: 63 72 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f 72 cript ran ok (or
1c40: 20 64 69 64 20 6e 6f 74 20 67 65 74 20 63 61 6c did not get cal
1c50: 6c 65 64 29 0a 09 09 09 09 20 3b 3b 20 64 6f 20 led)..... ;; do
1c60: 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 70 73 20 all the ezsteps
1c70: 28 69 66 20 61 6e 79 29 0a 09 09 09 09 20 28 69 (if any)..... (i
1c80: 66 20 65 7a 73 74 65 70 73 0a 09 09 09 09 20 20 f ezsteps.....
1c90: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 (let* ((testc
1ca0: 6f 6e 66 69 67 20 28 72 65 61 64 2d 63 6f 6e 66 onfig (read-conf
1cb0: 69 67 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 ig (conc work-ar
1cc0: 65 61 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 ea "/testconfig"
1cd0: 29 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d ) #f #t environ-
1ce0: 70 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 patt: "pre-launc
1cf0: 68 2d 65 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b h-env-vars")) ;;
1d00: 20 46 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c FIXME??? is all
1d10: 6f 77 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 ow-system ok her
1d20: 65 3f 0a 09 09 09 09 09 20 20 20 20 28 65 7a 73 e?...... (ezs
1d30: 74 65 70 73 6c 73 74 20 28 68 61 73 68 2d 74 61 tepslst (hash-ta
1d40: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1d50: 74 65 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 testconfig "ezst
1d60: 65 70 73 22 20 27 28 29 29 29 29 0a 09 09 09 09 eps" '()))).....
1d70: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
1d80: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e (file-exists? ".
1d90: 65 7a 73 74 65 70 73 22 29 29 28 63 72 65 61 74 ezsteps"))(creat
1da0: 65 2d 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a e-directory ".ez
1db0: 73 74 65 70 73 22 29 29 0a 09 09 09 09 20 20 20 steps")).....
1dc0: 20 20 20 20 3b 3b 20 69 66 20 65 7a 73 74 65 70 ;; if ezstep
1dd0: 73 20 77 61 73 20 64 65 66 69 6e 65 64 20 74 68 s was defined th
1de0: 65 6e 20 77 65 20 61 72 65 20 73 75 72 65 20 74 en we are sure t
1df0: 6f 20 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 o have at least
1e00: 6f 6e 65 20 73 74 65 70 20 62 75 74 20 63 68 65 one step but che
1e10: 63 6b 20 61 6e 79 77 61 79 0a 09 09 09 09 20 20 ck anyway.....
1e20: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 3e (if (not (>
1e30: 20 28 6c 65 6e 67 74 68 20 65 7a 73 74 65 70 73 (length ezsteps
1e40: 6c 73 74 29 20 30 29 29 0a 09 09 09 09 09 20 20 lst) 0))......
1e50: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1e60: 22 45 52 52 4f 52 3a 20 65 7a 73 74 65 70 73 20 "ERROR: ezsteps
1e70: 64 65 66 69 6e 65 64 20 62 75 74 20 65 7a 73 74 defined but ezst
1e80: 65 70 73 6c 73 74 20 69 73 20 7a 65 72 6f 20 6c epslst is zero l
1e90: 65 6e 67 74 68 22 29 0a 09 09 09 09 09 20 20 20 ength")......
1ea0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 (let loop ((ezst
1eb0: 65 70 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c ep (car ezstepsl
1ec0: 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 st)).......
1ed0: 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 65 7a (tal (cdr ez
1ee0: 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 stepslst))......
1ef0: 09 20 20 20 20 20 20 28 70 72 65 76 73 74 65 70 . (prevstep
1f00: 20 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 20 #f))......
1f10: 3b 3b 20 63 68 65 63 6b 20 65 78 69 74 2d 69 6e ;; check exit-in
1f20: 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 fo (vector-ref e
1f30: 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 xit-info 1).....
1f40: 09 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f . (if (vecto
1f50: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
1f60: 31 29 0a 09 09 09 09 09 09 20 28 6c 65 74 2a 20 1)....... (let*
1f70: 28 28 73 74 65 70 6e 61 6d 65 20 20 28 63 61 72 ((stepname (car
1f80: 20 65 7a 73 74 65 70 29 29 20 20 3b 3b 20 64 6f ezstep)) ;; do
1f90: 20 73 74 75 66 66 20 74 6f 20 72 75 6e 20 74 68 stuff to run th
1fa0: 65 20 73 74 65 70 0a 09 09 09 09 09 09 09 28 73 e step........(s
1fb0: 74 65 70 69 6e 66 6f 20 20 28 63 61 64 72 20 65 tepinfo (cadr e
1fc0: 7a 73 74 65 70 29 29 0a 09 09 09 09 09 09 09 28 zstep))........(
1fd0: 73 74 65 70 70 61 72 74 73 20 28 73 74 72 69 6e stepparts (strin
1fe0: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
1ff0: 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c "^(\\{([^\\}]*)\
2000: 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 24 22 29 20 \}\\s*|)(.*)$")
2010: 73 74 65 70 69 6e 66 6f 29 29 0a 09 09 09 09 09 stepinfo))......
2020: 09 09 28 73 74 65 70 70 61 72 6d 73 20 28 6c 69 ..(stepparms (li
2030: 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 st-ref stepparts
2040: 20 32 29 29 20 3b 3b 20 66 6f 72 20 66 75 74 75 2)) ;; for futu
2050: 72 65 20 75 73 65 2c 20 7b 56 41 52 3d 31 2c 32 re use, {VAR=1,2
2060: 2c 33 7d 2c 20 72 75 6e 20 73 74 65 70 20 66 6f ,3}, run step fo
2070: 72 20 65 61 63 68 20 0a 09 09 09 09 09 09 09 28 r each ........(
2080: 73 74 65 70 63 6d 64 20 20 20 28 6c 69 73 74 2d stepcmd (list-
2090: 72 65 66 20 73 74 65 70 70 61 72 74 73 20 33 29 ref stepparts 3)
20a0: 29 0a 09 09 09 09 09 09 09 28 73 63 72 69 70 74 )........(script
20b0: 20 20 20 20 22 22 29 20 3b 20 22 23 21 2f 62 69 "") ; "#!/bi
20c0: 6e 2f 62 61 73 68 5c 6e 22 29 20 3b 3b 20 79 65 n/bash\n") ;; ye
20d0: 70 2c 20 77 65 20 64 65 70 65 6e 64 20 6f 6e 20 p, we depend on
20e0: 62 69 6e 2f 62 61 73 68 20 46 49 58 4d 45 21 21 bin/bash FIXME!!
20f0: 21 0a 09 09 09 09 09 09 09 28 6c 6f 67 70 72 6f !........(logpro
2100: 2d 75 73 65 64 20 23 66 29 29 0a 09 09 09 09 09 -used #f))......
2110: 09 20 20 20 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 . ;; NB// can
2120: 73 61 66 65 6c 79 20 61 73 73 75 6d 65 20 77 65 safely assume we
2130: 20 61 72 65 20 69 6e 20 74 65 73 74 2d 61 72 65 are in test-are
2140: 61 20 64 69 72 65 63 74 6f 72 79 0a 09 09 09 09 a directory.....
2150: 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
2160: 74 20 34 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 t 4 "ezsteps:\n
2170: 73 74 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 stepname: " step
2180: 6e 61 6d 65 20 22 20 73 74 65 70 69 6e 66 6f 3a name " stepinfo:
2190: 20 22 20 73 74 65 70 69 6e 66 6f 20 22 20 73 74 " stepinfo " st
21a0: 65 70 70 61 72 74 73 3a 20 22 20 73 74 65 70 70 epparts: " stepp
21b0: 61 72 74 73 0a 09 09 09 09 09 09 09 09 22 20 73 arts........." s
21c0: 74 65 70 70 61 72 6d 73 3a 20 22 20 73 74 65 70 tepparms: " step
21d0: 70 61 72 6d 73 20 22 20 73 74 65 70 63 6d 64 3a parms " stepcmd:
21e0: 20 22 20 73 74 65 70 63 6d 64 29 0a 09 09 09 09 " stepcmd).....
21f0: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 28 .. ....... (
2200: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
2210: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
2220: 22 2e 6c 6f 67 70 72 6f 22 29 29 28 73 65 74 21 ".logpro"))(set!
2230: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 74 29 logpro-used #t)
2240: 29 0a 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 3b )........ ;; ;
2250: 3b 20 66 69 72 73 74 20 73 6f 75 72 63 65 20 74 ; first source t
2260: 68 65 20 70 72 65 76 69 6f 75 73 20 65 6e 76 69 he previous envi
2270: 72 6f 6e 6d 65 6e 74 0a 09 09 09 09 09 09 20 20 ronment.......
2280: 20 3b 3b 20 28 6c 65 74 20 28 28 70 72 65 76 2d ;; (let ((prev-
2290: 65 6e 76 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 env (conc ".ezst
22a0: 65 70 73 2f 22 20 70 72 65 76 73 74 65 70 20 28 eps/" prevstep (
22b0: 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 if (string-searc
22c0: 68 20 28 72 65 67 65 78 70 20 22 63 73 68 22 29 h (regexp "csh")
22d0: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 ....... ;;
22e0: 20 20 20 09 09 09 09 09 09 09 20 28 67 65 74 2d ....... (get-
22f0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
2300: 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 20 22 able "SHELL")) "
2310: 2e 63 73 68 22 20 22 2e 73 68 22 29 29 29 29 0a .csh" ".sh")))).
2320: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 28 69 ...... ;; (i
2330: 66 20 28 61 6e 64 20 70 72 65 76 73 74 65 70 20 f (and prevstep
2340: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 72 (file-exists? pr
2350: 65 76 2d 65 6e 76 29 29 0a 09 09 09 09 09 09 20 ev-env)).......
2360: 20 20 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 ;; (set!
2370: 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 script (conc sc
2380: 72 69 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 ript "source " p
2390: 72 65 76 2d 65 6e 76 29 29 29 29 0a 09 09 09 09 rev-env)))).....
23a0: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 3b .. ....... ;
23b0: 3b 20 63 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 ; call the comma
23c0: 6e 64 20 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 nd using mt_ezst
23d0: 65 70 0a 09 09 09 09 09 09 20 20 20 28 73 65 74 ep....... (set
23e0: 21 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 22 ! script (conc "
23f0: 6d 74 5f 65 7a 73 74 65 70 20 22 20 73 74 65 70 mt_ezstep " step
2400: 6e 61 6d 65 20 22 20 22 20 28 69 66 20 70 72 65 name " " (if pre
2410: 76 73 74 65 70 20 70 72 65 76 73 74 65 70 20 22 vstep prevstep "
2420: 2d 22 29 20 22 20 22 20 73 74 65 70 63 6d 64 29 -") " " stepcmd)
2430: 29 0a 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 )........ (deb
2440: 75 67 3a 70 72 69 6e 74 20 34 20 22 73 63 72 69 ug:print 4 "scri
2450: 70 74 3a 20 22 20 73 63 72 69 70 74 29 0a 0a 09 pt: " script)...
2460: 09 09 09 09 09 20 20 20 28 63 64 62 3a 72 65 6d ..... (cdb:rem
2470: 6f 74 65 2d 72 75 6e 20 64 62 3a 74 65 73 74 73 ote-run db:tests
2480: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
2490: 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e #f test-id stepn
24a0: 61 6d 65 20 22 73 74 61 72 74 22 20 22 2d 22 20 ame "start" "-"
24b0: 23 66 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 #f #f).......
24c0: 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 0a 09 09 ;; now launch...
24d0: 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 .... (let ((pi
24e0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 73 d (process-run s
24f0: 63 72 69 70 74 29 29 29 0a 09 09 09 09 09 09 20 cript))).......
2500: 20 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 (let process
2510: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
2520: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
2530: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
2540: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
2550: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
2560: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
2570: 09 09 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 ....... (mutex
2580: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 -lock! m).......
2590: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
25a0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
25b0: 64 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 d)......... (v
25c0: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
25d0: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
25e0: 75 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 us)......... (
25f0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
2600: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
2610: 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d e)......... (m
2620: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
2630: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ........ (if (
2640: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
2650: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 62 ....... (b
2660: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 28 egin.......... (
2670: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 thread-sleep! 2)
2680: 0a 09 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 .......... (proc
2690: 65 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 essloop (+ i 1))
26a0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 29 29 ))......... ))
26b0: 0a 20 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 28 6c 65 74 20 28 28 65 78 69 (let ((exi
26f0: 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nfo (vector-ref
2700: 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 20 20 exit-info 2)).
2710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2740: 20 20 20 20 20 20 20 20 20 28 6c 6f 67 66 6e 61 (logfna
2750: 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 (if logpro-used
2760: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
2770: 22 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 0a 09 ".html") "")))..
2780: 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 74 ..... ;; t
2790: 65 73 74 69 6e 67 20 69 66 20 70 72 6f 63 65 64 esting if proced
27a0: 75 72 65 73 20 63 61 6c 6c 65 64 20 69 6e 20 61 ures called in a
27b0: 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 63 61 75 remote call cau
27c0: 73 65 20 70 72 6f 62 6c 65 6d 73 20 28 61 6e 73 se problems (ans
27d0: 3a 20 6e 6f 20 6f 72 20 73 6f 20 49 20 73 75 73 : no or so I sus
27e0: 70 65 63 74 29 0a 09 09 09 09 09 09 20 20 20 20 pect).......
27f0: 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 (cdb:remote-r
2800: 75 6e 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 un db:teststep-s
2810: 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 et-status! #f te
2820: 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 st-id stepname "
2830: 65 6e 64 22 20 65 78 69 6e 66 6f 20 23 66 20 6c end" exinfo #f l
2840: 6f 67 66 6e 61 29 29 0a 09 09 09 09 09 09 20 20 ogfna)).......
2850: 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 (if logpro-us
2860: 65 64 0a 09 09 09 09 09 09 09 20 28 63 64 62 3a ed........ (cdb:
2870: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 test-set-log! *r
2880: 75 6e 72 65 6d 6f 74 65 2a 20 20 74 65 73 74 2d unremote* test-
2890: 69 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d id (conc stepnam
28a0: 65 20 22 2e 68 74 6d 6c 22 29 29 29 0a 09 09 09 e ".html")))....
28b0: 09 09 09 20 20 20 20 20 3b 3b 20 73 65 74 20 74 ... ;; set t
28c0: 68 65 20 74 65 73 74 20 66 69 6e 61 6c 20 73 74 he test final st
28d0: 61 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 atus.......
28e0: 28 6c 65 74 2a 20 28 28 74 68 69 73 2d 73 74 65 (let* ((this-ste
28f0: 70 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 p-status (cond..
2900: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2910: 28 61 6e 64 20 28 65 71 3f 20 28 76 65 63 74 6f (and (eq? (vecto
2920: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2930: 32 29 20 32 29 20 6c 6f 67 70 72 6f 2d 75 73 65 2) 2) logpro-use
2940: 64 29 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 d) 'warn).......
2950: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
2960: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
2970: 2d 69 6e 66 6f 20 32 29 20 30 29 20 20 20 20 20 -info 2) 0)
2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 70 'p
2990: 61 73 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 ass)..........
29a0: 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c (else 'fail
29b0: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
29c0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 overall-status
29d0: 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 (cond..........
29e0: 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c ((eq? rol
29f0: 6c 75 70 2d 73 74 61 74 75 73 20 32 29 20 27 77 lup-status 2) 'w
2a00: 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 arn)..........
2a10: 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 ((eq? rollu
2a20: 70 2d 73 74 61 74 75 73 20 30 29 20 27 70 61 73 p-status 0) 'pas
2a30: 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 s)..........
2a40: 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 (else 'fail))
2a50: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e 65 )........ (ne
2a60: 78 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 28 xt-status (
2a70: 63 6f 6e 64 20 0a 09 09 09 09 09 09 09 09 09 20 cond ..........
2a80: 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 ((eq? over
2a90: 61 6c 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 all-status 'pass
2aa0: 29 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ) this-step-stat
2ab0: 75 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 us)..........
2ac0: 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c ((eq? overal
2ad0: 6c 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 0a l-status 'warn).
2ae0: 09 09 09 09 09 09 09 09 09 09 28 69 66 20 28 65 ..........(if (e
2af0: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
2b00: 74 75 73 20 27 66 61 69 6c 29 20 27 66 61 69 6c tus 'fail) 'fail
2b10: 20 27 77 61 72 6e 29 29 0a 09 09 09 09 09 09 09 'warn))........
2b20: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 .. (else '
2b30: 66 61 69 6c 29 29 29 29 0a 09 09 09 09 09 09 20 fail)))).......
2b40: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2b50: 6e 74 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 nt 4 "Exit value
2b60: 20 72 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 received: " (ve
2b70: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2b80: 66 6f 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 fo 2) " logpro-u
2b90: 73 65 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 sed: " logpro-us
2ba0: 65 64 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 ed .........
2bb0: 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 " this-step-stat
2bc0: 75 73 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d us: " this-step-
2bd0: 73 74 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c status " overall
2be0: 2d 73 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 -status: " overa
2bf0: 6c 6c 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 ll-status ......
2c00: 09 09 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 ... " next-st
2c10: 61 74 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 atus: " next-sta
2c20: 74 75 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 tus " rollup-sta
2c30: 74 75 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 tus: " rollup-st
2c40: 61 74 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 atus).......
2c50: 20 20 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 (case next-st
2c60: 61 74 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 atus........ ((w
2c70: 61 72 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 arn)........ (s
2c80: 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 et! rollup-statu
2c90: 73 20 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b s 2)........ ;;
2ca0: 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 NB// test-set-s
2cb0: 74 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 tatus! does rdb
2cc0: 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 calls under the
2cd0: 68 6f 6f 64 0a 09 09 09 09 09 09 09 20 20 28 74 hood........ (t
2ce0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
2cf0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
2d00: 55 4e 4e 49 4e 47 22 20 22 57 41 52 4e 22 20 0a UNNING" "WARN" .
2d10: 09 09 09 09 09 09 09 09 09 20 20 28 69 66 20 28 ......... (if (
2d20: 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 eq? this-step-st
2d30: 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 atus 'warn) "Log
2d40: 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e pro warning foun
2d50: 64 22 20 23 66 29 0a 09 09 09 09 09 09 09 09 09 d" #f)..........
2d60: 20 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 #f))........ (
2d70: 28 70 61 73 73 29 0a 09 09 09 09 09 09 09 20 20 (pass)........
2d80: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
2d90: 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 status! test-id
2da0: 22 52 55 4e 4e 49 4e 47 22 20 22 50 41 53 53 22 "RUNNING" "PASS"
2db0: 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 #f #f))........
2dc0: 20 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c 0a (else ;; 'fail.
2dd0: 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 72 ....... (set! r
2de0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 ollup-status 1)
2df0: 3b 3b 20 66 6f 72 63 65 20 66 61 69 6c 0a 09 09 ;; force fail...
2e00: 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 ..... (tests:te
2e10: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
2e20: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2e30: 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 22 46 "FAIL" (conc "F
2e40: 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 22 20 ailed at step "
2e50: 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a 09 09 stepname) #f)...
2e60: 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 09 09 ..... )))).....
2e70: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 .. (if (and (s
2e80: 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 teprun-good? log
2e90: 70 72 6f 2d 75 73 65 64 20 28 76 65 63 74 6f 72 pro-used (vector
2ea0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
2eb0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e ))........ (n
2ec0: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 ot (null? tal)))
2ed0: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ....... (l
2ee0: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 28 63 oop (car tal) (c
2ef0: 64 72 20 74 61 6c 29 20 73 74 65 70 6e 61 6d 65 dr tal) stepname
2f00: 29 29 29 0a 09 09 09 09 09 09 20 28 64 65 62 75 )))....... (debu
2f10: 67 3a 70 72 69 6e 74 20 34 20 22 57 41 52 4e 49 g:print 4 "WARNI
2f20: 4e 47 3a 20 61 20 70 72 69 6f 72 20 73 74 65 70 NG: a prior step
2f30: 20 66 61 69 6c 65 64 2c 20 73 74 6f 70 70 69 6e failed, stoppin
2f40: 67 20 61 74 20 22 20 65 7a 73 74 65 70 29 29 29 g at " ezstep)))
2f50: 29 29 29 29 29 0a 09 09 20 28 6d 6f 6e 69 74 6f )))))... (monito
2f60: 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 28 rjob (lambda (
2f70: 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 73 )..... (let* ((s
2f80: 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 tart-seconds (cu
2f90: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a rrent-seconds)).
2fa0: 09 09 09 09 09 28 63 61 6c 63 2d 6d 69 6e 75 74 .....(calc-minut
2fb0: 65 73 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 es (lambda ()..
2fc0: 09 09 09 09 09 09 20 28 69 6e 65 78 61 63 74 2d ...... (inexact-
2fd0: 3e 65 78 61 63 74 20 0a 09 09 09 09 09 09 09 20 >exact ........
2fe0: 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 09 09 09 (round ........
2ff0: 20 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 20 (- ........
3000: 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e (current-secon
3010: 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 20 ds) ........
3020: 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 start-seconds)))
3030: 29 29 0a 09 09 09 09 09 28 6b 69 6c 6c 2d 74 72 ))......(kill-tr
3040: 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 20 28 ies 0))..... (
3050: 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 let loop ((minut
3060: 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 es (calc-minut
3070: 65 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 es)))..... (
3080: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 begin.....
3090: 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f (set! kill-job?
30a0: 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d (test-get-kill-
30b0: 72 65 71 75 65 73 74 20 74 65 73 74 2d 69 64 29 request test-id)
30c0: 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 ) ;; run-id test
30d0: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 0a -name itemdat)).
30e0: 09 09 09 09 20 20 20 20 20 20 20 28 6f 70 65 6e .... (open
30f0: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d -run-close test-
3100: 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 set-meta-info #f
3110: 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 test-id run-id
3120: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
3130: 74 20 6d 69 6e 75 74 65 73 29 0a 09 09 09 09 20 t minutes).....
3140: 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a (if kill-j
3150: 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 ob? ...... (be
3160: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d gin...... (m
3170: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
3180: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
3190: 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 pid (vector-ref
31a0: 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a 09 exit-info 0)))..
31b0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
31c0: 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 09 number? pid)....
31d0: 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ... (begin....
31e0: 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ... (debug:p
31f0: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
3200: 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 65 Request receive
3210: 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 61 d to kill job (a
3220: 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d ttempt # " kill-
3230: 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 09 tries ")")......
3240: 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 6f . (let ((pro
3250: 63 65 73 73 65 73 20 28 63 6d 64 2d 72 75 6e 2d cesses (cmd-run-
3260: 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 70 67 72 >list (conc "pgr
3270: 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 64 29 29 ep -l -P " pid))
3280: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
3290: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09 (for-each ......
32a0: 09 09 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 ..(lambda (p)...
32b0: 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 70 ..... (let* ((p
32c0: 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 70 arts (string-sp
32d0: 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 09 09 lit p)).........
32e0: 20 28 70 2d 69 64 20 20 20 28 69 66 20 28 3e 20 (p-id (if (>
32f0: 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 20 30 (length parts) 0
3300: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
3310: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
3320: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
3330: 09 09 09 09 09 09 20 20 20 20 20 23 66 29 29 29 ...... #f)))
3340: 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 ........ (if
3350: 70 2d 69 64 0a 09 09 09 09 09 09 09 09 28 62 65 p-id.........(be
3360: 67 69 6e 0a 09 09 09 09 09 09 09 09 20 20 28 64 gin......... (d
3370: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4b 69 ebug:print 0 "Ki
3380: 6c 6c 69 6e 67 20 22 20 28 63 61 64 72 20 70 61 lling " (cadr pa
3390: 72 74 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20 rts) "; kill -9
33a0: 20 22 20 70 2d 69 64 29 0a 09 09 09 09 09 09 09 " p-id)........
33b0: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
33c0: 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 "kill -9 " p-id
33d0: 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 28 63 ))))))........(c
33e0: 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 0a 09 ar processes))..
33f0: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 79 73 ..... (sys
3400: 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 tem (conc "kill
3410: 2d 39 20 2d 22 20 70 69 64 29 29 29 29 0a 09 09 -9 -" pid))))...
3420: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
3430: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
3440: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
3450: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
3460: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 ed to kill job b
3470: 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 ut problem with
3480: 70 72 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 74 process, attempt
3490: 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 ing to kill mana
34a0: 67 65 72 20 70 72 6f 63 65 73 73 22 29 0a 09 09 ger process")...
34b0: 09 09 09 09 20 20 20 20 20 28 74 65 73 74 73 3a .... (tests:
34c0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
34d0: 20 74 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 test-id "KILLED
34e0: 22 20 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 " "FAIL".......
34f0: 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 .. (args:get
3500: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
3510: 09 09 09 09 09 20 20 20 20 20 28 73 71 6c 69 74 ..... (sqlit
3520: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
3530: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 78 )....... (ex
3540: 69 74 20 31 29 29 29 29 0a 09 09 09 09 09 20 20 it 1))))......
3550: 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d 74 72 (set! kill-tr
3560: 69 65 73 20 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 ies (+ 1 kill-tr
3570: 69 65 73 29 29 0a 09 09 09 09 09 20 20 20 20 20 ies))......
3580: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
3590: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b )))..... ;
35a0: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
35b0: 69 7a 65 21 20 64 62 29 0a 09 09 09 09 20 20 20 ize! db).....
35c0: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
35d0: 70 21 20 28 2b 20 31 30 20 28 72 61 6e 64 6f 6d p! (+ 10 (random
35e0: 20 31 30 29 29 29 20 3b 3b 20 61 64 64 20 73 6f 10))) ;; add so
35f0: 6d 65 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 me jitter to the
3600: 20 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 call home time
3610: 74 6f 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 to spread out th
3620: 65 20 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 e db accesses...
3630: 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 .. (loop (
3640: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 calc-minutes))))
3650: 29 29 29 0a 09 09 20 28 74 68 31 20 20 20 20 20 )))... (th1
3660: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
3670: 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 d monitorjob))..
3680: 09 20 28 74 68 32 20 20 20 20 20 20 20 20 20 20 . (th2
3690: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 75 6e (make-thread run
36a0: 69 74 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 it))).. (set!
36b0: 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 job-thread th2)
36c0: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
36d0: 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 28 art! th1).. (
36e0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
36f0: 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 2).. (thread-
3700: 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 20 20 join! th2)..
3710: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
3720: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 . (let* ((ite
3730: 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 m-path (item-lis
3740: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
3750: 29 0a 09 09 20 20 20 28 74 65 73 74 69 6e 66 6f )... (testinfo
3760: 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d (cdb:get-test-
3770: 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 info-by-id *runr
3780: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 emote* test-id))
3790: 29 20 3b 3b 20 29 29 20 3b 3b 20 72 75 6e 2d 69 ) ;; )) ;; run-i
37a0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
37b0: 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 20 -path)))..
37c0: 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 65 ;; Am I complete
37d0: 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e d?.. (if (n
37e0: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
37f0: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
3800: 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c 45 54 stinfo) "COMPLET
3810: 45 44 22 29 29 0a 09 09 20 20 28 62 65 67 69 6e ED"))... (begin
3820: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
3830: 69 6e 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 int 2 "Test NOT
3840: 6c 6f 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 logged as COMPLE
3850: 54 45 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 TED, (state=" (d
3860: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
3870: 20 74 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 testinfo) "), u
3880: 70 64 61 74 69 6e 67 20 72 65 73 75 6c 74 2c 20 pdating result,
3890: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 69 73 rollup-status is
38a0: 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 " rollup-status
38b0: 29 0a 09 09 20 20 20 20 28 74 65 73 74 73 3a 74 )... (tests:t
38c0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
38d0: 74 65 73 74 2d 69 64 20 0a 09 09 09 09 20 20 20 test-id .....
38e0: 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 (if kill-job? "
38f0: 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 KILLED" "COMPLET
3900: 45 44 22 29 0a 09 09 09 09 20 20 20 20 28 63 6f ED")..... (co
3910: 6e 64 0a 09 09 09 09 20 20 20 20 20 28 28 6e 6f nd..... ((no
3920: 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 t (vector-ref ex
3930: 69 74 2d 69 6e 66 6f 20 31 29 29 20 22 46 41 49 it-info 1)) "FAI
3940: 4c 22 29 20 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 L") ;; job faile
3950: 64 20 74 6f 20 72 75 6e 0a 09 09 09 09 20 20 20 d to run.....
3960: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
3970: 74 61 74 75 73 20 30 29 0a 09 09 09 09 20 20 20 tatus 0).....
3980: 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 ;; if the cur
3990: 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 rent status is A
39a0: 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 6f UTO the defer to
39b0: 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 20 the calculated
39c0: 76 61 6c 75 65 20 28 69 2e 65 2e 20 6c 65 61 76 value (i.e. leav
39d0: 65 20 74 68 69 73 20 41 55 54 4f 29 0a 09 09 09 e this AUTO)....
39e0: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
39f0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3a00: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 status testinfo)
3a10: 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 22 20 "AUTO") "AUTO"
3a20: 22 50 41 53 53 22 29 29 0a 09 09 09 09 20 20 20 "PASS")).....
3a30: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
3a40: 74 61 74 75 73 20 31 29 20 22 46 41 49 4c 22 29 tatus 1) "FAIL")
3a50: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
3a60: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 29 rollup-status 2)
3a70: 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 66 ..... ;; if
3a80: 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 61 the current sta
3a90: 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 20 tus is AUTO the
3aa0: 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c defer to the cal
3ab0: 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 62 75 culated value bu
3ac0: 74 20 71 75 61 6c 69 66 79 20 28 69 2e 65 2e 20 t qualify (i.e.
3ad0: 6d 61 6b 65 20 74 68 69 73 20 41 55 54 4f 2d 57 make this AUTO-W
3ae0: 41 52 4e 29 0a 09 09 09 09 20 20 20 20 20 20 28 ARN)..... (
3af0: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
3b00: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
3b10: 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 estinfo) "AUTO")
3b20: 20 22 41 55 54 4f 2d 57 41 52 4e 22 20 22 57 41 "AUTO-WARN" "WA
3b30: 52 4e 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 RN"))..... (
3b40: 65 6c 73 65 20 22 46 41 49 4c 22 29 29 0a 09 09 else "FAIL"))...
3b50: 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d .. (args:get-
3b60: 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 29 0a arg "-m") #f))).
3b70: 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 . ;; for au
3b80: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
3b90: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
3ba0: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
3bb0: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
3bc0: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
3bd0: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
3be0: 74 68 20 22 22 29 29 0a 09 09 20 20 28 6f 70 65 th ""))... (ope
3bf0: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 n-run-close test
3c00: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d s:summarize-item
3c10: 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 s #f run-id test
3c20: 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 64 6f -name #f)) ;; do
3c30: 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74 n't force - just
3c40: 20 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 20 update if no..
3c50: 20 20 20 20 20 29 0a 09 20 20 20 20 28 6d 75 74 ).. (mut
3c60: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
3c70: 20 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 ;; (exec-resu
3c80: 6c 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 lts (cmd-run->li
3c90: 73 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 st fullrunscript
3ca0: 29 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 )) ;; (list ">"
3cb0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 (conc test-name
3cc0: 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a "-run.log")))).
3cd0: 09 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 73 . ;; (success
3ce0: 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 6c exec-resul
3cf0: 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 61 ts)) ;; (eq? (ca
3d00: 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 29 dr exec-results)
3d10: 20 30 29 29 29 0a 09 20 20 20 20 28 64 65 62 75 0))).. (debu
3d20: 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 74 70 75 g:print 2 "Outpu
3d30: 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 t from running "
3d40: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 fullrunscript "
3d50: 2c 20 70 69 64 20 22 20 28 76 65 63 74 6f 72 2d , pid " (vector-
3d60: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3d70: 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 20 " in work area
3d80: 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 61 " .... work-area
3d90: 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 ":\n====\n exit
3da0: 20 63 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d code " (vector-
3db0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
3dc0: 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a "\n" "====\n").
3dd0: 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 . ;; (sqlite3
3de0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
3df0: 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a ;; (sqlite3:
3e00: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
3e10: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 (if (not (ve
3e20: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3e30: 66 6f 20 31 29 29 0a 09 09 28 65 78 69 74 20 34 fo 1))...(exit 4
3e40: 29 29 29 29 29 29 29 0a 0a 3b 3b 20 73 65 74 20 )))))))..;; set
3e50: 75 70 20 74 68 65 20 76 65 72 79 20 62 61 73 69 up the very basi
3e60: 63 73 20 6e 65 65 64 65 64 20 66 6f 72 20 64 6f cs needed for do
3e70: 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 68 65 72 ing anything her
3e80: 65 2e 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 e..(define (setu
3e90: 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 20 3b 3b 20 p-for-run). ;;
3ea0: 77 6f 75 6c 64 20 73 65 74 20 76 61 6c 75 65 73 would set values
3eb0: 20 66 6f 72 20 4b 45 59 53 20 69 6e 20 74 68 65 for KEYS in the
3ec0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 65 72 environment her
3ed0: 65 20 66 6f 72 20 62 65 74 74 65 72 20 73 75 70 e for better sup
3ee0: 70 6f 72 74 20 6f 66 20 65 6e 76 2d 6f 76 65 72 port of env-over
3ef0: 72 69 64 65 20 62 75 74 20 0a 20 20 3b 3b 20 68 ride but . ;; h
3f00: 61 76 65 20 63 68 69 63 6b 65 6e 2f 65 67 67 20 ave chicken/egg
3f10: 73 63 65 6e 61 72 69 6f 2e 20 6e 65 65 64 20 74 scenario. need t
3f20: 6f 20 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e o read megatest.
3f30: 63 6f 6e 66 69 67 20 74 68 65 6e 20 72 65 61 64 config then read
3f40: 20 69 74 20 61 67 61 69 6e 2e 20 47 6f 69 6e 67 it again. Going
3f50: 20 74 6f 20 0a 20 20 3b 3b 20 70 61 73 73 20 6f to . ;; pass o
3f60: 6e 20 74 68 61 74 20 69 64 65 61 20 66 6f 72 20 n that idea for
3f70: 6e 6f 77 0a 20 20 3b 3b 20 73 70 65 63 69 61 6c now. ;; special
3f80: 20 63 61 73 65 0a 20 20 28 73 65 74 21 20 2a 63 case. (set! *c
3f90: 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 6e 64 onfiginfo* (find
3fa0: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
3fb0: 20 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 61 ... (if (a
3fc0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
3fd0: 6e 66 69 67 22 29 28 61 72 67 73 3a 67 65 74 2d nfig")(args:get-
3fe0: 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 arg "-config") "
3ff0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
4000: 29 0a 09 09 20 20 20 20 20 20 65 6e 76 69 72 6f )... enviro
4010: 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 n-patt: "env-ove
4020: 72 72 69 64 65 22 0a 09 09 20 20 20 20 20 20 67 rride"... g
4030: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 iven-toppath: (g
4040: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
4050: 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f ariable "MT_RUN_
4060: 41 52 45 41 5f 48 4f 4d 45 22 29 0a 09 09 20 20 AREA_HOME")...
4070: 20 20 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 pathenvvar:
4080: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
4090: 45 22 29 29 0a 20 20 28 73 65 74 21 20 2a 63 6f E")). (set! *co
40a0: 6e 66 69 67 64 61 74 2a 20 20 28 69 66 20 28 63 nfigdat* (if (c
40b0: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
40c0: 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f (car *configinfo
40d0: 2a 29 20 23 66 29 29 0a 20 20 28 73 65 74 21 20 *) #f)). (set!
40e0: 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 28 69 66 *toppath* (if
40f0: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
4100: 6f 2a 29 28 63 61 64 72 20 2a 63 6f 6e 66 69 67 o*)(cadr *config
4110: 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 69 info*) #f)). (i
4120: 66 20 2a 74 6f 70 70 61 74 68 2a 0a 20 20 20 20 f *toppath*.
4130: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 (setenv "MT_RU
4140: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f N_AREA_HOME" *to
4150: 70 70 61 74 68 2a 29 20 3b 3b 20 74 6f 20 62 65 ppath*) ;; to be
4160: 20 64 65 70 72 65 63 61 74 65 64 0a 20 20 20 20 deprecated.
4170: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4180: 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 "ERROR: failed
4190: 74 6f 20 66 69 6e 64 20 74 68 65 20 74 6f 70 20 to find the top
41a0: 70 61 74 68 20 74 6f 20 79 6f 75 72 20 72 75 6e path to your run
41b0: 20 73 65 74 75 70 2e 22 29 29 0a 20 20 2a 74 6f setup.")). *to
41c0: 70 70 61 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 ppath*)..(define
41d0: 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 (get-best-disk
41e0: 63 6f 6e 66 64 61 74 29 0a 20 20 28 6c 65 74 2a confdat). (let*
41f0: 20 28 28 64 69 73 6b 73 20 20 20 20 28 68 61 73 ((disks (has
4200: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
4210: 75 6c 74 20 63 6f 6e 66 64 61 74 20 22 64 69 73 ult confdat "dis
4220: 6b 73 22 20 23 66 29 29 0a 09 20 28 62 65 73 74 ks" #f)).. (best
4230: 20 20 20 20 20 23 66 29 0a 09 20 28 62 65 73 74 #f).. (best
4240: 73 69 7a 65 20 30 29 29 0a 20 20 20 20 28 69 66 size 0)). (if
4250: 20 64 69 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 disks ..(for-ea
4260: 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 ch .. (lambda (d
4270: 69 73 6b 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 isk-num).. (le
4280: 74 2a 20 28 28 64 69 72 70 61 74 68 20 20 20 20 t* ((dirpath
4290: 28 63 61 64 72 20 28 61 73 73 6f 63 20 64 69 73 (cadr (assoc dis
42a0: 6b 2d 6e 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 k-num disks)))..
42b0: 09 20 20 28 66 72 65 65 73 70 63 20 20 20 20 28 . (freespc (
42c0: 69 66 20 28 61 6e 64 20 28 64 69 72 65 63 74 6f if (and (directo
42d0: 72 79 3f 20 64 69 72 70 61 74 68 29 0a 09 09 09 ry? dirpath)....
42e0: 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 . (file-wr
42f0: 69 74 65 2d 61 63 63 65 73 73 3f 20 64 69 72 70 ite-access? dirp
4300: 61 74 68 29 29 0a 09 09 09 09 20 20 28 67 65 74 ath))..... (get
4310: 2d 64 66 20 64 69 72 70 61 74 68 29 0a 09 09 09 -df dirpath)....
4320: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 . (begin.....
4330: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4340: 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 "WARNING: path
4350: 22 20 64 69 72 70 61 74 68 20 22 20 69 6e 20 5b " dirpath " in [
4360: 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e disks] section n
4370: 6f 74 20 76 61 6c 69 64 20 6f 72 20 77 72 69 74 ot valid or writ
4380: 61 62 6c 65 22 29 0a 09 09 09 09 20 20 20 20 30 able")..... 0
4390: 29 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 )))).. (if (
43a0: 3e 20 66 72 65 65 73 70 63 20 62 65 73 74 73 69 > freespc bestsi
43b0: 7a 65 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 ze)... (begin...
43c0: 20 20 20 28 73 65 74 21 20 62 65 73 74 20 20 20 (set! best
43d0: 20 20 64 69 72 70 61 74 68 29 0a 09 09 20 20 20 dirpath)...
43e0: 28 73 65 74 21 20 62 65 73 74 73 69 7a 65 20 66 (set! bestsize f
43f0: 72 65 65 73 70 63 29 29 29 29 29 0a 09 20 28 6d reespc))))).. (m
4400: 61 70 20 63 61 72 20 64 69 73 6b 73 29 29 29 0a ap car disks))).
4410: 20 20 20 20 28 69 66 20 62 65 73 74 0a 09 62 65 (if best..be
4420: 73 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 st..(begin.. (d
4430: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4440: 52 4f 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 ROR: No valid di
4450: 73 6b 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 sks found in meg
4460: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c atest.config. Pl
4470: 65 61 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f ease add some to
4480: 20 79 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 your [disks] se
4490: 63 74 69 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 ction").. (exit
44a0: 20 31 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 1)))))..;; Desi
44b0: 72 65 64 20 64 69 72 65 63 74 6f 72 79 20 73 74 red directory st
44c0: 72 75 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 ructure:.;;.;;
44d0: 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 <linkdir> - <tar
44e0: 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 get> - <testname
44f0: 3e 20 2d 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 > -..;;
4500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4510: 20 20 20 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b |.;;
4520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4540: 20 20 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 v.;; <rund
4550: 69 72 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 3e ir> - <target>
4560: 20 20 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 - <testname
4570: 3e 20 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 > -|- <itempath(
4580: 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 s)>.;;.;; dir s
4590: 74 6f 72 65 64 20 69 6e 20 74 65 73 74 20 69 73 tored in test is
45a0: 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 :.;; .;; <linkd
45b0: 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d ir> - <target> -
45c0: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
45d0: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 <itempath> ].;;
45e0: 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 .;; All log file
45f0: 20 6c 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 links should be
4600: 20 73 74 6f 72 65 64 20 72 65 6c 61 74 69 76 65 stored relative
4610: 20 74 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 6c to the top of l
4620: 69 6e 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b ink path.;; .;;
4630: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
4640: 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d tname> [ - <item
4650: 70 61 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 path> ] .;;.(def
4660: 69 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b ine (create-work
4670: 2d 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 -area db run-id
4680: 74 65 73 74 2d 69 64 20 74 65 73 74 2d 73 72 63 test-id test-src
4690: 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 74 68 20 -path disk-path
46a0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 testname itemdat
46b0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d ). (let* ((run-
46c0: 69 6e 66 6f 20 28 63 64 62 3a 72 65 6d 6f 74 65 info (cdb:remote
46d0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 72 75 6e 2d -run db:get-run-
46e0: 69 6e 66 6f 20 23 66 20 72 75 6e 2d 69 64 29 29 info #f run-id))
46f0: 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 .. (item-path (i
4700: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
4710: 74 65 6d 64 61 74 29 29 0a 09 20 28 72 75 6e 6e temdat)).. (runn
4720: 61 6d 65 20 20 28 64 62 3a 67 65 74 2d 76 61 6c ame (db:get-val
4730: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 ue-by-header (db
4740: 3a 67 65 74 2d 72 6f 77 20 72 75 6e 2d 69 6e 66 :get-row run-inf
4750: 6f 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a 67 o)...... (db:g
4760: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 6e et-header run-in
4770: 66 6f 29 0a 09 09 09 09 09 20 20 20 22 72 75 6e fo)...... "run
4780: 6e 61 6d 65 22 29 29 0a 09 20 3b 3b 20 63 6f 6e name")).. ;; con
4790: 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 62 3a vert back to db:
47a0: 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 69 from rdb: - thi
47b0: 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 6e 20 s is always run
47c0: 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a 09 20 at server end..
47d0: 28 6b 65 79 2d 76 61 6c 73 20 28 63 64 62 3a 72 (key-vals (cdb:r
47e0: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
47f0: 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 72 75 6e -key-vals #f run
4800: 2d 69 64 29 29 0a 09 20 28 74 61 72 67 65 74 20 -id)).. (target
4810: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
4820: 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 perse key-vals "
4830: 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 2d 69 74 65 /"))... (not-ite
4840: 72 61 74 65 64 20 20 28 65 71 75 61 6c 3f 20 22 rated (equal? "
4850: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 " item-path))...
4860: 20 3b 3b 20 61 6c 6c 20 74 65 73 74 73 20 61 72 ;; all tests ar
4870: 65 20 66 6f 75 6e 64 20 61 74 20 3c 72 75 6e 64 e found at <rund
4880: 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 20 6f 72 ir>/test-base or
4890: 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 73 74 2d <linkdir>/test-
48a0: 62 61 73 65 0a 09 20 28 74 65 73 74 74 6f 70 2d base.. (testtop-
48b0: 62 61 73 65 20 28 63 6f 6e 63 20 74 61 72 67 65 base (conc targe
48c0: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f t "/" runname "/
48d0: 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 " testname)).. (
48e0: 74 65 73 74 2d 62 61 73 65 20 20 20 20 28 63 6f test-base (co
48f0: 6e 63 20 74 65 73 74 74 6f 70 2d 62 61 73 65 20 nc testtop-base
4900: 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 (if not-iterated
4910: 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 "" "/") item-pa
4920: 74 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 2f 2f 20 th))... ;; nb//
4930: 69 66 20 69 74 65 6d 70 61 74 68 20 69 73 20 6e if itempath is n
4940: 6f 74 20 22 22 20 74 68 65 6e 20 69 74 20 69 73 ot "" then it is
4950: 20 70 72 65 66 69 78 65 64 20 77 69 74 68 20 22 prefixed with "
4960: 2f 22 0a 09 20 28 74 6f 70 74 65 73 74 2d 70 61 /".. (toptest-pa
4970: 74 68 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 th (conc disk-pa
4980: 74 68 20 22 2f 22 20 74 65 73 74 74 6f 70 2d 62 th "/" testtop-b
4990: 61 73 65 29 29 0a 09 20 28 74 65 73 74 2d 70 61 ase)).. (test-pa
49a0: 74 68 20 20 20 20 28 63 6f 6e 63 20 64 69 73 6b th (conc disk
49b0: 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 2d 62 -path "/" test-b
49c0: 61 73 65 29 29 0a 0a 09 20 3b 3b 20 65 6e 73 75 ase))... ;; ensu
49d0: 72 65 20 74 68 69 73 20 65 78 69 73 74 73 20 66 re this exists f
49e0: 69 72 73 74 20 61 73 20 6c 69 6e 6b 73 20 74 6f irst as links to
49f0: 20 73 75 62 74 65 73 74 73 20 6d 75 73 74 20 62 subtests must b
4a00: 65 20 63 72 65 61 74 65 64 20 74 68 65 72 65 0a e created there.
4a10: 09 20 28 6c 69 6e 6b 74 72 65 65 20 20 28 6c 65 . (linktree (le
4a20: 74 20 28 28 72 64 20 28 63 6f 6e 66 69 67 2d 6c t ((rd (config-l
4a30: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
4a40: 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 * "setup" "linkt
4a50: 72 65 65 22 29 29 29 0a 09 09 20 20 20 20 20 20 ree")))...
4a60: 28 69 66 20 72 64 20 72 64 20 28 63 6f 6e 63 20 (if rd rd (conc
4a70: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 *toppath* "/runs
4a80: 22 29 29 29 29 0a 0a 09 20 28 6c 6e 6b 62 61 73 "))))... (lnkbas
4a90: 65 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 e (conc linktre
4aa0: 65 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 e "/" target "/"
4ab0: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e runname)).. (ln
4ac0: 6b 70 61 74 68 20 20 28 63 6f 6e 63 20 6c 6e 6b kpath (conc lnk
4ad0: 62 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 6d base "/" testnam
4ae0: 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 20 e)).. (lnkpathf
4af0: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 69 (conc lnkpath (i
4b00: 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 f not-iterated "
4b10: 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 " "/") item-path
4b20: 29 29 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 61 ))).. ;; Upda
4b30: 74 65 20 74 68 65 20 72 75 6e 64 69 72 20 70 61 te the rundir pa
4b40: 74 68 20 69 6e 20 74 68 65 20 74 65 73 74 20 72 th in the test r
4b50: 65 63 6f 72 64 20 66 6f 72 20 61 6c 6c 0a 20 20 ecord for all.
4b60: 20 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d (cdb:test-set-
4b70: 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 74 2d 69 rundir-by-test-i
4b80: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 d *runremote* te
4b90: 73 74 2d 69 64 20 6c 6e 6b 70 61 74 68 66 29 0a st-id lnkpathf).
4ba0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
4bb0: 74 20 32 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 t 2 "INFO:\n
4bc0: 20 20 20 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b lnkbase=" lnk
4bd0: 62 61 73 65 20 22 5c 6e 20 20 20 20 20 20 20 6c base "\n l
4be0: 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 nkpath=" lnkpath
4bf0: 20 22 5c 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 "\n toptest-pa
4c00: 74 68 3d 22 20 74 6f 70 74 65 73 74 2d 70 61 74 th=" toptest-pat
4c10: 68 20 22 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 h "\n test-p
4c20: 61 74 68 3d 22 20 74 65 73 74 2d 70 61 74 68 29 ath=" test-path)
4c30: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 . (if (not (f
4c40: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b ile-exists? link
4c50: 74 72 65 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 tree))..(begin..
4c60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4c70: 20 22 57 41 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 "WARNING: linkt
4c80: 72 65 65 20 64 69 64 20 6e 6f 74 20 65 78 69 73 ree did not exis
4c90: 74 21 20 43 72 65 61 74 69 6e 67 20 69 74 20 6e t! Creating it n
4ca0: 6f 77 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 ow at " linktree
4cb0: 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 ).. (create-dir
4cc0: 65 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 ectory linktree
4cd0: 23 74 29 29 29 20 3b 3b 20 28 73 79 73 74 65 6d #t))) ;; (system
4ce0: 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 (conc "mkdir -p
4cf0: 20 22 20 6c 69 6e 6b 74 72 65 65 29 29 29 29 0a " linktree)))).
4d00: 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 ;; create th
4d10: 65 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 e directory for
4d20: 74 68 65 20 74 65 73 74 73 20 64 69 72 20 6c 69 the tests dir li
4d30: 6e 6b 73 2c 20 74 68 69 73 20 69 73 20 6e 65 65 nks, this is nee
4d40: 64 65 64 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 ded no matter wh
4d50: 61 74 2e 2e 2e 0a 20 20 20 20 28 69 66 20 28 6e at.... (if (n
4d60: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
4d70: 69 73 74 73 3f 20 6c 6e 6b 62 61 73 65 29 29 0a ists? lnkbase)).
4d80: 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f .(create-directo
4d90: 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 0a ry lnkbase #t)).
4da0: 20 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 61 . ;; upda
4db0: 74 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 72 te the toptest r
4dc0: 65 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 6c ecord with its l
4dd0: 6f 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c 20 ocation rundir,
4de0: 63 61 63 68 65 20 74 68 65 20 70 61 74 68 0a 20 cache the path.
4df0: 20 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 20 ;; This wass
4e00: 68 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 65 highly inefficie
4e10: 6e 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 65 nt, one db write
4e20: 20 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 65 for every subte
4e30: 73 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 0a st, potentially.
4e40: 20 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 73 ;; thousands
4e50: 20 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 20 of unnecessary
4e60: 75 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 74 updates, cache t
4e70: 68 65 20 66 61 63 74 20 69 74 20 77 61 73 20 73 he fact it was s
4e80: 65 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 74 et and don't set
4e90: 20 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 69 it . ;; agai
4ea0: 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 42 20 2d n. .. ;; NB -
4eb0: 20 54 68 69 73 20 69 73 20 6e 6f 74 20 77 6f 72 This is not wor
4ec0: 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f 6d king right - som
4ed0: 65 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 20 e top tests are
4ee0: 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 20 not getting the
4ef0: 70 61 74 68 20 73 65 74 21 21 21 0a 0a 20 20 20 path set!!!..
4f00: 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d (if (not (hash-
4f10: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4f20: 74 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 t *toptest-paths
4f30: 2a 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a * testname #f)).
4f40: 09 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e 66 .(let* ((testinf
4f50: 6f 20 20 20 20 20 20 20 28 63 64 62 3a 67 65 74 o (cdb:get
4f60: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
4f70: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 *runremote* tes
4f80: 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e 2d 69 t-id)) ;; run-i
4f90: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
4fa0: 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 20 28 path)).. (
4fb0: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 20 28 curr-test-path (
4fc0: 69 66 20 74 65 73 74 69 6e 66 6f 20 28 64 62 3a if testinfo (db:
4fd0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 test-get-rundir
4fe0: 74 65 73 74 69 6e 66 6f 29 20 23 66 29 29 29 0a testinfo) #f))).
4ff0: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
5000: 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 et! *toptest-pat
5010: 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 63 75 72 hs* testname cur
5020: 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 r-test-path)..
5030: 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 74 68 69 73 ;; NB// Was this
5040: 20 66 6f 72 20 74 68 65 20 74 65 73 74 20 6f 72 for the test or
5050: 20 66 6f 72 20 74 68 65 20 70 61 72 65 6e 74 20 for the parent
5060: 69 6e 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 in an iterated t
5070: 65 73 74 3f 0a 09 20 20 28 63 64 62 3a 74 65 73 est?.. (cdb:tes
5080: 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 2a 72 t-set-rundir! *r
5090: 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 2d 69 64 unremote* run-id
50a0: 20 74 65 73 74 6e 61 6d 65 20 22 22 20 6c 6e 6b testname "" lnk
50b0: 70 61 74 68 29 20 3b 3b 20 74 6f 70 74 65 73 74 path) ;; toptest
50c0: 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f -path).. (if (o
50d0: 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 r (not curr-test
50e0: 2d 70 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 -path)... (not
50f0: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
5100: 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 s? toptest-path)
5110: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
5120: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print-
5130: 69 6e 66 6f 20 32 20 22 43 72 65 61 74 69 6e 67 info 2 "Creating
5140: 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 " toptest-path
5150: 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c 6e 6b " and link " lnk
5160: 70 61 74 68 29 0a 09 09 28 63 72 65 61 74 65 2d path)...(create-
5170: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 74 65 73 directory toptes
5180: 74 2d 70 61 74 68 20 23 74 29 0a 09 09 28 68 61 t-path #t)...(ha
5190: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
51a0: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
51b0: 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d 70 stname toptest-p
51c0: 61 74 68 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b ath))))).. ;;
51d0: 20 4e 6f 77 20 63 72 65 61 74 65 20 74 68 65 20 Now create the
51e0: 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 20 74 65 link from the te
51f0: 73 74 20 70 61 74 68 20 74 6f 20 74 68 65 20 6c st path to the l
5200: 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 65 76 65 ink tree, howeve
5210: 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 r. ;; if the
5220: 74 65 73 74 20 69 73 20 69 74 65 72 61 74 65 64 test is iterated
5230: 20 69 74 20 69 73 20 6e 65 63 65 73 73 61 72 79 it is necessary
5240: 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 70 to create the p
5250: 61 72 65 6e 74 20 70 61 74 68 0a 20 20 20 20 3b arent path. ;
5260: 3b 20 74 6f 20 74 68 65 20 69 74 65 72 61 74 69 ; to the iterati
5270: 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e 61 6d 65 on. use pathname
5280: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 20 74 72 -directory to tr
5290: 69 6d 20 74 68 65 20 70 61 74 68 20 62 79 20 6f im the path by o
52a0: 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 65 6c 0a ne. ;; level.
52b0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 (if (not not
52c0: 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 69 2e -iterated) ;; i.
52d0: 65 2e 20 69 74 65 72 61 74 65 64 0a 09 28 6c 65 e. iterated..(le
52e0: 74 20 28 28 69 74 65 72 61 74 65 64 2d 70 61 72 t ((iterated-par
52f0: 65 6e 74 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 ent (pathname-d
5300: 69 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 6c irectory (conc l
5310: 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d nkpath "/" item-
5320: 70 61 74 68 29 29 29 29 0a 09 20 20 28 64 65 62 path)))).. (deb
5330: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
5340: 22 43 72 65 61 74 69 6e 67 20 69 74 65 72 61 74 "Creating iterat
5350: 65 64 20 70 61 72 65 6e 74 20 22 20 69 74 65 72 ed parent " iter
5360: 61 74 65 64 2d 70 61 72 65 6e 74 29 0a 09 20 20 ated-parent)..
5370: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
5380: 79 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e y iterated-paren
5390: 74 20 23 74 29 29 29 0a 0a 20 20 20 20 28 69 66 t #t))).. (if
53a0: 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f (symbolic-link?
53b0: 20 6c 6e 6b 70 61 74 68 29 20 28 64 65 6c 65 74 lnkpath) (delet
53c0: 65 2d 66 69 6c 65 20 6c 6e 6b 70 61 74 68 29 29 e-file lnkpath))
53d0: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f . (if (not (o
53e0: 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 r (file-exists?
53f0: 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 6d lnkpath)... (sym
5400: 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 bolic-link? lnkp
5410: 61 74 68 29 29 29 0a 09 28 63 72 65 61 74 65 2d ath)))..(create-
5420: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f symbolic-link to
5430: 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 ptest-path lnkpa
5440: 74 68 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b th)). . ;;
5450: 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 74 The toptest pat
5460: 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 74 h has been creat
5470: 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 ed, the link to
5480: 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 20 the test in the
5490: 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 20 linktree has.
54a0: 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 64 ;; been created
54b0: 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 69 . Now, if this i
54c0: 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 s an iterated te
54d0: 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 74 st the real test
54e0: 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 65 dir must be cre
54f0: 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e 6f ated. (if (no
5500: 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 t not-iterated)
5510: 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 ;; this is an it
5520: 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 6c 65 erated test..(le
5530: 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 63 t ((lnktarget (c
5540: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
5550: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 item-path)))..
5560: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
5570: 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 20 74 Setting up sub t
5580: 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 0a 09 est run area")..
5590: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
55a0: 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 72 75 " - creating ru
55b0: 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 73 74 n area in " test
55c0: 2d 70 61 74 68 29 0a 09 20 20 28 63 72 65 61 74 -path).. (creat
55d0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
55e0: 2d 70 61 74 68 20 23 74 29 20 3b 3b 20 28 73 79 -path #t) ;; (sy
55f0: 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d 6b 64 stem (conc "mkd
5600: 69 72 20 2d 70 20 22 20 74 65 73 74 2d 70 61 74 ir -p " test-pat
5610: 68 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 h)).. (debug:pr
5620: 69 6e 74 20 32 20 0a 09 09 20 20 20 20 20 20 20 int 2 ...
5630: 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c 69 6e " - creating lin
5640: 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 2d 70 k from: " test-p
5650: 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 20 20 ath "\n"...
5660: 20 20 22 20 20 20 20 20 20 20 20 20 20 20 20 20 "
5670: 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e 6b 74 to: " lnkt
5680: 61 72 67 65 74 29 0a 09 20 20 3b 3b 20 28 63 72 arget).. ;; (cr
5690: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c eate-directory l
56a0: 6e 6b 70 61 74 68 20 23 74 29 20 3b 3b 20 28 73 nkpath #t) ;; (s
56b0: 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d 6b ystem (conc "mk
56c0: 64 69 72 20 2d 70 20 22 20 6c 6e 6b 70 61 74 68 dir -p " lnkpath
56d0: 29 29 0a 0a 09 20 20 3b 3b 20 49 66 20 74 68 65 ))... ;; If the
56e0: 72 65 20 69 73 20 61 6c 72 65 61 64 79 20 61 20 re is already a
56f0: 73 79 6d 6c 69 6e 6b 20 64 65 6c 65 74 65 20 69 symlink delete i
5700: 74 20 61 6e 64 20 72 65 63 72 65 61 74 65 20 69 t and recreate i
5710: 74 2e 0a 09 20 20 28 69 66 20 28 73 79 6d 62 6f t... (if (symbo
5720: 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 72 lic-link? lnktar
5730: 67 65 74 29 20 20 20 20 20 28 64 65 6c 65 74 65 get) (delete
5740: 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 67 65 74 29 -file lnktarget)
5750: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 66 ).. (if (not (f
5760: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 74 ile-exists? lnkt
5770: 61 72 67 65 74 29 29 20 28 63 72 65 61 74 65 2d arget)) (create-
5780: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 65 symbolic-link te
5790: 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 67 65 st-path lnktarge
57a0: 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 49 20 t)))).. ;; I
57b0: 73 75 73 70 65 63 74 20 74 68 69 73 20 73 65 63 suspect this sec
57c0: 74 69 6f 6e 20 77 61 73 20 64 65 6c 65 74 69 6e tion was deletin
57d0: 67 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 69 g test directori
57e0: 65 73 20 75 6e 64 65 72 20 73 6f 6d 65 20 0a 20 es under some .
57f0: 20 20 20 3b 3b 20 77 69 65 72 64 20 73 69 74 61 ;; wierd sita
5800: 74 69 6f 6e 73 3f 20 54 68 69 73 20 64 6f 65 73 tions? This does
5810: 6e 27 74 20 6d 61 6b 65 20 73 65 6e 73 65 20 2d n't make sense -
5820: 20 72 65 65 6e 61 62 6c 69 6e 67 20 74 68 65 20 reenabling the
5830: 72 6d 20 2d 66 20 0a 20 20 20 20 3b 3b 20 49 20 rm -f . ;; I
5840: 68 6f 6e 65 73 74 6c 79 20 64 6f 6e 27 74 20 72 honestly don't r
5850: 65 6d 65 6d 62 65 72 20 2a 77 68 79 2a 20 74 68 emember *why* th
5860: 69 73 20 63 68 75 6e 6b 20 77 61 73 20 6e 65 65 is chunk was nee
5870: 64 65 64 2e 2e 2e 0a 20 20 20 20 3b 3b 20 28 6c ded.... ;; (l
5880: 65 74 20 28 28 74 65 73 74 6c 69 6e 6b 20 28 63 et ((testlink (c
5890: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
58a0: 74 65 73 74 6e 61 6d 65 29 29 29 0a 20 20 20 20 testname))).
58b0: 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 28 66 ;; (if (and (f
58c0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 73 74 ile-exists? test
58d0: 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 20 link). ;;
58e0: 20 20 20 20 20 20 20 20 28 6f 72 20 28 72 65 67 (or (reg
58f0: 75 6c 61 72 2d 66 69 6c 65 3f 20 74 65 73 74 6c ular-file? testl
5900: 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 ink). ;;
5910: 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 . (symbolic-li
5920: 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a nk? testlink))).
5930: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 73 79 ;; (sy
5940: 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d stem (conc "rm -
5950: 66 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a f " testlink))).
5960: 20 20 20 20 3b 3b 20 20 20 28 73 79 73 74 65 6d ;; (system
5970: 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d 73 66 20 (conc "ln -sf
5980: 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 22 20 " test-path " "
5990: 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 testlink))).
59a0: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 (if (directory?
59b0: 74 65 73 74 2d 70 61 74 68 29 0a 09 28 62 65 67 test-path)..(beg
59c0: 69 6e 0a 09 20 20 28 6c 65 74 2a 20 28 28 63 6d in.. (let* ((cm
59d0: 64 20 20 20 20 28 63 6f 6e 63 20 22 72 73 79 6e d (conc "rsyn
59e0: 63 20 2d 61 76 22 20 28 69 66 20 28 64 65 62 75 c -av" (if (debu
59f0: 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 g:debug-mode 1)
5a00: 22 22 20 22 71 22 29 20 22 20 22 20 74 65 73 74 "" "q") " " test
5a10: 2d 73 72 63 2d 70 61 74 68 20 22 2f 20 22 20 74 -src-path "/ " t
5a20: 65 73 74 2d 70 61 74 68 20 22 2f 22 29 29 0a 09 est-path "/"))..
5a30: 09 20 28 73 74 61 74 75 73 20 28 73 79 73 74 65 . (status (syste
5a40: 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 20 28 69 m cmd))).. (i
5a50: 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 f (not (eq? stat
5a60: 75 73 20 30 29 29 0a 09 09 28 64 65 62 75 67 3a us 0))...(debug:
5a70: 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 3a 20 print 2 "ERROR:
5a80: 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 6e problem with run
5a90: 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
5aa0: 22 29 29 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e "))).. (list ln
5ab0: 6b 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 kpathf lnkpath )
5ac0: 29 0a 09 28 6c 69 73 74 20 23 66 20 23 66 29 29 )..(list #f #f))
5ad0: 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 74 ))..;; 1. look t
5ae0: 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 73 74 hough disks list
5af0: 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 20 6d for disk with m
5b00: 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e 20 ost space.;; 2.
5b10: 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 20 6f create run dir o
5b20: 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 6d n disk, path nam
5b30: 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c 0a e is meaningful.
5b40: 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c 69 6e ;; 3. create lin
5b50: 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 74 k from run dir t
5b60: 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e 73 20 o megatest runs
5b70: 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d 6f area .;; 4. remo
5b80: 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 65 73 tely run the tes
5b90: 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 68 t on allocated h
5ba0: 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c ost.;; - coul
5bb0: 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f 73 74 d be ssh to host
5bc0: 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 6c from hosts tabl
5bd0: 65 20 28 75 70 64 61 74 65 20 72 65 67 75 6c 61 e (update regula
5be0: 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 0a 3b rly with load).;
5bf0: 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 ; - could be
5c00: 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 20 netbatch.;;
5c10: 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 62 (launch-test db
5c20: 20 28 63 61 64 72 20 73 74 61 74 75 73 29 20 74 (cadr status) t
5c30: 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 69 est-conf)).(defi
5c40: 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 ne (launch-test
5c50: 64 62 20 72 75 6e 2d 69 64 20 72 75 6e 6e 61 6d db run-id runnam
5c60: 65 20 74 65 73 74 2d 63 6f 6e 66 20 6b 65 79 76 e test-conf keyv
5c70: 61 6c 6c 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 allst test-name
5c80: 74 65 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 test-path itemda
5c90: 74 20 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 t params). (cha
5ca0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 nge-directory *t
5cb0: 6f 70 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 oppath*). (alis
5cc0: 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 t->env-vars ;; c
5cd0: 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 onsolidate this
5ce0: 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 63 6f code with the co
5cf0: 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 de in megatest.s
5d00: 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 cm for "-execute
5d10: 22 0a 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c ". (list ;; (l
5d20: 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e ist "MT_TEST_RUN
5d30: 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
5d40: 0a 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 . (list "MT_R
5d50: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 UN_AREA_HOME" *t
5d60: 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 oppath*). (li
5d70: 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 st "MT_TEST_NAME
5d80: 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 " test-name).
5d90: 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 ;; (list "MT_IT
5da0: 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 EM_INFO" (conc i
5db0: 74 65 6d 64 61 74 29 29 20 0a 20 20 20 20 28 6c temdat)) . (l
5dc0: 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 ist "MT_RUNNAME"
5dd0: 20 20 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 runname).
5de0: 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 ;; (list "MT_TAR
5df0: 47 45 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 GET" mt_targe
5e00: 74 29 0a 20 20 20 20 29 29 0a 20 20 28 6c 65 74 t). )). (let
5e10: 2a 20 28 28 75 73 65 73 68 65 6c 6c 20 20 20 28 * ((useshell (
5e20: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
5e30: 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f onfigdat* "jobto
5e40: 6f 6c 73 22 20 20 20 20 20 22 75 73 65 73 68 65 ols" "useshe
5e50: 6c 6c 22 29 29 0a 09 20 28 6c 61 75 6e 63 68 65 ll")).. (launche
5e60: 72 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b r (config-look
5e70: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
5e80: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 6c jobtools" "l
5e90: 61 75 6e 63 68 65 72 22 29 29 0a 09 20 28 72 75 auncher")).. (ru
5ea0: 6e 73 63 72 69 70 74 20 20 28 63 6f 6e 66 69 67 nscript (config
5eb0: 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e -lookup test-con
5ec0: 66 20 20 20 22 73 65 74 75 70 22 20 20 20 20 20 f "setup"
5ed0: 20 20 20 22 72 75 6e 73 63 72 69 70 74 22 29 29 "runscript"))
5ee0: 0a 09 20 28 65 7a 73 74 65 70 73 20 20 20 20 28 .. (ezsteps (
5ef0: 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d > (length (hash-
5f00: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5f10: 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 7a 73 t test-conf "ezs
5f20: 74 65 70 73 22 20 27 28 29 29 29 20 30 29 29 20 teps" '())) 0))
5f30: 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 6c ;; don't send al
5f40: 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 6f 75 l the steps, cou
5f50: 6c 64 20 62 65 20 62 69 67 0a 09 20 28 64 69 73 ld be big.. (dis
5f60: 6b 73 70 61 63 65 20 20 28 63 6f 6e 66 69 67 2d kspace (config-
5f70: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
5f80: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
5f90: 22 20 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a " "diskspace")).
5fa0: 09 20 28 6d 65 6d 6f 72 79 20 20 20 20 20 28 63 . (memory (c
5fb0: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
5fc0: 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 t-conf "requir
5fd0: 65 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 22 ements" "memory"
5fe0: 29 29 0a 09 20 28 68 6f 73 74 73 20 20 20 20 20 )).. (hosts
5ff0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
6000: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
6010: 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b tools" "work
6020: 68 6f 73 74 73 22 29 29 0a 09 20 28 72 65 6d 6f hosts")).. (remo
6030: 74 65 2d 6d 65 67 61 74 65 73 74 20 28 63 6f 6e te-megatest (con
6040: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
6050: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
6060: 65 78 65 63 75 74 61 62 6c 65 22 29 29 0a 09 20 executable"))..
6070: 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 ;; FIXME SOMEDAY
6080: 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 20 74 : not good how t
6090: 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 73 65 his is so obtuse
60a0: 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 20 74 , this hack is t
60b0: 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 o .. ;;
60c0: 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 75 6e allow run
60d0: 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 62 6f ning from dashbo
60e0: 61 72 64 2e 20 45 78 74 72 61 63 74 20 74 68 65 ard. Extract the
60f0: 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 20 20 20 path.. ;;
6100: 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 from t
6110: 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 he called megate
6120: 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 st and convert d
6130: 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b 20 20 20 ashboard.. ;;
6140: 20 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 . or
6150: 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 dboard to megate
6160: 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d 65 67 61 st.. (local-mega
6170: 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 6c 6d test (let* ((lm
6180: 20 20 28 63 61 72 20 28 61 72 67 76 29 29 29 0a (car (argv))).
6190: 09 09 09 09 20 28 64 69 72 20 28 70 61 74 68 6e .... (dir (pathn
61a0: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d ame-directory lm
61b0: 29 29 0a 09 09 09 09 20 28 65 78 65 20 28 70 61 ))..... (exe (pa
61c0: 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 thname-strip-dir
61d0: 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 ectory lm)))....
61e0: 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 (conc (if di
61f0: 72 20 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 r (conc dir "/")
6200: 20 22 22 29 0a 09 09 09 09 20 20 28 63 61 73 65 "")..... (case
6210: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6220: 20 65 78 65 29 0a 09 09 09 09 20 20 20 20 28 28 exe)..... ((
6230: 64 62 6f 61 72 64 29 20 20 20 20 22 6d 65 67 61 dboard) "mega
6240: 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 test")..... (
6250: 28 6d 74 65 73 74 29 20 20 20 20 20 22 6d 65 67 (mtest) "meg
6260: 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 atest").....
6270: 28 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 ((dashboard) "me
6280: 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 gatest").....
6290: 20 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a (else exe))))).
62a0: 09 20 28 74 65 73 74 2d 73 69 67 20 20 20 28 63 . (test-sig (c
62b0: 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a onc test-name ":
62c0: 22 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 " (item-list->pa
62d0: 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b th itemdat))) ;;
62e0: 20 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 test-path is th
62f0: 65 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c e full path incl
6300: 75 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 uding the item-p
6310: 61 74 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 61 ath.. (work-area
6320: 20 20 23 66 29 0a 09 20 28 74 6f 70 74 65 73 74 #f).. (toptest
6330: 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 3b -work-area #f) ;
6340: 3b 20 66 6f 72 20 69 74 65 72 61 74 65 64 20 74 ; for iterated t
6350: 65 73 74 73 20 74 68 65 20 74 6f 70 20 74 65 73 ests the top tes
6360: 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 t contains data
6370: 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c relevant for all
6380: 0a 09 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 .. (diskpath #
6390: 66 29 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 20 f).. (cmdparms
63a0: 20 23 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 20 #f).. (fullcmd
63b0: 20 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e #f) ;; (defin
63c0: 65 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 e a (with-output
63d0: 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 -to-string (lamb
63e0: 64 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 da ()(write x)))
63f0: 29 0a 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 ).. (mt-bindir-p
6400: 61 74 68 20 23 66 29 0a 09 20 28 69 74 65 6d 2d ath #f).. (item-
6410: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
6420: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
6430: 09 20 28 74 65 73 74 2d 69 64 20 20 20 20 28 63 . (test-id (c
6440: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
6450: 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 23 66 20 :get-test-id #f
6460: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
6470: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 item-path)).. (
6480: 74 65 73 74 69 6e 66 6f 20 20 20 28 63 64 62 3a testinfo (cdb:
6490: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
64a0: 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 -id *runremote*
64b0: 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6d 74 5f test-id)).. (mt_
64c0: 74 61 72 67 65 74 20 20 28 73 74 72 69 6e 67 2d target (string-
64d0: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
64e0: 20 63 61 64 72 20 6b 65 79 76 61 6c 6c 73 74 29 cadr keyvallst)
64f0: 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d "/")).. (debug-
6500: 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 param (append (i
6510: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6520: 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 "-debug") (list
6530: 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a "-debug" (args:
6540: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 get-arg "-debug"
6550: 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 )) '())....
6560: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
6570: 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
6580: 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
6590: 27 28 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 '())))). (if
65a0: 68 6f 73 74 73 20 28 73 65 74 21 20 68 6f 73 74 hosts (set! host
65b0: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
65c0: 68 6f 73 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 hosts))). ;;
65d0: 73 65 74 20 74 68 65 20 6d 65 67 61 74 65 73 74 set the megatest
65e0: 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 20 6f 6e to be called on
65f0: 20 74 68 65 20 72 65 6d 6f 74 65 20 68 6f 73 74 the remote host
6600: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 65 . (if (not re
6610: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 28 73 mote-megatest)(s
6620: 65 74 21 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 et! remote-megat
6630: 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 est local-megate
6640: 73 74 29 29 20 3b 3b 20 22 6d 65 67 61 74 65 73 st)) ;; "megates
6650: 74 22 29 29 0a 20 20 20 20 28 73 65 74 21 20 6d t")). (set! m
6660: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 70 t-bindir-path (p
6670: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
6680: 79 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 y remote-megates
6690: 74 29 29 0a 20 20 20 20 28 69 66 20 6c 61 75 6e t)). (if laun
66a0: 63 68 65 72 20 28 73 65 74 21 20 6c 61 75 6e 63 cher (set! launc
66b0: 68 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 her (string-spli
66c0: 74 20 6c 61 75 6e 63 68 65 72 29 29 29 0a 20 20 t launcher))).
66d0: 20 20 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 ;; set up the
66e0: 72 75 6e 20 77 6f 72 6b 20 61 72 65 61 20 66 6f run work area fo
66f0: 72 20 74 68 69 73 20 74 65 73 74 0a 20 20 20 20 r this test.
6700: 28 73 65 74 21 20 64 69 73 6b 70 61 74 68 20 28 (set! diskpath (
6710: 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 2a 63 get-best-disk *c
6720: 6f 6e 66 69 67 64 61 74 2a 29 29 0a 20 20 20 20 onfigdat*)).
6730: 28 69 66 20 64 69 73 6b 70 61 74 68 0a 09 28 6c (if diskpath..(l
6740: 65 74 20 28 28 64 61 74 20 20 28 6f 70 65 6e 2d et ((dat (open-
6750: 72 75 6e 2d 63 6c 6f 73 65 20 63 72 65 61 74 65 run-close create
6760: 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 -work-area db ru
6770: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
6780: 74 2d 70 61 74 68 20 64 69 73 6b 70 61 74 68 20 t-path diskpath
6790: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
67a0: 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 77 6f t))).. (set! wo
67b0: 72 6b 2d 61 72 65 61 20 28 63 61 72 20 64 61 74 rk-area (car dat
67c0: 29 29 0a 09 20 20 28 73 65 74 21 20 74 6f 70 74 )).. (set! topt
67d0: 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 28 63 est-work-area (c
67e0: 61 64 72 20 64 61 74 29 29 0a 09 20 20 28 64 65 adr dat)).. (de
67f0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
6800: 20 22 55 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 "Using work are
6810: 61 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a a " work-area)).
6820: 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 .(begin.. (set!
6830: 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f 6e 63 work-area (conc
6840: 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 6d 70 test-path "/tmp
6850: 5f 72 75 6e 22 29 29 0a 09 20 20 28 63 72 65 61 _run")).. (crea
6860: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 te-directory wor
6870: 6b 2d 61 72 65 61 20 23 74 29 0a 09 20 20 28 64 k-area #t).. (d
6880: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
6890: 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 77 RNING: No disk w
68a0: 6f 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 69 ork area specifi
68b0: 65 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e 20 ed - running in
68c0: 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f the test directo
68d0: 72 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 6e ry under tmp_run
68e0: 22 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 63 "))). (set! c
68f0: 6d 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 3a mdparms (base64:
6900: 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 0a 09 base64-encode ..
6910: 09 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 . (with-outpu
6920: 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 09 09 20 20 t-to-string...
6930: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 3b (lambda () ;
6940: 3b 20 28 6c 69 73 74 20 27 68 6f 73 74 73 20 20 ; (list 'hosts
6950: 20 20 20 68 6f 73 74 73 29 0a 09 09 09 28 77 72 hosts)....(wr
6960: 69 74 65 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ite (list (list
6970: 27 74 65 73 74 70 61 74 68 20 20 74 65 73 74 2d 'testpath test-
6980: 70 61 74 68 29 0a 09 09 09 09 20 20 20 20 20 28 path)..... (
6990: 6c 69 73 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 list 'runremote
69a0: 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a 09 09 09 *runremote*)....
69b0: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 72 61 . (list 'tra
69c0: 6e 73 70 6f 72 74 20 2a 74 72 61 6e 73 70 6f 72 nsport *transpor
69d0: 74 2d 74 79 70 65 2a 29 0a 09 09 09 09 20 20 20 t-type*).....
69e0: 20 20 28 6c 69 73 74 20 27 74 6f 70 70 61 74 68 (list 'toppath
69f0: 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 *toppath*)...
6a00: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 77 6f .. (list 'wo
6a10: 72 6b 2d 61 72 65 61 20 77 6f 72 6b 2d 61 72 65 rk-area work-are
6a20: 61 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 a)..... (lis
6a30: 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 t 'test-name tes
6a40: 74 2d 6e 61 6d 65 29 20 0a 09 09 09 09 20 20 20 t-name) .....
6a50: 20 20 28 6c 69 73 74 20 27 72 75 6e 73 63 72 69 (list 'runscri
6a60: 70 74 20 72 75 6e 73 63 72 69 70 74 29 20 0a 09 pt runscript) ..
6a70: 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 72 ... (list 'r
6a80: 75 6e 2d 69 64 20 20 20 20 72 75 6e 2d 69 64 20 un-id run-id
6a90: 20 20 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 )..... (li
6aa0: 73 74 20 27 74 65 73 74 2d 69 64 20 20 20 74 65 st 'test-id te
6ab0: 73 74 2d 69 64 20 20 29 0a 09 09 09 09 20 20 20 st-id ).....
6ac0: 20 20 28 6c 69 73 74 20 27 69 74 65 6d 64 61 74 (list 'itemdat
6ad0: 20 20 20 69 74 65 6d 64 61 74 20 20 29 0a 09 09 itemdat )...
6ae0: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 6d 65 .. (list 'me
6af0: 67 61 74 65 73 74 20 20 72 65 6d 6f 74 65 2d 6d gatest remote-m
6b00: 65 67 61 74 65 73 74 29 0a 09 09 09 09 20 20 20 egatest).....
6b10: 20 20 28 6c 69 73 74 20 27 65 7a 73 74 65 70 73 (list 'ezsteps
6b20: 20 20 20 65 7a 73 74 65 70 73 29 20 0a 09 09 09 ezsteps) ....
6b30: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 61 72 . (list 'tar
6b40: 67 65 74 20 20 20 20 6d 74 5f 74 61 72 67 65 74 get mt_target
6b50: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
6b60: 20 27 65 6e 76 2d 6f 76 72 64 20 20 28 68 61 73 'env-ovrd (has
6b70: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
6b80: 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 ult *configdat*
6b90: 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 27 "env-override" '
6ba0: 28 29 29 29 20 0a 09 09 09 09 20 20 20 20 20 28 ())) ..... (
6bb0: 6c 69 73 74 20 27 73 65 74 2d 76 61 72 73 20 20 list 'set-vars
6bc0: 28 69 66 20 70 61 72 61 6d 73 20 28 68 61 73 68 (if params (hash
6bd0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
6be0: 6c 74 20 70 61 72 61 6d 73 20 22 2d 73 65 74 76 lt params "-setv
6bf0: 61 72 73 22 20 23 66 29 29 29 0a 09 09 09 09 20 ars" #f))).....
6c00: 20 20 20 20 28 6c 69 73 74 20 27 72 75 6e 6e 61 (list 'runna
6c10: 6d 65 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 me runname)...
6c20: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 6d 74 .. (list 'mt
6c30: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 6d 74 2d -bindir-path mt-
6c40: 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 29 29 bindir-path)))))
6c50: 29 29 20 3b 3b 20 28 73 74 72 69 6e 67 2d 69 6e )) ;; (string-in
6c60: 74 65 72 73 70 65 72 73 65 20 6b 65 79 76 61 6c tersperse keyval
6c70: 6c 73 74 20 22 20 22 29 29 29 29 0a 20 20 20 20 lst " ")))).
6c80: 3b 3b 20 63 6c 65 61 6e 20 6f 75 74 20 73 74 65 ;; clean out ste
6c90: 70 20 72 65 63 6f 72 64 73 20 66 72 6f 6d 20 70 p records from p
6ca0: 72 65 76 69 6f 75 73 20 72 75 6e 20 69 66 20 74 revious run if t
6cb0: 68 65 79 20 65 78 69 73 74 0a 20 20 20 20 3b 3b hey exist. ;;
6cc0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
6cd0: 66 6f 20 34 20 22 46 49 58 4d 45 45 45 45 45 21 fo 4 "FIXMEEEEE!
6ce0: 21 21 21 20 54 68 69 73 20 63 61 6e 20 62 65 20 !!! This can be
6cf0: 72 65 6d 6f 76 65 64 20 73 6f 6d 65 20 64 61 79 removed some day
6d00: 2c 20 70 65 72 68 61 70 73 20 6d 6f 76 65 20 61 , perhaps move a
6d10: 6c 6c 20 74 65 73 74 20 72 65 63 6f 72 64 73 20 ll test records
6d20: 74 6f 20 74 68 65 20 74 65 73 74 20 64 62 3f 22 to the test db?"
6d30: 29 0a 20 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 ). ;; (open-r
6d40: 75 6e 2d 63 6c 6f 73 65 20 64 62 3a 64 65 6c 65 un-close db:dele
6d50: 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 63 te-test-step-rec
6d60: 6f 72 64 73 20 64 62 20 74 65 73 74 2d 69 64 29 ords db test-id)
6d70: 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 . (change-dir
6d80: 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 ectory work-area
6d90: 29 20 3b 3b 20 73 6f 20 74 68 61 74 20 6c 6f 67 ) ;; so that log
6da0: 20 66 69 6c 65 73 20 66 72 6f 6d 20 74 68 65 20 files from the
6db0: 6c 61 75 6e 63 68 20 70 72 6f 63 65 73 73 20 64 launch process d
6dc0: 6f 6e 27 74 20 63 6c 75 74 74 65 72 20 74 68 65 on't clutter the
6dd0: 20 74 65 73 74 20 64 69 72 0a 20 20 20 20 28 74 test dir. (t
6de0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
6df0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 4c atus! test-id "L
6e00: 41 55 4e 43 48 45 44 22 20 22 6e 2f 61 22 20 23 AUNCHED" "n/a" #
6e10: 66 20 23 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 f #f) ;; (if lau
6e20: 6e 63 68 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e nch-results laun
6e30: 63 68 2d 72 65 73 75 6c 74 73 20 22 46 41 49 4c ch-results "FAIL
6e40: 45 44 22 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a ED")). (cond.
6e50: 20 20 20 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 ((and launc
6e60: 68 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 her hosts) ;; mu
6e70: 73 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 20 st be using ssh
6e80: 68 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 hostname. (
6e90: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
6ea0: 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 pend launcher (c
6eb0: 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 ar hosts)(list r
6ec0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
6ed0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
6ee0: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
6ef0: 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 ug-param))).
6f00: 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d ;; (set! fullcm
6f10: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
6f20: 65 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c er (car hosts)(l
6f30: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
6f40: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
6f50: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
6f60: 29 29 29 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 )))). (launc
6f70: 68 65 72 0a 20 20 20 20 20 20 28 73 65 74 21 20 her. (set!
6f80: 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 fullcmd (append
6f90: 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 20 72 launcher (list r
6fa0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
6fb0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
6fc0: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
6fd0: 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 20 ug-param))).
6fe0: 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d ;; (set! fullcm
6ff0: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
7000: 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d er (list remote-
7010: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
7020: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
7030: 70 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 28 parms)))). (
7040: 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 20 28 else. (if (
7050: 6e 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 64 65 not useshell)(de
7060: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 bug:print 0 "WAR
7070: 4e 49 4e 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c NING: internal l
7080: 61 75 6e 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f aunching will no
7090: 74 20 77 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 t work well with
70a0: 6f 75 74 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 out \"useshell y
70b0: 65 73 5c 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f es\" in your [jo
70c0: 62 74 6f 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 btools] section"
70d0: 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 )). (set! f
70e0: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 28 ullcmd (append (
70f0: 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 list remote-mega
7100: 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d test test-sig "-
7110: 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d execute" cmdparm
7120: 73 29 20 64 65 62 75 67 2d 70 61 72 61 6d 20 28 s) debug-param (
7130: 6c 69 73 74 20 28 69 66 20 75 73 65 73 68 65 6c list (if useshel
7140: 6c 20 22 26 22 20 22 22 29 29 29 29 29 29 0a 20 l "&" "")))))).
7150: 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c ;; (set! full
7160: 63 6d 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 cmd (list remote
7170: 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 -megatest test-s
7180: 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d ig "-execute" cm
7190: 64 70 61 72 6d 73 20 28 69 66 20 75 73 65 73 68 dparms (if usesh
71a0: 65 6c 6c 20 22 26 22 20 22 22 29 29 29 29 29 0a ell "&" ""))))).
71b0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
71c0: 74 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 28 t-arg "-xterm")(
71d0: 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
71e0: 70 65 6e 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 pend fullcmd (li
71f0: 73 74 20 22 2d 78 74 65 72 6d 22 29 29 29 29 0a st "-xterm")))).
7200: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7210: 20 31 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 1 "Launching "
7220: 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b work-area). ;
7230: 3b 20 73 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 ; set pre-launch
7240: 2d 65 6e 76 2d 76 61 72 73 20 62 65 66 6f 72 65 -env-vars before
7250: 20 6c 61 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 launching, keep
7260: 20 74 68 65 20 76 61 72 73 20 69 6e 20 70 72 65 the vars in pre
7270: 76 76 61 6c 73 20 61 6e 64 20 70 75 74 20 74 68 vvals and put th
7280: 65 20 65 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 e envionment bac
7290: 6b 20 77 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 k when done.
72a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
72b0: 66 75 6c 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 fullcmd: " fullc
72c0: 6d 64 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 md). (let* ((
72d0: 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 commonprevvals (
72e0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a alist->env-vars.
72f0: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
7300: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
7310: 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d configdat* "env-
7320: 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 29 29 override" '())))
7330: 0a 09 20 20 20 28 74 65 73 74 70 72 65 76 76 61 .. (testprevva
7340: 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 ls (alist->env
7350: 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 -vars.... (ha
7360: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
7370: 61 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 ault test-conf "
7380: 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f pre-launch-env-o
7390: 76 65 72 72 69 64 65 73 22 20 27 28 29 29 29 29 verrides" '())))
73a0: 0a 09 20 20 20 28 6d 69 73 63 70 72 65 76 76 61 .. (miscprevva
73b0: 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 ls (alist->env
73c0: 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 -vars ;; consoli
73d0: 64 61 74 65 20 74 68 69 73 20 63 6f 64 65 20 77 date this code w
73e0: 69 74 68 20 74 68 65 20 63 6f 64 65 20 69 6e 20 ith the code in
73f0: 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 megatest.scm for
7400: 20 22 2d 65 78 65 63 75 74 65 22 0a 09 09 09 20 "-execute"....
7410: 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 (append (list
7420: 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f (list "MT_TEST_
7430: 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 RUN_DIR" work-ar
7440: 65 61 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 ea)...... (list
7450: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
7460: 74 65 73 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 test-name)......
7470: 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d (list "MT_ITEM
7480: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
7490: 6d 64 61 74 29 29 20 0a 09 09 09 09 09 20 20 28 mdat)) ...... (
74a0: 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 list "MT_RUNNAME
74b0: 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 " runname)....
74c0: 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 .. (list "MT_TA
74d0: 52 47 45 54 22 20 20 20 20 6d 74 5f 74 61 72 67 RGET" mt_targ
74e0: 65 74 29 0a 09 09 09 09 09 20 20 29 0a 09 09 09 et)...... )....
74f0: 09 20 20 20 20 69 74 65 6d 64 61 74 29 29 29 0a . itemdat))).
7500: 09 20 20 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 . (launch-resu
7510: 6c 74 73 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 lts (apply cmd-r
7520: 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 72 2d 3e un-with-stderr->
7530: 6c 69 73 74 20 3b 3b 20 63 6d 64 2d 72 75 6e 2d list ;; cmd-run-
7540: 70 72 6f 63 2d 65 61 63 68 2d 6c 69 6e 65 0a 09 proc-each-line..
7550: 09 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c ... (if useshel
7560: 6c 0a 09 09 09 09 20 20 20 20 20 20 28 73 74 72 l..... (str
7570: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
7580: 66 75 6c 6c 63 6d 64 20 22 20 22 29 0a 09 09 09 fullcmd " ")....
7590: 09 20 20 20 20 20 20 28 63 61 72 20 66 75 6c 6c . (car full
75a0: 63 6d 64 29 29 0a 09 09 09 09 20 20 3b 3b 20 63 cmd))..... ;; c
75b0: 6f 6e 63 0a 09 09 09 09 20 20 28 69 66 20 75 73 onc..... (if us
75c0: 65 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 20 eshell.....
75d0: 20 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 28 '()..... (
75e0: 63 64 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 29 cdr fullcmd)))))
75f0: 20 3b 3b 20 20 6c 61 75 6e 63 68 65 72 20 66 75 ;; launcher fu
7600: 6c 6c 63 6d 64 29 29 29 3b 3b 20 28 61 70 70 6c llcmd)));; (appl
7610: 79 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 y cmd-run-proc-e
7620: 61 63 68 2d 6c 69 6e 65 20 6c 61 75 6e 63 68 65 ach-line launche
7630: 72 20 70 72 69 6e 74 20 66 75 6c 6c 63 6d 64 29 r print fullcmd)
7640: 29 29 20 3b 3b 20 28 63 6d 64 2d 72 75 6e 2d 3e )) ;; (cmd-run->
7650: 6c 69 73 74 20 66 75 6c 6c 63 6d 64 29 29 0a 20 list fullcmd)).
7660: 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 (with-outpu
7670: 74 2d 74 6f 2d 66 69 6c 65 20 22 6d 74 5f 6c 61 t-to-file "mt_la
7680: 75 6e 63 68 2e 6c 6f 67 22 0a 09 28 6c 61 6d 62 unch.log"..(lamb
7690: 64 61 20 28 29 0a 09 20 20 28 61 70 70 6c 79 20 da ().. (apply
76a0: 70 72 69 6e 74 20 6c 61 75 6e 63 68 2d 72 65 73 print launch-res
76b0: 75 6c 74 73 29 29 29 0a 20 20 20 20 20 20 28 64 ults))). (d
76c0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 ebug:print 2 "La
76d0: 75 6e 63 68 69 6e 67 20 63 6f 6d 70 6c 65 74 65 unching complete
76e0: 64 2c 20 75 70 64 61 74 69 6e 67 20 64 62 22 29 d, updating db")
76f0: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
7700: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 20 72 65 int 2 "Launch re
7710: 73 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 68 2d sults: " launch-
7720: 72 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 28 results). (
7730: 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 if (not launch-r
7740: 65 73 75 6c 74 73 29 0a 09 20 20 28 62 65 67 69 esults).. (begi
7750: 6e 0a 09 20 20 20 20 28 70 72 69 6e 74 20 22 45 n.. (print "E
7760: 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 RROR: Failed to
7770: 72 75 6e 20 22 20 28 73 74 72 69 6e 67 2d 69 6e run " (string-in
7780: 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d tersperse fullcm
7790: 64 20 22 20 22 29 20 22 2c 20 65 78 69 74 69 6e d " ") ", exitin
77a0: 67 20 6e 6f 77 22 29 0a 09 20 20 20 20 3b 3b 20 g now").. ;;
77b0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
77c0: 65 21 20 64 62 29 0a 09 20 20 20 20 3b 3b 20 67 e! db).. ;; g
77d0: 6f 6f 64 20 6f 6c 65 20 22 65 78 69 74 22 20 73 ood ole "exit" s
77e0: 65 65 6d 73 20 6e 6f 74 20 74 6f 20 77 6f 72 6b eems not to work
77f0: 0a 09 20 20 20 20 3b 3b 20 28 5f 65 78 69 74 20 .. ;; (_exit
7800: 39 29 0a 09 20 20 20 20 3b 3b 20 62 75 74 20 74 9).. ;; but t
7810: 68 69 73 20 68 61 63 6b 20 77 69 6c 6c 20 77 6f his hack will wo
7820: 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f 20 74 6f rk! Thanks go to
7830: 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 20 74 68 Alan Post of th
7840: 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 69 6c 20 e Chicken email
7850: 6c 69 73 74 0a 09 20 20 20 20 3b 3b 20 4e 42 2f list.. ;; NB/
7860: 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c 6c 20 / Is this still
7870: 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 62 needed? Should b
7880: 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 61 63 e safe to go bac
7890: 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 3f k to "exit" now?
78a0: 0a 09 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 .. (process-s
78b0: 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d 70 ignal (current-p
78c0: 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e 61 rocess-id) signa
78d0: 6c 2f 6b 69 6c 6c 29 0a 09 20 20 20 20 29 29 0a l/kill).. )).
78e0: 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e (alist->en
78f0: 76 2d 76 61 72 73 20 6d 69 73 63 70 72 65 76 76 v-vars miscprevv
7900: 61 6c 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 als). (alis
7910: 74 2d 3e 65 6e 76 2d 76 61 72 73 20 74 65 73 74 t->env-vars test
7920: 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 prevvals).
7930: 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
7940: 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 commonprevvals)
7950: 0a 20 20 20 20 20 20 6c 61 75 6e 63 68 2d 72 65 . launch-re
7960: 73 75 6c 74 73 29 29 0a 20 20 28 63 68 61 6e 67 sults)). (chang
7970: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
7980: 70 61 74 68 2a 29 29 0a 0a path*))..