Artifact
87b2ca50e6f301999a393c4746219a4726268869
File
launch.scm
— part of check-in
[eec815277b]
at
2013-04-27 11:36:22
on branch v1.54
— Added (but not yet used) cdb: calls for remaining test table updates. Remotified and renamed register-run
(user:
matt
size: 32547)
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 3b 3b 20 69 66 20 68 61 6e 64 65 64 20 61 20 .;; if handed a
05d0: 73 74 72 69 6e 67 2c 20 70 72 6f 63 65 73 73 20 string, process
05e0: 69 74 2c 20 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f it, else look fo
05f0: 72 20 4d 54 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 r MT_CMDINFO.(de
0600: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 fine (launch:get
0610: 2d 63 6d 64 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c -cmdinfo-assoc-l
0620: 69 73 74 20 23 21 6b 65 79 20 28 65 6e 63 6f 64 ist #!key (encod
0630: 65 64 2d 63 6d 64 20 23 66 29 29 0a 20 20 28 6c ed-cmd #f)). (l
0640: 65 74 20 28 28 65 6e 63 63 6d 64 20 28 69 66 20 et ((enccmd (if
0650: 65 6e 63 6f 64 65 64 2d 63 6d 64 20 65 6e 63 6f encoded-cmd enco
0660: 64 65 64 2d 63 6d 64 20 28 67 65 74 65 6e 76 20 ded-cmd (getenv
0670: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
0680: 0a 20 20 20 20 28 69 66 20 65 6e 63 63 6d 64 0a . (if enccmd.
0690: 09 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 .(read (open-inp
06a0: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
06b0: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
06c0: 65 6e 63 63 6d 64 29 29 29 0a 09 27 28 29 29 29 enccmd)))..'()))
06d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
06e0: 63 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 ch:execute encod
06f0: 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ed-cmd). (let*
0700: 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 ((cmdinfo (rea
0710: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
0720: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
0730: 65 36 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 e64-decode encod
0740: 65 64 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 ed-cmd))))).
0750: 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (setenv "MT_CMDI
0760: 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 NFO" encoded-cmd
0770: 29 0a 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f ). (if (list?
0780: 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 cmdinfo) ;; ((t
0790: 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 estpath /tmp/mrw
07a0: 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 ellan/jazzmind/s
07b0: 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 rc/example_run/t
07c0: 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 ests/sqlitespeed
07d0: 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e 61 6d 65 )..;; (test-name
07e0: 20 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 72 sqlitespeed) (r
07f0: 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
0800: 70 74 2e 72 62 29 20 28 64 62 2d 68 6f 73 74 20 pt.rb) (db-host
0810: 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d localhost) (run-
0820: 69 64 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 id 1))..(let* ((
0830: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
0840: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
0850: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b th cmdinfo)) ;
0860: 3b 20 48 6f 77 20 69 73 20 74 65 73 74 70 61 74 ; How is testpat
0870: 68 20 64 69 66 66 65 72 65 6e 74 20 66 72 6f 6d h different from
0880: 20 77 6f 72 6b 2d 61 72 65 61 20 3f 3f 0a 09 20 work-area ??..
0890: 20 20 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 (top-path
08a0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
08b0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
08c0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f fo)).. (wo
08d0: 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
08e0: 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
08f0: 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
0900: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
0910: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0920: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
0930: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
0940: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
0950: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
0960: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
0970: 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 73 (ezsteps (as
0980: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a 73 soc/default 'ezs
0990: 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 29 teps cmdinfo))
09a0: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 6e .. ;; (run
09b0: 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 65 remote (assoc/de
09c0: 66 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 65 fault 'runremote
09d0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
09e0: 20 20 20 28 74 72 61 6e 73 70 6f 72 74 20 28 61 (transport (a
09f0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 72 ssoc/default 'tr
0a00: 61 6e 73 70 6f 72 74 20 63 6d 64 69 6e 66 6f 29 ansport cmdinfo)
0a10: 29 0a 09 20 20 20 20 20 20 20 28 73 65 72 76 65 ).. (serve
0a20: 72 69 6e 66 20 28 61 73 73 6f 63 2f 64 65 66 61 rinf (assoc/defa
0a30: 75 6c 74 20 27 73 65 72 76 65 72 69 6e 66 20 63 ult 'serverinf c
0a40: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0a50: 20 28 70 6f 72 74 20 20 20 20 20 20 28 61 73 73 (port (ass
0a60: 6f 63 2f 64 65 66 61 75 6c 74 20 27 70 6f 72 74 oc/default 'port
0a70: 20 20 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a cmdinfo)).
0a80: 09 20 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 . (run-id
0a90: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0aa0: 74 20 27 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 t 'run-id cmd
0ab0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0ac0: 74 65 73 74 2d 69 64 20 20 20 28 61 73 73 6f 63 test-id (assoc
0ad0: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 69 /default 'test-i
0ae0: 64 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 d cmdinfo))..
0af0: 20 20 20 20 20 20 28 74 61 72 67 65 74 20 20 20 (target
0b00: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0b10: 27 74 61 72 67 65 74 20 20 20 20 63 6d 64 69 6e 'target cmdin
0b20: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
0b30: 65 6d 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 emdat (assoc/d
0b40: 65 66 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 efault 'itemdat
0b50: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
0b60: 20 20 20 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 (env-ovrd (
0b70: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 assoc/default 'e
0b80: 6e 76 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f nv-ovrd cmdinfo
0b90: 29 29 0a 09 20 20 20 20 20 20 20 28 73 65 74 2d )).. (set-
0ba0: 76 61 72 73 20 20 28 61 73 73 6f 63 2f 64 65 66 vars (assoc/def
0bb0: 61 75 6c 74 20 27 73 65 74 2d 76 61 72 73 20 20 ault 'set-vars
0bc0: 63 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 cmdinfo)) ;; pre
0bd0: 2d 6f 76 65 72 72 69 64 65 73 20 66 72 6f 6d 20 -overrides from
0be0: 2d 73 65 74 76 61 72 0a 09 20 20 20 20 20 20 20 -setvar..
0bf0: 28 72 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f (runname (asso
0c00: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 c/default 'runna
0c10: 6d 65 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 me cmdinfo))..
0c20: 20 20 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 (megatest
0c30: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0c40: 20 27 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 'megatest cmdi
0c50: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6d nfo)).. (m
0c60: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 t-bindir-path (a
0c70: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 ssoc/default 'mt
0c80: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 -bindir-path cmd
0c90: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0ca0: 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 20 keys #f)..
0cb0: 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 (keyvals
0cc0: 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 75 #f).. (fu
0cd0: 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 llrunscript (if
0ce0: 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 0a (not runscript).
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d10: 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 #f.
0d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d30: 20 20 20 20 20 20 20 28 69 66 20 28 73 75 62 73 (if (subs
0d40: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 tring-index "/"
0d50: 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 runscript).
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 runscript ;; us
0d90: 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 66 e unadultered if
0da0: 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 contains slashe
0db0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dd0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 (let ((f
0de0: 75 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 74 70 ulln (conc testp
0df0: 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 70 ath "/" runscrip
0e00: 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 t)))..
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
0e30: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 (file-exists? f
0e40: 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 20 20 ulln).
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e70: 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 2d 65 (file-e
0e80: 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 xecute-access? f
0e90: 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 20 20 ulln)).
0ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 20 20 fulln.
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ef0: 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 runscri
0f00: 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 75 6d pt))))) ;; assum
0f10: 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 20 70 e it is on the p
0f20: 61 74 68 0a 09 20 20 20 20 20 20 20 28 72 6f 6c ath.. (rol
0f30: 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a 09 lup-status 0))..
0f40: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
0f50: 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a 09 20 ory top-path)..
0f60: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
0f70: 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 65 73 "Exectuing " tes
0f80: 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 t-name " (id: "
0f90: 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 test-id ") on "
0fa0: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
0fb0: 0a 09 20 20 3b 3b 20 53 65 74 75 70 20 74 68 65 .. ;; Setup the
0fc0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 67 6c 6f *runremote* glo
0fd0: 62 61 6c 20 76 61 72 0a 09 20 20 28 69 66 20 2a bal var.. (if *
0fe0: 72 75 6e 72 65 6d 6f 74 65 2a 20 28 64 65 62 75 runremote* (debu
0ff0: 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 g:print 2 "ERROR
1000: 3a 20 49 27 6d 20 6e 6f 74 20 65 78 70 65 63 74 : I'm not expect
1010: 69 6e 67 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 ing *runremote*
1020: 74 6f 20 62 65 20 73 65 74 20 61 74 20 74 68 69 to be set at thi
1030: 73 20 74 69 6d 65 22 29 29 0a 09 20 20 3b 3b 20 s time")).. ;;
1040: 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f 74 65 (set! *runremote
1050: 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 20 20 * runremote)..
1060: 28 73 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 (set! *transport
1070: 2d 74 79 70 65 2a 20 28 73 74 72 69 6e 67 2d 3e -type* (string->
1080: 73 79 6d 62 6f 6c 20 74 72 61 6e 73 70 6f 72 74 symbol transport
1090: 29 29 0a 09 20 20 28 73 65 74 21 20 6b 65 79 73 )).. (set! keys
10a0: 20 20 20 20 20 20 20 28 63 64 62 3a 72 65 6d 6f (cdb:remo
10b0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
10c0: 79 73 20 23 66 29 29 0a 09 20 20 28 73 65 74 21 ys #f)).. (set!
10d0: 20 6b 65 79 76 61 6c 73 20 20 20 20 28 69 66 20 keyvals (if
10e0: 72 75 6e 2d 69 64 20 28 63 64 62 3a 72 65 6d 6f run-id (cdb:remo
10f0: 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 2d 6b 65 te-run db:get-ke
1100: 79 2d 76 61 6c 73 20 23 66 20 72 75 6e 2d 69 64 y-vals #f run-id
1110: 29 20 23 66 29 29 0a 09 20 20 3b 3b 20 61 70 70 ) #f)).. ;; app
1120: 6c 79 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 ly pre-overrides
1130: 20 62 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 before other va
1140: 72 69 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 riables. The pre
1150: 2d 6f 76 65 72 72 69 64 65 20 76 61 72 73 20 6d -override vars m
1160: 75 73 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c ust not.. ;; cl
1170: 6f 62 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 obbers things fr
1180: 6f 6d 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 om the official
1190: 73 6f 75 72 63 65 73 20 73 75 63 68 20 61 73 20 sources such as
11a0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
11b0: 61 6e 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 and runconfigs.c
11c0: 6f 6e 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 onfig.. (if (st
11d0: 72 69 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a ring? set-vars).
11e0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 . (let ((va
11f0: 72 70 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 rpairs (string-s
1200: 70 6c 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c plit set-vars ",
1210: 22 29 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 ")))...(debug:pr
1220: 69 6e 74 20 34 20 22 76 61 72 70 61 69 72 73 3a int 4 "varpairs:
1230: 20 22 20 76 61 72 70 61 69 72 73 29 0a 09 09 28 " varpairs)...(
1240: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 72 map (lambda (var
1250: 70 61 69 72 29 0a 09 09 20 20 20 20 20 20 20 28 pair)... (
1260: 6c 65 74 20 28 28 76 61 72 76 61 6c 20 28 73 74 let ((varval (st
1270: 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 61 ring-split varpa
1280: 69 72 20 22 3d 22 29 29 29 0a 09 09 09 20 28 69 ir "="))).... (i
1290: 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 f (eq? (length v
12a0: 61 72 76 61 6c 29 20 32 29 0a 09 09 09 20 20 20 arval) 2)....
12b0: 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 (let ((var (ca
12c0: 72 20 76 61 72 76 61 6c 29 29 0a 09 09 09 09 20 r varval)).....
12d0: 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 (val (cadr var
12e0: 76 61 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 val)))....
12f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
1300: 22 41 64 64 69 6e 67 20 70 72 65 2d 76 61 72 2f "Adding pre-var/
1310: 76 61 6c 20 22 20 76 61 72 20 22 20 3d 20 22 20 val " var " = "
1320: 76 61 6c 20 22 20 74 6f 20 74 68 65 20 65 6e 76 val " to the env
1330: 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 ironment")....
1340: 20 20 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 (setenv var
1350: 20 76 61 6c 29 29 29 29 29 0a 09 09 20 20 20 20 val)))))...
1360: 20 76 61 72 70 61 69 72 73 29 29 29 0a 09 20 20 varpairs)))..
1370: 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 (setenv "MT_TEST
1380: 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 _RUN_DIR" work-a
1390: 72 65 61 29 0a 09 20 20 28 73 65 74 65 6e 76 20 rea).. (setenv
13a0: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
13b0: 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 28 73 65 est-name).. (se
13c0: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 5f 49 4e tenv "MT_ITEM_IN
13d0: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
13e0: 74 29 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 t)).. (setenv "
13f0: 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
1400: 6e 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e nname).. (seten
1410: 76 20 22 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 v "MT_MEGATEST"
1420: 20 6d 65 67 61 74 65 73 74 29 0a 09 20 20 28 73 megatest).. (s
1430: 65 74 65 6e 76 20 22 4d 54 5f 54 41 52 47 45 54 etenv "MT_TARGET
1440: 22 20 20 20 20 74 61 72 67 65 74 29 0a 09 20 20 " target)..
1450: 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 (if mt-bindir-pa
1460: 74 68 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 th (setenv "PATH
1470: 22 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 " (conc (getenv
1480: 22 50 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 "PATH") ":" mt-b
1490: 69 6e 64 69 72 2d 70 61 74 68 29 29 29 0a 09 20 indir-path)))..
14a0: 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ;; (change-dire
14b0: 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a ctory top-path).
14c0: 09 20 20 28 69 66 20 28 6e 6f 74 20 28 73 65 74 . (if (not (set
14d0: 75 70 2d 66 6f 72 2d 72 75 6e 29 29 0a 09 20 20 up-for-run))..
14e0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 (begin...(de
14f0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 46 61 69 bug:print 0 "Fai
1500: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
1510: 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 iting") ...;; (s
1520: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
1530: 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 db)...;; (sqlit
1540: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
1550: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
1560: 20 20 3b 3b 20 43 61 6e 20 73 65 74 75 70 20 61 ;; Can setup a
1570: 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 s client for ser
1580: 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 ver mode now..
1590: 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 ;; (client:setup
15a0: 29 0a 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 )... (change-di
15b0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
15c0: 2a 29 20 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 *) .. (set-mega
15d0: 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 test-env-vars ru
15e0: 6e 2d 69 64 29 20 3b 3b 20 74 68 65 73 65 20 6d n-id) ;; these m
15f0: 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 79 20 ay be needed by
1600: 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 70 72 the launching pr
1610: 6f 63 65 73 73 0a 09 20 20 28 63 68 61 6e 67 65 ocess.. (change
1620: 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d -directory work-
1630: 61 72 65 61 29 20 0a 0a 09 20 20 28 6f 70 65 6e area) ... (open
1640: 2d 72 75 6e 2d 63 6c 6f 73 65 20 73 65 74 2d 72 -run-close set-r
1650: 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 23 un-config-vars #
1660: 66 20 72 75 6e 2d 69 64 20 6b 65 79 73 20 6b 65 f run-id keys ke
1670: 79 76 61 6c 73 29 0a 09 20 20 3b 3b 20 65 6e 76 yvals).. ;; env
1680: 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 ironment overrid
1690: 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 es are done *bef
16a0: 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 ore* the remaini
16b0: 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e 76 61 ng critical enva
16c0: 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 rs... (alist->e
16d0: 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 nv-vars env-ovrd
16e0: 29 0a 09 20 20 28 73 65 74 2d 6d 65 67 61 74 65 ).. (set-megate
16f0: 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d st-env-vars run-
1700: 69 64 29 0a 09 20 20 28 73 65 74 2d 69 74 65 6d id).. (set-item
1710: 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d 64 61 -env-vars itemda
1720: 74 29 0a 09 20 20 28 73 61 76 65 2d 65 6e 76 69 t).. (save-envi
1730: 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 ronment-as-files
1740: 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 20 "megatest")..
1750: 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 ;; open-run-clos
1760: 65 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 6f 72 e not needed for
1770: 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 test-set-meta-i
1780: 6e 66 6f 0a 09 20 20 28 74 65 73 74 73 3a 73 65 nfo.. (tests:se
1790: 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 t-meta-info #f t
17a0: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 est-id run-id te
17b0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 st-name itemdat
17c0: 30 29 0a 09 20 20 28 74 65 73 74 73 3a 74 65 73 0).. (tests:tes
17d0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 t-set-status! te
17e0: 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 st-id "REMOTEHOS
17f0: 54 53 54 41 52 54 22 20 22 6e 2f 61 22 20 28 61 TSTART" "n/a" (a
1800: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
1810: 29 20 23 66 29 0a 09 20 20 28 69 66 20 28 61 72 ) #f).. (if (ar
1820: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 gs:get-arg "-xte
1830: 72 6d 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 rm").. (set
1840: 21 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 ! fullrunscript
1850: 22 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 "xterm")..
1860: 28 69 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e (if (and fullrun
1870: 73 63 72 69 70 74 20 28 6e 6f 74 20 28 66 69 6c script (not (fil
1880: 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 e-execute-access
1890: 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 ? fullrunscript)
18a0: 29 29 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 ))... (system (
18b0: 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 conc "chmod ug+x
18c0: 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 " fullrunscript
18d0: 29 29 29 29 0a 09 20 20 3b 3b 20 57 65 20 61 72 )))).. ;; We ar
18e0: 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 e about to actua
18f0: 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 lly kick off the
1900: 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 test.. ;; so t
1910: 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c his is a good pl
1920: 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 ace to remove th
1930: 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 e records for ..
1940: 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 ;; any previou
1950: 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 s runs.. ;; (db
1960: 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 :test-remove-ste
1970: 70 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 ps db run-id tes
1980: 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 tname itemdat)..
1990: 20 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 .. (let* ((m
19a0: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 (make
19b0: 2d 6d 75 74 65 78 29 29 0a 09 09 20 28 6b 69 6c -mutex))... (kil
19c0: 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 l-job? #f)...
19d0: 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 (exit-info (
19e0: 76 65 63 74 6f 72 20 23 74 20 23 74 20 23 74 29 vector #t #t #t)
19f0: 29 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 )... (job-thread
1a00: 20 20 20 23 66 29 0a 09 09 20 28 72 75 6e 69 74 #f)... (runit
1a10: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1a20: 28 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d ()..... ;; (let-
1a30: 76 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 values..... ;;
1a40: 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 (((pid exit-stat
1a50: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 us exit-code)...
1a60: 09 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d .. ;; (run-n-
1a70: 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 wait fullrunscri
1a80: 70 74 29 29 29 0a 09 09 09 09 20 28 74 65 73 74 pt)))..... (test
1a90: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
1aa0: 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e s! test-id "RUNN
1ab0: 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 20 23 66 ING" "n/a" #f #f
1ac0: 29 0a 09 09 09 09 20 3b 3b 20 69 66 20 74 68 65 )..... ;; if the
1ad0: 72 65 20 69 73 20 61 20 72 75 6e 73 63 72 69 70 re is a runscrip
1ae0: 74 20 64 6f 20 69 74 20 66 69 72 73 74 0a 09 09 t do it first...
1af0: 09 09 20 28 69 66 20 66 75 6c 6c 72 75 6e 73 63 .. (if fullrunsc
1b00: 72 69 70 74 0a 09 09 09 09 20 20 20 20 20 28 6c ript..... (l
1b10: 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 et ((pid (proces
1b20: 73 2d 72 75 6e 20 66 75 6c 6c 72 75 6e 73 63 72 s-run fullrunscr
1b30: 69 70 74 29 29 29 0a 09 09 09 09 20 20 20 20 20 ipt))).....
1b40: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 (let loop ((i
1b50: 30 29 29 0a 09 09 09 09 09 20 28 6c 65 74 2d 76 0))...... (let-v
1b60: 61 6c 75 65 73 0a 09 09 09 09 09 20 20 28 28 28 alues...... (((
1b70: 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 pid-val exit-sta
1b80: 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 tus exit-code) (
1b90: 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 process-wait pid
1ba0: 20 23 74 29 29 29 0a 09 09 09 09 09 20 20 28 6d #t)))...... (m
1bb0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
1bc0: 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 65 74 ... (vector-set
1bd0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
1be0: 64 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f d)...... (vecto
1bf0: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
1c00: 20 31 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 1 exit-status).
1c10: 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 2d 73 ..... (vector-s
1c20: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 et! exit-info 2
1c30: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 exit-code)......
1c40: 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 (set! rollup-s
1c50: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 tatus exit-code)
1c60: 20 0a 09 09 09 09 09 20 20 28 6d 75 74 65 78 2d ...... (mutex-
1c70: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 unlock! m)......
1c80: 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 (if (eq? pid-v
1c90: 61 6c 20 30 29 0a 09 09 09 09 09 20 20 20 20 20 al 0)......
1ca0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 28 74 (begin.......(t
1cb0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
1cc0: 09 09 09 09 09 09 28 6c 6f 6f 70 20 28 2b 20 69 ......(loop (+ i
1cd0: 20 31 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 1)))......
1ce0: 20 29 29 29 29 29 0a 09 09 09 09 20 3b 3b 20 74 )))))..... ;; t
1cf0: 68 65 6e 2c 20 69 66 20 72 75 6e 73 63 72 69 70 hen, if runscrip
1d00: 74 20 72 61 6e 20 6f 6b 20 28 6f 72 20 64 69 64 t ran ok (or did
1d10: 20 6e 6f 74 20 67 65 74 20 63 61 6c 6c 65 64 29 not get called)
1d20: 0a 09 09 09 09 20 3b 3b 20 64 6f 20 61 6c 6c 20 ..... ;; do all
1d30: 74 68 65 20 65 7a 73 74 65 70 73 20 28 69 66 20 the ezsteps (if
1d40: 61 6e 79 29 0a 09 09 09 09 20 28 69 66 20 65 7a any)..... (if ez
1d50: 73 74 65 70 73 0a 09 09 09 09 20 20 20 20 20 28 steps..... (
1d60: 6c 65 74 2a 20 28 28 74 65 73 74 63 6f 6e 66 69 let* ((testconfi
1d70: 67 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 g (read-config (
1d80: 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 conc work-area "
1d90: 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 20 23 66 /testconfig") #f
1da0: 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 #t environ-patt
1db0: 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e : "pre-launch-en
1dc0: 76 2d 76 61 72 73 22 29 29 20 3b 3b 20 46 49 58 v-vars")) ;; FIX
1dd0: 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 2d 73 ME??? is allow-s
1de0: 79 73 74 65 6d 20 6f 6b 20 68 65 72 65 3f 0a 09 ystem ok here?..
1df0: 09 09 09 09 20 20 20 20 28 65 7a 73 74 65 70 73 .... (ezsteps
1e00: 6c 73 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d lst (hash-table-
1e10: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
1e20: 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 config "ezsteps"
1e30: 20 27 28 29 29 29 29 0a 09 09 09 09 20 20 20 20 '()))).....
1e40: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c (if (not (fil
1e50: 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a 73 74 e-exists? ".ezst
1e60: 65 70 73 22 29 29 28 63 72 65 61 74 65 2d 64 69 eps"))(create-di
1e70: 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 65 70 rectory ".ezstep
1e80: 73 22 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 s")).....
1e90: 3b 3b 20 69 66 20 65 7a 73 74 65 70 73 20 77 61 ;; if ezsteps wa
1ea0: 73 20 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 s defined then w
1eb0: 65 20 61 72 65 20 73 75 72 65 20 74 6f 20 68 61 e are sure to ha
1ec0: 76 65 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 ve at least one
1ed0: 73 74 65 70 20 62 75 74 20 63 68 65 63 6b 20 61 step but check a
1ee0: 6e 79 77 61 79 0a 09 09 09 09 20 20 20 20 20 20 nyway.....
1ef0: 20 28 69 66 20 28 6e 6f 74 20 28 3e 20 28 6c 65 (if (not (> (le
1f00: 6e 67 74 68 20 65 7a 73 74 65 70 73 6c 73 74 29 ngth ezstepslst)
1f10: 20 30 29 29 0a 09 09 09 09 09 20 20 20 28 64 65 0))...... (de
1f20: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
1f30: 4f 52 3a 20 65 7a 73 74 65 70 73 20 64 65 66 69 OR: ezsteps defi
1f40: 6e 65 64 20 62 75 74 20 65 7a 73 74 65 70 73 6c ned but ezstepsl
1f50: 73 74 20 69 73 20 7a 65 72 6f 20 6c 65 6e 67 74 st is zero lengt
1f60: 68 22 29 0a 09 09 09 09 09 20 20 20 28 6c 65 74 h")...... (let
1f70: 20 6c 6f 6f 70 20 28 28 65 7a 73 74 65 70 20 28 loop ((ezstep (
1f80: 63 61 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 car ezstepslst))
1f90: 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 74 61 ....... (ta
1fa0: 6c 20 20 20 20 28 63 64 72 20 65 7a 73 74 65 70 l (cdr ezstep
1fb0: 73 6c 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 slst)).......
1fc0: 20 20 20 28 70 72 65 76 73 74 65 70 20 23 66 29 (prevstep #f)
1fd0: 29 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 63 )...... ;; c
1fe0: 68 65 63 6b 20 65 78 69 74 2d 69 6e 66 6f 20 28 heck exit-info (
1ff0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
2000: 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 20 20 20 info 1)......
2010: 20 20 28 69 66 20 28 76 65 63 74 6f 72 2d 72 65 (if (vector-re
2020: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 f exit-info 1)..
2030: 09 09 09 09 09 20 28 6c 65 74 2a 20 28 28 73 74 ..... (let* ((st
2040: 65 70 6e 61 6d 65 20 20 28 63 61 72 20 65 7a 73 epname (car ezs
2050: 74 65 70 29 29 20 20 3b 3b 20 64 6f 20 73 74 75 tep)) ;; do stu
2060: 66 66 20 74 6f 20 72 75 6e 20 74 68 65 20 73 74 ff to run the st
2070: 65 70 0a 09 09 09 09 09 09 09 28 73 74 65 70 69 ep........(stepi
2080: 6e 66 6f 20 20 28 63 61 64 72 20 65 7a 73 74 65 nfo (cadr ezste
2090: 70 29 29 0a 09 09 09 09 09 09 09 28 73 74 65 70 p))........(step
20a0: 70 61 72 74 73 20 28 73 74 72 69 6e 67 2d 6d 61 parts (string-ma
20b0: 74 63 68 20 28 72 65 67 65 78 70 20 22 5e 28 5c tch (regexp "^(\
20c0: 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c \{([^\\}]*)\\}\\
20d0: 73 2a 7c 29 28 2e 2a 29 24 22 29 20 73 74 65 70 s*|)(.*)$") step
20e0: 69 6e 66 6f 29 29 0a 09 09 09 09 09 09 09 28 73 info))........(s
20f0: 74 65 70 70 61 72 6d 73 20 28 6c 69 73 74 2d 72 tepparms (list-r
2100: 65 66 20 73 74 65 70 70 61 72 74 73 20 32 29 29 ef stepparts 2))
2110: 20 3b 3b 20 66 6f 72 20 66 75 74 75 72 65 20 75 ;; for future u
2120: 73 65 2c 20 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c se, {VAR=1,2,3},
2130: 20 72 75 6e 20 73 74 65 70 20 66 6f 72 20 65 61 run step for ea
2140: 63 68 20 0a 09 09 09 09 09 09 09 28 73 74 65 70 ch ........(step
2150: 63 6d 64 20 20 20 28 6c 69 73 74 2d 72 65 66 20 cmd (list-ref
2160: 73 74 65 70 70 61 72 74 73 20 33 29 29 0a 09 09 stepparts 3))...
2170: 09 09 09 09 09 28 73 63 72 69 70 74 20 20 20 20 .....(script
2180: 22 22 29 20 3b 20 22 23 21 2f 62 69 6e 2f 62 61 "") ; "#!/bin/ba
2190: 73 68 5c 6e 22 29 20 3b 3b 20 79 65 70 2c 20 77 sh\n") ;; yep, w
21a0: 65 20 64 65 70 65 6e 64 20 6f 6e 20 62 69 6e 2f e depend on bin/
21b0: 62 61 73 68 20 46 49 58 4d 45 21 21 21 0a 09 09 bash FIXME!!!...
21c0: 09 09 09 09 09 28 6c 6f 67 70 72 6f 2d 75 73 65 .....(logpro-use
21d0: 64 20 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 d #f)).......
21e0: 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 73 61 66 65 ;; NB// can safe
21f0: 6c 79 20 61 73 73 75 6d 65 20 77 65 20 61 72 65 ly assume we are
2200: 20 69 6e 20 74 65 73 74 2d 61 72 65 61 20 64 69 in test-area di
2210: 72 65 63 74 6f 72 79 0a 09 09 09 09 09 09 20 20 rectory.......
2220: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 (debug:print 4
2230: 22 65 7a 73 74 65 70 73 3a 5c 6e 20 73 74 65 70 "ezsteps:\n step
2240: 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e 61 6d 65 name: " stepname
2250: 20 22 20 73 74 65 70 69 6e 66 6f 3a 20 22 20 73 " stepinfo: " s
2260: 74 65 70 69 6e 66 6f 20 22 20 73 74 65 70 70 61 tepinfo " steppa
2270: 72 74 73 3a 20 22 20 73 74 65 70 70 61 72 74 73 rts: " stepparts
2280: 0a 09 09 09 09 09 09 09 09 22 20 73 74 65 70 70 ........." stepp
2290: 61 72 6d 73 3a 20 22 20 73 74 65 70 70 61 72 6d arms: " stepparm
22a0: 73 20 22 20 73 74 65 70 63 6d 64 3a 20 22 20 73 s " stepcmd: " s
22b0: 74 65 70 63 6d 64 29 0a 09 09 09 09 09 09 20 20 tepcmd).......
22c0: 20 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ....... (if (
22d0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f file-exists? (co
22e0: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f nc stepname ".lo
22f0: 67 70 72 6f 22 29 29 28 73 65 74 21 20 6c 6f 67 gpro"))(set! log
2300: 70 72 6f 2d 75 73 65 64 20 23 74 29 29 0a 0a 09 pro-used #t))...
2310: 09 09 09 09 09 20 20 20 3b 3b 20 3b 3b 20 66 69 ..... ;; ;; fi
2320: 72 73 74 20 73 6f 75 72 63 65 20 74 68 65 20 70 rst source the p
2330: 72 65 76 69 6f 75 73 20 65 6e 76 69 72 6f 6e 6d revious environm
2340: 65 6e 74 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 ent....... ;;
2350: 28 6c 65 74 20 28 28 70 72 65 76 2d 65 6e 76 20 (let ((prev-env
2360: 28 63 6f 6e 63 20 22 2e 65 7a 73 74 65 70 73 2f (conc ".ezsteps/
2370: 22 20 70 72 65 76 73 74 65 70 20 28 69 66 20 28 " prevstep (if (
2380: 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 72 string-search (r
2390: 65 67 65 78 70 20 22 63 73 68 22 29 20 0a 09 09 egexp "csh") ...
23a0: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 09 .... ;; .
23b0: 09 09 09 09 09 09 20 28 67 65 74 2d 65 6e 76 69 ...... (get-envi
23c0: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
23d0: 20 22 53 48 45 4c 4c 22 29 29 20 22 2e 63 73 68 "SHELL")) ".csh
23e0: 22 20 22 2e 73 68 22 29 29 29 29 0a 09 09 09 09 " ".sh")))).....
23f0: 09 09 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 .. ;; (if (a
2400: 6e 64 20 70 72 65 76 73 74 65 70 20 28 66 69 6c nd prevstep (fil
2410: 65 2d 65 78 69 73 74 73 3f 20 70 72 65 76 2d 65 e-exists? prev-e
2420: 6e 76 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b nv))....... ;;
2430: 20 20 20 20 20 20 20 28 73 65 74 21 20 73 63 72 (set! scr
2440: 69 70 74 20 28 63 6f 6e 63 20 73 63 72 69 70 74 ipt (conc script
2450: 20 22 73 6f 75 72 63 65 20 22 20 70 72 65 76 2d "source " prev-
2460: 65 6e 76 29 29 29 29 0a 09 09 09 09 09 09 20 20 env)))).......
2470: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 63 61 ....... ;; ca
2480: 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 75 ll the command u
2490: 73 69 6e 67 20 6d 74 5f 65 7a 73 74 65 70 0a 09 sing mt_ezstep..
24a0: 09 09 09 09 09 20 20 20 28 73 65 74 21 20 73 63 ..... (set! sc
24b0: 72 69 70 74 20 28 63 6f 6e 63 20 22 6d 74 5f 65 ript (conc "mt_e
24c0: 7a 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 zstep " stepname
24d0: 20 22 20 22 20 28 69 66 20 70 72 65 76 73 74 65 " " (if prevste
24e0: 70 20 70 72 65 76 73 74 65 70 20 22 2d 22 29 20 p prevstep "-")
24f0: 22 20 22 20 73 74 65 70 63 6d 64 29 29 0a 0a 09 " " stepcmd))...
2500: 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ..... (debug:p
2510: 72 69 6e 74 20 34 20 22 73 63 72 69 70 74 3a 20 rint 4 "script:
2520: 22 20 73 63 72 69 70 74 29 0a 09 09 09 09 09 09 " script).......
2530: 20 20 20 3b 3b 20 44 4f 20 4e 4f 54 20 72 65 6d ;; DO NOT rem
2540: 6f 74 65 0a 09 09 09 09 09 09 20 20 20 28 64 62 ote....... (db
2550: 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d 73 74 :teststep-set-st
2560: 61 74 75 73 21 20 23 66 20 74 65 73 74 2d 69 64 atus! #f test-id
2570: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
2580: 22 20 22 2d 22 20 23 66 20 23 66 29 0a 09 09 09 " "-" #f #f)....
2590: 09 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 ... ;; now lau
25a0: 6e 63 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 nch....... (le
25b0: 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 t ((pid (process
25c0: 2d 72 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 -run script)))..
25d0: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 ..... (let p
25e0: 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 rocessloop ((i 0
25f0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2600: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 (let-values (((p
2610: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat
2620: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 us exit-code)(pr
2630: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
2640: 74 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 t))).........
2650: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
2660: 09 09 09 09 09 09 09 09 20 20 20 28 76 65 63 74 ........ (vect
2670: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2680: 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 o 0 pid)........
2690: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
26a0: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
26b0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 t-status).......
26c0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
26d0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
26e0: 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 it-code)........
26f0: 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 . (mutex-unloc
2700: 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 k! m).........
2710: 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 (if (eq? pid-va
2720: 6c 20 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 l 0).........
2730: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 (begin......
2740: 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 .... (thread-sle
2750: 65 70 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 ep! 2)..........
2760: 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b (processloop (+
2770: 20 69 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 i 1))))........
2780: 09 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 . )).
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
27c0: 20 28 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f ((exinfo (vecto
27d0: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
27e0: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2820: 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 logfna (if logpr
2830: 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 o-used (conc ste
2840: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
2850: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 "))).......
2860: 20 20 3b 3b 20 74 65 73 74 69 6e 67 20 69 66 20 ;; testing if
2870: 70 72 6f 63 65 64 75 72 65 73 20 63 61 6c 6c 65 procedures calle
2880: 64 20 69 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 d in a remote ca
2890: 6c 6c 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d ll cause problem
28a0: 73 20 28 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f s (ans: no or so
28b0: 20 49 20 73 75 73 70 65 63 74 29 0a 09 09 09 09 I suspect).....
28c0: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes
28d0: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
28e0: 21 20 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 ! #f test-id ste
28f0: 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 6e pname "end" exin
2900: 66 6f 20 23 66 20 6c 6f 67 66 6e 61 29 29 0a 09 fo #f logfna))..
2910: 09 09 09 09 09 20 20 20 20 20 28 69 66 20 6c 6f ..... (if lo
2920: 67 70 72 6f 2d 75 73 65 64 0a 09 09 09 09 09 09 gpro-used.......
2930: 09 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d . (cdb:test-set-
2940: 6c 6f 67 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a log! *runremote*
2950: 20 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 test-id (conc
2960: 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 stepname ".html"
2970: 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 3b )))....... ;
2980: 3b 20 73 65 74 20 74 68 65 20 74 65 73 74 20 66 ; set the test f
2990: 69 6e 61 6c 20 73 74 61 74 75 73 0a 09 09 09 09 inal status.....
29a0: 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 .. (let* ((t
29b0: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
29c0: 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 (cond..........
29d0: 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f ((and (eq?
29e0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
29f0: 74 2d 69 6e 66 6f 20 32 29 20 32 29 20 6c 6f 67 t-info 2) 2) log
2a00: 70 72 6f 2d 75 73 65 64 29 20 27 77 61 72 6e 29 pro-used) 'warn)
2a10: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2a20: 20 28 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 ((eq? (vector-r
2a30: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
2a40: 30 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0)
2a50: 20 20 20 20 20 27 70 61 73 73 29 0a 09 09 09 09 'pass).....
2a60: 09 09 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 ..... (els
2a70: 65 20 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 e 'fail)))......
2a80: 09 09 20 20 20 20 28 6f 76 65 72 61 6c 6c 2d 73 .. (overall-s
2a90: 74 61 74 75 73 20 20 20 28 63 6f 6e 64 0a 09 09 tatus (cond...
2aa0: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 ....... ((
2ab0: 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 eq? rollup-statu
2ac0: 73 20 32 29 20 27 77 61 72 6e 29 0a 09 09 09 09 s 2) 'warn).....
2ad0: 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 ..... ((eq
2ae0: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
2af0: 30 29 20 27 70 61 73 73 29 0a 09 09 09 09 09 09 0) 'pass).......
2b00: 09 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 ... (else
2b10: 27 66 61 69 6c 29 29 29 0a 09 09 09 09 09 09 09 'fail)))........
2b20: 20 20 20 20 28 6e 65 78 74 2d 73 74 61 74 75 73 (next-status
2b30: 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 (cond ....
2b40: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 28 65 ...... ((e
2b50: 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 q? overall-statu
2b60: 73 20 27 70 61 73 73 29 20 74 68 69 73 2d 73 74 s 'pass) this-st
2b70: 65 70 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 ep-status)......
2b80: 09 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f .... ((eq?
2b90: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 overall-status
2ba0: 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 'warn)..........
2bb0: 09 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 .(if (eq? this-s
2bc0: 74 65 70 2d 73 74 61 74 75 73 20 27 66 61 69 6c tep-status 'fail
2bd0: 29 20 27 66 61 69 6c 20 27 77 61 72 6e 29 29 0a ) 'fail 'warn)).
2be0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2bf0: 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 29 0a (else 'fail)))).
2c00: 09 09 09 09 09 09 20 20 20 20 20 20 20 28 64 65 ...... (de
2c10: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 45 78 69 bug:print 4 "Exi
2c20: 74 20 76 61 6c 75 65 20 72 65 63 65 69 76 65 64 t value received
2c30: 3a 20 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 : " (vector-ref
2c40: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 22 20 6c exit-info 2) " l
2c50: 6f 67 70 72 6f 2d 75 73 65 64 3a 20 22 20 6c 6f ogpro-used: " lo
2c60: 67 70 72 6f 2d 75 73 65 64 20 0a 09 09 09 09 09 gpro-used ......
2c70: 09 09 09 20 20 20 20 22 20 74 68 69 73 2d 73 74 ... " this-st
2c80: 65 70 2d 73 74 61 74 75 73 3a 20 22 20 74 68 69 ep-status: " thi
2c90: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 22 20 s-step-status "
2ca0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a 20 overall-status:
2cb0: 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 " overall-status
2cc0: 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 20 ......... "
2cd0: 6e 65 78 74 2d 73 74 61 74 75 73 3a 20 22 20 6e next-status: " n
2ce0: 65 78 74 2d 73 74 61 74 75 73 20 22 20 72 6f 6c ext-status " rol
2cf0: 6c 75 70 2d 73 74 61 74 75 73 3a 20 22 20 72 6f lup-status: " ro
2d00: 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 09 llup-status)....
2d10: 09 09 09 20 20 20 20 20 20 20 28 63 61 73 65 20 ... (case
2d20: 6e 65 78 74 2d 73 74 61 74 75 73 0a 09 09 09 09 next-status.....
2d30: 09 09 09 20 28 28 77 61 72 6e 29 0a 09 09 09 09 ... ((warn).....
2d40: 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 ... (set! rollu
2d50: 70 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 p-status 2).....
2d60: 09 09 09 20 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 ... ;; NB// tes
2d70: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f t-set-status! do
2d80: 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 es rdb calls und
2d90: 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 09 09 09 er the hood.....
2da0: 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 73 74 ... (tests:test
2db0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 -set-status! tes
2dc0: 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 t-id "RUNNING" "
2dd0: 57 41 52 4e 22 20 0a 09 09 09 09 09 09 09 09 09 WARN" ..........
2de0: 20 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d (if (eq? this-
2df0: 73 74 65 70 2d 73 74 61 74 75 73 20 27 77 61 72 step-status 'war
2e00: 6e 29 20 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 n) "Logpro warni
2e10: 6e 67 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 ng found" #f)...
2e20: 09 09 09 09 09 09 09 20 20 23 66 29 29 0a 09 09 ....... #f))...
2e30: 09 09 09 09 09 20 28 28 70 61 73 73 29 0a 09 09 ..... ((pass)...
2e40: 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 ..... (tests:te
2e50: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
2e60: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2e70: 20 22 50 41 53 53 22 20 23 66 20 23 66 29 29 0a "PASS" #f #f)).
2e80: 09 09 09 09 09 09 09 20 28 65 6c 73 65 20 3b 3b ....... (else ;;
2e90: 20 27 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 'fail........
2ea0: 28 73 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 (set! rollup-sta
2eb0: 74 75 73 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 tus 1) ;; force
2ec0: 66 61 69 6c 0a 09 09 09 09 09 09 09 20 20 28 74 fail........ (t
2ed0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
2ee0: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
2ef0: 55 4e 4e 49 4e 47 22 20 22 46 41 49 4c 22 20 28 UNNING" "FAIL" (
2f00: 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 conc "Failed at
2f10: 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 step " stepname)
2f20: 20 23 66 29 0a 09 09 09 09 09 09 09 20 20 29 29 #f)........ ))
2f30: 29 29 0a 09 09 09 09 09 09 20 20 20 28 69 66 20 ))....... (if
2f40: 28 61 6e 64 20 28 73 74 65 70 72 75 6e 2d 67 6f (and (steprun-go
2f50: 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 od? logpro-used
2f60: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
2f70: 2d 69 6e 66 6f 20 32 29 29 0a 09 09 09 09 09 09 -info 2)).......
2f80: 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f . (not (null?
2f90: 20 74 61 6c 29 29 29 0a 09 09 09 09 09 09 20 20 tal))).......
2fa0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
2fb0: 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 tal) (cdr tal) s
2fc0: 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 09 09 tepname)))......
2fd0: 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 . (debug:print 4
2fe0: 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 "WARNING: a pri
2ff0: 6f 72 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 or step failed,
3000: 73 74 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a stopping at " ez
3010: 73 74 65 70 29 29 29 29 29 29 29 29 0a 09 09 20 step))))))))...
3020: 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c (monitorjob (l
3030: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 20 28 6c ambda ()..... (l
3040: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
3050: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
3060: 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 63 61 6c onds))......(cal
3070: 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 c-minutes (lamb
3080: 64 61 20 28 29 0a 09 09 09 09 09 09 09 20 28 69 da ()........ (i
3090: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 nexact->exact ..
30a0: 09 09 09 09 09 09 20 20 28 72 6f 75 6e 64 20 0a ...... (round .
30b0: 09 09 09 09 09 09 09 20 20 20 28 2d 20 0a 09 09 ....... (- ...
30c0: 09 09 09 09 09 20 20 20 20 28 63 75 72 72 65 6e ..... (curren
30d0: 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 09 t-seconds) .....
30e0: 09 09 09 20 20 20 20 73 74 61 72 74 2d 73 65 63 ... start-sec
30f0: 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 09 09 28 onds)))))......(
3100: 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a 09 kill-tries 0))..
3110: 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ... (let loop
3120: 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c ((minutes (cal
3130: 63 2d 6d 69 6e 75 74 65 73 29 29 29 0a 09 09 09 c-minutes)))....
3140: 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 . (begin....
3150: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 69 . (set! ki
3160: 6c 6c 2d 6a 6f 62 3f 20 28 74 65 73 74 2d 67 65 ll-job? (test-ge
3170: 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 74 t-kill-request t
3180: 65 73 74 2d 69 64 29 29 20 3b 3b 20 72 75 6e 2d est-id)) ;; run-
3190: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
31a0: 6d 64 61 74 29 29 0a 09 09 09 09 20 20 20 20 20 mdat)).....
31b0: 20 20 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c ;; open-run-cl
31c0: 6f 73 65 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 ose not needed f
31d0: 6f 72 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 or test-set-meta
31e0: 2d 69 6e 66 6f 0a 09 09 09 09 20 20 20 20 20 20 -info.....
31f0: 20 28 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d (test-set-meta-
3200: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
3210: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
3220: 20 69 74 65 6d 64 61 74 20 6d 69 6e 75 74 65 73 itemdat minutes
3230: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 )..... (if
3240: 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 09 09 09 kill-job? .....
3250: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
3260: 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b (mutex-lock
3270: 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 20 28 ! m)...... (
3280: 6c 65 74 2a 20 28 28 70 69 64 20 28 76 65 63 74 let* ((pid (vect
3290: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
32a0: 20 30 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 0)))......
32b0: 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 70 (if (number? p
32c0: 69 64 29 0a 09 09 09 09 09 09 20 20 20 28 62 65 id)....... (be
32d0: 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 28 gin....... (
32e0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 debug:print 0 "W
32f0: 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 20 ARNING: Request
3300: 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c 6c received to kill
3310: 20 6a 6f 62 20 28 61 74 74 65 6d 70 74 20 23 20 job (attempt #
3320: 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 " kill-tries ")"
3330: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 )....... (le
3340: 74 20 28 28 70 72 6f 63 65 73 73 65 73 20 28 63 t ((processes (c
3350: 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f md-run->list (co
3360: 6e 63 20 22 70 67 72 65 70 20 2d 6c 20 2d 50 20 nc "pgrep -l -P
3370: 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 09 " pid)))).......
3380: 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
3390: 20 0a 09 09 09 09 09 09 09 28 6c 61 6d 62 64 61 ........(lambda
33a0: 20 28 70 29 0a 09 09 09 09 09 09 09 20 20 28 6c (p)........ (l
33b0: 65 74 2a 20 28 28 70 61 72 74 73 20 20 28 73 74 et* ((parts (st
33c0: 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 29 0a 09 ring-split p))..
33d0: 09 09 09 09 09 09 09 20 28 70 2d 69 64 20 20 20 ....... (p-id
33e0: 28 69 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 (if (> (length p
33f0: 61 72 74 73 29 20 30 29 0a 09 09 09 09 09 09 09 arts) 0)........
3400: 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e .. (string->
3410: 6e 75 6d 62 65 72 20 28 63 61 72 20 70 61 72 74 number (car part
3420: 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 s))..........
3430: 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 #f)))........
3440: 20 20 20 28 69 66 20 70 2d 69 64 0a 09 09 09 09 (if p-id.....
3450: 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 09 ....(begin......
3460: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
3470: 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 t 0 "Killing " (
3480: 63 61 64 72 20 70 61 72 74 73 29 20 22 3b 20 6b cadr parts) "; k
3490: 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 0a ill -9 " p-id).
34a0: 09 09 09 09 09 09 09 09 20 20 28 73 79 73 74 65 ........ (syste
34b0: 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 m (conc "kill -9
34c0: 20 22 20 70 2d 69 64 29 29 29 29 29 29 0a 09 09 " p-id))))))...
34d0: 09 09 09 09 09 28 63 61 72 20 70 72 6f 63 65 73 .....(car proces
34e0: 73 65 73 29 29 0a 09 09 09 09 09 09 20 20 20 20 ses)).......
34f0: 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 (system (conc
3500: 20 22 6b 69 6c 6c 20 2d 39 20 2d 22 20 70 69 64 "kill -9 -" pid
3510: 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 28 62 ))))....... (b
3520: 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 20 egin.......
3530: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
3540: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
3550: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
3560: 6c 20 6a 6f 62 20 62 75 74 20 70 72 6f 62 6c 65 l job but proble
3570: 6d 20 77 69 74 68 20 70 72 6f 63 65 73 73 2c 20 m with process,
3580: 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 6b 69 attempting to ki
3590: 6c 6c 20 6d 61 6e 61 67 65 72 20 70 72 6f 63 65 ll manager proce
35a0: 73 73 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 ss").......
35b0: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
35c0: 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 status! test-id
35d0: 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 49 4c 22 "KILLED" "FAIL"
35e0: 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 61 ......... (a
35f0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
3600: 29 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 ) #f).......
3610: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
3620: 7a 65 21 20 74 64 62 29 0a 09 09 09 09 09 09 20 ze! tdb).......
3630: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 0a (exit 1)))).
3640: 09 09 09 09 09 20 20 20 20 20 28 73 65 74 21 20 ..... (set!
3650: 6b 69 6c 6c 2d 74 72 69 65 73 20 28 2b 20 31 20 kill-tries (+ 1
3660: 6b 69 6c 6c 2d 74 72 69 65 73 29 29 0a 09 09 09 kill-tries))....
3670: 09 09 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e .. (mutex-un
3680: 6c 6f 63 6b 21 20 6d 29 29 29 0a 09 09 09 09 20 lock! m))).....
3690: 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 ;; (sqlite
36a0: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 3:finalize! db).
36b0: 09 09 09 09 20 20 20 20 20 20 20 28 74 68 72 65 .... (thre
36c0: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 30 20 ad-sleep! (+ 10
36d0: 28 72 61 6e 64 6f 6d 20 31 30 29 29 29 20 3b 3b (random 10))) ;;
36e0: 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 add some jitter
36f0: 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d to the call hom
3700: 65 20 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 e time to spread
3710: 20 6f 75 74 20 74 68 65 20 64 62 20 61 63 63 65 out the db acce
3720: 73 73 65 73 0a 09 09 09 09 20 20 20 20 20 20 20 sses.....
3730: 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e 75 (loop (calc-minu
3740: 74 65 73 29 29 29 29 29 29 29 0a 09 09 20 28 74 tes)))))))... (t
3750: 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b h1 (mak
3760: 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 e-thread monitor
3770: 6a 6f 62 29 29 0a 09 09 20 28 74 68 32 20 20 20 job))... (th2
3780: 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 (make-thr
3790: 65 61 64 20 72 75 6e 69 74 29 29 29 0a 09 20 20 ead runit)))..
37a0: 20 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 (set! job-thre
37b0: 61 64 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 ad th2).. (th
37c0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
37d0: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
37e0: 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 28 art! th2).. (
37f0: 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 thread-join! th2
3800: 29 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f ).. (mutex-lo
3810: 63 6b 21 20 6d 29 0a 09 20 20 20 20 28 6c 65 74 ck! m).. (let
3820: 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 * ((item-path (i
3830: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
3840: 74 65 6d 64 61 74 29 29 0a 09 09 20 20 20 28 74 temdat))... (t
3850: 65 73 74 69 6e 66 6f 20 20 28 63 64 62 3a 67 65 estinfo (cdb:ge
3860: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
3870: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 d *runremote* te
3880: 73 74 2d 69 64 29 29 29 20 3b 3b 20 29 29 20 3b st-id))) ;; )) ;
3890: 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 ; run-id test-na
38a0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a me item-path))).
38b0: 09 20 20 20 20 20 20 3b 3b 20 41 6d 20 49 20 63 . ;; Am I c
38c0: 6f 6d 70 6c 65 74 65 64 3f 0a 09 20 20 20 20 20 ompleted?..
38d0: 20 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c (if (not (equal
38e0: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
38f0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) "
3900: 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 COMPLETED"))...
3910: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 (begin... (d
3920: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 54 65 ebug:print 2 "Te
3930: 73 74 20 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 st NOT logged as
3940: 20 43 4f 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 COMPLETED, (sta
3950: 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 te=" (db:test-ge
3960: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
3970: 29 20 22 29 2c 20 75 70 64 61 74 69 6e 67 20 72 ) "), updating r
3980: 65 73 75 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 74 esult, rollup-st
3990: 61 74 75 73 20 69 73 20 22 20 72 6f 6c 6c 75 70 atus is " rollup
39a0: 2d 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 28 -status)... (
39b0: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
39c0: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 0a tatus! test-id .
39d0: 09 09 09 09 20 20 20 20 28 69 66 20 6b 69 6c 6c .... (if kill
39e0: 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 -job? "KILLED" "
39f0: 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 09 09 09 COMPLETED").....
3a00: 20 20 20 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 (cond.....
3a10: 20 20 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 ((not (vector
3a20: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 -ref exit-info 1
3a30: 29 29 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f )) "FAIL") ;; jo
3a40: 62 20 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 0a b failed to run.
3a50: 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 72 .... ((eq? r
3a60: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 0a ollup-status 0).
3a70: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 66 20 .... ;; if
3a80: 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 the current stat
3a90: 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 20 64 us is AUTO the d
3aa0: 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 efer to the calc
3ab0: 75 6c 61 74 65 64 20 76 61 6c 75 65 20 28 69 2e ulated value (i.
3ac0: 65 2e 20 6c 65 61 76 65 20 74 68 69 73 20 41 55 e. leave this AU
3ad0: 54 4f 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 TO)..... (i
3ae0: 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 f (equal? (db:te
3af0: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
3b00: 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 stinfo) "AUTO")
3b10: 22 41 55 54 4f 22 20 22 50 41 53 53 22 29 29 0a "AUTO" "PASS")).
3b20: 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 72 .... ((eq? r
3b30: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 ollup-status 1)
3b40: 22 46 41 49 4c 22 29 0a 09 09 09 09 20 20 20 20 "FAIL").....
3b50: 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 ((eq? rollup-st
3b60: 61 74 75 73 20 32 29 0a 09 09 09 09 20 20 20 20 atus 2).....
3b70: 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 72 ;; if the curr
3b80: 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 55 ent status is AU
3b90: 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 6f 20 TO the defer to
3ba0: 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 20 76 the calculated v
3bb0: 61 6c 75 65 20 62 75 74 20 71 75 61 6c 69 66 79 alue but qualify
3bc0: 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 68 69 73 (i.e. make this
3bd0: 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 09 09 09 AUTO-WARN).....
3be0: 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c (if (equal
3bf0: 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ? (db:test-get-s
3c00: 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 20 tatus testinfo)
3c10: 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 41 "AUTO") "AUTO-WA
3c20: 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 09 09 RN" "WARN"))....
3c30: 09 20 20 20 20 20 28 65 6c 73 65 20 22 46 41 49 . (else "FAI
3c40: 4c 22 29 29 0a 09 09 09 09 20 20 20 20 28 61 72 L"))..... (ar
3c50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
3c60: 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 3b 3b #f))).. ;;
3c70: 20 66 6f 72 20 61 75 74 6f 6d 61 74 65 64 20 63 for automated c
3c80: 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 72 reation of the r
3c90: 6f 6c 6c 75 70 20 68 74 6d 6c 20 66 69 6c 65 20 ollup html file
3ca0: 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 this is a good p
3cb0: 6c 61 63 65 2e 2e 2e 0a 09 20 20 20 20 20 20 28 lace..... (
3cc0: 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 if (not (equal?
3cd0: 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a 09 item-path ""))..
3ce0: 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f . (open-run-clo
3cf0: 73 65 20 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 se tests:summari
3d00: 7a 65 2d 69 74 65 6d 73 20 23 66 20 72 75 6e 2d ze-items #f run-
3d10: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 id test-name #f)
3d20: 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 ) ;; don't force
3d30: 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 - just update i
3d40: 66 20 6e 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 f no.. )..
3d50: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
3d60: 21 20 6d 29 0a 09 20 20 20 20 3b 3b 20 28 65 78 ! m).. ;; (ex
3d70: 65 63 2d 72 65 73 75 6c 74 73 20 28 63 6d 64 2d ec-results (cmd-
3d80: 72 75 6e 2d 3e 6c 69 73 74 20 66 75 6c 6c 72 75 run->list fullru
3d90: 6e 73 63 72 69 70 74 29 29 20 3b 3b 20 20 28 6c nscript)) ;; (l
3da0: 69 73 74 20 22 3e 22 20 28 63 6f 6e 63 20 74 65 ist ">" (conc te
3db0: 73 74 2d 6e 61 6d 65 20 22 2d 72 75 6e 2e 6c 6f st-name "-run.lo
3dc0: 67 22 29 29 29 29 0a 09 20 20 20 20 3b 3b 20 28 g")))).. ;; (
3dd0: 73 75 63 63 65 73 73 20 20 20 20 20 20 65 78 65 success exe
3de0: 63 2d 72 65 73 75 6c 74 73 29 29 20 3b 3b 20 28 c-results)) ;; (
3df0: 65 71 3f 20 28 63 61 64 72 20 65 78 65 63 2d 72 eq? (cadr exec-r
3e00: 65 73 75 6c 74 73 29 20 30 29 29 29 0a 09 20 20 esults) 0)))..
3e10: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
3e20: 20 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 75 "Output from ru
3e30: 6e 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 nning " fullruns
3e40: 63 72 69 70 74 20 22 2c 20 70 69 64 20 22 20 28 cript ", pid " (
3e50: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
3e60: 69 6e 66 6f 20 30 29 20 22 20 69 6e 20 77 6f 72 info 0) " in wor
3e70: 6b 20 61 72 65 61 20 22 20 0a 09 09 09 20 77 6f k area " .... wo
3e80: 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d rk-area ":\n====
3e90: 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 \n exit code " (
3ea0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
3eb0: 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 3d 3d info 2) "\n" "==
3ec0: 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 3b 3b 20 28 ==\n").. ;; (
3ed0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
3ee0: 21 20 64 62 29 0a 09 20 20 20 20 3b 3b 20 28 73 ! db).. ;; (s
3ef0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
3f00: 20 74 64 62 29 0a 09 20 20 20 20 28 69 66 20 28 tdb).. (if (
3f10: 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 not (vector-ref
3f20: 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 0a 09 09 exit-info 1))...
3f30: 28 65 78 69 74 20 34 29 29 29 29 29 29 29 0a 0a (exit 4)))))))..
3f40: 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 76 65 ;; set up the ve
3f50: 72 79 20 62 61 73 69 63 73 20 6e 65 65 64 65 64 ry basics needed
3f60: 20 66 6f 72 20 64 6f 69 6e 67 20 61 6e 79 74 68 for doing anyth
3f70: 69 6e 67 20 68 65 72 65 2e 0a 28 64 65 66 69 6e ing here..(defin
3f80: 65 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e e (setup-for-run
3f90: 29 0a 20 20 3b 3b 20 77 6f 75 6c 64 20 73 65 74 ). ;; would set
3fa0: 20 76 61 6c 75 65 73 20 66 6f 72 20 4b 45 59 53 values for KEYS
3fb0: 20 69 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d in the environm
3fc0: 65 6e 74 20 68 65 72 65 20 66 6f 72 20 62 65 74 ent here for bet
3fd0: 74 65 72 20 73 75 70 70 6f 72 74 20 6f 66 20 65 ter support of e
3fe0: 6e 76 2d 6f 76 65 72 72 69 64 65 20 62 75 74 20 nv-override but
3ff0: 0a 20 20 3b 3b 20 68 61 76 65 20 63 68 69 63 6b . ;; have chick
4000: 65 6e 2f 65 67 67 20 73 63 65 6e 61 72 69 6f 2e en/egg scenario.
4010: 20 6e 65 65 64 20 74 6f 20 72 65 61 64 20 6d 65 need to read me
4020: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 74 68 gatest.config th
4030: 65 6e 20 72 65 61 64 20 69 74 20 61 67 61 69 6e en read it again
4040: 2e 20 47 6f 69 6e 67 20 74 6f 20 0a 20 20 3b 3b . Going to . ;;
4050: 20 70 61 73 73 20 6f 6e 20 74 68 61 74 20 69 64 pass on that id
4060: 65 61 20 66 6f 72 20 6e 6f 77 0a 20 20 3b 3b 20 ea for now. ;;
4070: 73 70 65 63 69 61 6c 20 63 61 73 65 0a 20 20 28 special case. (
4080: 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f set! *configinfo
4090: 2a 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 * (find-and-read
40a0: 2d 63 6f 6e 66 69 67 20 0a 09 09 20 20 20 20 20 -config ...
40b0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
40c0: 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 rg "-config")(ar
40d0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e gs:get-arg "-con
40e0: 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e fig") "megatest.
40f0: 63 6f 6e 66 69 67 22 29 0a 09 09 20 20 20 20 20 config")...
4100: 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 environ-patt: "
4110: 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 0a 09 09 env-override"...
4120: 20 20 20 20 20 20 67 69 76 65 6e 2d 74 6f 70 70 given-topp
4130: 61 74 68 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f ath: (get-enviro
4140: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
4150: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
4160: 22 29 0a 09 09 20 20 20 20 20 20 70 61 74 68 65 ")... pathe
4170: 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 nvvar: "MT_RUN_A
4180: 52 45 41 5f 48 4f 4d 45 22 29 29 0a 20 20 28 73 REA_HOME")). (s
4190: 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 et! *configdat*
41a0: 20 28 69 66 20 28 63 61 72 20 2a 63 6f 6e 66 69 (if (car *confi
41b0: 67 69 6e 66 6f 2a 29 28 63 61 72 20 2a 63 6f 6e ginfo*)(car *con
41c0: 66 69 67 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 figinfo*) #f)).
41d0: 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a (set! *toppath*
41e0: 20 20 20 20 28 69 66 20 28 63 61 72 20 2a 63 6f (if (car *co
41f0: 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 64 72 20 nfiginfo*)(cadr
4200: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 66 *configinfo*) #f
4210: 29 29 0a 20 20 28 69 66 20 2a 74 6f 70 70 61 74 )). (if *toppat
4220: 68 2a 0a 20 20 20 20 20 20 28 73 65 74 65 6e 76 h*. (setenv
4230: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
4240: 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b ME" *toppath*) ;
4250: 3b 20 74 6f 20 62 65 20 64 65 70 72 65 63 61 74 ; to be deprecat
4260: 65 64 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a ed. (debug:
4270: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
4280: 66 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 failed to find t
4290: 68 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 79 he top path to y
42a0: 6f 75 72 20 72 75 6e 20 73 65 74 75 70 2e 22 29 our run setup.")
42b0: 29 0a 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 0a ). *toppath*)..
42c0: 28 64 65 66 69 6e 65 20 28 67 65 74 2d 62 65 73 (define (get-bes
42d0: 74 2d 64 69 73 6b 20 63 6f 6e 66 64 61 74 29 0a t-disk confdat).
42e0: 20 20 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 (let* ((disks
42f0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
4300: 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 ef/default confd
4310: 61 74 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a at "disks" #f)).
4320: 09 20 28 62 65 73 74 20 20 20 20 20 23 66 29 0a . (best #f).
4330: 09 20 28 62 65 73 74 73 69 7a 65 20 30 29 29 0a . (bestsize 0)).
4340: 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 (if disks ..
4350: 28 66 6f 72 2d 65 61 63 68 20 0a 09 20 28 6c 61 (for-each .. (la
4360: 6d 62 64 61 20 28 64 69 73 6b 2d 6e 75 6d 29 0a mbda (disk-num).
4370: 09 20 20 20 28 6c 65 74 2a 20 28 28 64 69 72 70 . (let* ((dirp
4380: 61 74 68 20 20 20 20 28 63 61 64 72 20 28 61 73 ath (cadr (as
4390: 73 6f 63 20 64 69 73 6b 2d 6e 75 6d 20 64 69 73 soc disk-num dis
43a0: 6b 73 29 29 29 0a 09 09 20 20 28 66 72 65 65 73 ks)))... (frees
43b0: 70 63 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 pc (if (and (
43c0: 64 69 72 65 63 74 6f 72 79 3f 20 64 69 72 70 61 directory? dirpa
43d0: 74 68 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 th)..... (
43e0: 66 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 file-write-acces
43f0: 73 3f 20 64 69 72 70 61 74 68 29 29 0a 09 09 09 s? dirpath))....
4400: 09 20 20 28 67 65 74 2d 64 66 20 64 69 72 70 61 . (get-df dirpa
4410: 74 68 29 0a 09 09 09 09 20 20 28 62 65 67 69 6e th)..... (begin
4420: 0a 09 09 09 09 20 20 20 20 28 64 65 62 75 67 3a ..... (debug:
4430: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
4440: 3a 20 70 61 74 68 20 22 20 64 69 72 70 61 74 68 : path " dirpath
4450: 20 22 20 69 6e 20 5b 64 69 73 6b 73 5d 20 73 65 " in [disks] se
4460: 63 74 69 6f 6e 20 6e 6f 74 20 76 61 6c 69 64 20 ction not valid
4470: 6f 72 20 77 72 69 74 61 62 6c 65 22 29 0a 09 09 or writable")...
4480: 09 09 20 20 20 20 30 29 29 29 29 0a 09 20 20 20 .. 0))))..
4490: 20 20 28 69 66 20 28 3e 20 66 72 65 65 73 70 63 (if (> freespc
44a0: 20 62 65 73 74 73 69 7a 65 29 0a 09 09 20 28 62 bestsize)... (b
44b0: 65 67 69 6e 0a 09 09 20 20 20 28 73 65 74 21 20 egin... (set!
44c0: 62 65 73 74 20 20 20 20 20 64 69 72 70 61 74 68 best dirpath
44d0: 29 0a 09 09 20 20 20 28 73 65 74 21 20 62 65 73 )... (set! bes
44e0: 74 73 69 7a 65 20 66 72 65 65 73 70 63 29 29 29 tsize freespc)))
44f0: 29 29 0a 09 20 28 6d 61 70 20 63 61 72 20 64 69 )).. (map car di
4500: 73 6b 73 29 29 29 0a 20 20 20 20 28 69 66 20 62 sks))). (if b
4510: 65 73 74 0a 09 62 65 73 74 0a 09 28 62 65 67 69 est..best..(begi
4520: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
4530: 74 20 30 20 22 45 52 52 4f 52 3a 20 4e 6f 20 76 t 0 "ERROR: No v
4540: 61 6c 69 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 alid disks found
4550: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e in megatest.con
4560: 66 69 67 2e 20 50 6c 65 61 73 65 20 61 64 64 20 fig. Please add
4570: 73 6f 6d 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 some to your [di
4580: 73 6b 73 5d 20 73 65 63 74 69 6f 6e 22 29 0a 09 sks] section")..
4590: 20 20 28 65 78 69 74 20 31 29 29 29 29 29 0a 0a (exit 1)))))..
45a0: 3b 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 63 ;; Desired direc
45b0: 74 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a tory structure:.
45c0: 3b 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e ;;.;; <linkdir>
45d0: 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 - <target> - <t
45e0: 65 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 estname> -..;;
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4610: 20 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 |.;;
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 20 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b v.;;
4640: 20 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c <rundir> - <
4650: 74 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 target> - <t
4660: 65 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 estname> -|- <it
4670: 65 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b empath(s)>.;;.;;
4680: 20 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 dir stored in
4690: 74 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 test is:.;; .;;
46a0: 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 <linkdir> - <ta
46b0: 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d rget> - <testnam
46c0: 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 e> [ - <itempath
46d0: 3e 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c > ].;; .;; All l
46e0: 6f 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 og file links sh
46f0: 6f 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 ould be stored r
4700: 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
4710: 6f 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a op of link path.
4720: 3b 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e ;; .;; <target>
4730: 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 - <testname> [
4740: 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a - <itempath> ] .
4750: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 ;;.(define (crea
4760: 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 te-work-area db
4770: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 run-id test-id t
4780: 65 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 est-src-path dis
4790: 6b 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 k-path testname
47a0: 69 74 65 6d 64 61 74 29 0a 20 20 28 6c 65 74 2a itemdat). (let*
47b0: 20 28 28 72 75 6e 2d 69 6e 66 6f 20 28 63 64 62 ((run-info (cdb
47c0: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 :remote-run db:g
47d0: 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 23 66 20 72 et-run-info #f r
47e0: 75 6e 2d 69 64 29 29 0a 09 20 28 69 74 65 6d 2d un-id)).. (item-
47f0: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
4800: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
4810: 09 20 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a . (runname (db:
4820: 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 get-value-by-hea
4830: 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 der (db:get-row
4840: 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 run-info)......
4850: 20 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 (db:get-header
4860: 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 run-info)......
4870: 20 20 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 "runname"))..
4880: 20 3b 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 6b ;; convert back
4890: 20 74 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 to db: from rdb
48a0: 3a 20 2d 20 74 68 69 73 20 69 73 20 61 6c 77 61 : - this is alwa
48b0: 79 73 20 72 75 6e 20 61 74 20 73 65 72 76 65 72 ys run at server
48c0: 20 65 6e 64 0a 09 20 28 6b 65 79 2d 76 61 6c 73 end.. (key-vals
48d0: 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e (cdb:remote-run
48e0: 20 64 62 3a 67 65 74 2d 6b 65 79 2d 76 61 6c 73 db:get-key-vals
48f0: 20 23 66 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 #f run-id)).. (
4900: 74 61 72 67 65 74 20 20 20 28 73 74 72 69 6e 67 target (string
4910: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 6b 65 79 -intersperse key
4920: 2d 76 61 6c 73 20 22 2f 22 29 29 0a 0a 09 20 28 -vals "/"))... (
4930: 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 not-iterated (e
4940: 71 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 qual? "" item-pa
4950: 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 th))... ;; all t
4960: 65 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 ests are found a
4970: 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d t <rundir>/test-
4980: 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 base or <linkdir
4990: 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 >/test-base.. (t
49a0: 65 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e esttop-base (con
49b0: 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e c target "/" run
49c0: 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d name "/" testnam
49d0: 65 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 e)).. (test-base
49e0: 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f (conc testto
49f0: 70 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 p-base (if not-i
4a00: 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 terated "" "/")
4a10: 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b item-path))... ;
4a20: 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 ; nb// if itempa
4a30: 74 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 th is not "" the
4a40: 6e 20 69 74 20 69 73 20 70 72 65 66 69 78 65 64 n it is prefixed
4a50: 20 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 with "/".. (top
4a60: 74 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 test-path (conc
4a70: 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 disk-path "/" te
4a80: 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 sttop-base)).. (
4a90: 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f test-path (co
4aa0: 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 nc disk-path "/"
4ab0: 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 test-base))...
4ac0: 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 65 ;; ensure this e
4ad0: 78 69 73 74 73 20 66 69 72 73 74 20 61 73 20 6c xists first as l
4ae0: 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 73 inks to subtests
4af0: 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 64 must be created
4b00: 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 there.. (linktr
4b10: 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 63 ee (let ((rd (c
4b20: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
4b30: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
4b40: 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 "linktree")))..
4b50: 09 20 20 20 20 20 20 28 69 66 20 72 64 20 72 64 . (if rd rd
4b60: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
4b70: 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 "/runs"))))...
4b80: 28 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 (lnkbase (conc
4b90: 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 linktree "/" tar
4ba0: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 get "/" runname)
4bb0: 29 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 ).. (lnkpath (c
4bc0: 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 onc lnkbase "/"
4bd0: 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e testname)).. (ln
4be0: 6b 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b kpathf (conc lnk
4bf0: 70 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 path (if not-ite
4c00: 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 rated "" "/") it
4c10: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 em-path)))..
4c20: 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 75 ;; Update the ru
4c30: 6e 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 ndir path in the
4c40: 20 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 test record for
4c50: 20 61 6c 6c 0a 20 20 20 20 28 63 64 62 3a 74 65 all. (cdb:te
4c60: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 st-set-rundir-by
4c70: 2d 74 65 73 74 2d 69 64 20 2a 72 75 6e 72 65 6d -test-id *runrem
4c80: 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 6c 6e 6b ote* test-id lnk
4c90: 70 61 74 68 66 29 0a 0a 20 20 20 20 28 64 65 62 pathf).. (deb
4ca0: 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f ug:print 2 "INFO
4cb0: 3a 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 :\n lnkbas
4cc0: 65 3d 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 e=" lnkbase "\n
4cd0: 20 20 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 lnkpath="
4ce0: 6c 6e 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 lnkpath "\n top
4cf0: 74 65 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 test-path=" topt
4d00: 65 73 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 est-path "\n
4d10: 20 74 65 73 74 2d 70 61 74 68 3d 22 20 74 65 73 test-path=" tes
4d20: 74 2d 70 61 74 68 29 0a 20 20 20 20 28 69 66 20 t-path). (if
4d30: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
4d40: 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 s? linktree))..(
4d50: 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
4d60: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
4d70: 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 6e : linktree did n
4d80: 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 74 69 ot exist! Creati
4d90: 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 20 6c ng it now at " l
4da0: 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 72 65 inktree).. (cre
4db0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 ate-directory li
4dc0: 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b 3b 20 nktree #t))) ;;
4dd0: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d (system (conc "m
4de0: 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 kdir -p " linktr
4df0: 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 ee)))). ;; cr
4e00: 65 61 74 65 20 74 68 65 20 64 69 72 65 63 74 6f eate the directo
4e10: 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 74 73 ry for the tests
4e20: 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 dir links, this
4e30: 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 is needed no ma
4e40: 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 tter what....
4e50: 20 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 (if (not (direc
4e60: 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b tory-exists? lnk
4e70: 62 61 73 65 29 29 0a 09 28 63 72 65 61 74 65 2d base))..(create-
4e80: 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b 62 61 73 directory lnkbas
4e90: 65 20 23 74 29 29 0a 20 20 20 20 0a 20 20 20 20 e #t)). .
4ea0: 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 74 6f ;; update the to
4eb0: 70 74 65 73 74 20 72 65 63 6f 72 64 20 77 69 74 ptest record wit
4ec0: 68 20 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 h its location r
4ed0: 75 6e 64 69 72 2c 20 63 61 63 68 65 20 74 68 65 undir, cache the
4ee0: 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 path. ;; Thi
4ef0: 73 20 77 61 73 73 20 68 69 67 68 6c 79 20 69 6e s wass highly in
4f00: 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 efficient, one d
4f10: 62 20 77 72 69 74 65 20 66 6f 72 20 65 76 65 72 b write for ever
4f20: 79 20 73 75 62 74 65 73 74 2c 20 70 6f 74 65 6e y subtest, poten
4f30: 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 tially. ;; th
4f40: 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 ousands of unnec
4f50: 65 73 73 61 72 79 20 75 70 64 61 74 65 73 2c 20 essary updates,
4f60: 63 61 63 68 65 20 74 68 65 20 66 61 63 74 20 69 cache the fact i
4f70: 74 20 77 61 73 20 73 65 74 20 61 6e 64 20 64 6f t was set and do
4f80: 6e 27 74 20 73 65 74 20 69 74 20 0a 20 20 20 20 n't set it .
4f90: 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 ;; again. ..
4fa0: 3b 3b 20 4e 42 20 2d 20 54 68 69 73 20 69 73 20 ;; NB - This is
4fb0: 6e 6f 74 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 not working righ
4fc0: 74 20 2d 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 t - some top tes
4fd0: 74 73 20 61 72 65 20 6e 6f 74 20 67 65 74 74 69 ts are not getti
4fe0: 6e 67 20 74 68 65 20 70 61 74 68 20 73 65 74 21 ng the path set!
4ff0: 21 21 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 !!.. (if (not
5000: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
5010: 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 /default *toptes
5020: 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d t-paths* testnam
5030: 65 20 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 e #f))..(let* ((
5040: 74 65 73 74 69 6e 66 6f 20 20 20 20 20 20 20 28 testinfo (
5050: 63 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 cdb:get-test-inf
5060: 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f o-by-id *runremo
5070: 74 65 2a 20 74 65 73 74 2d 69 64 29 29 20 3b 3b te* test-id)) ;;
5080: 20 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d run-id testnam
5090: 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 e item-path))..
50a0: 20 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 74 (curr-test
50b0: 2d 70 61 74 68 20 28 69 66 20 74 65 73 74 69 6e -path (if testin
50c0: 66 6f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d fo (db:test-get-
50d0: 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 rundir testinfo)
50e0: 20 23 66 29 29 29 0a 09 20 20 28 68 61 73 68 2d #f))).. (hash-
50f0: 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 table-set! *topt
5100: 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e est-paths* testn
5110: 61 6d 65 20 63 75 72 72 2d 74 65 73 74 2d 70 61 ame curr-test-pa
5120: 74 68 29 0a 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 th).. ;; NB// W
5130: 61 73 20 74 68 69 73 20 66 6f 72 20 74 68 65 20 as this for the
5140: 74 65 73 74 20 6f 72 20 66 6f 72 20 74 68 65 20 test or for the
5150: 70 61 72 65 6e 74 20 69 6e 20 61 6e 20 69 74 65 parent in an ite
5160: 72 61 74 65 64 20 74 65 73 74 3f 0a 09 20 20 28 rated test?.. (
5170: 63 64 62 3a 74 65 73 74 2d 73 65 74 2d 72 75 6e cdb:test-set-run
5180: 64 69 72 21 20 2a 72 75 6e 72 65 6d 6f 74 65 2a dir! *runremote*
5190: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
51a0: 20 22 22 20 6c 6e 6b 70 61 74 68 29 20 3b 3b 20 "" lnkpath) ;;
51b0: 74 6f 70 74 65 73 74 2d 70 61 74 68 29 0a 09 20 toptest-path)..
51c0: 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 63 75 (if (or (not cu
51d0: 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 09 rr-test-path)...
51e0: 20 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 (not (director
51f0: 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 74 65 73 y-exists? toptes
5200: 74 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 t-path)))..
5210: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
5220: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 22 43 :print-info 2 "C
5230: 72 65 61 74 69 6e 67 20 22 20 74 6f 70 74 65 73 reating " toptes
5240: 74 2d 70 61 74 68 20 22 20 61 6e 64 20 6c 69 6e t-path " and lin
5250: 6b 20 22 20 6c 6e 6b 70 61 74 68 29 0a 09 09 28 k " lnkpath)...(
5260: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
5270: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 23 74 toptest-path #t
5280: 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d )...(hash-table-
5290: 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 set! *toptest-pa
52a0: 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f ths* testname to
52b0: 70 74 65 73 74 2d 70 61 74 68 29 29 29 29 29 0a ptest-path))))).
52c0: 0a 20 20 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 . ;; Now crea
52d0: 74 65 20 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d te the link from
52e0: 20 74 68 65 20 74 65 73 74 20 70 61 74 68 20 74 the test path t
52f0: 6f 20 74 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c o the link tree,
5300: 20 68 6f 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 however. ;;
5310: 69 66 20 74 68 65 20 74 65 73 74 20 69 73 20 69 if the test is i
5320: 74 65 72 61 74 65 64 20 69 74 20 69 73 20 6e 65 terated it is ne
5330: 63 65 73 73 61 72 79 20 74 6f 20 63 72 65 61 74 cessary to creat
5340: 65 20 74 68 65 20 70 61 72 65 6e 74 20 70 61 74 e the parent pat
5350: 68 0a 20 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 h. ;; to the
5360: 69 74 65 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 iteration. use p
5370: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
5380: 79 20 74 6f 20 74 72 69 6d 20 74 68 65 20 70 61 y to trim the pa
5390: 74 68 20 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b th by one. ;;
53a0: 20 6c 65 76 65 6c 0a 20 20 20 20 28 69 66 20 28 level. (if (
53b0: 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 not not-iterated
53c0: 29 20 3b 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 ) ;; i.e. iterat
53d0: 65 64 0a 09 28 6c 65 74 20 28 28 69 74 65 72 61 ed..(let ((itera
53e0: 74 65 64 2d 70 61 72 65 6e 74 20 20 28 70 61 74 ted-parent (pat
53f0: 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 hname-directory
5400: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
5410: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 29 0a " item-path)))).
5420: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
5430: 69 6e 66 6f 20 32 20 22 43 72 65 61 74 69 6e 67 info 2 "Creating
5440: 20 69 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 iterated parent
5450: 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 " iterated-pare
5460: 6e 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 nt).. (handle-e
5470: 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 xceptions.. ex
5480: 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 n.. (begin..
5490: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
54a0: 30 20 22 45 52 52 4f 52 3a 20 20 46 61 69 6c 65 0 "ERROR: Faile
54b0: 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 d to create dire
54c0: 63 74 6f 72 79 20 22 20 69 74 65 72 61 74 65 64 ctory " iterated
54d0: 2d 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 69 74 -parent ((condit
54e0: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
54f0: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
5500: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 age) exn) ", exi
5510: 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 ting").. (ex
5520: 69 74 20 31 29 29 0a 09 20 20 20 28 63 72 65 61 it 1)).. (crea
5530: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 65 te-directory ite
5540: 72 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 29 rated-parent #t)
5550: 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 73 79 ))).. (if (sy
5560: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b mbolic-link? lnk
5570: 70 61 74 68 29 20 0a 09 28 68 61 6e 64 6c 65 2d path) ..(handle-
5580: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e exceptions.. exn
5590: 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 .. (begin.. (d
55a0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
55b0: 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 ROR: Failed to
55c0: 72 65 6d 6f 76 65 20 73 79 6d 6c 69 6e 6b 20 22 remove symlink "
55d0: 20 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 lnkpath ((condi
55e0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
55f0: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
5600: 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 sage) exn) ", ex
5610: 69 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 69 iting").. (exi
5620: 74 20 31 29 29 0a 09 20 28 64 65 6c 65 74 65 2d t 1)).. (delete-
5630: 66 69 6c 65 20 6c 6e 6b 70 61 74 68 29 29 29 0a file lnkpath))).
5640: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f . (if (not (o
5650: 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 r (file-exists?
5660: 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 6d lnkpath)... (sym
5670: 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 bolic-link? lnkp
5680: 61 74 68 29 29 29 0a 09 28 68 61 6e 64 6c 65 2d ath)))..(handle-
5690: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e exceptions.. exn
56a0: 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 .. (begin.. (d
56b0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
56c0: 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 ROR: Failed to
56d0: 63 72 65 61 74 65 20 73 79 6d 6c 69 6e 6b 20 22 create symlink "
56e0: 20 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 lnkpath ((condi
56f0: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
5700: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
5710: 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 sage) exn) ", ex
5720: 69 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 69 iting").. (exi
5730: 74 20 31 29 29 0a 09 20 28 63 72 65 61 74 65 2d t 1)).. (create-
5740: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f symbolic-link to
5750: 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 ptest-path lnkpa
5760: 74 68 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b th))). . ;
5770: 3b 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 ; The toptest pa
5780: 74 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 th has been crea
5790: 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f ted, the link to
57a0: 20 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 the test in the
57b0: 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 linktree has.
57c0: 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 ;; been create
57d0: 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 d. Now, if this
57e0: 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 is an iterated t
57f0: 65 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 est the real tes
5800: 74 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 t dir must be cr
5810: 65 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e eated. (if (n
5820: 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 ot not-iterated)
5830: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 ;; this is an i
5840: 74 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 6c terated test..(l
5850: 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 et ((lnktarget (
5860: 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 conc lnkpath "/"
5870: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 item-path)))..
5880: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
5890: 22 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 20 "Setting up sub
58a0: 74 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 0a test run area").
58b0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
58c0: 32 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 72 2 " - creating r
58d0: 75 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 73 un area in " tes
58e0: 74 2d 70 61 74 68 29 0a 09 20 20 28 68 61 6e 64 t-path).. (hand
58f0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 le-exceptions..
5900: 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 6e exn.. (begin
5910: 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
5920: 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 20 46 int 0 "ERROR: F
5930: 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 ailed to create
5940: 64 69 72 65 63 74 6f 72 79 20 22 20 74 65 73 74 directory " test
5950: 2d 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f -path ((conditio
5960: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
5970: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
5980: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 e) exn) ", exiti
5990: 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 ng").. (exit
59a0: 20 31 29 29 0a 09 20 20 20 28 63 72 65 61 74 65 1)).. (create
59b0: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 2d -directory test-
59c0: 70 61 74 68 20 23 74 29 29 0a 09 20 20 28 64 65 path #t)).. (de
59d0: 62 75 67 3a 70 72 69 6e 74 20 32 20 0a 09 09 20 bug:print 2 ...
59e0: 20 20 20 20 20 20 22 20 2d 20 63 72 65 61 74 69 " - creati
59f0: 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 ng link from: "
5a00: 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 22 0a 09 test-path "\n"..
5a10: 09 20 20 20 20 20 20 20 22 20 20 20 20 20 20 20 . "
5a20: 20 20 20 20 20 20 20 20 20 20 20 20 74 6f 3a 20 to:
5a30: 22 20 6c 6e 6b 74 61 72 67 65 74 29 0a 0a 09 20 " lnktarget)...
5a40: 20 3b 3b 20 49 66 20 74 68 65 72 65 20 69 73 20 ;; If there is
5a50: 61 6c 72 65 61 64 79 20 61 20 73 79 6d 6c 69 6e already a symlin
5a60: 6b 20 64 65 6c 65 74 65 20 69 74 20 61 6e 64 20 k delete it and
5a70: 72 65 63 72 65 61 74 65 20 69 74 2e 0a 09 20 20 recreate it...
5a80: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
5a90: 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 20 28 ns.. exn.. (
5aa0: 62 65 67 69 6e 0a 09 20 20 20 20 20 28 64 65 62 begin.. (deb
5ab0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
5ac0: 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 72 65 R: Failed to re
5ad0: 2d 63 72 65 61 74 65 20 6c 69 6e 6b 20 22 20 6c -create link " l
5ae0: 69 6e 6b 74 61 72 67 65 74 20 28 28 63 6f 6e 64 inktarget ((cond
5af0: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
5b00: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
5b10: 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 ssage) exn) ", e
5b20: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 xiting").. (
5b30: 65 78 69 74 29 29 0a 09 20 20 20 28 69 66 20 28 exit)).. (if (
5b40: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
5b50: 6e 6b 74 61 72 67 65 74 29 20 20 20 20 20 28 64 nktarget) (d
5b60: 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 74 61 elete-file lnkta
5b70: 72 67 65 74 29 29 0a 09 20 20 20 28 69 66 20 28 rget)).. (if (
5b80: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 not (file-exists
5b90: 3f 20 6c 6e 6b 74 61 72 67 65 74 29 29 20 28 63 ? lnktarget)) (c
5ba0: 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c reate-symbolic-l
5bb0: 69 6e 6b 20 74 65 73 74 2d 70 61 74 68 20 6c 6e ink test-path ln
5bc0: 6b 74 61 72 67 65 74 29 29 29 29 29 0a 0a 20 20 ktarget)))))..
5bd0: 20 20 3b 3b 20 49 20 73 75 73 70 65 63 74 20 74 ;; I suspect t
5be0: 68 69 73 20 73 65 63 74 69 6f 6e 20 77 61 73 20 his section was
5bf0: 64 65 6c 65 74 69 6e 67 20 74 65 73 74 20 64 69 deleting test di
5c00: 72 65 63 74 6f 72 69 65 73 20 75 6e 64 65 72 20 rectories under
5c10: 73 6f 6d 65 20 0a 20 20 20 20 3b 3b 20 77 69 65 some . ;; wie
5c20: 72 64 20 73 69 74 61 74 69 6f 6e 73 3f 20 54 68 rd sitations? Th
5c30: 69 73 20 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 is doesn't make
5c40: 73 65 6e 73 65 20 2d 20 72 65 65 6e 61 62 6c 69 sense - reenabli
5c50: 6e 67 20 74 68 65 20 72 6d 20 2d 66 20 0a 20 20 ng the rm -f .
5c60: 20 20 3b 3b 20 49 20 68 6f 6e 65 73 74 6c 79 20 ;; I honestly
5c70: 64 6f 6e 27 74 20 72 65 6d 65 6d 62 65 72 20 2a don't remember *
5c80: 77 68 79 2a 20 74 68 69 73 20 63 68 75 6e 6b 20 why* this chunk
5c90: 77 61 73 20 6e 65 65 64 65 64 2e 2e 2e 0a 20 20 was needed....
5ca0: 20 20 3b 3b 20 28 6c 65 74 20 28 28 74 65 73 74 ;; (let ((test
5cb0: 6c 69 6e 6b 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 link (conc lnkpa
5cc0: 74 68 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 th "/" testname)
5cd0: 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 )). ;; (if
5ce0: 28 61 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 74 (and (file-exist
5cf0: 73 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 s? testlink).
5d00: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 ;; (
5d10: 6f 72 20 28 72 65 67 75 6c 61 72 2d 66 69 6c 65 or (regular-file
5d20: 3f 20 74 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 ? testlink).
5d30: 3b 3b 20 20 20 20 20 09 20 20 20 28 73 79 6d 62 ;; . (symb
5d40: 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 74 65 73 74 6c olic-link? testl
5d50: 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 ink))). ;;
5d60: 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e (system (con
5d70: 63 20 22 72 6d 20 2d 66 20 22 20 74 65 73 74 6c c "rm -f " testl
5d80: 69 6e 6b 29 29 29 0a 20 20 20 20 3b 3b 20 20 20 ink))). ;;
5d90: 28 73 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 (system (conc "
5da0: 6c 6e 20 2d 73 66 20 22 20 74 65 73 74 2d 70 61 ln -sf " test-pa
5db0: 74 68 20 22 20 22 20 74 65 73 74 6c 69 6e 6b 29 th " " testlink)
5dc0: 29 29 0a 20 20 20 20 28 69 66 20 28 64 69 72 65 )). (if (dire
5dd0: 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 61 74 68 ctory? test-path
5de0: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 65 )..(begin.. (le
5df0: 74 2a 20 28 28 6f 76 72 63 6d 64 20 28 6c 65 74 t* ((ovrcmd (let
5e00: 20 28 28 63 6d 64 20 28 63 6f 6e 66 69 67 2d 6c ((cmd (config-l
5e10: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
5e20: 2a 20 22 73 65 74 75 70 22 20 22 74 65 73 74 63 * "setup" "testc
5e30: 6f 70 79 63 6d 64 22 29 29 29 0a 09 09 09 20 20 opycmd")))....
5e40: 20 28 69 66 20 63 6d 64 0a 09 09 09 20 20 20 20 (if cmd....
5e50: 20 20 20 3b 3b 20 73 75 62 73 74 69 74 75 74 65 ;; substitute
5e60: 20 74 68 65 20 54 45 53 54 5f 53 52 43 5f 50 41 the TEST_SRC_PA
5e70: 54 48 20 61 6e 64 20 54 45 53 54 5f 54 41 52 47 TH and TEST_TARG
5e80: 5f 50 41 54 48 0a 09 09 09 20 20 20 20 20 20 20 _PATH....
5e90: 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 (string-substitu
5ea0: 74 65 20 22 54 45 53 54 5f 54 41 52 47 5f 50 41 te "TEST_TARG_PA
5eb0: 54 48 22 20 74 65 73 74 2d 70 61 74 68 0a 09 09 TH" test-path...
5ec0: 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 73 75 .... (string-su
5ed0: 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f 53 bstitute "TEST_S
5ee0: 52 43 5f 50 41 54 48 22 20 74 65 73 74 2d 73 72 RC_PATH" test-sr
5ef0: 63 2d 70 61 74 68 20 63 6d 64 29 29 0a 09 09 09 c-path cmd))....
5f00: 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 20 #f)))...
5f10: 28 63 6d 64 20 20 20 20 28 69 66 20 6f 76 72 63 (cmd (if ovrc
5f20: 6d 64 20 0a 09 09 09 20 20 20 20 20 6f 76 72 63 md .... ovrc
5f30: 6d 64 0a 09 09 09 20 20 20 20 20 28 63 6f 6e 63 md.... (conc
5f40: 20 22 72 73 79 6e 63 20 2d 61 76 22 20 28 69 66 "rsync -av" (if
5f50: 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f (debug:debug-mo
5f60: 64 65 20 31 29 20 22 22 20 22 71 22 29 20 22 20 de 1) "" "q") "
5f70: 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 " test-src-path
5f80: 22 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 "/ " test-path "
5f90: 2f 22 29 29 29 0a 09 09 20 28 73 74 61 74 75 73 /")))... (status
5fa0: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a (system cmd))).
5fb0: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
5fc0: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))...
5fd0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
5fe0: 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 ERROR: problem w
5ff0: 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 ith running \""
6000: 63 6d 64 20 22 5c 22 22 29 29 29 0a 09 20 20 28 cmd "\""))).. (
6010: 6c 69 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e list lnkpathf ln
6020: 6b 70 61 74 68 20 29 29 0a 09 28 6c 69 73 74 20 kpath ))..(list
6030: 23 66 20 23 66 29 29 29 29 0a 0a 3b 3b 20 31 2e #f #f))))..;; 1.
6040: 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 look though dis
6050: 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b ks list for disk
6060: 20 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 with most space
6070: 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 .;; 2. create ru
6080: 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 n dir on disk, p
6090: 61 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e ath name is mean
60a0: 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 ingful.;; 3. cre
60b0: 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 ate link from ru
60c0: 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 n dir to megates
60d0: 74 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 t runs area .;;
60e0: 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 4. remotely run
60f0: 74 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f the test on allo
6100: 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 cated host.;;
6110: 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 - could be ssh
6120: 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 to host from hos
6130: 74 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 ts table (update
6140: 20 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 regularly with
6150: 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f load).;; - co
6160: 75 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a uld be netbatch.
6170: 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d ;; (launch-
6180: 74 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 test db (cadr st
6190: 61 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 atus) test-conf)
61a0: 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ).(define (launc
61b0: 68 2d 74 65 73 74 20 64 62 20 72 75 6e 2d 69 64 h-test db run-id
61c0: 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f runname test-co
61d0: 6e 66 20 6b 65 79 76 61 6c 6c 73 74 20 74 65 73 nf keyvallst tes
61e0: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 t-name test-path
61f0: 20 69 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 itemdat params)
6200: 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
6210: 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 0a tory *toppath*).
6220: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
6230: 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 rs ;; consolidat
6240: 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 e this code with
6250: 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 the code in meg
6260: 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d atest.scm for "-
6270: 65 78 65 63 75 74 65 22 0a 20 20 20 28 6c 69 73 execute". (lis
6280: 74 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 t ;; (list "MT_T
6290: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
62a0: 6b 2d 61 72 65 61 29 0a 20 20 20 20 28 6c 69 73 k-area). (lis
62b0: 74 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 t "MT_RUN_AREA_H
62c0: 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a OME" *toppath*).
62d0: 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 (list "MT_TE
62e0: 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 ST_NAME" test-na
62f0: 6d 65 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 me). ;; (list
6300: 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
6310: 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 (conc itemdat))
6320: 0a 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 . (list "MT_R
6330: 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d UNNAME" runnam
6340: 65 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 e). ;; (list
6350: 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d "MT_TARGET" m
6360: 74 5f 74 61 72 67 65 74 29 0a 20 20 20 20 29 29 t_target). ))
6370: 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 65 73 68 . (let* ((usesh
6380: 65 6c 6c 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f ell (config-lo
6390: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
63a0: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
63b0: 22 75 73 65 73 68 65 6c 6c 22 29 29 0a 09 20 28 "useshell")).. (
63c0: 6c 61 75 6e 63 68 65 72 20 20 20 28 63 6f 6e 66 launcher (conf
63d0: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
63e0: 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 gdat* "jobtools"
63f0: 20 20 20 20 20 22 6c 61 75 6e 63 68 65 72 22 29 "launcher")
6400: 29 0a 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 ).. (runscript
6410: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 (config-lookup t
6420: 65 73 74 2d 63 6f 6e 66 20 20 20 22 73 65 74 75 est-conf "setu
6430: 70 22 20 20 20 20 20 20 20 20 22 72 75 6e 73 63 p" "runsc
6440: 72 69 70 74 22 29 29 0a 09 20 28 65 7a 73 74 65 ript")).. (ezste
6450: 70 73 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 68 ps (> (length
6460: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
6470: 2f 64 65 66 61 75 6c 74 20 74 65 73 74 2d 63 6f /default test-co
6480: 6e 66 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 nf "ezsteps" '()
6490: 29 29 20 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 )) 0)) ;; don't
64a0: 73 65 6e 64 20 61 6c 6c 20 74 68 65 20 73 74 65 send all the ste
64b0: 70 73 2c 20 63 6f 75 6c 64 20 62 65 20 62 69 67 ps, could be big
64c0: 0a 09 20 28 64 69 73 6b 73 70 61 63 65 20 20 28 .. (diskspace (
64d0: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 config-lookup te
64e0: 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 st-conf "requi
64f0: 72 65 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 rements" "disksp
6500: 61 63 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 ace")).. (memory
6510: 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f (config-loo
6520: 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 kup test-conf
6530: 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 "requirements" "
6540: 6d 65 6d 6f 72 79 22 29 29 0a 09 20 28 68 6f 73 memory")).. (hos
6550: 74 73 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d ts (config-
6560: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
6570: 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 t* "jobtools"
6580: 20 20 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a "workhosts")).
6590: 09 20 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 . (remote-megate
65a0: 73 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 st (config-looku
65b0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
65c0: 65 74 75 70 22 20 22 65 78 65 63 75 74 61 62 6c etup" "executabl
65d0: 65 22 29 29 0a 09 20 3b 3b 20 46 49 58 4d 45 20 e")).. ;; FIXME
65e0: 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 67 6f 6f SOMEDAY: not goo
65f0: 64 20 68 6f 77 20 74 68 69 73 20 69 73 20 73 6f d how this is so
6600: 20 6f 62 74 75 73 65 2c 20 74 68 69 73 20 68 61 obtuse, this ha
6610: 63 6b 20 69 73 20 74 6f 20 0a 09 20 3b 3b 20 20 ck is to .. ;;
6620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 6c al
6630: 6c 6f 77 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d low running from
6640: 20 64 61 73 68 62 6f 61 72 64 2e 20 45 78 74 72 dashboard. Extr
6650: 61 63 74 20 74 68 65 20 70 61 74 68 0a 09 20 3b act the path.. ;
6660: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
6670: 20 66 72 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 from the called
6680: 20 6d 65 67 61 74 65 73 74 20 61 6e 64 20 63 6f megatest and co
6690: 6e 76 65 72 74 20 64 61 73 68 62 6f 61 72 64 0a nvert dashboard.
66a0: 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 . ;;
66b0: 20 09 20 20 6f 72 20 64 62 6f 61 72 64 20 74 6f . or dboard to
66c0: 20 6d 65 67 61 74 65 73 74 0a 09 20 28 6c 6f 63 megatest.. (loc
66d0: 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 28 6c 65 al-megatest (le
66e0: 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 20 28 61 t* ((lm (car (a
66f0: 72 67 76 29 29 29 0a 09 09 09 09 20 28 64 69 72 rgv)))..... (dir
6700: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
6710: 74 6f 72 79 20 6c 6d 29 29 0a 09 09 09 09 20 28 tory lm))..... (
6720: 65 78 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 exe (pathname-st
6730: 72 69 70 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d rip-directory lm
6740: 29 29 29 0a 09 09 09 20 20 20 20 28 63 6f 6e 63 ))).... (conc
6750: 20 28 69 66 20 64 69 72 20 28 63 6f 6e 63 20 64 (if dir (conc d
6760: 69 72 20 22 2f 22 29 20 22 22 29 0a 09 09 09 09 ir "/") "").....
6770: 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d (case (string-
6780: 3e 73 79 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 >symbol exe)....
6790: 09 20 20 20 20 28 28 64 62 6f 61 72 64 29 20 20 . ((dboard)
67a0: 20 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 09 "megatest")...
67b0: 09 09 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 .. ((mtest)
67c0: 20 20 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 "megatest")..
67d0: 09 09 09 20 20 20 20 28 28 64 61 73 68 62 6f 61 ... ((dashboa
67e0: 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a rd) "megatest").
67f0: 09 09 09 09 20 20 20 20 28 65 6c 73 65 20 65 78 .... (else ex
6800: 65 29 29 29 29 29 0a 09 20 28 74 65 73 74 2d 73 e))))).. (test-s
6810: 69 67 20 20 20 28 63 6f 6e 63 20 74 65 73 74 2d ig (conc test-
6820: 6e 61 6d 65 20 22 3a 22 20 28 69 74 65 6d 2d 6c name ":" (item-l
6830: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
6840: 74 29 29 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 t))) ;; test-pat
6850: 68 20 69 73 20 74 68 65 20 66 75 6c 6c 20 70 61 h is the full pa
6860: 74 68 20 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 th including the
6870: 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 28 77 6f item-path.. (wo
6880: 72 6b 2d 61 72 65 61 20 20 23 66 29 0a 09 20 28 rk-area #f).. (
6890: 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 toptest-work-are
68a0: 61 20 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 a #f) ;; for ite
68b0: 72 61 74 65 64 20 74 65 73 74 73 20 74 68 65 20 rated tests the
68c0: 74 6f 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e top test contain
68d0: 73 20 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 s data relevant
68e0: 66 6f 72 20 61 6c 6c 0a 09 20 28 64 69 73 6b 70 for all.. (diskp
68f0: 61 74 68 20 20 20 23 66 29 0a 09 20 28 63 6d 64 ath #f).. (cmd
6900: 70 61 72 6d 73 20 20 20 23 66 29 0a 09 20 28 66 parms #f).. (f
6910: 75 6c 6c 63 6d 64 20 20 20 20 23 66 29 20 3b 3b ullcmd #f) ;;
6920: 20 28 64 65 66 69 6e 65 20 61 20 28 77 69 74 68 (define a (with
6930: 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e -output-to-strin
6940: 67 20 28 6c 61 6d 62 64 61 20 28 29 28 77 72 69 g (lambda ()(wri
6950: 74 65 20 78 29 29 29 29 0a 09 20 28 6d 74 2d 62 te x)))).. (mt-b
6960: 69 6e 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 indir-path #f)..
6970: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 (item-path (ite
6980: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
6990: 6d 64 61 74 29 29 0a 09 20 28 74 65 73 74 2d 69 mdat)).. (test-i
69a0: 64 20 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 d (cdb:remote
69b0: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 74 65 73 74 -run db:get-test
69c0: 2d 69 64 20 23 66 20 72 75 6e 2d 69 64 20 74 65 -id #f run-id te
69d0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
69e0: 68 29 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 h)).. (testinfo
69f0: 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d (cdb:get-test-
6a00: 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 info-by-id *runr
6a10: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 emote* test-id))
6a20: 0a 09 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 .. (mt_target (
6a30: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
6a40: 73 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 se (map cadr key
6a50: 76 61 6c 6c 73 74 29 20 22 2f 22 29 29 0a 09 20 vallst) "/"))..
6a60: 28 64 65 62 75 67 2d 70 61 72 61 6d 20 28 61 70 (debug-param (ap
6a70: 70 65 6e 64 20 28 69 66 20 28 61 72 67 73 3a 67 pend (if (args:g
6a80: 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 et-arg "-debug")
6a90: 20 20 28 6c 69 73 74 20 22 2d 64 65 62 75 67 22 (list "-debug"
6aa0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6ab0: 2d 64 65 62 75 67 22 29 29 20 27 28 29 29 0a 09 -debug")) '())..
6ac0: 09 09 20 20 20 20 20 20 28 69 66 20 28 61 72 67 .. (if (arg
6ad0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 s:get-arg "-logg
6ae0: 69 6e 67 22 29 28 6c 69 73 74 20 22 2d 6c 6f 67 ing")(list "-log
6af0: 67 69 6e 67 22 29 20 27 28 29 29 29 29 29 0a 20 ging") '())))).
6b00: 20 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 (if hosts (se
6b10: 74 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 t! hosts (string
6b20: 2d 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a -split hosts))).
6b30: 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d ;; set the m
6b40: 65 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 egatest to be ca
6b50: 6c 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f lled on the remo
6b60: 74 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 te host. (if
6b70: 28 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 (not remote-mega
6b80: 74 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 test)(set! remot
6b90: 65 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c e-megatest local
6ba0: 2d 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 -megatest)) ;; "
6bb0: 6d 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 megatest")).
6bc0: 28 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d (set! mt-bindir-
6bd0: 70 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 path (pathname-d
6be0: 69 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d irectory remote-
6bf0: 6d 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 megatest)). (
6c00: 69 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 if launcher (set
6c10: 21 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 ! launcher (stri
6c20: 6e 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 ng-split launche
6c30: 72 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 r))). ;; set
6c40: 75 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 up the run work
6c50: 61 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 area for this te
6c60: 73 74 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 st. (set! dis
6c70: 6b 70 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d kpath (get-best-
6c80: 64 69 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a disk *configdat*
6c90: 29 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 )). (if diskp
6ca0: 61 74 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 ath..(let ((dat
6cb0: 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 (open-run-close
6cc0: 20 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 create-work-are
6cd0: 61 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 a db run-id test
6ce0: 2d 69 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 -id test-path di
6cf0: 73 6b 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 skpath test-name
6d00: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 itemdat))).. (
6d10: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
6d20: 63 61 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 car dat)).. (se
6d30: 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d t! toptest-work-
6d40: 61 72 65 61 20 28 63 61 64 72 20 64 61 74 29 29 area (cadr dat))
6d50: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
6d60: 2d 69 6e 66 6f 20 32 20 22 55 73 69 6e 67 20 77 -info 2 "Using w
6d70: 6f 72 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d ork area " work-
6d80: 61 72 65 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 area))..(begin..
6d90: 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
6da0: 61 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 a (conc test-pat
6db0: 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 h "/tmp_run"))..
6dc0: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
6dd0: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 ory work-area #t
6de0: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
6df0: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f t 0 "WARNING: No
6e00: 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 disk work area
6e10: 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 6e 6e specified - runn
6e20: 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 74 20 ing in the test
6e30: 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 72 20 directory under
6e40: 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 tmp_run"))).
6e50: 28 73 65 74 21 20 63 6d 64 70 61 72 6d 73 20 28 (set! cmdparms (
6e60: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e base64:base64-en
6e70: 63 6f 64 65 20 0a 09 09 20 20 20 20 28 77 69 74 code ... (wit
6e80: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 h-output-to-stri
6e90: 6e 67 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 ng... (lamb
6ea0: 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 da () ;; (list '
6eb0: 68 6f 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 hosts hosts)
6ec0: 0a 09 09 09 28 77 72 69 74 65 20 28 6c 69 73 74 ....(write (list
6ed0: 20 28 6c 69 73 74 20 27 74 65 73 74 70 61 74 68 (list 'testpath
6ee0: 20 20 74 65 73 74 2d 70 61 74 68 29 0a 09 09 09 test-path)....
6ef0: 09 20 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 27 . ;; (list '
6f00: 72 75 6e 72 65 6d 6f 74 65 20 2a 72 75 6e 72 65 runremote *runre
6f10: 6d 6f 74 65 2a 29 0a 09 09 09 09 20 20 20 20 20 mote*).....
6f20: 28 6c 69 73 74 20 27 74 72 61 6e 73 70 6f 72 74 (list 'transport
6f30: 20 28 63 6f 6e 63 20 2a 74 72 61 6e 73 70 6f 72 (conc *transpor
6f40: 74 2d 74 79 70 65 2a 29 29 0a 09 09 09 09 20 20 t-type*)).....
6f50: 20 20 20 28 6c 69 73 74 20 27 73 65 72 76 65 72 (list 'server
6f60: 69 6e 66 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f inf *server-info
6f70: 2a 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 *)..... (lis
6f80: 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f t 'toppath *to
6f90: 70 70 61 74 68 2a 29 0a 09 09 09 09 20 20 20 20 ppath*).....
6fa0: 20 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 (list 'work-are
6fb0: 61 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 a work-area)....
6fc0: 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 . (list 'tes
6fd0: 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 t-name test-name
6fe0: 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 ) ..... (lis
6ff0: 74 20 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e t 'runscript run
7000: 73 63 72 69 70 74 29 20 0a 09 09 09 09 20 20 20 script) .....
7010: 20 20 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 (list 'run-id
7020: 20 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 run-id )...
7030: 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 .. (list 'te
7040: 73 74 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 st-id test-id
7050: 20 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 )..... (lis
7060: 74 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 t 'itemdat ite
7070: 6d 64 61 74 20 20 29 0a 09 09 09 09 20 20 20 20 mdat ).....
7080: 20 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 (list 'megatest
7090: 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 remote-megates
70a0: 74 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 t)..... (lis
70b0: 74 20 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 t 'ezsteps ezs
70c0: 74 65 70 73 29 20 0a 09 09 09 09 20 20 20 20 20 teps) .....
70d0: 28 6c 69 73 74 20 27 74 61 72 67 65 74 20 20 20 (list 'target
70e0: 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 mt_target).....
70f0: 20 20 20 20 20 28 6c 69 73 74 20 27 65 6e 76 2d (list 'env-
7100: 6f 76 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c ovrd (hash-tabl
7110: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 e-ref/default *c
7120: 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f onfigdat* "env-o
7130: 76 65 72 72 69 64 65 22 20 27 28 29 29 29 20 0a verride" '())) .
7140: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
7150: 73 65 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 set-vars (if pa
7160: 72 61 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 rams (hash-table
7170: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 -ref/default par
7180: 61 6d 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 ams "-setvars" #
7190: 66 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 6c f)))..... (l
71a0: 69 73 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 ist 'runname r
71b0: 75 6e 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 20 unname).....
71c0: 20 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 (list 'mt-bindi
71d0: 72 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 r-path mt-bindir
71e0: 2d 70 61 74 68 29 29 29 29 29 29 29 20 3b 3b 20 -path))))))) ;;
71f0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7200: 72 73 65 20 6b 65 79 76 61 6c 6c 73 74 20 22 20 rse keyvallst "
7210: 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 6c 65 ")))). ;; cle
7220: 61 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f an out step reco
7230: 72 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 rds from previou
7240: 73 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 s run if they ex
7250: 69 73 74 0a 20 20 20 20 3b 3b 20 28 64 65 62 75 ist. ;; (debu
7260: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 20 22 g:print-info 4 "
7270: 46 49 58 4d 45 45 45 45 45 21 21 21 21 20 54 68 FIXMEEEEE!!!! Th
7280: 69 73 20 63 61 6e 20 62 65 20 72 65 6d 6f 76 65 is can be remove
7290: 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 65 72 68 d some day, perh
72a0: 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 74 65 73 aps move all tes
72b0: 74 20 72 65 63 6f 72 64 73 20 74 6f 20 74 68 65 t records to the
72c0: 20 74 65 73 74 20 64 62 3f 22 29 0a 20 20 20 20 test db?").
72d0: 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ;; (open-run-clo
72e0: 73 65 20 64 62 3a 64 65 6c 65 74 65 2d 74 65 73 se db:delete-tes
72f0: 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 64 t-step-records d
7300: 62 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 28 b test-id). (
7310: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
7320: 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b 20 73 work-area) ;; s
7330: 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 o that log files
7340: 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 from the launch
7350: 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 process don't c
7360: 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 74 20 lutter the test
7370: 64 69 72 0a 20 20 20 20 28 74 65 73 74 73 3a 74 dir. (tests:t
7380: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
7390: 74 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 test-id "LAUNCHE
73a0: 44 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 D" "n/a" #f #f)
73b0: 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 ;; (if launch-re
73c0: 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 sults launch-res
73d0: 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a ults "FAILED")).
73e0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 (cond. (
73f0: 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f (and launcher ho
7400: 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 sts) ;; must be
7410: 75 73 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 using ssh hostna
7420: 6d 65 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 me. (set! f
7430: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c ullcmd (append l
7440: 61 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 auncher (car hos
7450: 74 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d ts)(list remote-
7460: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
7470: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
7480: 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 parms) debug-par
7490: 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 am))). ;; (s
74a0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
74b0: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 end launcher (ca
74c0: 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 r hosts)(list re
74d0: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 mote-megatest te
74e0: 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 st-sig "-execute
74f0: 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 " cmdparms)))).
7500: 20 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 20 20 (launcher.
7510: 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d (set! fullcm
7520: 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 d (append launch
7530: 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d er (list remote-
7540: 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 megatest test-si
7550: 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 g "-execute" cmd
7560: 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 parms) debug-par
7570: 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 am))). ;; (s
7580: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
7590: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 end launcher (li
75a0: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
75b0: 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
75c0: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
75d0: 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 ))). (else.
75e0: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 (if (not us
75f0: 65 73 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 eshell)(debug:pr
7600: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
7610: 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 internal launchi
7620: 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b ng will not work
7630: 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 well without \"
7640: 75 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 useshell yes\" i
7650: 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 n your [jobtools
7660: 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 ] section")).
7670: 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
7680: 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 (append (list r
7690: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
76a0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
76b0: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
76c0: 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 ug-param (list (
76d0: 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 if useshell "&"
76e0: 22 22 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 "")))))). ;;
76f0: 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c (set! fullcmd (l
7700: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
7710: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
7720: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
7730: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 (if useshell "&
7740: 22 20 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 " ""))))). (i
7750: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
7760: 22 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 "-xterm")(set! f
7770: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 ullcmd (append f
7780: 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 ullcmd (list "-x
7790: 74 65 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 term")))). (d
77a0: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 4c 61 ebug:print 1 "La
77b0: 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 unching " work-a
77c0: 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 rea). ;; set
77d0: 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 pre-launch-env-v
77e0: 61 72 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 ars before launc
77f0: 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 hing, keep the v
7800: 61 72 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 ars in prevvals
7810: 61 6e 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 and put the envi
7820: 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e onment back when
7830: 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 62 75 67 done. (debug
7840: 3a 70 72 69 6e 74 20 34 20 22 66 75 6c 6c 63 6d :print 4 "fullcm
7850: 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 d: " fullcmd).
7860: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e (let* ((common
7870: 70 72 65 76 76 61 6c 73 20 28 61 6c 69 73 74 2d prevvals (alist-
7880: 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 >env-vars....
7890: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
78a0: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
78b0: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
78c0: 64 65 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 de" '()))).. (
78d0: 74 65 73 74 70 72 65 76 76 61 6c 73 20 20 20 28 testprevvals (
78e0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a alist->env-vars.
78f0: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
7900: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
7910: 65 73 74 2d 63 6f 6e 66 20 22 70 72 65 2d 6c 61 est-conf "pre-la
7920: 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 unch-env-overrid
7930: 65 73 22 20 27 28 29 29 29 29 0a 09 20 20 20 28 es" '()))).. (
7940: 6d 69 73 63 70 72 65 76 76 61 6c 73 20 20 20 28 miscprevvals (
7950: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
7960: 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 ;; consolidate t
7970: 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 his code with th
7980: 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 e code in megate
7990: 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 st.scm for "-exe
79a0: 63 75 74 65 22 0a 09 09 09 20 20 20 20 28 61 70 cute".... (ap
79b0: 70 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 pend (list (list
79c0: 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 "MT_TEST_RUN_DI
79d0: 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 R" work-area)...
79e0: 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 ... (list "MT_T
79f0: 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e EST_NAME" test-n
7a00: 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c 69 73 ame)...... (lis
7a10: 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 t "MT_ITEM_INFO"
7a20: 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 (conc itemdat))
7a30: 20 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 ...... (list "
7a40: 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
7a50: 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c nname)...... (l
7a60: 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 ist "MT_TARGET"
7a70: 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 mt_target)...
7a80: 09 09 09 20 20 29 0a 09 09 09 09 20 20 20 20 69 ... )..... i
7a90: 74 65 6d 64 61 74 29 29 29 0a 09 20 20 20 28 6c temdat))).. (l
7aa0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 aunch-results (a
7ab0: 70 70 6c 79 20 63 6d 64 2d 72 75 6e 2d 77 69 74 pply cmd-run-wit
7ac0: 68 2d 73 74 64 65 72 72 2d 3e 6c 69 73 74 20 3b h-stderr->list ;
7ad0: 3b 20 63 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 ; cmd-run-proc-e
7ae0: 61 63 68 2d 6c 69 6e 65 0a 09 09 09 09 20 20 28 ach-line..... (
7af0: 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 if useshell.....
7b00: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 69 6e (string-in
7b10: 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d tersperse fullcm
7b20: 64 20 22 20 22 29 0a 09 09 09 09 20 20 20 20 20 d " ").....
7b30: 20 28 63 61 72 20 66 75 6c 6c 63 6d 64 29 29 0a (car fullcmd)).
7b40: 09 09 09 09 20 20 3b 3b 20 63 6f 6e 63 0a 09 09 .... ;; conc...
7b50: 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c .. (if useshell
7b60: 0a 09 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 ..... '()..
7b70: 09 09 09 20 20 20 20 20 20 28 63 64 72 20 66 75 ... (cdr fu
7b80: 6c 6c 63 6d 64 29 29 29 29 29 20 3b 3b 20 20 6c llcmd))))) ;; l
7b90: 61 75 6e 63 68 65 72 20 66 75 6c 6c 63 6d 64 29 auncher fullcmd)
7ba0: 29 29 3b 3b 20 28 61 70 70 6c 79 20 63 6d 64 2d ));; (apply cmd-
7bb0: 72 75 6e 2d 70 72 6f 63 2d 65 61 63 68 2d 6c 69 run-proc-each-li
7bc0: 6e 65 20 6c 61 75 6e 63 68 65 72 20 70 72 69 6e ne launcher prin
7bd0: 74 20 66 75 6c 6c 63 6d 64 29 29 29 20 3b 3b 20 t fullcmd))) ;;
7be0: 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 74 20 66 (cmd-run->list f
7bf0: 75 6c 6c 63 6d 64 29 29 0a 20 20 20 20 20 20 28 ullcmd)). (
7c00: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
7c10: 69 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c ile "mt_launch.l
7c20: 6f 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a og"..(lambda ().
7c30: 09 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 . (apply print
7c40: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 launch-results))
7c50: 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 ). (debug:p
7c60: 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e rint 2 "Launchin
7c70: 67 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 g completed, upd
7c80: 61 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 ating db").
7c90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
7ca0: 22 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a "Launch results:
7cb0: 20 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 " launch-result
7cc0: 73 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f s). (if (no
7cd0: 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 t launch-results
7ce0: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
7cf0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
7d00: 46 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 Failed to run "
7d10: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
7d20: 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 rse fullcmd " ")
7d30: 20 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 ", exiting now"
7d40: 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 ).. ;; (sqlit
7d50: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 e3:finalize! db)
7d60: 0a 09 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c .. ;; good ol
7d70: 65 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e e "exit" seems n
7d80: 6f 74 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 ot to work..
7d90: 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 ;; (_exit 9)..
7da0: 20 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 ;; but this ha
7db0: 63 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 ck will work! Th
7dc0: 61 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 anks go to Alan
7dd0: 50 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 Post of the Chic
7de0: 6b 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 ken email list..
7df0: 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 ;; NB// Is t
7e00: 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 his still needed
7e10: 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 ? Should be safe
7e20: 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 to go back to "
7e30: 65 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 20 exit" now?..
7e40: 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 (process-signal
7e50: 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 (current-process
7e60: 2d 69 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c -id) signal/kill
7e70: 29 0a 09 20 20 20 20 29 29 0a 20 20 20 20 20 20 ).. )).
7e80: 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
7e90: 20 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 miscprevvals).
7ea0: 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 (alist->env
7eb0: 2d 76 61 72 73 20 74 65 73 74 70 72 65 76 76 61 -vars testprevva
7ec0: 6c 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 ls). (alist
7ed0: 2d 3e 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f ->env-vars commo
7ee0: 6e 70 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 nprevvals).
7ef0: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
7f00: 29 0a 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 ). (change-dire
7f10: 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 ctory *toppath*)
7f20: 29 0a 0a )..