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 33 2c 20 4d 61 74 74 68 65 77 06-2013, 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 20 64 69 72 65 63 74 6f 72 79 2d 75 i-18 directory-u
0260: 74 69 6c 73 20 70 6f 73 69 78 2d 65 78 74 72 61 tils posix-extra
0270: 73 20 7a 33 20 63 61 6c 6c 2d 77 69 74 68 2d 65 s z3 call-with-e
0280: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
0290: 62 6c 65 73 29 0a 28 75 73 65 20 64 65 66 73 74 bles).(use defst
02a0: 72 75 63 74 29 0a 0a 28 69 6d 70 6f 72 74 20 28 ruct)..(import (
02b0: 70 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 prefix base64 ba
02c0: 73 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 se64:)).(import
02d0: 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 (prefix sqlite3
02e0: 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 sqlite3:))..(dec
02f0: 6c 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 lare (unit launc
0300: 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 h)).(declare (us
0310: 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 es common)).(dec
0320: 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 lare (uses confi
0330: 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 gf)).(declare (u
0340: 73 65 73 20 64 62 29 29 0a 3b 3b 20 28 64 65 63 ses db)).;; (dec
0350: 6c 61 72 65 20 28 75 73 65 73 20 73 64 62 29 29 lare (uses sdb))
0360: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0370: 74 64 62 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 tdb)).;; (declar
0380: 65 20 28 75 73 65 73 20 66 69 6c 65 64 62 29 29 e (uses filedb))
0390: 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d ..(include "comm
03a0: 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 on_records.scm")
03b0: 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 .(include "key_r
03c0: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
03d0: 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 clude "db_record
03e0: 73 2e 73 63 6d 22 29 0a 0a 3b 3b 3d 3d 3d 3d 3d s.scm")..;;=====
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0430: 3d 0a 3b 3b 20 65 7a 73 74 65 70 73 0a 3b 3b 3d =.;; ezsteps.;;=
0440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0480: 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 65 7a 73 74 65 70 =====..;; ezstep
0490: 73 20 77 65 72 65 20 67 6f 69 6e 67 20 74 6f 20 s were going to
04a0: 62 65 20 63 6f 64 65 64 20 61 73 0a 3b 3b 20 73 be coded as.;; s
04b0: 74 65 70 6e 61 6d 65 5b 2c 70 72 65 64 73 74 65 tepname[,predste
04c0: 70 31 2c 70 72 65 64 73 74 65 70 32 20 2e 2e 2e p1,predstep2 ...
04d0: 5d 20 5b 7b 56 41 52 31 3d 66 69 72 73 74 2c 73 ] [{VAR1=first,s
04e0: 65 63 6f 6e 64 2c 74 68 69 72 64 7d 5d 20 63 6f econd,third}] co
04f0: 6d 6d 61 6e 64 20 74 6f 20 65 78 65 63 75 74 65 mmand to execute
0500: 0a 3b 3b 20 20 20 42 55 54 0a 3b 3b 20 6e 6f 77 .;; BUT.;; now
0510: 20 61 72 65 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 are.;; stepname
0520: 20 7b 56 41 52 3d 66 69 72 73 74 2c 73 65 63 6f {VAR=first,seco
0530: 6e 64 2c 74 68 69 72 64 20 2e 2e 2e 7d 20 63 6f nd,third ...} co
0540: 6d 6d 61 6e 64 20 2e 2e 2e 0a 3b 3b 20 77 68 65 mmand ....;; whe
0550: 72 65 20 74 68 65 20 7b 56 41 52 3d 66 69 72 73 re the {VAR=firs
0560: 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 2e t,second,third .
0570: 2e 2e 7d 20 69 73 20 6f 70 74 69 6f 6e 61 6c 2e ..} is optional.
0580: 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6e 20 65 78 ..;; given an ex
0590: 69 74 20 63 6f 64 65 20 61 6e 64 20 77 68 65 74 it code and whet
05a0: 68 65 72 20 6f 72 20 6e 6f 74 20 6c 6f 67 70 72 her or not logpr
05b0: 6f 20 77 61 73 20 75 73 65 64 20 63 61 6c 63 75 o was used calcu
05c0: 6c 61 74 65 20 4f 4b 2f 42 41 44 0a 3b 3b 20 72 late OK/BAD.;; r
05d0: 65 74 75 72 6e 20 23 74 20 69 66 20 77 65 20 61 eturn #t if we a
05e0: 72 65 20 6f 6b 2c 20 23 66 20 6f 74 68 65 72 77 re ok, #f otherw
05f0: 69 73 65 0a 28 64 65 66 69 6e 65 20 28 73 74 65 ise.(define (ste
0600: 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 70 72 prun-good? logpr
0610: 6f 20 65 78 69 74 63 6f 64 65 29 0a 20 20 28 6f o exitcode). (o
0620: 72 20 28 65 71 3f 20 65 78 69 74 63 6f 64 65 20 r (eq? exitcode
0630: 30 29 0a 20 20 20 20 20 20 28 61 6e 64 20 6c 6f 0). (and lo
0640: 67 70 72 6f 20 28 65 71 3f 20 65 78 69 74 63 6f gpro (eq? exitco
0650: 64 65 20 32 29 29 29 29 0a 0a 3b 3b 20 69 66 20 de 2))))..;; if
0660: 68 61 6e 64 65 64 20 61 20 73 74 72 69 6e 67 2c handed a string,
0670: 20 70 72 6f 63 65 73 73 20 69 74 2c 20 65 6c 73 process it, els
0680: 65 20 6c 6f 6f 6b 20 66 6f 72 20 4d 54 5f 43 4d e look for MT_CM
0690: 44 49 4e 46 4f 0a 28 64 65 66 69 6e 65 20 28 6c DINFO.(define (l
06a0: 61 75 6e 63 68 3a 67 65 74 2d 63 6d 64 69 6e 66 aunch:get-cmdinf
06b0: 6f 2d 61 73 73 6f 63 2d 6c 69 73 74 20 23 21 6b o-assoc-list #!k
06c0: 65 79 20 28 65 6e 63 6f 64 65 64 2d 63 6d 64 20 ey (encoded-cmd
06d0: 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 65 6e #f)). (let ((en
06e0: 63 63 6d 64 20 28 69 66 20 65 6e 63 6f 64 65 64 ccmd (if encoded
06f0: 2d 63 6d 64 20 65 6e 63 6f 64 65 64 2d 63 6d 64 -cmd encoded-cmd
0700: 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (getenv "MT_CMD
0710: 49 4e 46 4f 22 29 29 29 29 0a 20 20 20 20 28 69 INFO")))). (i
0720: 66 20 65 6e 63 63 6d 64 0a 09 28 63 6f 6d 6d 6f f enccmd..(commo
0730: 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d 73 n:read-encoded-s
0740: 74 72 69 6e 67 20 65 6e 63 63 6d 64 29 0a 09 27 tring enccmd)..'
0750: 28 29 29 29 29 0a 0a 3b 3b 20 20 20 20 20 20 20 ())))..;;
0760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0770: 30 20 20 20 20 20 20 20 20 20 20 20 31 20 20 20 0 1
0780: 20 20 20 20 20 20 20 20 20 20 20 32 20 20 20 20 2
0790: 20 20 20 20 20 20 20 20 20 20 33 0a 28 64 65 66 3.(def
07a0: 73 74 72 75 63 74 20 6c 61 75 6e 63 68 3a 65 69 struct launch:ei
07b0: 6e 66 20 28 70 69 64 20 23 74 29 28 65 78 69 74 nf (pid #t)(exit
07c0: 2d 73 74 61 74 75 73 20 23 74 29 28 65 78 69 74 -status #t)(exit
07d0: 2d 63 6f 64 65 20 23 74 29 28 72 6f 6c 6c 75 70 -code #t)(rollup
07e0: 2d 73 74 61 74 75 73 20 30 29 29 0a 0a 28 64 65 -status 0))..(de
07f0: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 72 75 6e fine (launch:run
0800: 73 74 65 70 20 65 7a 73 74 65 70 20 72 75 6e 2d step ezstep run-
0810: 69 64 20 74 65 73 74 2d 69 64 20 65 78 69 74 2d id test-id exit-
0820: 69 6e 66 6f 20 6d 20 74 61 6c 20 74 65 73 74 63 info m tal testc
0830: 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 onfig). (let* (
0840: 28 73 74 65 70 6e 61 6d 65 20 20 20 20 20 20 20 (stepname
0850: 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 20 3b (car ezstep)) ;
0860: 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 72 75 ; do stuff to ru
0870: 6e 20 74 68 65 20 73 74 65 70 0a 09 20 28 73 74 n the step.. (st
0880: 65 70 69 6e 66 6f 20 20 20 20 20 20 20 28 63 61 epinfo (ca
0890: 64 72 20 65 7a 73 74 65 70 29 29 0a 09 20 28 73 dr ezstep)).. (s
08a0: 74 65 70 70 61 72 74 73 20 20 20 20 20 20 28 73 tepparts (s
08b0: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
08c0: 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d exp "^(\\{([^\\}
08d0: 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 ]*)\\}\\s*|)(.*)
08e0: 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a 09 $") stepinfo))..
08f0: 20 28 73 74 65 70 70 61 72 6d 73 20 20 20 20 20 (stepparms
0900: 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 (list-ref stepp
0910: 61 72 74 73 20 32 29 29 20 3b 3b 20 66 6f 72 20 arts 2)) ;; for
0920: 66 75 74 75 72 65 20 75 73 65 2c 20 7b 56 41 52 future use, {VAR
0930: 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 74 65 =1,2,3}, run ste
0940: 70 20 66 6f 72 20 65 61 63 68 20 0a 09 20 28 73 p for each .. (s
0950: 74 65 70 63 6d 64 20 20 20 20 20 20 20 20 28 6c tepcmd (l
0960: 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 ist-ref steppart
0970: 73 20 33 29 29 0a 09 20 28 73 63 72 69 70 74 20 s 3)).. (script
0980: 20 20 20 20 20 20 20 20 22 22 29 20 3b 20 22 23 "") ; "#
0990: 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 20 3b !/bin/bash\n") ;
09a0: 3b 20 79 65 70 2c 20 77 65 20 64 65 70 65 6e 64 ; yep, we depend
09b0: 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 49 58 on bin/bash FIX
09c0: 4d 45 21 21 21 5c 0a 09 20 28 6c 6f 67 70 72 6f ME!!!\.. (logpro
09d0: 2d 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 -file (conc s
09e0: 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f tepname ".logpro
09f0: 22 29 29 0a 09 20 28 68 74 6d 6c 2d 66 69 6c 65 ")).. (html-file
0a00: 20 20 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 (conc step
0a10: 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 name ".html"))..
0a20: 20 28 74 63 6f 6e 66 69 67 2d 6c 6f 67 70 72 6f (tconfig-logpro
0a30: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
0a40: 20 74 65 73 74 63 6f 6e 66 69 67 20 22 6c 6f 67 testconfig "log
0a50: 70 72 6f 22 20 73 74 65 70 6e 61 6d 65 29 29 0a pro" stepname)).
0a60: 09 20 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 20 . (logpro-used
0a70: 20 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 (file-exists?
0a80: 6c 6f 67 70 72 6f 2d 66 69 6c 65 29 29 29 0a 0a logpro-file)))..
0a90: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 63 6f (if (and tco
0aa0: 6e 66 69 67 2d 6c 6f 67 70 72 6f 0a 09 20 20 20 nfig-logpro..
0ab0: 20 20 28 6e 6f 74 20 6c 6f 67 70 72 6f 2d 75 73 (not logpro-us
0ac0: 65 64 29 29 20 3b 3b 20 6e 6f 20 6c 6f 67 70 72 ed)) ;; no logpr
0ad0: 6f 20 66 69 6c 65 20 66 6f 75 6e 64 20 62 75 74 o file found but
0ae0: 20 68 61 76 65 20 61 20 64 65 66 6e 20 69 6e 20 have a defn in
0af0: 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 0a 09 the testconfig..
0b00: 28 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d (begin.. (with-
0b10: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 6c output-to-file l
0b20: 6f 67 70 72 6f 2d 66 69 6c 65 0a 09 20 20 20 20 ogpro-file..
0b30: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
0b40: 20 20 28 70 72 69 6e 74 20 22 3b 3b 20 6c 6f 67 (print ";; log
0b50: 70 72 6f 20 66 69 6c 65 20 65 78 74 72 61 63 74 pro file extract
0b60: 65 64 20 66 72 6f 6d 20 74 65 73 74 63 6f 6e 66 ed from testconf
0b70: 69 67 5c 6e 22 0a 09 09 20 20 20 20 20 22 3b 3b ig\n"... ";;
0b80: 22 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 ").. (print
0b90: 20 74 63 6f 6e 66 69 67 2d 6c 6f 67 70 72 6f 29 tconfig-logpro)
0ba0: 29 29 0a 09 20 20 28 73 65 74 21 20 6c 6f 67 70 )).. (set! logp
0bb0: 72 6f 2d 75 73 65 64 20 23 74 29 29 29 0a 20 20 ro-used #t))).
0bc0: 20 20 0a 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 63 . ;; NB// c
0bd0: 61 6e 20 73 61 66 65 6c 79 20 61 73 73 75 6d 65 an safely assume
0be0: 20 77 65 20 61 72 65 20 69 6e 20 74 65 73 74 2d we are in test-
0bf0: 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 0a 20 area directory.
0c00: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
0c10: 34 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 73 74 4 "ezsteps:\n st
0c20: 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e 61 epname: " stepna
0c30: 6d 65 20 22 20 73 74 65 70 69 6e 66 6f 3a 20 22 me " stepinfo: "
0c40: 20 73 74 65 70 69 6e 66 6f 20 22 20 73 74 65 70 stepinfo " step
0c50: 70 61 72 74 73 3a 20 22 20 73 74 65 70 70 61 72 parts: " steppar
0c60: 74 73 0a 09 09 20 22 20 73 74 65 70 70 61 72 6d ts... " stepparm
0c70: 73 3a 20 22 20 73 74 65 70 70 61 72 6d 73 20 22 s: " stepparms "
0c80: 20 73 74 65 70 63 6d 64 3a 20 22 20 73 74 65 70 stepcmd: " step
0c90: 63 6d 64 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b cmd). . ;;
0ca0: 20 3b 3b 20 66 69 72 73 74 20 73 6f 75 72 63 65 ;; first source
0cb0: 20 74 68 65 20 70 72 65 76 69 6f 75 73 20 65 6e the previous en
0cc0: 76 69 72 6f 6e 6d 65 6e 74 0a 20 20 20 20 3b 3b vironment. ;;
0cd0: 20 28 6c 65 74 20 28 28 70 72 65 76 2d 65 6e 76 (let ((prev-env
0ce0: 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 65 70 73 (conc ".ezsteps
0cf0: 2f 22 20 70 72 65 76 73 74 65 70 20 28 69 66 20 /" prevstep (if
0d00: 28 73 74 72 69 6e 67 2d 73 65 61 72 63 68 20 28 (string-search (
0d10: 72 65 67 65 78 70 20 22 63 73 68 22 29 20 0a 20 regexp "csh") .
0d20: 20 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 09 ;; .....
0d30: 09 09 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d .. (get-environm
0d40: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 ent-variable "SH
0d50: 45 4c 4c 22 29 29 20 22 2e 63 73 68 22 20 22 2e ELL")) ".csh" ".
0d60: 73 68 22 29 29 29 29 0a 20 20 20 20 3b 3b 20 20 sh")))). ;;
0d70: 20 28 69 66 20 28 61 6e 64 20 70 72 65 76 73 74 (if (and prevst
0d80: 65 70 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ep (file-exists?
0d90: 20 70 72 65 76 2d 65 6e 76 29 29 0a 20 20 20 20 prev-env)).
0da0: 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 20 73 ;; (set! s
0db0: 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 72 69 cript (conc scri
0dc0: 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 72 65 pt "source " pre
0dd0: 76 2d 65 6e 76 29 29 29 29 0a 20 20 20 20 0a 20 v-env)))). .
0de0: 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 20 63 ;; call the c
0df0: 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d 74 5f ommand using mt_
0e00: 65 7a 73 74 65 70 0a 20 20 20 20 3b 3b 20 28 73 ezstep. ;; (s
0e10: 65 74 21 20 73 63 72 69 70 74 20 28 63 6f 6e 63 et! script (conc
0e20: 20 22 6d 74 5f 65 7a 73 74 65 70 20 22 20 73 74 "mt_ezstep " st
0e30: 65 70 6e 61 6d 65 20 22 20 22 20 28 69 66 20 70 epname " " (if p
0e40: 72 65 76 73 74 65 70 20 70 72 65 76 73 74 65 70 revstep prevstep
0e50: 20 22 78 22 29 20 22 20 22 20 73 74 65 70 63 6d "x") " " stepcm
0e60: 64 29 29 0a 20 20 20 20 0a 20 20 20 20 28 64 65 d)). . (de
0e70: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 73 63 72 bug:print 4 "scr
0e80: 69 70 74 3a 20 22 20 73 63 72 69 70 74 29 0a 20 ipt: " script).
0e90: 20 20 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 (rmt:teststep
0ea0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
0eb0: 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
0ec0: 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 2d 22 name "start" "-"
0ed0: 20 23 66 20 23 66 29 0a 20 20 20 20 3b 3b 20 6e #f #f). ;; n
0ee0: 6f 77 20 6c 61 75 6e 63 68 20 74 68 65 20 61 63 ow launch the ac
0ef0: 74 75 61 6c 20 70 72 6f 63 65 73 73 0a 20 20 20 tual process.
0f00: 20 28 63 61 6c 6c 2d 77 69 74 68 2d 65 6e 76 69 (call-with-envi
0f10: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
0f20: 73 20 0a 20 20 20 20 20 28 6c 69 73 74 20 28 63 s . (list (c
0f30: 6f 6e 73 20 22 50 41 54 48 22 20 28 63 6f 6e 63 ons "PATH" (conc
0f40: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
0f50: 74 2d 76 61 72 69 61 62 6c 65 20 22 50 41 54 48 t-variable "PATH
0f60: 22 29 20 22 3a 2e 22 29 29 29 0a 20 20 20 20 20 ") ":."))).
0f70: 28 6c 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 70 (lambda () ;; (p
0f80: 72 6f 63 65 73 73 2d 72 75 6e 20 22 2f 62 69 6e rocess-run "/bin
0f90: 2f 62 61 73 68 22 20 22 2d 63 22 20 22 65 78 65 /bash" "-c" "exe
0fa0: 63 20 6c 73 20 2d 6c 20 2f 74 6d 70 2f 66 6f 6f c ls -l /tmp/foo
0fb0: 62 61 72 20 3e 20 2f 74 6d 70 2f 64 65 6c 6d 65 bar > /tmp/delme
0fc0: 2d 6d 6f 72 65 2e 6c 6f 67 20 32 3e 26 31 22 29 -more.log 2>&1")
0fd0: 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 . (let* ((
0fe0: 63 6d 64 20 28 63 6f 6e 63 20 73 74 65 70 63 6d cmd (conc stepcm
0ff0: 64 20 22 20 3e 20 22 20 73 74 65 70 6e 61 6d 65 d " > " stepname
1000: 20 22 2e 6c 6f 67 20 32 3e 26 31 22 29 29 20 3b ".log 2>&1")) ;
1010: 3b 20 3e 6f 75 74 66 69 6c 65 20 32 3e 26 31 20 ; >outfile 2>&1
1020: 0a 09 20 20 20 20 20 20 28 70 69 64 20 28 70 72 .. (pid (pr
1030: 6f 63 65 73 73 2d 72 75 6e 20 22 2f 62 69 6e 2f ocess-run "/bin/
1040: 62 61 73 68 22 20 28 6c 69 73 74 20 22 2d 63 22 bash" (list "-c"
1050: 20 63 6d 64 29 29 29 29 0a 09 20 28 72 6d 74 3a cmd)))).. (rmt:
1060: 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f test-set-top-pro
1070: 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 cess-pid run-id
1080: 74 65 73 74 2d 69 64 20 70 69 64 29 0a 09 20 28 test-id pid).. (
1090: 6c 65 74 20 70 72 6f 63 65 73 73 6c 6f 6f 70 20 let processloop
10a0: 28 28 69 20 30 29 29 0a 09 20 20 20 28 6c 65 74 ((i 0)).. (let
10b0: 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 -values (((pid-v
10c0: 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 al exit-status e
10d0: 78 69 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 xit-code)(proces
10e0: 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 s-wait pid #t)))
10f0: 0a 09 09 20 20 20 20 20 20 20 28 6d 75 74 65 78 ... (mutex
1100: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 20 20 20 20 -lock! m)...
1110: 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d (launch:einf-
1120: 70 69 64 2d 73 65 74 21 20 20 20 20 20 20 20 20 pid-set!
1130: 20 65 78 69 74 2d 69 6e 66 6f 20 70 69 64 29 20 exit-info pid)
1140: 20 20 20 20 20 20 20 20 3b 3b 20 28 76 65 63 74 ;; (vect
1150: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
1160: 6f 20 30 20 70 69 64 29 0a 09 09 20 20 20 20 20 o 0 pid)...
1170: 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 (launch:einf-e
1180: 78 69 74 2d 73 74 61 74 75 73 2d 73 65 74 21 20 xit-status-set!
1190: 65 78 69 74 2d 69 6e 66 6f 20 65 78 69 74 2d 73 exit-info exit-s
11a0: 74 61 74 75 73 29 20 3b 3b 20 28 76 65 63 74 6f tatus) ;; (vecto
11b0: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
11c0: 20 31 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 1 exit-status).
11d0: 09 09 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 .. (launch
11e0: 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 2d :einf-exit-code-
11f0: 73 65 74 21 20 20 20 65 78 69 74 2d 69 6e 66 6f set! exit-info
1200: 20 65 78 69 74 2d 63 6f 64 65 29 20 20 20 3b 3b exit-code) ;;
1210: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
1220: 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 it-info 2 exit-c
1230: 6f 64 65 29 0a 09 09 20 20 20 20 20 20 20 28 6d ode)... (m
1240: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
1250: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 65 71 .. (if (eq
1260: 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 ? pid-val 0)....
1270: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 (begin....
1280: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
1290: 20 32 29 0a 09 09 09 20 20 20 20 20 28 70 72 6f 2).... (pro
12a0: 63 65 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 cessloop (+ i 1)
12b0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 29 29 29 )))... )))
12c0: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
12d0: 69 6e 74 2d 69 6e 66 6f 20 30 20 22 73 74 65 70 int-info 0 "step
12e0: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 63 6f " stepname " co
12f0: 6d 70 6c 65 74 65 64 20 77 69 74 68 20 65 78 69 mpleted with exi
1300: 74 20 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 t code " (launch
1310: 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 :einf-exit-code
1320: 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 28 exit-info)) ;; (
1330: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
1340: 69 6e 66 6f 20 32 29 29 0a 20 20 20 20 3b 3b 20 info 2)). ;;
1350: 6e 6f 77 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 now run logpro i
1360: 66 20 6e 65 65 64 65 64 0a 20 20 20 20 28 69 66 f needed. (if
1370: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 28 6c logpro-used..(l
1380: 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 et ((pid (proces
1390: 73 2d 72 75 6e 20 28 63 6f 6e 63 20 22 6c 6f 67 s-run (conc "log
13a0: 70 72 6f 20 22 20 6c 6f 67 70 72 6f 2d 66 69 6c pro " logpro-fil
13b0: 65 20 22 20 22 20 28 63 6f 6e 63 20 73 74 65 70 e " " (conc step
13c0: 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 20 name ".html") "
13d0: 3c 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c < " stepname ".l
13e0: 6f 67 22 29 29 29 29 0a 09 20 20 28 6c 65 74 20 og")))).. (let
13f0: 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 processloop ((i
1400: 30 29 29 0a 09 20 20 20 20 28 6c 65 74 2d 76 61 0)).. (let-va
1410: 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 lues (((pid-val
1420: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
1430: 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d 77 -code)(process-w
1440: 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 ait pid #t)))...
1450: 09 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 .(mutex-lock! m)
1460: 0a 09 09 09 3b 3b 20 28 6d 61 6b 65 2d 6c 61 75 ....;; (make-lau
1470: 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 70 69 nch:einf pid: pi
1480: 64 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 65 d exit-status: e
1490: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
14a0: 63 6f 64 65 3a 20 65 78 69 74 2d 63 6f 64 65 29 code: exit-code)
14b0: 0a 09 09 09 28 6c 61 75 6e 63 68 3a 65 69 6e 66 ....(launch:einf
14c0: 2d 70 69 64 2d 73 65 74 21 20 20 20 20 20 20 20 -pid-set!
14d0: 20 20 65 78 69 74 2d 69 6e 66 6f 20 70 69 64 29 exit-info pid)
14e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 76 65 63 ;; (vec
14f0: 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e tor-set! exit-in
1500: 66 6f 20 30 20 70 69 64 29 0a 09 09 09 28 6c 61 fo 0 pid)....(la
1510: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 unch:einf-exit-s
1520: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
1530: 69 6e 66 6f 20 65 78 69 74 2d 73 74 61 74 75 73 info exit-status
1540: 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 ) ;; (vector-set
1550: 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 ! exit-info 1 ex
1560: 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 28 6c it-status)....(l
1570: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
1580: 63 6f 64 65 2d 73 65 74 21 20 20 20 65 78 69 74 code-set! exit
1590: 2d 69 6e 66 6f 20 65 78 69 74 2d 63 6f 64 65 29 -info exit-code)
15a0: 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 ;; (vector-se
15b0: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 t! exit-info 2 e
15c0: 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 28 6d 75 xit-code)....(mu
15d0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
15e0: 09 09 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 ..(if (eq? pid-v
15f0: 61 6c 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 al 0).... (be
1600: 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 74 68 gin.... (th
1610: 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 read-sleep! 2)..
1620: 09 09 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 .. (process
1630: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 loop (+ i 1)))))
1640: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
1650: 6e 74 2d 69 6e 66 6f 20 30 20 22 6c 6f 67 70 72 nt-info 0 "logpr
1660: 6f 20 66 6f 72 20 73 74 65 70 20 22 20 73 74 65 o for step " ste
1670: 70 6e 61 6d 65 20 22 20 65 78 69 74 65 64 20 77 pname " exited w
1680: 69 74 68 20 63 6f 64 65 20 22 20 28 6c 61 75 6e ith code " (laun
1690: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 ch:einf-exit-cod
16a0: 65 20 65 78 69 74 2d 69 6e 66 6f 29 29 29 29 29 e exit-info)))))
16b0: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ;; (vector-ref
16c0: 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 29 29 29 exit-info 2)))))
16d0: 0a 20 20 20 20 0a 20 20 20 20 28 6c 65 74 20 28 . . (let (
16e0: 28 65 78 69 6e 66 6f 20 28 6c 61 75 6e 63 68 3a (exinfo (launch:
16f0: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 einf-exit-code e
1700: 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 28 76 xit-info)) ;; (v
1710: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
1720: 6e 66 6f 20 32 29 29 0a 09 20 20 28 6c 6f 67 66 nfo 2)).. (logf
1730: 6e 61 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 na (if logpro-us
1740: 65 64 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d ed (conc stepnam
1750: 65 20 22 2e 68 74 6d 6c 22 29 20 22 22 29 29 29 e ".html") "")))
1760: 0a 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 . (rmt:test
1770: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
1780: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
1790: 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 stepname "end" e
17a0: 78 69 6e 66 6f 20 23 66 20 6c 6f 67 66 6e 61 29 xinfo #f logfna)
17b0: 29 0a 20 20 20 20 28 69 66 20 6c 6f 67 70 72 6f ). (if logpro
17c0: 2d 75 73 65 64 0a 09 28 72 6d 74 3a 74 65 73 74 -used..(rmt:test
17d0: 2d 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 -set-log! run-id
17e0: 20 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 test-id (conc s
17f0: 74 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 tepname ".html")
1800: 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 74 68 )). ;; set th
1810: 65 20 74 65 73 74 20 66 69 6e 61 6c 20 73 74 61 e test final sta
1820: 74 75 73 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 tus. (let* ((
1830: 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 61 process-exit-sta
1840: 74 75 73 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 tus (launch:einf
1850: 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 69 74 2d -exit-code exit-
1860: 69 6e 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f info)) ;; (vecto
1870: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
1880: 32 29 29 0a 09 20 20 20 28 74 68 69 73 2d 73 74 2)).. (this-st
1890: 65 70 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a ep-status (cond.
18a0: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
18b0: 65 71 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 74 eq? process-exit
18c0: 2d 73 74 61 74 75 73 20 32 29 20 6c 6f 67 70 72 -status 2) logpr
18d0: 6f 2d 75 73 65 64 29 20 27 77 61 72 6e 29 20 20 o-used) 'warn)
18e0: 3b 3b 20 6c 6f 67 70 72 6f 20 32 20 3d 20 77 61 ;; logpro 2 = wa
18f0: 72 6e 69 6e 67 73 0a 09 09 09 20 20 20 20 20 20 rnings....
1900: 28 28 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 ((and (eq? proce
1910: 73 73 2d 65 78 69 74 2d 73 74 61 74 75 73 20 33 ss-exit-status 3
1920: 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 ) logpro-used) '
1930: 63 68 65 63 6b 29 20 3b 3b 20 6c 6f 67 70 72 6f check) ;; logpro
1940: 20 33 20 3d 20 63 68 65 63 6b 0a 09 09 09 20 20 3 = check....
1950: 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f 20 70 ((and (eq? p
1960: 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 rocess-exit-stat
1970: 75 73 20 34 29 20 6c 6f 67 70 72 6f 2d 75 73 65 us 4) logpro-use
1980: 64 29 20 27 77 61 69 76 65 64 29 20 3b 3b 20 6c d) 'waived) ;; l
1990: 6f 67 70 72 6f 20 34 20 3d 20 61 62 6f 72 74 09 ogpro 4 = abort.
19a0: 09 09 20 20 20 20 20 20 0a 09 09 09 20 20 20 20 .. ....
19b0: 20 20 28 28 61 6e 64 20 28 65 71 3f 20 70 72 6f ((and (eq? pro
19c0: 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 73 cess-exit-status
19d0: 20 35 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 5) logpro-used)
19e0: 20 27 61 62 6f 72 74 29 20 3b 3b 20 6c 6f 67 70 'abort) ;; logp
19f0: 72 6f 20 34 20 3d 20 61 62 6f 72 74 0a 09 09 09 ro 4 = abort....
1a00: 20 20 20 20 20 20 28 28 65 71 3f 20 70 72 6f 63 ((eq? proc
1a10: 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 73 20 ess-exit-status
1a20: 30 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0)
1a30: 20 20 20 20 20 27 70 61 73 73 29 20 20 3b 3b 20 'pass) ;;
1a40: 6c 6f 67 70 72 6f 20 30 20 3d 20 70 61 73 73 0a logpro 0 = pass.
1a50: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 27 ... (else '
1a60: 66 61 69 6c 29 29 29 0a 09 20 20 20 28 6f 76 65 fail))).. (ove
1a70: 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 rall-status (c
1a80: 6f 6e 64 0a 09 09 09 20 20 20 20 20 20 28 28 65 ond.... ((e
1a90: 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d q? (launch:einf-
1aa0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
1ab0: 69 74 2d 69 6e 66 6f 29 20 32 29 20 27 77 61 72 it-info) 2) 'war
1ac0: 6e 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 n) ;; rollup-sta
1ad0: 74 75 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 tus (vector-ref
1ae0: 65 78 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 exit-info 3)....
1af0: 20 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 ((eq? (lau
1b00: 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d nch:einf-rollup-
1b10: 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f status exit-info
1b20: 29 20 30 29 20 27 70 61 73 73 29 20 3b 3b 20 28 ) 0) 'pass) ;; (
1b30: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
1b40: 69 6e 66 6f 20 33 29 0a 09 09 09 20 20 20 20 20 info 3)....
1b50: 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a (else 'fail))).
1b60: 09 20 20 20 28 6e 65 78 74 2d 73 74 61 74 75 73 . (next-status
1b70: 20 20 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 (cond ....
1b80: 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 ((eq? over
1b90: 61 6c 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 all-status 'pass
1ba0: 29 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ) this-step-stat
1bb0: 75 73 29 0a 09 09 09 20 20 20 20 20 20 28 28 65 us).... ((e
1bc0: 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 q? overall-statu
1bd0: 73 20 27 77 61 72 6e 29 0a 09 09 09 20 20 20 20 s 'warn)....
1be0: 20 20 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 (if (eq? this
1bf0: 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 66 61 -step-status 'fa
1c00: 69 6c 29 20 27 66 61 69 6c 20 27 77 61 72 6e 29 il) 'fail 'warn)
1c10: 29 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f ).... ((eq?
1c20: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 overall-status
1c30: 27 61 62 6f 72 74 29 20 27 61 62 6f 72 74 29 0a 'abort) 'abort).
1c40: 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 27 ... (else '
1c50: 66 61 69 6c 29 29 29 0a 09 20 20 20 28 6e 65 78 fail))).. (nex
1c60: 74 2d 73 74 61 74 65 20 20 20 20 20 20 20 3b 3b t-state ;;
1c70: 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 57 "RUNNING") ;; W
1c80: 48 59 20 57 41 53 20 54 48 49 53 20 43 48 41 4e HY WAS THIS CHAN
1c90: 47 45 44 20 54 4f 20 4e 4f 54 20 55 53 45 20 28 GED TO NOT USE (
1ca0: 6e 75 6c 6c 3f 20 74 61 6c 29 20 3f 3f 0a 09 20 null? tal) ??..
1cb0: 20 20 20 28 63 6f 6e 64 0a 09 20 20 20 20 20 28 (cond.. (
1cc0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 20 3b 3b 20 6d (null? tal) ;; m
1cd0: 6f 72 65 20 74 6f 20 72 75 6e 3f 0a 09 20 20 20 ore to run?..
1ce0: 20 20 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a "COMPLETED").
1cf0: 09 20 20 20 20 20 28 65 6c 73 65 20 22 52 55 4e . (else "RUN
1d00: 4e 49 4e 47 22 29 29 29 0a 09 20 20 20 29 0a 20 NING"))).. ).
1d10: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
1d20: 74 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 20 t 4 "Exit value
1d30: 72 65 63 65 69 76 65 64 3a 20 22 20 28 6c 61 75 received: " (lau
1d40: 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f nch:einf-exit-co
1d50: 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 20 22 20 de exit-info) "
1d60: 6c 6f 67 70 72 6f 2d 75 73 65 64 3a 20 22 20 6c logpro-used: " l
1d70: 6f 67 70 72 6f 2d 75 73 65 64 20 0a 09 09 20 20 ogpro-used ...
1d80: 20 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 " this-step-sta
1d90: 74 75 73 3a 20 22 20 74 68 69 73 2d 73 74 65 70 tus: " this-step
1da0: 2d 73 74 61 74 75 73 20 22 20 6f 76 65 72 61 6c -status " overal
1db0: 6c 2d 73 74 61 74 75 73 3a 20 22 20 6f 76 65 72 l-status: " over
1dc0: 61 6c 6c 2d 73 74 61 74 75 73 20 0a 09 09 20 20 all-status ...
1dd0: 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 3a 20 " next-status:
1de0: 22 20 6e 65 78 74 2d 73 74 61 74 75 73 20 22 20 " next-status "
1df0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 22 rollup-status: "
1e00: 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 (launch:einf-r
1e10: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 ollup-status exi
1e20: 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 28 76 65 63 t-info)) ;; (vec
1e30: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
1e40: 6f 20 33 29 29 0a 20 20 20 20 20 20 28 63 61 73 o 3)). (cas
1e50: 65 20 6e 65 78 74 2d 73 74 61 74 75 73 0a 09 28 e next-status..(
1e60: 28 77 61 72 6e 29 0a 09 20 28 6c 61 75 6e 63 68 (warn).. (launch
1e70: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
1e80: 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d 69 6e tus-set! exit-in
1e90: 66 6f 20 32 29 20 3b 3b 20 28 76 65 63 74 6f 72 fo 2) ;; (vector
1ea0: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1eb0: 33 20 32 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 3 2) ;; rollup-s
1ec0: 74 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f 2f 20 tatus.. ;; NB//
1ed0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
1ee0: 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 20 does rdb calls
1ef0: 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 under the hood..
1f00: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
1f10: 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
1f20: 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 test-id next-sta
1f30: 74 65 20 22 57 41 52 4e 22 20 0a 09 09 09 09 20 te "WARN" .....
1f40: 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 (if (eq? this-st
1f50: 65 70 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 ep-status 'warn)
1f60: 20 22 4c 6f 67 70 72 6f 20 77 61 72 6e 69 6e 67 "Logpro warning
1f70: 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 found" #f).....
1f80: 20 23 66 29 29 0a 09 28 28 63 68 65 63 6b 29 0a #f))..((check).
1f90: 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 . (launch:einf-r
1fa0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 ollup-status-set
1fb0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 20 3b ! exit-info 3) ;
1fc0: 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 ; (vector-set! e
1fd0: 78 69 74 2d 69 6e 66 6f 20 33 20 33 29 20 3b 3b xit-info 3 3) ;;
1fe0: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a 09 rollup-status..
1ff0: 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 ;; NB// test-se
2000: 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 20 72 t-status! does r
2010: 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 db calls under t
2020: 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 73 74 73 he hood.. (tests
2030: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
2040: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
2050: 20 6e 65 78 74 2d 73 74 61 74 65 20 22 43 48 45 next-state "CHE
2060: 43 4b 22 20 0a 09 09 09 09 20 28 69 66 20 28 65 CK" ..... (if (e
2070: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
2080: 74 75 73 20 27 63 68 65 63 6b 29 20 22 4c 6f 67 tus 'check) "Log
2090: 70 72 6f 20 63 68 65 63 6b 20 66 6f 75 6e 64 22 pro check found"
20a0: 20 23 66 29 0a 09 09 09 09 20 23 66 29 29 0a 09 #f)..... #f))..
20b0: 28 28 61 62 6f 72 74 29 0a 09 20 28 6c 61 75 6e ((abort).. (laun
20c0: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
20d0: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
20e0: 69 6e 66 6f 20 34 29 20 3b 3b 20 28 76 65 63 74 info 4) ;; (vect
20f0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2100: 6f 20 33 20 34 29 20 3b 3b 20 72 6f 6c 6c 75 70 o 3 4) ;; rollup
2110: 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f -status.. ;; NB/
2120: 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 / test-set-statu
2130: 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c s! does rdb call
2140: 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 s under the hood
2150: 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 .. (tests:test-s
2160: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
2170: 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 d test-id next-s
2180: 74 61 74 65 20 22 41 42 4f 52 54 22 20 0a 09 09 tate "ABORT" ...
2190: 09 09 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 .. (if (eq? this
21a0: 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 61 62 -step-status 'ab
21b0: 6f 72 74 29 20 22 4c 6f 67 70 72 6f 20 61 62 6f ort) "Logpro abo
21c0: 72 74 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 rt found" #f)...
21d0: 09 09 20 23 66 29 29 0a 09 28 28 70 61 73 73 29 .. #f))..((pass)
21e0: 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 .. (tests:test-s
21f0: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
2200: 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 d test-id next-s
2210: 74 61 74 65 20 22 50 41 53 53 22 20 23 66 20 23 tate "PASS" #f #
2220: 66 29 29 0a 09 28 65 6c 73 65 20 3b 3b 20 27 66 f))..(else ;; 'f
2230: 61 69 6c 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 ail.. (launch:ei
2240: 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 nf-rollup-status
2250: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
2260: 31 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 1) ;; (vector-se
2270: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 31 t! exit-info 3 1
2280: 29 20 3b 3b 20 66 6f 72 63 65 20 66 61 69 6c 2c ) ;; force fail,
2290: 20 74 68 69 73 20 75 73 65 64 20 74 6f 20 62 65 this used to be
22a0: 20 6e 65 78 74 2d 73 74 61 74 65 20 62 75 74 20 next-state but
22b0: 74 68 61 74 20 64 6f 65 73 6e 27 74 20 6d 61 6b that doesn't mak
22c0: 65 20 73 65 6e 73 65 2e 20 73 68 6f 75 6c 64 20 e sense. should
22d0: 61 6c 77 61 79 73 20 62 65 20 22 43 4f 4d 50 4c always be "COMPL
22e0: 45 54 45 44 22 20 0a 09 20 28 74 65 73 74 73 3a ETED" .. (tests:
22f0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
2300: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
2310: 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 46 41 49 "COMPLETED" "FAI
2320: 4c 22 20 28 63 6f 6e 63 20 22 46 61 69 6c 65 64 L" (conc "Failed
2330: 20 61 74 20 73 74 65 70 20 22 20 73 74 65 70 6e at step " stepn
2340: 61 6d 65 29 20 23 66 29 0a 09 20 29 29 29 0a 20 ame) #f).. ))).
2350: 20 20 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 29 logpro-used))
2360: 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ..(define (launc
2370: 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 65 h:execute encode
2380: 64 2d 63 6d 64 29 0a 20 20 0a 20 20 20 28 6c 65 d-cmd). . (le
2390: 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 20 t* ((cmdinfo
23a0: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
23b0: 6f 64 65 64 2d 73 74 72 69 6e 67 20 65 6e 63 6f oded-string enco
23c0: 64 65 64 2d 63 6d 64 29 29 0a 09 20 20 28 74 63 ded-cmd)).. (tc
23d0: 6f 6e 66 69 67 72 65 67 20 28 74 65 73 74 73 3a onfigreg (tests:
23e0: 67 65 74 2d 61 6c 6c 29 29 29 0a 20 20 20 20 28 get-all))). (
23f0: 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e setenv "MT_CMDIN
2400: 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 FO" encoded-cmd)
2410: 0a 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f 20 . (if (list?
2420: 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 28 28 74 65 cmdinfo) ;; ((te
2430: 73 74 70 61 74 68 20 2f 74 6d 70 2f 6d 72 77 65 stpath /tmp/mrwe
2440: 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 llan/jazzmind/sr
2450: 63 2f 65 78 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 c/example_run/te
2460: 73 74 73 2f 73 71 6c 69 74 65 73 70 65 65 64 29 sts/sqlitespeed)
2470: 0a 09 3b 3b 20 28 74 65 73 74 2d 6e 61 6d 65 20 ..;; (test-name
2480: 73 71 6c 69 74 65 73 70 65 65 64 29 20 28 72 75 sqlitespeed) (ru
2490: 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 nscript runscrip
24a0: 74 2e 72 62 29 20 28 64 62 2d 68 6f 73 74 20 6c t.rb) (db-host l
24b0: 6f 63 61 6c 68 6f 73 74 29 20 28 72 75 6e 2d 69 ocalhost) (run-i
24c0: 64 20 31 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 d 1))..(let* ((t
24d0: 65 73 74 70 61 74 68 20 20 28 61 73 73 6f 63 2f estpath (assoc/
24e0: 64 65 66 61 75 6c 74 20 27 74 65 73 74 70 61 74 default 'testpat
24f0: 68 20 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b 3b h cmdinfo)) ;;
2500: 20 74 65 73 74 70 61 74 68 20 69 73 20 74 68 65 testpath is the
2510: 20 74 65 73 74 20 73 70 65 63 20 61 72 65 61 0a test spec area.
2520: 09 20 20 20 20 20 20 20 28 74 6f 70 2d 70 61 74 . (top-pat
2530: 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c h (assoc/defaul
2540: 74 20 27 74 6f 70 70 61 74 68 20 20 20 63 6d 64 t 'toppath cmd
2550: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
2560: 77 6f 72 6b 2d 61 72 65 61 20 28 61 73 73 6f 63 work-area (assoc
2570: 2f 64 65 66 61 75 6c 74 20 27 77 6f 72 6b 2d 61 /default 'work-a
2580: 72 65 61 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b rea cmdinfo)) ;
2590: 3b 20 77 6f 72 6b 2d 61 72 65 61 20 69 73 20 74 ; work-area is t
25a0: 68 65 20 74 65 73 74 20 72 75 6e 20 61 72 65 61 he test run area
25b0: 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d 6e .. (test-n
25c0: 61 6d 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ame (assoc/defau
25d0: 6c 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 63 6d lt 'test-name cm
25e0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
25f0: 28 72 75 6e 73 63 72 69 70 74 20 28 61 73 73 6f (runscript (asso
2600: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 73 63 c/default 'runsc
2610: 72 69 70 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 ript cmdinfo))..
2620: 20 20 20 20 20 20 20 28 65 7a 73 74 65 70 73 20 (ezsteps
2630: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
2640: 20 27 65 7a 73 74 65 70 73 20 20 20 63 6d 64 69 'ezsteps cmdi
2650: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 3b 3b nfo)).. ;;
2660: 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 (runremote (ass
2670: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 oc/default 'runr
2680: 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a emote cmdinfo)).
2690: 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 6f . (transpo
26a0: 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c rt (assoc/defaul
26b0: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 t 'transport cmd
26c0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 3b info)).. ;
26d0: 3b 20 28 73 65 72 76 65 72 69 6e 66 20 28 61 73 ; (serverinf (as
26e0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 73 65 72 soc/default 'ser
26f0: 76 65 72 69 6e 66 20 63 6d 64 69 6e 66 6f 29 29 verinf cmdinfo))
2700: 0a 09 20 20 20 20 20 20 20 28 70 6f 72 74 20 20 .. (port
2710: 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 (assoc/defau
2720: 6c 74 20 27 70 6f 72 74 20 20 20 20 20 20 63 6d lt 'port cm
2730: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
2740: 28 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f (run-id (asso
2750: 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 c/default 'run-i
2760: 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 d cmdinfo))..
2770: 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 (test-id
2780: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
2790: 20 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 'test-id cmdi
27a0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
27b0: 61 72 67 65 74 20 20 20 20 28 61 73 73 6f 63 2f arget (assoc/
27c0: 64 65 66 61 75 6c 74 20 27 74 61 72 67 65 74 20 default 'target
27d0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
27e0: 20 20 20 20 20 28 69 74 65 6d 64 61 74 20 20 20 (itemdat
27f0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
2800: 69 74 65 6d 64 61 74 20 20 20 63 6d 64 69 6e 66 itemdat cmdinf
2810: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 65 6e 76 o)).. (env
2820: 2d 6f 76 72 64 20 20 28 61 73 73 6f 63 2f 64 65 -ovrd (assoc/de
2830: 66 61 75 6c 74 20 27 65 6e 76 2d 6f 76 72 64 20 fault 'env-ovrd
2840: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
2850: 20 20 20 28 73 65 74 2d 76 61 72 73 20 20 28 61 (set-vars (a
2860: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 73 65 ssoc/default 'se
2870: 74 2d 76 61 72 73 20 20 63 6d 64 69 6e 66 6f 29 t-vars cmdinfo)
2880: 29 20 3b 3b 20 70 72 65 2d 6f 76 65 72 72 69 64 ) ;; pre-overrid
2890: 65 73 20 66 72 6f 6d 20 2d 73 65 74 76 61 72 0a es from -setvar.
28a0: 09 20 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 . (runname
28b0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
28c0: 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 63 6d 64 t 'runname cmd
28d0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
28e0: 6d 65 67 61 74 65 73 74 20 20 28 61 73 73 6f 63 megatest (assoc
28f0: 2f 64 65 66 61 75 6c 74 20 27 6d 65 67 61 74 65 /default 'megate
2900: 73 74 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 st cmdinfo))..
2910: 20 20 20 20 20 20 28 72 75 6e 74 6c 69 6d 20 20 (runtlim
2920: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
2930: 27 72 75 6e 74 6c 69 6d 20 20 20 63 6d 64 69 6e 'runtlim cmdin
2940: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 fo)).. (it
2950: 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 em-path (item-li
2960: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
2970: 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 2d 62 )).. (mt-b
2980: 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 73 6f indir-path (asso
2990: 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 c/default 'mt-bi
29a0: 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 ndir-path cmdinf
29b0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6b 65 79 o)).. (key
29c0: 73 20 20 20 20 20 20 23 66 29 0a 09 20 20 20 20 s #f)..
29d0: 20 20 20 28 6b 65 79 76 61 6c 73 20 20 20 23 66 (keyvals #f
29e0: 29 0a 09 20 20 20 20 20 20 20 28 66 75 6c 6c 72 ).. (fullr
29f0: 75 6e 73 63 72 69 70 74 20 28 69 66 20 28 6e 6f unscript (if (no
2a00: 74 20 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 t runscript).
2a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
2a30: 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 f.
2a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a50: 20 20 20 20 28 69 66 20 28 73 75 62 73 74 72 69 (if (substri
2a60: 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 72 75 6e ng-index "/" run
2a70: 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 20 20 script).
2a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 ru
2aa0: 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 65 20 75 nscript ;; use u
2ab0: 6e 61 64 75 6c 74 65 72 65 64 20 69 66 20 63 6f nadultered if co
2ac0: 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 73 0a 20 ntains slashes.
2ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 20 20 28 6c 65 74 20 28 28 66 75 6c 6c (let ((full
2b00: 6e 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 68 n (conc testpath
2b10: 20 22 2f 22 20 72 75 6e 73 63 72 69 70 74 29 29 "/" runscript))
2b20: 29 0a 09 20 20 20 20 20 20 20 20 20 20 20 20 20 )..
2b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b40: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 66 (if (and (f
2b50: 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c ile-exists? full
2b60: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
2b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b90: 20 20 20 20 20 20 28 66 69 6c 65 2d 65 78 65 63 (file-exec
2ba0: 75 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c ute-access? full
2bb0: 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 n)).
2bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2be0: 20 20 66 75 6c 6c 6e 0a 20 20 20 20 20 20 20 20 fulln.
2bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c10: 20 20 20 20 20 20 72 75 6e 73 63 72 69 70 74 29 runscript)
2c20: 29 29 29 29 20 3b 3b 20 61 73 73 75 6d 65 20 69 )))) ;; assume i
2c30: 74 20 69 73 20 6f 6e 20 74 68 65 20 70 61 74 68 t is on the path
2c40: 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 6f 6c .. ;; (rol
2c50: 6c 75 70 2d 73 74 61 74 75 73 20 30 29 0a 09 20 lup-status 0)..
2c60: 20 20 20 20 20 20 29 0a 0a 09 20 20 3b 3b 20 4e )... ;; N
2c70: 46 53 20 6d 69 67 68 74 20 6e 6f 74 20 68 61 76 FS might not hav
2c80: 65 20 70 72 6f 70 61 67 61 74 65 64 20 74 68 65 e propagated the
2c90: 20 64 69 72 65 63 74 6f 72 79 20 6d 65 74 61 20 directory meta
2ca0: 64 61 74 61 20 74 6f 20 74 68 65 20 72 75 6e 20 data to the run
2cb0: 68 6f 73 74 20 2d 20 67 69 76 65 20 69 74 20 74 host - give it t
2cc0: 69 6d 65 20 69 66 20 6e 65 65 64 65 64 0a 09 20 ime if needed..
2cd0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 (let loop ((cou
2ce0: 6e 74 20 30 29 29 0a 09 20 20 20 20 28 69 66 20 nt 0)).. (if
2cf0: 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 74 73 (or (file-exists
2d00: 3f 20 74 6f 70 2d 70 61 74 68 29 0a 09 09 20 20 ? top-path)...
2d10: 20 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a (> count 10)).
2d20: 09 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ..(change-direct
2d30: 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a 09 09 ory top-path)...
2d40: 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 (begin... (debu
2d50: 67 3a 70 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a g:print 0 "INFO:
2d60: 20 4e 6f 74 20 73 74 61 72 74 69 6e 67 20 6a 6f Not starting jo
2d70: 62 20 79 65 74 20 2d 20 64 69 72 65 63 74 6f 72 b yet - director
2d80: 79 20 22 20 74 6f 70 2d 70 61 74 68 20 22 20 6e y " top-path " n
2d90: 6f 74 20 66 6f 75 6e 64 22 29 0a 09 09 20 20 28 ot found")... (
2da0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 30 thread-sleep! 10
2db0: 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 63 )... (loop (+ c
2dc0: 6f 75 6e 74 20 31 29 29 29 29 29 0a 0a 09 20 20 ount 1)))))...
2dd0: 28 6c 65 74 20 28 28 73 69 67 68 61 6e 64 20 28 (let ((sighand (
2de0: 6c 61 6d 62 64 61 20 28 73 69 67 6e 75 6d 29 0a lambda (signum).
2df0: 09 09 09 20 20 20 3b 3b 20 28 73 69 67 6e 61 6c ... ;; (signal
2e00: 2d 6d 61 73 6b 21 20 73 69 67 6e 75 6d 29 20 3b -mask! signum) ;
2e10: 3b 20 74 6f 20 6d 61 73 6b 20 6f 72 20 6e 6f 74 ; to mask or not
2e20: 3f 20 73 65 65 6d 73 20 74 6f 20 63 61 75 73 65 ? seems to cause
2e30: 20 69 73 73 75 65 73 20 69 6e 20 65 78 69 74 69 issues in exiti
2e40: 6e 67 0a 09 09 09 20 20 20 28 69 66 20 28 65 71 ng.... (if (eq
2e50: 3f 20 73 69 67 6e 75 6d 20 73 69 67 6e 61 6c 2f ? signum signal/
2e60: 73 74 6f 70 29 0a 09 09 09 20 28 64 65 62 75 67 stop).... (debug
2e70: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
2e80: 20 61 74 74 65 6d 70 74 20 74 6f 20 53 54 4f 50 attempt to STOP
2e90: 20 70 72 6f 63 65 73 73 2e 20 45 78 69 74 69 6e process. Exitin
2ea0: 67 2e 22 29 29 0a 09 09 09 20 20 20 28 73 65 74 g.")).... (set
2eb0: 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a ! *time-to-exit*
2ec0: 20 23 74 29 0a 09 09 09 20 20 20 28 70 72 69 6e #t).... (prin
2ed0: 74 20 22 52 65 63 65 69 76 65 64 20 73 69 67 6e t "Received sign
2ee0: 61 6c 20 22 20 73 69 67 6e 75 6d 20 22 2c 20 63 al " signum ", c
2ef0: 6c 65 61 6e 69 6e 67 20 75 70 20 62 65 66 6f 72 leaning up befor
2f00: 65 20 65 78 69 74 2e 20 50 6c 65 61 73 65 20 77 e exit. Please w
2f10: 61 69 74 2e 2e 2e 22 29 0a 09 09 09 20 20 20 28 ait...").... (
2f20: 6c 65 74 20 28 28 74 68 31 20 28 6d 61 6b 65 2d let ((th1 (make-
2f30: 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 thread (lambda (
2f40: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 74 65 )....... (te
2f50: 73 74 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 sts:test-force-s
2f60: 74 61 74 65 2d 73 74 61 74 75 73 21 20 72 75 6e tate-status! run
2f70: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 49 4e 43 -id test-id "INC
2f80: 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c 45 44 OMPLETE" "KILLED
2f90: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 70 ")....... (p
2fa0: 72 69 6e 74 20 22 4b 69 6c 6c 65 64 20 62 79 20 rint "Killed by
2fb0: 73 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 signal " signum
2fc0: 22 2e 20 45 78 69 74 69 6e 67 22 29 0a 09 09 09 ". Exiting")....
2fd0: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
2fe0: 73 6c 65 65 70 21 20 31 29 0a 09 09 09 09 09 09 sleep! 1).......
2ff0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 29 29 (exit 1))))
3000: 0a 09 09 09 09 20 28 74 68 32 20 28 6d 61 6b 65 ..... (th2 (make
3010: 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 -thread (lambda
3020: 28 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 74 ()....... (t
3030: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
3040: 09 09 09 09 09 09 20 20 20 20 20 28 64 65 62 75 ...... (debu
3050: 67 3a 70 72 69 6e 74 20 30 20 22 44 6f 6e 65 22 g:print 0 "Done"
3060: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 78 )....... (ex
3070: 69 74 20 34 29 29 29 29 29 0a 09 09 09 20 20 20 it 4)))))....
3080: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
3090: 20 74 68 32 29 0a 09 09 09 20 20 20 20 20 28 74 th2).... (t
30a0: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 hread-start! th1
30b0: 29 0a 09 09 09 20 20 20 20 20 28 74 68 72 65 61 ).... (threa
30c0: 64 2d 6a 6f 69 6e 21 20 74 68 32 29 29 29 29 29 d-join! th2)))))
30d0: 0a 09 20 20 20 20 28 73 65 74 2d 73 69 67 6e 61 .. (set-signa
30e0: 6c 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 l-handler! signa
30f0: 6c 2f 69 6e 74 20 73 69 67 68 61 6e 64 29 0a 09 l/int sighand)..
3100: 20 20 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d (set-signal-
3110: 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f handler! signal/
3120: 74 65 72 6d 20 73 69 67 68 61 6e 64 29 0a 09 20 term sighand)..
3130: 20 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 (set-signal-h
3140: 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 73 andler! signal/s
3150: 74 6f 70 20 73 69 67 68 61 6e 64 29 29 0a 09 20 top sighand))..
3160: 20 0a 09 20 20 3b 3b 20 28 73 65 74 2d 73 69 67 .. ;; (set-sig
3170: 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 nal-handler! sig
3180: 6e 61 6c 2f 69 6e 74 20 28 6c 61 6d 62 64 61 20 nal/int (lambda
3190: 28 29 0a 09 09 09 09 09 20 20 20 20 0a 09 20 20 ()...... ..
31a0: 3b 3b 20 44 6f 20 6e 6f 74 20 72 75 6e 20 74 68 ;; Do not run th
31b0: 65 20 74 65 73 74 20 69 66 20 69 74 20 69 73 20 e test if it is
31c0: 52 45 4d 4f 56 49 4e 47 2c 20 52 55 4e 4e 49 4e REMOVING, RUNNIN
31d0: 47 2c 20 4b 49 4c 4c 52 45 51 20 6f 72 20 52 45 G, KILLREQ or RE
31e0: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 2c 0a 09 MOTEHOSTSTART,..
31f0: 20 20 3b 3b 20 4d 61 72 6b 20 74 68 65 20 74 65 ;; Mark the te
3200: 73 74 20 61 73 20 52 45 4d 4f 54 45 48 4f 53 54 st as REMOTEHOST
3210: 53 54 41 52 54 20 2a 49 4d 4d 45 44 49 41 54 45 START *IMMEDIATE
3220: 4c 59 2a 0a 09 20 20 3b 3b 0a 09 20 20 28 6c 65 LY*.. ;;.. (le
3230: 74 20 28 28 74 65 73 74 2d 69 6e 66 6f 20 28 72 t ((test-info (r
3240: 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d mt:get-testinfo-
3250: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
3260: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a 09 -id test-id)))..
3270: 20 20 20 20 28 63 6f 6e 64 0a 09 20 20 20 20 20 (cond..
3280: 28 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 ((member (db:tes
3290: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test
32a0: 2d 69 6e 66 6f 29 20 27 28 22 49 4e 43 4f 4d 50 -info) '("INCOMP
32b0: 4c 45 54 45 22 20 22 4b 49 4c 4c 45 44 22 20 22 LETE" "KILLED" "
32c0: 55 4e 4b 4e 4f 57 4e 22 20 22 4b 49 4c 4c 52 45 UNKNOWN" "KILLRE
32d0: 51 22 20 22 53 54 55 43 4b 22 29 29 20 3b 3b 20 Q" "STUCK")) ;;
32e0: 70 72 69 6f 72 20 72 75 6e 20 6f 66 20 74 68 69 prior run of thi
32f0: 73 20 74 65 73 74 20 64 69 64 6e 27 74 20 63 6f s test didn't co
3300: 6d 70 6c 65 74 65 2c 20 67 6f 20 61 68 65 61 64 mplete, go ahead
3310: 20 61 6e 64 20 74 72 79 20 74 6f 20 72 65 72 75 and try to reru
3320: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
3330: 70 72 69 6e 74 20 30 20 22 49 4e 46 4f 3a 20 74 print 0 "INFO: t
3340: 65 73 74 20 69 73 20 49 4e 43 4f 4d 50 4c 45 54 est is INCOMPLET
3350: 45 20 6f 72 20 4b 49 4c 4c 45 44 2c 20 74 72 65 E or KILLED, tre
3360: 61 74 20 74 68 69 73 20 65 78 65 63 75 74 65 20 at this execute
3370: 63 61 6c 6c 20 61 73 20 61 20 72 65 72 75 6e 20 call as a rerun
3380: 72 65 71 75 65 73 74 22 29 0a 09 20 20 20 20 20 request")..
3390: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 (tests:test-for
33a0: 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 ce-state-status!
33b0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
33c0: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
33d0: 22 20 22 6e 2f 61 22 29 29 20 3b 3b 20 70 72 69 " "n/a")) ;; pri
33e0: 6d 65 20 69 74 20 66 6f 72 20 72 75 6e 6e 69 6e me it for runnin
33f0: 67 0a 09 20 20 20 20 20 28 28 6e 6f 74 20 28 6d g.. ((not (m
3400: 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d 67 ember (db:test-g
3410: 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e et-state test-in
3420: 66 6f 29 20 27 28 22 52 45 4d 4f 56 49 4e 47 22 fo) '("REMOVING"
3430: 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 "REMOTEHOSTSTAR
3440: 54 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 4b 49 T" "RUNNING" "KI
3450: 4c 4c 52 45 51 22 29 29 29 0a 09 20 20 20 20 20 LLREQ")))..
3460: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 (tests:test-for
3470: 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 ce-state-status!
3480: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
3490: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
34a0: 22 20 22 6e 2f 61 22 29 29 0a 09 20 20 20 20 20 " "n/a"))..
34b0: 28 65 6c 73 65 20 3b 3b 20 28 6d 65 6d 62 65 72 (else ;; (member
34c0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
34d0: 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 ate test-info) '
34e0: 28 22 52 45 4d 4f 56 49 4e 47 22 20 22 52 45 4d ("REMOVING" "REM
34f0: 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 52 OTEHOSTSTART" "R
3500: 55 4e 4e 49 4e 47 22 20 22 4b 49 4c 4c 52 45 51 UNNING" "KILLREQ
3510: 22 29 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 ")).. (debu
3520: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
3530: 3a 20 74 65 73 74 20 73 74 61 74 65 20 69 73 20 : test state is
3540: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 " (db:test-get-s
3550: 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 tate test-info)
3560: 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f 63 65 65 ", cannot procee
3570: 64 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 d").. (exit
3580: 29 29 29 29 0a 09 20 20 0a 09 20 20 28 64 65 62 )))).. .. (deb
3590: 75 67 3a 70 72 69 6e 74 20 32 20 22 45 78 65 63 ug:print 2 "Exec
35a0: 74 75 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d tuing " test-nam
35b0: 65 20 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d e " (id: " test-
35c0: 69 64 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d id ") on " (get-
35d0: 68 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 28 host-name)).. (
35e0: 73 65 74 21 20 6b 65 79 73 20 20 20 20 20 20 20 set! keys
35f0: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a (rmt:get-keys)).
3600: 09 20 20 3b 3b 20 28 72 75 6e 73 3a 73 65 74 2d . ;; (runs:set-
3610: 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 megatest-env-var
3620: 73 20 72 75 6e 2d 69 64 20 69 6e 6b 65 79 73 3a s run-id inkeys:
3630: 20 6b 65 79 73 20 69 6e 6b 65 79 76 61 6c 73 3a keys inkeyvals:
3640: 20 6b 65 79 76 61 6c 73 29 20 3b 3b 20 74 68 65 keyvals) ;; the
3650: 73 65 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 se may be needed
3660: 20 62 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e by the launchin
3670: 67 20 70 72 6f 63 65 73 73 0a 09 20 20 3b 3b 20 g process.. ;;
3680: 6f 6e 65 20 6f 66 20 74 68 65 73 65 20 69 73 20 one of these is
3690: 64 65 66 75 6e 63 74 2f 72 65 64 75 6e 64 61 6e defunct/redundan
36a0: 74 20 2e 2e 2e 0a 09 20 20 28 69 66 20 28 6e 6f t ..... (if (no
36b0: 74 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d t (launch:setup-
36c0: 66 6f 72 2d 72 75 6e 20 66 6f 72 63 65 3a 20 23 for-run force: #
36d0: 74 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 t)).. (begi
36e0: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
36f0: 20 30 20 22 46 61 69 6c 65 64 20 74 6f 20 73 65 0 "Failed to se
3700: 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 0a tup, exiting") .
3710: 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 ..;; (sqlite3:fi
3720: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 3b 3b nalize! db)...;;
3730: 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 (sqlite3:finali
3740: 7a 65 21 20 74 64 62 29 0a 09 09 28 65 78 69 74 ze! tdb)...(exit
3750: 20 31 29 29 29 0a 09 20 20 28 63 68 61 6e 67 65 1))).. (change
3760: 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 -directory *topp
3770: 61 74 68 2a 29 20 0a 0a 09 20 20 3b 3b 20 4e 4f ath*) ... ;; NO
3780: 54 45 3a 20 43 75 72 72 65 6e 74 20 6f 72 64 65 TE: Current orde
3790: 72 20 69 73 20 74 6f 20 70 72 6f 63 65 73 73 20 r is to process
37a0: 72 75 6e 63 6f 6e 66 69 67 73 20 2a 62 65 66 6f runconfigs *befo
37b0: 72 65 2a 20 73 65 74 74 69 6e 67 20 74 68 65 20 re* setting the
37c0: 4d 54 5f 20 76 61 72 73 2e 20 54 68 69 73 20 0a MT_ vars. This .
37d0: 09 20 20 3b 3b 20 20 20 20 20 20 20 73 65 65 6d . ;; seem
37e0: 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 62 75 74 20 s non-ideal but
37f0: 63 6f 75 6c 64 20 77 65 6c 6c 20 62 72 65 61 6b could well break
3800: 20 73 74 75 66 66 0a 09 20 20 3b 3b 20 20 20 20 stuff.. ;;
3810: 42 55 47 3f 20 42 55 47 3f 20 42 55 47 3f 0a 0a BUG? BUG? BUG?..
3820: 09 20 20 28 6c 65 74 20 28 28 72 63 6f 6e 66 69 . (let ((rconfi
3830: 67 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 g (full-runconfi
3840: 67 73 2d 72 65 61 64 29 29 29 20 3b 3b 20 28 72 gs-read))) ;; (r
3850: 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 ead-config (conc
3860: 20 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 *toppath* "/ru
3870: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
3880: 29 20 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 ) #f #t sections
3890: 3a 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 : (list "default
38a0: 22 20 74 61 72 67 65 74 29 29 29 29 0a 09 20 20 " target))))..
38b0: 20 20 3b 3b 20 28 73 65 74 75 70 2d 65 6e 76 2d ;; (setup-env-
38c0: 64 65 66 61 75 6c 74 73 20 28 63 6f 6e 63 20 2a defaults (conc *
38d0: 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f toppath* "/runco
38e0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 72 nfigs.config") r
38f0: 75 6e 2d 69 64 20 28 6d 61 6b 65 2d 68 61 73 68 un-id (make-hash
3900: 2d 74 61 62 6c 65 29 20 6b 65 79 76 61 6c 73 20 -table) keyvals
3910: 74 61 72 67 65 74 29 0a 09 20 20 20 20 3b 3b 20 target).. ;;
3920: 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d (set-run-config-
3930: 76 61 72 73 20 72 75 6e 2d 69 64 20 6b 65 79 76 vars run-id keyv
3940: 61 6c 73 20 74 61 72 67 65 74 29 20 3b 3b 20 28 als target) ;; (
3950: 64 62 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 db:get-target db
3960: 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 3b run-id)).. ;
3970: 3b 20 4e 6f 77 20 68 61 76 65 20 72 75 6e 63 6f ; Now have runco
3980: 6e 66 69 67 73 20 64 61 74 61 20 6c 6f 61 64 65 nfigs data loade
3990: 64 2c 20 73 65 74 20 65 6e 76 69 72 6f 6e 6d 65 d, set environme
39a0: 6e 74 20 76 61 72 73 0a 09 20 20 20 20 28 66 6f nt vars.. (fo
39b0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
39c0: 73 65 63 74 69 6f 6e 29 0a 09 09 09 28 66 6f 72 section)....(for
39d0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 76 -each (lambda (v
39e0: 61 72 76 61 6c 29 0a 09 09 09 09 20 20 20 20 28 arval)..... (
39f0: 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 76 let ((var (car v
3a00: 61 72 76 61 6c 29 29 0a 09 09 09 09 09 20 20 28 arval))...... (
3a10: 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 6c val (cadr varval
3a20: 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 )))..... (i
3a30: 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 f (and (string?
3a40: 76 61 72 29 28 73 74 72 69 6e 67 3f 20 76 61 6c var)(string? val
3a50: 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 69 6e ))...... (begin
3a60: 0a 09 09 09 09 09 20 20 20 20 28 73 65 74 65 6e ...... (seten
3a70: 76 20 76 61 72 20 28 63 6f 6e 66 69 67 3a 65 76 v var (config:ev
3a80: 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 al-string-in-env
3a90: 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 29 29 20 ironment val)))
3aa0: 3b 3b 20 76 61 6c 29 0a 09 09 09 09 09 20 20 28 ;; val)...... (
3ab0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
3ac0: 52 52 4f 52 3a 20 62 61 64 20 76 61 72 69 61 62 RROR: bad variab
3ad0: 6c 65 20 73 70 65 63 2c 20 22 20 76 61 72 20 22 le spec, " var "
3ae0: 3d 22 20 76 61 6c 29 29 29 29 0a 09 09 09 09 20 =" val)))).....
3af0: 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 (configf:get-se
3b00: 63 74 69 6f 6e 20 72 63 6f 6e 66 69 67 20 73 65 ction rconfig se
3b10: 63 74 69 6f 6e 29 29 29 0a 09 09 20 20 20 20 20 ction)))...
3b20: 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 (list "default"
3b30: 20 74 61 72 67 65 74 29 29 29 0a 0a 09 20 20 3b target)))... ;
3b40: 3b 20 4e 46 53 20 6d 69 67 68 74 20 6e 6f 74 20 ; NFS might not
3b50: 68 61 76 65 20 70 72 6f 70 61 67 61 74 65 64 20 have propagated
3b60: 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 6d 65 the directory me
3b70: 74 61 20 64 61 74 61 20 74 6f 20 74 68 65 20 72 ta data to the r
3b80: 75 6e 20 68 6f 73 74 20 2d 20 67 69 76 65 20 69 un host - give i
3b90: 74 20 74 69 6d 65 20 69 66 20 6e 65 65 64 65 64 t time if needed
3ba0: 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 .. (let loop ((
3bb0: 63 6f 75 6e 74 20 30 29 29 0a 09 20 20 20 20 28 count 0)).. (
3bc0: 69 66 20 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 if (or (file-exi
3bd0: 73 74 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a sts? work-area).
3be0: 09 09 20 20 20 20 28 3e 20 63 6f 75 6e 74 20 31 .. (> count 1
3bf0: 30 29 29 0a 09 09 28 63 68 61 6e 67 65 2d 64 69 0))...(change-di
3c00: 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are
3c10: 61 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 a)...(begin...
3c20: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
3c30: 49 4e 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 69 INFO: Not starti
3c40: 6e 67 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 72 ng job yet - dir
3c50: 65 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 ectory " work-ar
3c60: 65 61 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 ea " not found")
3c70: 0a 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 ... (thread-sle
3c80: 65 70 21 20 31 30 29 0a 09 09 20 20 28 6c 6f 6f ep! 10)... (loo
3c90: 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 p (+ count 1))))
3ca0: 29 0a 0a 09 20 20 3b 3b 20 28 63 68 61 6e 67 65 )... ;; (change
3cb0: 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d -directory work-
3cc0: 61 72 65 61 29 20 0a 09 20 20 28 73 65 74 21 20 area) .. (set!
3cd0: 6b 65 79 76 61 6c 73 20 20 20 20 28 6b 65 79 73 keyvals (keys
3ce0: 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 :target->keyval
3cf0: 6b 65 79 73 20 74 61 72 67 65 74 29 29 0a 09 20 keys target))..
3d00: 20 3b 3b 20 61 70 70 6c 79 20 70 72 65 2d 6f 76 ;; apply pre-ov
3d10: 65 72 72 69 64 65 73 20 62 65 66 6f 72 65 20 6f errides before o
3d20: 74 68 65 72 20 76 61 72 69 61 62 6c 65 73 2e 20 ther variables.
3d30: 54 68 65 20 70 72 65 2d 6f 76 65 72 72 69 64 65 The pre-override
3d40: 20 76 61 72 73 20 6d 75 73 74 20 6e 6f 74 0a 09 vars must not..
3d50: 20 20 3b 3b 20 63 6c 6f 62 62 65 72 73 20 74 68 ;; clobbers th
3d60: 69 6e 67 73 20 66 72 6f 6d 20 74 68 65 20 6f 66 ings from the of
3d70: 66 69 63 69 61 6c 20 73 6f 75 72 63 65 73 20 73 ficial sources s
3d80: 75 63 68 20 61 73 20 6d 65 67 61 74 65 73 74 2e uch as megatest.
3d90: 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 6f config and runco
3da0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 09 20 20 nfigs.config..
3db0: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 65 74 (if (string? set
3dc0: 2d 76 61 72 73 29 0a 09 20 20 20 20 20 20 28 6c -vars).. (l
3dd0: 65 74 20 28 28 76 61 72 70 61 69 72 73 20 28 73 et ((varpairs (s
3de0: 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 65 74 2d tring-split set-
3df0: 76 61 72 73 20 22 2c 22 29 29 29 0a 09 09 28 64 vars ",")))...(d
3e00: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 76 61 ebug:print 4 "va
3e10: 72 70 61 69 72 73 3a 20 22 20 76 61 72 70 61 69 rpairs: " varpai
3e20: 72 73 29 0a 09 09 28 6d 61 70 20 28 6c 61 6d 62 rs)...(map (lamb
3e30: 64 61 20 28 76 61 72 70 61 69 72 29 0a 09 09 20 da (varpair)...
3e40: 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 (let ((var
3e50: 76 61 6c 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 val (string-spli
3e60: 74 20 76 61 72 70 61 69 72 20 22 3d 22 29 29 29 t varpair "=")))
3e70: 0a 09 09 09 20 28 69 66 20 28 65 71 3f 20 28 6c .... (if (eq? (l
3e80: 65 6e 67 74 68 20 76 61 72 76 61 6c 29 20 32 29 ength varval) 2)
3e90: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
3ea0: 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 var (car varval)
3eb0: 29 0a 09 09 09 09 20 20 20 28 76 61 6c 20 28 63 )..... (val (c
3ec0: 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 adr varval)))...
3ed0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
3ee0: 72 69 6e 74 20 31 20 22 41 64 64 69 6e 67 20 70 rint 1 "Adding p
3ef0: 72 65 2d 76 61 72 2f 76 61 6c 20 22 20 76 61 72 re-var/val " var
3f00: 20 22 20 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 " = " val " to
3f10: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 the environment"
3f20: 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 65 74 ).... (set
3f30: 65 6e 76 20 76 61 72 20 76 61 6c 29 29 29 29 29 env var val)))))
3f40: 0a 09 09 20 20 20 20 20 76 61 72 70 61 69 72 73 ... varpairs
3f50: 29 29 29 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 ))).. (for-each
3f60: 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 .. (lambda (va
3f70: 72 76 61 6c 29 0a 09 20 20 20 20 20 28 6c 65 74 rval).. (let
3f80: 20 28 28 76 61 72 20 28 63 61 72 20 76 61 72 76 ((var (car varv
3f90: 61 6c 29 29 0a 09 09 20 20 20 28 76 61 6c 20 28 al))... (val (
3fa0: 63 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 cadr varval)))..
3fb0: 20 20 20 20 20 20 20 28 69 66 20 76 61 6c 0a 09 (if val..
3fc0: 09 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 . (setenv var
3fd0: 76 61 6c 29 0a 09 09 20 20 20 28 62 65 67 69 6e val)... (begin
3fe0: 0a 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 ... (debug:p
3ff0: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 72 rint 0 "ERROR: r
4000: 65 71 75 69 72 65 64 20 76 61 72 69 61 62 6c 65 equired variable
4010: 20 22 20 76 61 72 20 22 20 64 6f 65 73 20 6e 6f " var " does no
4020: 74 20 68 61 76 65 20 61 20 76 61 6c 69 64 20 76 t have a valid v
4030: 61 6c 75 65 2e 20 45 78 69 74 69 6e 67 22 29 0a alue. Exiting").
4040: 09 09 20 20 20 20 20 28 65 78 69 74 29 29 29 29 .. (exit))))
4050: 29 0a 09 20 20 20 20 20 28 6c 69 73 74 20 0a 09 ).. (list ..
4060: 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 (list "MT
4070: 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 _TEST_RUN_DIR" w
4080: 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 20 20 20 ork-area)..
4090: 20 28 6c 69 73 74 20 20 22 4d 54 5f 54 45 53 54 (list "MT_TEST
40a0: 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 _NAME" test-name
40b0: 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 ).. (list
40c0: 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 "MT_ITEM_INFO" (
40d0: 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 0a 09 conc itemdat))..
40e0: 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 (list "MT
40f0: 5f 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d _ITEMPATH" item
4100: 2d 70 61 74 68 29 0a 09 20 20 20 20 20 20 28 6c -path).. (l
4110: 69 73 74 20 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 ist "MT_RUNNAME
4120: 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 " runname)..
4130: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 4d (list "MT_M
4140: 45 47 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 EGATEST" megate
4150: 73 74 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 st).. (list
4160: 20 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 "MT_TARGET"
4170: 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 target)..
4180: 28 6c 69 73 74 20 20 22 4d 54 5f 4c 49 4e 4b 54 (list "MT_LINKT
4190: 52 45 45 22 20 20 28 63 6f 6e 66 69 67 66 3a 6c REE" (configf:l
41a0: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
41b0: 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 * "setup" "linkt
41c0: 72 65 65 22 29 29 0a 09 20 20 20 20 20 20 28 6c ree")).. (l
41d0: 69 73 74 20 20 22 4d 54 5f 54 45 53 54 53 55 49 ist "MT_TESTSUI
41e0: 54 45 4e 41 4d 45 22 20 28 63 6f 6d 6d 6f 6e 3a TENAME" (common:
41f0: 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 get-testsuite-na
4200: 6d 65 29 29 29 29 0a 0a 09 20 20 28 69 66 20 6d me))))... (if m
4210: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 73 t-bindir-path (s
4220: 65 74 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f etenv "PATH" (co
4230: 6e 63 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 nc (getenv "PATH
4240: 22 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 ") ":" mt-bindir
4250: 2d 70 61 74 68 29 29 29 0a 09 20 20 3b 3b 20 28 -path))).. ;; (
4260: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
4270: 20 74 6f 70 2d 70 61 74 68 29 0a 09 20 20 3b 3b top-path).. ;;
4280: 20 43 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c Can setup as cl
4290: 69 65 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 ient for server
42a0: 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 mode now.. ;; (
42b0: 63 6c 69 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 client:setup)...
42c0: 20 20 0a 09 20 20 3b 3b 20 65 6e 76 69 72 6f 6e .. ;; environ
42d0: 6d 65 6e 74 20 6f 76 65 72 72 69 64 65 73 20 61 ment overrides a
42e0: 72 65 20 64 6f 6e 65 20 2a 62 65 66 6f 72 65 2a re done *before*
42f0: 20 74 68 65 20 72 65 6d 61 69 6e 69 6e 67 20 63 the remaining c
4300: 72 69 74 69 63 61 6c 20 65 6e 76 61 72 73 2e 0a ritical envars..
4310: 09 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 . (alist->env-v
4320: 61 72 73 20 65 6e 76 2d 6f 76 72 64 29 0a 09 20 ars env-ovrd)..
4330: 20 28 72 75 6e 73 3a 73 65 74 2d 6d 65 67 61 74 (runs:set-megat
4340: 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 72 75 6e est-env-vars run
4350: 2d 69 64 20 69 6e 6b 65 79 73 3a 20 6b 65 79 73 -id inkeys: keys
4360: 20 69 6e 6b 65 79 76 61 6c 73 3a 20 6b 65 79 76 inkeyvals: keyv
4370: 61 6c 73 29 0a 09 20 20 28 73 65 74 2d 69 74 65 als).. (set-ite
4380: 6d 2d 65 6e 76 2d 76 61 72 73 20 69 74 65 6d 64 m-env-vars itemd
4390: 61 74 29 0a 09 20 20 28 73 61 76 65 2d 65 6e 76 at).. (save-env
43a0: 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 ironment-as-file
43b0: 73 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 20 s "megatest")..
43c0: 20 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f ;; open-run-clo
43d0: 73 65 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 6f se not needed fo
43e0: 72 20 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d r test-set-meta-
43f0: 69 6e 66 6f 0a 09 20 20 3b 3b 20 28 74 65 73 74 info.. ;; (test
4400: 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d s:set-full-meta-
4410: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
4420: 72 75 6e 2d 69 64 20 30 20 77 6f 72 6b 2d 61 72 run-id 0 work-ar
4430: 65 61 29 0a 09 20 20 3b 3b 20 28 74 65 73 74 73 ea).. ;; (tests
4440: 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 :set-full-meta-i
4450: 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 75 6e 2d nfo test-id run-
4460: 69 64 20 30 20 77 6f 72 6b 2d 61 72 65 61 29 0a id 0 work-area).
4470: 09 20 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 . (tests:set-fu
4480: 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 ll-meta-info #f
4490: 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 30 test-id run-id 0
44a0: 20 77 6f 72 6b 2d 61 72 65 61 20 31 30 29 0a 0a work-area 10)..
44b0: 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 . (thread-sleep
44c0: 21 20 30 2e 33 29 20 3b 3b 20 4e 46 53 20 73 6c ! 0.3) ;; NFS sl
44d0: 6f 77 6e 65 73 73 20 68 61 73 20 63 61 75 73 65 owness has cause
44e0: 64 20 67 72 69 65 66 20 68 65 72 65 0a 0a 09 20 d grief here...
44f0: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
4500: 72 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 20 20 rg "-xterm")..
4510: 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 72 75 (set! fullru
4520: 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 29 nscript "xterm")
4530: 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 .. (if (and
4540: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 0a fullrunscript .
4550: 09 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d 65 .. (file-e
4560: 78 69 73 74 73 3f 20 66 75 6c 6c 72 75 6e 73 63 xists? fullrunsc
4570: 72 69 70 74 29 0a 09 09 20 20 20 20 20 20 20 28 ript)... (
4580: 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 63 75 74 not (file-execut
4590: 65 2d 61 63 63 65 73 73 3f 20 66 75 6c 6c 72 75 e-access? fullru
45a0: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 20 20 28 nscript)))... (
45b0: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 63 68 system (conc "ch
45c0: 6d 6f 64 20 75 67 2b 78 20 22 20 66 75 6c 6c 72 mod ug+x " fullr
45d0: 75 6e 73 63 72 69 70 74 29 29 29 29 0a 0a 09 20 unscript))))...
45e0: 20 3b 3b 20 57 65 20 61 72 65 20 61 62 6f 75 74 ;; We are about
45f0: 20 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 to actually kic
4600: 6b 20 6f 66 66 20 74 68 65 20 74 65 73 74 0a 09 k off the test..
4610: 20 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 73 20 ;; so this is
4620: 61 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 6f 20 a good place to
4630: 72 65 6d 6f 76 65 20 74 68 65 20 72 65 63 6f 72 remove the recor
4640: 64 73 20 66 6f 72 20 0a 09 20 20 3b 3b 20 61 6e ds for .. ;; an
4650: 79 20 70 72 65 76 69 6f 75 73 20 72 75 6e 73 0a y previous runs.
4660: 09 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 . ;; (db:test-r
4670: 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 20 72 emove-steps db r
4680: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
4690: 74 65 6d 64 61 74 29 0a 09 20 20 0a 09 20 20 28 temdat).. .. (
46a0: 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 let* ((m
46b0: 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 (make-mutex)
46c0: 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 )... (kill-job?
46d0: 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d #f)... (exit-
46e0: 69 6e 66 6f 20 20 20 20 28 6d 61 6b 65 2d 6c 61 info (make-la
46f0: 75 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 23 unch:einf pid: #
4700: 74 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 23 t exit-status: #
4710: 74 20 65 78 69 74 2d 63 6f 64 65 3a 20 23 74 20 t exit-code: #t
4720: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 30 rollup-status: 0
4730: 29 29 20 3b 3b 20 70 69 64 20 65 78 69 74 2d 73 )) ;; pid exit-s
4740: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 20 tatus exit-code
4750: 28 69 2e 65 2e 20 70 72 6f 63 65 73 73 20 77 61 (i.e. process wa
4760: 73 20 73 75 63 63 65 73 73 66 75 6c 6c 79 20 72 s successfully r
4770: 75 6e 29 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 un) rollup-statu
4780: 73 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 s... (job-thread
4790: 20 20 20 23 66 29 0a 09 09 20 28 6b 65 65 70 2d #f)... (keep-
47a0: 67 6f 69 6e 67 20 20 20 23 74 29 0a 09 09 20 28 going #t)... (
47b0: 72 75 6e 69 74 20 20 20 20 20 20 20 20 28 6c 61 runit (la
47c0: 6d 62 64 61 20 28 29 0a 09 09 09 09 20 3b 3b 20 mbda ()..... ;;
47d0: 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 (let-values.....
47e0: 20 3b 3b 20 20 28 28 28 70 69 64 20 65 78 69 74 ;; (((pid exit
47f0: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 -status exit-cod
4800: 65 29 0a 09 09 09 09 20 3b 3b 20 20 20 20 28 72 e)..... ;; (r
4810: 75 6e 2d 6e 2d 77 61 69 74 20 66 75 6c 6c 72 75 un-n-wait fullru
4820: 6e 73 63 72 69 70 74 29 29 29 0a 09 09 09 09 20 nscript))).....
4830: 3b 3b 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 ;; (tests:test-s
4840: 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 2d et-status! test-
4850: 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e 2f id "RUNNING" "n/
4860: 61 22 20 23 66 20 23 66 29 0a 09 09 09 09 20 3b a" #f #f)..... ;
4870: 3b 20 53 69 6e 63 65 20 77 65 20 73 68 6f 75 6c ; Since we shoul
4880: 64 20 68 61 76 65 20 61 20 63 6c 65 61 6e 20 73 d have a clean s
4890: 6c 61 74 65 20 61 74 20 74 68 69 73 20 74 69 6d late at this tim
48a0: 65 20 74 68 65 72 65 20 69 73 20 6e 6f 20 6e 65 e there is no ne
48b0: 65 64 20 74 6f 20 64 6f 20 0a 09 09 09 09 20 3b ed to do ..... ;
48c0: 3b 20 61 6e 79 20 6f 66 20 74 68 65 20 6f 74 68 ; any of the oth
48d0: 65 72 20 73 74 75 66 66 20 74 68 61 74 20 74 65 er stuff that te
48e0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
48f0: 74 75 73 21 20 64 6f 65 73 2e 20 4c 65 74 27 73 tus! does. Let's
4900: 20 6a 75 73 74 20 0a 09 09 09 09 20 3b 3b 20 66 just ..... ;; f
4910: 6f 72 63 65 20 52 55 4e 4e 49 4e 47 2f 6e 2f 61 orce RUNNING/n/a
4920: 0a 09 09 09 09 20 0a 0a 09 09 09 09 20 3b 3b 20 ..... ...... ;;
4930: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 (thread-sleep! 0
4940: 2e 33 29 0a 09 09 09 09 20 28 74 65 73 74 73 3a .3)..... (tests:
4950: 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 65 test-force-state
4960: 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
4970: 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 test-id "RUNNING
4980: 22 20 22 6e 2f 61 22 29 0a 09 09 09 09 20 28 72 " "n/a")..... (r
4990: 6d 74 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d mt:roll-up-pass-
49a0: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d fail-counts run-
49b0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
49c0: 6d 2d 70 61 74 68 20 23 66 20 22 52 55 4e 4e 49 m-path #f "RUNNI
49d0: 4e 47 22 29 0a 09 09 09 09 20 3b 3b 20 28 74 68 NG")..... ;; (th
49e0: 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 33 29 read-sleep! 0.3)
49f0: 20 3b 3b 20 4e 46 53 20 73 6c 6f 77 6e 65 73 73 ;; NFS slowness
4a00: 20 68 61 73 20 63 61 75 73 65 64 20 67 72 69 65 has caused grie
4a10: 66 20 68 65 72 65 0a 0a 09 09 09 09 20 3b 3b 20 f here...... ;;
4a20: 69 66 20 74 68 65 72 65 20 69 73 20 61 20 72 75 if there is a ru
4a30: 6e 73 63 72 69 70 74 20 64 6f 20 69 74 20 66 69 nscript do it fi
4a40: 72 73 74 0a 09 09 09 09 20 28 69 66 20 66 75 6c rst..... (if ful
4a50: 6c 72 75 6e 73 63 72 69 70 74 0a 09 09 09 09 20 lrunscript.....
4a60: 20 20 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 (let ((pid (
4a70: 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c process-run full
4a80: 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 09 09 runscript)))....
4a90: 09 20 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 . (rmt:tes
4aa0: 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 t-set-top-proces
4ab0: 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 73 s-pid run-id tes
4ac0: 74 2d 69 64 20 70 69 64 29 0a 09 09 09 09 20 20 t-id pid).....
4ad0: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
4ae0: 28 69 20 30 29 29 0a 09 09 09 09 09 20 28 6c 65 (i 0))...... (le
4af0: 74 2d 76 61 6c 75 65 73 0a 09 09 09 09 09 20 20 t-values......
4b00: 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d (((pid-val exit-
4b10: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
4b20: 29 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 ) (process-wait
4b30: 70 69 64 20 23 74 29 29 29 0a 09 09 09 09 09 20 pid #t)))......
4b40: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 (mutex-lock! m)
4b50: 0a 09 09 09 09 09 20 20 28 6c 61 75 6e 63 68 3a ...... (launch:
4b60: 65 69 6e 66 2d 70 69 64 2d 73 65 74 21 20 20 20 einf-pid-set!
4b70: 20 20 20 20 20 20 20 20 65 78 69 74 2d 69 6e 66 exit-inf
4b80: 6f 20 20 70 69 64 29 20 20 20 20 20 20 20 20 20 o pid)
4b90: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
4ba0: 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 exit-info 0 pid)
4bb0: 0a 09 09 09 09 09 20 20 28 6c 61 75 6e 63 68 3a ...... (launch:
4bc0: 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 einf-exit-status
4bd0: 2d 73 65 74 21 20 20 20 65 78 69 74 2d 69 6e 66 -set! exit-inf
4be0: 6f 20 20 65 78 69 74 2d 73 74 61 74 75 73 29 20 o exit-status)
4bf0: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
4c00: 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 exit-info 1 exit
4c10: 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 -status)......
4c20: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 (launch:einf-exi
4c30: 74 2d 63 6f 64 65 2d 73 65 74 21 20 20 20 20 20 t-code-set!
4c40: 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d exit-info exit-
4c50: 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 65 63 74 code) ;; (vect
4c60: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
4c70: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
4c80: 09 09 09 09 20 20 28 6c 61 75 6e 63 68 3a 65 69 .... (launch:ei
4c90: 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 nf-rollup-status
4ca0: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
4cb0: 20 65 78 69 74 2d 63 6f 64 65 29 20 20 20 3b 3b exit-code) ;;
4cc0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
4cd0: 69 74 2d 69 6e 66 6f 20 33 20 65 78 69 74 2d 63 it-info 3 exit-c
4ce0: 6f 64 65 29 20 20 3b 3b 20 72 6f 6c 6c 75 70 20 ode) ;; rollup
4cf0: 73 74 61 74 75 73 0a 09 09 09 09 09 20 20 28 6d status...... (m
4d00: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
4d10: 09 09 09 09 09 20 20 28 69 66 20 28 65 71 3f 20 ..... (if (eq?
4d20: 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 09 09 pid-val 0)......
4d30: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 (begin....
4d40: 09 09 09 28 74 68 72 65 61 64 2d 73 6c 65 65 70 ...(thread-sleep
4d50: 21 20 32 29 0a 09 09 09 09 09 09 28 6c 6f 6f 70 ! 2).......(loop
4d60: 20 28 2b 20 69 20 31 29 29 29 0a 09 09 09 09 09 (+ i 1)))......
4d70: 20 20 20 20 20 20 29 29 29 29 29 0a 09 09 09 09 ))))).....
4d80: 20 3b 3b 20 74 68 65 6e 2c 20 69 66 20 72 75 6e ;; then, if run
4d90: 73 63 72 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f script ran ok (o
4da0: 72 20 64 69 64 20 6e 6f 74 20 67 65 74 20 63 61 r did not get ca
4db0: 6c 6c 65 64 29 0a 09 09 09 09 20 3b 3b 20 64 6f lled)..... ;; do
4dc0: 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 70 73 all the ezsteps
4dd0: 20 28 69 66 20 61 6e 79 29 0a 09 09 09 09 20 28 (if any)..... (
4de0: 69 66 20 65 7a 73 74 65 70 73 0a 09 09 09 09 20 if ezsteps.....
4df0: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 (let* ((test
4e00: 63 6f 6e 66 69 67 20 3b 3b 20 28 72 65 61 64 2d config ;; (read-
4e10: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f 72 config (conc wor
4e20: 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f 6e k-area "/testcon
4e30: 66 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 69 fig") #f #t envi
4e40: 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d 6c ron-patt: "pre-l
4e50: 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 aunch-env-vars")
4e60: 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 73 ) ;; FIXME??? is
4e70: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f 6b allow-system ok
4e80: 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 20 20 here?......
4e90: 20 3b 3b 20 4e 4f 54 45 3a 20 69 74 20 69 73 20 ;; NOTE: it is
4ea0: 74 65 6d 70 74 69 6e 67 20 74 6f 20 74 75 72 6e tempting to turn
4eb0: 20 6f 66 66 20 66 6f 72 63 65 2d 63 72 65 61 74 off force-creat
4ec0: 65 20 6f 66 20 74 65 73 74 63 6f 6e 66 69 67 20 e of testconfig
4ed0: 62 75 74 20 64 79 6e 61 6d 69 63 0a 09 09 09 09 but dynamic.....
4ee0: 09 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 65 . ;; e
4ef0: 7a 73 74 65 70 20 6e 61 6d 65 73 20 6e 65 65 64 zstep names need
4f00: 20 61 20 66 75 6c 6c 20 72 65 2d 65 76 61 6c 20 a full re-eval
4f10: 68 65 72 65 2e 0a 09 09 09 09 09 20 20 20 20 20 here.......
4f20: 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 (tests:get-testc
4f30: 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 onfig test-name
4f40: 74 63 6f 6e 66 69 67 72 65 67 20 23 74 20 66 6f tconfigreg #t fo
4f50: 72 63 65 2d 63 72 65 61 74 65 3a 20 23 74 29 29 rce-create: #t))
4f60: 20 3b 3b 20 27 72 65 74 75 72 6e 2d 70 72 6f 63 ;; 'return-proc
4f70: 73 29 29 29 0a 09 09 09 09 09 20 20 20 20 28 65 s)))...... (e
4f80: 7a 73 74 65 70 73 6c 73 74 20 28 68 61 73 68 2d zstepslst (hash-
4f90: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
4fa0: 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 65 7a t testconfig "ez
4fb0: 73 74 65 70 73 22 20 27 28 29 29 29 29 0a 09 09 steps" '())))...
4fc0: 09 09 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 .. (hash-t
4fd0: 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 74 63 able-set! *testc
4fe0: 6f 6e 66 69 67 73 2a 20 74 65 73 74 2d 6e 61 6d onfigs* test-nam
4ff0: 65 20 74 65 73 74 63 6f 6e 66 69 67 29 20 3b 3b e testconfig) ;;
5000: 20 63 61 63 68 65 64 20 66 6f 72 20 6c 61 7a 79 cached for lazy
5010: 20 72 65 61 64 73 20 6c 61 74 65 72 20 2e 2e 2e reads later ...
5020: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
5030: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
5040: 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 29 28 s? ".ezsteps"))(
5050: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
5060: 20 22 2e 65 7a 73 74 65 70 73 22 29 29 0a 09 09 ".ezsteps"))...
5070: 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 20 65 .. ;; if e
5080: 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 69 6e zsteps was defin
5090: 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 73 ed then we are s
50a0: 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 6c ure to have at l
50b0: 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 75 east one step bu
50c0: 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a 09 t check anyway..
50d0: 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 6e ... (if (n
50e0: 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a ot (> (length ez
50f0: 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 09 stepslst) 0))...
5100: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
5110: 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 65 7a 73 nt 0 "ERROR: ezs
5120: 74 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 teps defined but
5130: 20 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a ezstepslst is z
5140: 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 09 09 ero length")....
5150: 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 .. (let loop (
5160: 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a 73 (ezstep (car ezs
5170: 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 09 09 tepslst)).......
5180: 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 (tal (c
5190: 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a dr ezstepslst)).
51a0: 09 09 09 09 09 09 20 20 20 20 20 20 28 70 72 65 ...... (pre
51b0: 76 73 74 65 70 20 23 66 29 29 0a 09 09 09 09 09 vstep #f))......
51c0: 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 ;; check ex
51d0: 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d it-info (vector-
51e0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
51f0: 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 28 ...... (if (
5200: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 launch:einf-exit
5210: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 -status exit-inf
5220: 6f 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 o) ;; (vector-re
5230: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 f exit-info 1)..
5240: 09 09 09 09 09 20 28 6c 65 74 20 28 28 6c 6f 67 ..... (let ((log
5250: 70 72 6f 2d 75 73 65 64 20 28 6c 61 75 6e 63 68 pro-used (launch
5260: 3a 72 75 6e 73 74 65 70 20 65 7a 73 74 65 70 20 :runstep ezstep
5270: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 65 run-id test-id e
5280: 78 69 74 2d 69 6e 66 6f 20 6d 20 74 61 6c 20 74 xit-info m tal t
5290: 65 73 74 63 6f 6e 66 69 67 29 29 29 0a 09 09 09 estconfig)))....
52a0: 09 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 ... (if (and (
52b0: 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f steprun-good? lo
52c0: 67 70 72 6f 2d 75 73 65 64 20 28 6c 61 75 6e 63 gpro-used (launc
52d0: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 h:einf-exit-code
52e0: 20 65 78 69 74 2d 69 6e 66 6f 29 29 0a 09 09 09 exit-info))....
52f0: 09 09 09 09 20 20 20 20 28 6e 6f 74 20 28 6e 75 .... (not (nu
5300: 6c 6c 3f 20 74 61 6c 29 29 29 0a 09 09 09 09 09 ll? tal)))......
5310: 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 . (loop (c
5320: 61 72 20 74 61 6c 29 20 28 63 64 72 20 74 61 6c ar tal) (cdr tal
5330: 29 20 73 74 65 70 6e 61 6d 65 29 29 29 0a 09 09 ) stepname)))...
5340: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
5350: 74 20 34 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 t 4 "WARNING: a
5360: 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c 65 prior step faile
5370: 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 22 d, stopping at "
5380: 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 29 0a ezstep)))))))).
5390: 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 20 .. (monitorjob
53a0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
53b0: 20 28 6c 65 74 2a 20 28 28 73 74 61 72 74 2d 73 (let* ((start-s
53c0: 65 63 6f 6e 64 73 20 28 63 75 72 72 65 6e 74 2d econds (current-
53d0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 28 seconds))......(
53e0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c calc-minutes (l
53f0: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 09 ambda ()........
5400: 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 (inexact->exact
5410: 20 0a 09 09 09 09 09 09 09 20 20 28 72 6f 75 6e ........ (roun
5420: 64 20 0a 09 09 09 09 09 09 09 20 20 20 28 2d 20 d ........ (-
5430: 0a 09 09 09 09 09 09 09 20 20 20 20 28 63 75 72 ........ (cur
5440: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 rent-seconds) ..
5450: 09 09 09 09 09 09 20 20 20 20 73 74 61 72 74 2d ...... start-
5460: 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 09 09 seconds)))))....
5470: 09 09 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 ..(kill-tries 0)
5480: 29 0a 09 09 09 09 20 20 20 3b 3b 20 28 74 65 73 )..... ;; (tes
5490: 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 ts:set-full-meta
54a0: 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 -info #f test-id
54b0: 20 72 75 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 run-id (calc-mi
54c0: 6e 75 74 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 nutes) work-area
54d0: 29 0a 09 09 09 09 20 20 20 3b 3b 20 28 74 65 73 )..... ;; (tes
54e0: 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 ts:set-full-meta
54f0: 2d 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 75 -info test-id ru
5500: 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e 75 74 n-id (calc-minut
5510: 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 es) work-area)..
5520: 09 09 09 20 20 20 28 74 65 73 74 73 3a 73 65 74 ... (tests:set
5530: 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 -full-meta-info
5540: 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 #f test-id run-i
5550: 64 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 d (calc-minutes)
5560: 20 77 6f 72 6b 2d 61 72 65 61 20 31 30 29 0a 09 work-area 10)..
5570: 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ... (let loop
5580: 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 61 6c ((minutes (cal
5590: 63 2d 6d 69 6e 75 74 65 73 29 29 0a 09 09 09 09 c-minutes)).....
55a0: 09 20 20 20 20 20 20 28 63 70 75 2d 6c 6f 61 64 . (cpu-load
55b0: 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 (get-cpu-load)
55c0: 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 64 69 )...... (di
55d0: 73 6b 2d 66 72 65 65 20 28 67 65 74 2d 64 66 20 sk-free (get-df
55e0: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
55f0: 72 79 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 ry)))).....
5600: 28 6c 65 74 20 28 28 6e 65 77 2d 63 70 75 2d 6c (let ((new-cpu-l
5610: 6f 61 64 20 28 6c 65 74 2a 20 28 28 6c 6f 61 64 oad (let* ((load
5620: 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 (get-cpu-load)
5630: 29 0a 09 09 09 09 09 09 09 09 28 64 65 6c 74 61 ).........(delta
5640: 20 28 61 62 73 20 28 2d 20 6c 6f 61 64 20 63 70 (abs (- load cp
5650: 75 2d 6c 6f 61 64 29 29 29 29 0a 09 09 09 09 09 u-load))))......
5660: 09 09 20 20 20 28 69 66 20 28 3e 20 64 65 6c 74 .. (if (> delt
5670: 61 20 30 2e 36 29 20 3b 3b 20 64 6f 6e 27 74 20 a 0.6) ;; don't
5680: 62 6f 74 68 65 72 20 75 70 64 61 74 69 6e 67 20 bother updating
5690: 77 69 74 68 20 73 6d 61 6c 6c 20 63 68 61 6e 67 with small chang
56a0: 65 73 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 es........
56b0: 20 6c 6f 61 64 0a 09 09 09 09 09 09 09 20 20 20 load........
56c0: 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 20 #f)))......
56d0: 20 20 28 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 (new-disk-free
56e0: 20 28 6c 65 74 2a 20 28 28 64 66 20 20 20 20 28 (let* ((df (
56f0: 67 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d get-df (current-
5700: 64 69 72 65 63 74 6f 72 79 29 29 29 0a 09 09 09 directory)))....
5710: 09 09 09 09 09 20 28 64 65 6c 74 61 20 28 61 62 ..... (delta (ab
5720: 73 20 28 2d 20 64 66 20 64 69 73 6b 2d 66 72 65 s (- df disk-fre
5730: 65 29 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 e))))........
5740: 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 32 30 (if (> delta 20
5750: 30 29 20 3b 3b 20 69 67 6e 6f 72 65 20 63 68 61 0) ;; ignore cha
5760: 6e 67 65 73 20 75 6e 64 65 72 20 32 30 30 20 4d nges under 200 M
5770: 65 67 0a 09 09 09 09 09 09 09 09 64 66 0a 09 09 eg.........df...
5780: 09 09 09 09 09 09 23 66 29 29 29 29 0a 09 09 09 ......#f))))....
5790: 09 20 20 20 20 20 20 20 28 73 65 74 21 20 6b 69 . (set! ki
57a0: 6c 6c 2d 6a 6f 62 3f 20 28 6f 72 20 28 74 65 73 ll-job? (or (tes
57b0: 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 t-get-kill-reque
57c0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
57d0: 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 d) ;; run-id tes
57e0: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat))
57f0: 0a 09 09 09 09 09 09 09 20 20 20 28 61 6e 64 20 ........ (and
5800: 72 75 6e 74 6c 69 6d 20 28 6c 65 74 2a 20 28 28 runtlim (let* ((
5810: 72 75 6e 2d 73 65 63 6f 6e 64 73 20 20 20 28 2d run-seconds (-
5820: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
5830: 73 29 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 s) start-seconds
5840: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
5850: 20 20 20 28 74 69 6d 65 2d 65 78 63 65 65 64 65 (time-exceede
5860: 64 20 28 3e 20 72 75 6e 2d 73 65 63 6f 6e 64 73 d (> run-seconds
5870: 20 72 75 6e 74 6c 69 6d 29 29 29 0a 09 09 09 09 runtlim))).....
5880: 09 09 09 09 09 20 20 28 69 66 20 74 69 6d 65 2d ..... (if time-
5890: 65 78 63 65 65 64 65 64 0a 09 09 09 09 09 09 09 exceeded........
58a0: 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
58b0: 09 09 09 09 09 09 09 09 09 28 64 65 62 75 67 3a .........(debug:
58c0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 4b 49 print-info 0 "KI
58d0: 4c 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 54 LLING TEST DUE T
58e0: 4f 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 O TIME LIMIT EXC
58f0: 45 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 EEDED! Runtime="
5900: 20 72 75 6e 2d 73 65 63 6f 6e 64 73 20 22 20 73 run-seconds " s
5910: 65 63 6f 6e 64 73 2c 20 6c 69 6d 69 74 3d 22 20 econds, limit="
5920: 72 75 6e 74 6c 69 6d 29 0a 09 09 09 09 09 09 09 runtlim)........
5930: 09 09 09 23 74 29 0a 09 09 09 09 09 09 09 09 09 ...#t)..........
5940: 20 20 20 20 20 20 23 66 29 29 29 29 29 0a 09 09 #f)))))...
5950: 09 09 20 20 20 20 20 20 20 28 74 65 73 74 73 3a .. (tests:
5960: 75 70 64 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d update-central-m
5970: 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 eta-info run-id
5980: 74 65 73 74 2d 69 64 20 6e 65 77 2d 63 70 75 2d test-id new-cpu-
5990: 6c 6f 61 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 load new-disk-fr
59a0: 65 65 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 ee (calc-minutes
59b0: 29 20 23 66 20 23 66 29 0a 09 09 09 09 20 20 20 ) #f #f).....
59c0: 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 (if kill-job
59d0: 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 67 69 ? ...... (begi
59e0: 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 74 n...... (mut
59f0: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 09 ex-lock! m).....
5a00: 09 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 54 . ;; NOTE: T
5a10: 68 65 20 70 69 64 20 63 61 6e 20 63 68 61 6e 67 he pid can chang
5a20: 65 20 61 73 20 64 69 66 66 65 72 65 6e 74 20 73 e as different s
5a30: 74 65 70 73 20 61 72 65 20 72 75 6e 2e 20 44 6f teps are run. Do
5a40: 20 77 65 20 6e 65 65 64 20 68 61 6e 64 73 68 61 we need handsha
5a50: 6b 69 6e 67 20 62 65 74 77 65 65 6e 20 74 68 69 king between thi
5a60: 73 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 20 s...... ;;
5a70: 20 20 20 20 20 73 65 63 74 69 6f 6e 20 61 6e 64 section and
5a80: 20 74 68 65 20 72 75 6e 69 74 20 73 65 63 74 69 the runit secti
5a90: 6f 6e 3f 20 4f 72 20 61 64 64 20 61 20 6c 6f 6f on? Or add a loo
5aa0: 70 20 74 68 61 74 20 74 72 69 65 73 20 74 68 72 p that tries thr
5ab0: 65 65 20 74 69 6d 65 73 20 77 69 74 68 20 61 20 ee times with a
5ac0: 31 2f 34 20 73 65 63 6f 6e 64 0a 09 09 09 09 09 1/4 second......
5ad0: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 62 65 ;; be
5ae0: 74 77 65 65 6e 20 74 72 69 65 73 3f 0a 09 09 09 tween tries?....
5af0: 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 .. (let* ((p
5b00: 69 64 31 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 id1 (launch:einf
5b10: 2d 70 69 64 20 65 78 69 74 2d 69 6e 66 6f 29 29 -pid exit-info))
5b20: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ;; (vector-ref
5b30: 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 0a 09 09 exit-info 0))...
5b40: 09 09 09 09 20 20 20 20 28 70 69 64 32 20 28 72 .... (pid2 (r
5b50: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d mt:test-get-top-
5b60: 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d process-pid run-
5b70: 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 09 09 id test-id))....
5b80: 09 09 09 20 20 20 20 28 70 69 64 73 20 28 64 65 ... (pids (de
5b90: 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 lete-duplicates
5ba0: 28 66 69 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 (filter number?
5bb0: 28 6c 69 73 74 20 70 69 64 31 20 70 69 64 32 29 (list pid1 pid2)
5bc0: 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 ))))......
5bd0: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
5be0: 20 70 69 64 73 29 29 0a 09 09 09 09 09 09 20 20 pids)).......
5bf0: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 (begin.......
5c00: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 09 (for-each....
5c10: 09 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
5c20: 20 28 70 69 64 29 0a 09 09 09 09 09 09 09 28 68 (pid)........(h
5c30: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
5c40: 0a 09 09 09 09 09 09 09 20 65 78 6e 0a 09 09 09 ........ exn....
5c50: 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 .... (begin.....
5c60: 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 ... (debug:pri
5c70: 6e 74 2d 69 6e 66 6f 20 30 20 22 55 6e 61 62 6c nt-info 0 "Unabl
5c80: 65 20 74 6f 20 6b 69 6c 6c 20 70 72 6f 63 65 73 e to kill proces
5c90: 73 20 77 69 74 68 20 70 69 64 20 22 20 70 69 64 s with pid " pid
5ca0: 20 22 2c 20 70 6f 73 73 69 62 6c 79 20 61 6c 72 ", possibly alr
5cb0: 65 61 64 79 20 6b 69 6c 6c 65 64 2e 22 29 0a 09 eady killed.")..
5cc0: 09 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a ...... (debug:
5cd0: 70 72 69 6e 74 20 30 20 22 20 6d 65 73 73 61 67 print 0 " messag
5ce0: 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e e: " ((condition
5cf0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
5d00: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
5d10: 29 20 65 78 6e 29 29 29 0a 09 09 09 09 09 09 09 ) exn)))........
5d20: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
5d30: 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 "WARNING: Reques
5d40: 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 t received to ki
5d50: 6c 6c 20 6a 6f 62 20 22 20 70 69 64 29 20 3b 3b ll job " pid) ;;
5d60: 20 20 22 20 28 61 74 74 65 6d 70 74 20 23 20 22 " (attempt # "
5d70: 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 kill-tries ")")
5d80: 0a 09 09 09 09 09 09 09 20 28 64 65 62 75 67 3a ........ (debug:
5d90: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 53 69 print-info 0 "Si
5da0: 67 6e 61 6c 20 6d 61 73 6b 3d 22 20 28 73 69 67 gnal mask=" (sig
5db0: 6e 61 6c 2d 6d 61 73 6b 29 29 0a 09 09 09 09 09 nal-mask))......
5dc0: 09 09 20 3b 3b 20 28 69 66 20 28 70 72 6f 63 65 .. ;; (if (proce
5dd0: 73 73 3a 61 6c 69 76 65 3f 20 70 69 64 29 0a 09 ss:alive? pid)..
5de0: 09 09 09 09 09 09 20 3b 3b 20 20 20 20 20 28 62 ...... ;; (b
5df0: 65 67 69 6e 0a 09 09 09 09 09 09 09 20 28 6d 61 egin........ (ma
5e00: 70 20 28 6c 61 6d 62 64 61 20 28 70 69 64 2d 6e p (lambda (pid-n
5e10: 75 6d 29 0a 09 09 09 09 09 09 09 09 28 70 72 6f um).........(pro
5e20: 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 2d cess-signal pid-
5e30: 6e 75 6d 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 num signal/term)
5e40: 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 28 )........ (
5e50: 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 62 2d process:get-sub-
5e60: 70 69 64 73 20 70 69 64 29 29 0a 09 09 09 09 09 pids pid))......
5e70: 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 .. (thread-sleep
5e80: 21 20 35 29 0a 09 09 09 09 09 09 09 20 3b 3b 20 ! 5)........ ;;
5e90: 28 69 66 20 28 70 72 6f 63 65 73 73 3a 70 72 6f (if (process:pro
5ea0: 63 65 73 73 2d 61 6c 69 76 65 3f 20 70 69 64 29 cess-alive? pid)
5eb0: 0a 09 09 09 09 09 09 09 20 28 6d 61 70 20 28 6c ........ (map (l
5ec0: 61 6d 62 64 61 20 28 70 69 64 2d 6e 75 6d 29 0a ambda (pid-num).
5ed0: 09 09 09 09 09 09 09 09 28 68 61 6e 64 6c 65 2d ........(handle-
5ee0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 exceptions......
5ef0: 09 09 09 20 65 78 6e 0a 09 09 09 09 09 09 09 09 ... exn.........
5f00: 20 23 66 0a 09 09 09 09 09 09 09 09 20 28 70 72 #f......... (pr
5f10: 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 ocess-signal pid
5f20: 2d 6e 75 6d 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c -num signal/kill
5f30: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 )))........
5f40: 20 28 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 (process:get-su
5f50: 62 2d 70 69 64 73 20 70 69 64 29 29 29 29 0a 09 b-pids pid))))..
5f60: 09 09 09 09 09 09 20 3b 3b 20 20 20 20 28 64 65 ...... ;; (de
5f70: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
5f80: 20 22 6e 6f 74 20 6b 69 6c 6c 69 6e 67 20 70 72 "not killing pr
5f90: 6f 63 65 73 73 20 22 20 70 69 64 20 22 20 61 73 ocess " pid " as
5fa0: 20 69 74 20 69 73 20 6e 6f 74 20 61 6c 69 76 65 it is not alive
5fb0: 22 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 ")))).......
5fc0: 20 20 70 69 64 73 29 0a 09 09 09 09 09 09 20 20 pids).......
5fd0: 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
5fe0: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
5ff0: 64 20 74 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 d test-id "KILLE
6000: 44 22 20 20 22 4b 49 4c 4c 45 44 22 20 28 61 72 D" "KILLED" (ar
6010: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
6020: 20 23 66 29 29 0a 09 09 09 09 09 09 20 20 20 28 #f))....... (
6030: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 20 20 begin.......
6040: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6050: 22 45 52 52 4f 52 3a 20 4e 6f 74 68 69 6e 67 20 "ERROR: Nothing
6060: 74 6f 20 6b 69 6c 6c 2c 20 70 69 64 31 3d 22 20 to kill, pid1="
6070: 70 69 64 31 20 22 2c 20 70 69 64 32 3d 22 20 70 pid1 ", pid2=" p
6080: 69 64 32 29 0a 09 09 09 09 09 09 20 20 20 20 20 id2).......
6090: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
60a0: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
60b0: 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 est-id "KILLED"
60c0: 20 22 46 41 49 4c 45 44 20 54 4f 20 4b 49 4c 4c "FAILED TO KILL
60d0: 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 " (args:get-arg
60e0: 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 09 09 "-m") #f).......
60f0: 20 20 20 20 20 29 29 29 0a 09 09 09 09 09 20 20 )))......
6100: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
6110: 21 20 6d 29 0a 09 09 09 09 09 20 20 20 20 20 3b ! m)...... ;
6120: 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 73 74 ; no point in st
6130: 69 63 6b 69 6e 67 20 61 72 6f 75 6e 64 2e 20 45 icking around. E
6140: 78 69 74 20 6e 6f 77 2e 0a 09 09 09 09 09 20 20 xit now.......
6150: 20 20 20 28 65 78 69 74 29 29 29 0a 09 09 09 09 (exit))).....
6160: 20 20 20 20 20 20 20 28 69 66 20 6b 65 65 70 2d (if keep-
6170: 67 6f 69 6e 67 0a 09 09 09 09 09 20 20 20 28 62 going...... (b
6180: 65 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 egin...... (
6190: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 29 thread-sleep! 3)
61a0: 20 3b 3b 20 28 2b 20 33 20 28 72 61 6e 64 6f 6d ;; (+ 3 (random
61b0: 20 36 29 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 6))) ;; add som
61c0: 65 20 6a 69 74 74 65 72 20 74 6f 20 74 68 65 20 e jitter to the
61d0: 63 61 6c 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 call home time t
61e0: 6f 20 73 70 72 65 61 64 20 6f 75 74 20 74 68 65 o spread out the
61f0: 20 64 62 20 61 63 63 65 73 73 65 73 0a 09 09 09 db accesses....
6200: 09 09 20 20 20 20 20 28 69 66 20 6b 65 65 70 2d .. (if keep-
6210: 67 6f 69 6e 67 20 20 20 20 3b 3b 20 6b 65 65 70 going ;; keep
6220: 20 6f 72 69 67 69 6e 61 6c 73 20 66 6f 72 20 63 originals for c
6230: 70 75 2d 6c 6f 61 64 20 61 6e 64 20 64 69 73 6b pu-load and disk
6240: 2d 66 72 65 65 20 75 6e 6c 65 73 73 20 74 68 65 -free unless the
6250: 79 20 63 68 61 6e 67 65 20 6d 6f 72 65 20 74 68 y change more th
6260: 61 6e 20 74 68 65 20 61 6c 6c 6f 77 65 64 20 64 an the allowed d
6270: 65 6c 74 61 0a 09 09 09 09 09 09 20 28 6c 6f 6f elta....... (loo
6280: 70 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 p (calc-minutes)
6290: 20 28 6f 72 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 (or new-cpu-loa
62a0: 64 20 63 70 75 2d 6c 6f 61 64 29 20 28 6f 72 20 d cpu-load) (or
62b0: 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 20 64 69 new-disk-free di
62c0: 73 6b 2d 66 72 65 65 29 29 29 29 29 29 29 0a 09 sk-free)))))))..
62d0: 09 09 09 20 20 20 28 74 65 73 74 73 3a 75 70 64 ... (tests:upd
62e0: 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d 65 74 61 ate-central-meta
62f0: 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 74 65 73 -info run-id tes
6300: 74 2d 69 64 20 28 67 65 74 2d 63 70 75 2d 6c 6f t-id (get-cpu-lo
6310: 61 64 29 20 28 67 65 74 2d 64 66 20 28 63 75 72 ad) (get-df (cur
6320: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
6330: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 23 (calc-minutes) #
6340: 66 20 23 66 29 29 29 29 20 3b 3b 20 4e 4f 54 45 f #f)))) ;; NOTE
6350: 3a 20 43 68 65 63 6b 69 6e 67 20 74 77 69 63 65 : Checking twice
6360: 20 66 6f 72 20 6b 65 65 70 2d 67 6f 69 6e 67 20 for keep-going
6370: 69 73 20 69 6e 74 65 6e 74 69 6f 6e 61 6c 0a 09 is intentional..
6380: 09 20 28 74 68 31 20 20 20 20 20 20 20 20 20 20 . (th1
6390: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e (make-thread mon
63a0: 69 74 6f 72 6a 6f 62 20 22 6d 6f 6e 69 74 6f 72 itorjob "monitor
63b0: 20 6a 6f 62 22 29 29 0a 09 09 20 28 74 68 32 20 job"))... (th2
63c0: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 (make-t
63d0: 68 72 65 61 64 20 72 75 6e 69 74 20 22 72 75 6e hread runit "run
63e0: 20 6a 6f 62 22 29 29 29 0a 09 20 20 20 20 28 73 job"))).. (s
63f0: 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 et! job-thread t
6400: 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 h2).. (thread
6410: 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 -start! th1)..
6420: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
6430: 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 th2).. (thre
6440: 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 ad-join! th2)..
6450: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
6460: 69 6e 66 6f 20 30 20 22 4d 65 67 61 74 65 73 74 info 0 "Megatest
6470: 20 65 78 65 63 74 75 74 65 20 6f 66 20 74 65 73 exectute of tes
6480: 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 2c t " test-name ",
6490: 20 69 74 65 6d 20 70 61 74 68 20 22 20 69 74 65 item path " ite
64a0: 6d 2d 70 61 74 68 20 22 20 63 6f 6d 70 6c 65 74 m-path " complet
64b0: 65 2e 20 4e 6f 74 69 66 79 69 6e 67 20 74 68 65 e. Notifying the
64c0: 20 64 62 20 2e 2e 2e 22 29 0a 09 20 20 20 20 28 db ...").. (
64d0: 73 65 74 21 20 6b 65 65 70 2d 67 6f 69 6e 67 20 set! keep-going
64e0: 23 66 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 #f).. (thread
64f0: 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 09 20 20 20 -join! th1)..
6500: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
6510: 31 29 20 20 20 20 20 20 20 3b 3b 20 67 69 76 62 1) ;; givb
6520: 65 20 74 68 72 65 61 64 20 74 68 31 20 61 20 63 e thread th1 a c
6530: 68 61 6e 63 65 20 74 6f 20 62 65 20 64 6f 6e 65 hance to be done
6540: 20 54 4f 44 4f 3a 20 56 65 72 69 66 79 20 74 68 TODO: Verify th
6550: 69 73 20 69 73 20 6e 65 65 64 65 64 2e 20 41 74 is is needed. At
6560: 20 30 2e 31 20 49 20 77 61 73 20 67 65 74 74 69 0.1 I was getti
6570: 6e 67 20 66 61 69 6c 20 74 6f 20 73 74 6f 70 2c ng fail to stop,
6580: 20 69 6e 63 72 65 61 73 65 64 20 74 6f 20 74 6f increased to to
6590: 74 61 6c 20 6f 66 20 31 2e 31 20 73 65 63 2e 0a tal of 1.1 sec..
65a0: 09 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b . (mutex-lock
65b0: 21 20 6d 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 ! m).. (let*
65c0: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 ((item-path (ite
65d0: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
65e0: 6d 64 61 74 29 29 0a 09 09 20 20 20 3b 3b 20 6f mdat))... ;; o
65f0: 6e 6c 79 20 73 74 61 74 65 20 61 6e 64 20 73 74 nly state and st
6600: 61 74 75 73 20 6e 65 65 64 65 64 20 2d 20 75 73 atus needed - us
6610: 65 20 6c 61 7a 79 20 72 6f 75 74 69 6e 65 0a 09 e lazy routine..
6620: 09 20 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28 . (testinfo (
6630: 72 6d 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f rmt:get-testinfo
6640: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 -state-status ru
6650: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a n-id test-id))).
6660: 09 20 20 20 20 20 20 3b 3b 20 41 6d 20 49 20 63 . ;; Am I c
6670: 6f 6d 70 6c 65 74 65 64 3f 0a 09 20 20 20 20 20 ompleted?..
6680: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 28 64 62 (if (member (db
6690: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
66a0: 74 65 73 74 69 6e 66 6f 29 20 27 28 22 52 45 4d testinfo) '("REM
66b0: 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 52 OTEHOSTSTART" "R
66c0: 55 4e 4e 49 4e 47 22 29 29 20 3b 3b 20 4e 4f 54 UNNING")) ;; NOT
66d0: 45 3a 20 49 74 20 73 68 6f 75 6c 64 20 2a 6e 6f E: It should *no
66e0: 74 2a 20 62 65 20 52 45 4d 4f 54 45 48 4f 53 54 t* be REMOTEHOST
66f0: 53 54 41 52 54 20 62 75 74 20 66 6f 72 20 72 65 START but for re
6700: 61 73 6f 6e 73 20 49 20 64 6f 6e 27 74 20 79 65 asons I don't ye
6710: 74 20 75 6e 64 65 72 73 74 61 6e 64 20 69 74 20 t understand it
6720: 73 6f 6d 65 74 69 6d 65 73 20 67 65 74 73 20 73 sometimes gets s
6730: 74 75 63 6b 20 69 6e 20 74 68 61 74 20 73 74 61 tuck in that sta
6740: 74 65 20 3b 3b 20 28 6e 6f 74 20 28 65 71 75 61 te ;; (not (equa
6750: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
6760: 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 state testinfo)
6770: 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 "COMPLETED"))...
6780: 20 20 28 6c 65 74 20 28 28 6e 65 77 2d 73 74 61 (let ((new-sta
6790: 74 65 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 te (if kill-job
67a0: 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 4f 4d 50 ? "KILLED" "COMP
67b0: 4c 45 54 45 44 22 29 20 3b 3b 20 28 69 66 20 28 LETED") ;; (if (
67c0: 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 eq? (vector-ref
67d0: 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 30 29 20 exit-info 2) 0)
67e0: 3b 3b 20 65 78 69 74 65 64 20 77 69 74 68 20 22 ;; exited with "
67f0: 67 6f 6f 64 22 20 73 74 61 74 75 73 0a 09 09 09 good" status....
6800: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6820: 20 20 20 20 20 20 20 20 20 3b 3b 20 22 43 4f 4d ;; "COM
6830: 50 4c 45 54 45 44 22 0a 09 09 09 09 09 09 09 20 PLETED"........
6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
6850: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
6860: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 29 29 tate testinfo)))
6870: 20 20 20 3b 3b 20 65 6c 73 65 20 70 72 65 73 65 ;; else prese
6880: 76 65 20 74 68 65 20 73 74 61 74 65 20 61 73 20 ve the state as
6890: 73 65 74 20 77 69 74 68 69 6e 20 74 68 65 20 74 set within the t
68a0: 65 73 74 0a 09 09 09 09 20 20 20 20 29 0a 09 09 est..... )...
68b0: 09 28 6e 65 77 2d 73 74 61 74 75 73 20 28 63 6f .(new-status (co
68c0: 6e 64 0a 09 09 09 09 20 20 20 20 20 28 28 6e 6f nd..... ((no
68d0: 74 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 t (launch:einf-e
68e0: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
68f0: 69 6e 66 6f 29 29 20 22 46 41 49 4c 22 29 20 3b info)) "FAIL") ;
6900: 3b 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 ; job failed to
6910: 72 75 6e 20 2e 2e 2e 20 28 76 65 63 74 6f 72 2d run ... (vector-
6920: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
6930: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
6940: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
6950: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
6960: 69 6e 66 6f 29 20 30 29 20 20 20 20 20 3b 3b 20 info) 0) ;;
6970: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
6980: 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 20 20 20 -info 3).....
6990: 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 ;; if the cur
69a0: 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 rent status is A
69b0: 55 54 4f 20 74 68 65 6e 20 64 65 66 65 72 20 74 UTO then defer t
69c0: 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 o the calculated
69d0: 20 76 61 6c 75 65 20 28 69 2e 65 2e 20 6c 65 61 value (i.e. lea
69e0: 76 65 20 74 68 69 73 20 41 55 54 4f 29 0a 09 09 ve this AUTO)...
69f0: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 .. (if (equ
6a00: 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 al? (db:test-get
6a10: 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f -status testinfo
6a20: 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 22 ) "AUTO") "AUTO"
6a30: 20 22 50 41 53 53 22 29 29 0a 09 09 09 09 20 20 "PASS")).....
6a40: 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 ((eq? (launch
6a50: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
6a60: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 31 tus exit-info) 1
6a70: 29 20 22 46 41 49 4c 22 29 20 20 3b 3b 20 28 76 ) "FAIL") ;; (v
6a80: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
6a90: 6e 66 6f 20 33 29 0a 09 09 09 09 20 20 20 20 20 nfo 3).....
6aa0: 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 ((eq? (launch:ei
6ab0: 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 nf-rollup-status
6ac0: 20 65 78 69 74 2d 69 6e 66 6f 29 20 32 29 09 20 exit-info) 2).
6ad0: 20 20 20 20 3b 3b 09 28 76 65 63 74 6f 72 2d 72 ;;.(vector-r
6ae0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 0a ef exit-info 3).
6af0: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 66 20 .... ;; if
6b00: 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 the current stat
6b10: 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 20 64 us is AUTO the d
6b20: 65 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 efer to the calc
6b30: 75 6c 61 74 65 64 20 76 61 6c 75 65 20 62 75 74 ulated value but
6b40: 20 71 75 61 6c 69 66 79 20 28 69 2e 65 2e 20 6d qualify (i.e. m
6b50: 61 6b 65 20 74 68 69 73 20 41 55 54 4f 2d 57 41 ake this AUTO-WA
6b60: 52 4e 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 RN)..... (i
6b70: 66 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 f (equal? (db:te
6b80: 73 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 st-get-status te
6b90: 73 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 stinfo) "AUTO")
6ba0: 22 41 55 54 4f 2d 57 41 52 4e 22 20 22 57 41 52 "AUTO-WARN" "WAR
6bb0: 4e 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 65 N"))..... (e
6bc0: 6c 73 65 20 22 46 41 49 4c 22 29 29 29 29 20 3b lse "FAIL")))) ;
6bd0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
6be0: 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 29 tatus testinfo))
6bf0: 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 )... (debug:p
6c00: 72 69 6e 74 2d 69 6e 66 6f 20 31 20 22 54 65 73 rint-info 1 "Tes
6c10: 74 20 65 78 69 74 65 64 20 69 6e 20 73 74 61 74 t exited in stat
6c20: 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 e=" (db:test-get
6c30: 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 -state testinfo)
6c40: 20 22 2c 20 73 65 74 74 69 6e 67 20 73 74 61 74 ", setting stat
6c50: 65 2f 73 74 61 74 75 73 20 62 61 73 65 64 20 6f e/status based o
6c60: 6e 20 65 78 69 74 20 63 6f 64 65 20 6f 66 20 22 n exit code of "
6c70: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 (launch:einf-ex
6c80: 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 it-status exit-i
6c90: 6e 66 6f 29 20 22 20 61 6e 64 20 72 6f 6c 6c 75 nfo) " and rollu
6ca0: 70 2d 73 74 61 74 75 73 20 6f 66 20 22 20 28 6c p-status of " (l
6cb0: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
6cc0: 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e p-status exit-in
6cd0: 66 6f 29 29 0a 09 09 20 20 20 20 28 74 65 73 74 fo))... (test
6ce0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
6cf0: 73 21 20 72 75 6e 2d 69 64 20 0a 09 09 09 09 09 s! run-id ......
6d00: 20 20 20 20 74 65 73 74 2d 69 64 20 0a 09 09 09 test-id ....
6d10: 09 09 20 20 20 20 6e 65 77 2d 73 74 61 74 65 0a .. new-state.
6d20: 09 09 09 09 09 20 20 20 20 6e 65 77 2d 73 74 61 ..... new-sta
6d30: 74 75 73 0a 09 09 09 09 09 20 20 20 20 28 61 72 tus...... (ar
6d40: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
6d50: 20 23 66 29 0a 09 09 20 20 20 20 3b 3b 20 6e 65 #f)... ;; ne
6d60: 65 64 20 74 6f 20 75 70 64 61 74 65 20 74 68 65 ed to update the
6d70: 20 74 6f 70 20 74 65 73 74 20 72 65 63 6f 72 64 top test record
6d80: 20 69 66 20 50 41 53 53 20 6f 72 20 46 41 49 4c if PASS or FAIL
6d90: 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 73 and this is a s
6da0: 75 62 74 65 73 74 0a 09 09 20 20 20 20 3b 3b 20 ubtest... ;;
6db0: 4e 4f 20 4e 45 45 44 20 54 4f 20 43 41 4c 4c 20 NO NEED TO CALL
6dc0: 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 roll-up-pass-fai
6dd0: 6c 2d 63 6f 75 6e 74 73 20 48 45 52 45 2c 20 54 l-counts HERE, T
6de0: 48 49 53 20 49 53 20 44 4f 4e 45 20 49 4e 20 72 HIS IS DONE IN r
6df0: 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c oll-up-pass-fail
6e00: 2d 63 6f 75 6e 74 73 20 63 61 6c 6c 65 64 20 62 -counts called b
6e10: 79 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 y tests:test-set
6e20: 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 29 -status!... )
6e30: 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 ).. ;; for
6e40: 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 automated creati
6e50: 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 on of the rollup
6e60: 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 html file this
6e70: 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e is a good place.
6e80: 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e .... (if (n
6e90: 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d ot (equal? item-
6ea0: 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 74 path ""))... (t
6eb0: 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 ests:summarize-i
6ec0: 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 tems run-id test
6ed0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 -id test-name #f
6ee0: 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 )).. (tests
6ef0: 3a 73 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 20 :summarize-test
6f00: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 20 run-id test-id)
6f10: 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 ;; don't force
6f20: 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 - just update if
6f30: 20 6e 6f 0a 09 20 20 20 20 20 20 29 0a 09 20 20 no.. )..
6f40: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
6f50: 20 6d 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a m).. (debug:
6f60: 70 72 69 6e 74 20 32 20 22 4f 75 74 70 75 74 20 print 2 "Output
6f70: 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 from running " f
6f80: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 2c 20 ullrunscript ",
6f90: 70 69 64 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 pid " (launch:ei
6fa0: 6e 66 2d 70 69 64 20 65 78 69 74 2d 69 6e 66 6f nf-pid exit-info
6fb0: 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 ) " in work area
6fc0: 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 " .... work-are
6fd0: 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 a ":\n====\n exi
6fe0: 74 20 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 t code " (launch
6ff0: 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 :einf-exit-code
7000: 65 78 69 74 2d 69 6e 66 6f 29 20 22 5c 6e 22 20 exit-info) "\n"
7010: 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 28 "====\n").. (
7020: 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
7030: 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 einf-exit-status
7040: 20 65 78 69 74 2d 69 6e 66 6f 29 29 0a 09 09 28 exit-info))...(
7050: 65 78 69 74 20 34 29 29 29 29 29 29 29 0a 0a 3b exit 4)))))))..;
7060: 3b 20 73 65 74 20 75 70 20 74 68 65 20 76 65 72 ; set up the ver
7070: 79 20 62 61 73 69 63 73 20 6e 65 65 64 65 64 20 y basics needed
7080: 66 6f 72 20 64 6f 69 6e 67 20 61 6e 79 74 68 69 for doing anythi
7090: 6e 67 20 68 65 72 65 2e 0a 28 64 65 66 69 6e 65 ng here..(define
70a0: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 66 (launch:setup-f
70b0: 6f 72 2d 72 75 6e 20 23 21 6b 65 79 20 28 66 6f or-run #!key (fo
70c0: 72 63 65 20 23 66 29 29 0a 20 20 3b 3b 20 77 6f rce #f)). ;; wo
70d0: 75 6c 64 20 73 65 74 20 76 61 6c 75 65 73 20 66 uld set values f
70e0: 6f 72 20 4b 45 59 53 20 69 6e 20 74 68 65 20 65 or KEYS in the e
70f0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 68 65 72 65 20 nvironment here
7100: 66 6f 72 20 62 65 74 74 65 72 20 73 75 70 70 6f for better suppo
7110: 72 74 20 6f 66 20 65 6e 76 2d 6f 76 65 72 72 69 rt of env-overri
7120: 64 65 20 62 75 74 20 0a 20 20 3b 3b 20 68 61 76 de but . ;; hav
7130: 65 20 63 68 69 63 6b 65 6e 2f 65 67 67 20 73 63 e chicken/egg sc
7140: 65 6e 61 72 69 6f 2e 20 6e 65 65 64 20 74 6f 20 enario. need to
7150: 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e 63 6f read megatest.co
7160: 6e 66 69 67 20 74 68 65 6e 20 72 65 61 64 20 69 nfig then read i
7170: 74 20 61 67 61 69 6e 2e 20 47 6f 69 6e 67 20 74 t again. Going t
7180: 6f 20 0a 20 20 3b 3b 20 70 61 73 73 20 6f 6e 20 o . ;; pass on
7190: 74 68 61 74 20 69 64 65 61 20 66 6f 72 20 6e 6f that idea for no
71a0: 77 0a 20 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 w. ;; special c
71b0: 61 73 65 0a 20 20 28 69 66 20 28 6f 72 20 66 6f ase. (if (or fo
71c0: 72 63 65 20 28 6e 6f 74 20 28 68 61 73 68 2d 74 rce (not (hash-t
71d0: 61 62 6c 65 3f 20 2a 63 6f 6e 66 69 67 64 61 74 able? *configdat
71e0: 2a 29 29 29 20 20 3b 3b 20 6e 6f 20 6e 65 65 64 *))) ;; no need
71f0: 20 74 6f 20 72 65 2d 6f 70 65 6e 20 6f 6e 20 65 to re-open on e
7200: 76 65 72 79 20 63 61 6c 6c 0a 20 20 20 20 20 20 very call.
7210: 28 62 65 67 69 6e 0a 09 28 73 65 74 21 20 2a 63 (begin..(set! *c
7220: 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 6f 72 20 28 onfiginfo* (or (
7230: 69 66 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d if (get-environm
7240: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
7250: 5f 43 4d 44 49 4e 46 4f 22 29 20 3b 3b 20 77 65 _CMDINFO") ;; we
7260: 20 61 72 65 20 69 6e 73 69 64 65 20 61 20 74 65 are inside a te
7270: 73 74 20 2d 20 64 6f 20 6e 6f 74 20 72 65 70 72 st - do not repr
7280: 6f 63 65 73 73 20 63 6f 6e 66 69 67 73 0a 09 09 ocess configs...
7290: 09 09 20 20 20 28 6c 65 74 20 28 28 61 6c 69 73 .. (let ((alis
72a0: 74 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 28 67 tconfig (conc (g
72b0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
72c0: 61 72 69 61 62 6c 65 20 22 4d 54 5f 4c 49 4e 4b ariable "MT_LINK
72d0: 54 52 45 45 22 29 20 22 2f 22 0a 09 09 09 09 09 TREE") "/"......
72e0: 09 09 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 .. (get-envir
72f0: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
7300: 22 4d 54 5f 54 41 52 47 45 54 22 29 20 20 20 22 "MT_TARGET") "
7310: 2f 22 0a 09 09 09 09 09 09 09 20 20 20 20 28 67 /"........ (g
7320: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
7330: 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 4e ariable "MT_RUNN
7340: 41 4d 45 22 29 20 20 22 2f 22 0a 09 09 09 09 09 AME") "/"......
7350: 09 09 20 20 20 20 22 2e 6d 65 67 61 74 65 73 74 .. ".megatest
7360: 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 .cfg-" megatest
7370: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
7380: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
7390: 68 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 69 h)))..... (i
73a0: 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 f (file-exists?
73b0: 61 6c 69 73 74 63 6f 6e 66 69 67 29 0a 09 09 09 alistconfig)....
73c0: 09 09 20 28 6c 69 73 74 20 28 63 6f 6e 66 69 67 .. (list (config
73d0: 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 61 6c 69 f:read-alist ali
73e0: 73 74 63 6f 6e 66 69 67 29 0a 09 09 09 09 09 20 stconfig)......
73f0: 20 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 (get-envir
7400: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
7410: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
7420: 45 22 29 29 0a 09 09 09 09 09 20 23 66 29 29 0a E"))...... #f)).
7430: 09 09 09 09 20 20 20 23 66 29 20 3b 3b 20 6e 6f .... #f) ;; no
7440: 20 63 6f 6e 66 69 67 20 63 61 63 68 65 64 20 2d config cached -
7450: 20 67 69 76 65 20 75 70 0a 09 09 09 20 20 20 20 give up....
7460: 20 20 20 28 6c 65 74 20 28 28 72 75 6e 6e 61 6d (let ((runnam
7470: 65 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d e (or (args:get-
7480: 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 28 arg "-runname")(
7490: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
74a0: 75 6e 6e 61 6d 65 22 29 29 29 29 0a 09 09 09 09 unname")))).....
74b0: 20 28 69 66 20 72 75 6e 6e 61 6d 65 20 28 73 65 (if runname (se
74c0: 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 tenv "MT_RUNNAME
74d0: 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 09 09 09 " runname)).....
74e0: 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d (find-and-read-
74f0: 63 6f 6e 66 69 67 20 0a 09 09 09 09 20 20 28 69 config ..... (i
7500: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
7510: 22 2d 63 6f 6e 66 69 67 22 29 28 61 72 67 73 3a "-config")(args:
7520: 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 get-arg "-config
7530: 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e ") "megatest.con
7540: 66 69 67 22 29 0a 09 09 09 09 20 20 65 6e 76 69 fig")..... envi
7550: 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f ron-patt: "env-o
7560: 76 65 72 72 69 64 65 22 0a 09 09 09 09 20 20 67 verride"..... g
7570: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 iven-toppath: (g
7580: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
7590: 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f ariable "MT_RUN_
75a0: 41 52 45 41 5f 48 4f 4d 45 22 29 0a 09 09 09 09 AREA_HOME").....
75b0: 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d pathenvvar: "M
75c0: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
75d0: 29 29 29 29 0a 09 28 73 65 74 21 20 2a 63 6f 6e ))))..(set! *con
75e0: 66 69 67 64 61 74 2a 20 20 28 69 66 20 28 63 61 figdat* (if (ca
75f0: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 r *configinfo*)(
7600: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
7610: 29 20 23 66 29 29 0a 09 28 73 65 74 21 20 2a 74 ) #f))..(set! *t
7620: 6f 70 70 61 74 68 2a 20 20 20 20 28 69 66 20 28 oppath* (if (
7630: 63 61 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a car *configinfo*
7640: 29 28 63 61 64 72 20 2a 63 6f 6e 66 69 67 69 6e )(cadr *configin
7650: 66 6f 2a 29 20 23 66 29 29 0a 09 28 6c 65 74 2a fo*) #f))..(let*
7660: 20 28 28 63 6d 64 6c 69 6e 65 74 72 61 6e 73 70 ((cmdlinetransp
7670: 6f 72 74 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ort (args:get-ar
7680: 67 20 22 2d 74 72 61 6e 73 70 6f 72 74 22 29 29 g "-transport"))
7690: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
76a0: 28 74 6d 70 74 72 61 6e 73 70 6f 72 74 20 28 63 (tmptransport (c
76b0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
76c0: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 72 76 65 onfigdat* "serve
76d0: 72 22 20 22 74 72 61 6e 73 70 6f 72 74 22 29 29 r" "transport"))
76e0: 0a 09 20 20 20 20 20 20 20 28 74 72 61 6e 73 70 .. (transp
76f0: 6f 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 ort.
7700: 20 20 20 20 28 69 66 20 63 6d 64 6c 69 6e 65 74 (if cmdlinet
7710: 72 61 6e 73 70 6f 72 74 0a 20 20 20 20 20 20 20 ransport.
7720: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
7730: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 63 6d 64 ring->symbol cmd
7740: 6c 69 6e 65 74 72 61 6e 73 70 6f 72 74 29 0a 20 linetransport).
7750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7760: 20 20 20 28 69 66 20 74 6d 70 74 72 61 6e 73 70 (if tmptransp
7770: 6f 72 74 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ort (string->sym
7780: 62 6f 6c 20 74 6d 70 74 72 61 6e 73 70 6f 72 74 bol tmptransport
7790: 29 20 27 68 74 74 70 29 29 29 29 0a 09 20 20 28 ) 'http)))).. (
77a0: 69 66 20 28 6d 65 6d 62 65 72 20 74 72 61 6e 73 if (member trans
77b0: 70 6f 72 74 20 27 28 68 74 74 70 20 72 70 63 20 port '(http rpc
77c0: 6e 6d 73 67 29 29 0a 09 20 20 20 20 20 20 28 73 nmsg)).. (s
77d0: 65 74 21 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 et! *transport-t
77e0: 79 70 65 2a 20 74 72 61 6e 73 70 6f 72 74 29 0a ype* transport).
77f0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
7800: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
7810: 45 52 52 4f 52 3a 20 55 6e 72 65 63 6f 67 6e 69 ERROR: Unrecogni
7820: 73 65 64 20 74 72 61 6e 73 70 6f 72 74 20 22 20 sed transport "
7830: 74 72 61 6e 73 70 6f 72 74 29 0a 09 09 28 65 78 transport)...(ex
7840: 69 74 29 29 29 29 0a 09 28 6c 65 74 20 28 28 6c it))))..(let ((l
7850: 69 6e 6b 74 72 65 65 20 28 63 6f 6e 66 69 67 66 inktree (configf
7860: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
7870: 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e at* "setup" "lin
7880: 6b 74 72 65 65 22 29 29 29 20 3b 3b 20 6c 69 6e ktree"))) ;; lin
7890: 6b 20 74 72 65 65 20 69 73 20 63 72 69 74 69 63 k tree is critic
78a0: 61 6c 0a 09 20 20 28 69 66 20 6c 69 6e 6b 74 72 al.. (if linktr
78b0: 65 65 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e ee.. (if (n
78c0: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
78d0: 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 09 20 20 linktree))...
78e0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 68 61 (begin... (ha
78f0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
7900: 09 09 20 20 20 20 20 65 78 6e 0a 09 09 20 20 20 .. exn...
7910: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
7920: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
7930: 20 22 45 52 52 4f 52 3a 20 53 6f 6d 65 74 68 69 "ERROR: Somethi
7940: 6e 67 20 77 65 6e 74 20 77 72 6f 6e 67 20 77 68 ng went wrong wh
7950: 65 6e 20 74 72 79 69 6e 67 20 74 6f 20 63 72 65 en trying to cre
7960: 61 74 65 20 6c 69 6e 6b 74 72 65 65 20 64 69 72 ate linktree dir
7970: 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 0a at " linktree).
7980: 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a .. (debug:
7990: 70 72 69 6e 74 20 30 20 22 20 6d 65 73 73 61 67 print 0 " messag
79a0: 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e e: " ((condition
79b0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
79c0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
79d0: 29 20 65 78 6e 29 29 0a 09 09 20 20 20 20 20 20 ) exn))...
79e0: 20 28 65 78 69 74 20 31 29 29 0a 09 09 20 20 20 (exit 1))...
79f0: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
7a00: 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 ory linktree #t)
7a10: 29 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 ))).. (begi
7a20: 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 n...(debug:print
7a30: 20 30 20 22 45 52 52 4f 52 3a 20 6c 69 6e 6b 74 0 "ERROR: linkt
7a40: 72 65 65 20 6e 6f 74 20 64 65 66 69 6e 65 64 20 ree not defined
7a50: 69 6e 20 5b 73 65 74 75 70 5d 20 73 65 63 74 69 in [setup] secti
7a60: 6f 6e 20 6f 66 20 6d 65 67 61 74 65 73 74 2e 63 on of megatest.c
7a70: 6f 6e 66 69 67 22 29 0a 09 09 28 65 78 69 74 20 onfig")...(exit
7a80: 31 29 29 29 0a 09 20 20 28 69 66 20 6c 69 6e 6b 1))).. (if link
7a90: 74 72 65 65 0a 09 20 20 20 20 20 20 28 6c 65 74 tree.. (let
7aa0: 20 28 28 64 62 64 69 72 20 28 63 6f 6e 63 20 6c ((dbdir (conc l
7ab0: 69 6e 6b 74 72 65 65 20 22 2f 2e 64 62 22 29 29 inktree "/.db"))
7ac0: 29 0a 09 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 )...(handle-exce
7ad0: 70 74 69 6f 6e 73 0a 09 09 20 65 78 6e 0a 09 09 ptions... exn...
7ae0: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 64 65 (begin... (de
7af0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
7b00: 4f 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 63 72 OR: failed to cr
7b10: 65 61 74 65 20 74 68 65 20 22 20 64 62 64 69 72 eate the " dbdir
7b20: 20 22 20 61 72 65 61 20 66 6f 72 20 79 6f 75 72 " area for your
7b30: 20 64 61 74 61 62 61 73 65 20 66 69 6c 65 73 22 database files"
7b40: 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a 70 72 )... (debug:pr
7b50: 69 6e 74 20 30 20 22 20 6d 65 73 73 61 67 65 3a int 0 " message:
7b60: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
7b70: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
7b80: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
7b90: 65 78 6e 29 29 29 0a 09 09 20 28 69 66 20 28 6e exn)))... (if (n
7ba0: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
7bb0: 69 73 74 73 3f 20 64 62 64 69 72 29 29 28 63 72 ists? dbdir))(cr
7bc0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 64 eate-directory d
7bd0: 62 64 69 72 29 29 29 0a 09 09 28 73 65 74 65 6e bdir)))...(seten
7be0: 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 20 v "MT_LINKTREE"
7bf0: 6c 69 6e 6b 74 72 65 65 29 29 0a 09 20 20 20 20 linktree))..
7c00: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
7c10: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
7c20: 3a 20 6c 69 6e 6b 74 72 65 65 20 69 73 20 72 65 : linktree is re
7c30: 71 75 69 72 65 64 20 69 6e 20 79 6f 75 72 20 6d quired in your m
7c40: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 5b egatest.config [
7c50: 73 65 74 75 70 5d 20 73 65 63 74 69 6f 6e 22 29 setup] section")
7c60: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
7c70: 20 28 69 66 20 28 61 6e 64 20 2a 74 6f 70 70 61 (if (and *toppa
7c80: 74 68 2a 0a 09 09 20 20 20 28 64 69 72 65 63 74 th*... (direct
7c90: 6f 72 79 2d 65 78 69 73 74 73 3f 20 2a 74 6f 70 ory-exists? *top
7ca0: 70 61 74 68 2a 29 29 0a 09 20 20 20 20 20 20 28 path*)).. (
7cb0: 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 setenv "MT_RUN_A
7cc0: 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 REA_HOME" *toppa
7cd0: 74 68 2a 29 0a 09 20 20 20 20 20 20 28 62 65 67 th*).. (beg
7ce0: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
7cf0: 74 20 30 20 22 45 52 52 4f 52 3a 20 66 61 69 6c t 0 "ERROR: fail
7d00: 65 64 20 74 6f 20 66 69 6e 64 20 74 68 65 20 74 ed to find the t
7d10: 6f 70 20 70 61 74 68 20 74 6f 20 79 6f 75 72 20 op path to your
7d20: 4d 65 67 61 74 65 73 74 20 61 72 65 61 2e 22 29 Megatest area.")
7d30: 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 20 ...(exit 1)))..
7d40: 20 29 29 29 0a 20 20 2a 74 6f 70 70 61 74 68 2a ))). *toppath*
7d50: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
7d60: 63 68 3a 63 61 63 68 65 2d 63 6f 6e 66 69 67 29 ch:cache-config)
7d70: 0a 20 20 3b 3b 20 69 66 20 77 65 20 68 61 76 65 . ;; if we have
7d80: 20 61 20 6c 69 6e 6b 74 72 65 65 20 61 6e 64 20 a linktree and
7d90: 2d 72 75 6e 74 65 73 74 73 20 61 6e 64 20 2d 74 -runtests and -t
7da0: 61 72 67 65 74 20 61 6e 64 20 74 68 65 20 64 69 arget and the di
7db0: 72 65 63 74 6f 72 79 20 65 78 69 73 74 73 20 64 rectory exists d
7dc0: 75 6d 70 20 74 68 65 20 63 6f 6e 66 69 67 0a 20 ump the config.
7dd0: 20 3b 3b 20 74 6f 20 6d 65 67 61 74 65 73 74 2d ;; to megatest-
7de0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
7df0: 29 2e 63 66 67 20 61 6e 64 20 73 79 6d 6c 69 6e ).cfg and symlin
7e00: 6b 20 69 74 20 74 6f 20 6d 65 67 61 74 65 73 74 k it to megatest
7e10: 2e 63 66 67 0a 20 20 28 69 66 20 28 61 6e 64 20 .cfg. (if (and
7e20: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 0a 09 20 20 *configdat* ..
7e30: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
7e40: 72 67 20 22 2d 72 75 6e 22 29 0a 09 20 20 20 20 rg "-run")..
7e50: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
7e60: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 29 29 0a "-runtests"))).
7e70: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 69 (let* ((li
7e80: 6e 6b 74 72 65 65 20 28 67 65 74 2d 65 6e 76 69 nktree (get-envi
7e90: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
7ea0: 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 29 "MT_LINKTREE"))
7eb0: 0a 09 20 20 20 20 20 28 74 61 72 67 65 74 20 20 .. (target
7ec0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
7ed0: 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 t-target))..
7ee0: 20 28 72 75 6e 6e 61 6d 65 20 20 28 6f 72 20 28 (runname (or (
7ef0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
7f00: 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 20 28 unname").... (
7f10: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 args:get-arg ":r
7f20: 75 6e 6e 61 6d 65 22 29 29 29 0a 09 20 20 20 20 unname")))..
7f30: 20 28 66 75 6c 6c 64 69 72 20 20 28 63 6f 6e 63 (fulldir (conc
7f40: 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 0a 09 09 linktree "/"...
7f50: 09 20 20 20 20 20 74 61 72 67 65 74 20 22 2f 22 . target "/"
7f60: 0a 09 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 .... runname
7f70: 29 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e )))..(debug:prin
7f80: 74 2d 69 6e 66 6f 20 30 20 22 48 61 76 65 20 2d t-info 0 "Have -
7f90: 72 75 6e 74 65 73 74 73 20 77 69 74 68 20 74 61 runtests with ta
7fa0: 72 67 65 74 3d 22 20 74 61 72 67 65 74 20 22 2c rget=" target ",
7fb0: 20 72 75 6e 6e 61 6d 65 3d 22 20 72 75 6e 6e 61 runname=" runna
7fc0: 6d 65 20 22 2c 20 66 75 6c 6c 64 69 72 3d 22 20 me ", fulldir="
7fd0: 66 75 6c 6c 64 69 72 20 22 2c 20 74 65 73 74 70 fulldir ", testp
7fe0: 61 74 74 3d 22 20 28 6f 72 20 28 61 72 67 73 3a att=" (or (args:
7ff0: 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 70 61 get-arg "-testpa
8000: 74 74 22 29 20 22 25 22 29 29 0a 09 28 69 66 20 tt") "%"))..(if
8010: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 (file-exists? li
8020: 6e 6b 74 72 65 65 29 20 3b 3b 20 63 61 6e 27 74 nktree) ;; can't
8030: 20 70 72 6f 63 65 65 64 20 77 69 74 68 6f 75 74 proceed without
8040: 20 6c 69 6e 6b 74 72 65 65 0a 09 20 20 20 20 28 linktree.. (
8050: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 69 66 begin.. (if
8060: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
8070: 74 73 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 ts? fulldir))...
8080: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
8090: 6f 72 79 20 66 75 6c 6c 64 69 72 20 23 74 29 29 ory fulldir #t))
80a0: 20 3b 3b 20 6e 65 65 64 20 74 6f 20 70 72 6f 74 ;; need to prot
80b0: 65 63 74 20 77 69 74 68 20 65 78 63 65 70 74 69 ect with excepti
80c0: 6f 6e 20 68 61 6e 64 6c 65 72 20 0a 09 20 20 20 on handler ..
80d0: 20 20 20 28 69 66 20 28 61 6e 64 20 74 61 72 67 (if (and targ
80e0: 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e et... runn
80f0: 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 66 69 ame... (fi
8100: 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 64 le-exists? fulld
8110: 69 72 29 29 0a 09 09 20 20 28 6c 65 74 20 28 28 ir))... (let ((
8120: 74 6d 70 66 69 6c 65 20 20 28 63 6f 6e 63 20 66 tmpfile (conc f
8130: 75 6c 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 65 ulldir "/.megate
8140: 73 74 2e 63 66 67 2e 22 20 28 63 75 72 72 65 6e st.cfg." (curren
8150: 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 09 t-seconds)))....
8160: 28 74 61 72 67 66 69 6c 65 20 28 63 6f 6e 63 20 (targfile (conc
8170: 66 75 6c 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 fulldir "/.megat
8180: 65 73 74 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 est.cfg-" megat
8190: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 est-version "-"
81a0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
81b0: 68 61 73 68 29 29 29 0a 09 09 20 20 20 20 28 64 hash)))... (d
81c0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
81d0: 30 20 22 43 61 63 68 69 6e 67 20 6d 65 67 61 74 0 "Caching megat
81e0: 65 73 74 2e 63 6f 6e 66 69 67 20 69 6e 20 22 20 est.config in "
81f0: 66 75 6c 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 fulldir "/.megat
8200: 65 73 74 2e 63 66 67 22 29 0a 09 09 20 20 20 20 est.cfg")...
8210: 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 (configf:write-a
8220: 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a list *configdat*
8230: 20 74 6d 70 66 69 6c 65 29 0a 09 09 20 20 20 20 tmpfile)...
8240: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6c (system (conc "l
8250: 6e 20 2d 73 66 20 22 20 74 6d 70 66 69 6c 65 20 n -sf " tmpfile
8260: 22 20 22 20 74 61 72 67 66 69 6c 65 29 29 0a 09 " " targfile))..
8270: 09 20 20 20 20 29 29 29 29 29 29 29 0a 0a 28 64 . )))))))..(d
8280: 65 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d efine (get-best-
8290: 64 69 73 6b 20 63 6f 6e 66 64 61 74 20 74 65 73 disk confdat tes
82a0: 74 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a tconfig). (let*
82b0: 20 28 28 64 69 73 6b 73 20 20 20 28 6f 72 20 28 ((disks (or (
82c0: 61 6e 64 20 74 65 73 74 63 6f 6e 66 69 67 20 28 and testconfig (
82d0: 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
82e0: 65 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 efault testconfi
82f0: 67 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 g "disks" #f))..
8300: 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 . (hash-tab
8310: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 le-ref/default c
8320: 6f 6e 66 64 61 74 20 22 64 69 73 6b 73 22 20 23 onfdat "disks" #
8330: 66 29 29 29 0a 09 20 28 6d 69 6e 73 70 61 63 65 f))).. (minspace
8340: 20 28 6c 65 74 20 28 28 6d 20 28 63 6f 6e 66 69 (let ((m (confi
8350: 67 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 64 61 gf:lookup confda
8360: 74 20 22 73 65 74 75 70 22 20 22 6d 69 6e 73 70 t "setup" "minsp
8370: 61 63 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 ace")))... (
8380: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
8390: 6f 72 20 6d 20 22 31 30 30 30 30 22 29 29 29 29 or m "10000"))))
83a0: 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 ). (if disks
83b0: 0a 09 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f ..(let ((res (co
83c0: 6d 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 2d 77 69 mmon:get-disk-wi
83d0: 74 68 2d 6d 6f 73 74 2d 66 72 65 65 2d 73 70 61 th-most-free-spa
83e0: 63 65 20 64 69 73 6b 73 20 6d 69 6e 73 70 61 63 ce disks minspac
83f0: 65 29 29 29 20 3b 3b 20 6d 69 6e 20 73 69 7a 65 e))) ;; min size
8400: 20 6f 66 20 31 30 30 30 2c 20 73 65 65 6d 73 20 of 1000, seems
8410: 74 61 64 20 64 75 6d 62 0a 09 20 20 28 69 66 20 tad dumb.. (if
8420: 72 65 73 0a 09 20 20 20 20 20 20 28 63 64 72 20 res.. (cdr
8430: 72 65 73 29 0a 09 20 20 20 20 20 20 28 62 65 67 res).. (beg
8440: 69 6e 0a 09 09 28 69 66 20 28 63 6f 6d 6d 6f 6e in...(if (common
8450: 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 :low-noise-print
8460: 20 32 30 20 22 6e 6f 20 76 61 6c 69 64 20 64 69 20 "no valid di
8470: 73 6b 73 22 29 0a 09 09 20 20 20 20 28 64 65 62 sks")... (deb
8480: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
8490: 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 73 6b R: No valid disk
84a0: 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 61 74 s found in megat
84b0: 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c 65 61 est.config. Plea
84c0: 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f 20 79 se add some to y
84d0: 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 our [disks] sect
84e0: 69 6f 6e 20 61 6e 64 20 65 6e 73 75 72 65 20 74 ion and ensure t
84f0: 68 65 20 64 69 72 65 63 74 6f 72 79 20 65 78 69 he directory exi
8500: 73 74 73 21 22 29 29 0a 09 09 28 65 78 69 74 20 sts!"))...(exit
8510: 31 29 29 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 1)))))))..;; Des
8520: 69 72 65 64 20 64 69 72 65 63 74 6f 72 79 20 73 ired directory s
8530: 74 72 75 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 tructure:.;;.;;
8540: 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 <linkdir> - <ta
8550: 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d rget> - <testnam
8560: 65 3e 20 2d 2e 0a 3b 3b 20 20 20 20 20 20 20 20 e> -..;;
8570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8580: 20 20 20 20 20 20 20 20 20 20 20 20 20 7c 0a 3b |.;
8590: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
85a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85b0: 20 20 20 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e v.;; <run
85c0: 64 69 72 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 dir> - <target
85d0: 3e 20 20 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d > - <testnam
85e0: 65 3e 20 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 e> -|- <itempath
85f0: 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 (s)>.;;.;; dir
8600: 73 74 6f 72 65 64 20 69 6e 20 74 65 73 74 20 69 stored in test i
8610: 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b s:.;; .;; <link
8620: 64 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 dir> - <target>
8630: 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d - <testname> [ -
8640: 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b <itempath> ].;;
8650: 20 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c .;; All log fil
8660: 65 20 6c 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 e links should b
8670: 65 20 73 74 6f 72 65 64 20 72 65 6c 61 74 69 76 e stored relativ
8680: 65 20 74 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 e to the top of
8690: 6c 69 6e 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b link path.;; .;
86a0: 3b 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 ; <target> - <te
86b0: 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 stname> [ - <ite
86c0: 6d 70 61 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 mpath> ] .;;.(de
86d0: 66 69 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 fine (create-wor
86e0: 6b 2d 61 72 65 61 20 72 75 6e 2d 69 64 20 72 75 k-area run-id ru
86f0: 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 n-info keyvals t
8700: 65 73 74 2d 69 64 20 74 65 73 74 2d 73 72 63 2d est-id test-src-
8710: 70 61 74 68 20 64 69 73 6b 2d 70 61 74 68 20 74 path disk-path t
8720: 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 estname itemdat
8730: 23 21 6b 65 79 20 28 72 65 6d 74 72 69 65 73 20 #!key (remtries
8740: 32 29 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 74 2)). (let* ((it
8750: 65 6d 2d 70 61 74 68 20 28 69 66 20 28 73 74 72 em-path (if (str
8760: 69 6e 67 3f 20 69 74 65 6d 64 61 74 29 20 69 74 ing? itemdat) it
8770: 65 6d 64 61 74 20 28 69 74 65 6d 2d 6c 69 73 74 emdat (item-list
8780: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
8790: 29 20 3b 3b 20 69 66 20 70 61 73 73 20 69 6e 20 ) ;; if pass in
87a0: 73 74 72 69 6e 67 20 2d 20 6a 75 73 74 20 75 73 string - just us
87b0: 65 20 69 74 0a 09 20 28 72 75 6e 6e 61 6d 65 20 e it.. (runname
87c0: 20 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 72 (if (string? r
87d0: 75 6e 2d 69 6e 66 6f 29 20 3b 3b 20 69 66 20 77 un-info) ;; if w
87e0: 65 20 70 61 73 73 20 69 6e 20 61 20 73 74 72 69 e pass in a stri
87f0: 6e 67 20 61 73 20 72 75 6e 2d 69 6e 66 6f 20 75 ng as run-info u
8800: 73 65 20 69 74 20 61 73 20 72 75 6e 2d 6e 61 6d se it as run-nam
8810: 65 2e 0a 09 09 09 72 75 6e 2d 69 6e 66 6f 0a 09 e.....run-info..
8820: 09 09 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 2d ..(db:get-value-
8830: 62 79 2d 68 65 61 64 65 72 20 28 64 62 3a 67 65 by-header (db:ge
8840: 74 2d 72 6f 77 73 20 72 75 6e 2d 69 6e 66 6f 29 t-rows run-info)
8850: 0a 09 09 09 09 09 09 28 64 62 3a 67 65 74 2d 68 .......(db:get-h
8860: 65 61 64 65 72 20 72 75 6e 2d 69 6e 66 6f 29 0a eader run-info).
8870: 09 09 09 09 09 09 22 72 75 6e 6e 61 6d 65 22 29 ......"runname")
8880: 29 29 0a 09 20 3b 3b 20 63 6f 6e 76 65 72 74 20 )).. ;; convert
8890: 62 61 63 6b 20 74 6f 20 64 62 3a 20 66 72 6f 6d back to db: from
88a0: 20 72 64 62 3a 20 2d 20 74 68 69 73 20 69 73 20 rdb: - this is
88b0: 61 6c 77 61 79 73 20 72 75 6e 20 61 74 20 73 65 always run at se
88c0: 72 76 65 72 20 65 6e 64 0a 09 20 28 74 61 72 67 rver end.. (targ
88d0: 65 74 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 et (string-int
88e0: 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 ersperse (map ca
88f0: 64 72 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 dr keyvals) "/")
8900: 29 0a 0a 09 20 28 6e 6f 74 2d 69 74 65 72 61 74 )... (not-iterat
8910: 65 64 20 20 28 65 71 75 61 6c 3f 20 22 22 20 69 ed (equal? "" i
8920: 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b tem-path))... ;;
8930: 20 61 6c 6c 20 74 65 73 74 73 20 61 72 65 20 66 all tests are f
8940: 6f 75 6e 64 20 61 74 20 3c 72 75 6e 64 69 72 3e ound at <rundir>
8950: 2f 74 65 73 74 2d 62 61 73 65 20 6f 72 20 3c 6c /test-base or <l
8960: 69 6e 6b 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 inkdir>/test-bas
8970: 65 0a 09 20 28 74 65 73 74 74 6f 70 2d 62 61 73 e.. (testtop-bas
8980: 65 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 e (conc target "
8990: 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 /" runname "/" t
89a0: 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 74 65 73 estname)).. (tes
89b0: 74 2d 62 61 73 65 20 20 20 20 28 63 6f 6e 63 20 t-base (conc
89c0: 74 65 73 74 74 6f 70 2d 62 61 73 65 20 28 69 66 testtop-base (if
89d0: 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 22 not-iterated ""
89e0: 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 29 "/") item-path)
89f0: 29 0a 0a 09 20 3b 3b 20 6e 62 2f 2f 20 69 66 20 )... ;; nb// if
8a00: 69 74 65 6d 70 61 74 68 20 69 73 20 6e 6f 74 20 itempath is not
8a10: 22 22 20 74 68 65 6e 20 69 74 20 69 73 20 70 72 "" then it is pr
8a20: 65 66 69 78 65 64 20 77 69 74 68 20 22 2f 22 0a efixed with "/".
8a30: 09 20 28 74 6f 70 74 65 73 74 2d 70 61 74 68 20 . (toptest-path
8a40: 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 (conc disk-path
8a50: 22 2f 22 20 74 65 73 74 74 6f 70 2d 62 61 73 65 "/" testtop-base
8a60: 29 29 0a 09 20 28 74 65 73 74 2d 70 61 74 68 20 )).. (test-path
8a70: 20 20 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 61 (conc disk-pa
8a80: 74 68 20 22 2f 22 20 74 65 73 74 2d 62 61 73 65 th "/" test-base
8a90: 29 29 0a 0a 09 20 3b 3b 20 65 6e 73 75 72 65 20 ))... ;; ensure
8aa0: 74 68 69 73 20 65 78 69 73 74 73 20 66 69 72 73 this exists firs
8ab0: 74 20 61 73 20 6c 69 6e 6b 73 20 74 6f 20 73 75 t as links to su
8ac0: 62 74 65 73 74 73 20 6d 75 73 74 20 62 65 20 63 btests must be c
8ad0: 72 65 61 74 65 64 20 74 68 65 72 65 0a 09 20 28 reated there.. (
8ae0: 6c 69 6e 6b 74 72 65 65 20 20 28 6c 65 74 20 28 linktree (let (
8af0: 28 72 64 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b (rd (config-look
8b00: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
8b10: 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 setup" "linktree
8b20: 22 29 29 29 0a 09 09 20 20 20 20 20 20 28 69 66 ")))... (if
8b30: 20 72 64 20 72 64 20 28 63 6f 6e 63 20 2a 74 6f rd rd (conc *to
8b40: 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 22 29 29 ppath* "/runs"))
8b50: 29 29 0a 0a 09 20 28 6c 6e 6b 62 61 73 65 20 20 ))... (lnkbase
8b60: 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 (conc linktree
8b70: 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 "/" target "/" r
8b80: 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 unname)).. (lnkp
8b90: 61 74 68 20 20 20 28 63 6f 6e 63 20 6c 6e 6b 62 ath (conc lnkb
8ba0: 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ase "/" testname
8bb0: 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 20 20 )).. (lnkpathf
8bc0: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 69 (conc lnkpath (i
8bd0: 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 f not-iterated "
8be0: 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 " "/") item-path
8bf0: 29 29 0a 09 20 28 6c 6e 6b 74 61 72 67 65 74 20 )).. (lnktarget
8c00: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
8c10: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a " item-path)))..
8c20: 20 20 20 20 3b 3b 20 55 70 64 61 74 65 20 74 68 ;; Update th
8c30: 65 20 72 75 6e 64 69 72 20 70 61 74 68 20 69 6e e rundir path in
8c40: 20 74 68 65 20 74 65 73 74 20 72 65 63 6f 72 64 the test record
8c50: 20 66 6f 72 20 61 6c 6c 2c 20 72 75 6e 64 69 72 for all, rundir
8c60: 3d 70 68 79 73 69 63 61 6c 2c 20 73 68 6f 72 74 =physical, short
8c70: 64 69 72 3d 6c 6f 67 69 63 61 6c 0a 20 20 20 20 dir=logical.
8c80: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
8c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8cb0: 20 20 20 72 75 6e 64 69 72 20 20 20 73 68 6f 72 rundir shor
8cc0: 74 64 69 72 0a 20 20 20 20 28 72 6d 74 3a 67 65 tdir. (rmt:ge
8cd0: 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 65 73 74 neral-call 'test
8ce0: 2d 73 65 74 2d 72 75 6e 64 69 72 2d 73 68 6f 72 -set-rundir-shor
8cf0: 74 64 69 72 20 72 75 6e 2d 69 64 20 6c 6e 6b 70 tdir run-id lnkp
8d00: 61 74 68 66 20 74 65 73 74 2d 70 61 74 68 20 74 athf test-path t
8d10: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
8d20: 68 29 0a 0a 20 20 20 20 28 64 65 62 75 67 3a 70 h).. (debug:p
8d30: 72 69 6e 74 20 32 20 22 49 4e 46 4f 3a 5c 6e 20 rint 2 "INFO:\n
8d40: 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d 22 20 lnkbase="
8d50: 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 20 20 lnkbase "\n
8d60: 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 lnkpath=" lnkp
8d70: 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 73 74 ath "\n toptest
8d80: 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 74 2d -path=" toptest-
8d90: 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 65 73 path "\n tes
8da0: 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d 70 61 t-path=" test-pa
8db0: 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 th). (if (not
8dc0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c (file-exists? l
8dd0: 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 67 69 inktree))..(begi
8de0: 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e n.. (debug:prin
8df0: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 6c 69 t 0 "WARNING: li
8e00: 6e 6b 74 72 65 65 20 64 69 64 20 6e 6f 74 20 65 nktree did not e
8e10: 78 69 73 74 21 20 43 72 65 61 74 69 6e 67 20 69 xist! Creating i
8e20: 74 20 6e 6f 77 20 61 74 20 22 20 6c 69 6e 6b 74 t now at " linkt
8e30: 72 65 65 29 0a 09 20 20 28 63 72 65 61 74 65 2d ree).. (create-
8e40: 64 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b 74 72 directory linktr
8e50: 65 65 20 23 74 29 29 29 20 3b 3b 20 28 73 79 73 ee #t))) ;; (sys
8e60: 74 65 6d 20 28 63 6f 6e 63 20 22 6d 6b 64 69 72 tem (conc "mkdir
8e70: 20 2d 70 20 22 20 6c 69 6e 6b 74 72 65 65 29 29 -p " linktree))
8e80: 29 29 0a 20 20 20 20 3b 3b 20 63 72 65 61 74 65 )). ;; create
8e90: 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 66 the directory f
8ea0: 6f 72 20 74 68 65 20 74 65 73 74 73 20 64 69 72 or the tests dir
8eb0: 20 6c 69 6e 6b 73 2c 20 74 68 69 73 20 69 73 20 links, this is
8ec0: 6e 65 65 64 65 64 20 6e 6f 20 6d 61 74 74 65 72 needed no matter
8ed0: 20 77 68 61 74 2e 2e 2e 0a 20 20 20 20 28 69 66 what.... (if
8ee0: 20 28 61 6e 64 20 28 6e 6f 74 20 28 64 69 72 65 (and (not (dire
8ef0: 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e ctory-exists? ln
8f00: 6b 62 61 73 65 29 29 0a 09 20 20 20 20 20 28 6e kbase)).. (n
8f10: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
8f20: 20 6c 6e 6b 62 61 73 65 29 29 29 0a 09 28 68 61 lnkbase)))..(ha
8f30: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
8f40: 09 20 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 . exn.. (begin..
8f50: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
8f60: 22 45 52 52 4f 52 3a 20 50 72 6f 62 6c 65 6d 20 "ERROR: Problem
8f70: 63 72 65 61 74 69 6e 67 20 6c 69 6e 6b 74 72 65 creating linktre
8f80: 65 20 62 61 73 65 20 61 74 20 22 20 6c 6e 6b 62 e base at " lnkb
8f90: 61 73 65 29 0a 09 20 20 20 28 70 72 69 6e 74 2d ase).. (print-
8fa0: 65 72 72 6f 72 2d 6d 65 73 73 61 67 65 20 65 78 error-message ex
8fb0: 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 n (current-error
8fc0: 2d 70 6f 72 74 29 29 29 0a 09 20 28 63 72 65 61 -port))).. (crea
8fd0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b te-directory lnk
8fe0: 62 61 73 65 20 23 74 29 29 29 0a 20 20 20 20 0a base #t))). .
8ff0: 20 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 68 ;; update th
9000: 65 20 74 6f 70 74 65 73 74 20 72 65 63 6f 72 64 e toptest record
9010: 20 77 69 74 68 20 69 74 73 20 6c 6f 63 61 74 69 with its locati
9020: 6f 6e 20 72 75 6e 64 69 72 2c 20 63 61 63 68 65 on rundir, cache
9030: 20 74 68 65 20 70 61 74 68 0a 20 20 20 20 3b 3b the path. ;;
9040: 20 54 68 69 73 20 77 61 73 73 20 68 69 67 68 6c This wass highl
9050: 79 20 69 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f y inefficient, o
9060: 6e 65 20 64 62 20 77 72 69 74 65 20 66 6f 72 20 ne db write for
9070: 65 76 65 72 79 20 73 75 62 74 65 73 74 2c 20 70 every subtest, p
9080: 6f 74 65 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b otentially. ;
9090: 3b 20 74 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 ; thousands of u
90a0: 6e 6e 65 63 65 73 73 61 72 79 20 75 70 64 61 74 nnecessary updat
90b0: 65 73 2c 20 63 61 63 68 65 20 74 68 65 20 66 61 es, cache the fa
90c0: 63 74 20 69 74 20 77 61 73 20 73 65 74 20 61 6e ct it was set an
90d0: 64 20 64 6f 6e 27 74 20 73 65 74 20 69 74 20 0a d don't set it .
90e0: 20 20 20 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a ;; again. ..
90f0: 20 20 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 ;; Now creat
9100: 65 20 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 e the link from
9110: 74 68 65 20 74 65 73 74 20 70 61 74 68 20 74 6f the test path to
9120: 20 74 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 the link tree,
9130: 68 6f 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 however. ;; i
9140: 66 20 74 68 65 20 74 65 73 74 20 69 73 20 69 74 f the test is it
9150: 65 72 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 erated it is nec
9160: 65 73 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 essary to create
9170: 20 74 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 the parent path
9180: 0a 20 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 . ;; to the i
9190: 74 65 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 teration. use pa
91a0: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
91b0: 20 74 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 to trim the pat
91c0: 68 20 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 h by one. ;;
91d0: 6c 65 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e level. (if (n
91e0: 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 ot not-iterated)
91f0: 20 3b 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 ;; i.e. iterate
9200: 64 0a 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 d..(let ((iterat
9210: 65 64 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 ed-parent (path
9220: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 name-directory (
9230: 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 conc lnkpath "/"
9240: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 item-path))))..
9250: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
9260: 6e 66 6f 20 32 20 22 43 72 65 61 74 69 6e 67 20 nfo 2 "Creating
9270: 69 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 iterated parent
9280: 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e " iterated-paren
9290: 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 t).. (handle-ex
92a0: 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e ceptions.. exn
92b0: 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 .. (begin..
92c0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
92d0: 20 22 45 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 "ERROR: Failed
92e0: 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 to create direc
92f0: 74 6f 72 79 20 22 20 69 74 65 72 61 74 65 64 2d tory " iterated-
9300: 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 69 74 69 parent ((conditi
9310: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
9320: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
9330: 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 ge) exn) ", exit
9340: 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 ing").. (exi
9350: 74 20 31 29 29 0a 09 20 20 20 28 63 72 65 61 74 t 1)).. (creat
9360: 65 2d 64 69 72 65 63 74 6f 72 79 20 69 74 65 72 e-directory iter
9370: 61 74 65 64 2d 70 61 72 65 6e 74 20 23 74 29 29 ated-parent #t))
9380: 29 29 0a 0a 20 20 20 20 28 69 66 20 28 73 79 6d )).. (if (sym
9390: 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 bolic-link? lnkp
93a0: 61 74 68 29 20 0a 09 28 68 61 6e 64 6c 65 2d 65 ath) ..(handle-e
93b0: 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a xceptions.. exn.
93c0: 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 . (begin.. (de
93d0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
93e0: 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 72 OR: Failed to r
93f0: 65 6d 6f 76 65 20 73 79 6d 6c 69 6e 6b 20 22 20 emove symlink "
9400: 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 74 lnkpath ((condit
9410: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
9420: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
9430: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 age) exn) ", exi
9440: 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 69 74 ting").. (exit
9450: 20 31 29 29 0a 09 20 28 64 65 6c 65 74 65 2d 66 1)).. (delete-f
9460: 69 6c 65 20 6c 6e 6b 70 61 74 68 29 29 29 0a 0a ile lnkpath)))..
9470: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 (if (not (or
9480: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c (file-exists? l
9490: 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 79 6d 62 nkpath)... (symb
94a0: 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 olic-link? lnkpa
94b0: 74 68 29 29 29 0a 09 28 68 61 6e 64 6c 65 2d 65 th)))..(handle-e
94c0: 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a xceptions.. exn.
94d0: 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 . (begin.. (de
94e0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
94f0: 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 63 OR: Failed to c
9500: 72 65 61 74 65 20 73 79 6d 6c 69 6e 6b 20 22 20 reate symlink "
9510: 6c 6e 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 74 lnkpath ((condit
9520: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
9530: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
9540: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 age) exn) ", exi
9550: 74 69 6e 67 22 29 0a 09 20 20 20 28 65 78 69 74 ting").. (exit
9560: 20 31 29 29 0a 09 20 28 63 72 65 61 74 65 2d 73 1)).. (create-s
9570: 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 ymbolic-link top
9580: 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 test-path lnkpat
9590: 68 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b h))). . ;;
95a0: 20 4e 42 20 2d 20 54 68 69 73 20 77 61 73 20 6e NB - This was n
95b0: 6f 74 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 ot working right
95c0: 20 2d 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 - some top test
95d0: 73 20 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e s are not gettin
95e0: 67 20 74 68 65 20 70 61 74 68 20 73 65 74 21 21 g the path set!!
95f0: 21 0a 20 20 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 !. ;;. ;;
9600: 44 6f 20 74 68 65 20 73 65 74 74 69 6e 67 20 6f Do the setting o
9610: 66 20 74 68 69 73 20 72 65 63 6f 72 64 20 61 66 f this record af
9620: 74 65 72 20 74 68 65 20 70 61 74 68 73 20 61 72 ter the paths ar
9630: 65 20 63 72 65 61 74 65 64 20 73 6f 20 74 68 61 e created so tha
9640: 74 20 74 68 65 20 73 68 6f 72 74 64 69 72 20 63 t the shortdir c
9650: 61 6e 20 0a 20 20 20 20 3b 3b 20 62 65 20 73 65 an . ;; be se
9660: 74 20 74 6f 20 74 68 65 20 72 65 61 6c 20 64 69 t to the real di
9670: 72 65 63 74 6f 72 79 20 6c 6f 63 61 74 69 6f 6e rectory location
9680: 2e 20 54 68 69 73 20 69 73 20 73 61 66 65 72 20 . This is safer
9690: 66 6f 72 20 66 75 74 75 72 65 20 63 6c 65 61 6e for future clean
96a0: 20 75 70 20 69 66 20 74 68 65 20 6c 69 6e 6b 0a up if the link.
96b0: 20 20 20 20 3b 3b 20 74 72 65 65 20 69 73 20 64 ;; tree is d
96c0: 61 6d 61 67 65 64 20 6f 72 20 6c 6f 73 74 2e 0a amaged or lost..
96d0: 20 20 20 20 3b 3b 20 0a 20 20 20 20 28 69 66 20 ;; . (if
96e0: 28 6e 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 (not (hash-table
96f0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 6f -ref/default *to
9700: 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 ptest-paths* tes
9710: 74 6e 61 6d 65 20 23 66 29 29 0a 09 28 6c 65 74 tname #f))..(let
9720: 2a 20 28 28 74 65 73 74 69 6e 66 6f 20 20 20 20 * ((testinfo
9730: 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 (rmt:get-test
9740: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d -info-by-id run-
9750: 69 64 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 id test-id)) ;;
9760: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
9770: 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 item-path))..
9780: 20 20 20 20 20 28 63 75 72 72 2d 74 65 73 74 2d (curr-test-
9790: 70 61 74 68 20 28 69 66 20 74 65 73 74 69 6e 66 path (if testinf
97a0: 6f 20 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 o ;; (filedb:get
97b0: 2d 70 61 74 68 20 2a 66 64 62 2a 0a 09 09 09 09 -path *fdb*.....
97c0: 09 09 09 20 20 20 20 20 3b 3b 20 28 64 62 3a 67 ... ;; (db:g
97d0: 65 74 2d 70 61 74 68 20 64 62 73 74 72 75 63 74 et-path dbstruct
97e0: 0a 09 09 09 09 20 20 20 3b 3b 20 28 72 6d 74 3a ..... ;; (rmt:
97f0: 73 64 62 2d 71 72 79 20 27 67 65 74 73 74 72 20 sdb-qry 'getstr
9800: 0a 09 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 ..... (db:test
9810: 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 -get-rundir test
9820: 69 6e 66 6f 29 20 3b 3b 20 29 20 3b 3b 20 29 0a info) ;; ) ;; ).
9830: 09 09 09 09 20 20 20 23 66 29 29 29 0a 09 20 20 .... #f)))..
9840: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
9850: 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a *toptest-paths*
9860: 20 74 65 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 testname curr-t
9870: 65 73 74 2d 70 61 74 68 29 0a 09 20 20 3b 3b 20 est-path).. ;;
9880: 4e 42 2f 2f 20 57 61 73 20 74 68 69 73 20 66 6f NB// Was this fo
9890: 72 20 74 68 65 20 74 65 73 74 20 6f 72 20 66 6f r the test or fo
98a0: 72 20 74 68 65 20 70 61 72 65 6e 74 20 69 6e 20 r the parent in
98b0: 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 an iterated test
98c0: 3f 0a 09 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 ?.. (rmt:genera
98d0: 6c 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 l-call 'test-set
98e0: 2d 72 75 6e 64 69 72 2d 73 68 6f 72 74 64 69 72 -rundir-shortdir
98f0: 20 72 75 6e 2d 69 64 20 6c 6e 6b 70 61 74 68 20 run-id lnkpath
9900: 0a 09 09 09 20 20 20 20 28 69 66 20 28 66 69 6c .... (if (fil
9910: 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 61 74 e-exists? lnkpat
9920: 68 29 0a 09 09 09 09 28 72 65 73 6f 6c 76 65 2d h).....(resolve-
9930: 70 61 74 68 6e 61 6d 65 20 6c 6e 6b 70 61 74 68 pathname lnkpath
9940: 29 0a 09 09 09 09 6c 6e 6b 70 61 74 68 29 0a 09 ).....lnkpath)..
9950: 09 09 20 20 20 20 74 65 73 74 6e 61 6d 65 20 22 .. testname "
9960: 22 29 0a 09 20 20 3b 3b 20 28 72 6d 74 3a 67 65 ").. ;; (rmt:ge
9970: 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 65 73 74 neral-call 'test
9980: 2d 73 65 74 2d 72 75 6e 64 69 72 20 72 75 6e 2d -set-rundir run-
9990: 69 64 20 6c 6e 6b 70 61 74 68 20 74 65 73 74 6e id lnkpath testn
99a0: 61 6d 65 20 22 22 29 20 3b 3b 20 74 6f 70 74 65 ame "") ;; topte
99b0: 73 74 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 st-path).. (if
99c0: 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 (or (not curr-te
99d0: 73 74 2d 70 61 74 68 29 0a 09 09 20 20 28 6e 6f st-path)... (no
99e0: 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 t (directory-exi
99f0: 73 74 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 sts? toptest-pat
9a00: 68 29 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 h))).. (beg
9a10: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
9a20: 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 74 69 t-info 2 "Creati
9a30: 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 ng " toptest-pat
9a40: 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c h " and link " l
9a50: 6e 6b 70 61 74 68 29 0a 09 09 28 68 61 6e 64 6c nkpath)...(handl
9a60: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 e-exceptions...
9a70: 65 78 6e 0a 09 09 20 23 66 20 3b 3b 20 64 6f 6e exn... #f ;; don
9a80: 27 74 20 63 61 72 65 20 74 6f 20 63 61 74 63 68 't care to catch
9a90: 20 61 6e 64 20 64 65 61 6c 20 77 69 74 68 20 65 and deal with e
9aa0: 72 72 6f 72 73 20 68 65 72 65 20 66 6f 72 20 6e rrors here for n
9ab0: 6f 77 2e 0a 09 09 20 28 63 72 65 61 74 65 2d 64 ow.... (create-d
9ac0: 69 72 65 63 74 6f 72 79 20 74 6f 70 74 65 73 74 irectory toptest
9ad0: 2d 70 61 74 68 20 23 74 29 29 0a 09 09 28 68 61 -path #t))...(ha
9ae0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
9af0: 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
9b00: 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d 70 stname toptest-p
9b10: 61 74 68 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b ath))))).. ;;
9b20: 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 74 The toptest pat
9b30: 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 74 h has been creat
9b40: 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 ed, the link to
9b50: 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 20 the test in the
9b60: 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 20 linktree has.
9b70: 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 64 ;; been created
9b80: 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 69 . Now, if this i
9b90: 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 s an iterated te
9ba0: 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 74 st the real test
9bb0: 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 65 dir must be cre
9bc0: 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e 6f ated. (if (no
9bd0: 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 t not-iterated)
9be0: 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 ;; this is an it
9bf0: 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 62 65 erated test..(be
9c00: 67 69 6e 20 3b 3b 20 28 6c 65 74 20 28 28 6c 6e gin ;; (let ((ln
9c10: 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e ktarget (conc ln
9c20: 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 kpath "/" item-p
9c30: 61 74 68 29 29 29 0a 09 20 20 28 64 65 62 75 67 ath))).. (debug
9c40: 3a 70 72 69 6e 74 20 32 20 22 53 65 74 74 69 6e :print 2 "Settin
9c50: 67 20 75 70 20 73 75 62 20 74 65 73 74 20 72 75 g up sub test ru
9c60: 6e 20 61 72 65 61 22 29 0a 09 20 20 28 64 65 62 n area").. (deb
9c70: 75 67 3a 70 72 69 6e 74 20 32 20 22 20 2d 20 63 ug:print 2 " - c
9c80: 72 65 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 reating run area
9c90: 20 69 6e 20 22 20 74 65 73 74 2d 70 61 74 68 29 in " test-path)
9ca0: 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 .. (handle-exce
9cb0: 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 ptions.. exn..
9cc0: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
9cd0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
9ce0: 45 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 ERROR: Failed t
9cf0: 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 74 6f o create directo
9d00: 72 79 20 22 20 74 65 73 74 2d 70 61 74 68 20 28 ry " test-path (
9d10: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
9d20: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
9d30: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
9d40: 20 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 ", exiting")..
9d50: 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 (exit 1))..
9d60: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
9d70: 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 ory test-path #t
9d80: 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
9d90: 6e 74 20 32 20 0a 09 09 20 20 20 20 20 20 20 22 nt 2 ... "
9da0: 20 2d 20 63 72 65 61 74 69 6e 67 20 6c 69 6e 6b - creating link
9db0: 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 2d 70 61 from: " test-pa
9dc0: 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 20 20 20 th "\n"...
9dd0: 20 22 20 20 20 20 20 20 20 20 20 20 20 20 20 20 "
9de0: 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e 6b 74 61 to: " lnkta
9df0: 72 67 65 74 29 0a 0a 09 20 20 3b 3b 20 49 66 20 rget)... ;; If
9e00: 74 68 65 72 65 20 69 73 20 61 6c 72 65 61 64 79 there is already
9e10: 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 6c 65 74 a symlink delet
9e20: 65 20 69 74 20 61 6e 64 20 72 65 63 72 65 61 74 e it and recreat
9e30: 65 20 69 74 2e 0a 09 20 20 28 68 61 6e 64 6c 65 e it... (handle
9e40: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 -exceptions..
9e50: 65 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 exn.. (begin..
9e60: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
9e70: 74 20 30 20 22 45 52 52 4f 52 3a 20 20 46 61 69 t 0 "ERROR: Fai
9e80: 6c 65 64 20 74 6f 20 72 65 2d 63 72 65 61 74 65 led to re-create
9e90: 20 6c 69 6e 6b 20 22 20 6c 6e 6b 74 61 72 67 65 link " lnktarge
9ea0: 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 t ((condition-pr
9eb0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
9ec0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
9ed0: 78 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 xn) ", exiting")
9ee0: 0a 09 20 20 20 20 20 28 65 78 69 74 29 29 0a 09 .. (exit))..
9ef0: 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 (if (symbolic
9f00: 2d 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 72 67 65 74 -link? lnktarget
9f10: 29 20 20 20 20 20 28 64 65 6c 65 74 65 2d 66 69 ) (delete-fi
9f20: 6c 65 20 6c 6e 6b 74 61 72 67 65 74 29 29 0a 09 le lnktarget))..
9f30: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c (if (not (fil
9f40: 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 74 61 72 e-exists? lnktar
9f50: 67 65 74 29 29 20 28 63 72 65 61 74 65 2d 73 79 get)) (create-sy
9f60: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 65 73 74 mbolic-link test
9f70: 2d 70 61 74 68 20 6c 6e 6b 74 61 72 67 65 74 29 -path lnktarget)
9f80: 29 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 6e )))).. (if (n
9f90: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 3f 20 74 ot (directory? t
9fa0: 65 73 74 2d 70 61 74 68 29 29 0a 09 28 63 72 65 est-path))..(cre
9fb0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 ate-directory te
9fc0: 73 74 2d 70 61 74 68 20 23 74 29 29 20 3b 3b 20 st-path #t)) ;;
9fd0: 74 68 69 73 20 69 73 20 61 20 68 61 63 6b 2c 20 this is a hack,
9fe0: 49 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 77 68 79 I don't know why
9ff0: 20 6f 75 74 20 6f 66 20 74 68 65 20 62 6c 75 65 out of the blue
a000: 20 74 68 69 73 20 70 61 74 68 20 64 6f 65 73 20 this path does
a010: 6e 6f 74 20 65 78 69 73 74 20 73 6f 6d 65 74 69 not exist someti
a020: 6d 65 73 0a 0a 20 20 20 20 28 69 66 20 28 61 6e mes.. (if (an
a030: 64 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 d test-src-path
a040: 28 64 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 (directory? test
a050: 2d 70 61 74 68 29 29 0a 09 28 62 65 67 69 6e 0a -path))..(begin.
a060: 09 20 20 28 6c 65 74 2a 20 28 28 6f 76 72 63 6d . (let* ((ovrcm
a070: 64 20 28 6c 65 74 20 28 28 63 6d 64 20 28 63 6f d (let ((cmd (co
a080: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e nfig-lookup *con
a090: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
a0a0: 22 74 65 73 74 63 6f 70 79 63 6d 64 22 29 29 29 "testcopycmd")))
a0b0: 0a 09 09 09 20 20 20 28 69 66 20 63 6d 64 0a 09 .... (if cmd..
a0c0: 09 09 20 20 20 20 20 20 20 3b 3b 20 73 75 62 73 .. ;; subs
a0d0: 74 69 74 75 74 65 20 74 68 65 20 54 45 53 54 5f titute the TEST_
a0e0: 53 52 43 5f 50 41 54 48 20 61 6e 64 20 54 45 53 SRC_PATH and TES
a0f0: 54 5f 54 41 52 47 5f 50 41 54 48 0a 09 09 09 20 T_TARG_PATH....
a100: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 (string-su
a110: 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f 54 bstitute "TEST_T
a120: 41 52 47 5f 50 41 54 48 22 20 74 65 73 74 2d 70 ARG_PATH" test-p
a130: 61 74 68 0a 09 09 09 09 09 09 20 20 28 73 74 72 ath....... (str
a140: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
a150: 54 45 53 54 5f 53 52 43 5f 50 41 54 48 22 20 74 TEST_SRC_PATH" t
a160: 65 73 74 2d 73 72 63 2d 70 61 74 68 20 63 6d 64 est-src-path cmd
a170: 20 23 74 29 20 23 74 29 0a 09 09 09 20 20 20 20 #t) #t)....
a180: 20 20 20 23 66 29 29 29 0a 09 09 20 28 63 6d 64 #f)))... (cmd
a190: 20 20 20 20 28 69 66 20 6f 76 72 63 6d 64 20 0a (if ovrcmd .
a1a0: 09 09 09 20 20 20 20 20 6f 76 72 63 6d 64 0a 09 ... ovrcmd..
a1b0: 09 09 20 20 20 20 20 28 63 6f 6e 63 20 22 72 73 .. (conc "rs
a1c0: 79 6e 63 20 2d 61 76 22 20 28 69 66 20 28 64 65 ync -av" (if (de
a1d0: 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 bug:debug-mode 1
a1e0: 29 20 22 22 20 22 71 22 29 20 22 20 22 20 74 65 ) "" "q") " " te
a1f0: 73 74 2d 73 72 63 2d 70 61 74 68 20 22 2f 20 22 st-src-path "/ "
a200: 20 74 65 73 74 2d 70 61 74 68 20 22 2f 22 0a 09 test-path "/"..
a210: 09 09 09 20 20 20 22 20 3e 3e 20 22 20 74 65 73 ... " >> " tes
a220: 74 2d 70 61 74 68 20 22 2f 6d 74 5f 6c 61 75 6e t-path "/mt_laun
a230: 63 68 2e 6c 6f 67 20 32 3e 3e 20 22 20 74 65 73 ch.log 2>> " tes
a240: 74 2d 70 61 74 68 20 22 2f 6d 74 5f 6c 61 75 6e t-path "/mt_laun
a250: 63 68 2e 6c 6f 67 22 29 29 29 0a 09 09 20 28 73 ch.log")))... (s
a260: 74 61 74 75 73 20 28 73 79 73 74 65 6d 20 63 6d tatus (system cm
a270: 64 29 29 29 0a 09 20 20 20 20 28 69 66 20 28 6e d))).. (if (n
a280: 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 20 30 ot (eq? status 0
a290: 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e ))...(debug:prin
a2a0: 74 20 32 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 t 2 "ERROR: prob
a2b0: 6c 65 6d 20 77 69 74 68 20 72 75 6e 6e 69 6e 67 lem with running
a2c0: 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 29 29 \"" cmd "\"")))
a2d0: 0a 09 20 20 28 6c 69 73 74 20 6c 6e 6b 70 61 74 .. (list lnkpat
a2e0: 68 66 20 6c 6e 6b 70 61 74 68 20 29 29 0a 09 28 hf lnkpath ))..(
a2f0: 69 66 20 28 61 6e 64 20 74 65 73 74 2d 73 72 63 if (and test-src
a300: 2d 70 61 74 68 20 28 3e 20 72 65 6d 74 72 69 65 -path (> remtrie
a310: 73 20 30 29 29 0a 09 20 20 20 20 28 62 65 67 69 s 0)).. (begi
a320: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
a330: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
a340: 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 Failed to create
a350: 20 77 6f 72 6b 20 61 72 65 61 20 61 74 20 22 20 work area at "
a360: 74 65 73 74 2d 70 61 74 68 20 22 20 77 69 74 68 test-path " with
a370: 20 6c 69 6e 6b 20 61 74 20 22 20 6c 6e 6b 74 61 link at " lnkta
a380: 72 67 65 74 20 22 2c 20 72 65 6d 61 69 6e 69 6e rget ", remainin
a390: 67 20 61 74 74 65 6d 70 74 73 20 22 20 72 65 6d g attempts " rem
a3a0: 74 72 69 65 73 29 0a 09 20 20 20 20 20 20 3b 3b tries).. ;;
a3b0: 20 0a 09 20 20 20 20 20 20 28 63 72 65 61 74 65 .. (create
a3c0: 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 2d 69 -work-area run-i
a3d0: 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 d run-info keyva
a3e0: 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d ls test-id test-
a3f0: 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 src-path disk-pa
a400: 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d th testname item
a410: 64 61 74 20 72 65 6d 74 72 69 65 73 3a 20 28 2d dat remtries: (-
a420: 20 72 65 6d 74 72 69 65 73 20 31 29 29 29 0a 09 remtries 1)))..
a430: 20 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 29 (list #f #f)
a440: 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b ))))..;; 1. look
a450: 20 74 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 though disks li
a460: 73 74 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 st for disk with
a470: 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 most space.;; 2
a480: 2e 20 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 . create run dir
a490: 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e on disk, path n
a4a0: 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 ame is meaningfu
a4b0: 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c l.;; 3. create l
a4c0: 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 ink from run dir
a4d0: 20 74 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e to megatest run
a4e0: 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 s area .;; 4. re
a4f0: 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 motely run the t
a500: 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 est on allocated
a510: 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f host.;; - co
a520: 75 6c 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f uld be ssh to ho
a530: 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 st from hosts ta
a540: 62 6c 65 20 28 75 70 64 61 74 65 20 72 65 67 75 ble (update regu
a550: 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 larly with load)
a560: 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 .;; - could b
a570: 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 e netbatch.;;
a580: 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 (launch-test
a590: 64 62 20 28 63 61 64 72 20 73 74 61 74 75 73 29 db (cadr status)
a5a0: 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 test-conf)).(de
a5b0: 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 fine (launch-tes
a5c0: 74 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 t test-id run-id
a5d0: 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c run-info keyval
a5e0: 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 s runname test-c
a5f0: 6f 6e 66 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 onf test-name te
a600: 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 74 20 st-path itemdat
a610: 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 6e 67 params). (chang
a620: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
a630: 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 74 2d path*). (alist-
a640: 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e >env-vars ;; con
a650: 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f solidate this co
a660: 64 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 de with the code
a670: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d in megatest.scm
a680: 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a for "-execute".
a690: 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c 69 73 (list ;; (lis
a6a0: 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 t "MT_TEST_RUN_D
a6b0: 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 IR" work-area).
a6c0: 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e (list "MT_RUN
a6d0: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 _AREA_HOME" *top
a6e0: 70 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 73 74 path*). (list
a6f0: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
a700: 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 3b test-name). ;
a710: 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d ; (list "MT_ITEM
a720: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
a730: 6d 64 61 74 29 29 20 0a 20 20 20 20 28 6c 69 73 mdat)) . (lis
a740: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
a750: 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 3b 3b runname). ;;
a760: 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
a770: 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
a780: 0a 20 20 20 20 29 29 0a 20 20 28 6c 65 74 2a 20 . )). (let*
a790: 28 28 74 72 65 67 69 73 74 72 79 20 20 20 20 20 ((tregistry
a7a0: 20 20 28 74 65 73 74 73 3a 67 65 74 2d 61 6c 6c (tests:get-all
a7b0: 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 )).. (item-path
a7c0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 70 20 (let ((ip
a7d0: 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 (item-list->path
a7e0: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 09 09 20 itemdat)))....
a7f0: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
a800: 61 72 73 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ars (list (list
a810: 22 4d 54 5f 49 54 45 4d 50 41 54 48 22 20 69 70 "MT_ITEMPATH" ip
a820: 29 29 29 0a 09 09 09 20 20 20 20 69 70 29 29 0a ))).... ip)).
a830: 09 20 28 74 63 6f 6e 66 69 67 20 20 20 20 20 20 . (tconfig
a840: 20 20 20 28 6f 72 20 28 74 65 73 74 73 3a 67 65 (or (tests:ge
a850: 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 t-testconfig tes
a860: 74 2d 6e 61 6d 65 20 74 72 65 67 69 73 74 72 79 t-name tregistry
a870: 20 23 74 20 66 6f 72 63 65 2d 63 72 65 61 74 65 #t force-create
a880: 3a 20 23 74 29 0a 09 09 09 20 20 20 20 20 20 74 : #t).... t
a890: 65 73 74 2d 63 6f 6e 66 29 29 20 3b 3b 20 66 6f est-conf)) ;; fo
a8a0: 72 63 65 20 72 65 2d 72 65 61 64 20 6e 6f 77 20 rce re-read now
a8b0: 74 68 61 74 20 61 6c 6c 20 76 61 72 73 20 61 72 that all vars ar
a8c0: 65 20 73 65 74 0a 09 20 28 75 73 65 73 68 65 6c e set.. (useshel
a8d0: 6c 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 l (let ((
a8e0: 75 73 68 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b ush (config-look
a8f0: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
a900: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 jobtools" "u
a910: 73 65 73 68 65 6c 6c 22 29 29 29 0a 09 09 09 20 seshell")))....
a920: 20 20 20 28 69 66 20 75 73 68 20 0a 09 09 09 09 (if ush .....
a930: 28 69 66 20 28 65 71 75 61 6c 3f 20 75 73 68 20 (if (equal? ush
a940: 22 6e 6f 22 29 20 3b 3b 20 6d 75 73 74 20 75 73 "no") ;; must us
a950: 65 20 22 6e 6f 22 20 74 6f 20 4e 4f 54 20 75 73 e "no" to NOT us
a960: 65 20 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 e shell.....
a970: 23 66 0a 09 09 09 09 20 20 20 20 75 73 68 29 0a #f..... ush).
a980: 09 09 09 09 23 74 29 29 29 20 20 20 20 20 3b 3b ....#t))) ;;
a990: 20 64 65 66 61 75 6c 74 20 69 73 20 79 65 73 0a default is yes.
a9a0: 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 20 20 . (runscript
a9b0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
a9c0: 70 20 74 63 6f 6e 66 69 67 20 20 20 22 73 65 74 p tconfig "set
a9d0: 75 70 22 20 20 20 20 20 20 20 20 22 72 75 6e 73 up" "runs
a9e0: 63 72 69 70 74 22 29 29 0a 09 20 28 65 7a 73 74 cript")).. (ezst
a9f0: 65 70 73 20 20 20 20 20 20 20 20 20 28 3e 20 28 eps (> (
aa00: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
aa10: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
aa20: 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 config "ezsteps"
aa30: 20 27 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f '())) 0)) ;; do
aa40: 6e 27 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 n't send all the
aa50: 20 73 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 steps, could be
aa60: 20 62 69 67 0a 09 20 28 64 69 73 6b 73 70 61 63 big.. (diskspac
aa70: 65 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d e (config-
aa80: 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 lookup tconfig
aa90: 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 "requirements"
aaa0: 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a 09 20 "diskspace"))..
aab0: 28 6d 65 6d 6f 72 79 20 20 20 20 20 20 20 20 20 (memory
aac0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
aad0: 74 63 6f 6e 66 69 67 20 20 20 22 72 65 71 75 69 tconfig "requi
aae0: 72 65 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 rements" "memory
aaf0: 22 29 29 0a 09 20 28 68 6f 73 74 73 20 20 20 20 ")).. (hosts
ab00: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c (config-l
ab10: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
ab20: 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 * "jobtools"
ab30: 20 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a 09 "workhosts"))..
ab40: 20 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 (remote-megates
ab50: 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t (config-lookup
ab60: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
ab70: 74 75 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 tup" "executable
ab80: 22 29 29 0a 09 20 28 72 75 6e 2d 74 69 6d 65 2d ")).. (run-time-
ab90: 6c 69 6d 69 74 20 20 28 6f 72 20 28 63 6f 6e 66 limit (or (conf
aba0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 74 63 6f 6e igf:lookup tcon
abb0: 66 69 67 20 20 20 22 72 65 71 75 69 72 65 6d 65 fig "requireme
abc0: 6e 74 73 22 20 22 72 75 6e 74 69 6d 65 6c 69 6d nts" "runtimelim
abd0: 22 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e ").... (con
abe0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 2a 63 6f figf:lookup *co
abf0: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
ac00: 20 22 72 75 6e 74 69 6d 65 6c 69 6d 22 29 29 29 "runtimelim")))
ac10: 0a 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 .. ;; FIXME SOME
ac20: 44 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f DAY: not good ho
ac30: 77 20 74 68 69 73 20 69 73 20 73 6f 20 6f 62 74 w this is so obt
ac40: 75 73 65 2c 20 74 68 69 73 20 68 61 63 6b 20 69 use, this hack i
ac50: 73 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 s to .. ;;
ac60: 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 allow
ac70: 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 running from das
ac80: 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 20 hboard. Extract
ac90: 74 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 the path.. ;;
aca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
acb0: 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 m the called meg
acc0: 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 atest and conver
acd0: 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b t dashboard.. ;;
ace0: 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 .
acf0: 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 or dboard to meg
ad00: 61 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d atest.. (local-m
ad10: 65 67 61 74 65 73 74 20 20 28 6c 65 74 2a 20 28 egatest (let* (
ad20: 28 6c 6d 20 20 28 63 61 72 20 28 61 72 67 76 29 (lm (car (argv)
ad30: 29 29 0a 09 09 09 09 20 28 64 69 72 20 28 70 61 ))..... (dir (pa
ad40: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
ad50: 20 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 65 20 lm))..... (exe
ad60: 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d (pathname-strip-
ad70: 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a directory lm))).
ad80: 09 09 09 20 20 20 20 28 63 6f 6e 63 20 28 69 66 ... (conc (if
ad90: 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 20 22 dir (conc dir "
ada0: 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 28 63 /") "")..... (c
adb0: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym
adc0: 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 20 20 bol exe).....
add0: 20 28 28 64 62 6f 61 72 64 29 20 20 20 20 22 2e ((dboard) ".
ade0: 2e 2f 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 ./megatest")....
adf0: 09 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 20 . ((mtest)
ae00: 20 20 22 2e 2e 2f 6d 65 67 61 74 65 73 74 22 29 "../megatest")
ae10: 0a 09 09 09 09 20 20 20 20 28 28 64 61 73 68 62 ..... ((dashb
ae20: 6f 61 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 oard) "megatest"
ae30: 29 0a 09 09 09 09 20 20 20 20 28 65 6c 73 65 20 )..... (else
ae40: 65 78 65 29 29 29 29 29 0a 09 20 28 6c 61 75 6e exe))))).. (laun
ae50: 63 68 65 72 20 20 20 20 20 20 20 20 28 63 6f 6d cher (com
ae60: 6d 6f 6e 3a 67 65 74 2d 6c 61 75 6e 63 68 65 72 mon:get-launcher
ae70: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 65 73 *configdat* tes
ae80: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
ae90: 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f )) ;; (config-lo
aea0: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
aeb0: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
aec0: 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 20 28 "launcher")).. (
aed0: 74 65 73 74 2d 73 69 67 20 20 20 28 63 6f 6e 63 test-sig (conc
aee0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
aef0: 74 73 75 69 74 65 2d 6e 61 6d 65 29 20 22 3a 22 tsuite-name) ":"
af00: 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a 22 20 69 test-name ":" i
af10: 74 65 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 69 tem-path)) ;; (i
af20: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
af30: 74 65 6d 64 61 74 29 29 29 20 3b 3b 20 74 65 73 temdat))) ;; tes
af40: 74 2d 70 61 74 68 20 69 73 20 74 68 65 20 66 75 t-path is the fu
af50: 6c 6c 20 70 61 74 68 20 69 6e 63 6c 75 64 69 6e ll path includin
af60: 67 20 74 68 65 20 69 74 65 6d 2d 70 61 74 68 0a g the item-path.
af70: 09 20 28 77 6f 72 6b 2d 61 72 65 61 20 20 23 66 . (work-area #f
af80: 29 0a 09 20 28 74 6f 70 74 65 73 74 2d 77 6f 72 ).. (toptest-wor
af90: 6b 2d 61 72 65 61 20 23 66 29 20 3b 3b 20 66 6f k-area #f) ;; fo
afa0: 72 20 69 74 65 72 61 74 65 64 20 74 65 73 74 73 r iterated tests
afb0: 20 74 68 65 20 74 6f 70 20 74 65 73 74 20 63 6f the top test co
afc0: 6e 74 61 69 6e 73 20 64 61 74 61 20 72 65 6c 65 ntains data rele
afd0: 76 61 6e 74 20 66 6f 72 20 61 6c 6c 0a 09 20 28 vant for all.. (
afe0: 64 69 73 6b 70 61 74 68 20 20 20 23 66 29 0a 09 diskpath #f)..
aff0: 20 28 63 6d 64 70 61 72 6d 73 20 20 20 23 66 29 (cmdparms #f)
b000: 0a 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 23 .. (fullcmd #
b010: 66 29 20 3b 3b 20 28 64 65 66 69 6e 65 20 61 20 f) ;; (define a
b020: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
b030: 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 string (lambda (
b040: 29 28 77 72 69 74 65 20 78 29 29 29 29 0a 09 20 )(write x))))..
b050: 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 (mt-bindir-path
b060: 23 66 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 #f).. (testinfo
b070: 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d (rmt:get-test-
b080: 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 info-by-id run-i
b090: 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6d d test-id)).. (m
b0a0: 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 69 6e t_target (strin
b0b0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
b0c0: 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 29 ap cadr keyvals)
b0d0: 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d "/")).. (debug-
b0e0: 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 param (append (i
b0f0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
b100: 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 "-debug") (list
b110: 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a "-debug" (args:
b120: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 get-arg "-debug"
b130: 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 )) '())....
b140: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
b150: 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
b160: 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
b170: 27 28 29 29 29 29 29 0a 0a 20 20 20 20 28 73 65 '())))).. (se
b180: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 50 41 54 tenv "MT_ITEMPAT
b190: 48 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 H" item-path).
b1a0: 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 (if hosts (set
b1b0: 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d ! hosts (string-
b1c0: 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 split hosts))).
b1d0: 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 ;; set the me
b1e0: 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c gatest to be cal
b1f0: 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 led on the remot
b200: 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 e host. (if (
b210: 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 not remote-megat
b220: 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 est)(set! remote
b230: 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d -megatest local-
b240: 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d megatest)) ;; "m
b250: 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 egatest")). (
b260: 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 set! mt-bindir-p
b270: 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 ath (pathname-di
b280: 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d rectory remote-m
b290: 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 egatest)). (i
b2a0: 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 f launcher (set!
b2b0: 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e launcher (strin
b2c0: 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 g-split launcher
b2d0: 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 ))). ;; set u
b2e0: 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 p the run work a
b2f0: 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 rea for this tes
b300: 74 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 t. (if (and (
b310: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 args:get-arg "-p
b320: 72 65 63 6c 65 61 6e 22 29 20 3b 3b 20 75 73 65 reclean") ;; use
b330: 72 20 68 61 73 20 72 65 71 75 65 73 74 65 64 20 r has requested
b340: 74 6f 20 70 72 65 63 6c 65 61 6e 20 66 6f 72 20 to preclean for
b350: 74 68 69 73 20 72 75 6e 0a 09 20 20 20 20 20 28 this run.. (
b360: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 64 62 3a not (member (db:
b370: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 test-get-rundir
b380: 74 65 73 74 69 6e 66 6f 29 28 6c 69 73 74 20 22 testinfo)(list "
b390: 6e 2f 61 22 20 22 2f 74 6d 70 2f 62 61 64 6e 61 n/a" "/tmp/badna
b3a0: 6d 65 22 29 29 29 29 20 3b 3b 20 6e 2f 61 20 69 me")))) ;; n/a i
b3b0: 73 20 61 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 s a placeholder
b3c0: 61 6e 64 20 74 68 75 73 20 6e 6f 74 20 61 20 72 and thus not a r
b3d0: 65 61 64 20 64 69 72 0a 09 28 62 65 67 69 6e 0a ead dir..(begin.
b3e0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
b3f0: 69 6e 66 6f 20 30 20 22 61 74 74 65 6d 70 74 69 info 0 "attempti
b400: 6e 67 20 74 6f 20 70 72 65 63 6c 65 61 6e 20 64 ng to preclean d
b410: 69 72 65 63 74 6f 72 79 20 22 20 28 64 62 3a 74 irectory " (db:t
b420: 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 est-get-rundir t
b430: 65 73 74 69 6e 66 6f 29 20 22 20 66 6f 72 20 74 estinfo) " for t
b440: 65 73 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 est " test-name
b450: 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 "/" item-path)..
b460: 20 20 28 72 75 6e 73 3a 72 65 6d 6f 76 65 2d 74 (runs:remove-t
b470: 65 73 74 2d 64 69 72 65 63 74 6f 72 79 20 74 65 est-directory te
b480: 73 74 69 6e 66 6f 20 27 72 65 6d 6f 76 65 2d 64 stinfo 'remove-d
b490: 61 74 61 2d 6f 6e 6c 79 29 29 29 20 3b 3b 20 72 ata-only))) ;; r
b4a0: 65 6d 6f 76 65 20 64 61 74 61 20 6f 6e 6c 79 2c emove data only,
b4b0: 20 64 6f 20 6e 6f 74 20 70 65 72 74 75 72 62 20 do not perturb
b4c0: 74 68 65 20 72 65 63 6f 72 64 0a 0a 20 20 20 20 the record..
b4d0: 3b 3b 20 70 72 65 76 65 6e 74 20 6f 76 65 72 6c ;; prevent overl
b4e0: 61 70 70 69 6e 67 20 61 63 74 69 6f 6e 73 20 2d apping actions -
b4f0: 20 73 65 74 20 74 6f 20 4c 41 55 4e 43 48 45 44 set to LAUNCHED
b500: 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 6f 73 as early as pos
b510: 73 69 62 6c 65 0a 20 20 20 20 3b 3b 0a 20 20 20 sible. ;;.
b520: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
b530: 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
b540: 74 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 test-id "LAUNCHE
b550: 44 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 D" "n/a" #f #f)
b560: 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 ;; (if launch-re
b570: 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 sults launch-res
b580: 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a ults "FAILED")).
b590: 20 20 20 20 28 72 6d 74 3a 72 6f 6c 6c 2d 75 70 (rmt:roll-up
b5a0: 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 -pass-fail-count
b5b0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
b5c0: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 23 66 20 me item-path #f
b5d0: 22 4c 41 55 4e 43 48 45 44 22 29 0a 20 20 20 20 "LAUNCHED").
b5e0: 28 73 65 74 21 20 64 69 73 6b 70 61 74 68 20 28 (set! diskpath (
b5f0: 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 2a 63 get-best-disk *c
b600: 6f 6e 66 69 67 64 61 74 2a 20 74 63 6f 6e 66 69 onfigdat* tconfi
b610: 67 29 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b g)). (if disk
b620: 70 61 74 68 0a 09 28 6c 65 74 20 28 28 64 61 74 path..(let ((dat
b630: 20 20 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 (create-work-a
b640: 72 65 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 rea run-id run-i
b650: 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 nfo keyvals test
b660: 2d 69 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 -id test-path di
b670: 73 6b 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 skpath test-name
b680: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 itemdat))).. (
b690: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
b6a0: 63 61 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 car dat)).. (se
b6b0: 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d t! toptest-work-
b6c0: 61 72 65 61 20 28 63 61 64 72 20 64 61 74 29 29 area (cadr dat))
b6d0: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
b6e0: 2d 69 6e 66 6f 20 32 20 22 55 73 69 6e 67 20 77 -info 2 "Using w
b6f0: 6f 72 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d ork area " work-
b700: 61 72 65 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 area))..(begin..
b710: 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
b720: 61 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 a (conc test-pat
b730: 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 h "/tmp_run"))..
b740: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
b750: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 ory work-area #t
b760: 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
b770: 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f t 0 "WARNING: No
b780: 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 disk work area
b790: 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 6e 6e specified - runn
b7a0: 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 74 20 ing in the test
b7b0: 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 72 20 directory under
b7c0: 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 tmp_run"))).
b7d0: 28 73 65 74 21 20 63 6d 64 70 61 72 6d 73 20 28 (set! cmdparms (
b7e0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e base64:base64-en
b7f0: 63 6f 64 65 20 0a 09 09 20 20 20 20 28 7a 33 3a code ... (z3:
b800: 65 6e 63 6f 64 65 2d 62 75 66 66 65 72 20 0a 09 encode-buffer ..
b810: 09 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 . (with-outp
b820: 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 09 09 20 ut-to-string...
b830: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
b840: 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f 73 74 73 ;; (list 'hosts
b850: 20 20 20 20 20 68 6f 73 74 73 29 0a 09 09 09 20 hosts)....
b860: 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 6c 69 (write (list (li
b870: 73 74 20 27 74 65 73 74 70 61 74 68 20 20 74 65 st 'testpath te
b880: 73 74 2d 70 61 74 68 29 0a 09 09 09 09 20 20 20 st-path).....
b890: 20 20 20 28 6c 69 73 74 20 27 74 72 61 6e 73 70 (list 'transp
b8a0: 6f 72 74 20 28 63 6f 6e 63 20 2a 74 72 61 6e 73 ort (conc *trans
b8b0: 70 6f 72 74 2d 74 79 70 65 2a 29 29 0a 09 09 09 port-type*))....
b8c0: 09 20 20 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 . ;; (list
b8d0: 27 73 65 72 76 65 72 69 6e 66 20 2a 73 65 72 76 'serverinf *serv
b8e0: 65 72 2d 69 6e 66 6f 2a 29 0a 09 09 09 09 20 20 er-info*).....
b8f0: 20 20 20 20 28 6c 69 73 74 20 27 74 6f 70 70 61 (list 'toppa
b900: 74 68 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a th *toppath*).
b910: 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
b920: 27 77 6f 72 6b 2d 61 72 65 61 20 77 6f 72 6b 2d 'work-area work-
b930: 61 72 65 61 29 0a 09 09 09 09 20 20 20 20 20 20 area).....
b940: 28 6c 69 73 74 20 27 74 65 73 74 2d 6e 61 6d 65 (list 'test-name
b950: 20 74 65 73 74 2d 6e 61 6d 65 29 20 0a 09 09 09 test-name) ....
b960: 09 20 20 20 20 20 20 28 6c 69 73 74 20 27 72 75 . (list 'ru
b970: 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 70 nscript runscrip
b980: 74 29 20 0a 09 09 09 09 20 20 20 20 20 20 28 6c t) ..... (l
b990: 69 73 74 20 27 72 75 6e 2d 69 64 20 20 20 20 72 ist 'run-id r
b9a0: 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 09 20 20 un-id ).....
b9b0: 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d (list 'test-
b9c0: 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 0a id test-id ).
b9d0: 09 09 09 09 20 20 20 20 20 20 3b 3b 20 28 6c 69 .... ;; (li
b9e0: 73 74 20 27 69 74 65 6d 2d 70 61 74 68 20 69 74 st 'item-path it
b9f0: 65 6d 2d 70 61 74 68 20 29 0a 09 09 09 09 20 20 em-path ).....
ba00: 20 20 20 20 28 6c 69 73 74 20 27 69 74 65 6d 64 (list 'itemd
ba10: 61 74 20 20 20 69 74 65 6d 64 61 74 20 20 29 0a at itemdat ).
ba20: 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
ba30: 27 6d 65 67 61 74 65 73 74 20 20 72 65 6d 6f 74 'megatest remot
ba40: 65 2d 6d 65 67 61 74 65 73 74 29 0a 09 09 09 09 e-megatest).....
ba50: 20 20 20 20 20 20 28 6c 69 73 74 20 27 65 7a 73 (list 'ezs
ba60: 74 65 70 73 20 20 20 65 7a 73 74 65 70 73 29 20 teps ezsteps)
ba70: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 ..... (list
ba80: 20 27 74 61 72 67 65 74 20 20 20 20 6d 74 5f 74 'target mt_t
ba90: 61 72 67 65 74 29 0a 09 09 09 09 20 20 20 20 20 arget).....
baa0: 20 28 6c 69 73 74 20 27 72 75 6e 74 6c 69 6d 20 (list 'runtlim
bab0: 20 20 28 69 66 20 72 75 6e 2d 74 69 6d 65 2d 6c (if run-time-l
bac0: 69 6d 69 74 20 28 63 6f 6d 6d 6f 6e 3a 68 6d 73 imit (common:hms
bad0: 2d 73 74 72 69 6e 67 2d 3e 73 65 63 6f 6e 64 73 -string->seconds
bae0: 20 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 29 run-time-limit)
baf0: 20 23 66 29 29 0a 09 09 09 09 20 20 20 20 20 20 #f)).....
bb00: 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 (list 'env-ovrd
bb10: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
bb20: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
bb30: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
bb40: 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 20 de" '())) .....
bb50: 20 20 20 20 20 28 6c 69 73 74 20 27 73 65 74 2d (list 'set-
bb60: 76 61 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 vars (if params
bb70: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
bb80: 2f 64 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 /default params
bb90: 22 2d 73 65 74 76 61 72 73 22 20 23 66 29 29 29 "-setvars" #f)))
bba0: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 ..... (list
bbb0: 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 'runname runn
bbc0: 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 ame)..... (
bbd0: 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d list 'mt-bindir-
bbe0: 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 path mt-bindir-p
bbf0: 61 74 68 29 29 29 29 29 29 29 29 0a 0a 20 20 20 ath))))))))..
bc00: 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 74 20 73 74 ;; clean out st
bc10: 65 70 20 72 65 63 6f 72 64 73 20 66 72 6f 6d 20 ep records from
bc20: 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 66 20 previous run if
bc30: 74 68 65 79 20 65 78 69 73 74 0a 20 20 20 20 3b they exist. ;
bc40: 3b 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d 74 65 ; (rmt:delete-te
bc50: 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 st-step-records
bc60: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a run-id test-id).
bc70: 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 64 69 ;; if the di
bc80: 72 20 64 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 r does not exist
bc90: 20 77 65 20 6d 61 79 20 68 61 76 65 20 61 20 69 we may have a i
bca0: 74 65 6d 70 61 74 68 20 77 68 65 72 65 20 69 6e tempath where in
bcb0: 64 69 76 69 64 75 61 6c 20 76 61 72 69 61 62 6c dividual variabl
bcc0: 65 73 20 61 72 65 20 61 20 70 61 74 68 2c 20 6c es are a path, l
bcd0: 61 75 6e 63 68 20 61 6e 79 77 61 79 0a 20 20 20 aunch anyway.
bce0: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
bcf0: 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 28 s? work-area)..(
bd00: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
bd10: 20 77 6f 72 6b 2d 61 72 65 61 29 29 20 3b 3b 20 work-area)) ;;
bd20: 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 so that log file
bd30: 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 s from the launc
bd40: 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 h process don't
bd50: 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 74 clutter the test
bd60: 20 64 69 72 0a 20 20 20 20 28 63 6f 6e 64 0a 20 dir. (cond.
bd70: 20 20 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 ((and launch
bd80: 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 er hosts) ;; mus
bd90: 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 20 68 t be using ssh h
bda0: 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 73 ostname. (s
bdb0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
bdc0: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 end launcher (ca
bdd0: 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 r hosts)(list re
bde0: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 22 2d mote-megatest "-
bdf0: 6d 22 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 m" test-sig "-ex
be00: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
be10: 20 64 65 62 75 67 2d 70 61 72 61 6d 29 29 29 0a debug-param))).
be20: 20 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 ;; (set! fu
be30: 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 llcmd (append la
be40: 75 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 uncher (car host
be50: 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d s)(list remote-m
be60: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
be70: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
be80: 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 28 6c arms)))). (l
be90: 61 75 6e 63 68 65 72 0a 20 20 20 20 20 20 28 73 auncher. (s
bea0: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
beb0: 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 end launcher (li
bec0: 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
bed0: 73 74 20 22 2d 6d 22 20 74 65 73 74 2d 73 69 67 st "-m" test-sig
bee0: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
bef0: 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
bf00: 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 73 65 m))). ;; (se
bf10: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
bf20: 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 nd launcher (lis
bf30: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
bf40: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
bf50: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 cute" cmdparms))
bf60: 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 )). (else.
bf70: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 73 65 (if (not use
bf80: 73 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 shell)(debug:pri
bf90: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 69 nt 0 "WARNING: i
bfa0: 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e nternal launchin
bfb0: 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 g will not work
bfc0: 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 well without \"u
bfd0: 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e seshell yes\" in
bfe0: 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d your [jobtools]
bff0: 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 20 20 20 section")).
c000: 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 (set! fullcmd
c010: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 65 (append (list re
c020: 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 22 2d mote-megatest "-
c030: 6d 22 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 m" test-sig "-ex
c040: 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
c050: 20 64 65 62 75 67 2d 70 61 72 61 6d 20 28 6c 69 debug-param (li
c060: 73 74 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 st (if useshell
c070: 22 26 22 20 22 22 29 29 29 29 29 29 0a 20 20 20 "&" "")))))).
c080: 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d ;; (set! fullcm
c090: 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d d (list remote-m
c0a0: 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
c0b0: 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
c0c0: 61 72 6d 73 20 28 69 66 20 75 73 65 73 68 65 6c arms (if useshel
c0d0: 6c 20 22 26 22 20 22 22 29 29 29 29 29 0a 20 20 l "&" ""))))).
c0e0: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
c0f0: 61 72 67 20 22 2d 78 74 65 72 6d 22 29 28 73 65 arg "-xterm")(se
c100: 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 t! fullcmd (appe
c110: 6e 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 nd fullcmd (list
c120: 20 22 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 20 "-xterm")))).
c130: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
c140: 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f "Launching " wo
c150: 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 rk-area). ;;
c160: 73 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 set pre-launch-e
c170: 6e 76 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c nv-vars before l
c180: 61 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 aunching, keep t
c190: 68 65 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 he vars in prevv
c1a0: 61 6c 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 als and put the
c1b0: 65 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 envionment back
c1c0: 77 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 28 64 when done. (d
c1d0: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 22 66 75 ebug:print 4 "fu
c1e0: 6c 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 6d 64 llcmd: " fullcmd
c1f0: 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f ). (let* ((co
c200: 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 61 6c mmonprevvals (al
c210: 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 ist->env-vars...
c220: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
c230: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f -ref/default *co
c240: 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 nfigdat* "env-ov
c250: 65 72 72 69 64 65 22 20 27 28 29 29 29 29 0a 09 erride" '())))..
c260: 20 20 20 28 74 65 73 74 70 72 65 76 76 61 6c 73 (testprevvals
c270: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
c280: 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 73 68 ars.... (hash
c290: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
c2a0: 6c 74 20 74 63 6f 6e 66 69 67 20 22 70 72 65 2d lt tconfig "pre-
c2b0: 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 launch-env-overr
c2c0: 69 64 65 73 22 20 27 28 29 29 29 29 0a 09 20 20 ides" '())))..
c2d0: 20 28 6d 69 73 63 70 72 65 76 76 61 6c 73 20 20 (miscprevvals
c2e0: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
c2f0: 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 s ;; consolidate
c300: 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 this code with
c310: 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 the code in mega
c320: 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 test.scm for "-e
c330: 78 65 63 75 74 65 22 0a 09 09 09 20 20 20 20 28 xecute".... (
c340: 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 append (list (li
c350: 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f st "MT_TEST_RUN_
c360: 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a DIR" work-area).
c370: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
c380: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
c390: 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c -name)...... (l
c3a0: 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 ist "MT_ITEM_INF
c3b0: 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 O" (conc itemdat
c3c0: 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 73 74 )) ...... (list
c3d0: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 "MT_RUNNAME"
c3e0: 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 runname)......
c3f0: 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 (list "MT_TARGET
c400: 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a " mt_target).
c410: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
c420: 5f 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d _ITEMPATH" item
c430: 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 29 0a -path)...... ).
c440: 09 09 09 09 20 20 20 20 69 74 65 6d 64 61 74 29 .... itemdat)
c450: 29 29 0a 09 20 20 20 3b 3b 20 4c 61 75 6e 63 68 )).. ;; Launch
c460: 77 61 69 74 20 64 65 66 61 75 6c 74 73 20 74 6f wait defaults to
c470: 20 74 72 75 65 2c 20 6d 75 73 74 20 6f 76 65 72 true, must over
c480: 72 69 64 65 20 69 74 20 74 6f 20 74 75 72 6e 20 ride it to turn
c490: 6f 66 66 20 77 61 69 74 0a 09 20 20 20 28 6c 61 off wait.. (la
c4a0: 75 6e 63 68 77 61 69 74 20 20 20 20 20 28 69 66 unchwait (if
c4b0: 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 69 67 (equal? (config
c4c0: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
c4d0: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 61 dat* "setup" "la
c4e0: 75 6e 63 68 77 61 69 74 22 29 20 22 6e 6f 22 29 unchwait") "no")
c4f0: 20 23 66 20 23 74 29 29 0a 09 20 20 20 28 6c 61 #f #t)).. (la
c500: 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 unch-results (ap
c510: 70 6c 79 20 28 69 66 20 6c 61 75 6e 63 68 77 61 ply (if launchwa
c520: 69 74 0a 09 09 09 09 20 20 20 20 20 20 63 6d 64 it..... cmd
c530: 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 72 -run-with-stderr
c540: 2d 3e 6c 69 73 74 0a 09 09 09 09 20 20 20 20 20 ->list.....
c550: 20 70 72 6f 63 65 73 73 2d 72 75 6e 29 0a 09 09 process-run)...
c560: 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c .. (if useshell
c570: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 ..... (let
c580: 28 28 63 6d 64 73 74 72 20 28 73 74 72 69 6e 67 ((cmdstr (string
c590: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
c5a0: 6c 63 6d 64 20 22 20 22 29 29 29 0a 09 09 09 09 lcmd " "))).....
c5b0: 09 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 0a .(if launchwait.
c5c0: 09 09 09 09 09 20 20 20 20 63 6d 64 73 74 72 0a ..... cmdstr.
c5d0: 09 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 63 ..... (conc c
c5e0: 6d 64 73 74 72 20 22 20 3e 3e 20 6d 74 5f 6c 61 mdstr " >> mt_la
c5f0: 75 6e 63 68 2e 6c 6f 67 20 32 3e 26 31 22 29 29 unch.log 2>&1"))
c600: 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 72 )..... (car
c610: 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 20 fullcmd)).....
c620: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 (if useshell...
c630: 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 .. '().....
c640: 20 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c 63 (cdr fullc
c650: 6d 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 md))))). (i
c660: 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 77 61 69 f (not launchwai
c670: 74 29 20 3b 3b 20 67 69 76 65 20 74 68 65 20 4f t) ;; give the O
c680: 53 20 61 20 6c 69 74 74 6c 65 20 74 69 6d 65 20 S a little time
c690: 74 6f 20 61 6c 6c 6f 77 20 74 68 65 20 70 72 6f to allow the pro
c6a0: 63 65 73 73 20 74 6f 20 73 74 61 72 74 0a 09 20 cess to start..
c6b0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
c6c0: 30 2e 30 31 29 29 0a 20 20 20 20 20 20 28 77 69 0.01)). (wi
c6d0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
c6e0: 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 e "mt_launch.log
c6f0: 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 "..(lambda ()..
c700: 20 28 70 72 69 6e 74 20 22 4c 41 55 4e 43 48 43 (print "LAUNCHC
c710: 4d 44 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e MD: " (string-in
c720: 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d tersperse fullcm
c730: 64 20 22 20 22 29 29 0a 09 20 20 28 69 66 20 28 d " ")).. (if (
c740: 6c 69 73 74 3f 20 6c 61 75 6e 63 68 2d 72 65 73 list? launch-res
c750: 75 6c 74 73 29 0a 09 20 20 20 20 20 20 28 61 70 ults).. (ap
c760: 70 6c 79 20 70 72 69 6e 74 20 6c 61 75 6e 63 68 ply print launch
c770: 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 20 20 20 -results)..
c780: 20 28 70 72 69 6e 74 20 22 4e 4f 54 45 3a 20 6c (print "NOTE: l
c790: 61 75 6e 63 68 65 64 20 5c 22 22 20 66 75 6c 6c aunched \"" full
c7a0: 63 6d 64 20 22 5c 22 5c 6e 20 20 62 75 74 20 64 cmd "\"\n but d
c7b0: 69 64 20 6e 6f 74 20 77 61 69 74 20 66 6f 72 20 id not wait for
c7c0: 69 74 20 74 6f 20 70 72 6f 63 65 65 64 2e 20 41 it to proceed. A
c7d0: 64 64 20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 dd the following
c7e0: 20 74 6f 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e to megatest.con
c7f0: 66 69 67 20 5c 6e 5b 73 65 74 75 70 5d 5c 6e 6c fig \n[setup]\nl
c800: 61 75 6e 63 68 77 61 69 74 20 79 65 73 5c 6e 20 aunchwait yes\n
c810: 20 69 66 20 79 6f 75 20 68 61 76 65 20 70 72 6f if you have pro
c820: 62 6c 65 6d 73 20 77 69 74 68 20 74 68 69 73 22 blems with this"
c830: 29 29 0a 09 20 20 23 3a 61 70 70 65 6e 64 29 29 )).. #:append))
c840: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
c850: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 69 6e 67 int 2 "Launching
c860: 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 completed, upda
c870: 74 69 6e 67 20 64 62 22 29 0a 20 20 20 20 20 20 ting db").
c880: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
c890: 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 Launch results:
c8a0: 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 " launch-results
c8b0: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
c8c0: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
c8d0: 0a 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 . (begi
c8e0: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 n. (p
c8f0: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 69 rint "ERROR: Fai
c900: 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 73 74 led to run " (st
c910: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
c920: 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 22 2c fullcmd " ") ",
c930: 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 0a 20 exiting now").
c940: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 73 ;; (s
c950: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
c960: 20 64 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 db).
c970: 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 ;; good ole "ex
c980: 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f it" seems not to
c990: 20 77 6f 72 6b 0a 20 20 20 20 20 20 20 20 20 20 work.
c9a0: 20 20 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a 20 ;; (_exit 9).
c9b0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 62 75 ;; bu
c9c0: 74 20 74 68 69 73 20 68 61 63 6b 20 77 69 6c 6c t this hack will
c9d0: 20 77 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f work! Thanks go
c9e0: 20 74 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 to Alan Post of
c9f0: 20 74 68 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 the Chicken ema
ca00: 69 6c 20 6c 69 73 74 0a 20 20 20 20 20 20 20 20 il list.
ca10: 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 ;; NB// Is t
ca20: 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 his still needed
ca30: 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 ? Should be safe
ca40: 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 to go back to "
ca50: 65 78 69 74 22 20 6e 6f 77 3f 0a 20 20 20 20 20 exit" now?.
ca60: 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d (process-
ca70: 73 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d signal (current-
ca80: 70 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e process-id) sign
ca90: 61 6c 2f 6b 69 6c 6c 29 0a 20 20 20 20 20 20 20 al/kill).
caa0: 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 28 61 )). (a
cab0: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 6d list->env-vars m
cac0: 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 20 20 iscprevvals).
cad0: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
cae0: 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c 73 ars testprevvals
caf0: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e ). (alist->
cb00: 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 env-vars commonp
cb10: 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 6c revvals). l
cb20: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 0a aunch-results)).
cb30: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
cb40: 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a ory *toppath*)).
cb50: 0a 3b 3b 20 72 65 63 6f 76 65 72 20 61 20 74 65 .;; recover a te
cb60: 73 74 20 77 68 65 72 65 20 74 68 65 20 74 6f 70 st where the top
cb70: 20 63 6f 6e 74 72 6f 6c 6c 69 6e 67 20 6d 74 65 controlling mte
cb80: 73 74 20 6d 61 79 20 68 61 76 65 20 64 69 65 64 st may have died
cb90: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 .;;.(define (lau
cba0: 6e 63 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 nch:recover-test
cbb0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
cbc0: 0a 20 20 3b 3b 20 74 68 69 73 20 66 75 6e 63 74 . ;; this funct
cbd0: 69 6f 6e 20 69 73 20 63 61 6c 6c 65 64 20 6f 6e ion is called on
cbe0: 20 74 68 65 20 74 65 73 74 20 72 75 6e 20 68 6f the test run ho
cbf0: 73 74 20 76 69 61 20 73 73 68 0a 20 20 3b 3b 0a st via ssh. ;;.
cc00: 20 20 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 61 74 20 ;; 1. look at
cc10: 74 68 65 20 70 72 6f 63 65 73 73 20 66 72 6f 6d the process from
cc20: 20 70 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 69 pid. ;; - i
cc30: 73 20 69 74 20 6f 77 6e 65 64 20 62 79 20 63 61 s it owned by ca
cc40: 6c 6c 69 6e 67 20 75 73 65 72 0a 20 20 3b 3b 20 lling user. ;;
cc50: 20 20 20 2d 20 69 74 20 69 74 27 73 20 72 75 6e - it it's run
cc60: 20 64 69 72 65 63 74 6f 72 79 20 63 6f 72 72 65 directory corre
cc70: 63 74 20 66 6f 72 20 74 68 65 20 74 65 73 74 0a ct for the test.
cc80: 20 20 3b 3b 20 20 20 20 2d 20 69 73 20 74 68 65 ;; - is the
cc90: 72 65 20 61 20 63 6f 6e 74 72 6f 6c 6c 69 6e 67 re a controlling
cca0: 20 6d 74 65 73 74 20 28 6d 61 79 62 65 20 73 74 mtest (maybe st
ccb0: 75 63 6b 29 0a 20 20 3b 3b 20 32 2e 20 69 66 20 uck). ;; 2. if
ccc0: 72 65 63 6f 76 65 72 79 20 69 73 20 6e 65 65 64 recovery is need
ccd0: 65 64 20 77 61 74 63 68 20 70 69 64 0a 20 20 3b ed watch pid. ;
cce0: 3b 20 20 20 20 2d 20 77 68 65 6e 20 69 74 20 65 ; - when it e
ccf0: 78 69 74 73 20 74 61 6b 65 20 74 68 65 20 65 78 xits take the ex
cd00: 69 74 20 63 6f 64 65 20 61 6e 64 20 64 6f 20 74 it code and do t
cd10: 68 65 20 6e 65 65 64 66 75 6c 0a 20 20 3b 3b 0a he needful. ;;.
cd20: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 72 (let* ((pid (r
cd30: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d mt:test-get-top-
cd40: 70 72 6f 63 65 73 73 2d 69 64 20 72 75 6e 2d 69 process-id run-i
cd50: 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 70 d test-id)).. (p
cd60: 73 72 65 73 20 28 77 69 74 68 2d 69 6e 70 75 74 sres (with-input
cd70: 2d 66 72 6f 6d 2d 70 69 70 65 0a 09 09 20 28 63 -from-pipe... (c
cd80: 6f 6e 63 20 22 70 73 20 2d 46 20 2d 75 20 22 20 onc "ps -F -u "
cd90: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
cda0: 6d 65 29 20 22 20 7c 20 67 72 65 70 20 2d 45 20 me) " | grep -E
cdb0: 27 22 20 70 69 64 20 22 20 27 20 7c 20 67 72 65 '" pid " ' | gre
cdc0: 70 20 2d 76 20 27 67 72 65 70 20 2d 45 20 22 20 p -v 'grep -E "
cdd0: 70 69 64 20 22 27 22 29 0a 09 09 20 28 6c 61 6d pid "'")... (lam
cde0: 62 64 61 20 28 29 0a 09 09 20 20 20 28 72 65 61 bda ()... (rea
cdf0: 64 2d 6c 69 6e 65 29 29 29 29 0a 09 20 28 72 75 d-line)))).. (ru
ce00: 6e 64 69 72 20 28 69 66 20 28 73 74 72 69 6e 67 ndir (if (string
ce10: 3f 20 70 73 72 65 73 29 20 3b 3b 20 72 65 61 6c ? psres) ;; real
ce20: 20 70 72 6f 63 65 73 73 20 6f 77 6e 65 64 20 62 process owned b
ce30: 79 20 75 73 65 72 0a 09 09 20 20 20 20 20 28 72 y user... (r
ce40: 65 61 64 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ead-symbolic-lin
ce50: 6b 20 28 63 6f 6e 63 20 22 2f 70 72 6f 63 2f 22 k (conc "/proc/"
ce60: 20 70 69 64 20 22 2f 63 77 64 22 29 29 0a 09 09 pid "/cwd"))...
ce70: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 3b #f))). ;
ce80: 3b 20 6e 6f 77 20 77 61 69 74 20 6f 6e 20 74 68 ; now wait on th
ce90: 61 74 20 70 72 6f 63 65 73 73 20 69 66 20 61 6c at process if al
cea0: 6c 20 69 73 20 63 6f 72 72 65 63 74 0a 20 20 20 l is correct.
ceb0: 20 3b 3b 20 70 65 72 69 6f 64 69 63 61 6c 6c 79 ;; periodically
cec0: 20 75 70 64 61 74 65 20 74 68 65 20 64 62 20 77 update the db w
ced0: 69 74 68 20 72 75 6e 74 69 6d 65 0a 20 20 20 20 ith runtime.
cee0: 3b 3b 20 77 68 65 6e 20 74 68 65 20 70 72 6f 63 ;; when the proc
cef0: 65 73 73 20 65 78 69 74 73 20 6c 6f 6f 6b 20 61 ess exits look a
cf00: 74 20 74 68 65 20 64 62 2c 20 69 66 20 73 74 69 t the db, if sti
cf10: 6c 6c 20 52 55 4e 4e 49 4e 47 20 61 66 74 65 72 ll RUNNING after
cf20: 20 31 30 20 73 65 63 6f 6e 64 73 20 73 65 74 0a 10 seconds set.
cf30: 20 20 20 20 3b 3b 20 73 74 61 74 65 2f 73 74 61 ;; state/sta
cf40: 74 75 73 20 61 70 70 72 6f 70 72 69 61 74 65 6c tus appropriatel
cf50: 79 0a 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 y. (process-w
cf60: 61 69 74 20 70 69 64 29 29 29 0a ait pid))).