Artifact
dd3e168314adea722e5f94aae4db40f6db8de5de
File
launch.scm
— part of check-in
[4856f788ea]
at
2012-12-03 10:27:46
on branch trunk
— Partial implementation of new filtering. Changed launch logic on finding script to execute for test
(user:
mrwellan
size: 30582)
[more...]
0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 32 2c 20 4d 61 74 74 68 65 77 06-2012, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 es db))..(includ
0300: 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 e "common_record
0310: 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 s.scm").(include
0320: 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 "key_records.sc
0330: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 m").(include "db
0340: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a _records.scm")..
0350: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0390: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 ========.;; ezst
03a0: 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d eps.;;==========
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b ============..;;
03f0: 20 65 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f ezsteps were go
0400: 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 ing to be coded
0410: 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c as.;; stepname[,
0420: 70 72 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 predstep1,predst
0430: 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d ep2 ...] [{VAR1=
0440: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0450: 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 rd}] command to
0460: 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 execute.;; BUT
0470: 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 .;; now are.;; s
0480: 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 tepname {VAR=fir
0490: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 st,second,third
04a0: 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e ...} command ...
04b0: 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 .;; where the {V
04c0: 41 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c AR=first,second,
04d0: 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 third ...} is op
04e0: 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 tional...;; give
04f0: 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 n an exit code a
0500: 6e 64 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f nd whether or no
0510: 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 t logpro was use
0520: 64 20 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 d calculate OK/B
0530: 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 AD.;; return #t
0540: 69 66 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 if we are ok, #f
0550: 20 6f 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 otherwise.(defi
0560: 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 ne (steprun-good
0570: 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 ? logpro exitcod
0580: 65 29 0a 20 20 28 6f 72 20 28 65 71 3f 20 65 78 e). (or (eq? ex
0590: 69 74 63 6f 64 65 20 30 29 0a 20 20 20 20 20 20 itcode 0).
05a0: 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f (and logpro (eq?
05b0: 20 65 78 69 74 63 6f 64 65 20 32 29 29 29 29 0a exitcode 2)))).
05c0: 0a 3b 3b 20 69 66 20 68 61 6e 64 65 64 20 61 20 .;; if handed a
05d0: 73 74 72 69 6e 67 2c 20 70 72 6f 63 65 73 73 20 string, process
05e0: 69 74 2c 20 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f it, else look fo
05f0: 72 20 4d 54 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 r MT_CMDINFO.(de
0600: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 fine (launch:get
0610: 2d 63 6d 64 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c -cmdinfo-assoc-l
0620: 69 73 74 20 23 21 6b 65 79 20 28 65 6e 63 6f 64 ist #!key (encod
0630: 65 64 2d 63 6d 64 20 23 66 29 29 0a 20 20 28 6c ed-cmd #f)). (l
0640: 65 74 20 28 28 65 6e 63 63 6d 64 20 28 69 66 20 et ((enccmd (if
0650: 65 6e 63 6f 64 65 64 2d 63 6d 64 20 65 6e 63 6f encoded-cmd enco
0660: 64 65 64 2d 63 6d 64 20 28 67 65 74 65 6e 76 20 ded-cmd (getenv
0670: 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 "MT_CMDINFO"))))
0680: 0a 20 20 20 20 28 69 66 20 65 6e 63 63 64 6d 0a . (if enccdm.
0690: 09 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 .(read (open-inp
06a0: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
06b0: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
06c0: 65 6e 63 63 6d 64 29 29 29 0a 09 27 28 29 29 29 enccmd)))..'()))
06d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
06e0: 63 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 ch:execute encod
06f0: 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ed-cmd). (let*
0700: 28 28 63 6d 64 69 6e 66 6f 20 20 20 28 72 65 61 ((cmdinfo (rea
0710: 64 20 28 6f 70 65 6e 2d 69 6e 70 75 74 2d 73 74 d (open-input-st
0720: 72 69 6e 67 20 28 62 61 73 65 36 34 3a 62 61 73 ring (base64:bas
0730: 65 36 34 2d 64 65 63 6f 64 65 20 65 6e 63 6f 64 e64-decode encod
0740: 65 64 2d 63 6d 64 29 29 29 29 29 0a 20 20 20 20 ed-cmd))))).
0750: 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 (setenv "MT_CMDI
0760: 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 NFO" encoded-cmd
0770: 29 0a 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f ). (if (list?
0780: 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 cmdinfo) ;; ((t
0790: 65 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 estpath /tmp/mrw
07a0: 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 ellan/jazzmind/s
07b0: 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 rc/example_run/t
07c0: 65 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 ests/sqlitespeed
07d0: 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e 61 6d 65 )..;; (test-name
07e0: 20 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 72 sqlitespeed) (r
07f0: 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
0800: 70 74 2e 72 62 29 20 28 64 62 2d 68 6f 73 74 20 pt.rb) (db-host
0810: 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d localhost) (run-
0820: 69 64 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 id 1))..(let* ((
0830: 74 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 testpath (assoc
0840: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 /default 'testpa
0850: 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b th cmdinfo)) ;
0860: 3b 20 48 6f 77 20 69 73 20 74 65 73 74 70 61 74 ; How is testpat
0870: 68 20 64 69 66 66 65 72 65 6e 74 20 66 72 6f 6d h different from
0880: 20 77 6f 72 6b 2d 61 72 65 61 20 3f 3f 0a 09 20 work-area ??..
0890: 20 20 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 (top-path
08a0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
08b0: 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 'toppath cmdin
08c0: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f fo)).. (wo
08d0: 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 rk-area (assoc/d
08e0: 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 efault 'work-are
08f0: 61 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 a cmdinfo))..
0900: 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 28 (test-name (
0910: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0920: 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 6f est-name cmdinfo
0930: 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 73 )).. (runs
0940: 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 66 cript (assoc/def
0950: 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 20 ault 'runscript
0960: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
0970: 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 73 (ezsteps (as
0980: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a 73 soc/default 'ezs
0990: 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 29 teps cmdinfo))
09a0: 0a 09 20 20 20 20 20 20 20 28 64 62 2d 68 6f 73 .. (db-hos
09b0: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
09c0: 6c 74 20 27 64 62 2d 68 6f 73 74 20 20 20 63 6d lt 'db-host cm
09d0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
09e0: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
09f0: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
0a00: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
0a10: 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
0a20: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
0a30: 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
0a40: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
0a50: 61 72 67 65 74 20 20 20 20 28 61 73 73 6f 63 2f arget (assoc/
0a60: 64 65 66 61 75 6c 74 20 27 74 61 72 67 65 74 20 default 'target
0a70: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
0a80: 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 (itemdat
0a90: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0aa0: 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 itemdat cmdinf
0ab0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 65 6e 76 o)).. (env
0ac0: 2d 6f 76 72 64 20 20 28 61 73 73 6f 63 2f 64 65 -ovrd (assoc/de
0ad0: 66 61 75 6c 74 20 27 65 6e 76 2d 6f 76 72 64 20 fault 'env-ovrd
0ae0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0af0: 20 20 20 28 73 65 74 2d 76 61 72 73 20 20 28 61 (set-vars (a
0b00: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 73 65 ssoc/default 'se
0b10: 74 2d 76 61 72 73 20 20 63 6d 64 69 6e 66 6f 29 t-vars cmdinfo)
0b20: 29 20 3b 3b 20 70 72 65 2d 6f 76 65 72 72 69 64 ) ;; pre-overrid
0b30: 65 73 20 66 72 6f 6d 20 2d 73 65 74 76 61 72 0a es from -setvar.
0b40: 09 20 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 . (runname
0b50: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0b60: 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 63 6d 64 t 'runname cmd
0b70: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0b80: 6d 65 67 61 74 65 73 74 20 20 28 61 73 73 6f 63 megatest (assoc
0b90: 2f 64 65 66 61 75 6c 74 20 27 6d 65 67 61 74 65 /default 'megate
0ba0: 73 74 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 st cmdinfo))..
0bb0: 20 20 20 20 20 20 28 6d 74 2d 62 69 6e 64 69 72 (mt-bindir
0bc0: 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64 65 66 -path (assoc/def
0bd0: 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d ault 'mt-bindir-
0be0: 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29 0a 09 path cmdinfo))..
0bf0: 20 20 20 20 20 20 20 28 66 75 6c 6c 72 75 6e 73 (fullruns
0c00: 63 72 69 70 74 20 28 69 66 20 28 6e 6f 74 20 72 cript (if (not r
0c10: 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 unscript).
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c30: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 #f.
0c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c60: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
0c70: 69 6e 64 65 78 20 22 2f 22 20 72 75 6e 73 63 72 index "/" runscr
0c80: 69 70 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ipt).
0c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ca0: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
0cb0: 72 69 70 74 20 3b 3b 20 75 73 65 20 75 6e 61 64 ript ;; use unad
0cc0: 75 6c 74 65 72 65 64 20 69 66 20 63 6f 6e 74 61 ultered if conta
0cd0: 69 6e 73 20 73 6c 61 73 68 65 73 0a 20 20 20 20 ins slashes.
0ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d00: 20 20 28 6c 65 74 20 28 28 66 75 6c 6c 6e 20 28 (let ((fulln (
0d10: 63 6f 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f conc testpath "/
0d20: 22 20 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 " runscript)))..
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d50: 20 20 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 (if (and (file
0d60: 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 6e 29 0a -exists? fulln).
0d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0da0: 20 20 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 (file-execute
0db0: 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 6e 29 29 -access? fulln))
0dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
0df0: 75 6c 6c 6e 0a 20 20 20 20 20 20 20 20 20 20 20 ulln.
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 20 20 20 72 75 6e 73 63 72 69 70 74 29 29 29 29 runscript))))
0e30: 29 20 3b 3b 20 61 73 73 75 6d 65 20 69 74 20 69 ) ;; assume it i
0e40: 73 20 6f 6e 20 74 68 65 20 70 61 74 68 0a 09 20 s on the path..
0e50: 20 20 20 20 20 20 28 72 6f 6c 6c 75 70 2d 73 74 (rollup-st
0e60: 61 74 75 73 20 30 29 29 0a 09 20 20 0a 09 20 20 atus 0)).. ..
0e70: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
0e80: 45 78 65 63 74 75 69 6e 67 20 22 20 74 65 73 74 Exectuing " test
0e90: 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 74 -name " (id: " t
0ea0: 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 28 est-id ") on " (
0eb0: 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a get-host-name)).
0ec0: 09 20 20 3b 3b 20 61 70 70 6c 79 20 70 72 65 2d . ;; apply pre-
0ed0: 6f 76 65 72 72 69 64 65 73 20 62 65 66 6f 72 65 overrides before
0ee0: 20 6f 74 68 65 72 20 76 61 72 69 61 62 6c 65 73 other variables
0ef0: 2e 20 54 68 65 20 70 72 65 2d 6f 76 65 72 72 69 . The pre-overri
0f00: 64 65 20 76 61 72 73 20 6d 75 73 74 20 6e 6f 74 de vars must not
0f10: 0a 09 20 20 3b 3b 20 63 6c 6f 62 62 65 72 73 20 .. ;; clobbers
0f20: 74 68 69 6e 67 73 20 66 72 6f 6d 20 74 68 65 20 things from the
0f30: 6f 66 66 69 63 69 61 6c 20 73 6f 75 72 63 65 73 official sources
0f40: 20 73 75 63 68 20 61 73 20 6d 65 67 61 74 65 73 such as megates
0f50: 74 2e 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e t.config and run
0f60: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 09 configs.config..
0f70: 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 (if (string? s
0f80: 65 74 2d 76 61 72 73 29 0a 09 20 20 20 20 20 20 et-vars)..
0f90: 28 6c 65 74 20 28 28 76 61 72 70 61 69 72 73 20 (let ((varpairs
0fa0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 65 (string-split se
0fb0: 74 2d 76 61 72 73 20 22 2c 22 29 29 29 0a 09 09 t-vars ",")))...
0fc0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 (debug:print 4 "
0fd0: 76 61 72 70 61 69 72 73 3a 20 22 20 76 61 72 70 varpairs: " varp
0fe0: 61 69 72 73 29 0a 09 09 28 6d 61 70 20 28 6c 61 airs)...(map (la
0ff0: 6d 62 64 61 20 28 76 61 72 70 61 69 72 29 0a 09 mbda (varpair)..
1000: 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 . (let ((v
1010: 61 72 76 61 6c 20 28 73 74 72 69 6e 67 2d 73 70 arval (string-sp
1020: 6c 69 74 20 76 61 72 70 61 69 72 20 22 3d 22 29 lit varpair "=")
1030: 29 29 0a 09 09 09 20 28 69 66 20 28 65 71 3f 20 )).... (if (eq?
1040: 28 6c 65 6e 67 74 68 20 76 61 72 76 61 6c 29 20 (length varval)
1050: 32 29 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 2).... (let
1060: 28 28 76 61 72 20 28 63 61 72 20 76 61 72 76 61 ((var (car varva
1070: 6c 29 29 0a 09 09 09 09 20 20 20 28 76 61 6c 20 l))..... (val
1080: 28 63 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a (cadr varval))).
1090: 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
10a0: 3a 70 72 69 6e 74 20 31 20 22 41 64 64 69 6e 67 :print 1 "Adding
10b0: 20 70 72 65 2d 76 61 72 2f 76 61 6c 20 22 20 76 pre-var/val " v
10c0: 61 72 20 22 20 3d 20 22 20 76 61 6c 20 22 20 74 ar " = " val " t
10d0: 6f 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e o the environmen
10e0: 74 22 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 t").... (s
10f0: 65 74 65 6e 76 20 76 61 72 20 76 61 6c 29 29 29 etenv var val)))
1100: 29 29 0a 09 09 20 20 20 20 20 76 61 72 70 61 69 ))... varpai
1110: 72 73 29 29 29 0a 09 20 20 28 73 65 74 65 6e 76 rs))).. (setenv
1120: 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 "MT_TEST_RUN_DI
1130: 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 R" work-area)..
1140: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 (setenv "MT_TES
1150: 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d T_NAME" test-nam
1160: 65 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d e).. (setenv "M
1170: 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f T_ITEM_INFO" (co
1180: 6e 63 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 nc itemdat))..
1190: 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e (setenv "MT_RUNN
11a0: 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a AME" runname).
11b0: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 4d . (setenv "MT_M
11c0: 45 47 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 EGATEST" megate
11d0: 73 74 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 st).. (setenv "
11e0: 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 74 61 MT_TARGET" ta
11f0: 72 67 65 74 29 0a 09 20 20 28 69 66 20 6d 74 2d rget).. (if mt-
1200: 62 69 6e 64 69 72 2d 70 61 74 68 20 28 73 65 74 bindir-path (set
1210: 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 env "PATH" (conc
1220: 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 (getenv "PATH")
1230: 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 ":" mt-bindir-p
1240: 61 74 68 29 29 29 0a 09 20 20 28 63 68 61 6e 67 ath))).. (chang
1250: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 2d e-directory top-
1260: 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6e 6f path).. (if (no
1270: 74 20 28 73 65 74 75 70 2d 66 6f 72 2d 72 75 6e t (setup-for-run
1280: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
1290: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
12a0: 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 74 0 "Failed to set
12b0: 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a 09 up, exiting") ..
12c0: 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e .;; (sqlite3:fin
12d0: 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 3b 3b 20 alize! db)...;;
12e0: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
12f0: 65 21 20 74 64 62 29 0a 09 09 28 65 78 69 74 20 e! tdb)...(exit
1300: 31 29 29 29 0a 09 20 20 3b 3b 20 43 61 6e 20 73 1))).. ;; Can s
1310: 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 etup as client f
1320: 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e or server mode n
1330: 6f 77 0a 09 20 20 28 73 65 72 76 65 72 3a 63 6c ow.. (server:cl
1340: 69 65 6e 74 2d 73 65 74 75 70 29 0a 0a 09 20 20 ient-setup)...
1350: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
1360: 79 20 2a 74 6f 70 70 61 74 68 2a 29 20 0a 09 20 y *toppath*) ..
1370: 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 (set-megatest-e
1380: 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 29 20 nv-vars run-id)
1390: 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 62 65 20 ;; these may be
13a0: 6e 65 65 64 65 64 20 62 79 20 74 68 65 20 6c 61 needed by the la
13b0: 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 73 73 0a unching process.
13c0: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
13d0: 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 tory work-area)
13e0: 0a 0a 09 20 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 ... (open-run-c
13f0: 6c 6f 73 65 20 73 65 74 2d 72 75 6e 2d 63 6f 6e lose set-run-con
1400: 66 69 67 2d 76 61 72 73 20 23 66 20 72 75 6e 2d fig-vars #f run-
1410: 69 64 29 0a 09 20 20 3b 3b 20 65 6e 76 69 72 6f id).. ;; enviro
1420: 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 nment overrides
1430: 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 are done *before
1440: 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 * the remaining
1450: 63 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e critical envars.
1460: 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d .. (alist->env-
1470: 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 vars env-ovrd)..
1480: 20 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 2d (set-megatest-
1490: 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 29 env-vars run-id)
14a0: 0a 09 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e .. (set-item-en
14b0: 76 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a v-vars itemdat).
14c0: 09 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e . (save-environ
14d0: 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d ment-as-files "m
14e0: 65 67 61 74 65 73 74 22 29 0a 09 20 20 28 6f 70 egatest").. (op
14f0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 en-run-close tes
1500: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 t-set-meta-info
1510: 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 #f test-id run-i
1520: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
1530: 64 61 74 20 30 29 0a 09 20 20 28 74 65 73 74 73 dat 0).. (tests
1540: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
1550: 21 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 ! test-id "REMOT
1560: 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 EHOSTSTART" "n/a
1570: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
1580: 22 2d 6d 22 29 20 23 66 29 0a 09 20 20 28 69 66 "-m") #f).. (if
1590: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
15a0: 2d 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 -xterm")..
15b0: 28 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 (set! fullrunscr
15c0: 69 70 74 20 22 78 74 65 72 6d 22 29 0a 09 20 20 ipt "xterm")..
15d0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 66 75 6c (if (and ful
15e0: 6c 72 75 6e 73 63 72 69 70 74 20 28 6e 6f 74 20 lrunscript (not
15f0: 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 (file-execute-ac
1600: 63 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 cess? fullrunscr
1610: 69 70 74 29 29 29 0a 09 09 20 20 28 73 79 73 74 ipt)))... (syst
1620: 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 em (conc "chmod
1630: 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 ug+x " fullrunsc
1640: 72 69 70 74 29 29 29 29 0a 09 20 20 3b 3b 20 57 ript)))).. ;; W
1650: 65 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 61 e are about to a
1660: 63 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 ctually kick off
1670: 20 74 68 65 20 74 65 73 74 0a 09 20 20 3b 3b 20 the test.. ;;
1680: 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f so this is a goo
1690: 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 d place to remov
16a0: 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 6f e the records fo
16b0: 72 20 0a 09 20 20 3b 3b 20 61 6e 79 20 70 72 65 r .. ;; any pre
16c0: 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 3b 3b vious runs.. ;;
16d0: 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 (db:test-remove
16e0: 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 64 -steps db run-id
16f0: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 testname itemda
1700: 74 29 0a 09 20 20 0a 09 20 20 28 6c 65 74 2a 20 t).. .. (let*
1710: 28 28 6d 20 20 20 20 20 20 20 20 20 20 20 20 28 ((m (
1720: 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 make-mutex))...
1730: 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 (kill-job? #f
1740: 29 0a 09 09 20 28 65 78 69 74 2d 69 6e 66 6f 20 )... (exit-info
1750: 20 20 20 28 76 65 63 74 6f 72 20 23 74 20 23 74 (vector #t #t
1760: 20 23 74 29 29 0a 09 09 20 28 6a 6f 62 2d 74 68 #t))... (job-th
1770: 72 65 61 64 20 20 20 23 66 29 0a 09 09 20 28 72 read #f)... (r
1780: 75 6e 69 74 20 20 20 20 20 20 20 20 28 6c 61 6d unit (lam
1790: 62 64 61 20 28 29 0a 09 09 09 09 20 3b 3b 20 28 bda ()..... ;; (
17a0: 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 20 let-values.....
17b0: 3b 3b 20 20 28 28 28 70 69 64 20 65 78 69 74 2d ;; (((pid exit-
17c0: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
17d0: 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 28 72 75 )..... ;; (ru
17e0: 6e 2d 6e 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e n-n-wait fullrun
17f0: 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 28 script)))..... (
1800: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
1810: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 tatus! test-id "
1820: 52 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 20 23 RUNNING" "n/a" #
1830: 66 20 23 66 29 0a 09 09 09 09 20 3b 3b 20 69 66 f #f)..... ;; if
1840: 20 74 68 65 72 65 20 69 73 20 61 20 72 75 6e 73 there is a runs
1850: 63 72 69 70 74 20 64 6f 20 69 74 20 66 69 72 73 cript do it firs
1860: 74 0a 09 09 09 09 20 28 69 66 20 66 75 6c 6c 72 t..... (if fullr
1870: 75 6e 73 63 72 69 70 74 0a 09 09 09 09 20 20 20 unscript.....
1880: 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 (let ((pid (pr
1890: 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 ocess-run fullru
18a0: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 nscript))).....
18b0: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
18c0: 28 28 69 20 30 29 29 0a 09 09 09 09 09 20 28 6c ((i 0))...... (l
18d0: 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 20 et-values......
18e0: 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 (((pid-val exit
18f0: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
1900: 65 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 e) (process-wait
1910: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 pid #t)))......
1920: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
1930: 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 6f 72 )...... (vector
1940: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1950: 30 20 70 69 64 29 0a 09 09 09 09 09 20 20 28 76 0 pid)...... (v
1960: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
1970: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
1980: 75 73 29 0a 09 09 09 09 09 20 20 28 76 65 63 74 us)...... (vect
1990: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
19a0: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
19b0: 09 09 09 09 20 20 28 73 65 74 21 20 72 6f 6c 6c .... (set! roll
19c0: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 up-status exit-c
19d0: 6f 64 65 29 20 0a 09 09 09 09 09 20 20 28 6d 75 ode) ...... (mu
19e0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
19f0: 09 09 09 09 20 20 28 69 66 20 28 65 71 3f 20 70 .... (if (eq? p
1a00: 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 20 id-val 0)......
1a10: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
1a20: 09 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ..(thread-sleep!
1a30: 20 32 29 0a 09 09 09 09 09 09 28 6c 6f 6f 70 20 2).......(loop
1a40: 28 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 20 (+ i 1)))......
1a50: 20 20 20 20 20 29 29 29 29 29 0a 09 09 09 09 20 ))))).....
1a60: 3b 3b 20 74 68 65 6e 2c 20 69 66 20 72 75 6e 73 ;; then, if runs
1a70: 63 72 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f 72 cript ran ok (or
1a80: 20 64 69 64 20 6e 6f 74 20 67 65 74 20 63 61 6c did not get cal
1a90: 6c 65 64 29 0a 09 09 09 09 20 3b 3b 20 64 6f 20 led)..... ;; do
1aa0: 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 70 73 20 all the ezsteps
1ab0: 28 69 66 20 61 6e 79 29 0a 09 09 09 09 20 28 69 (if any)..... (i
1ac0: 66 20 65 7a 73 74 65 70 73 0a 09 09 09 09 20 20 f ezsteps.....
1ad0: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 (let* ((testc
1ae0: 6f 6e 66 69 67 20 28 72 65 61 64 2d 63 6f 6e 66 onfig (read-conf
1af0: 69 67 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 ig (conc work-ar
1b00: 65 61 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 ea "/testconfig"
1b10: 29 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d ) #f #t environ-
1b20: 70 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 patt: "pre-launc
1b30: 68 2d 65 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b h-env-vars")) ;;
1b40: 20 46 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c FIXME??? is all
1b50: 6f 77 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 ow-system ok her
1b60: 65 3f 0a 09 09 09 09 09 20 20 20 20 28 65 7a 73 e?...... (ezs
1b70: 74 65 70 73 6c 73 74 20 28 68 61 73 68 2d 74 61 tepslst (hash-ta
1b80: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1b90: 74 65 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 testconfig "ezst
1ba0: 65 70 73 22 20 27 28 29 29 29 29 0a 09 09 09 09 eps" '()))).....
1bb0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
1bc0: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e (file-exists? ".
1bd0: 65 7a 73 74 65 70 73 22 29 29 28 63 72 65 61 74 ezsteps"))(creat
1be0: 65 2d 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a e-directory ".ez
1bf0: 73 74 65 70 73 22 29 29 0a 09 09 09 09 20 20 20 steps")).....
1c00: 20 20 20 20 3b 3b 20 69 66 20 65 7a 73 74 65 70 ;; if ezstep
1c10: 73 20 77 61 73 20 64 65 66 69 6e 65 64 20 74 68 s was defined th
1c20: 65 6e 20 77 65 20 61 72 65 20 73 75 72 65 20 74 en we are sure t
1c30: 6f 20 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 o have at least
1c40: 6f 6e 65 20 73 74 65 70 20 62 75 74 20 63 68 65 one step but che
1c50: 63 6b 20 61 6e 79 77 61 79 0a 09 09 09 09 20 20 ck anyway.....
1c60: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 3e (if (not (>
1c70: 20 28 6c 65 6e 67 74 68 20 65 7a 73 74 65 70 73 (length ezsteps
1c80: 6c 73 74 29 20 30 29 29 0a 09 09 09 09 09 20 20 lst) 0))......
1c90: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1ca0: 22 45 52 52 4f 52 3a 20 65 7a 73 74 65 70 73 20 "ERROR: ezsteps
1cb0: 64 65 66 69 6e 65 64 20 62 75 74 20 65 7a 73 74 defined but ezst
1cc0: 65 70 73 6c 73 74 20 69 73 20 7a 65 72 6f 20 6c epslst is zero l
1cd0: 65 6e 67 74 68 22 29 0a 09 09 09 09 09 20 20 20 ength")......
1ce0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 (let loop ((ezst
1cf0: 65 70 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c ep (car ezstepsl
1d00: 73 74 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 st)).......
1d10: 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 65 7a (tal (cdr ez
1d20: 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 stepslst))......
1d30: 09 20 20 20 20 20 20 28 70 72 65 76 73 74 65 70 . (prevstep
1d40: 20 23 66 29 29 0a 09 09 09 09 09 20 20 20 20 20 #f))......
1d50: 3b 3b 20 63 68 65 63 6b 20 65 78 69 74 2d 69 6e ;; check exit-in
1d60: 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 fo (vector-ref e
1d70: 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 xit-info 1).....
1d80: 09 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f . (if (vecto
1d90: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
1da0: 31 29 0a 09 09 09 09 09 09 20 28 6c 65 74 2a 20 1)....... (let*
1db0: 28 28 73 74 65 70 6e 61 6d 65 20 20 28 63 61 72 ((stepname (car
1dc0: 20 65 7a 73 74 65 70 29 29 20 20 3b 3b 20 64 6f ezstep)) ;; do
1dd0: 20 73 74 75 66 66 20 74 6f 20 72 75 6e 20 74 68 stuff to run th
1de0: 65 20 73 74 65 70 0a 09 09 09 09 09 09 09 28 73 e step........(s
1df0: 74 65 70 69 6e 66 6f 20 20 28 63 61 64 72 20 65 tepinfo (cadr e
1e00: 7a 73 74 65 70 29 29 0a 09 09 09 09 09 09 09 28 zstep))........(
1e10: 73 74 65 70 70 61 72 74 73 20 28 73 74 72 69 6e stepparts (strin
1e20: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
1e30: 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c "^(\\{([^\\}]*)\
1e40: 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 24 22 29 20 \}\\s*|)(.*)$")
1e50: 73 74 65 70 69 6e 66 6f 29 29 0a 09 09 09 09 09 stepinfo))......
1e60: 09 09 28 73 74 65 70 70 61 72 6d 73 20 28 6c 69 ..(stepparms (li
1e70: 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 st-ref stepparts
1e80: 20 32 29 29 20 3b 3b 20 66 6f 72 20 66 75 74 75 2)) ;; for futu
1e90: 72 65 20 75 73 65 2c 20 7b 56 41 52 3d 31 2c 32 re use, {VAR=1,2
1ea0: 2c 33 7d 2c 20 72 75 6e 20 73 74 65 70 20 66 6f ,3}, run step fo
1eb0: 72 20 65 61 63 68 20 0a 09 09 09 09 09 09 09 28 r each ........(
1ec0: 73 74 65 70 63 6d 64 20 20 20 28 6c 69 73 74 2d stepcmd (list-
1ed0: 72 65 66 20 73 74 65 70 70 61 72 74 73 20 33 29 ref stepparts 3)
1ee0: 29 0a 09 09 09 09 09 09 09 28 73 63 72 69 70 74 )........(script
1ef0: 20 20 20 20 22 22 29 20 3b 20 22 23 21 2f 62 69 "") ; "#!/bi
1f00: 6e 2f 62 61 73 68 5c 6e 22 29 20 3b 3b 20 79 65 n/bash\n") ;; ye
1f10: 70 2c 20 77 65 20 64 65 70 65 6e 64 20 6f 6e 20 p, we depend on
1f20: 62 69 6e 2f 62 61 73 68 20 46 49 58 4d 45 21 21 bin/bash FIXME!!
1f30: 21 0a 09 09 09 09 09 09 09 28 6c 6f 67 70 72 6f !........(logpro
1f40: 2d 75 73 65 64 20 23 66 29 29 0a 09 09 09 09 09 -used #f))......
1f50: 09 20 20 20 3b 3b 20 4e 42 2f 2f 20 63 61 6e 20 . ;; NB// can
1f60: 73 61 66 65 6c 79 20 61 73 73 75 6d 65 20 77 65 safely assume we
1f70: 20 61 72 65 20 69 6e 20 74 65 73 74 2d 61 72 65 are in test-are
1f80: 61 20 64 69 72 65 63 74 6f 72 79 0a 09 09 09 09 a directory.....
1f90: 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
1fa0: 74 20 34 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 t 4 "ezsteps:\n
1fb0: 73 74 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 stepname: " step
1fc0: 6e 61 6d 65 20 22 20 73 74 65 70 69 6e 66 6f 3a name " stepinfo:
1fd0: 20 22 20 73 74 65 70 69 6e 66 6f 20 22 20 73 74 " stepinfo " st
1fe0: 65 70 70 61 72 74 73 3a 20 22 20 73 74 65 70 70 epparts: " stepp
1ff0: 61 72 74 73 0a 09 09 09 09 09 09 09 09 22 20 73 arts........." s
2000: 74 65 70 70 61 72 6d 73 3a 20 22 20 73 74 65 70 tepparms: " step
2010: 70 61 72 6d 73 20 22 20 73 74 65 70 63 6d 64 3a parms " stepcmd:
2020: 20 22 20 73 74 65 70 63 6d 64 29 0a 09 09 09 09 " stepcmd).....
2030: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 28 .. ....... (
2040: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
2050: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
2060: 22 2e 6c 6f 67 70 72 6f 22 29 29 28 73 65 74 21 ".logpro"))(set!
2070: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 74 29 logpro-used #t)
2080: 29 0a 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 3b )........ ;; ;
2090: 3b 20 66 69 72 73 74 20 73 6f 75 72 63 65 20 74 ; first source t
20a0: 68 65 20 70 72 65 76 69 6f 75 73 20 65 6e 76 69 he previous envi
20b0: 72 6f 6e 6d 65 6e 74 0a 09 09 09 09 09 09 20 20 ronment.......
20c0: 20 3b 3b 20 28 6c 65 74 20 28 28 70 72 65 76 2d ;; (let ((prev-
20d0: 65 6e 76 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 env (conc ".ezst
20e0: 65 70 73 2f 22 20 70 72 65 76 73 74 65 70 20 28 eps/" prevstep (
20f0: 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 if (string-searc
2100: 68 20 28 72 65 67 65 78 70 20 22 63 73 68 22 29 h (regexp "csh")
2110: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 ....... ;;
2120: 20 20 20 09 09 09 09 09 09 09 20 28 67 65 74 2d ....... (get-
2130: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
2140: 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 20 22 able "SHELL")) "
2150: 2e 63 73 68 22 20 22 2e 73 68 22 29 29 29 29 0a .csh" ".sh")))).
2160: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 28 69 ...... ;; (i
2170: 66 20 28 61 6e 64 20 70 72 65 76 73 74 65 70 20 f (and prevstep
2180: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 70 72 (file-exists? pr
2190: 65 76 2d 65 6e 76 29 29 0a 09 09 09 09 09 09 20 ev-env)).......
21a0: 20 20 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 ;; (set!
21b0: 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 script (conc sc
21c0: 72 69 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 ript "source " p
21d0: 72 65 76 2d 65 6e 76 29 29 29 29 0a 09 09 09 09 rev-env)))).....
21e0: 09 09 20 20 20 0a 09 09 09 09 09 09 20 20 20 3b .. ....... ;
21f0: 3b 20 63 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 ; call the comma
2200: 6e 64 20 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 nd using mt_ezst
2210: 65 70 0a 09 09 09 09 09 09 20 20 20 28 73 65 74 ep....... (set
2220: 21 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 22 ! script (conc "
2230: 6d 74 5f 65 7a 73 74 65 70 20 22 20 73 74 65 70 mt_ezstep " step
2240: 6e 61 6d 65 20 22 20 22 20 28 69 66 20 70 72 65 name " " (if pre
2250: 76 73 74 65 70 20 70 72 65 76 73 74 65 70 20 22 vstep prevstep "
2260: 2d 22 29 20 22 20 22 20 73 74 65 70 63 6d 64 29 -") " " stepcmd)
2270: 29 0a 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 )........ (deb
2280: 75 67 3a 70 72 69 6e 74 20 34 20 22 73 63 72 69 ug:print 4 "scri
2290: 70 74 3a 20 22 20 73 63 72 69 70 74 29 0a 0a 09 pt: " script)...
22a0: 09 09 09 09 09 20 20 20 28 63 64 62 3a 72 65 6d ..... (cdb:rem
22b0: 6f 74 65 2d 72 75 6e 20 64 62 3a 74 65 73 74 73 ote-run db:tests
22c0: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
22d0: 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e #f test-id stepn
22e0: 61 6d 65 20 22 73 74 61 72 74 22 20 22 2d 22 20 ame "start" "-"
22f0: 23 66 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 #f #f).......
2300: 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 0a 09 09 ;; now launch...
2310: 09 09 09 09 20 20 20 28 6c 65 74 20 28 28 70 69 .... (let ((pi
2320: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 73 d (process-run s
2330: 63 72 69 70 74 29 29 29 0a 09 09 09 09 09 09 20 cript))).......
2340: 20 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 (let process
2350: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 loop ((i 0))....
2360: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 2d 76 ... (let-v
2370: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
2380: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
2390: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
23a0: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
23b0: 09 09 09 09 09 09 09 20 20 20 28 6d 75 74 65 78 ....... (mutex
23c0: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 09 09 -lock! m).......
23d0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
23e0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
23f0: 64 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 76 d)......... (v
2400: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
2410: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
2420: 75 73 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 us)......... (
2430: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
2440: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
2450: 65 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 6d e)......... (m
2460: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
2470: 09 09 09 09 09 09 09 09 20 20 20 28 69 66 20 28 ........ (if (
2480: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
2490: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 62 ....... (b
24a0: 65 67 69 6e 0a 09 09 09 09 09 09 09 09 09 20 28 egin.......... (
24b0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 thread-sleep! 2)
24c0: 0a 09 09 09 09 09 09 09 09 09 20 28 70 72 6f 63 .......... (proc
24d0: 65 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 essloop (+ i 1))
24e0: 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 29 29 ))......... ))
24f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2520: 20 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 69 (let ((exi
2530: 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nfo (vector-ref
2540: 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 20 20 exit-info 2)).
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 28 6c 6f 67 66 6e 61 (logfna
2590: 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 (if logpro-used
25a0: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
25b0: 22 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 0a 09 ".html") "")))..
25c0: 09 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 74 ..... ;; t
25d0: 65 73 74 69 6e 67 20 69 66 20 70 72 6f 63 65 64 esting if proced
25e0: 75 72 65 73 20 63 61 6c 6c 65 64 20 69 6e 20 61 ures called in a
25f0: 20 72 65 6d 6f 74 65 20 63 61 6c 6c 20 63 61 75 remote call cau
2600: 73 65 20 70 72 6f 62 6c 65 6d 73 20 28 61 6e 73 se problems (ans
2610: 3a 20 6e 6f 20 6f 72 20 73 6f 20 49 20 73 75 73 : no or so I sus
2620: 70 65 63 74 29 0a 09 09 09 09 09 09 20 20 20 20 pect).......
2630: 20 20 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 (cdb:remote-r
2640: 75 6e 20 64 62 3a 74 65 73 74 73 74 65 70 2d 73 un db:teststep-s
2650: 65 74 2d 73 74 61 74 75 73 21 20 23 66 20 74 65 et-status! #f te
2660: 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 22 st-id stepname "
2670: 65 6e 64 22 20 65 78 69 6e 66 6f 20 23 66 20 6c end" exinfo #f l
2680: 6f 67 66 6e 61 29 29 0a 09 09 09 09 09 09 20 20 ogfna)).......
2690: 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 (if logpro-us
26a0: 65 64 0a 09 09 09 09 09 09 09 20 28 63 64 62 3a ed........ (cdb:
26b0: 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 test-set-log! *r
26c0: 75 6e 72 65 6d 6f 74 65 2a 20 20 74 65 73 74 2d unremote* test-
26d0: 69 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d id (conc stepnam
26e0: 65 20 22 2e 68 74 6d 6c 22 29 29 29 0a 09 09 09 e ".html")))....
26f0: 09 09 09 20 20 20 20 20 3b 3b 20 73 65 74 20 74 ... ;; set t
2700: 68 65 20 74 65 73 74 20 66 69 6e 61 6c 20 73 74 he test final st
2710: 61 74 75 73 0a 09 09 09 09 09 09 20 20 20 20 20 atus.......
2720: 28 6c 65 74 2a 20 28 28 74 68 69 73 2d 73 74 65 (let* ((this-ste
2730: 70 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 p-status (cond..
2740: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2750: 28 61 6e 64 20 28 65 71 3f 20 28 76 65 63 74 6f (and (eq? (vecto
2760: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2770: 32 29 20 32 29 20 6c 6f 67 70 72 6f 2d 75 73 65 2) 2) logpro-use
2780: 64 29 20 27 77 61 72 6e 29 0a 09 09 09 09 09 09 d) 'warn).......
2790: 09 09 09 20 20 20 20 20 20 20 28 28 65 71 3f 20 ... ((eq?
27a0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
27b0: 2d 69 6e 66 6f 20 32 29 20 30 29 20 20 20 20 20 -info 2) 0)
27c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 70 'p
27d0: 61 73 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 ass)..........
27e0: 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c (else 'fail
27f0: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
2800: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 overall-status
2810: 20 28 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 (cond..........
2820: 20 20 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c ((eq? rol
2830: 6c 75 70 2d 73 74 61 74 75 73 20 32 29 20 27 77 lup-status 2) 'w
2840: 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 20 arn)..........
2850: 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 ((eq? rollu
2860: 70 2d 73 74 61 74 75 73 20 30 29 20 27 70 61 73 p-status 0) 'pas
2870: 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 s)..........
2880: 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 (else 'fail))
2890: 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e 65 )........ (ne
28a0: 78 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 28 xt-status (
28b0: 63 6f 6e 64 20 0a 09 09 09 09 09 09 09 09 09 20 cond ..........
28c0: 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 ((eq? over
28d0: 61 6c 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 all-status 'pass
28e0: 29 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ) this-step-stat
28f0: 75 73 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 us)..........
2900: 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c ((eq? overal
2910: 6c 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 0a l-status 'warn).
2920: 09 09 09 09 09 09 09 09 09 09 28 69 66 20 28 65 ..........(if (e
2930: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
2940: 74 75 73 20 27 66 61 69 6c 29 20 27 66 61 69 6c tus 'fail) 'fail
2950: 20 27 77 61 72 6e 29 29 0a 09 09 09 09 09 09 09 'warn))........
2960: 09 09 20 20 20 20 20 20 20 28 65 6c 73 65 20 27 .. (else '
2970: 66 61 69 6c 29 29 29 29 0a 09 09 09 09 09 09 20 fail)))).......
2980: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2990: 6e 74 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 nt 4 "Exit value
29a0: 20 72 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 received: " (ve
29b0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
29c0: 66 6f 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 fo 2) " logpro-u
29d0: 73 65 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 sed: " logpro-us
29e0: 65 64 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 ed .........
29f0: 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 " this-step-stat
2a00: 75 73 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d us: " this-step-
2a10: 73 74 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c status " overall
2a20: 2d 73 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 -status: " overa
2a30: 6c 6c 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 ll-status ......
2a40: 09 09 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 ... " next-st
2a50: 61 74 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 atus: " next-sta
2a60: 74 75 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 tus " rollup-sta
2a70: 74 75 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 tus: " rollup-st
2a80: 61 74 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 atus).......
2a90: 20 20 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 (case next-st
2aa0: 61 74 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 atus........ ((w
2ab0: 61 72 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 arn)........ (s
2ac0: 65 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 et! rollup-statu
2ad0: 73 20 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b s 2)........ ;;
2ae0: 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 NB// test-set-s
2af0: 74 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 tatus! does rdb
2b00: 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 calls under the
2b10: 68 6f 6f 64 0a 09 09 09 09 09 09 09 20 20 28 74 hood........ (t
2b20: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
2b30: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
2b40: 55 4e 4e 49 4e 47 22 20 22 57 41 52 4e 22 20 0a UNNING" "WARN" .
2b50: 09 09 09 09 09 09 09 09 09 20 20 28 69 66 20 28 ......... (if (
2b60: 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 eq? this-step-st
2b70: 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 atus 'warn) "Log
2b80: 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e pro warning foun
2b90: 64 22 20 23 66 29 0a 09 09 09 09 09 09 09 09 09 d" #f)..........
2ba0: 20 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 #f))........ (
2bb0: 28 70 61 73 73 29 0a 09 09 09 09 09 09 09 20 20 (pass)........
2bc0: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
2bd0: 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 status! test-id
2be0: 22 52 55 4e 4e 49 4e 47 22 20 22 50 41 53 53 22 "RUNNING" "PASS"
2bf0: 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 #f #f))........
2c00: 20 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c 0a (else ;; 'fail.
2c10: 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 72 ....... (set! r
2c20: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 ollup-status 1)
2c30: 3b 3b 20 66 6f 72 63 65 20 66 61 69 6c 0a 09 09 ;; force fail...
2c40: 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 ..... (tests:te
2c50: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
2c60: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
2c70: 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 22 46 "FAIL" (conc "F
2c80: 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 22 20 ailed at step "
2c90: 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a 09 09 stepname) #f)...
2ca0: 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 09 09 ..... )))).....
2cb0: 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 .. (if (and (s
2cc0: 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 teprun-good? log
2cd0: 70 72 6f 2d 75 73 65 64 20 28 76 65 63 74 6f 72 pro-used (vector
2ce0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
2cf0: 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 6e ))........ (n
2d00: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 ot (null? tal)))
2d10: 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 6c ....... (l
2d20: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 28 63 oop (car tal) (c
2d30: 64 72 20 74 61 6c 29 20 73 74 65 70 6e 61 6d 65 dr tal) stepname
2d40: 29 29 29 0a 09 09 09 09 09 09 20 28 64 65 62 75 )))....... (debu
2d50: 67 3a 70 72 69 6e 74 20 34 20 22 57 41 52 4e 49 g:print 4 "WARNI
2d60: 4e 47 3a 20 61 20 70 72 69 6f 72 20 73 74 65 70 NG: a prior step
2d70: 20 66 61 69 6c 65 64 2c 20 73 74 6f 70 70 69 6e failed, stoppin
2d80: 67 20 61 74 20 22 20 65 7a 73 74 65 70 29 29 29 g at " ezstep)))
2d90: 29 29 29 29 29 0a 09 09 20 28 6d 6f 6e 69 74 6f )))))... (monito
2da0: 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 28 rjob (lambda (
2db0: 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 73 )..... (let* ((s
2dc0: 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 tart-seconds (cu
2dd0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a rrent-seconds)).
2de0: 09 09 09 09 09 28 63 61 6c 63 2d 6d 69 6e 75 74 .....(calc-minut
2df0: 65 73 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 es (lambda ()..
2e00: 09 09 09 09 09 09 20 28 69 6e 65 78 61 63 74 2d ...... (inexact-
2e10: 3e 65 78 61 63 74 20 0a 09 09 09 09 09 09 09 20 >exact ........
2e20: 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 09 09 09 (round ........
2e30: 20 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 20 (- ........
2e40: 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e (current-secon
2e50: 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 20 ds) ........
2e60: 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 start-seconds)))
2e70: 29 29 0a 09 09 09 09 09 28 6b 69 6c 6c 2d 74 72 ))......(kill-tr
2e80: 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 20 28 ies 0))..... (
2e90: 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 let loop ((minut
2ea0: 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 es (calc-minut
2eb0: 65 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 es)))..... (
2ec0: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 begin.....
2ed0: 20 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f (set! kill-job?
2ee0: 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d (test-get-kill-
2ef0: 72 65 71 75 65 73 74 20 74 65 73 74 2d 69 64 29 request test-id)
2f00: 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 74 ) ;; run-id test
2f10: 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 0a -name itemdat)).
2f20: 09 09 09 09 20 20 20 20 20 20 20 28 6f 70 65 6e .... (open
2f30: 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 2d -run-close test-
2f40: 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 set-meta-info #f
2f50: 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 test-id run-id
2f60: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
2f70: 74 20 6d 69 6e 75 74 65 73 29 0a 09 09 09 09 20 t minutes).....
2f80: 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a (if kill-j
2f90: 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 ob? ...... (be
2fa0: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d gin...... (m
2fb0: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
2fc0: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
2fd0: 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 pid (vector-ref
2fe0: 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a 09 exit-info 0)))..
2ff0: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
3000: 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 09 number? pid)....
3010: 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 ... (begin....
3020: 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ... (debug:p
3030: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
3040: 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 65 Request receive
3050: 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 61 d to kill job (a
3060: 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d ttempt # " kill-
3070: 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 09 tries ")")......
3080: 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 6f . (let ((pro
3090: 63 65 73 73 65 73 20 28 63 6d 64 2d 72 75 6e 2d cesses (cmd-run-
30a0: 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 70 67 72 >list (conc "pgr
30b0: 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 64 29 29 ep -l -P " pid))
30c0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
30d0: 28 66 6f 72 2d 65 61 63 68 20 0a 09 09 09 09 09 (for-each ......
30e0: 09 09 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 ..(lambda (p)...
30f0: 09 09 09 09 09 20 20 28 6c 65 74 2a 20 28 28 70 ..... (let* ((p
3100: 61 72 74 73 20 20 28 73 74 72 69 6e 67 2d 73 70 arts (string-sp
3110: 6c 69 74 20 70 29 29 0a 09 09 09 09 09 09 09 09 lit p)).........
3120: 20 28 70 2d 69 64 20 20 20 28 69 66 20 28 3e 20 (p-id (if (>
3130: 28 6c 65 6e 67 74 68 20 70 61 72 74 73 29 20 30 (length parts) 0
3140: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
3150: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
3160: 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 (car parts))....
3170: 09 09 09 09 09 09 20 20 20 20 20 23 66 29 29 29 ...... #f)))
3180: 0a 09 09 09 09 09 09 09 20 20 20 20 28 69 66 20 ........ (if
3190: 70 2d 69 64 0a 09 09 09 09 09 09 09 09 28 62 65 p-id.........(be
31a0: 67 69 6e 0a 09 09 09 09 09 09 09 09 20 20 28 64 gin......... (d
31b0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 4b 69 ebug:print 0 "Ki
31c0: 6c 6c 69 6e 67 20 22 20 28 63 61 64 72 20 70 61 lling " (cadr pa
31d0: 72 74 73 29 20 22 3b 20 6b 69 6c 6c 20 2d 39 20 rts) "; kill -9
31e0: 20 22 20 70 2d 69 64 29 0a 09 09 09 09 09 09 09 " p-id)........
31f0: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
3200: 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 "kill -9 " p-id
3210: 29 29 29 29 29 29 0a 09 09 09 09 09 09 09 28 63 ))))))........(c
3220: 61 72 20 70 72 6f 63 65 73 73 65 73 29 29 0a 09 ar processes))..
3230: 09 09 09 09 09 20 20 20 20 20 20 20 28 73 79 73 ..... (sys
3240: 74 65 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 tem (conc "kill
3250: 2d 39 20 2d 22 20 70 69 64 29 29 29 29 0a 09 09 -9 -" pid))))...
3260: 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 .... (begin...
3270: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
3280: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
3290: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
32a0: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 ed to kill job b
32b0: 75 74 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 ut problem with
32c0: 70 72 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 74 process, attempt
32d0: 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 ing to kill mana
32e0: 67 65 72 20 70 72 6f 63 65 73 73 22 29 0a 09 09 ger process")...
32f0: 09 09 09 09 20 20 20 20 20 28 74 65 73 74 73 3a .... (tests:
3300: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
3310: 20 74 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 test-id "KILLED
3320: 22 20 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 " "FAIL".......
3330: 09 09 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 .. (args:get
3340: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
3350: 09 09 09 09 09 20 20 20 20 20 28 73 71 6c 69 74 ..... (sqlit
3360: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
3370: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 78 )....... (ex
3380: 69 74 20 31 29 29 29 29 0a 09 09 09 09 09 20 20 it 1))))......
3390: 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d 74 72 (set! kill-tr
33a0: 69 65 73 20 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 ies (+ 1 kill-tr
33b0: 69 65 73 29 29 0a 09 09 09 09 09 20 20 20 20 20 ies))......
33c0: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
33d0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b )))..... ;
33e0: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
33f0: 69 7a 65 21 20 64 62 29 0a 09 09 09 09 20 20 20 ize! db).....
3400: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
3410: 70 21 20 28 2b 20 31 30 20 28 72 61 6e 64 6f 6d p! (+ 10 (random
3420: 20 31 30 29 29 29 20 3b 3b 20 61 64 64 20 73 6f 10))) ;; add so
3430: 6d 65 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 me jitter to the
3440: 20 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 call home time
3450: 74 6f 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 to spread out th
3460: 65 20 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 e db accesses...
3470: 09 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 .. (loop (
3480: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 calc-minutes))))
3490: 29 29 29 0a 09 09 20 28 74 68 31 20 20 20 20 20 )))... (th1
34a0: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
34b0: 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 29 29 0a 09 d monitorjob))..
34c0: 09 20 28 74 68 32 20 20 20 20 20 20 20 20 20 20 . (th2
34d0: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 75 6e (make-thread run
34e0: 69 74 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 it))).. (set!
34f0: 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 job-thread th2)
3500: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
3510: 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 28 art! th1).. (
3520: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
3530: 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 2).. (thread-
3540: 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 20 20 join! th2)..
3550: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
3560: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 . (let* ((ite
3570: 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 m-path (item-lis
3580: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
3590: 29 0a 09 09 20 20 20 28 74 65 73 74 69 6e 66 6f )... (testinfo
35a0: 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 2d (cdb:get-test-
35b0: 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e 72 info-by-id *runr
35c0: 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 29 emote* test-id))
35d0: 29 20 3b 3b 20 29 29 20 3b 3b 20 72 75 6e 2d 69 ) ;; )) ;; run-i
35e0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
35f0: 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 20 -path)))..
3600: 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 65 ;; Am I complete
3610: 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e d?.. (if (n
3620: 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 ot (equal? (db:t
3630: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
3640: 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c 45 54 stinfo) "COMPLET
3650: 45 44 22 29 29 0a 09 09 20 20 28 62 65 67 69 6e ED"))... (begin
3660: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
3670: 69 6e 74 20 32 20 22 54 65 73 74 20 4e 4f 54 20 int 2 "Test NOT
3680: 6c 6f 67 67 65 64 20 61 73 20 43 4f 4d 50 4c 45 logged as COMPLE
3690: 54 45 44 2c 20 28 73 74 61 74 65 3d 22 20 28 64 TED, (state=" (d
36a0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
36b0: 20 74 65 73 74 69 6e 66 6f 29 20 22 29 2c 20 75 testinfo) "), u
36c0: 70 64 61 74 69 6e 67 20 72 65 73 75 6c 74 2c 20 pdating result,
36d0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 69 73 rollup-status is
36e0: 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 " rollup-status
36f0: 29 0a 09 09 20 20 20 20 28 74 65 73 74 73 3a 74 )... (tests:t
3700: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
3710: 74 65 73 74 2d 69 64 20 0a 09 09 09 09 20 20 20 test-id .....
3720: 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 (if kill-job? "
3730: 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 KILLED" "COMPLET
3740: 45 44 22 29 0a 09 09 09 09 20 20 20 20 28 63 6f ED")..... (co
3750: 6e 64 0a 09 09 09 09 20 20 20 20 20 28 28 6e 6f nd..... ((no
3760: 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 t (vector-ref ex
3770: 69 74 2d 69 6e 66 6f 20 31 29 29 20 22 46 41 49 it-info 1)) "FAI
3780: 4c 22 29 20 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 L") ;; job faile
3790: 64 20 74 6f 20 72 75 6e 0a 09 09 09 09 20 20 20 d to run.....
37a0: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
37b0: 74 61 74 75 73 20 30 29 0a 09 09 09 09 20 20 20 tatus 0).....
37c0: 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 ;; if the cur
37d0: 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 rent status is A
37e0: 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 6f UTO the defer to
37f0: 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 20 the calculated
3800: 76 61 6c 75 65 20 28 69 2e 65 2e 20 6c 65 61 76 value (i.e. leav
3810: 65 20 74 68 69 73 20 41 55 54 4f 29 0a 09 09 09 e this AUTO)....
3820: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
3830: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
3840: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 status testinfo)
3850: 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 22 20 "AUTO") "AUTO"
3860: 22 50 41 53 53 22 29 29 0a 09 09 09 09 20 20 20 "PASS")).....
3870: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
3880: 74 61 74 75 73 20 31 29 20 22 46 41 49 4c 22 29 tatus 1) "FAIL")
3890: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
38a0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 32 29 rollup-status 2)
38b0: 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 66 ..... ;; if
38c0: 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 61 the current sta
38d0: 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 20 tus is AUTO the
38e0: 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c defer to the cal
38f0: 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 62 75 culated value bu
3900: 74 20 71 75 61 6c 69 66 79 20 28 69 2e 65 2e 20 t qualify (i.e.
3910: 6d 61 6b 65 20 74 68 69 73 20 41 55 54 4f 2d 57 make this AUTO-W
3920: 41 52 4e 29 0a 09 09 09 09 20 20 20 20 20 20 28 ARN)..... (
3930: 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 if (equal? (db:t
3940: 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 est-get-status t
3950: 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 estinfo) "AUTO")
3960: 20 22 41 55 54 4f 2d 57 41 52 4e 22 20 22 57 41 "AUTO-WARN" "WA
3970: 52 4e 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 RN"))..... (
3980: 65 6c 73 65 20 22 46 41 49 4c 22 29 29 0a 09 09 else "FAIL"))...
3990: 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d .. (args:get-
39a0: 61 72 67 20 22 2d 6d 22 29 20 23 66 29 29 29 0a arg "-m") #f))).
39b0: 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 . ;; for au
39c0: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
39d0: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
39e0: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
39f0: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
3a00: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
3a10: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
3a20: 74 68 20 22 22 29 29 0a 09 09 20 20 28 6f 70 65 th ""))... (ope
3a30: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 74 65 73 74 n-run-close test
3a40: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 6d s:summarize-item
3a50: 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 s #f run-id test
3a60: 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 64 6f -name #f)) ;; do
3a70: 6e 27 74 20 66 6f 72 63 65 20 2d 20 6a 75 73 74 n't force - just
3a80: 20 75 70 64 61 74 65 20 69 66 20 6e 6f 0a 09 20 update if no..
3a90: 20 20 20 20 20 29 0a 09 20 20 20 20 28 6d 75 74 ).. (mut
3aa0: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
3ab0: 20 20 20 3b 3b 20 28 65 78 65 63 2d 72 65 73 75 ;; (exec-resu
3ac0: 6c 74 73 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 lts (cmd-run->li
3ad0: 73 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 st fullrunscript
3ae0: 29 29 20 3b 3b 20 20 28 6c 69 73 74 20 22 3e 22 )) ;; (list ">"
3af0: 20 28 63 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 (conc test-name
3b00: 20 22 2d 72 75 6e 2e 6c 6f 67 22 29 29 29 29 0a "-run.log")))).
3b10: 09 20 20 20 20 3b 3b 20 28 73 75 63 63 65 73 73 . ;; (success
3b20: 20 20 20 20 20 20 65 78 65 63 2d 72 65 73 75 6c exec-resul
3b30: 74 73 29 29 20 3b 3b 20 28 65 71 3f 20 28 63 61 ts)) ;; (eq? (ca
3b40: 64 72 20 65 78 65 63 2d 72 65 73 75 6c 74 73 29 dr exec-results)
3b50: 20 30 29 29 29 0a 09 20 20 20 20 28 64 65 62 75 0))).. (debu
3b60: 67 3a 70 72 69 6e 74 20 32 20 22 4f 75 74 70 75 g:print 2 "Outpu
3b70: 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 t from running "
3b80: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 fullrunscript "
3b90: 2c 20 70 69 64 20 22 20 28 76 65 63 74 6f 72 2d , pid " (vector-
3ba0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3bb0: 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 20 " in work area
3bc0: 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 61 " .... work-area
3bd0: 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 ":\n====\n exit
3be0: 20 63 6f 64 65 20 22 20 28 76 65 63 74 6f 72 2d code " (vector-
3bf0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
3c00: 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a "\n" "====\n").
3c10: 09 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 . ;; (sqlite3
3c20: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
3c30: 20 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a ;; (sqlite3:
3c40: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
3c50: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 76 65 (if (not (ve
3c60: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3c70: 66 6f 20 31 29 29 0a 09 09 28 65 78 69 74 20 34 fo 1))...(exit 4
3c80: 29 29 29 29 29 29 29 0a 0a 3b 3b 20 73 65 74 20 )))))))..;; set
3c90: 75 70 20 74 68 65 20 76 65 72 79 20 62 61 73 69 up the very basi
3ca0: 63 73 20 6e 65 65 64 65 64 20 66 6f 72 20 64 6f cs needed for do
3cb0: 69 6e 67 20 61 6e 79 74 68 69 6e 67 20 68 65 72 ing anything her
3cc0: 65 2e 0a 28 64 65 66 69 6e 65 20 28 73 65 74 75 e..(define (setu
3cd0: 70 2d 66 6f 72 2d 72 75 6e 29 0a 20 20 3b 3b 20 p-for-run). ;;
3ce0: 77 6f 75 6c 64 20 73 65 74 20 76 61 6c 75 65 73 would set values
3cf0: 20 66 6f 72 20 4b 45 59 53 20 69 6e 20 74 68 65 for KEYS in the
3d00: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 65 72 environment her
3d10: 65 20 66 6f 72 20 62 65 74 74 65 72 20 73 75 70 e for better sup
3d20: 70 6f 72 74 20 6f 66 20 65 6e 76 2d 6f 76 65 72 port of env-over
3d30: 72 69 64 65 20 62 75 74 20 0a 20 20 3b 3b 20 68 ride but . ;; h
3d40: 61 76 65 20 63 68 69 63 6b 65 6e 2f 65 67 67 20 ave chicken/egg
3d50: 73 63 65 6e 61 72 69 6f 2e 20 6e 65 65 64 20 74 scenario. need t
3d60: 6f 20 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e o read megatest.
3d70: 63 6f 6e 66 69 67 20 74 68 65 6e 20 72 65 61 64 config then read
3d80: 20 69 74 20 61 67 61 69 6e 2e 20 47 6f 69 6e 67 it again. Going
3d90: 20 74 6f 20 0a 20 20 3b 3b 20 70 61 73 73 20 6f to . ;; pass o
3da0: 6e 20 74 68 61 74 20 69 64 65 61 20 66 6f 72 20 n that idea for
3db0: 6e 6f 77 0a 20 20 3b 3b 20 73 70 65 63 69 61 6c now. ;; special
3dc0: 20 63 61 73 65 0a 20 20 28 73 65 74 21 20 2a 63 case. (set! *c
3dd0: 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 6e 64 onfiginfo* (find
3de0: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
3df0: 20 0a 09 09 20 20 20 20 20 20 28 69 66 20 28 61 ... (if (a
3e00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
3e10: 6e 66 69 67 22 29 28 61 72 67 73 3a 67 65 74 2d nfig")(args:get-
3e20: 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 arg "-config") "
3e30: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
3e40: 29 0a 09 09 20 20 20 20 20 20 65 6e 76 69 72 6f )... enviro
3e50: 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 n-patt: "env-ove
3e60: 72 72 69 64 65 22 0a 09 09 20 20 20 20 20 20 67 rride"... g
3e70: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 iven-toppath: (g
3e80: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
3e90: 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f ariable "MT_RUN_
3ea0: 41 52 45 41 5f 48 4f 4d 45 22 29 0a 09 09 20 20 AREA_HOME")...
3eb0: 20 20 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 pathenvvar:
3ec0: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
3ed0: 45 22 29 29 0a 20 20 28 73 65 74 21 20 2a 63 6f E")). (set! *co
3ee0: 6e 66 69 67 64 61 74 2a 20 20 28 69 66 20 28 63 nfigdat* (if (c
3ef0: 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 ar *configinfo*)
3f00: 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f (car *configinfo
3f10: 2a 29 20 23 66 29 29 0a 20 20 28 73 65 74 21 20 *) #f)). (set!
3f20: 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 28 69 66 *toppath* (if
3f30: 20 28 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 (car *configinf
3f40: 6f 2a 29 28 63 61 64 72 20 2a 63 6f 6e 66 69 67 o*)(cadr *config
3f50: 69 6e 66 6f 2a 29 20 23 66 29 29 0a 20 20 28 69 info*) #f)). (i
3f60: 66 20 2a 74 6f 70 70 61 74 68 2a 0a 20 20 20 20 f *toppath*.
3f70: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 (setenv "MT_RU
3f80: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f N_AREA_HOME" *to
3f90: 70 70 61 74 68 2a 29 20 3b 3b 20 74 6f 20 62 65 ppath*) ;; to be
3fa0: 20 64 65 70 72 65 63 61 74 65 64 0a 20 20 20 20 deprecated.
3fb0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3fc0: 20 22 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 "ERROR: failed
3fd0: 74 6f 20 66 69 6e 64 20 74 68 65 20 74 6f 70 20 to find the top
3fe0: 70 61 74 68 20 74 6f 20 79 6f 75 72 20 72 75 6e path to your run
3ff0: 20 73 65 74 75 70 2e 22 29 29 0a 20 20 2a 74 6f setup.")). *to
4000: 70 70 61 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 ppath*)..(define
4010: 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 (get-best-disk
4020: 63 6f 6e 66 64 61 74 29 0a 20 20 28 6c 65 74 2a confdat). (let*
4030: 20 28 28 64 69 73 6b 73 20 20 20 20 28 68 61 73 ((disks (has
4040: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
4050: 75 6c 74 20 63 6f 6e 66 64 61 74 20 22 64 69 73 ult confdat "dis
4060: 6b 73 22 20 23 66 29 29 0a 09 20 28 62 65 73 74 ks" #f)).. (best
4070: 20 20 20 20 20 23 66 29 0a 09 20 28 62 65 73 74 #f).. (best
4080: 73 69 7a 65 20 30 29 29 0a 20 20 20 20 28 69 66 size 0)). (if
4090: 20 64 69 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 disks ..(for-ea
40a0: 63 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 ch .. (lambda (d
40b0: 69 73 6b 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 isk-num).. (le
40c0: 74 2a 20 28 28 64 69 72 70 61 74 68 20 20 20 20 t* ((dirpath
40d0: 28 63 61 64 72 20 28 61 73 73 6f 63 20 64 69 73 (cadr (assoc dis
40e0: 6b 2d 6e 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 k-num disks)))..
40f0: 09 20 20 28 66 72 65 65 73 70 63 20 20 20 20 28 . (freespc (
4100: 69 66 20 28 61 6e 64 20 28 64 69 72 65 63 74 6f if (and (directo
4110: 72 79 3f 20 64 69 72 70 61 74 68 29 0a 09 09 09 ry? dirpath)....
4120: 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 . (file-wr
4130: 69 74 65 2d 61 63 63 65 73 73 3f 20 64 69 72 70 ite-access? dirp
4140: 61 74 68 29 29 0a 09 09 09 09 20 20 28 67 65 74 ath))..... (get
4150: 2d 64 66 20 64 69 72 70 61 74 68 29 0a 09 09 09 -df dirpath)....
4160: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 . (begin.....
4170: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4180: 20 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 "WARNING: path
4190: 22 20 64 69 72 70 61 74 68 20 22 20 69 6e 20 5b " dirpath " in [
41a0: 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e disks] section n
41b0: 6f 74 20 76 61 6c 69 64 20 6f 72 20 77 72 69 74 ot valid or writ
41c0: 61 62 6c 65 22 29 0a 09 09 09 09 20 20 20 20 30 able")..... 0
41d0: 29 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 )))).. (if (
41e0: 3e 20 66 72 65 65 73 70 63 20 62 65 73 74 73 69 > freespc bestsi
41f0: 7a 65 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 ze)... (begin...
4200: 20 20 20 28 73 65 74 21 20 62 65 73 74 20 20 20 (set! best
4210: 20 20 64 69 72 70 61 74 68 29 0a 09 09 20 20 20 dirpath)...
4220: 28 73 65 74 21 20 62 65 73 74 73 69 7a 65 20 66 (set! bestsize f
4230: 72 65 65 73 70 63 29 29 29 29 29 0a 09 20 28 6d reespc))))).. (m
4240: 61 70 20 63 61 72 20 64 69 73 6b 73 29 29 29 0a ap car disks))).
4250: 20 20 20 20 28 69 66 20 62 65 73 74 0a 09 62 65 (if best..be
4260: 73 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 st..(begin.. (d
4270: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
4280: 52 4f 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 ROR: No valid di
4290: 73 6b 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 sks found in meg
42a0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c atest.config. Pl
42b0: 65 61 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f ease add some to
42c0: 20 79 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 your [disks] se
42d0: 63 74 69 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 ction").. (exit
42e0: 20 31 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 1)))))..;; Desi
42f0: 72 65 64 20 64 69 72 65 63 74 6f 72 79 20 73 74 red directory st
4300: 72 75 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 ructure:.;;.;;
4310: 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 <linkdir> - <tar
4320: 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 get> - <testname
4330: 3e 20 2d 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 > -..;;
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4350: 20 20 20 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b |.;;
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4380: 20 20 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 v.;; <rund
4390: 69 72 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 3e ir> - <target>
43a0: 20 20 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 - <testname
43b0: 3e 20 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 > -|- <itempath(
43c0: 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 s)>.;;.;; dir s
43d0: 74 6f 72 65 64 20 69 6e 20 74 65 73 74 20 69 73 tored in test is
43e0: 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 :.;; .;; <linkd
43f0: 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d ir> - <target> -
4400: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
4410: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 <itempath> ].;;
4420: 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 .;; All log file
4430: 20 6c 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 links should be
4440: 20 73 74 6f 72 65 64 20 72 65 6c 61 74 69 76 65 stored relative
4450: 20 74 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 6c to the top of l
4460: 69 6e 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b ink path.;; .;;
4470: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
4480: 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d tname> [ - <item
4490: 70 61 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 path> ] .;;.(def
44a0: 69 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b ine (create-work
44b0: 2d 61 72 65 61 20 64 62 20 72 75 6e 2d 69 64 20 -area db run-id
44c0: 74 65 73 74 2d 69 64 20 74 65 73 74 2d 73 72 63 test-id test-src
44d0: 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 74 68 20 -path disk-path
44e0: 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 testname itemdat
44f0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 2d ). (let* ((run-
4500: 69 6e 66 6f 20 28 63 64 62 3a 72 65 6d 6f 74 65 info (cdb:remote
4510: 2d 72 75 6e 20 64 62 3a 67 65 74 2d 72 75 6e 2d -run db:get-run-
4520: 69 6e 66 6f 20 23 66 20 72 75 6e 2d 69 64 29 29 info #f run-id))
4530: 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 .. (item-path (i
4540: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
4550: 74 65 6d 64 61 74 29 29 0a 09 20 28 72 75 6e 6e temdat)).. (runn
4560: 61 6d 65 20 20 28 64 62 3a 67 65 74 2d 76 61 6c ame (db:get-val
4570: 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 62 ue-by-header (db
4580: 3a 67 65 74 2d 72 6f 77 20 72 75 6e 2d 69 6e 66 :get-row run-inf
4590: 6f 29 0a 09 09 09 09 09 20 20 20 28 64 62 3a 67 o)...... (db:g
45a0: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 6e et-header run-in
45b0: 66 6f 29 0a 09 09 09 09 09 20 20 20 22 72 75 6e fo)...... "run
45c0: 6e 61 6d 65 22 29 29 0a 09 20 3b 3b 20 63 6f 6e name")).. ;; con
45d0: 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 62 3a vert back to db:
45e0: 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 69 from rdb: - thi
45f0: 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 6e 20 s is always run
4600: 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a 09 20 at server end..
4610: 28 6b 65 79 2d 76 61 6c 73 20 28 63 64 62 3a 72 (key-vals (cdb:r
4620: 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 65 74 emote-run db:get
4630: 2d 6b 65 79 2d 76 61 6c 73 20 23 66 20 72 75 6e -key-vals #f run
4640: 2d 69 64 29 29 0a 09 20 28 74 61 72 67 65 74 20 -id)).. (target
4650: 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 (string-inters
4660: 70 65 72 73 65 20 6b 65 79 2d 76 61 6c 73 20 22 perse key-vals "
4670: 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 2d 69 74 65 /"))... (not-ite
4680: 72 61 74 65 64 20 20 28 65 71 75 61 6c 3f 20 22 rated (equal? "
4690: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 " item-path))...
46a0: 20 3b 3b 20 61 6c 6c 20 74 65 73 74 73 20 61 72 ;; all tests ar
46b0: 65 20 66 6f 75 6e 64 20 61 74 20 3c 72 75 6e 64 e found at <rund
46c0: 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 20 6f 72 ir>/test-base or
46d0: 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 73 74 2d <linkdir>/test-
46e0: 62 61 73 65 0a 09 20 28 74 65 73 74 74 6f 70 2d base.. (testtop-
46f0: 62 61 73 65 20 28 63 6f 6e 63 20 74 61 72 67 65 base (conc targe
4700: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f t "/" runname "/
4710: 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 " testname)).. (
4720: 74 65 73 74 2d 62 61 73 65 20 20 20 20 28 63 6f test-base (co
4730: 6e 63 20 74 65 73 74 74 6f 70 2d 62 61 73 65 20 nc testtop-base
4740: 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 (if not-iterated
4750: 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 "" "/") item-pa
4760: 74 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 2f 2f 20 th))... ;; nb//
4770: 69 66 20 69 74 65 6d 70 61 74 68 20 69 73 20 6e if itempath is n
4780: 6f 74 20 22 22 20 74 68 65 6e 20 69 74 20 69 73 ot "" then it is
4790: 20 70 72 65 66 69 78 65 64 20 77 69 74 68 20 22 prefixed with "
47a0: 2f 22 0a 09 20 28 74 6f 70 74 65 73 74 2d 70 61 /".. (toptest-pa
47b0: 74 68 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 th (conc disk-pa
47c0: 74 68 20 22 2f 22 20 74 65 73 74 74 6f 70 2d 62 th "/" testtop-b
47d0: 61 73 65 29 29 0a 09 20 28 74 65 73 74 2d 70 61 ase)).. (test-pa
47e0: 74 68 20 20 20 20 28 63 6f 6e 63 20 64 69 73 6b th (conc disk
47f0: 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 2d 62 -path "/" test-b
4800: 61 73 65 29 29 0a 0a 09 20 3b 3b 20 65 6e 73 75 ase))... ;; ensu
4810: 72 65 20 74 68 69 73 20 65 78 69 73 74 73 20 66 re this exists f
4820: 69 72 73 74 20 61 73 20 6c 69 6e 6b 73 20 74 6f irst as links to
4830: 20 73 75 62 74 65 73 74 73 20 6d 75 73 74 20 62 subtests must b
4840: 65 20 63 72 65 61 74 65 64 20 74 68 65 72 65 0a e created there.
4850: 09 20 28 6c 69 6e 6b 74 72 65 65 20 20 28 6c 65 . (linktree (le
4860: 74 20 28 28 72 64 20 28 63 6f 6e 66 69 67 2d 6c t ((rd (config-l
4870: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
4880: 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 * "setup" "linkt
4890: 72 65 65 22 29 29 29 0a 09 09 20 20 20 20 20 20 ree")))...
48a0: 28 69 66 20 72 64 20 72 64 20 28 63 6f 6e 63 20 (if rd rd (conc
48b0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 *toppath* "/runs
48c0: 22 29 29 29 29 0a 0a 09 20 28 6c 6e 6b 62 61 73 "))))... (lnkbas
48d0: 65 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 e (conc linktre
48e0: 65 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 e "/" target "/"
48f0: 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e runname)).. (ln
4900: 6b 70 61 74 68 20 20 28 63 6f 6e 63 20 6c 6e 6b kpath (conc lnk
4910: 62 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 6d base "/" testnam
4920: 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 20 e)).. (lnkpathf
4930: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 69 (conc lnkpath (i
4940: 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 f not-iterated "
4950: 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 " "/") item-path
4960: 29 29 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 61 ))).. ;; Upda
4970: 74 65 20 74 68 65 20 72 75 6e 64 69 72 20 70 61 te the rundir pa
4980: 74 68 20 69 6e 20 74 68 65 20 74 65 73 74 20 72 th in the test r
4990: 65 63 6f 72 64 20 66 6f 72 20 61 6c 6c 0a 20 20 ecord for all.
49a0: 20 20 28 63 64 62 3a 74 65 73 74 2d 73 65 74 2d (cdb:test-set-
49b0: 72 75 6e 64 69 72 2d 62 79 2d 74 65 73 74 2d 69 rundir-by-test-i
49c0: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 d *runremote* te
49d0: 73 74 2d 69 64 20 6c 6e 6b 70 61 74 68 66 29 0a st-id lnkpathf).
49e0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
49f0: 74 20 32 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 t 2 "INFO:\n
4a00: 20 20 20 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b lnkbase=" lnk
4a10: 62 61 73 65 20 22 5c 6e 20 20 20 20 20 20 20 6c base "\n l
4a20: 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 nkpath=" lnkpath
4a30: 20 22 5c 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 "\n toptest-pa
4a40: 74 68 3d 22 20 74 6f 70 74 65 73 74 2d 70 61 74 th=" toptest-pat
4a50: 68 20 22 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 h "\n test-p
4a60: 61 74 68 3d 22 20 74 65 73 74 2d 70 61 74 68 29 ath=" test-path)
4a70: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 . (if (not (f
4a80: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b ile-exists? link
4a90: 74 72 65 65 29 29 0a 09 28 62 65 67 69 6e 0a 09 tree))..(begin..
4aa0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
4ab0: 20 22 57 41 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 "WARNING: linkt
4ac0: 72 65 65 20 64 69 64 20 6e 6f 74 20 65 78 69 73 ree did not exis
4ad0: 74 21 20 43 72 65 61 74 69 6e 67 20 69 74 20 6e t! Creating it n
4ae0: 6f 77 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 ow at " linktree
4af0: 29 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 ).. (create-dir
4b00: 65 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 ectory linktree
4b10: 23 74 29 29 29 20 3b 3b 20 28 73 79 73 74 65 6d #t))) ;; (system
4b20: 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 (conc "mkdir -p
4b30: 20 22 20 6c 69 6e 6b 74 72 65 65 29 29 29 29 0a " linktree)))).
4b40: 20 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 ;; create th
4b50: 65 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 e directory for
4b60: 74 68 65 20 74 65 73 74 73 20 64 69 72 20 6c 69 the tests dir li
4b70: 6e 6b 73 2c 20 74 68 69 73 20 69 73 20 6e 65 65 nks, this is nee
4b80: 64 65 64 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 ded no matter wh
4b90: 61 74 2e 2e 2e 0a 20 20 20 20 28 69 66 20 28 6e at.... (if (n
4ba0: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
4bb0: 69 73 74 73 3f 20 6c 6e 6b 62 61 73 65 29 29 0a ists? lnkbase)).
4bc0: 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f .(create-directo
4bd0: 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 0a ry lnkbase #t)).
4be0: 20 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 61 . ;; upda
4bf0: 74 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 72 te the toptest r
4c00: 65 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 6c ecord with its l
4c10: 6f 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c 20 ocation rundir,
4c20: 63 61 63 68 65 20 74 68 65 20 70 61 74 68 0a 20 cache the path.
4c30: 20 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 20 ;; This wass
4c40: 68 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 65 highly inefficie
4c50: 6e 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 65 nt, one db write
4c60: 20 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 65 for every subte
4c70: 73 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 0a st, potentially.
4c80: 20 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 73 ;; thousands
4c90: 20 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 20 of unnecessary
4ca0: 75 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 74 updates, cache t
4cb0: 68 65 20 66 61 63 74 20 69 74 20 77 61 73 20 73 he fact it was s
4cc0: 65 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 74 et and don't set
4cd0: 20 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 69 it . ;; agai
4ce0: 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 42 20 2d n. .. ;; NB -
4cf0: 20 54 68 69 73 20 69 73 20 6e 6f 74 20 77 6f 72 This is not wor
4d00: 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f 6d king right - som
4d10: 65 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 20 e top tests are
4d20: 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 20 not getting the
4d30: 70 61 74 68 20 73 65 74 21 21 21 0a 0a 20 20 20 path set!!!..
4d40: 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d (if (not (hash-
4d50: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4d60: 74 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 t *toptest-paths
4d70: 2a 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a * testname #f)).
4d80: 09 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e 66 .(let* ((testinf
4d90: 6f 20 20 20 20 20 20 20 28 63 64 62 3a 67 65 74 o (cdb:get
4da0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
4db0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 *runremote* tes
4dc0: 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e 2d 69 t-id)) ;; run-i
4dd0: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
4de0: 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 20 28 path)).. (
4df0: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 20 28 curr-test-path (
4e00: 69 66 20 74 65 73 74 69 6e 66 6f 20 28 64 62 3a if testinfo (db:
4e10: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 test-get-rundir
4e20: 74 65 73 74 69 6e 66 6f 29 20 23 66 29 29 29 0a testinfo) #f))).
4e30: 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 . (hash-table-s
4e40: 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 et! *toptest-pat
4e50: 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 63 75 72 hs* testname cur
4e60: 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 r-test-path)..
4e70: 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 74 68 69 73 ;; NB// Was this
4e80: 20 66 6f 72 20 74 68 65 20 74 65 73 74 20 6f 72 for the test or
4e90: 20 66 6f 72 20 74 68 65 20 70 61 72 65 6e 74 20 for the parent
4ea0: 69 6e 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 in an iterated t
4eb0: 65 73 74 3f 0a 09 20 20 28 63 64 62 3a 74 65 73 est?.. (cdb:tes
4ec0: 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 2a 72 t-set-rundir! *r
4ed0: 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 2d 69 64 unremote* run-id
4ee0: 20 74 65 73 74 6e 61 6d 65 20 22 22 20 6c 6e 6b testname "" lnk
4ef0: 70 61 74 68 29 20 3b 3b 20 74 6f 70 74 65 73 74 path) ;; toptest
4f00: 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f -path).. (if (o
4f10: 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 r (not curr-test
4f20: 2d 70 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 -path)... (not
4f30: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
4f40: 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 s? toptest-path)
4f50: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
4f60: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print-
4f70: 69 6e 66 6f 20 32 20 22 43 72 65 61 74 69 6e 67 info 2 "Creating
4f80: 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 " toptest-path
4f90: 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c 6e 6b " and link " lnk
4fa0: 70 61 74 68 29 0a 09 09 28 63 72 65 61 74 65 2d path)...(create-
4fb0: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 74 65 73 directory toptes
4fc0: 74 2d 70 61 74 68 20 23 74 29 0a 09 09 28 68 61 t-path #t)...(ha
4fd0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
4fe0: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
4ff0: 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d 70 stname toptest-p
5000: 61 74 68 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b ath))))).. ;;
5010: 20 4e 6f 77 20 63 72 65 61 74 65 20 74 68 65 20 Now create the
5020: 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 20 74 65 link from the te
5030: 73 74 20 70 61 74 68 20 74 6f 20 74 68 65 20 6c st path to the l
5040: 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 65 76 65 ink tree, howeve
5050: 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 r. ;; if the
5060: 74 65 73 74 20 69 73 20 69 74 65 72 61 74 65 64 test is iterated
5070: 20 69 74 20 69 73 20 6e 65 63 65 73 73 61 72 79 it is necessary
5080: 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 70 to create the p
5090: 61 72 65 6e 74 20 70 61 74 68 0a 20 20 20 20 3b arent path. ;
50a0: 3b 20 74 6f 20 74 68 65 20 69 74 65 72 61 74 69 ; to the iterati
50b0: 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e 61 6d 65 on. use pathname
50c0: 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 20 74 72 -directory to tr
50d0: 69 6d 20 74 68 65 20 70 61 74 68 20 62 79 20 6f im the path by o
50e0: 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 65 6c 0a ne. ;; level.
50f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 (if (not not
5100: 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 69 2e -iterated) ;; i.
5110: 65 2e 20 69 74 65 72 61 74 65 64 0a 09 28 6c 65 e. iterated..(le
5120: 74 20 28 28 69 74 65 72 61 74 65 64 2d 70 61 72 t ((iterated-par
5130: 65 6e 74 20 20 28 70 61 74 68 6e 61 6d 65 2d 64 ent (pathname-d
5140: 69 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 20 6c irectory (conc l
5150: 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d nkpath "/" item-
5160: 70 61 74 68 29 29 29 29 0a 09 20 20 28 64 65 62 path)))).. (deb
5170: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
5180: 22 43 72 65 61 74 69 6e 67 20 69 74 65 72 61 74 "Creating iterat
5190: 65 64 20 70 61 72 65 6e 74 20 22 20 69 74 65 72 ed parent " iter
51a0: 61 74 65 64 2d 70 61 72 65 6e 74 29 0a 09 20 20 ated-parent)..
51b0: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
51c0: 79 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e y iterated-paren
51d0: 74 20 23 74 29 29 29 0a 0a 20 20 20 20 28 69 66 t #t))).. (if
51e0: 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f (symbolic-link?
51f0: 20 6c 6e 6b 70 61 74 68 29 20 28 64 65 6c 65 74 lnkpath) (delet
5200: 65 2d 66 69 6c 65 20 6c 6e 6b 70 61 74 68 29 29 e-file lnkpath))
5210: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f . (if (not (o
5220: 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 r (file-exists?
5230: 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 6d lnkpath)... (sym
5240: 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 bolic-link? lnkp
5250: 61 74 68 29 29 29 0a 09 28 63 72 65 61 74 65 2d ath)))..(create-
5260: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f symbolic-link to
5270: 70 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 ptest-path lnkpa
5280: 74 68 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b th)). . ;;
5290: 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 74 The toptest pat
52a0: 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 74 h has been creat
52b0: 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 ed, the link to
52c0: 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 20 the test in the
52d0: 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 20 linktree has.
52e0: 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 64 ;; been created
52f0: 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 69 . Now, if this i
5300: 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 s an iterated te
5310: 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 74 st the real test
5320: 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 65 dir must be cre
5330: 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e 6f ated. (if (no
5340: 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 t not-iterated)
5350: 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 ;; this is an it
5360: 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 6c 65 erated test..(le
5370: 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 63 t ((lnktarget (c
5380: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
5390: 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 item-path)))..
53a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
53b0: 53 65 74 74 69 6e 67 20 75 70 20 73 75 62 20 74 Setting up sub t
53c0: 65 73 74 20 72 75 6e 20 61 72 65 61 22 29 0a 09 est run area")..
53d0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
53e0: 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 72 75 " - creating ru
53f0: 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 73 74 n area in " test
5400: 2d 70 61 74 68 29 0a 09 20 20 28 63 72 65 61 74 -path).. (creat
5410: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 e-directory test
5420: 2d 70 61 74 68 20 23 74 29 20 3b 3b 20 28 73 79 -path #t) ;; (sy
5430: 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d 6b 64 stem (conc "mkd
5440: 69 72 20 2d 70 20 22 20 74 65 73 74 2d 70 61 74 ir -p " test-pat
5450: 68 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 h)).. (debug:pr
5460: 69 6e 74 20 32 20 0a 09 09 20 20 20 20 20 20 20 int 2 ...
5470: 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c 69 6e " - creating lin
5480: 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 2d 70 k from: " test-p
5490: 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 20 20 ath "\n"...
54a0: 20 20 22 20 20 20 20 20 20 20 20 20 20 20 20 20 "
54b0: 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e 6b 74 to: " lnkt
54c0: 61 72 67 65 74 29 0a 09 20 20 3b 3b 20 28 63 72 arget).. ;; (cr
54d0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c eate-directory l
54e0: 6e 6b 70 61 74 68 20 23 74 29 20 3b 3b 20 28 73 nkpath #t) ;; (s
54f0: 79 73 74 65 6d 20 20 28 63 6f 6e 63 20 22 6d 6b ystem (conc "mk
5500: 64 69 72 20 2d 70 20 22 20 6c 6e 6b 70 61 74 68 dir -p " lnkpath
5510: 29 29 0a 0a 09 20 20 3b 3b 20 49 66 20 74 68 65 ))... ;; If the
5520: 72 65 20 69 73 20 61 6c 72 65 61 64 79 20 61 20 re is already a
5530: 73 79 6d 6c 69 6e 6b 20 64 65 6c 65 74 65 20 69 symlink delete i
5540: 74 20 61 6e 64 20 72 65 63 72 65 61 74 65 20 69 t and recreate i
5550: 74 2e 0a 09 20 20 28 69 66 20 28 73 79 6d 62 6f t... (if (symbo
5560: 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 72 lic-link? lnktar
5570: 67 65 74 29 20 20 20 20 20 28 64 65 6c 65 74 65 get) (delete
5580: 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 67 65 74 29 -file lnktarget)
5590: 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 28 66 ).. (if (not (f
55a0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 74 ile-exists? lnkt
55b0: 61 72 67 65 74 29 29 20 28 63 72 65 61 74 65 2d arget)) (create-
55c0: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 65 symbolic-link te
55d0: 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 67 65 st-path lnktarge
55e0: 74 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 49 20 t)))).. ;; I
55f0: 73 75 73 70 65 63 74 20 74 68 69 73 20 73 65 63 suspect this sec
5600: 74 69 6f 6e 20 77 61 73 20 64 65 6c 65 74 69 6e tion was deletin
5610: 67 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 69 g test directori
5620: 65 73 20 75 6e 64 65 72 20 73 6f 6d 65 20 0a 20 es under some .
5630: 20 20 20 3b 3b 20 77 69 65 72 64 20 73 69 74 61 ;; wierd sita
5640: 74 69 6f 6e 73 3f 20 54 68 69 73 20 64 6f 65 73 tions? This does
5650: 6e 27 74 20 6d 61 6b 65 20 73 65 6e 73 65 20 2d n't make sense -
5660: 20 72 65 65 6e 61 62 6c 69 6e 67 20 74 68 65 20 reenabling the
5670: 72 6d 20 2d 66 20 0a 20 20 20 20 3b 3b 20 49 20 rm -f . ;; I
5680: 68 6f 6e 65 73 74 6c 79 20 64 6f 6e 27 74 20 72 honestly don't r
5690: 65 6d 65 6d 62 65 72 20 2a 77 68 79 2a 20 74 68 emember *why* th
56a0: 69 73 20 63 68 75 6e 6b 20 77 61 73 20 6e 65 65 is chunk was nee
56b0: 64 65 64 2e 2e 2e 0a 20 20 20 20 3b 3b 20 28 6c ded.... ;; (l
56c0: 65 74 20 28 28 74 65 73 74 6c 69 6e 6b 20 28 63 et ((testlink (c
56d0: 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
56e0: 74 65 73 74 6e 61 6d 65 29 29 29 0a 20 20 20 20 testname))).
56f0: 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 28 66 ;; (if (and (f
5700: 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 73 74 ile-exists? test
5710: 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 20 link). ;;
5720: 20 20 20 20 20 20 20 20 28 6f 72 20 28 72 65 67 (or (reg
5730: 75 6c 61 72 2d 66 69 6c 65 3f 20 74 65 73 74 6c ular-file? testl
5740: 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 ink). ;;
5750: 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 . (symbolic-li
5760: 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a nk? testlink))).
5770: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 73 79 ;; (sy
5780: 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d stem (conc "rm -
5790: 66 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a f " testlink))).
57a0: 20 20 20 20 3b 3b 20 20 20 28 73 79 73 74 65 6d ;; (system
57b0: 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d 73 66 20 (conc "ln -sf
57c0: 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 22 20 " test-path " "
57d0: 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 20 20 20 testlink))).
57e0: 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 3f 20 (if (directory?
57f0: 74 65 73 74 2d 70 61 74 68 29 0a 09 28 62 65 67 test-path)..(beg
5800: 69 6e 0a 09 20 20 28 6c 65 74 2a 20 28 28 63 6d in.. (let* ((cm
5810: 64 20 20 20 20 28 63 6f 6e 63 20 22 72 73 79 6e d (conc "rsyn
5820: 63 20 2d 61 76 22 20 28 69 66 20 28 64 65 62 75 c -av" (if (debu
5830: 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 g:debug-mode 1)
5840: 22 22 20 22 71 22 29 20 22 20 22 20 74 65 73 74 "" "q") " " test
5850: 2d 73 72 63 2d 70 61 74 68 20 22 2f 20 22 20 74 -src-path "/ " t
5860: 65 73 74 2d 70 61 74 68 20 22 2f 22 29 29 0a 09 est-path "/"))..
5870: 09 20 28 73 74 61 74 75 73 20 28 73 79 73 74 65 . (status (syste
5880: 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 20 28 69 m cmd))).. (i
5890: 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 74 f (not (eq? stat
58a0: 75 73 20 30 29 29 0a 09 09 28 64 65 62 75 67 3a us 0))...(debug:
58b0: 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 3a 20 print 2 "ERROR:
58c0: 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 6e problem with run
58d0: 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 ning \"" cmd "\"
58e0: 22 29 29 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e "))).. (list ln
58f0: 6b 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 kpathf lnkpath )
5900: 29 0a 09 28 6c 69 73 74 20 23 66 20 23 66 29 29 )..(list #f #f))
5910: 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 74 ))..;; 1. look t
5920: 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 73 74 hough disks list
5930: 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 20 6d for disk with m
5940: 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e 20 ost space.;; 2.
5950: 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 20 6f create run dir o
5960: 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 6d n disk, path nam
5970: 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c 0a e is meaningful.
5980: 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c 69 6e ;; 3. create lin
5990: 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 74 k from run dir t
59a0: 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e 73 20 o megatest runs
59b0: 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d 6f area .;; 4. remo
59c0: 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 65 73 tely run the tes
59d0: 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 68 t on allocated h
59e0: 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c ost.;; - coul
59f0: 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f 73 74 d be ssh to host
5a00: 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 6c from hosts tabl
5a10: 65 20 28 75 70 64 61 74 65 20 72 65 67 75 6c 61 e (update regula
5a20: 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 0a 3b rly with load).;
5a30: 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 ; - could be
5a40: 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 20 netbatch.;;
5a50: 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 62 (launch-test db
5a60: 20 28 63 61 64 72 20 73 74 61 74 75 73 29 20 74 (cadr status) t
5a70: 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 69 est-conf)).(defi
5a80: 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 ne (launch-test
5a90: 64 62 20 72 75 6e 2d 69 64 20 72 75 6e 6e 61 6d db run-id runnam
5aa0: 65 20 74 65 73 74 2d 63 6f 6e 66 20 6b 65 79 76 e test-conf keyv
5ab0: 61 6c 6c 73 74 20 74 65 73 74 2d 6e 61 6d 65 20 allst test-name
5ac0: 74 65 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 test-path itemda
5ad0: 74 20 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 t params). (cha
5ae0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 nge-directory *t
5af0: 6f 70 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 oppath*). (alis
5b00: 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 t->env-vars ;; c
5b10: 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 onsolidate this
5b20: 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 63 6f code with the co
5b30: 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 de in megatest.s
5b40: 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 cm for "-execute
5b50: 22 0a 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c ". (list ;; (l
5b60: 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e ist "MT_TEST_RUN
5b70: 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
5b80: 0a 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 . (list "MT_R
5b90: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 UN_AREA_HOME" *t
5ba0: 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 oppath*). (li
5bb0: 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 st "MT_TEST_NAME
5bc0: 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 " test-name).
5bd0: 20 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 ;; (list "MT_IT
5be0: 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 EM_INFO" (conc i
5bf0: 74 65 6d 64 61 74 29 29 20 0a 20 20 20 20 28 6c temdat)) . (l
5c00: 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 ist "MT_RUNNAME"
5c10: 20 20 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 runname).
5c20: 3b 3b 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 ;; (list "MT_TAR
5c30: 47 45 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 GET" mt_targe
5c40: 74 29 0a 20 20 20 20 29 29 0a 20 20 28 6c 65 74 t). )). (let
5c50: 2a 20 28 28 75 73 65 73 68 65 6c 6c 20 20 20 28 * ((useshell (
5c60: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
5c70: 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f onfigdat* "jobto
5c80: 6f 6c 73 22 20 20 20 20 20 22 75 73 65 73 68 65 ols" "useshe
5c90: 6c 6c 22 29 29 0a 09 20 28 6c 61 75 6e 63 68 65 ll")).. (launche
5ca0: 72 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b r (config-look
5cb0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
5cc0: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 6c jobtools" "l
5cd0: 61 75 6e 63 68 65 72 22 29 29 0a 09 20 28 72 75 auncher")).. (ru
5ce0: 6e 73 63 72 69 70 74 20 20 28 63 6f 6e 66 69 67 nscript (config
5cf0: 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e -lookup test-con
5d00: 66 20 20 20 22 73 65 74 75 70 22 20 20 20 20 20 f "setup"
5d10: 20 20 20 22 72 75 6e 73 63 72 69 70 74 22 29 29 "runscript"))
5d20: 0a 09 20 28 65 7a 73 74 65 70 73 20 20 20 20 28 .. (ezsteps (
5d30: 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d > (length (hash-
5d40: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5d50: 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 7a 73 t test-conf "ezs
5d60: 74 65 70 73 22 20 27 28 29 29 29 20 30 29 29 20 teps" '())) 0))
5d70: 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 6c ;; don't send al
5d80: 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 6f 75 l the steps, cou
5d90: 6c 64 20 62 65 20 62 69 67 0a 09 20 28 64 69 73 ld be big.. (dis
5da0: 6b 73 70 61 63 65 20 20 28 63 6f 6e 66 69 67 2d kspace (config-
5db0: 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 lookup test-conf
5dc0: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
5dd0: 22 20 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a " "diskspace")).
5de0: 09 20 28 6d 65 6d 6f 72 79 20 20 20 20 20 28 63 . (memory (c
5df0: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
5e00: 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 t-conf "requir
5e10: 65 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 22 ements" "memory"
5e20: 29 29 0a 09 20 28 68 6f 73 74 73 20 20 20 20 20 )).. (hosts
5e30: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
5e40: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
5e50: 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b tools" "work
5e60: 68 6f 73 74 73 22 29 29 0a 09 20 28 72 65 6d 6f hosts")).. (remo
5e70: 74 65 2d 6d 65 67 61 74 65 73 74 20 28 63 6f 6e te-megatest (con
5e80: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
5e90: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
5ea0: 65 78 65 63 75 74 61 62 6c 65 22 29 29 0a 09 20 executable"))..
5eb0: 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 ;; FIXME SOMEDAY
5ec0: 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 20 74 : not good how t
5ed0: 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 73 65 his is so obtuse
5ee0: 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 20 74 , this hack is t
5ef0: 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 o .. ;;
5f00: 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 75 6e allow run
5f10: 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 62 6f ning from dashbo
5f20: 61 72 64 2e 20 45 78 74 72 61 63 74 20 74 68 65 ard. Extract the
5f30: 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 20 20 20 path.. ;;
5f40: 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 from t
5f50: 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 he called megate
5f60: 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 st and convert d
5f70: 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b 20 20 20 ashboard.. ;;
5f80: 20 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 . or
5f90: 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 dboard to megate
5fa0: 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d 65 67 61 st.. (local-mega
5fb0: 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 6c 6d test (let* ((lm
5fc0: 20 20 28 63 61 72 20 28 61 72 67 76 29 29 29 0a (car (argv))).
5fd0: 09 09 09 09 20 28 64 69 72 20 28 70 61 74 68 6e .... (dir (pathn
5fe0: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d ame-directory lm
5ff0: 29 29 0a 09 09 09 09 20 28 65 78 65 20 28 70 61 ))..... (exe (pa
6000: 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 thname-strip-dir
6010: 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 ectory lm)))....
6020: 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 (conc (if di
6030: 72 20 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 r (conc dir "/")
6040: 20 22 22 29 0a 09 09 09 09 20 20 28 63 61 73 65 "")..... (case
6050: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
6060: 20 65 78 65 29 0a 09 09 09 09 20 20 20 20 28 28 exe)..... ((
6070: 64 62 6f 61 72 64 29 20 20 20 20 22 6d 65 67 61 dboard) "mega
6080: 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 test")..... (
6090: 28 6d 74 65 73 74 29 20 20 20 20 20 22 6d 65 67 (mtest) "meg
60a0: 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 atest").....
60b0: 28 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 ((dashboard) "me
60c0: 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 gatest").....
60d0: 20 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a (else exe))))).
60e0: 09 20 28 74 65 73 74 2d 73 69 67 20 20 20 28 63 . (test-sig (c
60f0: 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a onc test-name ":
6100: 22 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 " (item-list->pa
6110: 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b th itemdat))) ;;
6120: 20 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 test-path is th
6130: 65 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c e full path incl
6140: 75 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 uding the item-p
6150: 61 74 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 61 ath.. (work-area
6160: 20 20 23 66 29 0a 09 20 28 74 6f 70 74 65 73 74 #f).. (toptest
6170: 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 3b -work-area #f) ;
6180: 3b 20 66 6f 72 20 69 74 65 72 61 74 65 64 20 74 ; for iterated t
6190: 65 73 74 73 20 74 68 65 20 74 6f 70 20 74 65 73 ests the top tes
61a0: 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 t contains data
61b0: 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c relevant for all
61c0: 0a 09 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 .. (diskpath #
61d0: 66 29 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 20 f).. (cmdparms
61e0: 20 23 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 20 #f).. (fullcmd
61f0: 20 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e #f) ;; (defin
6200: 65 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 e a (with-output
6210: 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 -to-string (lamb
6220: 64 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 da ()(write x)))
6230: 29 0a 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 ).. (mt-bindir-p
6240: 61 74 68 20 23 66 29 0a 09 20 28 69 74 65 6d 2d ath #f).. (item-
6250: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
6260: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
6270: 09 20 28 74 65 73 74 2d 69 64 20 20 20 20 28 63 . (test-id (c
6280: 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 db:remote-run db
6290: 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 23 66 20 :get-test-id #f
62a0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
62b0: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 item-path)).. (
62c0: 74 65 73 74 69 6e 66 6f 20 20 20 28 63 64 62 3a testinfo (cdb:
62d0: 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 get-test-info-by
62e0: 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 -id *runremote*
62f0: 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6d 74 5f test-id)).. (mt_
6300: 74 61 72 67 65 74 20 20 28 73 74 72 69 6e 67 2d target (string-
6310: 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 intersperse (map
6320: 20 63 61 64 72 20 6b 65 79 76 61 6c 6c 73 74 29 cadr keyvallst)
6330: 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d "/")).. (debug-
6340: 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 param (append (i
6350: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
6360: 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 "-debug") (list
6370: 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a "-debug" (args:
6380: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 get-arg "-debug"
6390: 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 )) '())....
63a0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
63b0: 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
63c0: 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
63d0: 27 28 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 '())))). (if
63e0: 68 6f 73 74 73 20 28 73 65 74 21 20 68 6f 73 74 hosts (set! host
63f0: 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 s (string-split
6400: 68 6f 73 74 73 29 29 29 0a 20 20 20 20 3b 3b 20 hosts))). ;;
6410: 73 65 74 20 74 68 65 20 6d 65 67 61 74 65 73 74 set the megatest
6420: 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 20 6f 6e to be called on
6430: 20 74 68 65 20 72 65 6d 6f 74 65 20 68 6f 73 74 the remote host
6440: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 65 . (if (not re
6450: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 28 73 mote-megatest)(s
6460: 65 74 21 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 et! remote-megat
6470: 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 est local-megate
6480: 73 74 29 29 20 3b 3b 20 22 6d 65 67 61 74 65 73 st)) ;; "megates
6490: 74 22 29 29 0a 20 20 20 20 28 73 65 74 21 20 6d t")). (set! m
64a0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 70 t-bindir-path (p
64b0: 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
64c0: 79 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 y remote-megates
64d0: 74 29 29 0a 20 20 20 20 28 69 66 20 6c 61 75 6e t)). (if laun
64e0: 63 68 65 72 20 28 73 65 74 21 20 6c 61 75 6e 63 cher (set! launc
64f0: 68 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 her (string-spli
6500: 74 20 6c 61 75 6e 63 68 65 72 29 29 29 0a 20 20 t launcher))).
6510: 20 20 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 ;; set up the
6520: 72 75 6e 20 77 6f 72 6b 20 61 72 65 61 20 66 6f run work area fo
6530: 72 20 74 68 69 73 20 74 65 73 74 0a 20 20 20 20 r this test.
6540: 28 73 65 74 21 20 64 69 73 6b 70 61 74 68 20 28 (set! diskpath (
6550: 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 2a 63 get-best-disk *c
6560: 6f 6e 66 69 67 64 61 74 2a 29 29 0a 20 20 20 20 onfigdat*)).
6570: 28 69 66 20 64 69 73 6b 70 61 74 68 0a 09 28 6c (if diskpath..(l
6580: 65 74 20 28 28 64 61 74 20 20 28 6f 70 65 6e 2d et ((dat (open-
6590: 72 75 6e 2d 63 6c 6f 73 65 20 63 72 65 61 74 65 run-close create
65a0: 2d 77 6f 72 6b 2d 61 72 65 61 20 64 62 20 72 75 -work-area db ru
65b0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 74 65 73 n-id test-id tes
65c0: 74 2d 70 61 74 68 20 64 69 73 6b 70 61 74 68 20 t-path diskpath
65d0: 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 test-name itemda
65e0: 74 29 29 29 0a 09 20 20 28 73 65 74 21 20 77 6f t))).. (set! wo
65f0: 72 6b 2d 61 72 65 61 20 28 63 61 72 20 64 61 74 rk-area (car dat
6600: 29 29 0a 09 20 20 28 73 65 74 21 20 74 6f 70 74 )).. (set! topt
6610: 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 28 63 est-work-area (c
6620: 61 64 72 20 64 61 74 29 29 0a 09 20 20 28 64 65 adr dat)).. (de
6630: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
6640: 20 22 55 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 "Using work are
6650: 61 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a a " work-area)).
6660: 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 .(begin.. (set!
6670: 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f 6e 63 work-area (conc
6680: 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 6d 70 test-path "/tmp
6690: 5f 72 75 6e 22 29 29 0a 09 20 20 28 63 72 65 61 _run")).. (crea
66a0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 te-directory wor
66b0: 6b 2d 61 72 65 61 20 23 74 29 0a 09 20 20 28 64 k-area #t).. (d
66c0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 57 41 ebug:print 0 "WA
66d0: 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 77 RNING: No disk w
66e0: 6f 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 69 ork area specifi
66f0: 65 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e 20 ed - running in
6700: 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f the test directo
6710: 72 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 6e ry under tmp_run
6720: 22 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 63 "))). (set! c
6730: 6d 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 3a mdparms (base64:
6740: 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 28 77 base64-encode (w
6750: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 ith-output-to-st
6760: 72 69 6e 67 0a 09 09 09 09 09 20 20 20 28 6c 61 ring...... (la
6770: 6d 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 74 mbda () ;; (list
6780: 20 27 68 6f 73 74 73 20 20 20 20 20 68 6f 73 74 'hosts host
6790: 73 29 0a 09 09 09 09 09 20 20 20 20 20 28 77 72 s)...... (wr
67a0: 69 74 65 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ite (list (list
67b0: 27 74 65 73 74 70 61 74 68 20 20 74 65 73 74 2d 'testpath test-
67c0: 70 61 74 68 29 0a 09 09 09 09 09 09 09 20 20 28 path)........ (
67d0: 6c 69 73 74 20 27 74 6f 70 70 61 74 68 20 20 20 list 'toppath
67e0: 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 09 09 09 *toppath*)......
67f0: 09 09 20 20 28 6c 69 73 74 20 27 77 6f 72 6b 2d .. (list 'work-
6800: 61 72 65 61 20 77 6f 72 6b 2d 61 72 65 61 29 0a area work-area).
6810: 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 ....... (list '
6820: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e test-name test-n
6830: 61 6d 65 29 20 0a 09 09 09 09 09 09 09 20 20 28 ame) ........ (
6840: 6c 69 73 74 20 27 72 75 6e 73 63 72 69 70 74 20 list 'runscript
6850: 72 75 6e 73 63 72 69 70 74 29 20 0a 09 09 09 09 runscript) .....
6860: 09 09 09 20 20 28 6c 69 73 74 20 27 72 75 6e 2d ... (list 'run-
6870: 69 64 20 20 20 20 72 75 6e 2d 69 64 20 20 20 29 id run-id )
6880: 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 ........ (list
6890: 27 74 65 73 74 2d 69 64 20 20 20 74 65 73 74 2d 'test-id test-
68a0: 69 64 20 20 29 0a 09 09 09 09 09 09 09 20 20 28 id )........ (
68b0: 6c 69 73 74 20 27 69 74 65 6d 64 61 74 20 20 20 list 'itemdat
68c0: 69 74 65 6d 64 61 74 20 20 29 0a 09 09 09 09 09 itemdat )......
68d0: 09 09 20 20 28 6c 69 73 74 20 27 6d 65 67 61 74 .. (list 'megat
68e0: 65 73 74 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 est remote-mega
68f0: 74 65 73 74 29 0a 09 09 09 09 09 09 09 20 20 28 test)........ (
6900: 6c 69 73 74 20 27 65 7a 73 74 65 70 73 20 20 20 list 'ezsteps
6910: 65 7a 73 74 65 70 73 29 20 0a 09 09 09 09 09 09 ezsteps) .......
6920: 09 20 20 28 6c 69 73 74 20 27 74 61 72 67 65 74 . (list 'target
6930: 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 mt_target)..
6940: 09 09 09 09 09 09 20 20 28 6c 69 73 74 20 27 65 ...... (list 'e
6950: 6e 76 2d 6f 76 72 64 20 20 28 68 61 73 68 2d 74 nv-ovrd (hash-t
6960: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
6970: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e *configdat* "en
6980: 76 2d 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 v-override" '())
6990: 29 20 0a 09 09 09 09 09 09 09 20 20 28 6c 69 73 ) ........ (lis
69a0: 74 20 27 73 65 74 2d 76 61 72 73 20 20 28 69 66 t 'set-vars (if
69b0: 20 70 61 72 61 6d 73 20 28 68 61 73 68 2d 74 61 params (hash-ta
69c0: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
69d0: 70 61 72 61 6d 73 20 22 2d 73 65 74 76 61 72 73 params "-setvars
69e0: 22 20 23 66 29 29 29 0a 09 09 09 09 09 09 09 20 " #f)))........
69f0: 20 28 6c 69 73 74 20 27 72 75 6e 6e 61 6d 65 20 (list 'runname
6a00: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 runname)......
6a10: 09 09 20 20 28 6c 69 73 74 20 27 6d 74 2d 62 69 .. (list 'mt-bi
6a20: 6e 64 69 72 2d 70 61 74 68 20 6d 74 2d 62 69 6e ndir-path mt-bin
6a30: 64 69 72 2d 70 61 74 68 29 29 29 29 29 29 29 20 dir-path)))))))
6a40: 3b 3b 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 ;; (string-inter
6a50: 73 70 65 72 73 65 20 6b 65 79 76 61 6c 6c 73 74 sperse keyvallst
6a60: 20 22 20 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 " ")))). ;;
6a70: 63 6c 65 61 6e 20 6f 75 74 20 73 74 65 70 20 72 clean out step r
6a80: 65 63 6f 72 64 73 20 66 72 6f 6d 20 70 72 65 76 ecords from prev
6a90: 69 6f 75 73 20 72 75 6e 20 69 66 20 74 68 65 79 ious run if they
6aa0: 20 65 78 69 73 74 0a 20 20 20 20 3b 3b 20 28 64 exist. ;; (d
6ab0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
6ac0: 34 20 22 46 49 58 4d 45 45 45 45 45 21 21 21 21 4 "FIXMEEEEE!!!!
6ad0: 20 54 68 69 73 20 63 61 6e 20 62 65 20 72 65 6d This can be rem
6ae0: 6f 76 65 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 oved some day, p
6af0: 65 72 68 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 erhaps move all
6b00: 74 65 73 74 20 72 65 63 6f 72 64 73 20 74 6f 20 test records to
6b10: 74 68 65 20 74 65 73 74 20 64 62 3f 22 29 0a 20 the test db?").
6b20: 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d ;; (open-run-
6b30: 63 6c 6f 73 65 20 64 62 3a 64 65 6c 65 74 65 2d close db:delete-
6b40: 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 test-step-record
6b50: 73 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 s db test-id).
6b60: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
6b70: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b ory work-area) ;
6b80: 3b 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 ; so that log fi
6b90: 6c 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 les from the lau
6ba0: 6e 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 nch process don'
6bb0: 74 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 t clutter the te
6bc0: 73 74 20 64 69 72 0a 20 20 20 20 28 74 65 73 74 st dir. (test
6bd0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
6be0: 73 21 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e s! test-id "LAUN
6bf0: 43 48 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 CHED" "n/a" #f #
6c00: 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 f) ;; (if launch
6c10: 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d -results launch-
6c20: 72 65 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 results "FAILED"
6c30: 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 )). (cond.
6c40: 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 ((and launcher
6c50: 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 hosts) ;; must
6c60: 62 65 20 75 73 69 6e 67 20 73 73 68 20 68 6f 73 be using ssh hos
6c70: 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 73 65 74 tname. (set
6c80: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6c90: 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 d launcher (car
6ca0: 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f hosts)(list remo
6cb0: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
6cc0: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
6cd0: 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
6ce0: 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b param))). ;;
6cf0: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
6d00: 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 append launcher
6d10: 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 (car hosts)(list
6d20: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
6d30: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
6d40: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 ute" cmdparms)))
6d50: 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 ). (launcher
6d60: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
6d70: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
6d80: 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f ncher (list remo
6d90: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
6da0: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
6db0: 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
6dc0: 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b param))). ;;
6dd0: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
6de0: 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 append launcher
6df0: 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 (list remote-meg
6e00: 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 atest test-sig "
6e10: 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 -execute" cmdpar
6e20: 6d 73 29 29 29 29 0a 20 20 20 20 20 28 65 6c 73 ms)))). (els
6e30: 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 e. (if (not
6e40: 20 75 73 65 73 68 65 6c 6c 29 28 64 65 62 75 67 useshell)(debug
6e50: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
6e60: 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e G: internal laun
6e70: 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 ching will not w
6e80: 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 ork well without
6e90: 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 65 73 5c \"useshell yes\
6ea0: 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f " in your [jobto
6eb0: 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a ols] section")).
6ec0: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
6ed0: 63 6d 64 20 28 61 70 70 65 6e 64 20 28 6c 69 73 cmd (append (lis
6ee0: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
6ef0: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
6f00: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 cute" cmdparms)
6f10: 64 65 62 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 debug-param (lis
6f20: 74 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 t (if useshell "
6f30: 26 22 20 22 22 29 29 29 29 29 29 0a 20 20 20 20 &" "")))))).
6f40: 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
6f50: 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
6f60: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
6f70: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
6f80: 72 6d 73 20 28 69 66 20 75 73 65 73 68 65 6c 6c rms (if useshell
6f90: 20 22 26 22 20 22 22 29 29 29 29 29 0a 20 20 20 "&" ""))))).
6fa0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
6fb0: 72 67 20 22 2d 78 74 65 72 6d 22 29 28 73 65 74 rg "-xterm")(set
6fc0: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
6fd0: 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 d fullcmd (list
6fe0: 22 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 20 20 "-xterm")))).
6ff0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
7000: 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 "Launching " wor
7010: 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 k-area). ;; s
7020: 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e et pre-launch-en
7030: 76 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c 61 v-vars before la
7040: 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 unching, keep th
7050: 65 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 61 e vars in prevva
7060: 6c 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 65 ls and put the e
7070: 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 nvionment back w
7080: 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 hen done. (de
7090: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 66 75 6c bug:print 4 "ful
70a0: 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 lcmd: " fullcmd)
70b0: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d . (let* ((com
70c0: 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 61 6c 69 monprevvals (ali
70d0: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 st->env-vars....
70e0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
70f0: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e ref/default *con
7100: 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 figdat* "env-ove
7110: 72 72 69 64 65 22 20 27 28 29 29 29 29 0a 09 20 rride" '())))..
7120: 20 20 28 74 65 73 74 70 72 65 76 76 61 6c 73 20 (testprevvals
7130: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
7140: 72 73 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d rs.... (hash-
7150: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
7160: 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 70 72 65 t test-conf "pre
7170: 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 -launch-env-over
7180: 72 69 64 65 73 22 20 27 28 29 29 29 29 0a 09 20 rides" '())))..
7190: 20 20 28 6d 69 73 63 70 72 65 76 76 61 6c 73 20 (miscprevvals
71a0: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
71b0: 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 rs ;; consolidat
71c0: 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 e this code with
71d0: 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 the code in meg
71e0: 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d atest.scm for "-
71f0: 65 78 65 63 75 74 65 22 0a 09 09 09 20 20 20 20 execute"....
7200: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 6c (append (list (l
7210: 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e ist "MT_TEST_RUN
7220: 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
7230: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
7240: 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes
7250: 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 t-name)...... (
7260: 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e list "MT_ITEM_IN
7270: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
7280: 74 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 73 t)) ...... (lis
7290: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
72a0: 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 runname)......
72b0: 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
72c0: 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
72d0: 0a 09 09 09 09 09 20 20 29 0a 09 09 09 09 20 20 ...... ).....
72e0: 20 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 itemdat)))..
72f0: 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 (launch-results
7300: 20 28 61 70 70 6c 79 20 63 6d 64 2d 72 75 6e 2d (apply cmd-run-
7310: 77 69 74 68 2d 73 74 64 65 72 72 2d 3e 6c 69 73 with-stderr->lis
7320: 74 20 3b 3b 20 63 6d 64 2d 72 75 6e 2d 70 72 6f t ;; cmd-run-pro
7330: 63 2d 65 61 63 68 2d 6c 69 6e 65 0a 09 09 09 09 c-each-line.....
7340: 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 (if useshell..
7350: 09 09 09 20 20 20 20 20 20 28 73 74 72 69 6e 67 ... (string
7360: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
7370: 6c 63 6d 64 20 22 20 22 29 0a 09 09 09 09 20 20 lcmd " ").....
7380: 20 20 20 20 28 63 61 72 20 66 75 6c 6c 63 6d 64 (car fullcmd
7390: 29 29 0a 09 09 09 09 20 20 3b 3b 20 63 6f 6e 63 ))..... ;; conc
73a0: 0a 09 09 09 09 20 20 28 69 66 20 75 73 65 73 68 ..... (if usesh
73b0: 65 6c 6c 0a 09 09 09 09 20 20 20 20 20 20 27 28 ell..... '(
73c0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 64 72 )..... (cdr
73d0: 20 66 75 6c 6c 63 6d 64 29 29 29 29 29 20 3b 3b fullcmd))))) ;;
73e0: 20 20 6c 61 75 6e 63 68 65 72 20 66 75 6c 6c 63 launcher fullc
73f0: 6d 64 29 29 29 3b 3b 20 28 61 70 70 6c 79 20 63 md)));; (apply c
7400: 6d 64 2d 72 75 6e 2d 70 72 6f 63 2d 65 61 63 68 md-run-proc-each
7410: 2d 6c 69 6e 65 20 6c 61 75 6e 63 68 65 72 20 70 -line launcher p
7420: 72 69 6e 74 20 66 75 6c 6c 63 6d 64 29 29 29 20 rint fullcmd)))
7430: 3b 3b 20 28 63 6d 64 2d 72 75 6e 2d 3e 6c 69 73 ;; (cmd-run->lis
7440: 74 20 66 75 6c 6c 63 6d 64 29 29 0a 20 20 20 20 t fullcmd)).
7450: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
7460: 6f 2d 66 69 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 o-file "mt_launc
7470: 68 2e 6c 6f 67 22 0a 09 28 6c 61 6d 62 64 61 20 h.log"..(lambda
7480: 28 29 0a 09 20 20 28 61 70 70 6c 79 20 70 72 69 ().. (apply pri
7490: 6e 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 nt launch-result
74a0: 73 29 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 s))). (debu
74b0: 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 6e 63 g:print 2 "Launc
74c0: 68 69 6e 67 20 63 6f 6d 70 6c 65 74 65 64 2c 20 hing completed,
74d0: 75 70 64 61 74 69 6e 67 20 64 62 22 29 0a 20 20 updating db").
74e0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
74f0: 20 32 20 22 4c 61 75 6e 63 68 20 72 65 73 75 6c 2 "Launch resul
7500: 74 73 3a 20 22 20 6c 61 75 6e 63 68 2d 72 65 73 ts: " launch-res
7510: 75 6c 74 73 29 0a 20 20 20 20 20 20 28 69 66 20 ults). (if
7520: 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 (not launch-resu
7530: 6c 74 73 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 lts).. (begin..
7540: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
7550: 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 72 75 6e R: Failed to run
7560: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
7570: 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 sperse fullcmd "
7580: 20 22 29 20 22 2c 20 65 78 69 74 69 6e 67 20 6e ") ", exiting n
7590: 6f 77 22 29 0a 09 20 20 20 20 3b 3b 20 28 73 71 ow").. ;; (sq
75a0: 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 lite3:finalize!
75b0: 64 62 29 0a 09 20 20 20 20 3b 3b 20 67 6f 6f 64 db).. ;; good
75c0: 20 6f 6c 65 20 22 65 78 69 74 22 20 73 65 65 6d ole "exit" seem
75d0: 73 20 6e 6f 74 20 74 6f 20 77 6f 72 6b 0a 09 20 s not to work..
75e0: 20 20 20 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a ;; (_exit 9).
75f0: 09 20 20 20 20 3b 3b 20 62 75 74 20 74 68 69 73 . ;; but this
7600: 20 68 61 63 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 hack will work!
7610: 20 54 68 61 6e 6b 73 20 67 6f 20 74 6f 20 41 6c Thanks go to Al
7620: 61 6e 20 50 6f 73 74 20 6f 66 20 74 68 65 20 43 an Post of the C
7630: 68 69 63 6b 65 6e 20 65 6d 61 69 6c 20 6c 69 73 hicken email lis
7640: 74 0a 09 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 t.. ;; NB// I
7650: 73 20 74 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 s this still nee
7660: 64 65 64 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 ded? Should be s
7670: 61 66 65 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 afe to go back t
7680: 6f 20 22 65 78 69 74 22 20 6e 6f 77 3f 0a 09 20 o "exit" now?..
7690: 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e (process-sign
76a0: 61 6c 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 al (current-proc
76b0: 65 73 73 2d 69 64 29 20 73 69 67 6e 61 6c 2f 6b ess-id) signal/k
76c0: 69 6c 6c 29 0a 09 20 20 20 20 29 29 0a 20 20 20 ill).. )).
76d0: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
76e0: 61 72 73 20 6d 69 73 63 70 72 65 76 76 61 6c 73 ars miscprevvals
76f0: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e ). (alist->
7700: 65 6e 76 2d 76 61 72 73 20 74 65 73 74 70 72 65 env-vars testpre
7710: 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 61 6c vvals). (al
7720: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 63 6f ist->env-vars co
7730: 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 0a 20 20 mmonprevvals).
7740: 20 20 20 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c launch-resul
7750: 74 73 29 29 0a 20 20 28 63 68 61 6e 67 65 2d 64 ts)). (change-d
7760: 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
7770: 68 2a 29 29 0a 0a h*))..