Artifact
63a202fc1df9bb5a0946c725333116cbbd8aa37c
File
launch.scm
— part of check-in
[1a3dcbdc46]
at
2013-03-04 23:30:30
on branch network-only-transport
— zmq running ok on Ubuntu
(user:
matt
size: 31149)
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 3b 3b 20 69 66 20 68 61 6e 64 65 64 20 61 20 .;; if handed a
05d0: 73 74 72 69 6e 67 2c 20 70 72 6f 63 65 73 73 20 string, process
05e0: 69 74 2c 20 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f it, else look fo
05f0: 72 20 4d 54 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 r MT_CMDINFO.(de
0600: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 fine (launch:get
0610: 2d 63 6d 64 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c -cmdinfo-assoc-l
0620: 69 73 74 20 23 21 6b 65 79 20 28 65 6e 63 6f 64 ist #!key (encod
0630: 65 64 2d 63 6d 64 20 23 66 29 29 0a 20 20 28 6c ed-cmd #f)). (l
0640: 65 74 20 28 28 65 6e 63 63 6d 64 20 28 69 66 20 et ((enccmd (if
0650: 65 6e 63 6f 64 65 64 2d 63 6d 64 20 65 6e 63 6f encoded-cmd enco
0660: 64 65 64 2d 63 6d 64 20 28 67 65 74 65 6e 76 20 ded-cmd (getenv
0670: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
0680: 0a 20 20 20 20 28 69 66 20 65 6e 63 63 64 6d 0a . (if enccdm.
0690: 09 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 .(read (open-inp
06a0: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
06b0: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
06c0: 65 6e 63 63 6d 64 29 29 29 0a 09 27 28 29 29 29 enccmd)))..'()))
06d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
06e0: 63 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 ch:execute encod
06f0: 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ed-cmd). (let*
0700: 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 ((cmdinfo (rea
0710: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
0720: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
0730: 65 36 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 e64-decode encod
0740: 65 64 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 ed-cmd))))).
0750: 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (setenv "MT_CMDI
0760: 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 NFO" encoded-cmd
0770: 29 0a 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f ). (if (list?
0780: 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 cmdinfo) ;; ((t
0790: 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 estpath /tmp/mrw
07a0: 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 ellan/jazzmind/s
07b0: 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 rc/example_run/t
07c0: 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 ests/sqlitespeed
07d0: 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e 61 6d 65 )..;; (test-name
07e0: 20 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 72 sqlitespeed) (r
07f0: 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
0800: 70 74 2e 72 62 29 20 28 64 62 2d 68 6f 73 74 20 pt.rb) (db-host
0810: 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d localhost) (run-
0820: 69 64 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 id 1))..(let* ((
0830: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
0840: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
0850: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b th cmdinfo)) ;
0860: 3b 20 48 6f 77 20 69 73 20 74 65 73 74 70 61 74 ; How is testpat
0870: 68 20 64 69 66 66 65 72 65 6e 74 20 66 72 6f 6d h different from
0880: 20 77 6f 72 6b 2d 61 72 65 61 20 3f 3f 0a 09 20 work-area ??..
0890: 20 20 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 (top-path
08a0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
08b0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
08c0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f fo)).. (wo
08d0: 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
08e0: 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
08f0: 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
0900: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
0910: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0920: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
0930: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
0940: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
0950: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
0960: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
0970: 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 73 (ezsteps (as
0980: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a 73 soc/default 'ezs
0990: 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 29 teps cmdinfo))
09a0: 0a 09 20 20 20 20 20 20 20 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 72 75 6e 2d 69 ).. (run-i
0a20: 64 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 d (assoc/defa
0a30: 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 ult 'run-id c
0a40: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0a50: 20 28 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 (test-id (ass
0a60: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 oc/default 'test
0a70: 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a -id cmdinfo)).
0a80: 09 20 20 20 20 20 20 20 28 74 61 72 67 65 74 20 . (target
0a90: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0aa0: 74 20 27 74 61 72 67 65 74 20 20 20 20 63 6d 64 t 'target cmd
0ab0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0ac0: 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 itemdat (assoc
0ad0: 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 /default 'itemda
0ae0: 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 t cmdinfo))..
0af0: 20 20 20 20 20 20 28 65 6e 76 2d 6f 76 72 64 20 (env-ovrd
0b00: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0b10: 27 65 6e 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 'env-ovrd cmdin
0b20: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 fo)).. (se
0b30: 74 2d 76 61 72 73 20 20 28 61 73 73 6f 63 2f 64 t-vars (assoc/d
0b40: 65 66 61 75 6c 74 20 27 73 65 74 2d 76 61 72 73 efault 'set-vars
0b50: 20 20 63 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 70 cmdinfo)) ;; p
0b60: 72 65 2d 6f 76 65 72 72 69 64 65 73 20 66 72 6f re-overrides fro
0b70: 6d 20 2d 73 65 74 76 61 72 0a 09 20 20 20 20 20 m -setvar..
0b80: 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 61 73 (runname (as
0b90: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
0ba0: 6e 61 6d 65 20 20 20 63 6d 64 69 6e 66 6f 29 29 name cmdinfo))
0bb0: 0a 09 20 20 20 20 20 20 20 28 6d 65 67 61 74 65 .. (megate
0bc0: 73 74 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 st (assoc/defau
0bd0: 6c 74 20 27 6d 65 67 61 74 65 73 74 20 20 63 6d lt 'megatest cm
0be0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
0bf0: 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 (mt-bindir-path
0c00: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0c10: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 mt-bindir-path c
0c20: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0c30: 20 28 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a (keys #f).
0c40: 09 20 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 . (keyvals
0c50: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
0c60: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 fullrunscript (i
0c70: 66 20 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 f (not runscript
0c80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 #f.
0cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cc0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 75 (if (su
0cd0: 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f bstring-index "/
0ce0: 22 20 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 " 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 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 runscript ;;
0d20: 75 73 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 use unadultered
0d30: 69 66 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 if contains slas
0d40: 68 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 hes.
0d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d60: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
0d70: 28 66 75 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 (fulln (conc tes
0d80: 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 tpath "/" runscr
0d90: 69 70 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 ipt)))..
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0db0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 (if (a
0dc0: 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f nd (file-exists?
0dd0: 20 66 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 fulln).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e00: 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 (file
0e10: 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f -execute-access?
0e20: 20 66 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 fulln)).
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e50: 20 20 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 fulln.
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
0e90: 72 69 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 ript))))) ;; ass
0ea0: 75 6d 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 ume it is on the
0eb0: 20 70 61 74 68 0a 09 20 20 20 20 20 20 20 28 72 path.. (r
0ec0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 ollup-status 0))
0ed0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
0ee0: 20 32 20 22 45 78 65 63 74 75 69 6e 67 20 22 20 2 "Exectuing "
0ef0: 74 65 73 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a test-name " (id:
0f00: 20 22 20 74 65 73 74 2d 69 64 20 22 29 20 6f 6e " test-id ") on
0f10: 20 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d " (get-host-nam
0f20: 65 29 29 0a 09 20 20 3b 3b 20 53 65 74 75 70 20 e)).. ;; Setup
0f30: 74 68 65 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 the *runremote*
0f40: 67 6c 6f 62 61 6c 20 76 61 72 0a 09 20 20 28 69 global var.. (i
0f50: 66 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 64 f *runremote* (d
0f60: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 ebug:print 2 "ER
0f70: 52 4f 52 3a 20 49 27 6d 20 6e 6f 74 20 65 78 70 ROR: I'm not exp
0f80: 65 63 74 69 6e 67 20 2a 72 75 6e 72 65 6d 6f 74 ecting *runremot
0f90: 65 2a 20 74 6f 20 62 65 20 73 65 74 20 61 74 20 e* to be set at
0fa0: 74 68 69 73 20 74 69 6d 65 22 29 29 0a 09 20 20 this time"))..
0fb0: 3b 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d ;; (set! *runrem
0fc0: 6f 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a ote* runremote).
0fd0: 09 20 20 28 73 65 74 21 20 2a 74 72 61 6e 73 70 . (set! *transp
0fe0: 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 69 6e ort-type* (strin
0ff0: 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 g->symbol transp
1000: 6f 72 74 29 29 0a 09 20 20 28 73 65 74 21 20 6b ort)).. (set! k
1010: 65 79 73 20 20 20 20 20 20 20 28 63 64 62 3a 72 eys (cdb:r
1020: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
1030: 2d 6b 65 79 73 20 23 66 29 29 0a 09 20 20 28 73 -keys #f)).. (s
1040: 65 74 21 20 6b 65 79 76 61 6c 73 20 20 20 20 28 et! keyvals (
1050: 69 66 20 72 75 6e 2d 69 64 20 28 63 64 62 3a 72 if run-id (cdb:r
1060: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
1070: 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 72 75 6e -key-vals #f run
1080: 2d 69 64 29 20 23 66 29 29 0a 09 20 20 3b 3b 20 -id) #f)).. ;;
1090: 61 70 70 6c 79 20 70 72 65 2d 6f 76 65 72 72 69 apply pre-overri
10a0: 64 65 73 20 62 65 66 6f 72 65 20 6f 74 68 65 72 des before other
10b0: 20 76 61 72 69 61 62 6c 65 73 2e 20 54 68 65 20 variables. The
10c0: 70 72 65 2d 6f 76 65 72 72 69 64 65 20 76 61 72 pre-override var
10d0: 73 20 6d 75 73 74 20 6e 6f 74 0a 09 20 20 3b 3b s must not.. ;;
10e0: 20 63 6c 6f 62 62 65 72 73 20 74 68 69 6e 67 73 clobbers things
10f0: 20 66 72 6f 6d 20 74 68 65 20 6f 66 66 69 63 69 from the offici
1100: 61 6c 20 73 6f 75 72 63 65 73 20 73 75 63 68 20 al sources such
1110: 61 73 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 as megatest.conf
1120: 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 ig and runconfig
1130: 73 2e 63 6f 6e 66 69 67 0a 09 20 20 28 69 66 20 s.config.. (if
1140: 28 73 74 72 69 6e 67 3f 20 73 65 74 2d 76 61 72 (string? set-var
1150: 73 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 28 s).. (let (
1160: 28 76 61 72 70 61 69 72 73 20 28 73 74 72 69 6e (varpairs (strin
1170: 67 2d 73 70 6c 69 74 20 73 65 74 2d 76 61 72 73 g-split set-vars
1180: 20 22 2c 22 29 29 29 0a 09 09 28 64 65 62 75 67 ",")))...(debug
1190: 3a 70 72 69 6e 74 20 34 20 22 76 61 72 70 61 69 :print 4 "varpai
11a0: 72 73 3a 20 22 20 76 61 72 70 61 69 72 73 29 0a rs: " varpairs).
11b0: 09 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 ..(map (lambda (
11c0: 76 61 72 70 61 69 72 29 0a 09 09 20 20 20 20 20 varpair)...
11d0: 20 20 28 6c 65 74 20 28 28 76 61 72 76 61 6c 20 (let ((varval
11e0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 (string-split va
11f0: 72 70 61 69 72 20 22 3d 22 29 29 29 0a 09 09 09 rpair "=")))....
1200: 20 28 69 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 (if (eq? (lengt
1210: 68 20 76 61 72 76 61 6c 29 20 32 29 0a 09 09 09 h varval) 2)....
1220: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 (let ((var
1230: 28 63 61 72 20 76 61 72 76 61 6c 29 29 0a 09 09 (car varval))...
1240: 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 .. (val (cadr
1250: 76 61 72 76 61 6c 29 29 29 0a 09 09 09 20 20 20 varval)))....
1260: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1270: 20 31 20 22 41 64 64 69 6e 67 20 70 72 65 2d 76 1 "Adding pre-v
1280: 61 72 2f 76 61 6c 20 22 20 76 61 72 20 22 20 3d ar/val " var " =
1290: 20 22 20 76 61 6c 20 22 20 74 6f 20 74 68 65 20 " val " to the
12a0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 09 environment")...
12b0: 09 20 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 . (setenv
12c0: 76 61 72 20 76 61 6c 29 29 29 29 29 0a 09 09 20 var val)))))...
12d0: 20 20 20 20 76 61 72 70 61 69 72 73 29 29 29 0a varpairs))).
12e0: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 . (setenv "MT_T
12f0: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
1300: 6b 2d 61 72 65 61 29 0a 09 20 20 28 73 65 74 65 k-area).. (sete
1310: 6e 76 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 nv "MT_TEST_NAME
1320: 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 " test-name)..
1330: 28 73 65 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d (setenv "MT_ITEM
1340: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
1350: 6d 64 61 74 29 29 0a 09 20 20 28 73 65 74 65 6e mdat)).. (seten
1360: 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 v "MT_RUNNAME"
1370: 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 28 73 65 runname).. (se
1380: 74 65 6e 76 20 22 4d 54 5f 4d 45 47 41 54 45 53 tenv "MT_MEGATES
1390: 54 22 20 20 6d 65 67 61 74 65 73 74 29 0a 09 20 T" megatest)..
13a0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 (setenv "MT_TAR
13b0: 47 45 54 22 20 20 20 20 74 61 72 67 65 74 29 0a GET" target).
13c0: 09 20 20 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 . (if mt-bindir
13d0: 2d 70 61 74 68 20 28 73 65 74 65 6e 76 20 22 50 -path (setenv "P
13e0: 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 65 ATH" (conc (gete
13f0: 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 20 6d nv "PATH") ":" m
1400: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 t-bindir-path)))
1410: 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
1420: 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a ctory top-path).
1430: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
1440: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
1450: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
1460: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
1470: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
1480: 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 iting") ...;; (s
1490: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
14a0: 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 db)...;; (sqlit
14b0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
14c0: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
14d0: 20 20 3b 3b 20 43 61 6e 20 73 65 74 75 70 20 61 ;; Can setup a
14e0: 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 s client for ser
14f0: 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 ver mode now..
1500: 3b 3b 20 28 73 65 72 76 65 72 3a 63 6c 69 65 6e ;; (server:clien
1510: 74 2d 73 65 74 75 70 29 0a 0a 09 20 20 28 63 68 t-setup)... (ch
1520: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a ange-directory *
1530: 74 6f 70 70 61 74 68 2a 29 20 0a 09 20 20 28 73 toppath*) .. (s
1540: 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d et-megatest-env-
1550: 76 61 72 73 20 72 75 6e 2d 69 64 29 20 3b 3b 20 vars run-id) ;;
1560: 74 68 65 73 65 20 6d 61 79 20 62 65 20 6e 65 65 these may be nee
1570: 64 65 64 20 62 79 20 74 68 65 20 6c 61 75 6e 63 ded by the launc
1580: 68 69 6e 67 20 70 72 6f 63 65 73 73 0a 09 20 20 hing process..
1590: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
15a0: 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 0a 0a 09 y work-area) ...
15b0: 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 (open-run-clos
15c0: 65 20 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 e set-run-config
15d0: 2d 76 61 72 73 20 23 66 20 72 75 6e 2d 69 64 20 -vars #f run-id
15e0: 6b 65 79 73 20 6b 65 79 76 61 6c 73 29 0a 09 20 keys keyvals)..
15f0: 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 ;; environment
1600: 6f 76 65 72 72 69 64 65 73 20 61 72 65 20 64 6f overrides are do
1610: 6e 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 ne *before* the
1620: 72 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 remaining critic
1630: 61 6c 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 61 al envars... (a
1640: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 list->env-vars e
1650: 6e 76 2d 6f 76 72 64 29 0a 09 20 20 28 73 65 74 nv-ovrd).. (set
1660: 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 -megatest-env-va
1670: 72 73 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 73 rs run-id).. (s
1680: 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 et-item-env-vars
1690: 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 73 61 itemdat).. (sa
16a0: 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 ve-environment-a
16b0: 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 65 73 s-files "megates
16c0: 74 22 29 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e t").. (open-run
16d0: 2d 63 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 2d -close test-set-
16e0: 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 meta-info #f tes
16f0: 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 t-id run-id test
1700: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 30 29 -name itemdat 0)
1710: 0a 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d .. (tests:test-
1720: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test
1730: 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 -id "REMOTEHOSTS
1740: 54 41 52 54 22 20 22 6e 2f 61 22 20 28 61 72 67 TART" "n/a" (arg
1750: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 s:get-arg "-m")
1760: 23 66 29 0a 09 20 20 28 69 66 20 28 61 72 67 73 #f).. (if (args
1770: 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d :get-arg "-xterm
1780: 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 ").. (set!
1790: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 78 fullrunscript "x
17a0: 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 28 69 term").. (i
17b0: 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e 73 63 f (and fullrunsc
17c0: 72 69 70 74 20 28 6e 6f 74 20 28 66 69 6c 65 2d ript (not (file-
17d0: 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 execute-access?
17e0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
17f0: 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f ... (system (co
1800: 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 nc "chmod ug+x "
1810: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
1820: 29 29 0a 09 20 20 3b 3b 20 57 65 20 61 72 65 20 )).. ;; We are
1830: 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c 6c about to actuall
1840: 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 74 y kick off the t
1850: 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 68 69 est.. ;; so thi
1860: 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 s is a good plac
1870: 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 e to remove the
1880: 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 20 20 records for ..
1890: 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 73 20 ;; any previous
18a0: 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 3a 74 runs.. ;; (db:t
18b0: 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 73 est-remove-steps
18c0: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db run-id testn
18d0: 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 20 ame itemdat)..
18e0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 20 .. (let* ((m
18f0: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d (make-m
1900: 75 74 65 78 29 29 0a 09 09 20 28 6b 69 6c 6c 2d utex))... (kill-
1910: 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 20 28 job? #f)... (
1920: 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 76 65 exit-info (ve
1930: 63 74 6f 72 20 23 74 20 23 74 20 23 74 29 29 0a ctor #t #t #t)).
1940: 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 20 20 .. (job-thread
1950: 20 23 66 29 0a 09 09 20 28 72 75 6e 69 74 20 20 #f)... (runit
1960: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
1970: 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d 76 61 ..... ;; (let-va
1980: 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 28 28 lues..... ;; ((
1990: 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 75 73 (pid exit-status
19a0: 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 exit-code).....
19b0: 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 ;; (run-n-wa
19c0: 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 it fullrunscript
19d0: 29 29 29 0a 09 09 09 09 20 28 74 65 73 74 73 3a )))..... (tests:
19e0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
19f0: 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e test-id "RUNNIN
1a00: 47 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 0a G" "n/a" #f #f).
1a10: 09 09 09 09 20 3b 3b 20 69 66 20 74 68 65 72 65 .... ;; if there
1a20: 20 69 73 20 61 20 72 75 6e 73 63 72 69 70 74 20 is a runscript
1a30: 64 6f 20 69 74 20 66 69 72 73 74 0a 09 09 09 09 do it first.....
1a40: 20 28 69 66 20 66 75 6c 6c 72 75 6e 73 63 72 69 (if fullrunscri
1a50: 70 74 0a 09 09 09 09 20 20 20 20 20 28 6c 65 74 pt..... (let
1a60: 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d ((pid (process-
1a70: 72 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 run fullrunscrip
1a80: 74 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 t))).....
1a90: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 (let loop ((i 0)
1aa0: 29 0a 09 09 09 09 09 20 28 6c 65 74 2d 76 61 6c )...... (let-val
1ab0: 75 65 73 0a 09 09 09 09 09 20 20 28 28 28 70 69 ues...... (((pi
1ac0: 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 d-val exit-statu
1ad0: 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 s exit-code) (pr
1ae0: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
1af0: 74 29 29 29 0a 09 09 09 09 09 20 20 28 6d 75 74 t)))...... (mut
1b00: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 ex-lock! m).....
1b10: 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
1b20: 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 exit-info 0 pid)
1b30: 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d ...... (vector-
1b40: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 set! exit-info 1
1b50: 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 exit-status)...
1b60: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
1b70: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
1b80: 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 20 20 it-code)......
1b90: 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 (set! rollup-sta
1ba0: 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20 0a tus exit-code) .
1bb0: 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d 75 6e ..... (mutex-un
1bc0: 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 lock! m)......
1bd0: 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c (if (eq? pid-val
1be0: 20 30 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 0)...... (
1bf0: 62 65 67 69 6e 0a 09 09 09 09 09 09 28 74 68 72 begin.......(thr
1c00: 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 ead-sleep! 2)...
1c10: 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 20 31 ....(loop (+ i 1
1c20: 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 29 )))...... )
1c30: 29 29 29 29 0a 09 09 09 09 20 3b 3b 20 74 68 65 ))))..... ;; the
1c40: 6e 2c 20 69 66 20 72 75 6e 73 63 72 69 70 74 20 n, if runscript
1c50: 72 61 6e 20 6f 6b 20 28 6f 72 20 64 69 64 20 6e ran ok (or did n
1c60: 6f 74 20 67 65 74 20 63 61 6c 6c 65 64 29 0a 09 ot get called)..
1c70: 09 09 09 20 3b 3b 20 64 6f 20 61 6c 6c 20 74 68 ... ;; do all th
1c80: 65 20 65 7a 73 74 65 70 73 20 28 69 66 20 61 6e e ezsteps (if an
1c90: 79 29 0a 09 09 09 09 20 28 69 66 20 65 7a 73 74 y)..... (if ezst
1ca0: 65 70 73 0a 09 09 09 09 20 20 20 20 20 28 6c 65 eps..... (le
1cb0: 74 2a 20 28 28 74 65 73 74 63 6f 6e 66 69 67 20 t* ((testconfig
1cc0: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f (read-config (co
1cd0: 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f 74 nc work-area "/t
1ce0: 65 73 74 63 6f 6e 66 69 67 22 29 20 23 66 20 23 estconfig") #f #
1cf0: 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 t environ-patt:
1d00: 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d "pre-launch-env-
1d10: 76 61 72 73 22 29 29 20 3b 3b 20 46 49 58 4d 45 vars")) ;; FIXME
1d20: 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 2d 73 79 73 ??? is allow-sys
1d30: 74 65 6d 20 6f 6b 20 68 65 72 65 3f 0a 09 09 09 tem ok here?....
1d40: 09 09 20 20 20 20 28 65 7a 73 74 65 70 73 6c 73 .. (ezstepsls
1d50: 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
1d60: 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 63 6f f/default testco
1d70: 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 20 27 nfig "ezsteps" '
1d80: 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 ()))).....
1d90: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file-
1da0: 65 78 69 73 74 73 3f 20 22 2e 65 7a 73 74 65 70 exists? ".ezstep
1db0: 73 22 29 29 28 63 72 65 61 74 65 2d 64 69 72 65 s"))(create-dire
1dc0: 63 74 6f 72 79 20 22 2e 65 7a 73 74 65 70 73 22 ctory ".ezsteps"
1dd0: 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b ))..... ;;
1de0: 20 69 66 20 65 7a 73 74 65 70 73 20 77 61 73 20 if ezsteps was
1df0: 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 65 20 defined then we
1e00: 61 72 65 20 73 75 72 65 20 74 6f 20 68 61 76 65 are sure to have
1e10: 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 73 74 at least one st
1e20: 65 70 20 62 75 74 20 63 68 65 63 6b 20 61 6e 79 ep but check any
1e30: 77 61 79 0a 09 09 09 09 20 20 20 20 20 20 20 28 way..... (
1e40: 69 66 20 28 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 if (not (> (leng
1e50: 74 68 20 65 7a 73 74 65 70 73 6c 73 74 29 20 30 th ezstepslst) 0
1e60: 29 29 0a 09 09 09 09 09 20 20 20 28 64 65 62 75 ))...... (debu
1e70: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
1e80: 3a 20 65 7a 73 74 65 70 73 20 64 65 66 69 6e 65 : ezsteps define
1e90: 64 20 62 75 74 20 65 7a 73 74 65 70 73 6c 73 74 d but ezstepslst
1ea0: 20 69 73 20 7a 65 72 6f 20 6c 65 6e 67 74 68 22 is zero length"
1eb0: 29 0a 09 09 09 09 09 20 20 20 28 6c 65 74 20 6c )...... (let l
1ec0: 6f 6f 70 20 28 28 65 7a 73 74 65 70 20 28 63 61 oop ((ezstep (ca
1ed0: 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 r ezstepslst))..
1ee0: 09 09 09 09 09 20 20 20 20 20 20 28 74 61 6c 20 ..... (tal
1ef0: 20 20 20 28 63 64 72 20 65 7a 73 74 65 70 73 6c (cdr ezstepsl
1f00: 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 st)).......
1f10: 20 28 70 72 65 76 73 74 65 70 20 23 66 29 29 0a (prevstep #f)).
1f20: 09 09 09 09 09 20 20 20 20 20 3b 3b 20 63 68 65 ..... ;; che
1f30: 63 6b 20 65 78 69 74 2d 69 6e 66 6f 20 28 76 65 ck exit-info (ve
1f40: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
1f50: 66 6f 20 31 29 0a 09 09 09 09 09 20 20 20 20 20 fo 1)......
1f60: 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (if (vector-ref
1f70: 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 exit-info 1)....
1f80: 09 09 09 20 28 6c 65 74 2a 20 28 28 73 74 65 70 ... (let* ((step
1f90: 6e 61 6d 65 20 20 28 63 61 72 20 65 7a 73 74 65 name (car ezste
1fa0: 70 29 29 20 20 3b 3b 20 64 6f 20 73 74 75 66 66 p)) ;; do stuff
1fb0: 20 74 6f 20 72 75 6e 20 74 68 65 20 73 74 65 70 to run the step
1fc0: 0a 09 09 09 09 09 09 09 28 73 74 65 70 69 6e 66 ........(stepinf
1fd0: 6f 20 20 28 63 61 64 72 20 65 7a 73 74 65 70 29 o (cadr ezstep)
1fe0: 29 0a 09 09 09 09 09 09 09 28 73 74 65 70 70 61 )........(steppa
1ff0: 72 74 73 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 rts (string-matc
2000: 68 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c 7b h (regexp "^(\\{
2010: 28 5b 5e 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a ([^\\}]*)\\}\\s*
2020: 7c 29 28 2e 2a 29 24 22 29 20 73 74 65 70 69 6e |)(.*)$") stepin
2030: 66 6f 29 29 0a 09 09 09 09 09 09 09 28 73 74 65 fo))........(ste
2040: 70 70 61 72 6d 73 20 28 6c 69 73 74 2d 72 65 66 pparms (list-ref
2050: 20 73 74 65 70 70 61 72 74 73 20 32 29 29 20 3b stepparts 2)) ;
2060: 3b 20 66 6f 72 20 66 75 74 75 72 65 20 75 73 65 ; for future use
2070: 2c 20 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c 20 72 , {VAR=1,2,3}, r
2080: 75 6e 20 73 74 65 70 20 66 6f 72 20 65 61 63 68 un step for each
2090: 20 0a 09 09 09 09 09 09 09 28 73 74 65 70 63 6d ........(stepcm
20a0: 64 20 20 20 28 6c 69 73 74 2d 72 65 66 20 73 74 d (list-ref st
20b0: 65 70 70 61 72 74 73 20 33 29 29 0a 09 09 09 09 epparts 3)).....
20c0: 09 09 09 28 73 63 72 69 70 74 20 20 20 20 22 22 ...(script ""
20d0: 29 20 3b 20 22 23 21 2f 62 69 6e 2f 62 61 73 68 ) ; "#!/bin/bash
20e0: 5c 6e 22 29 20 3b 3b 20 79 65 70 2c 20 77 65 20 \n") ;; yep, we
20f0: 64 65 70 65 6e 64 20 6f 6e 20 62 69 6e 2f 62 61 depend on bin/ba
2100: 73 68 20 46 49 58 4d 45 21 21 21 0a 09 09 09 09 sh FIXME!!!.....
2110: 09 09 09 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 ...(logpro-used
2120: 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b #f))....... ;;
2130: 20 4e 42 2f 2f 20 63 61 6e 20 73 61 66 65 6c 79 NB// can safely
2140: 20 61 73 73 75 6d 65 20 77 65 20 61 72 65 20 69 assume we are i
2150: 6e 20 74 65 73 74 2d 61 72 65 61 20 64 69 72 65 n test-area dire
2160: 63 74 6f 72 79 0a 09 09 09 09 09 09 20 20 20 28 ctory....... (
2170: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 65 debug:print 4 "e
2180: 7a 73 74 65 70 73 3a 5c 6e 20 73 74 65 70 6e 61 zsteps:\n stepna
2190: 6d 65 3a 20 22 20 73 74 65 70 6e 61 6d 65 20 22 me: " stepname "
21a0: 20 73 74 65 70 69 6e 66 6f 3a 20 22 20 73 74 65 stepinfo: " ste
21b0: 70 69 6e 66 6f 20 22 20 73 74 65 70 70 61 72 74 pinfo " steppart
21c0: 73 3a 20 22 20 73 74 65 70 70 61 72 74 73 0a 09 s: " stepparts..
21d0: 09 09 09 09 09 09 09 22 20 73 74 65 70 70 61 72 ......." steppar
21e0: 6d 73 3a 20 22 20 73 74 65 70 70 61 72 6d 73 20 ms: " stepparms
21f0: 22 20 73 74 65 70 63 6d 64 3a 20 22 20 73 74 65 " stepcmd: " ste
2200: 70 63 6d 64 29 0a 09 09 09 09 09 09 20 20 20 0a pcmd)....... .
2210: 09 09 09 09 09 09 20 20 20 28 69 66 20 28 66 69 ...... (if (fi
2220: 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 le-exists? (conc
2230: 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 stepname ".logp
2240: 72 6f 22 29 29 28 73 65 74 21 20 6c 6f 67 70 72 ro"))(set! logpr
2250: 6f 2d 75 73 65 64 20 23 74 29 29 0a 0a 09 09 09 o-used #t)).....
2260: 09 09 09 20 20 20 3b 3b 20 3b 3b 20 66 69 72 73 ... ;; ;; firs
2270: 74 20 73 6f 75 72 63 65 20 74 68 65 20 70 72 65 t source the pre
2280: 76 69 6f 75 73 20 65 6e 76 69 72 6f 6e 6d 65 6e vious environmen
2290: 74 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 28 6c t....... ;; (l
22a0: 65 74 20 28 28 70 72 65 76 2d 65 6e 76 20 28 63 et ((prev-env (c
22b0: 6f 6e 63 20 22 2e 65 7a 73 74 65 70 73 2f 22 20 onc ".ezsteps/"
22c0: 70 72 65 76 73 74 65 70 20 28 69 66 20 28 73 74 prevstep (if (st
22d0: 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 ring-search (reg
22e0: 65 78 70 20 22 63 73 68 22 29 20 0a 09 09 09 09 exp "csh") .....
22f0: 09 09 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 .. ;; ...
2300: 09 09 09 09 20 28 67 65 74 2d 65 6e 76 69 72 6f .... (get-enviro
2310: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
2320: 53 48 45 4c 4c 22 29 29 20 22 2e 63 73 68 22 20 SHELL")) ".csh"
2330: 22 2e 73 68 22 29 29 29 29 0a 09 09 09 09 09 09 ".sh")))).......
2340: 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 ;; (if (and
2350: 20 70 72 65 76 73 74 65 70 20 28 66 69 6c 65 2d prevstep (file-
2360: 65 78 69 73 74 73 3f 20 70 72 65 76 2d 65 6e 76 exists? prev-env
2370: 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 ))....... ;;
2380: 20 20 20 20 20 28 73 65 74 21 20 73 63 72 69 70 (set! scrip
2390: 74 20 28 63 6f 6e 63 20 73 63 72 69 70 74 20 22 t (conc script "
23a0: 73 6f 75 72 63 65 20 22 20 70 72 65 76 2d 65 6e source " prev-en
23b0: 76 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 0a v))))....... .
23c0: 09 09 09 09 09 09 20 20 20 3b 3b 20 63 61 6c 6c ...... ;; call
23d0: 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 75 73 69 the command usi
23e0: 6e 67 20 6d 74 5f 65 7a 73 74 65 70 0a 09 09 09 ng mt_ezstep....
23f0: 09 09 09 20 20 20 28 73 65 74 21 20 73 63 72 69 ... (set! scri
2400: 70 74 20 28 63 6f 6e 63 20 22 6d 74 5f 65 7a 73 pt (conc "mt_ezs
2410: 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 20 22 tep " stepname "
2420: 20 22 20 28 69 66 20 70 72 65 76 73 74 65 70 20 " (if prevstep
2430: 70 72 65 76 73 74 65 70 20 22 2d 22 29 20 22 20 prevstep "-") "
2440: 22 20 73 74 65 70 63 6d 64 29 29 0a 0a 09 09 09 " stepcmd)).....
2450: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
2460: 6e 74 20 34 20 22 73 63 72 69 70 74 3a 20 22 20 nt 4 "script: "
2470: 73 63 72 69 70 74 29 0a 0a 09 09 09 09 09 09 20 script)........
2480: 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 (cdb:remote-ru
2490: 6e 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 65 n db:teststep-se
24a0: 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 73 t-status! #f tes
24b0: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 73 t-id stepname "s
24c0: 74 61 72 74 22 20 22 2d 22 20 23 66 20 23 66 29 tart" "-" #f #f)
24d0: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 6e 6f 77 ....... ;; now
24e0: 20 6c 61 75 6e 63 68 0a 09 09 09 09 09 09 20 20 launch.......
24f0: 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f (let ((pid (pro
2500: 63 65 73 73 2d 72 75 6e 20 73 63 72 69 70 74 29 cess-run script)
2510: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c ))....... (l
2520: 65 74 20 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 et processloop (
2530: 28 69 20 30 29 29 0a 09 09 09 09 09 09 20 20 20 (i 0)).......
2540: 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 (let-values
2550: 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d (((pid-val exit-
2560: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
2570: 29 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 )(process-wait p
2580: 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 09 09 id #t)))........
2590: 09 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 . (mutex-lock!
25a0: 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 m)......... (
25b0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
25c0: 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 -info 0 pid)....
25d0: 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 2d ..... (vector-
25e0: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 set! exit-info 1
25f0: 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 exit-status)...
2600: 09 09 09 09 09 09 20 20 20 28 76 65 63 74 6f 72 ...... (vector
2610: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
2620: 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 2 exit-code)....
2630: 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 2d 75 ..... (mutex-u
2640: 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 nlock! m).......
2650: 09 09 20 20 20 28 69 66 20 28 65 71 3f 20 70 69 .. (if (eq? pi
2660: 64 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 09 09 d-val 0)........
2670: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
2680: 09 09 09 09 09 09 09 09 20 28 74 68 72 65 61 64 ........ (thread
2690: 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 -sleep! 2)......
26a0: 09 09 09 09 20 28 70 72 6f 63 65 73 73 6c 6f 6f .... (processloo
26b0: 70 20 28 2b 20 69 20 31 29 29 29 29 0a 09 09 09 p (+ i 1))))....
26c0: 09 09 09 09 09 20 20 20 29 29 0a 20 20 20 20 20 ..... )).
26d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2700: 28 6c 65 74 20 28 28 65 78 69 6e 66 6f 20 28 76 (let ((exinfo (v
2710: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
2720: 6e 66 6f 20 32 29 29 0a 20 20 20 20 20 20 20 20 nfo 2)).
2730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2760: 20 20 20 28 6c 6f 67 66 6e 61 20 28 69 66 20 6c (logfna (if l
2770: 6f 67 70 72 6f 2d 75 73 65 64 20 28 63 6f 6e 63 ogpro-used (conc
2780: 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c stepname ".html
2790: 22 29 20 22 22 29 29 29 0a 09 09 09 09 09 09 20 ") ""))).......
27a0: 20 20 20 20 20 20 3b 3b 20 74 65 73 74 69 6e 67 ;; testing
27b0: 20 69 66 20 70 72 6f 63 65 64 75 72 65 73 20 63 if procedures c
27c0: 61 6c 6c 65 64 20 69 6e 20 61 20 72 65 6d 6f 74 alled in a remot
27d0: 65 20 63 61 6c 6c 20 63 61 75 73 65 20 70 72 6f e call cause pro
27e0: 62 6c 65 6d 73 20 28 61 6e 73 3a 20 6e 6f 20 6f blems (ans: no o
27f0: 72 20 73 6f 20 49 20 73 75 73 70 65 63 74 29 0a r so I suspect).
2800: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 64 ...... (cd
2810: 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a b:remote-run db:
2820: 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 teststep-set-sta
2830: 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 20 tus! #f test-id
2840: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
2850: 78 69 6e 66 6f 20 23 66 20 6c 6f 67 66 6e 61 29 xinfo #f logfna)
2860: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 69 66 )....... (if
2870: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 09 09 logpro-used....
2880: 09 09 09 09 20 28 63 64 62 3a 74 65 73 74 2d 73 .... (cdb:test-s
2890: 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f et-log! *runremo
28a0: 74 65 2a 20 20 74 65 73 74 2d 69 64 20 28 63 6f te* test-id (co
28b0: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
28c0: 6d 6c 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 ml"))).......
28d0: 20 20 3b 3b 20 73 65 74 20 74 68 65 20 74 65 73 ;; set the tes
28e0: 74 20 66 69 6e 61 6c 20 73 74 61 74 75 73 0a 09 t final status..
28f0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 ..... (let*
2900: 28 28 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ((this-step-stat
2910: 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 us (cond........
2920: 09 09 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 .. ((and (
2930: 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 eq? (vector-ref
2940: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 32 29 20 exit-info 2) 2)
2950: 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 77 61 logpro-used) 'wa
2960: 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 rn)..........
2970: 20 20 20 20 28 28 65 71 3f 20 28 76 65 63 74 6f ((eq? (vecto
2980: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2990: 32 29 20 30 29 20 20 20 20 20 20 20 20 20 20 20 2) 0)
29a0: 20 20 20 20 20 20 20 20 27 70 61 73 73 29 0a 09 'pass)..
29b0: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
29c0: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 else 'fail)))...
29d0: 09 09 09 09 09 20 20 20 20 28 6f 76 65 72 61 6c ..... (overal
29e0: 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f 6e 64 l-status (cond
29f0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2a00: 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 ((eq? rollup-st
2a10: 61 74 75 73 20 32 29 20 27 77 61 72 6e 29 0a 09 atus 2) 'warn)..
2a20: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2a30: 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 (eq? rollup-stat
2a40: 75 73 20 30 29 20 27 70 61 73 73 29 0a 09 09 09 us 0) 'pass)....
2a50: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 65 6c ...... (el
2a60: 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 09 09 se 'fail))).....
2a70: 09 09 09 20 20 20 20 28 6e 65 78 74 2d 73 74 61 ... (next-sta
2a80: 74 75 73 20 20 20 20 20 20 28 63 6f 6e 64 20 0a tus (cond .
2a90: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2aa0: 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 ((eq? overall-st
2ab0: 61 74 75 73 20 27 70 61 73 73 29 20 74 68 69 73 atus 'pass) this
2ac0: 2d 73 74 65 70 2d 73 74 61 74 75 73 29 0a 09 09 -step-status)...
2ad0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 ....... ((
2ae0: 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 eq? overall-stat
2af0: 75 73 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 us 'warn).......
2b00: 09 09 09 09 28 69 66 20 28 65 71 3f 20 74 68 69 ....(if (eq? thi
2b10: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 66 s-step-status 'f
2b20: 61 69 6c 29 20 27 66 61 69 6c 20 27 77 61 72 6e ail) 'fail 'warn
2b30: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
2b40: 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 (else 'fail))
2b50: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2b60: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
2b70: 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 65 69 Exit value recei
2b80: 76 65 64 3a 20 22 20 28 76 65 63 74 6f 72 2d 72 ved: " (vector-r
2b90: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
2ba0: 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 3a 20 22 " logpro-used: "
2bb0: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 0a 09 09 logpro-used ...
2bc0: 09 09 09 09 09 09 20 20 20 20 22 20 74 68 69 73 ...... " this
2bd0: 2d 73 74 65 70 2d 73 74 61 74 75 73 3a 20 22 20 -step-status: "
2be0: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
2bf0: 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 " overall-statu
2c00: 73 3a 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 s: " overall-sta
2c10: 74 75 73 20 0a 09 09 09 09 09 09 09 09 20 20 20 tus .........
2c20: 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 3a 20 " next-status:
2c30: 22 20 6e 65 78 74 2d 73 74 61 74 75 73 20 22 20 " next-status "
2c40: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 22 rollup-status: "
2c50: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a rollup-status).
2c60: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 61 ...... (ca
2c70: 73 65 20 6e 65 78 74 2d 73 74 61 74 75 73 0a 09 se next-status..
2c80: 09 09 09 09 09 09 20 28 28 77 61 72 6e 29 0a 09 ...... ((warn)..
2c90: 09 09 09 09 09 09 20 20 28 73 65 74 21 20 72 6f ...... (set! ro
2ca0: 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 29 0a 09 llup-status 2)..
2cb0: 09 09 09 09 09 09 20 20 3b 3b 20 4e 42 2f 2f 20 ...... ;; NB//
2cc0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
2cd0: 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 20 does rdb calls
2ce0: 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 under the hood..
2cf0: 09 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 ...... (tests:t
2d00: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
2d10: 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 test-id "RUNNING
2d20: 22 20 22 57 41 52 4e 22 20 0a 09 09 09 09 09 09 " "WARN" .......
2d30: 09 09 09 20 20 28 69 66 20 28 65 71 3f 20 74 68 ... (if (eq? th
2d40: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 is-step-status '
2d50: 77 61 72 6e 29 20 22 4c 6f 67 70 72 6f 20 77 61 warn) "Logpro wa
2d60: 72 6e 69 6e 67 20 66 6f 75 6e 64 22 20 23 66 29 rning found" #f)
2d70: 0a 09 09 09 09 09 09 09 09 09 20 20 23 66 29 29 .......... #f))
2d80: 0a 09 09 09 09 09 09 09 20 28 28 70 61 73 73 29 ........ ((pass)
2d90: 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 74 73 ........ (tests
2da0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
2db0: 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 ! test-id "RUNNI
2dc0: 4e 47 22 20 22 50 41 53 53 22 20 23 66 20 23 66 NG" "PASS" #f #f
2dd0: 29 29 0a 09 09 09 09 09 09 09 20 28 65 6c 73 65 ))........ (else
2de0: 20 3b 3b 20 27 66 61 69 6c 0a 09 09 09 09 09 09 ;; 'fail.......
2df0: 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d . (set! rollup-
2e00: 73 74 61 74 75 73 20 31 29 20 3b 3b 20 66 6f 72 status 1) ;; for
2e10: 63 65 20 66 61 69 6c 0a 09 09 09 09 09 09 09 20 ce fail........
2e20: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
2e30: 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 -status! test-id
2e40: 20 22 52 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c "RUNNING" "FAIL
2e50: 22 20 28 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 " (conc "Failed
2e60: 61 74 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 at step " stepna
2e70: 6d 65 29 20 23 66 29 0a 09 09 09 09 09 09 09 20 me) #f)........
2e80: 20 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 ))))....... (
2e90: 69 66 20 28 61 6e 64 20 28 73 74 65 70 72 75 6e if (and (steprun
2ea0: 2d 67 6f 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 -good? logpro-us
2eb0: 65 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 ed (vector-ref e
2ec0: 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 xit-info 2))....
2ed0: 09 09 09 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 .... (not (nu
2ee0: 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 09 09 09 ll? tal)))......
2ef0: 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 . (loop (c
2f00: 61 72 20 74 61 6c 29 20 28 63 64 72 20 74 61 6c ar tal) (cdr tal
2f10: 29 20 73 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 ) stepname)))...
2f20: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
2f30: 74 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 t 4 "WARNING: a
2f40: 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c 65 prior step faile
2f50: 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 22 d, stopping at "
2f60: 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 0a ezstep)))))))).
2f70: 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 .. (monitorjob
2f80: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
2f90: 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 73 (let* ((start-s
2fa0: 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 2d econds (current-
2fb0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 seconds))......(
2fc0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c calc-minutes (l
2fd0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 ambda ()........
2fe0: 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 (inexact->exact
2ff0: 20 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 6e ........ (roun
3000: 64 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d 20 d ........ (-
3010: 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 75 72 ........ (cur
3020: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 rent-seconds) ..
3030: 09 09 09 09 09 09 20 20 20 20 73 74 61 72 74 2d ...... start-
3040: 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 seconds)))))....
3050: 09 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 ..(kill-tries 0)
3060: 29 0a 09 09 09 09 20 20 20 28 6c 65 74 20 6c 6f )..... (let lo
3070: 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28 op ((minutes (
3080: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a calc-minutes))).
3090: 09 09 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a .... (begin.
30a0: 09 09 09 09 20 20 20 20 20 20 20 28 73 65 74 21 .... (set!
30b0: 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 74 kill-job? (test
30c0: 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 -get-kill-reques
30d0: 74 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 72 t test-id)) ;; r
30e0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
30f0: 69 74 65 6d 64 61 74 29 29 0a 09 09 09 09 20 20 itemdat)).....
3100: 20 20 20 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 (open-run-c
3110: 6c 6f 73 65 20 74 65 73 74 2d 73 65 74 2d 6d 65 lose test-set-me
3120: 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d ta-info #f test-
3130: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e id run-id test-n
3140: 61 6d 65 20 69 74 65 6d 64 61 74 20 6d 69 6e 75 ame itemdat minu
3150: 74 65 73 29 0a 09 09 09 09 20 20 20 20 20 20 20 tes).....
3160: 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 (if kill-job? ..
3170: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
3180: 09 09 09 20 20 20 20 20 28 6d 75 74 65 78 2d 6c ... (mutex-l
3190: 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 20 ock! m)......
31a0: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 76 (let* ((pid (v
31b0: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
31c0: 6e 66 6f 20 30 29 29 29 0a 09 09 09 09 09 20 20 nfo 0)))......
31d0: 20 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 (if (number
31e0: 3f 20 70 69 64 29 0a 09 09 09 09 09 09 20 20 20 ? pid).......
31f0: 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 (begin.......
3200: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3210: 20 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 "WARNING: Reque
3220: 73 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b st received to k
3230: 69 6c 6c 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 ill job (attempt
3240: 20 23 20 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 # " kill-tries
3250: 22 29 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 ")").......
3260: 28 6c 65 74 20 28 28 70 72 6f 63 65 73 73 65 73 (let ((processes
3270: 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 (cmd-run->list
3280: 28 63 6f 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 (conc "pgrep -l
3290: 2d 50 20 22 20 70 69 64 29 29 29 29 0a 09 09 09 -P " pid))))....
32a0: 09 09 09 20 20 20 20 20 20 20 28 66 6f 72 2d 65 ... (for-e
32b0: 61 63 68 20 0a 09 09 09 09 09 09 09 28 6c 61 6d ach ........(lam
32c0: 62 64 61 20 28 70 29 0a 09 09 09 09 09 09 09 20 bda (p)........
32d0: 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 (let* ((parts
32e0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 (string-split p)
32f0: 29 0a 09 09 09 09 09 09 09 09 20 28 70 2d 69 64 )......... (p-id
3300: 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 (if (> (lengt
3310: 68 20 70 61 72 74 73 29 20 30 29 0a 09 09 09 09 h parts) 0).....
3320: 09 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e ..... (strin
3330: 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 72 20 70 g->number (car p
3340: 61 72 74 73 29 29 0a 09 09 09 09 09 09 09 09 09 arts))..........
3350: 20 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 #f)))......
3360: 09 09 20 20 20 20 28 69 66 20 70 2d 69 64 0a 09 .. (if p-id..
3370: 09 09 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 .......(begin...
3380: 09 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
3390: 72 69 6e 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 rint 0 "Killing
33a0: 22 20 28 63 61 64 72 20 70 61 72 74 73 29 20 22 " (cadr parts) "
33b0: 3b 20 6b 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 ; kill -9 " p-i
33c0: 64 29 0a 09 09 09 09 09 09 09 09 20 20 28 73 79 d)......... (sy
33d0: 73 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c stem (conc "kill
33e0: 20 2d 39 20 22 20 70 2d 69 64 29 29 29 29 29 29 -9 " p-id))))))
33f0: 0a 09 09 09 09 09 09 09 28 63 61 72 20 70 72 6f ........(car pro
3400: 63 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 20 cesses)).......
3410: 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 (system (c
3420: 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 2d 22 20 onc "kill -9 -"
3430: 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 pid)))).......
3440: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 (begin.......
3450: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
3460: 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 0 "WARNING: Requ
3470: 65 73 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 est received to
3480: 6b 69 6c 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f kill job but pro
3490: 62 6c 65 6d 20 77 69 74 68 20 70 72 6f 63 65 73 blem with proces
34a0: 73 2c 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f s, attempting to
34b0: 20 6b 69 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 kill manager pr
34c0: 6f 63 65 73 73 22 29 0a 09 09 09 09 09 09 20 20 ocess").......
34d0: 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
34e0: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
34f0: 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 id "KILLED" "FA
3500: 49 4c 22 0a 09 09 09 09 09 09 09 09 20 20 20 20 IL".........
3510: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3520: 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 09 09 20 -m") #f).......
3530: 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 69 6e (sqlite3:fin
3540: 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 09 09 alize! tdb).....
3550: 09 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
3560: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 73 65 ))...... (se
3570: 74 21 20 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b t! kill-tries (+
3580: 20 31 20 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 1 kill-tries)).
3590: 09 09 09 09 09 20 20 20 20 20 28 6d 75 74 65 78 ..... (mutex
35a0: 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 09 -unlock! m)))...
35b0: 09 09 20 20 20 20 20 20 20 3b 3b 20 28 73 71 6c .. ;; (sql
35c0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
35d0: 62 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 74 b)..... (t
35e0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 hread-sleep! (+
35f0: 31 30 20 28 72 61 6e 64 6f 6d 20 31 30 29 29 29 10 (random 10)))
3600: 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 ;; add some jit
3610: 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 ter to the call
3620: 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 home time to spr
3630: 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 ead out the db a
3640: 63 63 65 73 73 65 73 0a 09 09 09 09 20 20 20 20 ccesses.....
3650: 20 20 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d (loop (calc-m
3660: 69 6e 75 74 65 73 29 29 29 29 29 29 29 0a 09 09 inutes)))))))...
3670: 20 28 74 68 31 20 20 20 20 20 20 20 20 20 20 28 (th1 (
3680: 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 make-thread moni
3690: 74 6f 72 6a 6f 62 29 29 0a 09 09 20 28 74 68 32 torjob))... (th2
36a0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
36b0: 74 68 72 65 61 64 20 72 75 6e 69 74 29 29 29 0a thread runit))).
36c0: 09 20 20 20 20 28 73 65 74 21 20 6a 6f 62 2d 74 . (set! job-t
36d0: 68 72 65 61 64 20 74 68 32 29 0a 09 20 20 20 20 hread th2)..
36e0: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t
36f0: 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 h1).. (thread
3700: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 20 -start! th2)..
3710: 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 (thread-join!
3720: 74 68 32 29 0a 09 20 20 20 20 28 6d 75 74 65 78 th2).. (mutex
3730: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 28 -lock! m).. (
3740: 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 let* ((item-path
3750: 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 (item-list->pat
3760: 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20 20 h itemdat))...
3770: 20 28 74 65 73 74 69 6e 66 6f 20 20 28 63 64 62 (testinfo (cdb
3780: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
3790: 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a y-id *runremote*
37a0: 20 74 65 73 74 2d 69 64 29 29 29 20 3b 3b 20 29 test-id))) ;; )
37b0: 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 ) ;; run-id test
37c0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 -name item-path)
37d0: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 41 6d 20 )).. ;; Am
37e0: 49 20 63 6f 6d 70 6c 65 74 65 64 3f 0a 09 20 20 I completed?..
37f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
3800: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
3810: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
3820: 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a ) "COMPLETED")).
3830: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 .. (begin...
3840: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
3850: 22 54 65 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 "Test NOT logged
3860: 20 61 73 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 as COMPLETED, (
3870: 73 74 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 state=" (db:test
3880: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 -get-state testi
3890: 6e 66 6f 29 20 22 29 2c 20 75 70 64 61 74 69 6e nfo) "), updatin
38a0: 67 20 72 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 g result, rollup
38b0: 2d 73 74 61 74 75 73 20 69 73 20 22 20 72 6f 6c -status is " rol
38c0: 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 20 20 lup-status)...
38d0: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
38e0: 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 t-status! test-i
38f0: 64 20 0a 09 09 09 09 20 20 20 20 28 69 66 20 6b d ..... (if k
3900: 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 ill-job? "KILLED
3910: 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 " "COMPLETED")..
3920: 09 09 09 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 ... (cond....
3930: 09 20 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 . ((not (vec
3940: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3950: 6f 20 31 29 29 20 22 46 41 49 4c 22 29 20 3b 3b o 1)) "FAIL") ;;
3960: 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 72 job failed to r
3970: 75 6e 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 un..... ((eq
3980: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
3990: 30 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 0)..... ;;
39a0: 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 if the current s
39b0: 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 tatus is AUTO th
39c0: 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 e defer to the c
39d0: 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 alculated value
39e0: 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 73 (i.e. leave this
39f0: 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 20 20 AUTO).....
3a00: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 (if (equal? (db
3a10: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
3a20: 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f testinfo) "AUTO
3a30: 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 53 22 ") "AUTO" "PASS"
3a40: 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 ))..... ((eq
3a50: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
3a60: 31 29 20 22 46 41 49 4c 22 29 0a 09 09 09 09 20 1) "FAIL").....
3a70: 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 ((eq? rollup
3a80: 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 20 -status 2).....
3a90: 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 ;; if the c
3aa0: 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 urrent status is
3ab0: 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 AUTO the defer
3ac0: 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 to the calculate
3ad0: 64 20 76 61 6c 75 65 20 62 75 74 20 71 75 61 6c d value but qual
3ae0: 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 ify (i.e. make t
3af0: 68 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 his AUTO-WARN)..
3b00: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 ... (if (eq
3b10: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
3b20: 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 t-status testinf
3b30: 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f o) "AUTO") "AUTO
3b40: 2d 57 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a -WARN" "WARN")).
3b50: 09 09 09 09 20 20 20 20 20 28 65 6c 73 65 20 22 .... (else "
3b60: 46 41 49 4c 22 29 29 0a 09 09 09 09 20 20 20 20 FAIL")).....
3b70: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
3b80: 6d 22 29 20 23 66 29 29 29 0a 09 20 20 20 20 20 m") #f)))..
3b90: 20 3b 3b 20 66 6f 72 20 61 75 74 6f 6d 61 74 65 ;; for automate
3ba0: 64 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 d creation of th
3bb0: 65 20 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 66 69 e rollup html fi
3bc0: 6c 65 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f le this is a goo
3bd0: 64 20 70 6c 61 63 65 2e 2e 2e 0a 09 20 20 20 20 d place.....
3be0: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 (if (not (equa
3bf0: 6c 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 l? item-path "")
3c00: 29 0a 09 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d )... (open-run-
3c10: 63 6c 6f 73 65 20 74 65 73 74 73 3a 73 75 6d 6d close tests:summ
3c20: 61 72 69 7a 65 2d 69 74 65 6d 73 20 23 66 20 72 arize-items #f r
3c30: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
3c40: 23 66 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f #f)) ;; don't fo
3c50: 72 63 65 20 2d 20 6a 75 73 74 20 75 70 64 61 74 rce - just updat
3c60: 65 20 69 66 20 6e 6f 0a 09 20 20 20 20 20 20 29 e if no.. )
3c70: 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c .. (mutex-unl
3c80: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 3b 3b 20 ock! m).. ;;
3c90: 28 65 78 65 63 2d 72 65 73 75 6c 74 73 20 28 63 (exec-results (c
3ca0: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c md-run->list ful
3cb0: 6c 72 75 6e 73 63 72 69 70 74 29 29 20 3b 3b 20 lrunscript)) ;;
3cc0: 20 28 6c 69 73 74 20 22 3e 22 20 28 63 6f 6e 63 (list ">" (conc
3cd0: 20 74 65 73 74 2d 6e 61 6d 65 20 22 2d 72 75 6e test-name "-run
3ce0: 2e 6c 6f 67 22 29 29 29 29 0a 09 20 20 20 20 3b .log")))).. ;
3cf0: 3b 20 28 73 75 63 63 65 73 73 20 20 20 20 20 20 ; (success
3d00: 65 78 65 63 2d 72 65 73 75 6c 74 73 29 29 20 3b exec-results)) ;
3d10: 3b 20 28 65 71 3f 20 28 63 61 64 72 20 65 78 65 ; (eq? (cadr exe
3d20: 63 2d 72 65 73 75 6c 74 73 29 20 30 29 29 29 0a c-results) 0))).
3d30: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3d40: 74 20 32 20 22 4f 75 74 70 75 74 20 66 72 6f 6d t 2 "Output from
3d50: 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c 72 running " fullr
3d60: 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 64 20 unscript ", pid
3d70: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 " (vector-ref ex
3d80: 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 6e 20 it-info 0) " in
3d90: 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 work area " ....
3da0: 20 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d work-area ":\n=
3db0: 3d 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 ===\n exit code
3dc0: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 " (vector-ref ex
3dd0: 69 74 2d 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 it-info 2) "\n"
3de0: 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 3b "====\n").. ;
3df0: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
3e00: 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 3b 3b ize! db).. ;;
3e10: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
3e20: 7a 65 21 20 74 64 62 29 0a 09 20 20 20 20 28 69 ze! tdb).. (i
3e30: 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 f (not (vector-r
3e40: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 ef exit-info 1))
3e50: 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 29 29 ...(exit 4))))))
3e60: 29 0a 0a 3b 3b 20 73 65 74 20 75 70 20 74 68 65 )..;; set up the
3e70: 20 76 65 72 79 20 62 61 73 69 63 73 20 6e 65 65 very basics nee
3e80: 64 65 64 20 66 6f 72 20 64 6f 69 6e 67 20 61 6e ded for doing an
3e90: 79 74 68 69 6e 67 20 68 65 72 65 2e 0a 28 64 65 ything here..(de
3ea0: 66 69 6e 65 20 28 73 65 74 75 70 2d 66 6f 72 2d fine (setup-for-
3eb0: 72 75 6e 29 0a 20 20 3b 3b 20 77 6f 75 6c 64 20 run). ;; would
3ec0: 73 65 74 20 76 61 6c 75 65 73 20 66 6f 72 20 4b set values for K
3ed0: 45 59 53 20 69 6e 20 74 68 65 20 65 6e 76 69 72 EYS in the envir
3ee0: 6f 6e 6d 65 6e 74 20 68 65 72 65 20 66 6f 72 20 onment here for
3ef0: 62 65 74 74 65 72 20 73 75 70 70 6f 72 74 20 6f better support o
3f00: 66 20 65 6e 76 2d 6f 76 65 72 72 69 64 65 20 62 f env-override b
3f10: 75 74 20 0a 20 20 3b 3b 20 68 61 76 65 20 63 68 ut . ;; have ch
3f20: 69 63 6b 65 6e 2f 65 67 67 20 73 63 65 6e 61 72 icken/egg scenar
3f30: 69 6f 2e 20 6e 65 65 64 20 74 6f 20 72 65 61 64 io. need to read
3f40: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
3f50: 20 74 68 65 6e 20 72 65 61 64 20 69 74 20 61 67 then read it ag
3f60: 61 69 6e 2e 20 47 6f 69 6e 67 20 74 6f 20 0a 20 ain. Going to .
3f70: 20 3b 3b 20 70 61 73 73 20 6f 6e 20 74 68 61 74 ;; pass on that
3f80: 20 69 64 65 61 20 66 6f 72 20 6e 6f 77 0a 20 20 idea for now.
3f90: 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 0a ;; special case.
3fa0: 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 (set! *configi
3fb0: 6e 66 6f 2a 20 28 66 69 6e 64 2d 61 6e 64 2d 72 nfo* (find-and-r
3fc0: 65 61 64 2d 63 6f 6e 66 69 67 20 0a 09 09 20 20 ead-config ...
3fd0: 20 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 (if (args:ge
3fe0: 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 t-arg "-config")
3ff0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
4000: 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 74 65 config") "megate
4010: 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 09 20 20 st.config")...
4020: 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 environ-patt
4030: 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 : "env-override"
4040: 0a 09 09 20 20 20 20 20 20 67 69 76 65 6e 2d 74 ... given-t
4050: 6f 70 70 61 74 68 3a 20 28 67 65 74 2d 65 6e 76 oppath: (get-env
4060: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
4070: 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 e "MT_RUN_AREA_H
4080: 4f 4d 45 22 29 0a 09 09 20 20 20 20 20 20 70 61 OME")... pa
4090: 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 thenvvar: "MT_RU
40a0: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 0a 20 N_AREA_HOME")).
40b0: 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 (set! *configda
40c0: 74 2a 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f t* (if (car *co
40d0: 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 72 20 2a nfiginfo*)(car *
40e0: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 configinfo*) #f)
40f0: 29 0a 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 ). (set! *toppa
4100: 74 68 2a 20 20 20 20 28 69 66 20 28 63 61 72 20 th* (if (car
4110: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 *configinfo*)(ca
4120: 64 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 dr *configinfo*)
4130: 20 23 66 29 29 0a 20 20 28 69 66 20 2a 74 6f 70 #f)). (if *top
4140: 70 61 74 68 2a 0a 20 20 20 20 20 20 28 73 65 74 path*. (set
4150: 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 env "MT_RUN_AREA
4160: 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a _HOME" *toppath*
4170: 29 20 3b 3b 20 74 6f 20 62 65 20 64 65 70 72 65 ) ;; to be depre
4180: 63 61 74 65 64 0a 20 20 20 20 20 20 28 64 65 62 cated. (deb
4190: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
41a0: 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 66 69 6e R: failed to fin
41b0: 64 20 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 d the top path t
41c0: 6f 20 79 6f 75 72 20 72 75 6e 20 73 65 74 75 70 o your run setup
41d0: 2e 22 29 29 0a 20 20 2a 74 6f 70 70 61 74 68 2a .")). *toppath*
41e0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 74 2d )..(define (get-
41f0: 62 65 73 74 2d 64 69 73 6b 20 63 6f 6e 66 64 61 best-disk confda
4200: 74 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 69 73 t). (let* ((dis
4210: 6b 73 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c ks (hash-tabl
4220: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f e-ref/default co
4230: 6e 66 64 61 74 20 22 64 69 73 6b 73 22 20 23 66 nfdat "disks" #f
4240: 29 29 0a 09 20 28 62 65 73 74 20 20 20 20 20 23 )).. (best #
4250: 66 29 0a 09 20 28 62 65 73 74 73 69 7a 65 20 30 f).. (bestsize 0
4260: 29 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 73 )). (if disks
4270: 20 0a 09 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 ..(for-each ..
4280: 28 6c 61 6d 62 64 61 20 28 64 69 73 6b 2d 6e 75 (lambda (disk-nu
4290: 6d 29 0a 09 20 20 20 28 6c 65 74 2a 20 28 28 64 m).. (let* ((d
42a0: 69 72 70 61 74 68 20 20 20 20 28 63 61 64 72 20 irpath (cadr
42b0: 28 61 73 73 6f 63 20 64 69 73 6b 2d 6e 75 6d 20 (assoc disk-num
42c0: 64 69 73 6b 73 29 29 29 0a 09 09 20 20 28 66 72 disks)))... (fr
42d0: 65 65 73 70 63 20 20 20 20 28 69 66 20 28 61 6e eespc (if (an
42e0: 64 20 28 64 69 72 65 63 74 6f 72 79 3f 20 64 69 d (directory? di
42f0: 72 70 61 74 68 29 0a 09 09 09 09 20 20 20 20 20 rpath).....
4300: 20 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 (file-write-ac
4310: 63 65 73 73 3f 20 64 69 72 70 61 74 68 29 29 0a cess? dirpath)).
4320: 09 09 09 09 20 20 28 67 65 74 2d 64 66 20 64 69 .... (get-df di
4330: 72 70 61 74 68 29 0a 09 09 09 09 20 20 28 62 65 rpath)..... (be
4340: 67 69 6e 0a 09 09 09 09 20 20 20 20 28 64 65 62 gin..... (deb
4350: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
4360: 49 4e 47 3a 20 70 61 74 68 20 22 20 64 69 72 70 ING: path " dirp
4370: 61 74 68 20 22 20 69 6e 20 5b 64 69 73 6b 73 5d ath " in [disks]
4380: 20 73 65 63 74 69 6f 6e 20 6e 6f 74 20 76 61 6c section not val
4390: 69 64 20 6f 72 20 77 72 69 74 61 62 6c 65 22 29 id or writable")
43a0: 0a 09 09 09 09 20 20 20 20 30 29 29 29 29 0a 09 ..... 0))))..
43b0: 20 20 20 20 20 28 69 66 20 28 3e 20 66 72 65 65 (if (> free
43c0: 73 70 63 20 62 65 73 74 73 69 7a 65 29 0a 09 09 spc bestsize)...
43d0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 73 65 (begin... (se
43e0: 74 21 20 62 65 73 74 20 20 20 20 20 64 69 72 70 t! best dirp
43f0: 61 74 68 29 0a 09 09 20 20 20 28 73 65 74 21 20 ath)... (set!
4400: 62 65 73 74 73 69 7a 65 20 66 72 65 65 73 70 63 bestsize freespc
4410: 29 29 29 29 29 0a 09 20 28 6d 61 70 20 63 61 72 ))))).. (map car
4420: 20 64 69 73 6b 73 29 29 29 0a 20 20 20 20 28 69 disks))). (i
4430: 66 20 62 65 73 74 0a 09 62 65 73 74 0a 09 28 62 f best..best..(b
4440: 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
4450: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 4e rint 0 "ERROR: N
4460: 6f 20 76 61 6c 69 64 20 64 69 73 6b 73 20 66 6f o valid disks fo
4470: 75 6e 64 20 69 6e 20 6d 65 67 61 74 65 73 74 2e und in megatest.
4480: 63 6f 6e 66 69 67 2e 20 50 6c 65 61 73 65 20 61 config. Please a
4490: 64 64 20 73 6f 6d 65 20 74 6f 20 79 6f 75 72 20 dd some to your
44a0: 5b 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 22 [disks] section"
44b0: 29 0a 09 20 20 28 65 78 69 74 20 31 29 29 29 29 ).. (exit 1))))
44c0: 29 0a 0a 3b 3b 20 44 65 73 69 72 65 64 20 64 69 )..;; Desired di
44d0: 72 65 63 74 6f 72 79 20 73 74 72 75 63 74 75 72 rectory structur
44e0: 65 3a 0a 3b 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 e:.;;.;; <linkd
44f0: 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d ir> - <target> -
4500: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b <testname> -..;
4510: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
4520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4530: 20 20 20 20 20 20 7c 0a 3b 3b 20 20 20 20 20 20 |.;;
4540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 v
4560: 0a 3b 3b 20 20 3c 72 75 6e 64 69 72 3e 20 20 2d .;; <rundir> -
4570: 20 20 3c 74 61 72 67 65 74 3e 20 20 2d 20 20 20 <target> -
4580: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 <testname> -|-
4590: 3c 69 74 65 6d 70 61 74 68 28 73 29 3e 0a 3b 3b <itempath(s)>.;;
45a0: 0a 3b 3b 20 20 64 69 72 20 73 74 6f 72 65 64 20 .;; dir stored
45b0: 69 6e 20 74 65 73 74 20 69 73 3a 0a 3b 3b 20 0a in test is:.;; .
45c0: 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 ;; <linkdir> -
45d0: 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 <target> - <test
45e0: 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 name> [ - <itemp
45f0: 61 74 68 3e 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c ath> ].;; .;; Al
4600: 6c 20 6c 6f 67 20 66 69 6c 65 20 6c 69 6e 6b 73 l log file links
4610: 20 73 68 6f 75 6c 64 20 62 65 20 73 74 6f 72 65 should be store
4620: 64 20 72 65 6c 61 74 69 76 65 20 74 6f 20 74 68 d relative to th
4630: 65 20 74 6f 70 20 6f 66 20 6c 69 6e 6b 20 70 61 e top of link pa
4640: 74 68 0a 3b 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 th.;; .;; <targ
4650: 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e et> - <testname>
4660: 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 [ - <itempath>
4670: 5d 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 ] .;;.(define (c
4680: 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 reate-work-area
4690: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 db run-id test-i
46a0: 64 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 d test-src-path
46b0: 64 69 73 6b 2d 70 61 74 68 20 74 65 73 74 6e 61 disk-path testna
46c0: 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 28 6c me itemdat). (l
46d0: 65 74 2a 20 28 28 72 75 6e 2d 69 6e 66 6f 20 28 et* ((run-info (
46e0: 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 cdb:remote-run d
46f0: 62 3a 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 23 b:get-run-info #
4700: 66 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 69 74 f run-id)).. (it
4710: 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 em-path (item-li
4720: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
4730: 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 28 )).. (runname (
4740: 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d db:get-value-by-
4750: 68 65 61 64 65 72 20 28 64 62 3a 67 65 74 2d 72 header (db:get-r
4760: 6f 77 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 ow run-info)....
4770: 09 09 20 20 20 28 64 62 3a 67 65 74 2d 68 65 61 .. (db:get-hea
4780: 64 65 72 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 der run-info)...
4790: 09 09 09 20 20 20 22 72 75 6e 6e 61 6d 65 22 29 ... "runname")
47a0: 29 0a 09 20 3b 3b 20 63 6f 6e 76 65 72 74 20 62 ).. ;; convert b
47b0: 61 63 6b 20 74 6f 20 64 62 3a 20 66 72 6f 6d 20 ack to db: from
47c0: 72 64 62 3a 20 2d 20 74 68 69 73 20 69 73 20 61 rdb: - this is a
47d0: 6c 77 61 79 73 20 72 75 6e 20 61 74 20 73 65 72 lways run at ser
47e0: 76 65 72 20 65 6e 64 0a 09 20 28 6b 65 79 2d 76 ver end.. (key-v
47f0: 61 6c 73 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d als (cdb:remote-
4800: 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 run db:get-key-v
4810: 61 6c 73 20 23 66 20 72 75 6e 2d 69 64 29 29 0a als #f run-id)).
4820: 09 20 28 74 61 72 67 65 74 20 20 20 28 73 74 72 . (target (str
4830: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
4840: 6b 65 79 2d 76 61 6c 73 20 22 2f 22 29 29 0a 0a key-vals "/"))..
4850: 09 20 28 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 . (not-iterated
4860: 20 28 65 71 75 61 6c 3f 20 22 22 20 69 74 65 6d (equal? "" item
4870: 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c -path))... ;; al
4880: 6c 20 74 65 73 74 73 20 61 72 65 20 66 6f 75 6e l tests are foun
4890: 64 20 61 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 d at <rundir>/te
48a0: 73 74 2d 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b st-base or <link
48b0: 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 dir>/test-base..
48c0: 20 28 74 65 73 74 74 6f 70 2d 62 61 73 65 20 28 (testtop-base (
48d0: 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 conc target "/"
48e0: 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 runname "/" test
48f0: 6e 61 6d 65 29 29 0a 09 20 28 74 65 73 74 2d 62 name)).. (test-b
4900: 61 73 65 20 20 20 20 28 63 6f 6e 63 20 74 65 73 ase (conc tes
4910: 74 74 6f 70 2d 62 61 73 65 20 28 69 66 20 6e 6f ttop-base (if no
4920: 74 2d 69 74 65 72 61 74 65 64 20 22 22 20 22 2f t-iterated "" "/
4930: 22 29 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a ") item-path))..
4940: 09 20 3b 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 . ;; nb// if ite
4950: 6d 70 61 74 68 20 69 73 20 6e 6f 74 20 22 22 20 mpath is not ""
4960: 74 68 65 6e 20 69 74 20 69 73 20 70 72 65 66 69 then it is prefi
4970: 78 65 64 20 77 69 74 68 20 22 2f 22 0a 09 20 28 xed with "/".. (
4980: 74 6f 70 74 65 73 74 2d 70 61 74 68 20 28 63 6f toptest-path (co
4990: 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 nc disk-path "/"
49a0: 20 74 65 73 74 74 6f 70 2d 62 61 73 65 29 29 0a testtop-base)).
49b0: 09 20 28 74 65 73 74 2d 70 61 74 68 20 20 20 20 . (test-path
49c0: 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 (conc disk-path
49d0: 22 2f 22 20 74 65 73 74 2d 62 61 73 65 29 29 0a "/" test-base)).
49e0: 0a 09 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 .. ;; ensure thi
49f0: 73 20 65 78 69 73 74 73 20 66 69 72 73 74 20 61 s exists first a
4a00: 73 20 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 s links to subte
4a10: 73 74 73 20 6d 75 73 74 20 62 65 20 63 72 65 61 sts must be crea
4a20: 74 65 64 20 74 68 65 72 65 0a 09 20 28 6c 69 6e ted there.. (lin
4a30: 6b 74 72 65 65 20 20 28 6c 65 74 20 28 28 72 64 ktree (let ((rd
4a40: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
4a50: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
4a60: 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 up" "linktree"))
4a70: 29 0a 09 09 20 20 20 20 20 20 28 69 66 20 72 64 )... (if rd
4a80: 20 72 64 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 rd (conc *toppa
4a90: 74 68 2a 20 22 2f 72 75 6e 73 22 29 29 29 29 0a th* "/runs")))).
4aa0: 0a 09 20 28 6c 6e 6b 62 61 73 65 20 20 28 63 6f .. (lnkbase (co
4ab0: 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 nc linktree "/"
4ac0: 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
4ad0: 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 20 me)).. (lnkpath
4ae0: 20 28 63 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 (conc lnkbase "
4af0: 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 /" testname))..
4b00: 28 6c 6e 6b 70 61 74 68 66 20 28 63 6f 6e 63 20 (lnkpathf (conc
4b10: 6c 6e 6b 70 61 74 68 20 28 69 66 20 6e 6f 74 2d lnkpath (if not-
4b20: 69 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 iterated "" "/")
4b30: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 item-path)))..
4b40: 20 20 20 3b 3b 20 55 70 64 61 74 65 20 74 68 65 ;; Update the
4b50: 20 72 75 6e 64 69 72 20 70 61 74 68 20 69 6e 20 rundir path in
4b60: 74 68 65 20 74 65 73 74 20 72 65 63 6f 72 64 20 the test record
4b70: 66 6f 72 20 61 6c 6c 0a 20 20 20 20 28 63 64 62 for all. (cdb
4b80: 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 :test-set-rundir
4b90: 2d 62 79 2d 74 65 73 74 2d 69 64 20 2a 72 75 6e -by-test-id *run
4ba0: 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 remote* test-id
4bb0: 6c 6e 6b 70 61 74 68 66 29 0a 0a 20 20 20 20 28 lnkpathf).. (
4bc0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 debug:print 2 "I
4bd0: 4e 46 4f 3a 5c 6e 20 20 20 20 20 20 20 6c 6e 6b NFO:\n lnk
4be0: 62 61 73 65 3d 22 20 6c 6e 6b 62 61 73 65 20 22 base=" lnkbase "
4bf0: 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 70 61 74 68 \n lnkpath
4c00: 3d 22 20 6c 6e 6b 70 61 74 68 20 22 5c 6e 20 20 =" lnkpath "\n
4c10: 74 6f 70 74 65 73 74 2d 70 61 74 68 3d 22 20 74 toptest-path=" t
4c20: 6f 70 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 20 optest-path "\n
4c30: 20 20 20 20 74 65 73 74 2d 70 61 74 68 3d 22 20 test-path="
4c40: 74 65 73 74 2d 70 61 74 68 29 0a 20 20 20 20 28 test-path). (
4c50: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 if (not (file-ex
4c60: 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 ists? linktree))
4c70: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
4c80: 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e ug:print 0 "WARN
4c90: 49 4e 47 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 ING: linktree di
4ca0: 64 20 6e 6f 74 20 65 78 69 73 74 21 20 43 72 65 d not exist! Cre
4cb0: 61 74 69 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 ating it now at
4cc0: 22 20 6c 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 " linktree).. (
4cd0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
4ce0: 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 29 29 20 linktree #t)))
4cf0: 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 ;; (system (conc
4d00: 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e "mkdir -p " lin
4d10: 6b 74 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b ktree)))). ;;
4d20: 20 63 72 65 61 74 65 20 74 68 65 20 64 69 72 65 create the dire
4d30: 63 74 6f 72 79 20 66 6f 72 20 74 68 65 20 74 65 ctory for the te
4d40: 73 74 73 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 sts dir links, t
4d50: 68 69 73 20 69 73 20 6e 65 65 64 65 64 20 6e 6f his is needed no
4d60: 20 6d 61 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a matter what....
4d70: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 64 69 (if (not (di
4d80: 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 rectory-exists?
4d90: 6c 6e 6b 62 61 73 65 29 29 0a 09 28 63 72 65 61 lnkbase))..(crea
4da0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b te-directory lnk
4db0: 62 61 73 65 20 23 74 29 29 0a 20 20 20 20 0a 20 base #t)). .
4dc0: 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 ;; update the
4dd0: 20 74 6f 70 74 65 73 74 20 72 65 63 6f 72 64 20 toptest record
4de0: 77 69 74 68 20 69 74 73 20 6c 6f 63 61 74 69 6f with its locatio
4df0: 6e 20 72 75 6e 64 69 72 2c 20 63 61 63 68 65 20 n rundir, cache
4e00: 74 68 65 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 the path. ;;
4e10: 54 68 69 73 20 77 61 73 73 20 68 69 67 68 6c 79 This wass highly
4e20: 20 69 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e inefficient, on
4e30: 65 20 64 62 20 77 72 69 74 65 20 66 6f 72 20 65 e db write for e
4e40: 76 65 72 79 20 73 75 62 74 65 73 74 2c 20 70 6f very subtest, po
4e50: 74 65 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b tentially. ;;
4e60: 20 74 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e thousands of un
4e70: 6e 65 63 65 73 73 61 72 79 20 75 70 64 61 74 65 necessary update
4e80: 73 2c 20 63 61 63 68 65 20 74 68 65 20 66 61 63 s, cache the fac
4e90: 74 20 69 74 20 77 61 73 20 73 65 74 20 61 6e 64 t it was set and
4ea0: 20 64 6f 6e 27 74 20 73 65 74 20 69 74 20 0a 20 don't set it .
4eb0: 20 20 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 ;; again. ..
4ec0: 20 20 20 3b 3b 20 4e 42 20 2d 20 54 68 69 73 20 ;; NB - This
4ed0: 69 73 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 20 72 is not working r
4ee0: 69 67 68 74 20 2d 20 73 6f 6d 65 20 74 6f 70 20 ight - some top
4ef0: 74 65 73 74 73 20 61 72 65 20 6e 6f 74 20 67 65 tests are not ge
4f00: 74 74 69 6e 67 20 74 68 65 20 70 61 74 68 20 73 tting the path s
4f10: 65 74 21 21 21 0a 0a 20 20 20 20 28 69 66 20 28 et!!!.. (if (
4f20: 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d not (hash-table-
4f30: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 ref/default *top
4f40: 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 test-paths* test
4f50: 6e 61 6d 65 20 23 66 29 29 0a 09 28 6c 65 74 2a name #f))..(let*
4f60: 20 28 28 74 65 73 74 69 6e 66 6f 20 20 20 20 20 ((testinfo
4f70: 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d (cdb:get-test-
4f80: 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 info-by-id *runr
4f90: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 emote* test-id))
4fa0: 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 73 74 ;; run-id test
4fb0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 name item-path))
4fc0: 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 2d 74 .. (curr-t
4fd0: 65 73 74 2d 70 61 74 68 20 28 69 66 20 74 65 73 est-path (if tes
4fe0: 74 69 6e 66 6f 20 28 64 62 3a 74 65 73 74 2d 67 tinfo (db:test-g
4ff0: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e et-rundir testin
5000: 66 6f 29 20 23 66 29 29 29 0a 09 20 20 28 68 61 fo) #f))).. (ha
5010: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
5020: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
5030: 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 74 stname curr-test
5040: 2d 70 61 74 68 29 0a 09 20 20 3b 3b 20 4e 42 2f -path).. ;; NB/
5050: 2f 20 57 61 73 20 74 68 69 73 20 66 6f 72 20 74 / Was this for t
5060: 68 65 20 74 65 73 74 20 6f 72 20 66 6f 72 20 74 he test or for t
5070: 68 65 20 70 61 72 65 6e 74 20 69 6e 20 61 6e 20 he parent in an
5080: 69 74 65 72 61 74 65 64 20 74 65 73 74 3f 0a 09 iterated test?..
5090: 20 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d (cdb:test-set-
50a0: 72 75 6e 64 69 72 21 20 2a 72 75 6e 72 65 6d 6f rundir! *runremo
50b0: 74 65 2a 20 72 75 6e 2d 69 64 20 74 65 73 74 6e te* run-id testn
50c0: 61 6d 65 20 22 22 20 6c 6e 6b 70 61 74 68 29 20 ame "" lnkpath)
50d0: 3b 3b 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 ;; toptest-path)
50e0: 0a 09 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 .. (if (or (not
50f0: 20 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 curr-test-path)
5100: 0a 09 09 20 20 28 6e 6f 74 20 28 64 69 72 65 63 ... (not (direc
5110: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 tory-exists? top
5120: 74 65 73 74 2d 70 61 74 68 29 29 29 0a 09 20 20 test-path)))..
5130: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
5140: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
5150: 20 22 43 72 65 61 74 69 6e 67 20 22 20 74 6f 70 "Creating " top
5160: 74 65 73 74 2d 70 61 74 68 20 22 20 61 6e 64 20 test-path " and
5170: 6c 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 29 0a link " lnkpath).
5180: 09 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ..(create-direct
5190: 6f 72 79 20 74 6f 70 74 65 73 74 2d 70 61 74 68 ory toptest-path
51a0: 20 23 74 29 0a 09 09 28 68 61 73 68 2d 74 61 62 #t)...(hash-tab
51b0: 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 le-set! *toptest
51c0: 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 -paths* testname
51d0: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 toptest-path)))
51e0: 29 29 0a 0a 20 20 20 20 3b 3b 20 4e 6f 77 20 63 )).. ;; Now c
51f0: 72 65 61 74 65 20 74 68 65 20 6c 69 6e 6b 20 66 reate the link f
5200: 72 6f 6d 20 74 68 65 20 74 65 73 74 20 70 61 74 rom the test pat
5210: 68 20 74 6f 20 74 68 65 20 6c 69 6e 6b 20 74 72 h to the link tr
5220: 65 65 2c 20 68 6f 77 65 76 65 72 0a 20 20 20 20 ee, however.
5230: 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 20 69 ;; if the test i
5240: 73 20 69 74 65 72 61 74 65 64 20 69 74 20 69 73 s iterated it is
5250: 20 6e 65 63 65 73 73 61 72 79 20 74 6f 20 63 72 necessary to cr
5260: 65 61 74 65 20 74 68 65 20 70 61 72 65 6e 74 20 eate the parent
5270: 70 61 74 68 0a 20 20 20 20 3b 3b 20 74 6f 20 74 path. ;; to t
5280: 68 65 20 69 74 65 72 61 74 69 6f 6e 2e 20 75 73 he iteration. us
5290: 65 20 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 e pathname-direc
52a0: 74 6f 72 79 20 74 6f 20 74 72 69 6d 20 74 68 65 tory to trim the
52b0: 20 70 61 74 68 20 62 79 20 6f 6e 65 0a 20 20 20 path by one.
52c0: 20 3b 3b 20 6c 65 76 65 6c 0a 20 20 20 20 28 69 ;; level. (i
52d0: 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 f (not not-itera
52e0: 74 65 64 29 20 3b 3b 20 69 2e 65 2e 20 69 74 65 ted) ;; i.e. ite
52f0: 72 61 74 65 64 0a 09 28 6c 65 74 20 28 28 69 74 rated..(let ((it
5300: 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 20 28 erated-parent (
5310: 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f pathname-directo
5320: 72 79 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 ry (conc lnkpath
5330: 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 "/" item-path))
5340: 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
5350: 6e 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 74 nt-info 2 "Creat
5360: 69 6e 67 20 69 74 65 72 61 74 65 64 20 70 61 72 ing iterated par
5370: 65 6e 74 20 22 20 69 74 65 72 61 74 65 64 2d 70 ent " iterated-p
5380: 61 72 65 6e 74 29 0a 09 20 20 28 63 72 65 61 74 arent).. (creat
5390: 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 65 72 e-directory iter
53a0: 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 29 29 ated-parent #t))
53b0: 29 0a 0a 20 20 20 20 28 69 66 20 28 73 79 6d 62 ).. (if (symb
53c0: 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 olic-link? lnkpa
53d0: 74 68 29 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 th) (delete-file
53e0: 20 6c 6e 6b 70 61 74 68 29 29 0a 20 20 20 20 28 lnkpath)). (
53f0: 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 66 69 6c if (not (or (fil
5400: 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 61 74 e-exists? lnkpat
5410: 68 29 0a 09 09 20 28 73 79 6d 62 6f 6c 69 63 2d h)... (symbolic-
5420: 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 29 29 link? lnkpath)))
5430: 0a 09 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c ..(create-symbol
5440: 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 74 2d ic-link toptest-
5450: 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 0a 20 path lnkpath)).
5460: 20 20 20 0a 20 20 20 20 3b 3b 20 54 68 65 20 74 . ;; The t
5470: 6f 70 74 65 73 74 20 70 61 74 68 20 68 61 73 20 optest path has
5480: 62 65 65 6e 20 63 72 65 61 74 65 64 2c 20 74 68 been created, th
5490: 65 20 6c 69 6e 6b 20 74 6f 20 74 68 65 20 74 65 e link to the te
54a0: 73 74 20 69 6e 20 74 68 65 20 6c 69 6e 6b 74 72 st in the linktr
54b0: 65 65 20 68 61 73 0a 20 20 20 20 3b 3b 20 62 65 ee has. ;; be
54c0: 65 6e 20 63 72 65 61 74 65 64 2e 20 4e 6f 77 2c en created. Now,
54d0: 20 69 66 20 74 68 69 73 20 69 73 20 61 6e 20 69 if this is an i
54e0: 74 65 72 61 74 65 64 20 74 65 73 74 20 74 68 65 terated test the
54f0: 20 72 65 61 6c 20 74 65 73 74 20 64 69 72 20 6d real test dir m
5500: 75 73 74 20 62 65 20 63 72 65 61 74 65 64 0a 20 ust be created.
5510: 20 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 2d (if (not not-
5520: 69 74 65 72 61 74 65 64 29 20 3b 3b 20 74 68 69 iterated) ;; thi
5530: 73 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 s is an iterated
5540: 20 74 65 73 74 0a 09 28 6c 65 74 20 28 28 6c 6e test..(let ((ln
5550: 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e ktarget (conc ln
5560: 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 kpath "/" item-p
5570: 61 74 68 29 29 29 0a 09 20 20 28 64 65 62 75 67 ath))).. (debug
5580: 3a 70 72 69 6e 74 20 32 20 22 53 65 74 74 69 6e :print 2 "Settin
5590: 67 20 75 70 20 73 75 62 20 74 65 73 74 20 72 75 g up sub test ru
55a0: 6e 20 61 72 65 61 22 29 0a 09 20 20 28 64 65 62 n area").. (deb
55b0: 75 67 3a 70 72 69 6e 74 20 32 20 22 20 2d 20 63 ug:print 2 " - c
55c0: 72 65 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 reating run area
55d0: 20 69 6e 20 22 20 74 65 73 74 2d 70 61 74 68 29 in " test-path)
55e0: 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
55f0: 63 74 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 ctory test-path
5600: 23 74 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 20 #t) ;; (system
5610: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
5620: 22 20 74 65 73 74 2d 70 61 74 68 29 29 0a 09 20 " test-path))..
5630: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
5640: 0a 09 09 20 20 20 20 20 20 20 22 20 2d 20 63 72 ... " - cr
5650: 65 61 74 69 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d eating link from
5660: 3a 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 5c : " test-path "\
5670: 6e 22 0a 09 09 20 20 20 20 20 20 20 22 20 20 20 n"... "
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5690: 74 6f 3a 20 22 20 6c 6e 6b 74 61 72 67 65 74 29 to: " lnktarget)
56a0: 0a 09 20 20 3b 3b 20 28 63 72 65 61 74 65 2d 64 .. ;; (create-d
56b0: 69 72 65 63 74 6f 72 79 20 6c 6e 6b 70 61 74 68 irectory lnkpath
56c0: 20 23 74 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 #t) ;; (system
56d0: 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 (conc "mkdir -p
56e0: 20 22 20 6c 6e 6b 70 61 74 68 29 29 0a 0a 09 20 " lnkpath))...
56f0: 20 3b 3b 20 49 66 20 74 68 65 72 65 20 69 73 20 ;; If there is
5700: 61 6c 72 65 61 64 79 20 61 20 73 79 6d 6c 69 6e already a symlin
5710: 6b 20 64 65 6c 65 74 65 20 69 74 20 61 6e 64 20 k delete it and
5720: 72 65 63 72 65 61 74 65 20 69 74 2e 0a 09 20 20 recreate it...
5730: 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 (if (symbolic-li
5740: 6e 6b 3f 20 6c 6e 6b 74 61 72 67 65 74 29 20 20 nk? lnktarget)
5750: 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 (delete-file
5760: 6c 6e 6b 74 61 72 67 65 74 29 29 0a 09 20 20 28 lnktarget)).. (
5770: 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 if (not (file-ex
5780: 69 73 74 73 3f 20 6c 6e 6b 74 61 72 67 65 74 29 ists? lnktarget)
5790: 29 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c ) (create-symbol
57a0: 69 63 2d 6c 69 6e 6b 20 74 65 73 74 2d 70 61 74 ic-link test-pat
57b0: 68 20 6c 6e 6b 74 61 72 67 65 74 29 29 29 29 0a h lnktarget)))).
57c0: 0a 20 20 20 20 3b 3b 20 49 20 73 75 73 70 65 63 . ;; I suspec
57d0: 74 20 74 68 69 73 20 73 65 63 74 69 6f 6e 20 77 t this section w
57e0: 61 73 20 64 65 6c 65 74 69 6e 67 20 74 65 73 74 as deleting test
57f0: 20 64 69 72 65 63 74 6f 72 69 65 73 20 75 6e 64 directories und
5800: 65 72 20 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 er some . ;;
5810: 77 69 65 72 64 20 73 69 74 61 74 69 6f 6e 73 3f wierd sitations?
5820: 20 54 68 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 This doesn't ma
5830: 6b 65 20 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 ke sense - reena
5840: 62 6c 69 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 bling the rm -f
5850: 0a 20 20 20 20 3b 3b 20 49 20 68 6f 6e 65 73 74 . ;; I honest
5860: 6c 79 20 64 6f 6e 27 74 20 72 65 6d 65 6d 62 65 ly don't remembe
5870: 72 20 2a 77 68 79 2a 20 74 68 69 73 20 63 68 75 r *why* this chu
5880: 6e 6b 20 77 61 73 20 6e 65 65 64 65 64 2e 2e 2e nk was needed...
5890: 0a 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 28 74 . ;; (let ((t
58a0: 65 73 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e estlink (conc ln
58b0: 6b 70 61 74 68 20 22 2f 22 20 74 65 73 74 6e 61 kpath "/" testna
58c0: 6d 65 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 me))). ;; (
58d0: 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 if (and (file-ex
58e0: 69 73 74 73 3f 20 74 65 73 74 6c 69 6e 6b 29 0a ists? testlink).
58f0: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
5900: 20 20 28 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 (or (regular-f
5910: 69 6c 65 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 ile? testlink).
5920: 20 20 20 3b 3b 20 20 20 20 20 09 20 20 20 28 73 ;; . (s
5930: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 74 65 ymbolic-link? te
5940: 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b stlink))). ;;
5950: 20 20 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 (system (
5960: 63 6f 6e 63 20 22 72 6d 20 2d 66 20 22 20 74 65 conc "rm -f " te
5970: 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b stlink))). ;;
5980: 20 20 20 28 73 79 73 74 65 6d 20 20 28 63 6f 6e (system (con
5990: 63 20 22 6c 6e 20 2d 73 66 20 22 20 74 65 73 74 c "ln -sf " test
59a0: 2d 70 61 74 68 20 22 20 22 20 74 65 73 74 6c 69 -path " " testli
59b0: 6e 6b 29 29 29 0a 20 20 20 20 28 69 66 20 28 64 nk))). (if (d
59c0: 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 irectory? test-p
59d0: 61 74 68 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ath)..(begin..
59e0: 28 6c 65 74 2a 20 28 28 63 6d 64 20 20 20 20 28 (let* ((cmd (
59f0: 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d 61 76 22 conc "rsync -av"
5a00: 20 28 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 (if (debug:debu
5a10: 67 2d 6d 6f 64 65 20 31 29 20 22 22 20 22 71 22 g-mode 1) "" "q"
5a20: 29 20 22 20 22 20 74 65 73 74 2d 73 72 63 2d 70 ) " " test-src-p
5a30: 61 74 68 20 22 2f 20 22 20 74 65 73 74 2d 70 61 ath "/ " test-pa
5a40: 74 68 20 22 2f 22 29 29 0a 09 09 20 28 73 74 61 th "/"))... (sta
5a50: 74 75 73 20 28 73 79 73 74 65 6d 20 63 6d 64 29 tus (system cmd)
5a60: 29 29 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 )).. (if (not
5a70: 20 28 65 71 3f 20 73 74 61 74 75 73 20 30 29 29 (eq? status 0))
5a80: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
5a90: 32 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 2 "ERROR: proble
5aa0: 6d 20 77 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c m with running \
5ab0: 22 22 20 63 6d 64 20 22 5c 22 22 29 29 29 0a 09 "" cmd "\"")))..
5ac0: 20 20 28 6c 69 73 74 20 6c 6e 6b 70 61 74 68 66 (list lnkpathf
5ad0: 20 6c 6e 6b 70 61 74 68 20 29 29 0a 09 28 6c 69 lnkpath ))..(li
5ae0: 73 74 20 23 66 20 23 66 29 29 29 29 0a 0a 3b 3b st #f #f))))..;;
5af0: 20 31 2e 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 1. look though
5b00: 64 69 73 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 disks list for d
5b10: 69 73 6b 20 77 69 74 68 20 6d 6f 73 74 20 73 70 isk with most sp
5b20: 61 63 65 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 ace.;; 2. create
5b30: 20 72 75 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b run dir on disk
5b40: 2c 20 70 61 74 68 20 6e 61 6d 65 20 69 73 20 6d , path name is m
5b50: 65 61 6e 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 eaningful.;; 3.
5b60: 63 72 65 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d create link from
5b70: 20 72 75 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 run dir to mega
5b80: 74 65 73 74 20 72 75 6e 73 20 61 72 65 61 20 0a test runs area .
5b90: 3b 3b 20 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 ;; 4. remotely r
5ba0: 75 6e 20 74 68 65 20 74 65 73 74 20 6f 6e 20 61 un the test on a
5bb0: 6c 6c 6f 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b llocated host.;;
5bc0: 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 - could be s
5bd0: 73 68 20 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 sh to host from
5be0: 68 6f 73 74 73 20 74 61 62 6c 65 20 28 75 70 64 hosts table (upd
5bf0: 61 74 65 20 72 65 67 75 6c 61 72 6c 79 20 77 69 ate regularly wi
5c00: 74 68 20 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d th load).;; -
5c10: 20 63 6f 75 6c 64 20 62 65 20 6e 65 74 62 61 74 could be netbat
5c20: 63 68 0a 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e ch.;; (laun
5c30: 63 68 2d 74 65 73 74 20 64 62 20 28 63 61 64 72 ch-test db (cadr
5c40: 20 73 74 61 74 75 73 29 20 74 65 73 74 2d 63 6f status) test-co
5c50: 6e 66 29 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 nf)).(define (la
5c60: 75 6e 63 68 2d 74 65 73 74 20 64 62 20 72 75 6e unch-test db run
5c70: 2d 69 64 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 -id runname test
5c80: 2d 63 6f 6e 66 20 6b 65 79 76 61 6c 6c 73 74 20 -conf keyvallst
5c90: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 70 test-name test-p
5ca0: 61 74 68 20 69 74 65 6d 64 61 74 20 70 61 72 61 ath itemdat para
5cb0: 6d 73 29 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 ms). (change-di
5cc0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
5cd0: 2a 29 0a 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 *). (alist->env
5ce0: 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 -vars ;; consoli
5cf0: 64 61 74 65 20 74 68 69 73 20 63 6f 64 65 20 77 date this code w
5d00: 69 74 68 20 74 68 65 20 63 6f 64 65 20 69 6e 20 ith the code in
5d10: 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 megatest.scm for
5d20: 20 22 2d 65 78 65 63 75 74 65 22 0a 20 20 20 28 "-execute". (
5d30: 6c 69 73 74 20 3b 3b 20 28 6c 69 73 74 20 22 4d list ;; (list "M
5d40: 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 T_TEST_RUN_DIR"
5d50: 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 28 work-area). (
5d60: 6c 69 73 74 20 22 4d 54 5f 52 55 4e 5f 41 52 45 list "MT_RUN_ARE
5d70: 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 A_HOME" *toppath
5d80: 2a 29 0a 20 20 20 20 28 6c 69 73 74 20 22 4d 54 *). (list "MT
5d90: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
5da0: 2d 6e 61 6d 65 29 0a 20 20 20 20 3b 3b 20 28 6c -name). ;; (l
5db0: 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 ist "MT_ITEM_INF
5dc0: 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 O" (conc itemdat
5dd0: 29 29 20 0a 20 20 20 20 28 6c 69 73 74 20 22 4d )) . (list "M
5de0: 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
5df0: 6e 61 6d 65 29 0a 20 20 20 20 3b 3b 20 28 6c 69 name). ;; (li
5e00: 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 st "MT_TARGET"
5e10: 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 20 20 20 mt_target).
5e20: 20 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 )). (let* ((us
5e30: 65 73 68 65 6c 6c 20 20 20 28 63 6f 6e 66 69 67 eshell (config
5e40: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
5e50: 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
5e60: 20 20 20 22 75 73 65 73 68 65 6c 6c 22 29 29 0a "useshell")).
5e70: 09 20 28 6c 61 75 6e 63 68 65 72 20 20 20 28 63 . (launcher (c
5e80: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
5e90: 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f nfigdat* "jobtoo
5ea0: 6c 73 22 20 20 20 20 20 22 6c 61 75 6e 63 68 65 ls" "launche
5eb0: 72 22 29 29 0a 09 20 28 72 75 6e 73 63 72 69 70 r")).. (runscrip
5ec0: 74 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 t (config-looku
5ed0: 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 73 p test-conf "s
5ee0: 65 74 75 70 22 20 20 20 20 20 20 20 20 22 72 75 etup" "ru
5ef0: 6e 73 63 72 69 70 74 22 29 29 0a 09 20 28 65 7a nscript")).. (ez
5f00: 73 74 65 70 73 20 20 20 20 28 3e 20 28 6c 65 6e steps (> (len
5f10: 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d gth (hash-table-
5f20: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
5f30: 2d 63 6f 6e 66 20 22 65 7a 73 74 65 70 73 22 20 -conf "ezsteps"
5f40: 27 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f 6e '())) 0)) ;; don
5f50: 27 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 20 't send all the
5f60: 73 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 20 steps, could be
5f70: 62 69 67 0a 09 20 28 64 69 73 6b 73 70 61 63 65 big.. (diskspace
5f80: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
5f90: 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 test-conf "re
5fa0: 71 75 69 72 65 6d 65 6e 74 73 22 20 22 64 69 73 quirements" "dis
5fb0: 6b 73 70 61 63 65 22 29 29 0a 09 20 28 6d 65 6d kspace")).. (mem
5fc0: 6f 72 79 20 20 20 20 20 28 63 6f 6e 66 69 67 2d ory (config-
5fd0: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
5fe0: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
5ff0: 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 20 28 " "memory")).. (
6000: 68 6f 73 74 73 20 20 20 20 20 20 28 63 6f 6e 66 hosts (conf
6010: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
6020: 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 gdat* "jobtools"
6030: 20 20 20 20 20 22 77 6f 72 6b 68 6f 73 74 73 22 "workhosts"
6040: 29 29 0a 09 20 28 72 65 6d 6f 74 65 2d 6d 65 67 )).. (remote-meg
6050: 61 74 65 73 74 20 28 63 6f 6e 66 69 67 2d 6c 6f atest (config-lo
6060: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
6070: 20 22 73 65 74 75 70 22 20 22 65 78 65 63 75 74 "setup" "execut
6080: 61 62 6c 65 22 29 29 0a 09 20 3b 3b 20 46 49 58 able")).. ;; FIX
6090: 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 ME SOMEDAY: not
60a0: 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 69 73 good how this is
60b0: 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 69 73 so obtuse, this
60c0: 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 20 3b hack is to .. ;
60d0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
60e0: 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 66 allow running f
60f0: 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e 20 45 rom dashboard. E
6100: 78 74 72 61 63 74 20 74 68 65 20 70 61 74 68 0a xtract the path.
6110: 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 . ;;
6120: 20 20 20 20 66 72 6f 6d 20 74 68 65 20 63 61 6c from the cal
6130: 6c 65 64 20 6d 65 67 61 74 65 73 74 20 61 6e 64 led megatest and
6140: 20 63 6f 6e 76 65 72 74 20 64 61 73 68 62 6f 61 convert dashboa
6150: 72 64 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 rd.. ;;
6160: 20 20 20 20 09 20 20 6f 72 20 64 62 6f 61 72 64 . or dboard
6170: 20 74 6f 20 6d 65 67 61 74 65 73 74 0a 09 20 28 to megatest.. (
6180: 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 local-megatest
6190: 28 6c 65 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 (let* ((lm (car
61a0: 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 20 28 (argv)))..... (
61b0: 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 dir (pathname-di
61c0: 72 65 63 74 6f 72 79 20 6c 6d 29 29 0a 09 09 09 rectory lm))....
61d0: 09 20 28 65 78 65 20 28 70 61 74 68 6e 61 6d 65 . (exe (pathname
61e0: 2d 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 -strip-directory
61f0: 20 6c 6d 29 29 29 0a 09 09 09 20 20 20 20 28 63 lm))).... (c
6200: 6f 6e 63 20 28 69 66 20 64 69 72 20 28 63 6f 6e onc (if dir (con
6210: 63 20 64 69 72 20 22 2f 22 29 20 22 22 29 0a 09 c dir "/") "")..
6220: 09 09 09 20 20 28 63 61 73 65 20 28 73 74 72 69 ... (case (stri
6230: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 65 78 65 29 0a ng->symbol exe).
6240: 09 09 09 09 20 20 20 20 28 28 64 62 6f 61 72 64 .... ((dboard
6250: 29 20 20 20 20 22 6d 65 67 61 74 65 73 74 22 29 ) "megatest")
6260: 0a 09 09 09 09 20 20 20 20 28 28 6d 74 65 73 74 ..... ((mtest
6270: 29 20 20 20 20 20 22 6d 65 67 61 74 65 73 74 22 ) "megatest"
6280: 29 0a 09 09 09 09 20 20 20 20 28 28 64 61 73 68 )..... ((dash
6290: 62 6f 61 72 64 29 20 22 6d 65 67 61 74 65 73 74 board) "megatest
62a0: 22 29 0a 09 09 09 09 20 20 20 20 28 65 6c 73 65 ")..... (else
62b0: 20 65 78 65 29 29 29 29 29 0a 09 20 28 74 65 73 exe))))).. (tes
62c0: 74 2d 73 69 67 20 20 20 28 63 6f 6e 63 20 74 65 t-sig (conc te
62d0: 73 74 2d 6e 61 6d 65 20 22 3a 22 20 28 69 74 65 st-name ":" (ite
62e0: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
62f0: 6d 64 61 74 29 29 29 20 3b 3b 20 74 65 73 74 2d mdat))) ;; test-
6300: 70 61 74 68 20 69 73 20 74 68 65 20 66 75 6c 6c path is the full
6310: 20 70 61 74 68 20 69 6e 63 6c 75 64 69 6e 67 20 path including
6320: 74 68 65 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 the item-path..
6330: 28 77 6f 72 6b 2d 61 72 65 61 20 20 23 66 29 0a (work-area #f).
6340: 09 20 28 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d . (toptest-work-
6350: 61 72 65 61 20 23 66 29 20 3b 3b 20 66 6f 72 20 area #f) ;; for
6360: 69 74 65 72 61 74 65 64 20 74 65 73 74 73 20 74 iterated tests t
6370: 68 65 20 74 6f 70 20 74 65 73 74 20 63 6f 6e 74 he top test cont
6380: 61 69 6e 73 20 64 61 74 61 20 72 65 6c 65 76 61 ains data releva
6390: 6e 74 20 66 6f 72 20 61 6c 6c 0a 09 20 28 64 69 nt for all.. (di
63a0: 73 6b 70 61 74 68 20 20 20 23 66 29 0a 09 20 28 skpath #f).. (
63b0: 63 6d 64 70 61 72 6d 73 20 20 20 23 66 29 0a 09 cmdparms #f)..
63c0: 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 23 66 29 (fullcmd #f)
63d0: 20 3b 3b 20 28 64 65 66 69 6e 65 20 61 20 28 77 ;; (define a (w
63e0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 ith-output-to-st
63f0: 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 28 ring (lambda ()(
6400: 77 72 69 74 65 20 78 29 29 29 29 0a 09 20 28 6d write x)))).. (m
6410: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 23 66 t-bindir-path #f
6420: 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 28 ).. (item-path (
6430: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
6440: 69 74 65 6d 64 61 74 29 29 0a 09 20 28 74 65 73 itemdat)).. (tes
6450: 74 2d 69 64 20 20 20 20 28 63 64 62 3a 72 65 6d t-id (cdb:rem
6460: 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 ote-run db:get-t
6470: 65 73 74 2d 69 64 20 23 66 20 72 75 6e 2d 69 64 est-id #f run-id
6480: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
6490: 70 61 74 68 29 29 0a 09 20 28 74 65 73 74 69 6e path)).. (testin
64a0: 66 6f 20 20 20 28 63 64 62 3a 67 65 74 2d 74 65 fo (cdb:get-te
64b0: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 st-info-by-id *r
64c0: 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 unremote* test-i
64d0: 64 29 29 0a 09 20 28 6d 74 5f 74 61 72 67 65 74 d)).. (mt_target
64e0: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
64f0: 70 65 72 73 65 20 28 6d 61 70 20 63 61 64 72 20 perse (map cadr
6500: 6b 65 79 76 61 6c 6c 73 74 29 20 22 2f 22 29 29 keyvallst) "/"))
6510: 0a 09 20 28 64 65 62 75 67 2d 70 61 72 61 6d 20 .. (debug-param
6520: 28 61 70 70 65 6e 64 20 28 69 66 20 28 61 72 67 (append (if (arg
6530: 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 s:get-arg "-debu
6540: 67 22 29 20 20 28 6c 69 73 74 20 22 2d 64 65 62 g") (list "-deb
6550: 75 67 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ug" (args:get-ar
6560: 67 20 22 2d 64 65 62 75 67 22 29 29 20 27 28 29 g "-debug")) '()
6570: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if (
6580: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
6590: 6f 67 67 69 6e 67 22 29 28 6c 69 73 74 20 22 2d ogging")(list "-
65a0: 6c 6f 67 67 69 6e 67 22 29 20 27 28 29 29 29 29 logging") '())))
65b0: 29 0a 20 20 20 20 28 69 66 20 68 6f 73 74 73 20 ). (if hosts
65c0: 28 73 65 74 21 20 68 6f 73 74 73 20 28 73 74 72 (set! hosts (str
65d0: 69 6e 67 2d 73 70 6c 69 74 20 68 6f 73 74 73 29 ing-split hosts)
65e0: 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 74 68 )). ;; set th
65f0: 65 20 6d 65 67 61 74 65 73 74 20 74 6f 20 62 65 e megatest to be
6600: 20 63 61 6c 6c 65 64 20 6f 6e 20 74 68 65 20 72 called on the r
6610: 65 6d 6f 74 65 20 68 6f 73 74 0a 20 20 20 20 28 emote host. (
6620: 69 66 20 28 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d if (not remote-m
6630: 65 67 61 74 65 73 74 29 28 73 65 74 21 20 72 65 egatest)(set! re
6640: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 6c 6f mote-megatest lo
6650: 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 29 20 3b cal-megatest)) ;
6660: 3b 20 22 6d 65 67 61 74 65 73 74 22 29 29 0a 20 ; "megatest")).
6670: 20 20 20 28 73 65 74 21 20 6d 74 2d 62 69 6e 64 (set! mt-bind
6680: 69 72 2d 70 61 74 68 20 28 70 61 74 68 6e 61 6d ir-path (pathnam
6690: 65 2d 64 69 72 65 63 74 6f 72 79 20 72 65 6d 6f e-directory remo
66a0: 74 65 2d 6d 65 67 61 74 65 73 74 29 29 0a 20 20 te-megatest)).
66b0: 20 20 28 69 66 20 6c 61 75 6e 63 68 65 72 20 28 (if launcher (
66c0: 73 65 74 21 20 6c 61 75 6e 63 68 65 72 20 28 73 set! launcher (s
66d0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 6c 61 75 6e tring-split laun
66e0: 63 68 65 72 29 29 29 0a 20 20 20 20 3b 3b 20 73 cher))). ;; s
66f0: 65 74 20 75 70 20 74 68 65 20 72 75 6e 20 77 6f et up the run wo
6700: 72 6b 20 61 72 65 61 20 66 6f 72 20 74 68 69 73 rk area for this
6710: 20 74 65 73 74 0a 20 20 20 20 28 73 65 74 21 20 test. (set!
6720: 64 69 73 6b 70 61 74 68 20 28 67 65 74 2d 62 65 diskpath (get-be
6730: 73 74 2d 64 69 73 6b 20 2a 63 6f 6e 66 69 67 64 st-disk *configd
6740: 61 74 2a 29 29 0a 20 20 20 20 28 69 66 20 64 69 at*)). (if di
6750: 73 6b 70 61 74 68 0a 09 28 6c 65 74 20 28 28 64 skpath..(let ((d
6760: 61 74 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c at (open-run-cl
6770: 6f 73 65 20 63 72 65 61 74 65 2d 77 6f 72 6b 2d ose create-work-
6780: 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 74 area db run-id t
6790: 65 73 74 2d 69 64 20 74 65 73 74 2d 70 61 74 68 est-id test-path
67a0: 20 64 69 73 6b 70 61 74 68 20 74 65 73 74 2d 6e diskpath test-n
67b0: 61 6d 65 20 69 74 65 6d 64 61 74 29 29 29 0a 09 ame itemdat)))..
67c0: 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
67d0: 61 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 20 a (car dat))..
67e0: 28 73 65 74 21 20 74 6f 70 74 65 73 74 2d 77 6f (set! toptest-wo
67f0: 72 6b 2d 61 72 65 61 20 28 63 61 64 72 20 64 61 rk-area (cadr da
6800: 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 t)).. (debug:pr
6810: 69 6e 74 2d 69 6e 66 6f 20 32 20 22 55 73 69 6e int-info 2 "Usin
6820: 67 20 77 6f 72 6b 20 61 72 65 61 20 22 20 77 6f g work area " wo
6830: 72 6b 2d 61 72 65 61 29 29 0a 09 28 62 65 67 69 rk-area))..(begi
6840: 6e 0a 09 20 20 28 73 65 74 21 20 77 6f 72 6b 2d n.. (set! work-
6850: 61 72 65 61 20 28 63 6f 6e 63 20 74 65 73 74 2d area (conc test-
6860: 70 61 74 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 path "/tmp_run")
6870: 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 ).. (create-dir
6880: 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 ectory work-area
6890: 20 23 74 29 0a 09 20 20 28 64 65 62 75 67 3a 70 #t).. (debug:p
68a0: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
68b0: 20 4e 6f 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 No disk work ar
68c0: 65 61 20 73 70 65 63 69 66 69 65 64 20 2d 20 72 ea specified - r
68d0: 75 6e 6e 69 6e 67 20 69 6e 20 74 68 65 20 74 65 unning in the te
68e0: 73 74 20 64 69 72 65 63 74 6f 72 79 20 75 6e 64 st directory und
68f0: 65 72 20 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 er tmp_run"))).
6900: 20 20 20 28 73 65 74 21 20 63 6d 64 70 61 72 6d (set! cmdparm
6910: 73 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 34 s (base64:base64
6920: 2d 65 6e 63 6f 64 65 20 0a 09 09 20 20 20 20 28 -encode ... (
6930: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
6940: 74 72 69 6e 67 0a 09 09 20 20 20 20 20 20 28 6c tring... (l
6950: 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 ambda () ;; (lis
6960: 74 20 27 68 6f 73 74 73 20 20 20 20 20 68 6f 73 t 'hosts hos
6970: 74 73 29 0a 09 09 09 28 77 72 69 74 65 20 28 6c ts)....(write (l
6980: 69 73 74 20 28 6c 69 73 74 20 27 74 65 73 74 70 ist (list 'testp
6990: 61 74 68 20 20 74 65 73 74 2d 70 61 74 68 29 0a ath test-path).
69a0: 09 09 09 09 20 20 20 20 20 3b 3b 20 28 6c 69 73 .... ;; (lis
69b0: 74 20 27 72 75 6e 72 65 6d 6f 74 65 20 2a 72 75 t 'runremote *ru
69c0: 6e 72 65 6d 6f 74 65 2a 29 0a 09 09 09 09 20 20 nremote*).....
69d0: 20 20 20 28 6c 69 73 74 20 27 74 72 61 6e 73 70 (list 'transp
69e0: 6f 72 74 20 28 63 6f 6e 63 20 2a 74 72 61 6e 73 ort (conc *trans
69f0: 70 6f 72 74 2d 74 79 70 65 2a 29 29 0a 09 09 09 port-type*))....
6a00: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 6f 70 . (list 'top
6a10: 70 61 74 68 20 20 20 2a 74 6f 70 70 61 74 68 2a path *toppath*
6a20: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
6a30: 20 27 77 6f 72 6b 2d 61 72 65 61 20 77 6f 72 6b 'work-area work
6a40: 2d 61 72 65 61 29 0a 09 09 09 09 20 20 20 20 20 -area).....
6a50: 28 6c 69 73 74 20 27 74 65 73 74 2d 6e 61 6d 65 (list 'test-name
6a60: 20 74 65 73 74 2d 6e 61 6d 65 29 20 0a 09 09 09 test-name) ....
6a70: 09 20 20 20 20 20 28 6c 69 73 74 20 27 72 75 6e . (list 'run
6a80: 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 74 script runscript
6a90: 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 ) ..... (lis
6aa0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 72 75 6e t 'run-id run
6ab0: 2d 69 64 20 20 20 29 0a 09 09 09 09 20 20 20 20 -id ).....
6ac0: 20 28 6c 69 73 74 20 27 74 65 73 74 2d 69 64 20 (list 'test-id
6ad0: 20 20 74 65 73 74 2d 69 64 20 20 29 0a 09 09 09 test-id )....
6ae0: 09 20 20 20 20 20 28 6c 69 73 74 20 27 69 74 65 . (list 'ite
6af0: 6d 64 61 74 20 20 20 69 74 65 6d 64 61 74 20 20 mdat itemdat
6b00: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
6b10: 20 27 6d 65 67 61 74 65 73 74 20 20 72 65 6d 6f 'megatest remo
6b20: 74 65 2d 6d 65 67 61 74 65 73 74 29 0a 09 09 09 te-megatest)....
6b30: 09 20 20 20 20 20 28 6c 69 73 74 20 27 65 7a 73 . (list 'ezs
6b40: 74 65 70 73 20 20 20 65 7a 73 74 65 70 73 29 20 teps ezsteps)
6b50: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
6b60: 27 74 61 72 67 65 74 20 20 20 20 6d 74 5f 74 61 'target mt_ta
6b70: 72 67 65 74 29 0a 09 09 09 09 20 20 20 20 20 28 rget)..... (
6b80: 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 20 list 'env-ovrd
6b90: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
6ba0: 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 default *configd
6bb0: 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 at* "env-overrid
6bc0: 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 20 20 e" '())) .....
6bd0: 20 20 20 28 6c 69 73 74 20 27 73 65 74 2d 76 61 (list 'set-va
6be0: 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 20 28 rs (if params (
6bf0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
6c00: 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 22 2d efault params "-
6c10: 73 65 74 76 61 72 73 22 20 23 66 29 29 29 0a 09 setvars" #f)))..
6c20: 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 72 ... (list 'r
6c30: 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 6d 65 unname runname
6c40: 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 )..... (list
6c50: 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 'mt-bindir-path
6c60: 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 mt-bindir-path)
6c70: 29 29 29 29 29 29 20 3b 3b 20 28 73 74 72 69 6e )))))) ;; (strin
6c80: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 g-intersperse ke
6c90: 79 76 61 6c 6c 73 74 20 22 20 22 29 29 29 29 0a yvallst " ")))).
6ca0: 20 20 20 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 74 ;; clean out
6cb0: 20 73 74 65 70 20 72 65 63 6f 72 64 73 20 66 72 step records fr
6cc0: 6f 6d 20 70 72 65 76 69 6f 75 73 20 72 75 6e 20 om previous run
6cd0: 69 66 20 74 68 65 79 20 65 78 69 73 74 0a 20 20 if they exist.
6ce0: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
6cf0: 74 2d 69 6e 66 6f 20 34 20 22 46 49 58 4d 45 45 t-info 4 "FIXMEE
6d00: 45 45 45 21 21 21 21 20 54 68 69 73 20 63 61 6e EEE!!!! This can
6d10: 20 62 65 20 72 65 6d 6f 76 65 64 20 73 6f 6d 65 be removed some
6d20: 20 64 61 79 2c 20 70 65 72 68 61 70 73 20 6d 6f day, perhaps mo
6d30: 76 65 20 61 6c 6c 20 74 65 73 74 20 72 65 63 6f ve all test reco
6d40: 72 64 73 20 74 6f 20 74 68 65 20 74 65 73 74 20 rds to the test
6d50: 64 62 3f 22 29 0a 20 20 20 20 3b 3b 20 28 6f 70 db?"). ;; (op
6d60: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 64 62 3a en-run-close db:
6d70: 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 delete-test-step
6d80: 2d 72 65 63 6f 72 64 73 20 64 62 20 74 65 73 74 -records db test
6d90: 2d 69 64 29 0a 20 20 20 20 28 63 68 61 6e 67 65 -id). (change
6da0: 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d -directory work-
6db0: 61 72 65 61 29 20 3b 3b 20 73 6f 20 74 68 61 74 area) ;; so that
6dc0: 20 6c 6f 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 log files from
6dd0: 74 68 65 20 6c 61 75 6e 63 68 20 70 72 6f 63 65 the launch proce
6de0: 73 73 20 64 6f 6e 27 74 20 63 6c 75 74 74 65 72 ss don't clutter
6df0: 20 74 68 65 20 74 65 73 74 20 64 69 72 0a 20 20 the test dir.
6e00: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
6e10: 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 t-status! test-i
6e20: 64 20 22 4c 41 55 4e 43 48 45 44 22 20 22 6e 2f d "LAUNCHED" "n/
6e30: 61 22 20 23 66 20 23 66 29 20 3b 3b 20 28 69 66 a" #f #f) ;; (if
6e40: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 launch-results
6e50: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 22 launch-results "
6e60: 46 41 49 4c 45 44 22 29 29 0a 20 20 20 20 28 63 FAILED")). (c
6e70: 6f 6e 64 0a 20 20 20 20 20 28 28 61 6e 64 20 6c ond. ((and l
6e80: 61 75 6e 63 68 65 72 20 68 6f 73 74 73 29 20 3b auncher hosts) ;
6e90: 3b 20 6d 75 73 74 20 62 65 20 75 73 69 6e 67 20 ; must be using
6ea0: 73 73 68 20 68 6f 73 74 6e 61 6d 65 0a 20 20 20 ssh hostname.
6eb0: 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
6ec0: 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
6ed0: 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 r (car hosts)(li
6ee0: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
6ef0: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
6f00: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
6f10: 20 64 65 62 75 67 2d 70 61 72 61 6d 29 29 29 0a debug-param))).
6f20: 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 ;; (set! fu
6f30: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 llcmd (append la
6f40: 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 uncher (car host
6f50: 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d s)(list remote-m
6f60: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
6f70: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
6f80: 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 28 6c arms)))). (l
6f90: 61 75 6e 63 68 65 72 0a 20 20 20 20 20 20 28 73 auncher. (s
6fa0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
6fb0: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 end launcher (li
6fc0: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
6fd0: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
6fe0: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
6ff0: 20 64 65 62 75 67 2d 70 61 72 61 6d 29 29 29 0a debug-param))).
7000: 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 ;; (set! fu
7010: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 llcmd (append la
7020: 75 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d uncher (list rem
7030: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 ote-megatest tes
7040: 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 t-sig "-execute"
7050: 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 cmdparms)))).
7060: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 (else. (
7070: 69 66 20 28 6e 6f 74 20 75 73 65 73 68 65 6c 6c if (not useshell
7080: 29 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 )(debug:print 0
7090: 22 57 41 52 4e 49 4e 47 3a 20 69 6e 74 65 72 6e "WARNING: intern
70a0: 61 6c 20 6c 61 75 6e 63 68 69 6e 67 20 77 69 6c al launching wil
70b0: 6c 20 6e 6f 74 20 77 6f 72 6b 20 77 65 6c 6c 20 l not work well
70c0: 77 69 74 68 6f 75 74 20 5c 22 75 73 65 73 68 65 without \"useshe
70d0: 6c 6c 20 79 65 73 5c 22 20 69 6e 20 79 6f 75 72 ll yes\" in your
70e0: 20 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 73 65 63 74 [jobtools] sect
70f0: 69 6f 6e 22 29 29 0a 20 20 20 20 20 20 28 73 65 ion")). (se
7100: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
7110: 6e 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d nd (list remote-
7120: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
7130: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
7140: 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 parms) debug-par
7150: 61 6d 20 28 6c 69 73 74 20 28 69 66 20 75 73 65 am (list (if use
7160: 73 68 65 6c 6c 20 22 26 22 20 22 22 29 29 29 29 shell "&" ""))))
7170: 29 29 0a 20 20 20 20 3b 3b 20 28 73 65 74 21 20 )). ;; (set!
7180: 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 72 65 fullcmd (list re
7190: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
71a0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
71b0: 22 20 63 6d 64 70 61 72 6d 73 20 28 69 66 20 75 " cmdparms (if u
71c0: 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 29 29 seshell "&" ""))
71d0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 72 67 ))). (if (arg
71e0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 s:get-arg "-xter
71f0: 6d 22 29 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 m")(set! fullcmd
7200: 20 28 61 70 70 65 6e 64 20 66 75 6c 6c 63 6d 64 (append fullcmd
7210: 20 28 6c 69 73 74 20 22 2d 78 74 65 72 6d 22 29 (list "-xterm")
7220: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
7230: 72 69 6e 74 20 31 20 22 4c 61 75 6e 63 68 69 6e rint 1 "Launchin
7240: 67 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 g " work-area).
7250: 20 20 20 3b 3b 20 73 65 74 20 70 72 65 2d 6c 61 ;; set pre-la
7260: 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 20 62 65 unch-env-vars be
7270: 66 6f 72 65 20 6c 61 75 6e 63 68 69 6e 67 2c 20 fore launching,
7280: 6b 65 65 70 20 74 68 65 20 76 61 72 73 20 69 6e keep the vars in
7290: 20 70 72 65 76 76 61 6c 73 20 61 6e 64 20 70 75 prevvals and pu
72a0: 74 20 74 68 65 20 65 6e 76 69 6f 6e 6d 65 6e 74 t the envionment
72b0: 20 62 61 63 6b 20 77 68 65 6e 20 64 6f 6e 65 0a back when done.
72c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
72d0: 20 34 20 22 66 75 6c 6c 63 6d 64 3a 20 22 20 66 4 "fullcmd: " f
72e0: 75 6c 6c 63 6d 64 29 0a 20 20 20 20 28 6c 65 74 ullcmd). (let
72f0: 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 * ((commonprevva
7300: 6c 73 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 ls (alist->env-v
7310: 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 73 68 ars.... (hash
7320: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
7330: 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 lt *configdat* "
7340: 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 27 28 env-override" '(
7350: 29 29 29 29 0a 09 20 20 20 28 74 65 73 74 70 72 )))).. (testpr
7360: 65 76 76 61 6c 73 20 20 20 28 61 6c 69 73 74 2d evvals (alist-
7370: 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 >env-vars....
7380: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
7390: 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f /default test-co
73a0: 6e 66 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 nf "pre-launch-e
73b0: 6e 76 2d 6f 76 65 72 72 69 64 65 73 22 20 27 28 nv-overrides" '(
73c0: 29 29 29 29 0a 09 20 20 20 28 6d 69 73 63 70 72 )))).. (miscpr
73d0: 65 76 76 61 6c 73 20 20 20 28 61 6c 69 73 74 2d evvals (alist-
73e0: 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e >env-vars ;; con
73f0: 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f solidate this co
7400: 64 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 de with the code
7410: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d in megatest.scm
7420: 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a for "-execute".
7430: 09 09 09 20 20 20 20 28 61 70 70 65 6e 64 20 28 ... (append (
7440: 6c 69 73 74 20 28 6c 69 73 74 20 22 4d 54 5f 54 list (list "MT_T
7450: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
7460: 6b 2d 61 72 65 61 29 0a 09 09 09 09 09 20 20 28 k-area)...... (
7470: 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e 41 list "MT_TEST_NA
7480: 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 ME" test-name)..
7490: 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f .... (list "MT_
74a0: 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 ITEM_INFO" (conc
74b0: 20 69 74 65 6d 64 61 74 29 29 20 0a 09 09 09 09 itemdat)) .....
74c0: 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e . (list "MT_RUN
74d0: 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 NAME" runname)
74e0: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
74f0: 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d 74 5f T_TARGET" mt_
7500: 74 61 72 67 65 74 29 0a 09 09 09 09 09 20 20 29 target)...... )
7510: 0a 09 09 09 09 20 20 20 20 69 74 65 6d 64 61 74 ..... itemdat
7520: 29 29 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 2d ))).. (launch-
7530: 72 65 73 75 6c 74 73 20 28 61 70 70 6c 79 20 63 results (apply c
7540: 6d 64 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 md-run-with-stde
7550: 72 72 2d 3e 6c 69 73 74 20 3b 3b 20 63 6d 64 2d rr->list ;; cmd-
7560: 72 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 run-proc-each-li
7570: 6e 65 0a 09 09 09 09 20 20 28 69 66 20 75 73 65 ne..... (if use
7580: 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 20 20 shell.....
7590: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
75a0: 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 rse fullcmd " ")
75b0: 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 72 20 ..... (car
75c0: 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 20 20 fullcmd)).....
75d0: 3b 3b 20 63 6f 6e 63 0a 09 09 09 09 20 20 28 69 ;; conc..... (i
75e0: 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 f useshell.....
75f0: 20 20 20 20 20 27 28 29 0a 09 09 09 09 20 20 20 '().....
7600: 20 20 20 28 63 64 72 20 66 75 6c 6c 63 6d 64 29 (cdr fullcmd)
7610: 29 29 29 29 20 3b 3b 20 20 6c 61 75 6e 63 68 65 )))) ;; launche
7620: 72 20 66 75 6c 6c 63 6d 64 29 29 29 3b 3b 20 28 r fullcmd)));; (
7630: 61 70 70 6c 79 20 63 6d 64 2d 72 75 6e 2d 70 72 apply cmd-run-pr
7640: 6f 63 2d 65 61 63 68 2d 6c 69 6e 65 20 6c 61 75 oc-each-line lau
7650: 6e 63 68 65 72 20 70 72 69 6e 74 20 66 75 6c 6c ncher print full
7660: 63 6d 64 29 29 29 20 3b 3b 20 28 63 6d 64 2d 72 cmd))) ;; (cmd-r
7670: 75 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 63 6d 64 un->list fullcmd
7680: 29 29 0a 20 20 20 20 20 20 28 77 69 74 68 2d 6f )). (with-o
7690: 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 22 6d utput-to-file "m
76a0: 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 22 0a 09 28 t_launch.log"..(
76b0: 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 28 61 70 lambda ().. (ap
76c0: 70 6c 79 20 70 72 69 6e 74 20 6c 61 75 6e 63 68 ply print launch
76d0: 2d 72 65 73 75 6c 74 73 29 29 29 0a 20 20 20 20 -results))).
76e0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
76f0: 20 22 4c 61 75 6e 63 68 69 6e 67 20 63 6f 6d 70 "Launching comp
7700: 6c 65 74 65 64 2c 20 75 70 64 61 74 69 6e 67 20 leted, updating
7710: 64 62 22 29 0a 20 20 20 20 20 20 28 64 65 62 75 db"). (debu
7720: 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 g:print 2 "Launc
7730: 68 20 72 65 73 75 6c 74 73 3a 20 22 20 6c 61 75 h results: " lau
7740: 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 20 20 20 nch-results).
7750: 20 20 20 28 69 66 20 28 6e 6f 74 20 6c 61 75 6e (if (not laun
7760: 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 28 ch-results).. (
7770: 62 65 67 69 6e 0a 09 20 20 20 20 28 70 72 69 6e begin.. (prin
7780: 74 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 t "ERROR: Failed
7790: 20 74 6f 20 72 75 6e 20 22 20 28 73 74 72 69 6e to run " (strin
77a0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 g-intersperse fu
77b0: 6c 6c 63 6d 64 20 22 20 22 29 20 22 2c 20 65 78 llcmd " ") ", ex
77c0: 69 74 69 6e 67 20 6e 6f 77 22 29 0a 09 20 20 20 iting now")..
77d0: 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ;; (sqlite3:fin
77e0: 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 alize! db)..
77f0: 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 69 ;; good ole "exi
7800: 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f 20 t" seems not to
7810: 77 6f 72 6b 0a 09 20 20 20 20 3b 3b 20 28 5f 65 work.. ;; (_e
7820: 78 69 74 20 39 29 0a 09 20 20 20 20 3b 3b 20 62 xit 9).. ;; b
7830: 75 74 20 74 68 69 73 20 68 61 63 6b 20 77 69 6c ut this hack wil
7840: 6c 20 77 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 l work! Thanks g
7850: 6f 20 74 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f o to Alan Post o
7860: 66 20 74 68 65 20 43 68 69 63 6b 65 6e 20 65 6d f the Chicken em
7870: 61 69 6c 20 6c 69 73 74 0a 09 20 20 20 20 3b 3b ail list.. ;;
7880: 20 4e 42 2f 2f 20 49 73 20 74 68 69 73 20 73 74 NB// Is this st
7890: 69 6c 6c 20 6e 65 65 64 65 64 3f 20 53 68 6f 75 ill needed? Shou
78a0: 6c 64 20 62 65 20 73 61 66 65 20 74 6f 20 67 6f ld be safe to go
78b0: 20 62 61 63 6b 20 74 6f 20 22 65 78 69 74 22 20 back to "exit"
78c0: 6e 6f 77 3f 0a 09 20 20 20 20 28 70 72 6f 63 65 now?.. (proce
78d0: 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 72 72 65 ss-signal (curre
78e0: 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 73 nt-process-id) s
78f0: 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 20 20 ignal/kill)..
7900: 20 29 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 )). (alist
7910: 2d 3e 65 6e 76 2d 76 61 72 73 20 6d 69 73 63 70 ->env-vars miscp
7920: 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 revvals). (
7930: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
7940: 74 65 73 74 70 72 65 76 76 61 6c 73 29 0a 20 20 testprevvals).
7950: 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d (alist->env-
7960: 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 vars commonprevv
7970: 61 6c 73 29 0a 20 20 20 20 20 20 6c 61 75 6e 63 als). launc
7980: 68 2d 72 65 73 75 6c 74 73 29 29 0a 20 20 28 63 h-results)). (c
7990: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
79a0: 2a 74 6f 70 70 61 74 68 2a 29 29 0a 0a *toppath*))..