Artifact
ea08ddd3748f2922c795291c330bb57f80368e22
File
launch.scm
— part of check-in
[25e777f7f1]
at
2013-04-28 00:47:10
on branch v1.54
— Don't wait for the launch process to complete before moving on to next test launch
(user:
matt
size: 32695)
[more...]
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 6d 64 0a . (if enccmd.
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 3b 3b 20 28 72 75 6e .. ;; (run
09b0: 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 remote (assoc/de
09c0: 66 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 fault 'runremote
09d0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
09e0: 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
09f0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
0a00: 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
0a10: 29 0a 09 20 20 20 20 20 20 20 28 73 65 72 76 65 ).. (serve
0a20: 72 69 6e 66 20 28 61 73 73 6f 63 2f 64 65 66 61 rinf (assoc/defa
0a30: 75 6c 74 20 27 73 65 72 76 65 72 69 6e 66 20 63 ult 'serverinf c
0a40: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0a50: 20 28 70 6f 72 74 20 20 20 20 20 20 28 61 73 73 (port (ass
0a60: 6f 63 2f 64 65 66 61 75 6c 74 20 27 70 6f 72 74 oc/default 'port
0a70: 20 20 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a cmdinfo)).
0a80: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
0a90: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0aa0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
0ab0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0ac0: 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 test-id (assoc
0ad0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 /default 'test-i
0ae0: 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 d cmdinfo))..
0af0: 20 20 20 20 20 20 28 74 61 72 67 65 74 20 20 20 (target
0b00: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0b10: 27 74 61 72 67 65 74 20 20 20 20 63 6d 64 69 6e 'target cmdin
0b20: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
0b30: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
0b40: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
0b50: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
0b60: 20 20 20 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 (env-ovrd (
0b70: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 assoc/default 'e
0b80: 6e 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f nv-ovrd cmdinfo
0b90: 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 74 2d )).. (set-
0ba0: 76 61 72 73 20 20 28 61 73 73 6f 63 2f 64 65 66 vars (assoc/def
0bb0: 61 75 6c 74 20 27 73 65 74 2d 76 61 72 73 20 20 ault 'set-vars
0bc0: 63 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 cmdinfo)) ;; pre
0bd0: 2d 6f 76 65 72 72 69 64 65 73 20 66 72 6f 6d 20 -overrides from
0be0: 2d 73 65 74 76 61 72 0a 09 20 20 20 20 20 20 20 -setvar..
0bf0: 28 72 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f (runname (asso
0c00: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 c/default 'runna
0c10: 6d 65 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 me cmdinfo))..
0c20: 20 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 (megatest
0c30: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0c40: 20 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 'megatest cmdi
0c50: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6d nfo)).. (m
0c60: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 t-bindir-path (a
0c70: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 ssoc/default 'mt
0c80: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 -bindir-path cmd
0c90: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0ca0: 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 20 keys #f)..
0cb0: 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 (keyvals
0cc0: 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 75 #f).. (fu
0cd0: 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 llrunscript (if
0ce0: 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 0a (not runscript).
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: 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 #f.
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 20 20 20 20 20 20 20 28 69 66 20 28 73 75 62 73 (if (subs
0d40: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 tring-index "/"
0d50: 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 runscript).
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 runscript ;; us
0d90: 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 66 e unadultered if
0da0: 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 contains slashe
0db0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dd0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 (let ((f
0de0: 75 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 74 70 ulln (conc testp
0df0: 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 ath "/" runscrip
0e00: 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 t)))..
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
0e30: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 (file-exists? f
0e40: 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 20 20 ulln).
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 66 69 6c 65 2d 65 (file-e
0e80: 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 xecute-access? f
0e90: 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 20 20 ulln)).
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 20 20 fulln.
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ef0: 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 runscri
0f00: 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 75 6d pt))))) ;; assum
0f10: 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 20 70 e it is on the p
0f20: 61 74 68 0a 09 20 20 20 20 20 20 20 28 72 6f 6c ath.. (rol
0f30: 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a 09 lup-status 0))..
0f40: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
0f50: 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a 09 20 ory top-path)..
0f60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0f70: 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 65 73 "Exectuing " tes
0f80: 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 t-name " (id: "
0f90: 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 test-id ") on "
0fa0: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
0fb0: 0a 09 20 20 3b 3b 20 53 65 74 75 70 20 74 68 65 .. ;; Setup the
0fc0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 67 6c 6f *runremote* glo
0fd0: 62 61 6c 20 76 61 72 0a 09 20 20 28 69 66 20 2a bal var.. (if *
0fe0: 72 75 6e 72 65 6d 6f 74 65 2a 20 28 64 65 62 75 runremote* (debu
0ff0: 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 g:print 2 "ERROR
1000: 3a 20 49 27 6d 20 6e 6f 74 20 65 78 70 65 63 74 : I'm not expect
1010: 69 6e 67 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 ing *runremote*
1020: 74 6f 20 62 65 20 73 65 74 20 61 74 20 74 68 69 to be set at thi
1030: 73 20 74 69 6d 65 22 29 29 0a 09 20 20 3b 3b 20 s time")).. ;;
1040: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
1050: 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 20 20 * runremote)..
1060: 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 (set! *transport
1070: 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e -type* (string->
1080: 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 symbol transport
1090: 29 29 0a 09 20 20 28 73 65 74 21 20 6b 65 79 73 )).. (set! keys
10a0: 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f (cdb:remo
10b0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
10c0: 79 73 20 23 66 29 29 0a 09 20 20 28 73 65 74 21 ys #f)).. (set!
10d0: 20 6b 65 79 76 61 6c 73 20 20 20 20 28 69 66 20 keyvals (if
10e0: 72 75 6e 2d 69 64 20 28 63 64 62 3a 72 65 6d 6f run-id (cdb:remo
10f0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
1100: 79 2d 76 61 6c 73 20 23 66 20 72 75 6e 2d 69 64 y-vals #f run-id
1110: 29 20 23 66 29 29 0a 09 20 20 3b 3b 20 61 70 70 ) #f)).. ;; app
1120: 6c 79 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 ly pre-overrides
1130: 20 62 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 before other va
1140: 72 69 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 riables. The pre
1150: 2d 6f 76 65 72 72 69 64 65 20 76 61 72 73 20 6d -override vars m
1160: 75 73 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c ust not.. ;; cl
1170: 6f 62 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 obbers things fr
1180: 6f 6d 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 om the official
1190: 73 6f 75 72 63 65 73 20 73 75 63 68 20 61 73 20 sources such as
11a0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
11b0: 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 and runconfigs.c
11c0: 6f 6e 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 onfig.. (if (st
11d0: 72 69 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a ring? set-vars).
11e0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 . (let ((va
11f0: 72 70 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 rpairs (string-s
1200: 70 6c 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c plit set-vars ",
1210: 22 29 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 ")))...(debug:pr
1220: 69 6e 74 20 34 20 22 76 61 72 70 61 69 72 73 3a int 4 "varpairs:
1230: 20 22 20 76 61 72 70 61 69 72 73 29 0a 09 09 28 " varpairs)...(
1240: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 72 map (lambda (var
1250: 70 61 69 72 29 0a 09 09 20 20 20 20 20 20 20 28 pair)... (
1260: 6c 65 74 20 28 28 76 61 72 76 61 6c 20 28 73 74 let ((varval (st
1270: 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 61 ring-split varpa
1280: 69 72 20 22 3d 22 29 29 29 0a 09 09 09 20 28 69 ir "="))).... (i
1290: 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 f (eq? (length v
12a0: 61 72 76 61 6c 29 20 32 29 0a 09 09 09 20 20 20 arval) 2)....
12b0: 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 (let ((var (ca
12c0: 72 20 76 61 72 76 61 6c 29 29 0a 09 09 09 09 20 r varval)).....
12d0: 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 (val (cadr var
12e0: 76 61 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 val)))....
12f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
1300: 22 41 64 64 69 6e 67 20 70 72 65 2d 76 61 72 2f "Adding pre-var/
1310: 76 61 6c 20 22 20 76 61 72 20 22 20 3d 20 22 20 val " var " = "
1320: 76 61 6c 20 22 20 74 6f 20 74 68 65 20 65 6e 76 val " to the env
1330: 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 ironment")....
1340: 20 20 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 (setenv var
1350: 20 76 61 6c 29 29 29 29 29 0a 09 09 20 20 20 20 val)))))...
1360: 20 76 61 72 70 61 69 72 73 29 29 29 0a 09 20 20 varpairs)))..
1370: 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 (setenv "MT_TEST
1380: 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 _RUN_DIR" work-a
1390: 72 65 61 29 0a 09 20 20 28 73 65 74 65 6e 76 20 rea).. (setenv
13a0: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
13b0: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 28 73 65 est-name).. (se
13c0: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 5f 49 4e tenv "MT_ITEM_IN
13d0: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
13e0: 74 29 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 t)).. (setenv "
13f0: 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
1400: 6e 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e nname).. (seten
1410: 76 20 22 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 v "MT_MEGATEST"
1420: 20 6d 65 67 61 74 65 73 74 29 0a 09 20 20 28 73 megatest).. (s
1430: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
1440: 22 20 20 20 20 74 61 72 67 65 74 29 0a 09 20 20 " target)..
1450: 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 (if mt-bindir-pa
1460: 74 68 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 th (setenv "PATH
1470: 22 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 " (conc (getenv
1480: 22 50 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 "PATH") ":" mt-b
1490: 69 6e 64 69 72 2d 70 61 74 68 29 29 29 0a 09 20 indir-path)))..
14a0: 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ;; (change-dire
14b0: 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a ctory top-path).
14c0: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
14d0: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
14e0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
14f0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
1500: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
1510: 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 iting") ...;; (s
1520: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
1530: 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 db)...;; (sqlit
1540: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
1550: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
1560: 20 20 3b 3b 20 43 61 6e 20 73 65 74 75 70 20 61 ;; Can setup a
1570: 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 s client for ser
1580: 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 ver mode now..
1590: 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 ;; (client:setup
15a0: 29 0a 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )... (change-di
15b0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
15c0: 2a 29 20 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 *) .. (set-mega
15d0: 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 test-env-vars ru
15e0: 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 20 6d n-id) ;; these m
15f0: 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 79 20 ay be needed by
1600: 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 the launching pr
1610: 6f 63 65 73 73 0a 09 20 20 28 63 68 61 6e 67 65 ocess.. (change
1620: 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d -directory work-
1630: 61 72 65 61 29 20 0a 0a 09 20 20 28 6f 70 65 6e area) ... (open
1640: 2d 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 2d 72 -run-close set-r
1650: 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 23 un-config-vars #
1660: 66 20 72 75 6e 2d 69 64 20 6b 65 79 73 20 6b 65 f run-id keys ke
1670: 79 76 61 6c 73 29 0a 09 20 20 3b 3b 20 65 6e 76 yvals).. ;; env
1680: 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 ironment overrid
1690: 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 es are done *bef
16a0: 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 ore* the remaini
16b0: 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e 76 61 ng critical enva
16c0: 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 rs... (alist->e
16d0: 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 nv-vars env-ovrd
16e0: 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 65 ).. (set-megate
16f0: 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d st-env-vars run-
1700: 69 64 29 0a 09 20 20 28 73 65 74 2d 69 74 65 6d id).. (set-item
1710: 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d 64 61 -env-vars itemda
1720: 74 29 0a 09 20 20 28 73 61 76 65 2d 65 6e 76 69 t).. (save-envi
1730: 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 ronment-as-files
1740: 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 20 "megatest")..
1750: 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ;; open-run-clos
1760: 65 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 6f 72 e not needed for
1770: 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 test-set-meta-i
1780: 6e 66 6f 0a 09 20 20 28 74 65 73 74 73 3a 73 65 nfo.. (tests:se
1790: 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 t-meta-info #f t
17a0: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 est-id run-id te
17b0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 st-name itemdat
17c0: 30 29 0a 09 20 20 28 74 65 73 74 73 3a 74 65 73 0).. (tests:tes
17d0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 t-set-status! te
17e0: 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 st-id "REMOTEHOS
17f0: 54 53 54 41 52 54 22 20 22 6e 2f 61 22 20 28 61 TSTART" "n/a" (a
1800: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
1810: 29 20 23 66 29 0a 09 20 20 28 69 66 20 28 61 72 ) #f).. (if (ar
1820: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 gs:get-arg "-xte
1830: 72 6d 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 rm").. (set
1840: 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 ! fullrunscript
1850: 22 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 "xterm")..
1860: 28 69 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e (if (and fullrun
1870: 73 63 72 69 70 74 20 28 6e 6f 74 20 28 66 69 6c script (not (fil
1880: 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 e-execute-access
1890: 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 ? fullrunscript)
18a0: 29 29 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 ))... (system (
18b0: 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 conc "chmod ug+x
18c0: 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 " fullrunscript
18d0: 29 29 29 29 0a 09 20 20 3b 3b 20 57 65 20 61 72 )))).. ;; We ar
18e0: 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 e about to actua
18f0: 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 lly kick off the
1900: 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 test.. ;; so t
1910: 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c his is a good pl
1920: 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 ace to remove th
1930: 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 e records for ..
1940: 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 ;; any previou
1950: 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 s runs.. ;; (db
1960: 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 :test-remove-ste
1970: 70 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ps db run-id tes
1980: 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 tname itemdat)..
1990: 20 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 .. (let* ((m
19a0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 (make
19b0: 2d 6d 75 74 65 78 29 29 0a 09 09 20 28 6b 69 6c -mutex))... (kil
19c0: 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 l-job? #f)...
19d0: 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 (exit-info (
19e0: 76 65 63 74 6f 72 20 23 74 20 23 74 20 23 74 29 vector #t #t #t)
19f0: 29 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 )... (job-thread
1a00: 20 20 20 23 66 29 0a 09 09 20 28 72 75 6e 69 74 #f)... (runit
1a10: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1a20: 28 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d ()..... ;; (let-
1a30: 76 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 values..... ;;
1a40: 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 (((pid exit-stat
1a50: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 us exit-code)...
1a60: 09 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d .. ;; (run-n-
1a70: 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 wait fullrunscri
1a80: 70 74 29 29 29 0a 09 09 09 09 20 28 74 65 73 74 pt)))..... (test
1a90: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
1aa0: 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e s! test-id "RUNN
1ab0: 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 20 23 66 ING" "n/a" #f #f
1ac0: 29 0a 09 09 09 09 20 3b 3b 20 69 66 20 74 68 65 )..... ;; if the
1ad0: 72 65 20 69 73 20 61 20 72 75 6e 73 63 72 69 70 re is a runscrip
1ae0: 74 20 64 6f 20 69 74 20 66 69 72 73 74 0a 09 09 t do it first...
1af0: 09 09 20 28 69 66 20 66 75 6c 6c 72 75 6e 73 63 .. (if fullrunsc
1b00: 72 69 70 74 0a 09 09 09 09 20 20 20 20 20 28 6c ript..... (l
1b10: 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 et ((pid (proces
1b20: 73 2d 72 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72 s-run fullrunscr
1b30: 69 70 74 29 29 29 0a 09 09 09 09 20 20 20 20 20 ipt))).....
1b40: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 (let loop ((i
1b50: 30 29 29 0a 09 09 09 09 09 20 28 6c 65 74 2d 76 0))...... (let-v
1b60: 61 6c 75 65 73 0a 09 09 09 09 09 20 20 28 28 28 alues...... (((
1b70: 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 pid-val exit-sta
1b80: 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 tus exit-code) (
1b90: 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 process-wait pid
1ba0: 20 23 74 29 29 29 0a 09 09 09 09 09 20 20 28 6d #t)))...... (m
1bb0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
1bc0: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
1bd0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
1be0: 64 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f d)...... (vecto
1bf0: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
1c00: 20 31 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 1 exit-status).
1c10: 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 ..... (vector-s
1c20: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 et! exit-info 2
1c30: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 exit-code)......
1c40: 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 (set! rollup-s
1c50: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 tatus exit-code)
1c60: 20 0a 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d ...... (mutex-
1c70: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 unlock! m)......
1c80: 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 (if (eq? pid-v
1c90: 61 6c 20 30 29 0a 09 09 09 09 09 20 20 20 20 20 al 0)......
1ca0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 28 74 (begin.......(t
1cb0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
1cc0: 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 ......(loop (+ i
1cd0: 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 1)))......
1ce0: 20 29 29 29 29 29 0a 09 09 09 09 20 3b 3b 20 74 )))))..... ;; t
1cf0: 68 65 6e 2c 20 69 66 20 72 75 6e 73 63 72 69 70 hen, if runscrip
1d00: 74 20 72 61 6e 20 6f 6b 20 28 6f 72 20 64 69 64 t ran ok (or did
1d10: 20 6e 6f 74 20 67 65 74 20 63 61 6c 6c 65 64 29 not get called)
1d20: 0a 09 09 09 09 20 3b 3b 20 64 6f 20 61 6c 6c 20 ..... ;; do all
1d30: 74 68 65 20 65 7a 73 74 65 70 73 20 28 69 66 20 the ezsteps (if
1d40: 61 6e 79 29 0a 09 09 09 09 20 28 69 66 20 65 7a any)..... (if ez
1d50: 73 74 65 70 73 0a 09 09 09 09 20 20 20 20 20 28 steps..... (
1d60: 6c 65 74 2a 20 28 28 74 65 73 74 63 6f 6e 66 69 let* ((testconfi
1d70: 67 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 g (read-config (
1d80: 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 conc work-area "
1d90: 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 20 23 66 /testconfig") #f
1da0: 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 #t environ-patt
1db0: 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e : "pre-launch-en
1dc0: 76 2d 76 61 72 73 22 29 29 20 3b 3b 20 46 49 58 v-vars")) ;; FIX
1dd0: 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 2d 73 ME??? is allow-s
1de0: 79 73 74 65 6d 20 6f 6b 20 68 65 72 65 3f 0a 09 ystem ok here?..
1df0: 09 09 09 09 20 20 20 20 28 65 7a 73 74 65 70 73 .... (ezsteps
1e00: 6c 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d lst (hash-table-
1e10: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
1e20: 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 config "ezsteps"
1e30: 20 27 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 '()))).....
1e40: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c (if (not (fil
1e50: 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a 73 74 e-exists? ".ezst
1e60: 65 70 73 22 29 29 28 63 72 65 61 74 65 2d 64 69 eps"))(create-di
1e70: 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 65 70 rectory ".ezstep
1e80: 73 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 s")).....
1e90: 3b 3b 20 69 66 20 65 7a 73 74 65 70 73 20 77 61 ;; if ezsteps wa
1ea0: 73 20 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 s defined then w
1eb0: 65 20 61 72 65 20 73 75 72 65 20 74 6f 20 68 61 e are sure to ha
1ec0: 76 65 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 ve at least one
1ed0: 73 74 65 70 20 62 75 74 20 63 68 65 63 6b 20 61 step but check a
1ee0: 6e 79 77 61 79 0a 09 09 09 09 20 20 20 20 20 20 nyway.....
1ef0: 20 28 69 66 20 28 6e 6f 74 20 28 3e 20 28 6c 65 (if (not (> (le
1f00: 6e 67 74 68 20 65 7a 73 74 65 70 73 6c 73 74 29 ngth ezstepslst)
1f10: 20 30 29 29 0a 09 09 09 09 09 20 20 20 28 64 65 0))...... (de
1f20: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
1f30: 4f 52 3a 20 65 7a 73 74 65 70 73 20 64 65 66 69 OR: ezsteps defi
1f40: 6e 65 64 20 62 75 74 20 65 7a 73 74 65 70 73 6c ned but ezstepsl
1f50: 73 74 20 69 73 20 7a 65 72 6f 20 6c 65 6e 67 74 st is zero lengt
1f60: 68 22 29 0a 09 09 09 09 09 20 20 20 28 6c 65 74 h")...... (let
1f70: 20 6c 6f 6f 70 20 28 28 65 7a 73 74 65 70 20 28 loop ((ezstep (
1f80: 63 61 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 car ezstepslst))
1f90: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 74 61 ....... (ta
1fa0: 6c 20 20 20 20 28 63 64 72 20 65 7a 73 74 65 70 l (cdr ezstep
1fb0: 73 6c 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 slst)).......
1fc0: 20 20 20 28 70 72 65 76 73 74 65 70 20 23 66 29 (prevstep #f)
1fd0: 29 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 63 )...... ;; c
1fe0: 68 65 63 6b 20 65 78 69 74 2d 69 6e 66 6f 20 28 heck exit-info (
1ff0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
2000: 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 20 20 20 info 1)......
2010: 20 20 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 (if (vector-re
2020: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 f exit-info 1)..
2030: 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28 73 74 ..... (let* ((st
2040: 65 70 6e 61 6d 65 20 20 28 63 61 72 20 65 7a 73 epname (car ezs
2050: 74 65 70 29 29 20 20 3b 3b 20 64 6f 20 73 74 75 tep)) ;; do stu
2060: 66 66 20 74 6f 20 72 75 6e 20 74 68 65 20 73 74 ff to run the st
2070: 65 70 0a 09 09 09 09 09 09 09 28 73 74 65 70 69 ep........(stepi
2080: 6e 66 6f 20 20 28 63 61 64 72 20 65 7a 73 74 65 nfo (cadr ezste
2090: 70 29 29 0a 09 09 09 09 09 09 09 28 73 74 65 70 p))........(step
20a0: 70 61 72 74 73 20 28 73 74 72 69 6e 67 2d 6d 61 parts (string-ma
20b0: 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 28 5c tch (regexp "^(\
20c0: 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c \{([^\\}]*)\\}\\
20d0: 73 2a 7c 29 28 2e 2a 29 24 22 29 20 73 74 65 70 s*|)(.*)$") step
20e0: 69 6e 66 6f 29 29 0a 09 09 09 09 09 09 09 28 73 info))........(s
20f0: 74 65 70 70 61 72 6d 73 20 28 6c 69 73 74 2d 72 tepparms (list-r
2100: 65 66 20 73 74 65 70 70 61 72 74 73 20 32 29 29 ef stepparts 2))
2110: 20 3b 3b 20 66 6f 72 20 66 75 74 75 72 65 20 75 ;; for future u
2120: 73 65 2c 20 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c se, {VAR=1,2,3},
2130: 20 72 75 6e 20 73 74 65 70 20 66 6f 72 20 65 61 run step for ea
2140: 63 68 20 0a 09 09 09 09 09 09 09 28 73 74 65 70 ch ........(step
2150: 63 6d 64 20 20 20 28 6c 69 73 74 2d 72 65 66 20 cmd (list-ref
2160: 73 74 65 70 70 61 72 74 73 20 33 29 29 0a 09 09 stepparts 3))...
2170: 09 09 09 09 09 28 73 63 72 69 70 74 20 20 20 20 .....(script
2180: 22 22 29 20 3b 20 22 23 21 2f 62 69 6e 2f 62 61 "") ; "#!/bin/ba
2190: 73 68 5c 6e 22 29 20 3b 3b 20 79 65 70 2c 20 77 sh\n") ;; yep, w
21a0: 65 20 64 65 70 65 6e 64 20 6f 6e 20 62 69 6e 2f e depend on bin/
21b0: 62 61 73 68 20 46 49 58 4d 45 21 21 21 0a 09 09 bash FIXME!!!...
21c0: 09 09 09 09 09 28 6c 6f 67 70 72 6f 2d 75 73 65 .....(logpro-use
21d0: 64 20 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 d #f)).......
21e0: 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 73 61 66 65 ;; NB// can safe
21f0: 6c 79 20 61 73 73 75 6d 65 20 77 65 20 61 72 65 ly assume we are
2200: 20 69 6e 20 74 65 73 74 2d 61 72 65 61 20 64 69 in test-area di
2210: 72 65 63 74 6f 72 79 0a 09 09 09 09 09 09 20 20 rectory.......
2220: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
2230: 22 65 7a 73 74 65 70 73 3a 5c 6e 20 73 74 65 70 "ezsteps:\n step
2240: 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e 61 6d 65 name: " stepname
2250: 20 22 20 73 74 65 70 69 6e 66 6f 3a 20 22 20 73 " stepinfo: " s
2260: 74 65 70 69 6e 66 6f 20 22 20 73 74 65 70 70 61 tepinfo " steppa
2270: 72 74 73 3a 20 22 20 73 74 65 70 70 61 72 74 73 rts: " stepparts
2280: 0a 09 09 09 09 09 09 09 09 22 20 73 74 65 70 70 ........." stepp
2290: 61 72 6d 73 3a 20 22 20 73 74 65 70 70 61 72 6d arms: " stepparm
22a0: 73 20 22 20 73 74 65 70 63 6d 64 3a 20 22 20 73 s " stepcmd: " s
22b0: 74 65 70 63 6d 64 29 0a 09 09 09 09 09 09 20 20 tepcmd).......
22c0: 20 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ....... (if (
22d0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f file-exists? (co
22e0: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f nc stepname ".lo
22f0: 67 70 72 6f 22 29 29 28 73 65 74 21 20 6c 6f 67 gpro"))(set! log
2300: 70 72 6f 2d 75 73 65 64 20 23 74 29 29 0a 0a 09 pro-used #t))...
2310: 09 09 09 09 09 20 20 20 3b 3b 20 3b 3b 20 66 69 ..... ;; ;; fi
2320: 72 73 74 20 73 6f 75 72 63 65 20 74 68 65 20 70 rst source the p
2330: 72 65 76 69 6f 75 73 20 65 6e 76 69 72 6f 6e 6d revious environm
2340: 65 6e 74 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 ent....... ;;
2350: 28 6c 65 74 20 28 28 70 72 65 76 2d 65 6e 76 20 (let ((prev-env
2360: 28 63 6f 6e 63 20 22 2e 65 7a 73 74 65 70 73 2f (conc ".ezsteps/
2370: 22 20 70 72 65 76 73 74 65 70 20 28 69 66 20 28 " prevstep (if (
2380: 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 string-search (r
2390: 65 67 65 78 70 20 22 63 73 68 22 29 20 0a 09 09 egexp "csh") ...
23a0: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 09 .... ;; .
23b0: 09 09 09 09 09 09 20 28 67 65 74 2d 65 6e 76 69 ...... (get-envi
23c0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
23d0: 20 22 53 48 45 4c 4c 22 29 29 20 22 2e 63 73 68 "SHELL")) ".csh
23e0: 22 20 22 2e 73 68 22 29 29 29 29 0a 09 09 09 09 " ".sh")))).....
23f0: 09 09 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 .. ;; (if (a
2400: 6e 64 20 70 72 65 76 73 74 65 70 20 28 66 69 6c nd prevstep (fil
2410: 65 2d 65 78 69 73 74 73 3f 20 70 72 65 76 2d 65 e-exists? prev-e
2420: 6e 76 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b nv))....... ;;
2430: 20 20 20 20 20 20 20 28 73 65 74 21 20 73 63 72 (set! scr
2440: 69 70 74 20 28 63 6f 6e 63 20 73 63 72 69 70 74 ipt (conc script
2450: 20 22 73 6f 75 72 63 65 20 22 20 70 72 65 76 2d "source " prev-
2460: 65 6e 76 29 29 29 29 0a 09 09 09 09 09 09 20 20 env)))).......
2470: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 63 61 ....... ;; ca
2480: 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 75 ll the command u
2490: 73 69 6e 67 20 6d 74 5f 65 7a 73 74 65 70 0a 09 sing mt_ezstep..
24a0: 09 09 09 09 09 20 20 20 28 73 65 74 21 20 73 63 ..... (set! sc
24b0: 72 69 70 74 20 28 63 6f 6e 63 20 22 6d 74 5f 65 ript (conc "mt_e
24c0: 7a 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 zstep " stepname
24d0: 20 22 20 22 20 28 69 66 20 70 72 65 76 73 74 65 " " (if prevste
24e0: 70 20 70 72 65 76 73 74 65 70 20 22 2d 22 29 20 p prevstep "-")
24f0: 22 20 22 20 73 74 65 70 63 6d 64 29 29 0a 0a 09 " " stepcmd))...
2500: 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ..... (debug:p
2510: 72 69 6e 74 20 34 20 22 73 63 72 69 70 74 3a 20 rint 4 "script:
2520: 22 20 73 63 72 69 70 74 29 0a 09 09 09 09 09 09 " script).......
2530: 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d ;; DO NOT rem
2540: 6f 74 65 0a 09 09 09 09 09 09 20 20 20 28 64 62 ote....... (db
2550: 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
2560: 61 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 atus! #f test-id
2570: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
2580: 22 20 22 2d 22 20 23 66 20 23 66 29 0a 09 09 09 " "-" #f #f)....
2590: 09 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 ... ;; now lau
25a0: 6e 63 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 nch....... (le
25b0: 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 t ((pid (process
25c0: 2d 72 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 -run script)))..
25d0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 ..... (let p
25e0: 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 rocessloop ((i 0
25f0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2600: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 (let-values (((p
2610: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat
2620: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 us exit-code)(pr
2630: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
2640: 74 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 t))).........
2650: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
2660: 09 09 09 09 09 09 09 09 20 20 20 28 76 65 63 74 ........ (vect
2670: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2680: 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 o 0 pid)........
2690: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
26a0: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
26b0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 t-status).......
26c0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
26d0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
26e0: 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 it-code)........
26f0: 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 . (mutex-unloc
2700: 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 k! m).........
2710: 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 (if (eq? pid-va
2720: 6c 20 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 l 0).........
2730: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 (begin......
2740: 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 .... (thread-sle
2750: 65 70 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 ep! 2)..........
2760: 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b (processloop (+
2770: 20 69 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 i 1))))........
2780: 09 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 . )).
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
27c0: 20 28 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f ((exinfo (vecto
27d0: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
27e0: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2820: 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 logfna (if logpr
2830: 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 o-used (conc ste
2840: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
2850: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 "))).......
2860: 20 20 3b 3b 20 74 65 73 74 69 6e 67 20 69 66 20 ;; testing if
2870: 70 72 6f 63 65 64 75 72 65 73 20 63 61 6c 6c 65 procedures calle
2880: 64 20 69 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 d in a remote ca
2890: 6c 6c 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d ll cause problem
28a0: 73 20 28 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f s (ans: no or so
28b0: 20 49 20 73 75 73 70 65 63 74 29 0a 09 09 09 09 I suspect).....
28c0: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes
28d0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
28e0: 21 20 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 ! #f test-id ste
28f0: 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 6e pname "end" exin
2900: 66 6f 20 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 fo #f logfna))..
2910: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 6c 6f ..... (if lo
2920: 67 70 72 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 gpro-used.......
2930: 09 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d . (cdb:test-set-
2940: 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a log! *runremote*
2950: 20 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 test-id (conc
2960: 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 stepname ".html"
2970: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b )))....... ;
2980: 3b 20 73 65 74 20 74 68 65 20 74 65 73 74 20 66 ; set the test f
2990: 69 6e 61 6c 20 73 74 61 74 75 73 0a 09 09 09 09 inal status.....
29a0: 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 .. (let* ((t
29b0: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
29c0: 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 (cond..........
29d0: 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f ((and (eq?
29e0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
29f0: 74 2d 69 6e 66 6f 20 32 29 20 32 29 20 6c 6f 67 t-info 2) 2) log
2a00: 70 72 6f 2d 75 73 65 64 29 20 27 77 61 72 6e 29 pro-used) 'warn)
2a10: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2a20: 20 28 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 ((eq? (vector-r
2a30: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
2a40: 30 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0)
2a50: 20 20 20 20 20 27 70 61 73 73 29 0a 09 09 09 09 'pass).....
2a60: 09 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 ..... (els
2a70: 65 20 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 e 'fail)))......
2a80: 09 09 20 20 20 20 28 6f 76 65 72 61 6c 6c 2d 73 .. (overall-s
2a90: 74 61 74 75 73 20 20 20 28 63 6f 6e 64 0a 09 09 tatus (cond...
2aa0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 ....... ((
2ab0: 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 eq? rollup-statu
2ac0: 73 20 32 29 20 27 77 61 72 6e 29 0a 09 09 09 09 s 2) 'warn).....
2ad0: 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 ..... ((eq
2ae0: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
2af0: 30 29 20 27 70 61 73 73 29 0a 09 09 09 09 09 09 0) 'pass).......
2b00: 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 ... (else
2b10: 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 09 09 'fail)))........
2b20: 20 20 20 20 28 6e 65 78 74 2d 73 74 61 74 75 73 (next-status
2b30: 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 (cond ....
2b40: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 ...... ((e
2b50: 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 q? overall-statu
2b60: 73 20 27 70 61 73 73 29 20 74 68 69 73 2d 73 74 s 'pass) this-st
2b70: 65 70 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 ep-status)......
2b80: 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f .... ((eq?
2b90: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 overall-status
2ba0: 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 'warn)..........
2bb0: 09 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 .(if (eq? this-s
2bc0: 74 65 70 2d 73 74 61 74 75 73 20 27 66 61 69 6c tep-status 'fail
2bd0: 29 20 27 66 61 69 6c 20 27 77 61 72 6e 29 29 0a ) 'fail 'warn)).
2be0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2bf0: 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 29 0a (else 'fail)))).
2c00: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 65 ...... (de
2c10: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 45 78 69 bug:print 4 "Exi
2c20: 74 20 76 61 6c 75 65 20 72 65 63 65 69 76 65 64 t value received
2c30: 3a 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 : " (vector-ref
2c40: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 22 20 6c exit-info 2) " l
2c50: 6f 67 70 72 6f 2d 75 73 65 64 3a 20 22 20 6c 6f ogpro-used: " lo
2c60: 67 70 72 6f 2d 75 73 65 64 20 0a 09 09 09 09 09 gpro-used ......
2c70: 09 09 09 20 20 20 20 22 20 74 68 69 73 2d 73 74 ... " this-st
2c80: 65 70 2d 73 74 61 74 75 73 3a 20 22 20 74 68 69 ep-status: " thi
2c90: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 22 20 s-step-status "
2ca0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a 20 overall-status:
2cb0: 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 " overall-status
2cc0: 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 20 ......... "
2cd0: 6e 65 78 74 2d 73 74 61 74 75 73 3a 20 22 20 6e next-status: " n
2ce0: 65 78 74 2d 73 74 61 74 75 73 20 22 20 72 6f 6c ext-status " rol
2cf0: 6c 75 70 2d 73 74 61 74 75 73 3a 20 22 20 72 6f lup-status: " ro
2d00: 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 09 llup-status)....
2d10: 09 09 09 20 20 20 20 20 20 20 28 63 61 73 65 20 ... (case
2d20: 6e 65 78 74 2d 73 74 61 74 75 73 0a 09 09 09 09 next-status.....
2d30: 09 09 09 20 28 28 77 61 72 6e 29 0a 09 09 09 09 ... ((warn).....
2d40: 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 ... (set! rollu
2d50: 70 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 p-status 2).....
2d60: 09 09 09 20 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 ... ;; NB// tes
2d70: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f t-set-status! do
2d80: 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 es rdb calls und
2d90: 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 09 09 09 er the hood.....
2da0: 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 ... (tests:test
2db0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 -set-status! tes
2dc0: 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 t-id "RUNNING" "
2dd0: 57 41 52 4e 22 20 0a 09 09 09 09 09 09 09 09 09 WARN" ..........
2de0: 20 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d (if (eq? this-
2df0: 73 74 65 70 2d 73 74 61 74 75 73 20 27 77 61 72 step-status 'war
2e00: 6e 29 20 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 n) "Logpro warni
2e10: 6e 67 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 ng found" #f)...
2e20: 09 09 09 09 09 09 09 20 20 23 66 29 29 0a 09 09 ....... #f))...
2e30: 09 09 09 09 09 20 28 28 70 61 73 73 29 0a 09 09 ..... ((pass)...
2e40: 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 ..... (tests:te
2e50: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
2e60: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2e70: 20 22 50 41 53 53 22 20 23 66 20 23 66 29 29 0a "PASS" #f #f)).
2e80: 09 09 09 09 09 09 09 20 28 65 6c 73 65 20 3b 3b ....... (else ;;
2e90: 20 27 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 'fail........
2ea0: 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 (set! rollup-sta
2eb0: 74 75 73 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 tus 1) ;; force
2ec0: 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 74 fail........ (t
2ed0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
2ee0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
2ef0: 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 28 UNNING" "FAIL" (
2f00: 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 conc "Failed at
2f10: 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 step " stepname)
2f20: 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 29 #f)........ ))
2f30: 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 ))....... (if
2f40: 28 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 6f (and (steprun-go
2f50: 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 od? logpro-used
2f60: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
2f70: 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 09 -info 2)).......
2f80: 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f . (not (null?
2f90: 20 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 tal))).......
2fa0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
2fb0: 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 tal) (cdr tal) s
2fc0: 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 tepname)))......
2fd0: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 . (debug:print 4
2fe0: 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 "WARNING: a pri
2ff0: 6f 72 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 or step failed,
3000: 73 74 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a stopping at " ez
3010: 73 74 65 70 29 29 29 29 29 29 29 29 0a 09 09 20 step))))))))...
3020: 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c (monitorjob (l
3030: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 28 6c ambda ()..... (l
3040: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
3050: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
3060: 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 63 61 6c onds))......(cal
3070: 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 c-minutes (lamb
3080: 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 28 69 da ()........ (i
3090: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 nexact->exact ..
30a0: 09 09 09 09 09 09 20 20 28 72 6f 75 6e 64 20 0a ...... (round .
30b0: 09 09 09 09 09 09 09 20 20 20 28 2d 20 0a 09 09 ....... (- ...
30c0: 09 09 09 09 09 20 20 20 20 28 63 75 72 72 65 6e ..... (curren
30d0: 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 t-seconds) .....
30e0: 09 09 09 20 20 20 20 73 74 61 72 74 2d 73 65 63 ... start-sec
30f0: 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 09 09 28 onds)))))......(
3100: 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 kill-tries 0))..
3110: 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ... (let loop
3120: 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c ((minutes (cal
3130: 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a 09 09 09 c-minutes)))....
3140: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 . (begin....
3150: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 69 . (set! ki
3160: 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 ll-job? (test-ge
3170: 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 74 t-kill-request t
3180: 65 73 74 2d 69 64 29 29 20 3b 3b 20 72 75 6e 2d est-id)) ;; run-
3190: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
31a0: 6d 64 61 74 29 29 0a 09 09 09 09 20 20 20 20 20 mdat)).....
31b0: 20 20 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; open-run-cl
31c0: 6f 73 65 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 ose not needed f
31d0: 6f 72 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 or test-set-meta
31e0: 2d 69 6e 66 6f 0a 09 09 09 09 20 20 20 20 20 20 -info.....
31f0: 20 28 74 65 73 74 73 3a 73 65 74 2d 6d 65 74 61 (tests:set-meta
3200: 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 -info #f test-id
3210: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d run-id test-nam
3220: 65 20 69 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 e itemdat minute
3230: 73 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 s)..... (i
3240: 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 09 f kill-job? ....
3250: 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 .. (begin.....
3260: 09 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 . (mutex-loc
3270: 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 20 k! m)......
3280: 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 63 (let* ((pid (vec
3290: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
32a0: 6f 20 30 29 29 29 0a 09 09 09 09 09 20 20 20 20 o 0)))......
32b0: 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 (if (number?
32c0: 70 69 64 29 0a 09 09 09 09 09 09 20 20 20 28 62 pid)....... (b
32d0: 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 egin.......
32e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
32f0: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
3300: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
3310: 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 23 l job (attempt #
3320: 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 " kill-tries ")
3330: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c ")....... (l
3340: 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 20 28 et ((processes (
3350: 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 cmd-run->list (c
3360: 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 2d 50 onc "pgrep -l -P
3370: 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 " pid))))......
3380: 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 . (for-eac
3390: 68 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 64 h ........(lambd
33a0: 61 20 28 70 29 0a 09 09 09 09 09 09 09 20 20 28 a (p)........ (
33b0: 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 73 let* ((parts (s
33c0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 0a tring-split p)).
33d0: 09 09 09 09 09 09 09 09 20 28 70 2d 69 64 20 20 ........ (p-id
33e0: 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 (if (> (length
33f0: 70 61 72 74 73 29 20 30 29 0a 09 09 09 09 09 09 parts) 0).......
3400: 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d ... (string-
3410: 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 72 >number (car par
3420: 74 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 ts))..........
3430: 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 #f)))........
3440: 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 09 09 (if p-id....
3450: 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 .....(begin.....
3460: 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 .... (debug:pri
3470: 6e 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 nt 0 "Killing "
3480: 28 63 61 64 72 20 70 61 72 74 73 29 20 22 3b 20 (cadr parts) ";
3490: 6b 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 kill -9 " p-id)
34a0: 0a 09 09 09 09 09 09 09 09 20 20 28 73 79 73 74 ......... (syst
34b0: 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d em (conc "kill -
34c0: 39 20 22 20 70 2d 69 64 29 29 29 29 29 29 0a 09 9 " p-id))))))..
34d0: 09 09 09 09 09 09 28 63 61 72 20 70 72 6f 63 65 ......(car proce
34e0: 73 73 65 73 29 29 0a 09 09 09 09 09 09 20 20 20 sses)).......
34f0: 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e (system (con
3500: 63 20 22 6b 69 6c 6c 20 2d 39 20 2d 22 20 70 69 c "kill -9 -" pi
3510: 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 d))))....... (
3520: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
3530: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
3540: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
3550: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
3560: 6c 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c ll job but probl
3570: 65 6d 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c em with process,
3580: 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b attempting to k
3590: 69 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 ill manager proc
35a0: 65 73 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 ess").......
35b0: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
35c0: 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 -status! test-id
35d0: 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 49 4c "KILLED" "FAIL
35e0: 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 "......... (
35f0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
3600: 22 29 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 ") #f).......
3610: 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c (sqlite3:final
3620: 69 7a 65 21 20 74 64 62 29 0a 09 09 09 09 09 09 ize! tdb).......
3630: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 (exit 1))))
3640: 0a 09 09 09 09 09 20 20 20 20 20 28 73 65 74 21 ...... (set!
3650: 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 31 kill-tries (+ 1
3660: 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 09 kill-tries))...
3670: 09 09 09 20 20 20 20 20 28 6d 75 74 65 78 2d 75 ... (mutex-u
3680: 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 09 09 09 nlock! m))).....
3690: 20 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 ;; (sqlit
36a0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
36b0: 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 68 72 ..... (thr
36c0: 65 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 30 ead-sleep! (+ 10
36d0: 20 28 72 61 6e 64 6f 6d 20 31 30 29 29 29 20 3b (random 10))) ;
36e0: 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 ; add some jitte
36f0: 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f r to the call ho
3700: 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 65 61 me time to sprea
3710: 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 63 63 d out the db acc
3720: 65 73 73 65 73 0a 09 09 09 09 20 20 20 20 20 20 esses.....
3730: 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e (loop (calc-min
3740: 75 74 65 73 29 29 29 29 29 29 29 0a 09 09 20 28 utes)))))))... (
3750: 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 th1 (ma
3760: 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f ke-thread monito
3770: 72 6a 6f 62 29 29 0a 09 09 20 28 74 68 32 20 20 rjob))... (th2
3780: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 (make-th
3790: 72 65 61 64 20 72 75 6e 69 74 29 29 29 0a 09 20 read runit)))..
37a0: 20 20 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 (set! job-thr
37b0: 65 61 64 20 74 68 32 29 0a 09 20 20 20 20 28 74 ead th2).. (t
37c0: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 hread-start! th1
37d0: 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 ).. (thread-s
37e0: 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 tart! th2)..
37f0: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
3800: 32 29 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 2).. (mutex-l
3810: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 28 6c 65 ock! m).. (le
3820: 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 t* ((item-path (
3830: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
3840: 69 74 65 6d 64 61 74 29 29 0a 09 09 20 20 20 28 itemdat))... (
3850: 74 65 73 74 69 6e 66 6f 20 20 28 63 64 62 3a 67 testinfo (cdb:g
3860: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
3870: 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 id *runremote* t
3880: 65 73 74 2d 69 64 29 29 29 20 3b 3b 20 29 29 20 est-id))) ;; ))
3890: 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e ;; run-id test-n
38a0: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 ame item-path)))
38b0: 0a 09 20 20 20 20 20 20 3b 3b 20 41 6d 20 49 20 .. ;; Am I
38c0: 63 6f 6d 70 6c 65 74 65 64 3f 0a 09 20 20 20 20 completed?..
38d0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
38e0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
38f0: 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 state testinfo)
3900: 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 "COMPLETED"))...
3910: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 (begin... (
3920: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 54 debug:print 2 "T
3930: 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 est NOT logged a
3940: 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 s COMPLETED, (st
3950: 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 ate=" (db:test-g
3960: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
3970: 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 o) "), updating
3980: 72 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 result, rollup-s
3990: 74 61 74 75 73 20 69 73 20 22 20 72 6f 6c 6c 75 tatus is " rollu
39a0: 70 2d 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 p-status)...
39b0: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
39c0: 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 status! test-id
39d0: 0a 09 09 09 09 20 20 20 20 28 69 66 20 6b 69 6c ..... (if kil
39e0: 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 l-job? "KILLED"
39f0: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 "COMPLETED")....
3a00: 09 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 20 . (cond.....
3a10: 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 74 6f ((not (vecto
3a20: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
3a30: 31 29 29 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 1)) "FAIL") ;; j
3a40: 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 72 75 6e ob failed to run
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 30 29 rollup-status 0)
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 28 69 culated value (i
3ac0: 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 73 20 41 .e. leave this A
3ad0: 55 54 4f 29 0a 09 09 09 09 20 20 20 20 20 20 28 UTO)..... (
3ae0: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
3af0: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
3b00: 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 estinfo) "AUTO")
3b10: 20 22 41 55 54 4f 22 20 22 50 41 53 53 22 29 29 "AUTO" "PASS"))
3b20: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
3b30: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 rollup-status 1)
3b40: 20 22 46 41 49 4c 22 29 0a 09 09 09 09 20 20 20 "FAIL").....
3b50: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
3b60: 74 61 74 75 73 20 32 29 0a 09 09 09 09 20 20 20 tatus 2).....
3b70: 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 ;; if the cur
3b80: 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 rent status is A
3b90: 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 6f UTO the defer to
3ba0: 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 20 the calculated
3bb0: 76 61 6c 75 65 20 62 75 74 20 71 75 61 6c 69 66 value but qualif
3bc0: 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 68 69 y (i.e. make thi
3bd0: 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 09 09 s AUTO-WARN)....
3be0: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
3bf0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3c00: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 status testinfo)
3c10: 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 "AUTO") "AUTO-W
3c20: 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 09 ARN" "WARN"))...
3c30: 09 09 20 20 20 20 20 28 65 6c 73 65 20 22 46 41 .. (else "FA
3c40: 49 4c 22 29 29 0a 09 09 09 09 20 20 20 20 28 61 IL"))..... (a
3c50: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
3c60: 29 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 3b ) #f))).. ;
3c70: 3b 20 66 6f 72 20 61 75 74 6f 6d 61 74 65 64 20 ; for automated
3c80: 63 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 creation of the
3c90: 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 66 69 6c 65 rollup html file
3ca0: 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 this is a good
3cb0: 70 6c 61 63 65 2e 2e 2e 0a 09 20 20 20 20 20 20 place.....
3cc0: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
3cd0: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a item-path "")).
3ce0: 09 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c .. (open-run-cl
3cf0: 6f 73 65 20 74 65 73 74 73 3a 73 75 6d 6d 61 72 ose tests:summar
3d00: 69 7a 65 2d 69 74 65 6d 73 20 23 66 20 72 75 6e ize-items #f run
3d10: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 -id test-name #f
3d20: 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 )) ;; don't forc
3d30: 65 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 e - just update
3d40: 69 66 20 6e 6f 0a 09 20 20 20 20 20 20 29 0a 09 if no.. )..
3d50: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
3d60: 6b 21 20 6d 29 0a 09 20 20 20 20 3b 3b 20 28 65 k! m).. ;; (e
3d70: 78 65 63 2d 72 65 73 75 6c 74 73 20 28 63 6d 64 xec-results (cmd
3d80: 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 -run->list fullr
3d90: 75 6e 73 63 72 69 70 74 29 29 20 3b 3b 20 20 28 unscript)) ;; (
3da0: 6c 69 73 74 20 22 3e 22 20 28 63 6f 6e 63 20 74 list ">" (conc t
3db0: 65 73 74 2d 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c est-name "-run.l
3dc0: 6f 67 22 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 og")))).. ;;
3dd0: 28 73 75 63 63 65 73 73 20 20 20 20 20 20 65 78 (success ex
3de0: 65 63 2d 72 65 73 75 6c 74 73 29 29 20 3b 3b 20 ec-results)) ;;
3df0: 28 65 71 3f 20 28 63 61 64 72 20 65 78 65 63 2d (eq? (cadr exec-
3e00: 72 65 73 75 6c 74 73 29 20 30 29 29 29 0a 09 20 results) 0)))..
3e10: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
3e20: 32 20 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 2 "Output from r
3e30: 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e unning " fullrun
3e40: 73 63 72 69 70 74 20 22 2c 20 70 69 64 20 22 20 script ", pid "
3e50: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
3e60: 2d 69 6e 66 6f 20 30 29 20 22 20 69 6e 20 77 6f -info 0) " in wo
3e70: 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 20 77 rk area " .... w
3e80: 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d ork-area ":\n===
3e90: 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 20 =\n exit code "
3ea0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
3eb0: 2d 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d -info 2) "\n" "=
3ec0: 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 3b 3b 20 ===\n").. ;;
3ed0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
3ee0: 65 21 20 64 62 29 0a 09 20 20 20 20 3b 3b 20 28 e! db).. ;; (
3ef0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
3f00: 21 20 74 64 62 29 0a 09 20 20 20 20 28 69 66 20 ! tdb).. (if
3f10: 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 66 (not (vector-ref
3f20: 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 exit-info 1))..
3f30: 09 28 65 78 69 74 20 34 29 29 29 29 29 29 29 0a .(exit 4))))))).
3f40: 0a 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 76 .;; set up the v
3f50: 65 72 79 20 62 61 73 69 63 73 20 6e 65 65 64 65 ery basics neede
3f60: 64 20 66 6f 72 20 64 6f 69 6e 67 20 61 6e 79 74 d for doing anyt
3f70: 68 69 6e 67 20 68 65 72 65 2e 0a 28 64 65 66 69 hing here..(defi
3f80: 6e 65 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 ne (setup-for-ru
3f90: 6e 29 0a 20 20 3b 3b 20 77 6f 75 6c 64 20 73 65 n). ;; would se
3fa0: 74 20 76 61 6c 75 65 73 20 66 6f 72 20 4b 45 59 t values for KEY
3fb0: 53 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e S in the environ
3fc0: 6d 65 6e 74 20 68 65 72 65 20 66 6f 72 20 62 65 ment here for be
3fd0: 74 74 65 72 20 73 75 70 70 6f 72 74 20 6f 66 20 tter support of
3fe0: 65 6e 76 2d 6f 76 65 72 72 69 64 65 20 62 75 74 env-override but
3ff0: 20 0a 20 20 3b 3b 20 68 61 76 65 20 63 68 69 63 . ;; have chic
4000: 6b 65 6e 2f 65 67 67 20 73 63 65 6e 61 72 69 6f ken/egg scenario
4010: 2e 20 6e 65 65 64 20 74 6f 20 72 65 61 64 20 6d . need to read m
4020: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 74 egatest.config t
4030: 68 65 6e 20 72 65 61 64 20 69 74 20 61 67 61 69 hen read it agai
4040: 6e 2e 20 47 6f 69 6e 67 20 74 6f 20 0a 20 20 3b n. Going to . ;
4050: 3b 20 70 61 73 73 20 6f 6e 20 74 68 61 74 20 69 ; pass on that i
4060: 64 65 61 20 66 6f 72 20 6e 6f 77 0a 20 20 3b 3b dea for now. ;;
4070: 20 73 70 65 63 69 61 6c 20 63 61 73 65 0a 20 20 special case.
4080: 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 (set! *configinf
4090: 6f 2a 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 o* (find-and-rea
40a0: 64 2d 63 6f 6e 66 69 67 20 0a 09 09 20 20 20 20 d-config ...
40b0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
40c0: 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 28 61 arg "-config")(a
40d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
40e0: 6e 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 nfig") "megatest
40f0: 2e 63 6f 6e 66 69 67 22 29 0a 09 09 20 20 20 20 .config")...
4100: 20 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 environ-patt:
4110: 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 0a 09 "env-override"..
4120: 09 20 20 20 20 20 20 67 69 76 65 6e 2d 74 6f 70 . given-top
4130: 70 61 74 68 3a 20 28 67 65 74 2d 65 6e 76 69 72 path: (get-envir
4140: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
4150: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
4160: 45 22 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 E")... path
4170: 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f envvar: "MT_RUN_
4180: 41 52 45 41 5f 48 4f 4d 45 22 29 29 0a 20 20 28 AREA_HOME")). (
4190: 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a set! *configdat*
41a0: 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 (if (car *conf
41b0: 69 67 69 6e 66 6f 2a 29 28 63 61 72 20 2a 63 6f iginfo*)(car *co
41c0: 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a nfiginfo*) #f)).
41d0: 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 (set! *toppath
41e0: 2a 20 20 20 20 28 69 66 20 28 63 61 72 20 2a 63 * (if (car *c
41f0: 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 64 72 onfiginfo*)(cadr
4200: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 *configinfo*) #
4210: 66 29 29 0a 20 20 28 69 66 20 2a 74 6f 70 70 61 f)). (if *toppa
4220: 74 68 2a 0a 20 20 20 20 20 20 28 73 65 74 65 6e th*. (seten
4230: 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 v "MT_RUN_AREA_H
4240: 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 20 OME" *toppath*)
4250: 3b 3b 20 74 6f 20 62 65 20 64 65 70 72 65 63 61 ;; to be depreca
4260: 74 65 64 0a 20 20 20 20 20 20 28 64 65 62 75 67 ted. (debug
4270: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
4280: 20 66 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 failed to find
4290: 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 the top path to
42a0: 79 6f 75 72 20 72 75 6e 20 73 65 74 75 70 2e 22 your run setup."
42b0: 29 29 0a 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a )). *toppath*).
42c0: 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d 62 65 .(define (get-be
42d0: 73 74 2d 64 69 73 6b 20 63 6f 6e 66 64 61 74 29 st-disk confdat)
42e0: 0a 20 20 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 . (let* ((disks
42f0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
4300: 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 ref/default conf
4310: 64 61 74 20 22 64 69 73 6b 73 22 20 23 66 29 29 dat "disks" #f))
4320: 0a 09 20 28 62 65 73 74 20 20 20 20 20 23 66 29 .. (best #f)
4330: 0a 09 20 28 62 65 73 74 73 69 7a 65 20 30 29 29 .. (bestsize 0))
4340: 0a 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a . (if disks .
4350: 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c .(for-each .. (l
4360: 61 6d 62 64 61 20 28 64 69 73 6b 2d 6e 75 6d 29 ambda (disk-num)
4370: 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 69 72 .. (let* ((dir
4380: 70 61 74 68 20 20 20 20 28 63 61 64 72 20 28 61 path (cadr (a
4390: 73 73 6f 63 20 64 69 73 6b 2d 6e 75 6d 20 64 69 ssoc disk-num di
43a0: 73 6b 73 29 29 29 0a 09 09 20 20 28 66 72 65 65 sks)))... (free
43b0: 73 70 63 20 20 20 20 28 69 66 20 28 61 6e 64 20 spc (if (and
43c0: 28 64 69 72 65 63 74 6f 72 79 3f 20 64 69 72 70 (directory? dirp
43d0: 61 74 68 29 0a 09 09 09 09 20 20 20 20 20 20 20 ath).....
43e0: 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 (file-write-acce
43f0: 73 73 3f 20 64 69 72 70 61 74 68 29 29 0a 09 09 ss? dirpath))...
4400: 09 09 20 20 28 67 65 74 2d 64 66 20 64 69 72 70 .. (get-df dirp
4410: 61 74 68 29 0a 09 09 09 09 20 20 28 62 65 67 69 ath)..... (begi
4420: 6e 0a 09 09 09 09 20 20 20 20 28 64 65 62 75 67 n..... (debug
4430: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
4440: 47 3a 20 70 61 74 68 20 22 20 64 69 72 70 61 74 G: path " dirpat
4450: 68 20 22 20 69 6e 20 5b 64 69 73 6b 73 5d 20 73 h " in [disks] s
4460: 65 63 74 69 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 ection not valid
4470: 20 6f 72 20 77 72 69 74 61 62 6c 65 22 29 0a 09 or writable")..
4480: 09 09 09 20 20 20 20 30 29 29 29 29 0a 09 20 20 ... 0))))..
4490: 20 20 20 28 69 66 20 28 3e 20 66 72 65 65 73 70 (if (> freesp
44a0: 63 20 62 65 73 74 73 69 7a 65 29 0a 09 09 20 28 c bestsize)... (
44b0: 62 65 67 69 6e 0a 09 09 20 20 20 28 73 65 74 21 begin... (set!
44c0: 20 62 65 73 74 20 20 20 20 20 64 69 72 70 61 74 best dirpat
44d0: 68 29 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 h)... (set! be
44e0: 73 74 73 69 7a 65 20 66 72 65 65 73 70 63 29 29 stsize freespc))
44f0: 29 29 29 0a 09 20 28 6d 61 70 20 63 61 72 20 64 ))).. (map car d
4500: 69 73 6b 73 29 29 29 0a 20 20 20 20 28 69 66 20 isks))). (if
4510: 62 65 73 74 0a 09 62 65 73 74 0a 09 28 62 65 67 best..best..(beg
4520: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
4530: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4e 6f 20 nt 0 "ERROR: No
4540: 76 61 6c 69 64 20 64 69 73 6b 73 20 66 6f 75 6e valid disks foun
4550: 64 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f d in megatest.co
4560: 6e 66 69 67 2e 20 50 6c 65 61 73 65 20 61 64 64 nfig. Please add
4570: 20 73 6f 6d 65 20 74 6f 20 79 6f 75 72 20 5b 64 some to your [d
4580: 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 22 29 0a isks] section").
4590: 09 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a . (exit 1))))).
45a0: 0a 3b 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 .;; Desired dire
45b0: 63 74 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a ctory structure:
45c0: 0a 3b 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 .;;.;; <linkdir
45d0: 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c > - <target> - <
45e0: 74 65 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 testname> -..;;
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4610: 20 20 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 |.;;
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b v.;
4640: 3b 20 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 ; <rundir> -
4650: 3c 74 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c <target> - <
4660: 74 65 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 testname> -|- <i
4670: 74 65 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b tempath(s)>.;;.;
4680: 3b 20 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e ; dir stored in
4690: 20 74 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b test is:.;; .;;
46a0: 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 <linkdir> - <t
46b0: 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 arget> - <testna
46c0: 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 me> [ - <itempat
46d0: 68 3e 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 h> ].;; .;; All
46e0: 6c 6f 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 log file links s
46f0: 68 6f 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 hould be stored
4700: 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 relative to the
4710: 74 6f 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 top of link path
4720: 0a 3b 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 .;; .;; <target
4730: 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b > - <testname> [
4740: 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 - <itempath> ]
4750: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 .;;.(define (cre
4760: 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 ate-work-area db
4770: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
4780: 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 test-src-path di
4790: 73 6b 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 sk-path testname
47a0: 20 69 74 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 itemdat). (let
47b0: 2a 20 28 28 72 75 6e 2d 69 6e 66 6f 20 28 63 64 * ((run-info (cd
47c0: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
47d0: 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 23 66 20 get-run-info #f
47e0: 72 75 6e 2d 69 64 29 29 0a 09 20 28 69 74 65 6d run-id)).. (item
47f0: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
4800: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
4810: 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 .. (runname (db
4820: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
4830: 61 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 ader (db:get-row
4840: 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 run-info)......
4850: 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 (db:get-heade
4860: 72 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 r run-info).....
4870: 09 20 20 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a . "runname")).
4880: 09 20 3b 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 . ;; convert bac
4890: 6b 20 74 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 k to db: from rd
48a0: 62 3a 20 2d 20 74 68 69 73 20 69 73 20 61 6c 77 b: - this is alw
48b0: 61 79 73 20 72 75 6e 20 61 74 20 73 65 72 76 65 ays run at serve
48c0: 72 20 65 6e 64 0a 09 20 28 6b 65 79 2d 76 61 6c r end.. (key-val
48d0: 73 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 s (cdb:remote-ru
48e0: 6e 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c n db:get-key-val
48f0: 73 20 23 66 20 72 75 6e 2d 69 64 29 29 0a 09 20 s #f run-id))..
4900: 28 74 61 72 67 65 74 20 20 20 28 73 74 72 69 6e (target (strin
4910: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
4920: 79 2d 76 61 6c 73 20 22 2f 22 29 29 0a 0a 09 20 y-vals "/"))...
4930: 28 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 (not-iterated (
4940: 65 71 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 equal? "" item-p
4950: 61 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 ath))... ;; all
4960: 74 65 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 tests are found
4970: 61 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 at <rundir>/test
4980: 2d 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 -base or <linkdi
4990: 72 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 r>/test-base.. (
49a0: 74 65 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f testtop-base (co
49b0: 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 nc target "/" ru
49c0: 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
49d0: 6d 65 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 me)).. (test-bas
49e0: 65 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 e (conc testt
49f0: 6f 70 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d op-base (if not-
4a00: 69 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 iterated "" "/")
4a10: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 item-path))...
4a20: 3b 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 ;; nb// if itemp
4a30: 61 74 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 ath is not "" th
4a40: 65 6e 20 69 74 20 69 73 20 70 72 65 66 69 78 65 en it is prefixe
4a50: 64 20 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f d with "/".. (to
4a60: 70 74 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 ptest-path (conc
4a70: 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 disk-path "/" t
4a80: 65 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 esttop-base))..
4a90: 28 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 (test-path (c
4aa0: 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f onc disk-path "/
4ab0: 22 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 " test-base))...
4ac0: 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 ;; ensure this
4ad0: 65 78 69 73 74 73 20 66 69 72 73 74 20 61 73 20 exists first as
4ae0: 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 links to subtest
4af0: 73 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 s must be create
4b00: 64 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 d there.. (linkt
4b10: 72 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 ree (let ((rd (
4b20: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
4b30: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
4b40: 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a " "linktree"))).
4b50: 09 09 20 20 20 20 20 20 28 69 66 20 72 64 20 72 .. (if rd r
4b60: 64 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 d (conc *toppath
4b70: 2a 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 * "/runs"))))...
4b80: 20 28 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 (lnkbase (conc
4b90: 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 linktree "/" ta
4ba0: 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 rget "/" runname
4bb0: 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 )).. (lnkpath (
4bc0: 63 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 conc lnkbase "/"
4bd0: 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c testname)).. (l
4be0: 6e 6b 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e nkpathf (conc ln
4bf0: 6b 70 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 kpath (if not-it
4c00: 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 erated "" "/") i
4c10: 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 tem-path)))..
4c20: 20 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 ;; Update the r
4c30: 75 6e 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 undir path in th
4c40: 65 20 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f e test record fo
4c50: 72 20 61 6c 6c 0a 20 20 20 20 28 63 64 62 3a 74 r all. (cdb:t
4c60: 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 est-set-rundir-b
4c70: 79 2d 74 65 73 74 2d 69 64 20 2a 72 75 6e 72 65 y-test-id *runre
4c80: 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 6c 6e mote* test-id ln
4c90: 6b 70 61 74 68 66 29 0a 0a 20 20 20 20 28 64 65 kpathf).. (de
4ca0: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 bug:print 2 "INF
4cb0: 4f 3a 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 O:\n lnkba
4cc0: 73 65 3d 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e se=" lnkbase "\n
4cd0: 20 20 20 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 lnkpath="
4ce0: 20 6c 6e 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f lnkpath "\n to
4cf0: 70 74 65 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 ptest-path=" top
4d00: 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 test-path "\n
4d10: 20 20 74 65 73 74 2d 70 61 74 68 3d 22 20 74 65 test-path=" te
4d20: 73 74 2d 70 61 74 68 29 0a 20 20 20 20 28 69 66 st-path). (if
4d30: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
4d40: 74 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 ts? linktree))..
4d50: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
4d60: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
4d70: 47 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 G: linktree did
4d80: 6e 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 74 not exist! Creat
4d90: 69 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 20 ing it now at "
4da0: 6c 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 72 linktree).. (cr
4db0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c eate-directory l
4dc0: 69 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b 3b inktree #t))) ;;
4dd0: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
4de0: 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 mkdir -p " linkt
4df0: 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 ree)))). ;; c
4e00: 72 65 61 74 65 20 74 68 65 20 64 69 72 65 63 74 reate the direct
4e10: 6f 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 74 ory for the test
4e20: 73 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 s dir links, thi
4e30: 73 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d s is needed no m
4e40: 61 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 atter what....
4e50: 20 20 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 (if (not (dire
4e60: 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e ctory-exists? ln
4e70: 6b 62 61 73 65 29 29 0a 09 28 63 72 65 61 74 65 kbase))..(create
4e80: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b 62 61 -directory lnkba
4e90: 73 65 20 23 74 29 29 0a 20 20 20 20 0a 20 20 20 se #t)). .
4ea0: 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 74 ;; update the t
4eb0: 6f 70 74 65 73 74 20 72 65 63 6f 72 64 20 77 69 optest record wi
4ec0: 74 68 20 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 th its location
4ed0: 72 75 6e 64 69 72 2c 20 63 61 63 68 65 20 74 68 rundir, cache th
4ee0: 65 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 e path. ;; Th
4ef0: 69 73 20 77 61 73 73 20 68 69 67 68 6c 79 20 69 is wass highly i
4f00: 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 nefficient, one
4f10: 64 62 20 77 72 69 74 65 20 66 6f 72 20 65 76 65 db write for eve
4f20: 72 79 20 73 75 62 74 65 73 74 2c 20 70 6f 74 65 ry subtest, pote
4f30: 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 ntially. ;; t
4f40: 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 housands of unne
4f50: 63 65 73 73 61 72 79 20 75 70 64 61 74 65 73 2c cessary updates,
4f60: 20 63 61 63 68 65 20 74 68 65 20 66 61 63 74 20 cache the fact
4f70: 69 74 20 77 61 73 20 73 65 74 20 61 6e 64 20 64 it was set and d
4f80: 6f 6e 27 74 20 73 65 74 20 69 74 20 0a 20 20 20 on't set it .
4f90: 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 ;; again. ..
4fa0: 20 3b 3b 20 4e 42 20 2d 20 54 68 69 73 20 69 73 ;; NB - This is
4fb0: 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 20 72 69 67 not working rig
4fc0: 68 74 20 2d 20 73 6f 6d 65 20 74 6f 70 20 74 65 ht - some top te
4fd0: 73 74 73 20 61 72 65 20 6e 6f 74 20 67 65 74 74 sts are not gett
4fe0: 69 6e 67 20 74 68 65 20 70 61 74 68 20 73 65 74 ing the path set
4ff0: 21 21 21 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f !!!.. (if (no
5000: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
5010: 66 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 f/default *topte
5020: 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 st-paths* testna
5030: 6d 65 20 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 me #f))..(let* (
5040: 28 74 65 73 74 69 6e 66 6f 20 20 20 20 20 20 20 (testinfo
5050: 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e (cdb:get-test-in
5060: 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d fo-by-id *runrem
5070: 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 20 3b ote* test-id)) ;
5080: 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 ; run-id testna
5090: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 me item-path))..
50a0: 20 20 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 (curr-tes
50b0: 74 2d 70 61 74 68 20 28 69 66 20 74 65 73 74 69 t-path (if testi
50c0: 6e 66 6f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 nfo (db:test-get
50d0: 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f -rundir testinfo
50e0: 29 20 23 66 29 29 29 0a 09 20 20 28 68 61 73 68 ) #f))).. (hash
50f0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 -table-set! *top
5100: 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 test-paths* test
5110: 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 74 2d 70 name curr-test-p
5120: 61 74 68 29 0a 09 20 20 3b 3b 20 4e 42 2f 2f 20 ath).. ;; NB//
5130: 57 61 73 20 74 68 69 73 20 66 6f 72 20 74 68 65 Was this for the
5140: 20 74 65 73 74 20 6f 72 20 66 6f 72 20 74 68 65 test or for the
5150: 20 70 61 72 65 6e 74 20 69 6e 20 61 6e 20 69 74 parent in an it
5160: 65 72 61 74 65 64 20 74 65 73 74 3f 0a 09 20 20 erated test?..
5170: 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 (cdb:test-set-ru
5180: 6e 64 69 72 21 20 2a 72 75 6e 72 65 6d 6f 74 65 ndir! *runremote
5190: 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d * run-id testnam
51a0: 65 20 22 22 20 6c 6e 6b 70 61 74 68 29 20 3b 3b e "" lnkpath) ;;
51b0: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 0a 09 toptest-path)..
51c0: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 63 (if (or (not c
51d0: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 urr-test-path)..
51e0: 09 20 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f . (not (directo
51f0: 72 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 74 65 ry-exists? topte
5200: 73 74 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 st-path)))..
5210: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
5220: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 g:print-info 2 "
5230: 43 72 65 61 74 69 6e 67 20 22 20 74 6f 70 74 65 Creating " topte
5240: 73 74 2d 70 61 74 68 20 22 20 61 6e 64 20 6c 69 st-path " and li
5250: 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 29 0a 09 09 nk " lnkpath)...
5260: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
5270: 79 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 23 y toptest-path #
5280: 74 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 t)...(hash-table
5290: 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 -set! *toptest-p
52a0: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 74 aths* testname t
52b0: 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 29 29 optest-path)))))
52c0: 0a 0a 20 20 20 20 3b 3b 20 4e 6f 77 20 63 72 65 .. ;; Now cre
52d0: 61 74 65 20 74 68 65 20 6c 69 6e 6b 20 66 72 6f ate the link fro
52e0: 6d 20 74 68 65 20 74 65 73 74 20 70 61 74 68 20 m the test path
52f0: 74 6f 20 74 68 65 20 6c 69 6e 6b 20 74 72 65 65 to the link tree
5300: 2c 20 68 6f 77 65 76 65 72 0a 20 20 20 20 3b 3b , however. ;;
5310: 20 69 66 20 74 68 65 20 74 65 73 74 20 69 73 20 if the test is
5320: 69 74 65 72 61 74 65 64 20 69 74 20 69 73 20 6e iterated it is n
5330: 65 63 65 73 73 61 72 79 20 74 6f 20 63 72 65 61 ecessary to crea
5340: 74 65 20 74 68 65 20 70 61 72 65 6e 74 20 70 61 te the parent pa
5350: 74 68 0a 20 20 20 20 3b 3b 20 74 6f 20 74 68 65 th. ;; to the
5360: 20 69 74 65 72 61 74 69 6f 6e 2e 20 75 73 65 20 iteration. use
5370: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
5380: 72 79 20 74 6f 20 74 72 69 6d 20 74 68 65 20 70 ry to trim the p
5390: 61 74 68 20 62 79 20 6f 6e 65 0a 20 20 20 20 3b ath by one. ;
53a0: 3b 20 6c 65 76 65 6c 0a 20 20 20 20 28 69 66 20 ; level. (if
53b0: 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 (not not-iterate
53c0: 64 29 20 3b 3b 20 69 2e 65 2e 20 69 74 65 72 61 d) ;; i.e. itera
53d0: 74 65 64 0a 09 28 6c 65 74 20 28 28 69 74 65 72 ted..(let ((iter
53e0: 61 74 65 64 2d 70 61 72 65 6e 74 20 20 28 70 61 ated-parent (pa
53f0: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
5400: 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 (conc lnkpath "
5410: 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 29 /" item-path))))
5420: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
5430: 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 74 69 6e -info 2 "Creatin
5440: 67 20 69 74 65 72 61 74 65 64 20 70 61 72 65 6e g iterated paren
5450: 74 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 t " iterated-par
5460: 65 6e 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d ent).. (handle-
5470: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 exceptions.. e
5480: 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 xn.. (begin..
5490: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
54a0: 20 30 20 22 45 52 52 4f 52 3a 20 20 46 61 69 6c 0 "ERROR: Fail
54b0: 65 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 ed to create dir
54c0: 65 63 74 6f 72 79 20 22 20 69 74 65 72 61 74 65 ectory " iterate
54d0: 64 2d 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 69 d-parent ((condi
54e0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
54f0: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
5500: 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 sage) exn) ", ex
5510: 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 iting").. (e
5520: 78 69 74 20 31 29 29 0a 09 20 20 20 28 63 72 65 xit 1)).. (cre
5530: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 ate-directory it
5540: 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 erated-parent #t
5550: 29 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 73 )))).. (if (s
5560: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e ymbolic-link? ln
5570: 6b 70 61 74 68 29 20 0a 09 28 68 61 6e 64 6c 65 kpath) ..(handle
5580: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 -exceptions.. ex
5590: 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 n.. (begin.. (
55a0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
55b0: 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f RROR: Failed to
55c0: 20 72 65 6d 6f 76 65 20 73 79 6d 6c 69 6e 6b 20 remove symlink
55d0: 22 20 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 " lnkpath ((cond
55e0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
55f0: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
5600: 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 ssage) exn) ", e
5610: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 xiting").. (ex
5620: 69 74 20 31 29 29 0a 09 20 28 64 65 6c 65 74 65 it 1)).. (delete
5630: 2d 66 69 6c 65 20 6c 6e 6b 70 61 74 68 29 29 29 -file lnkpath)))
5640: 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
5650: 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f or (file-exists?
5660: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 lnkpath)... (sy
5670: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b mbolic-link? lnk
5680: 70 61 74 68 29 29 29 0a 09 28 68 61 6e 64 6c 65 path)))..(handle
5690: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 -exceptions.. ex
56a0: 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 n.. (begin.. (
56b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
56c0: 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f RROR: Failed to
56d0: 20 63 72 65 61 74 65 20 73 79 6d 6c 69 6e 6b 20 create symlink
56e0: 22 20 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 " lnkpath ((cond
56f0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
5700: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
5710: 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 ssage) exn) ", e
5720: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 xiting").. (ex
5730: 69 74 20 31 29 29 0a 09 20 28 63 72 65 61 74 65 it 1)).. (create
5740: 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 -symbolic-link t
5750: 6f 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 optest-path lnkp
5760: 61 74 68 29 29 29 0a 20 20 20 20 0a 20 20 20 20 ath))). .
5770: 3b 3b 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 ;; The toptest p
5780: 61 74 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 ath has been cre
5790: 61 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 ated, the link t
57a0: 6f 20 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 o the test in th
57b0: 65 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 e linktree has.
57c0: 20 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 ;; been creat
57d0: 65 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 ed. Now, if this
57e0: 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 is an iterated
57f0: 74 65 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 test the real te
5800: 73 74 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 st dir must be c
5810: 72 65 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 reated. (if (
5820: 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 not not-iterated
5830: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 ) ;; this is an
5840: 69 74 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 iterated test..(
5850: 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 let ((lnktarget
5860: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
5870: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 " item-path)))..
5880: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
5890: 20 22 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 "Setting up sub
58a0: 20 74 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 test run area")
58b0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
58c0: 20 32 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 2 " - creating
58d0: 72 75 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 run area in " te
58e0: 73 74 2d 70 61 74 68 29 0a 09 20 20 28 68 61 6e st-path).. (han
58f0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
5900: 20 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 exn.. (begi
5910: 6e 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 n.. (debug:p
5920: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 20 rint 0 "ERROR:
5930: 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 Failed to create
5940: 20 64 69 72 65 63 74 6f 72 79 20 22 20 74 65 73 directory " tes
5950: 74 2d 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 t-path ((conditi
5960: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
5970: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
5980: 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 ge) exn) ", exit
5990: 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 ing").. (exi
59a0: 74 20 31 29 29 0a 09 20 20 20 28 63 72 65 61 74 t 1)).. (creat
59b0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
59c0: 2d 70 61 74 68 20 23 74 29 29 0a 09 20 20 28 64 -path #t)).. (d
59d0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 0a 09 09 ebug:print 2 ...
59e0: 20 20 20 20 20 20 20 22 20 2d 20 63 72 65 61 74 " - creat
59f0: 69 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 ing link from: "
5a00: 20 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 22 0a test-path "\n".
5a10: 09 09 20 20 20 20 20 20 20 22 20 20 20 20 20 20 .. "
5a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 3a to:
5a30: 20 22 20 6c 6e 6b 74 61 72 67 65 74 29 0a 0a 09 " lnktarget)...
5a40: 20 20 3b 3b 20 49 66 20 74 68 65 72 65 20 69 73 ;; If there is
5a50: 20 61 6c 72 65 61 64 79 20 61 20 73 79 6d 6c 69 already a symli
5a60: 6e 6b 20 64 65 6c 65 74 65 20 69 74 20 61 6e 64 nk delete it and
5a70: 20 72 65 63 72 65 61 74 65 20 69 74 2e 0a 09 20 recreate it...
5a80: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
5a90: 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 20 ons.. exn..
5aa0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 64 65 (begin.. (de
5ab0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
5ac0: 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 72 OR: Failed to r
5ad0: 65 2d 63 72 65 61 74 65 20 6c 69 6e 6b 20 22 20 e-create link "
5ae0: 6c 69 6e 6b 74 61 72 67 65 74 20 28 28 63 6f 6e linktarget ((con
5af0: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
5b00: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
5b10: 65 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 essage) exn) ",
5b20: 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 exiting")..
5b30: 28 65 78 69 74 29 29 0a 09 20 20 20 28 69 66 20 (exit)).. (if
5b40: 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 (symbolic-link?
5b50: 6c 6e 6b 74 61 72 67 65 74 29 20 20 20 20 20 28 lnktarget) (
5b60: 64 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 74 delete-file lnkt
5b70: 61 72 67 65 74 29 29 0a 09 20 20 20 28 69 66 20 arget)).. (if
5b80: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
5b90: 73 3f 20 6c 6e 6b 74 61 72 67 65 74 29 29 20 28 s? lnktarget)) (
5ba0: 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d create-symbolic-
5bb0: 6c 69 6e 6b 20 74 65 73 74 2d 70 61 74 68 20 6c link test-path l
5bc0: 6e 6b 74 61 72 67 65 74 29 29 29 29 29 0a 0a 20 nktarget)))))..
5bd0: 20 20 20 3b 3b 20 49 20 73 75 73 70 65 63 74 20 ;; I suspect
5be0: 74 68 69 73 20 73 65 63 74 69 6f 6e 20 77 61 73 this section was
5bf0: 20 64 65 6c 65 74 69 6e 67 20 74 65 73 74 20 64 deleting test d
5c00: 69 72 65 63 74 6f 72 69 65 73 20 75 6e 64 65 72 irectories under
5c10: 20 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 77 69 some . ;; wi
5c20: 65 72 64 20 73 69 74 61 74 69 6f 6e 73 3f 20 54 erd sitations? T
5c30: 68 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 6b 65 his doesn't make
5c40: 20 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 62 6c sense - reenabl
5c50: 69 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 0a 20 ing the rm -f .
5c60: 20 20 20 3b 3b 20 49 20 68 6f 6e 65 73 74 6c 79 ;; I honestly
5c70: 20 64 6f 6e 27 74 20 72 65 6d 65 6d 62 65 72 20 don't remember
5c80: 2a 77 68 79 2a 20 74 68 69 73 20 63 68 75 6e 6b *why* this chunk
5c90: 20 77 61 73 20 6e 65 65 64 65 64 2e 2e 2e 0a 20 was needed....
5ca0: 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 74 65 73 ;; (let ((tes
5cb0: 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 tlink (conc lnkp
5cc0: 61 74 68 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ath "/" testname
5cd0: 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 ))). ;; (if
5ce0: 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 (and (file-exis
5cf0: 74 73 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 ts? testlink).
5d00: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ;;
5d10: 28 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 69 6c (or (regular-fil
5d20: 65 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 e? testlink).
5d30: 20 3b 3b 20 20 20 20 20 09 20 20 20 28 73 79 6d ;; . (sym
5d40: 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 74 65 73 74 bolic-link? test
5d50: 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 link))). ;;
5d60: 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f (system (co
5d70: 6e 63 20 22 72 6d 20 2d 66 20 22 20 74 65 73 74 nc "rm -f " test
5d80: 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 link))). ;;
5d90: 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 (system (conc
5da0: 22 6c 6e 20 2d 73 66 20 22 20 74 65 73 74 2d 70 "ln -sf " test-p
5db0: 61 74 68 20 22 20 22 20 74 65 73 74 6c 69 6e 6b ath " " testlink
5dc0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 64 69 72 ))). (if (dir
5dd0: 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 61 74 ectory? test-pat
5de0: 68 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c h)..(begin.. (l
5df0: 65 74 2a 20 28 28 6f 76 72 63 6d 64 20 28 6c 65 et* ((ovrcmd (le
5e00: 74 20 28 28 63 6d 64 20 28 63 6f 6e 66 69 67 2d t ((cmd (config-
5e10: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
5e20: 74 2a 20 22 73 65 74 75 70 22 20 22 74 65 73 74 t* "setup" "test
5e30: 63 6f 70 79 63 6d 64 22 29 29 29 0a 09 09 09 20 copycmd")))....
5e40: 20 20 28 69 66 20 63 6d 64 0a 09 09 09 20 20 20 (if cmd....
5e50: 20 20 20 20 3b 3b 20 73 75 62 73 74 69 74 75 74 ;; substitut
5e60: 65 20 74 68 65 20 54 45 53 54 5f 53 52 43 5f 50 e the TEST_SRC_P
5e70: 41 54 48 20 61 6e 64 20 54 45 53 54 5f 54 41 52 ATH and TEST_TAR
5e80: 47 5f 50 41 54 48 0a 09 09 09 20 20 20 20 20 20 G_PATH....
5e90: 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 (string-substit
5ea0: 75 74 65 20 22 54 45 53 54 5f 54 41 52 47 5f 50 ute "TEST_TARG_P
5eb0: 41 54 48 22 20 74 65 73 74 2d 70 61 74 68 0a 09 ATH" test-path..
5ec0: 09 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 73 ..... (string-s
5ed0: 75 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f ubstitute "TEST_
5ee0: 53 52 43 5f 50 41 54 48 22 20 74 65 73 74 2d 73 SRC_PATH" test-s
5ef0: 72 63 2d 70 61 74 68 20 63 6d 64 20 23 74 29 20 rc-path cmd #t)
5f00: 23 74 29 0a 09 09 09 20 20 20 20 20 20 20 23 66 #t).... #f
5f10: 29 29 29 0a 09 09 20 28 63 6d 64 20 20 20 20 28 )))... (cmd (
5f20: 69 66 20 6f 76 72 63 6d 64 20 0a 09 09 09 20 20 if ovrcmd ....
5f30: 20 20 20 6f 76 72 63 6d 64 0a 09 09 09 20 20 20 ovrcmd....
5f40: 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d (conc "rsync -
5f50: 61 76 22 20 28 69 66 20 28 64 65 62 75 67 3a 64 av" (if (debug:d
5f60: 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 22 22 20 ebug-mode 1) ""
5f70: 22 71 22 29 20 22 20 22 20 74 65 73 74 2d 73 72 "q") " " test-sr
5f80: 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 73 74 c-path "/ " test
5f90: 2d 70 61 74 68 20 22 2f 22 0a 09 09 09 09 20 20 -path "/".....
5fa0: 20 22 20 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 " >> " test-pat
5fb0: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
5fc0: 67 20 3e 3e 32 20 22 20 74 65 73 74 2d 70 61 74 g >>2 " test-pat
5fd0: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
5fe0: 67 22 29 29 29 0a 09 09 20 28 73 74 61 74 75 73 g")))... (status
5ff0: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a (system cmd))).
6000: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
6010: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))...
6020: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
6030: 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 ERROR: problem w
6040: 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 ith running \""
6050: 63 6d 64 20 22 5c 22 22 29 29 29 0a 09 20 20 28 cmd "\""))).. (
6060: 6c 69 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e list lnkpathf ln
6070: 6b 70 61 74 68 20 29 29 0a 09 28 6c 69 73 74 20 kpath ))..(list
6080: 23 66 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e #f #f))))..;; 1.
6090: 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 look though dis
60a0: 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b ks list for disk
60b0: 20 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 with most space
60c0: 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 .;; 2. create ru
60d0: 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 n dir on disk, p
60e0: 61 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e ath name is mean
60f0: 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 ingful.;; 3. cre
6100: 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 ate link from ru
6110: 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 n dir to megates
6120: 74 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 t runs area .;;
6130: 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 4. remotely run
6140: 74 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f the test on allo
6150: 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 cated host.;;
6160: 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 - could be ssh
6170: 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 to host from hos
6180: 74 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 ts table (update
6190: 20 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 regularly with
61a0: 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f load).;; - co
61b0: 75 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a uld be netbatch.
61c0: 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d ;; (launch-
61d0: 74 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 test db (cadr st
61e0: 61 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 atus) test-conf)
61f0: 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ).(define (launc
6200: 68 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 h-test db run-id
6210: 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f runname test-co
6220: 6e 66 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 nf keyvallst tes
6230: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 t-name test-path
6240: 20 69 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 itemdat params)
6250: 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
6260: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a tory *toppath*).
6270: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
6280: 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 rs ;; consolidat
6290: 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 e this code with
62a0: 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 the code in meg
62b0: 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d atest.scm for "-
62c0: 65 78 65 63 75 74 65 22 0a 20 20 20 28 6c 69 73 execute". (lis
62d0: 74 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 t ;; (list "MT_T
62e0: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
62f0: 6b 2d 61 72 65 61 29 0a 20 20 20 20 28 6c 69 73 k-area). (lis
6300: 74 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 t "MT_RUN_AREA_H
6310: 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a OME" *toppath*).
6320: 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 (list "MT_TE
6330: 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 ST_NAME" test-na
6340: 6d 65 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 me). ;; (list
6350: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
6360: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 (conc itemdat))
6370: 0a 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 . (list "MT_R
6380: 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d UNNAME" runnam
6390: 65 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 e). ;; (list
63a0: 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d "MT_TARGET" m
63b0: 74 5f 74 61 72 67 65 74 29 0a 20 20 20 20 29 29 t_target). ))
63c0: 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 65 73 68 . (let* ((usesh
63d0: 65 6c 6c 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f ell (config-lo
63e0: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
63f0: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
6400: 22 75 73 65 73 68 65 6c 6c 22 29 29 0a 09 20 28 "useshell")).. (
6410: 6c 61 75 6e 63 68 65 72 20 20 20 28 63 6f 6e 66 launcher (conf
6420: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
6430: 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 gdat* "jobtools"
6440: 20 20 20 20 20 22 6c 61 75 6e 63 68 65 72 22 29 "launcher")
6450: 29 0a 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 ).. (runscript
6460: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 (config-lookup t
6470: 65 73 74 2d 63 6f 6e 66 20 20 20 22 73 65 74 75 est-conf "setu
6480: 70 22 20 20 20 20 20 20 20 20 22 72 75 6e 73 63 p" "runsc
6490: 72 69 70 74 22 29 29 0a 09 20 28 65 7a 73 74 65 ript")).. (ezste
64a0: 70 73 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 ps (> (length
64b0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
64c0: 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f /default test-co
64d0: 6e 66 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 nf "ezsteps" '()
64e0: 29 29 20 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 )) 0)) ;; don't
64f0: 73 65 6e 64 20 61 6c 6c 20 74 68 65 20 73 74 65 send all the ste
6500: 70 73 2c 20 63 6f 75 6c 64 20 62 65 20 62 69 67 ps, could be big
6510: 0a 09 20 28 64 69 73 6b 73 70 61 63 65 20 20 28 .. (diskspace (
6520: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 config-lookup te
6530: 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 st-conf "requi
6540: 72 65 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 rements" "disksp
6550: 61 63 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 ace")).. (memory
6560: 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f (config-loo
6570: 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 kup test-conf
6580: 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 "requirements" "
6590: 6d 65 6d 6f 72 79 22 29 29 0a 09 20 28 68 6f 73 memory")).. (hos
65a0: 74 73 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d ts (config-
65b0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
65c0: 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 t* "jobtools"
65d0: 20 20 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a "workhosts")).
65e0: 09 20 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 . (remote-megate
65f0: 73 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 st (config-looku
6600: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
6610: 65 74 75 70 22 20 22 65 78 65 63 75 74 61 62 6c etup" "executabl
6620: 65 22 29 29 0a 09 20 3b 3b 20 46 49 58 4d 45 20 e")).. ;; FIXME
6630: 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 67 6f 6f SOMEDAY: not goo
6640: 64 20 68 6f 77 20 74 68 69 73 20 69 73 20 73 6f d how this is so
6650: 20 6f 62 74 75 73 65 2c 20 74 68 69 73 20 68 61 obtuse, this ha
6660: 63 6b 20 69 73 20 74 6f 20 0a 09 20 3b 3b 20 20 ck is to .. ;;
6670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6c al
6680: 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d low running from
6690: 20 64 61 73 68 62 6f 61 72 64 2e 20 45 78 74 72 dashboard. Extr
66a0: 61 63 74 20 74 68 65 20 70 61 74 68 0a 09 20 3b act the path.. ;
66b0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
66c0: 20 66 72 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 from the called
66d0: 20 6d 65 67 61 74 65 73 74 20 61 6e 64 20 63 6f megatest and co
66e0: 6e 76 65 72 74 20 64 61 73 68 62 6f 61 72 64 0a nvert dashboard.
66f0: 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 . ;;
6700: 20 09 20 20 6f 72 20 64 62 6f 61 72 64 20 74 6f . or dboard to
6710: 20 6d 65 67 61 74 65 73 74 0a 09 20 28 6c 6f 63 megatest.. (loc
6720: 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 28 6c 65 al-megatest (le
6730: 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 20 28 61 t* ((lm (car (a
6740: 72 67 76 29 29 29 0a 09 09 09 09 20 28 64 69 72 rgv)))..... (dir
6750: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
6760: 74 6f 72 79 20 6c 6d 29 29 0a 09 09 09 09 20 28 tory lm))..... (
6770: 65 78 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 exe (pathname-st
6780: 72 69 70 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d rip-directory lm
6790: 29 29 29 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 ))).... (conc
67a0: 20 28 69 66 20 64 69 72 20 28 63 6f 6e 63 20 64 (if dir (conc d
67b0: 69 72 20 22 2f 22 29 20 22 22 29 0a 09 09 09 09 ir "/") "").....
67c0: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
67d0: 3e 73 79 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 >symbol exe)....
67e0: 09 20 20 20 20 28 28 64 62 6f 61 72 64 29 20 20 . ((dboard)
67f0: 20 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 "megatest")...
6800: 09 09 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 .. ((mtest)
6810: 20 20 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 "megatest")..
6820: 09 09 09 20 20 20 20 28 28 64 61 73 68 62 6f 61 ... ((dashboa
6830: 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a rd) "megatest").
6840: 09 09 09 09 20 20 20 20 28 65 6c 73 65 20 65 78 .... (else ex
6850: 65 29 29 29 29 29 0a 09 20 28 74 65 73 74 2d 73 e))))).. (test-s
6860: 69 67 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d ig (conc test-
6870: 6e 61 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c name ":" (item-l
6880: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
6890: 74 29 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 t))) ;; test-pat
68a0: 68 20 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 h is the full pa
68b0: 74 68 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 th including the
68c0: 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f item-path.. (wo
68d0: 72 6b 2d 61 72 65 61 20 20 23 66 29 0a 09 20 28 rk-area #f).. (
68e0: 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 toptest-work-are
68f0: 61 20 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 a #f) ;; for ite
6900: 72 61 74 65 64 20 74 65 73 74 73 20 74 68 65 20 rated tests the
6910: 74 6f 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e top test contain
6920: 73 20 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 s data relevant
6930: 66 6f 72 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 for all.. (diskp
6940: 61 74 68 20 20 20 23 66 29 0a 09 20 28 63 6d 64 ath #f).. (cmd
6950: 70 61 72 6d 73 20 20 20 23 66 29 0a 09 20 28 66 parms #f).. (f
6960: 75 6c 6c 63 6d 64 20 20 20 20 23 66 29 20 3b 3b ullcmd #f) ;;
6970: 20 28 64 65 66 69 6e 65 20 61 20 28 77 69 74 68 (define a (with
6980: 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e -output-to-strin
6990: 67 20 28 6c 61 6d 62 64 61 20 28 29 28 77 72 69 g (lambda ()(wri
69a0: 74 65 20 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 te x)))).. (mt-b
69b0: 69 6e 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 indir-path #f)..
69c0: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 (item-path (ite
69d0: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
69e0: 6d 64 61 74 29 29 0a 09 20 28 74 65 73 74 2d 69 mdat)).. (test-i
69f0: 64 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 d (cdb:remote
6a00: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 -run db:get-test
6a10: 2d 69 64 20 23 66 20 72 75 6e 2d 69 64 20 74 65 -id #f run-id te
6a20: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
6a30: 68 29 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 h)).. (testinfo
6a40: 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d (cdb:get-test-
6a50: 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 info-by-id *runr
6a60: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 emote* test-id))
6a70: 0a 09 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 .. (mt_target (
6a80: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
6a90: 73 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 se (map cadr key
6aa0: 76 61 6c 6c 73 74 29 20 22 2f 22 29 29 0a 09 20 vallst) "/"))..
6ab0: 28 64 65 62 75 67 2d 70 61 72 61 6d 20 28 61 70 (debug-param (ap
6ac0: 70 65 6e 64 20 28 69 66 20 28 61 72 67 73 3a 67 pend (if (args:g
6ad0: 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 et-arg "-debug")
6ae0: 20 20 28 6c 69 73 74 20 22 2d 64 65 62 75 67 22 (list "-debug"
6af0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6b00: 2d 64 65 62 75 67 22 29 29 20 27 28 29 29 0a 09 -debug")) '())..
6b10: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
6b20: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 s:get-arg "-logg
6b30: 69 6e 67 22 29 28 6c 69 73 74 20 22 2d 6c 6f 67 ing")(list "-log
6b40: 67 69 6e 67 22 29 20 27 28 29 29 29 29 29 0a 20 ging") '())))).
6b50: 20 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 (if hosts (se
6b60: 74 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 t! hosts (string
6b70: 2d 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a -split hosts))).
6b80: 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d ;; set the m
6b90: 65 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 egatest to be ca
6ba0: 6c 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f lled on the remo
6bb0: 74 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 te host. (if
6bc0: 28 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 (not remote-mega
6bd0: 74 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 test)(set! remot
6be0: 65 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c e-megatest local
6bf0: 2d 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 -megatest)) ;; "
6c00: 6d 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 megatest")).
6c10: 28 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d (set! mt-bindir-
6c20: 70 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 path (pathname-d
6c30: 69 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d irectory remote-
6c40: 6d 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 megatest)). (
6c50: 69 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 if launcher (set
6c60: 21 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 ! launcher (stri
6c70: 6e 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 ng-split launche
6c80: 72 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 r))). ;; set
6c90: 75 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 up the run work
6ca0: 61 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 area for this te
6cb0: 73 74 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 st. (set! dis
6cc0: 6b 70 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d kpath (get-best-
6cd0: 64 69 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a disk *configdat*
6ce0: 29 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 )). (if diskp
6cf0: 61 74 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 ath..(let ((dat
6d00: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
6d10: 20 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 create-work-are
6d20: 61 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 a db run-id test
6d30: 2d 69 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 -id test-path di
6d40: 73 6b 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 skpath test-name
6d50: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 itemdat))).. (
6d60: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
6d70: 63 61 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 car dat)).. (se
6d80: 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d t! toptest-work-
6d90: 61 72 65 61 20 28 63 61 64 72 20 64 61 74 29 29 area (cadr dat))
6da0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
6db0: 2d 69 6e 66 6f 20 32 20 22 55 73 69 6e 67 20 77 -info 2 "Using w
6dc0: 6f 72 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d ork area " work-
6dd0: 61 72 65 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 area))..(begin..
6de0: 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
6df0: 61 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 a (conc test-pat
6e00: 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 h "/tmp_run"))..
6e10: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
6e20: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 ory work-area #t
6e30: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
6e40: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f t 0 "WARNING: No
6e50: 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 disk work area
6e60: 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 6e 6e specified - runn
6e70: 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 74 20 ing in the test
6e80: 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 72 20 directory under
6e90: 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 tmp_run"))).
6ea0: 28 73 65 74 21 20 63 6d 64 70 61 72 6d 73 20 28 (set! cmdparms (
6eb0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e base64:base64-en
6ec0: 63 6f 64 65 20 0a 09 09 20 20 20 20 28 77 69 74 code ... (wit
6ed0: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 h-output-to-stri
6ee0: 6e 67 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 ng... (lamb
6ef0: 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 da () ;; (list '
6f00: 68 6f 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 hosts hosts)
6f10: 0a 09 09 09 28 77 72 69 74 65 20 28 6c 69 73 74 ....(write (list
6f20: 20 28 6c 69 73 74 20 27 74 65 73 74 70 61 74 68 (list 'testpath
6f30: 20 20 74 65 73 74 2d 70 61 74 68 29 0a 09 09 09 test-path)....
6f40: 09 20 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 27 . ;; (list '
6f50: 72 75 6e 72 65 6d 6f 74 65 20 2a 72 75 6e 72 65 runremote *runre
6f60: 6d 6f 74 65 2a 29 0a 09 09 09 09 20 20 20 20 20 mote*).....
6f70: 28 6c 69 73 74 20 27 74 72 61 6e 73 70 6f 72 74 (list 'transport
6f80: 20 28 63 6f 6e 63 20 2a 74 72 61 6e 73 70 6f 72 (conc *transpor
6f90: 74 2d 74 79 70 65 2a 29 29 0a 09 09 09 09 20 20 t-type*)).....
6fa0: 20 20 20 28 6c 69 73 74 20 27 73 65 72 76 65 72 (list 'server
6fb0: 69 6e 66 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f inf *server-info
6fc0: 2a 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 *)..... (lis
6fd0: 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f t 'toppath *to
6fe0: 70 70 61 74 68 2a 29 0a 09 09 09 09 20 20 20 20 ppath*).....
6ff0: 20 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 (list 'work-are
7000: 61 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 a work-area)....
7010: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 . (list 'tes
7020: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 t-name test-name
7030: 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 ) ..... (lis
7040: 74 20 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e t 'runscript run
7050: 73 63 72 69 70 74 29 20 0a 09 09 09 09 20 20 20 script) .....
7060: 20 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 (list 'run-id
7070: 20 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 run-id )...
7080: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 .. (list 'te
7090: 73 74 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 st-id test-id
70a0: 20 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 )..... (lis
70b0: 74 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 t 'itemdat ite
70c0: 6d 64 61 74 20 20 29 0a 09 09 09 09 20 20 20 20 mdat ).....
70d0: 20 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 (list 'megatest
70e0: 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 remote-megates
70f0: 74 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 t)..... (lis
7100: 74 20 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 t 'ezsteps ezs
7110: 74 65 70 73 29 20 0a 09 09 09 09 20 20 20 20 20 teps) .....
7120: 28 6c 69 73 74 20 27 74 61 72 67 65 74 20 20 20 (list 'target
7130: 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 mt_target).....
7140: 20 20 20 20 20 28 6c 69 73 74 20 27 65 6e 76 2d (list 'env-
7150: 6f 76 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c ovrd (hash-tabl
7160: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
7170: 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f onfigdat* "env-o
7180: 76 65 72 72 69 64 65 22 20 27 28 29 29 29 20 0a verride" '())) .
7190: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
71a0: 73 65 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 set-vars (if pa
71b0: 72 61 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 rams (hash-table
71c0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 -ref/default par
71d0: 61 6d 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 ams "-setvars" #
71e0: 66 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c f)))..... (l
71f0: 69 73 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 ist 'runname r
7200: 75 6e 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 unname).....
7210: 20 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 (list 'mt-bindi
7220: 72 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 r-path mt-bindir
7230: 2d 70 61 74 68 29 29 29 29 29 29 29 20 3b 3b 20 -path))))))) ;;
7240: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7250: 72 73 65 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 rse keyvallst "
7260: 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 6c 65 ")))). ;; cle
7270: 61 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f an out step reco
7280: 72 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 rds from previou
7290: 73 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 s run if they ex
72a0: 69 73 74 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 ist. ;; (debu
72b0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 g:print-info 4 "
72c0: 46 49 58 4d 45 45 45 45 45 21 21 21 21 20 54 68 FIXMEEEEE!!!! Th
72d0: 69 73 20 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 is can be remove
72e0: 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 d some day, perh
72f0: 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 aps move all tes
7300: 74 20 72 65 63 6f 72 64 73 20 74 6f 20 74 68 65 t records to the
7310: 20 74 65 73 74 20 64 62 3f 22 29 0a 20 20 20 20 test db?").
7320: 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ;; (open-run-clo
7330: 73 65 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 se db:delete-tes
7340: 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 t-step-records d
7350: 62 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 28 b test-id). (
7360: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
7370: 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b 20 73 work-area) ;; s
7380: 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 o that log files
7390: 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 from the launch
73a0: 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 process don't c
73b0: 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 74 20 lutter the test
73c0: 64 69 72 0a 20 20 20 20 28 74 65 73 74 73 3a 74 dir. (tests:t
73d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
73e0: 74 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 test-id "LAUNCHE
73f0: 44 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 D" "n/a" #f #f)
7400: 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 ;; (if launch-re
7410: 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 sults launch-res
7420: 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a ults "FAILED")).
7430: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 (cond. (
7440: 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f (and launcher ho
7450: 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 sts) ;; must be
7460: 75 73 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 using ssh hostna
7470: 6d 65 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 me. (set! f
7480: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c ullcmd (append l
7490: 61 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 auncher (car hos
74a0: 74 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d ts)(list remote-
74b0: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
74c0: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
74d0: 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 parms) debug-par
74e0: 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 am))). ;; (s
74f0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
7500: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 end launcher (ca
7510: 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 r hosts)(list re
7520: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
7530: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
7540: 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 " cmdparms)))).
7550: 20 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 (launcher.
7560: 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d (set! fullcm
7570: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
7580: 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d er (list remote-
7590: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
75a0: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
75b0: 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 parms) debug-par
75c0: 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 am))). ;; (s
75d0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
75e0: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 end launcher (li
75f0: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
7600: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
7610: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
7620: 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 ))). (else.
7630: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 (if (not us
7640: 65 73 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 eshell)(debug:pr
7650: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
7660: 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 internal launchi
7670: 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b ng will not work
7680: 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 well without \"
7690: 75 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 useshell yes\" i
76a0: 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 n your [jobtools
76b0: 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 ] section")).
76c0: 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
76d0: 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 (append (list r
76e0: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
76f0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
7700: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
7710: 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 ug-param (list (
7720: 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 if useshell "&"
7730: 22 22 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 "")))))). ;;
7740: 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c (set! fullcmd (l
7750: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
7760: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
7770: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
7780: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 (if useshell "&
7790: 22 20 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 " ""))))). (i
77a0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
77b0: 22 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 "-xterm")(set! f
77c0: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 ullcmd (append f
77d0: 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 ullcmd (list "-x
77e0: 74 65 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 term")))). (d
77f0: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 ebug:print 1 "La
7800: 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 unching " work-a
7810: 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 rea). ;; set
7820: 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 pre-launch-env-v
7830: 61 72 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 ars before launc
7840: 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 hing, keep the v
7850: 61 72 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 ars in prevvals
7860: 61 6e 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 and put the envi
7870: 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e onment back when
7880: 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 done. (debug
7890: 3a 70 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d :print 4 "fullcm
78a0: 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 d: " fullcmd).
78b0: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e (let* ((common
78c0: 70 72 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d prevvals (alist-
78d0: 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 >env-vars....
78e0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
78f0: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
7900: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
7910: 64 65 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 de" '()))).. (
7920: 74 65 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 testprevvals (
7930: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a alist->env-vars.
7940: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
7950: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
7960: 65 73 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 est-conf "pre-la
7970: 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 unch-env-overrid
7980: 65 73 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 es" '()))).. (
7990: 6d 69 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 miscprevvals (
79a0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
79b0: 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 ;; consolidate t
79c0: 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 his code with th
79d0: 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 e code in megate
79e0: 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 st.scm for "-exe
79f0: 63 75 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 cute".... (ap
7a00: 70 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 pend (list (list
7a10: 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 "MT_TEST_RUN_DI
7a20: 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 R" work-area)...
7a30: 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 ... (list "MT_T
7a40: 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e EST_NAME" test-n
7a50: 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 ame)...... (lis
7a60: 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 t "MT_ITEM_INFO"
7a70: 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 (conc itemdat))
7a80: 20 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 ...... (list "
7a90: 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
7aa0: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c nname)...... (l
7ab0: 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 ist "MT_TARGET"
7ac0: 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 mt_target)...
7ad0: 09 09 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 ... )..... i
7ae0: 74 65 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c temdat))).. (l
7af0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 aunch-results (a
7b00: 70 70 6c 79 20 28 69 66 20 28 65 71 75 61 6c 3f pply (if (equal?
7b10: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
7b20: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
7b30: 74 75 70 22 20 22 6c 61 75 6e 63 68 77 61 69 74 tup" "launchwait
7b40: 22 29 20 22 79 65 73 22 29 0a 09 09 09 09 20 20 ") "yes").....
7b50: 20 20 20 20 63 6d 64 2d 72 75 6e 2d 77 69 74 68 cmd-run-with
7b60: 2d 73 74 64 65 72 72 2d 3e 6c 69 73 74 0a 09 09 -stderr->list...
7b70: 09 09 20 20 20 20 20 20 70 72 6f 63 65 73 73 2d .. process-
7b80: 72 75 6e 29 0a 09 09 09 09 20 20 28 69 66 20 75 run)..... (if u
7b90: 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 seshell.....
7ba0: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
7bb0: 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 perse fullcmd "
7bc0: 22 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 ")..... (ca
7bd0: 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 r fullcmd)).....
7be0: 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 (if useshell..
7bf0: 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 ... '()....
7c00: 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c . (cdr full
7c10: 63 6d 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 cmd))))). (
7c20: 69 66 20 28 6c 69 73 74 3f 20 6c 61 75 6e 63 68 if (list? launch
7c30: 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 28 77 69 -results).. (wi
7c40: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
7c50: 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 e "mt_launch.log
7c60: 22 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ".. (lambda (
7c70: 29 0a 09 20 20 20 20 20 20 28 61 70 70 6c 79 20 ).. (apply
7c80: 70 72 69 6e 74 20 6c 61 75 6e 63 68 2d 72 65 73 print launch-res
7c90: 75 6c 74 73 29 29 0a 09 20 20 20 20 23 3a 61 70 ults)).. #:ap
7ca0: 70 65 6e 64 29 29 0a 20 20 20 20 20 20 28 64 65 pend)). (de
7cb0: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 bug:print 2 "Lau
7cc0: 6e 63 68 69 6e 67 20 63 6f 6d 70 6c 65 74 65 64 nching completed
7cd0: 2c 20 75 70 64 61 74 69 6e 67 20 64 62 22 29 0a , updating db").
7ce0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
7cf0: 6e 74 20 32 20 22 4c 61 75 6e 63 68 20 72 65 73 nt 2 "Launch res
7d00: 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 68 2d 72 ults: " launch-r
7d10: 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 28 69 esults). (i
7d20: 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 65 f (not launch-re
7d30: 73 75 6c 74 73 29 0a 20 20 20 20 20 20 20 20 20 sults).
7d40: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
7d50: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
7d60: 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 72 75 6e R: Failed to run
7d70: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
7d80: 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 sperse fullcmd "
7d90: 20 22 29 20 22 2c 20 65 78 69 74 69 6e 67 20 6e ") ", exiting n
7da0: 6f 77 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ow").
7db0: 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ;; (sqlite3:fin
7dc0: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 alize! db).
7dd0: 20 20 20 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f ;; good o
7de0: 6c 65 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 le "exit" seems
7df0: 6e 6f 74 20 74 6f 20 77 6f 72 6b 0a 20 20 20 20 not to work.
7e00: 20 20 20 20 20 20 20 20 3b 3b 20 28 5f 65 78 69 ;; (_exi
7e10: 74 20 39 29 0a 20 20 20 20 20 20 20 20 20 20 20 t 9).
7e20: 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
7e30: 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
7e40: 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
7e50: 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
7e60: 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 20 20 en email list.
7e70: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 42 2f ;; NB/
7e80: 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c 6c 20 / Is this still
7e90: 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 62 needed? Should b
7ea0: 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 61 63 e safe to go bac
7eb0: 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 3f k to "exit" now?
7ec0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 . (pr
7ed0: 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 ocess-signal (cu
7ee0: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
7ef0: 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 20 ) signal/kill).
7f00: 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 )).
7f10: 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d (alist->env-
7f20: 76 61 72 73 20 6d 69 73 63 70 72 65 76 76 61 6c vars miscprevval
7f30: 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d s). (alist-
7f40: 3e 65 6e 76 2d 76 61 72 73 20 74 65 73 74 70 72 >env-vars testpr
7f50: 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 61 evvals). (a
7f60: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 63 list->env-vars c
7f70: 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 0a 20 ommonprevvals).
7f80: 20 20 20 20 20 6c 61 75 6e 63 68 2d 72 65 73 75 launch-resu
7f90: 6c 74 73 29 29 0a 20 20 28 63 68 61 6e 67 65 2d lts)). (change-
7fa0: 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 directory *toppa
7fb0: 74 68 2a 29 29 0a 0a th*))..