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 20 63 73 76 29 0a 28 75 73 65 20 64 bles csv).(use d
02a0: 65 66 73 74 72 75 63 74 20 70 61 74 68 6e 61 6d efstruct pathnam
02b0: 65 2d 65 78 70 61 6e 64 29 0a 0a 28 69 6d 70 6f e-expand)..(impo
02c0: 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 36 rt (prefix base6
02d0: 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 70 4 base64:)).(imp
02e0: 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 ort (prefix sqli
02f0: 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a te3 sqlite3:))..
0300: 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 6c (declare (unit l
0310: 61 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 65 aunch)).(declare
0320: 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a (uses common)).
0330: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
0340: 6f 6e 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 onfigf)).(declar
0350: 65 20 28 75 73 65 73 20 64 62 29 29 0a 3b 3b 20 e (uses db)).;;
0360: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 (declare (uses s
0370: 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 db)).(declare (u
0380: 73 65 73 20 74 64 62 29 29 0a 3b 3b 20 28 64 65 ses tdb)).;; (de
0390: 63 6c 61 72 65 20 28 75 73 65 73 20 66 69 6c 65 clare (uses file
03a0: 64 62 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 db))..(include "
03b0: 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 common_records.s
03c0: 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b cm").(include "k
03d0: 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 ey_records.scm")
03e0: 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 .(include "db_re
03f0: 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 3d cords.scm")..;;=
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0440: 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 65 70 73 =====.;; ezsteps
0450: 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 65 7a =========..;; ez
04a0: 73 74 65 70 73 20 77 65 72 65 20 67 6f 69 6e 67 steps were going
04b0: 20 74 6f 20 62 65 20 63 6f 64 65 64 20 61 73 0a to be coded as.
04c0: 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c 70 72 65 ;; stepname[,pre
04d0: 64 73 74 65 70 31 2c 70 72 65 64 73 74 65 70 32 dstep1,predstep2
04e0: 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d 66 69 72 ...] [{VAR1=fir
04f0: 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 7d st,second,third}
0500: 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 65 78 65 ] command to exe
0510: 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 0a 3b 3b cute.;; BUT.;;
0520: 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 74 65 70 now are.;; step
0530: 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 73 74 2c name {VAR=first,
0540: 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 2e 2e 2e second,third ...
0550: 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 0a 3b 3b } command ....;;
0560: 20 77 68 65 72 65 20 74 68 65 20 7b 56 41 52 3d where the {VAR=
0570: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0580: 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 74 69 6f rd ...} is optio
0590: 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 nal...;; given a
05a0: 6e 20 65 78 69 74 20 63 6f 64 65 20 61 6e 64 20 n exit code and
05b0: 77 68 65 74 68 65 72 20 6f 72 20 6e 6f 74 20 6c whether or not l
05c0: 6f 67 70 72 6f 20 77 61 73 20 75 73 65 64 20 63 ogpro was used c
05d0: 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 41 44 0a alculate OK/BAD.
05e0: 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 69 66 20 ;; return #t if
05f0: 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 20 6f 74 we are ok, #f ot
0600: 68 65 72 77 69 73 65 0a 28 64 65 66 69 6e 65 20 herwise.(define
0610: 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c (steprun-good? l
0620: 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 65 29 0a ogpro exitcode).
0630: 20 20 28 6f 72 20 28 65 71 3f 20 65 78 69 74 63 (or (eq? exitc
0640: 6f 64 65 20 30 29 0a 20 20 20 20 20 20 28 61 6e ode 0). (an
0650: 64 20 6c 6f 67 70 72 6f 20 28 65 71 3f 20 65 78 d logpro (eq? ex
0660: 69 74 63 6f 64 65 20 32 29 29 29 29 0a 0a 3b 3b itcode 2))))..;;
0670: 20 69 66 20 68 61 6e 64 65 64 20 61 20 73 74 72 if handed a str
0680: 69 6e 67 2c 20 70 72 6f 63 65 73 73 20 69 74 2c ing, process it,
0690: 20 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f 72 20 4d else look for M
06a0: 54 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 66 69 6e T_CMDINFO.(defin
06b0: 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 2d 63 6d e (launch:get-cm
06c0: 64 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c 69 73 74 dinfo-assoc-list
06d0: 20 23 21 6b 65 79 20 28 65 6e 63 6f 64 65 64 2d #!key (encoded-
06e0: 63 6d 64 20 23 66 29 29 0a 20 20 28 6c 65 74 20 cmd #f)). (let
06f0: 28 28 65 6e 63 63 6d 64 20 28 69 66 20 65 6e 63 ((enccmd (if enc
0700: 6f 64 65 64 2d 63 6d 64 20 65 6e 63 6f 64 65 64 oded-cmd encoded
0710: 2d 63 6d 64 20 28 67 65 74 65 6e 76 20 22 4d 54 -cmd (getenv "MT
0720: 5f 43 4d 44 49 4e 46 4f 22 29 29 29 29 0a 20 20 _CMDINFO")))).
0730: 20 20 28 69 66 20 65 6e 63 63 6d 64 0a 09 28 63 (if enccmd..(c
0740: 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 ommon:read-encod
0750: 65 64 2d 73 74 72 69 6e 67 20 65 6e 63 63 6d 64 ed-string enccmd
0760: 29 0a 09 27 28 29 29 29 29 0a 0a 3b 3b 20 20 20 )..'())))..;;
0770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0780: 20 20 20 20 30 20 20 20 20 20 20 20 20 20 20 20 0
0790: 31 20 20 20 20 20 20 20 20 20 20 20 20 20 20 32 1 2
07a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 33 0a 3.
07b0: 28 64 65 66 73 74 72 75 63 74 20 6c 61 75 6e 63 (defstruct launc
07c0: 68 3a 65 69 6e 66 20 28 70 69 64 20 23 74 29 28 h:einf (pid #t)(
07d0: 65 78 69 74 2d 73 74 61 74 75 73 20 23 74 29 28 exit-status #t)(
07e0: 65 78 69 74 2d 63 6f 64 65 20 23 74 29 28 72 6f exit-code #t)(ro
07f0: 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a llup-status 0)).
0800: 0a 3b 3b 20 72 65 74 75 72 6e 20 28 63 6f 6e 63 .;; return (conc
0810: 20 73 74 61 74 75 73 20 22 3a 20 22 20 63 6f 6d status ": " com
0820: 6d 65 6e 74 29 20 66 72 6f 6d 20 74 68 65 20 66 ment) from the f
0830: 69 6e 61 6c 20 73 65 63 74 69 6f 6e 20 73 6f 20 inal section so
0840: 74 68 61 74 0a 3b 3b 20 20 20 74 68 65 20 63 6f that.;; the co
0850: 6d 6d 65 6e 74 20 63 61 6e 20 62 65 20 73 65 74 mment can be set
0860: 20 69 6e 20 74 68 65 20 73 74 65 70 20 72 65 63 in the step rec
0870: 6f 72 64 20 69 6e 20 6c 61 75 6e 63 68 2e 73 63 ord in launch.sc
0880: 6d 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 m.;;.(define (la
0890: 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f unch:load-logpro
08a0: 2d 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 -dat run-id test
08b0: 2d 69 64 20 73 74 65 70 6e 61 6d 65 29 0a 20 20 -id stepname).
08c0: 28 6c 65 74 20 28 28 63 6e 61 6d 65 20 28 63 6f (let ((cname (co
08d0: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 nc stepname ".da
08e0: 74 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 66 t"))). (if (f
08f0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 6e 61 6d ile-exists? cnam
0900: 65 29 0a 09 28 6c 65 74 2a 20 28 28 64 61 74 20 e)..(let* ((dat
0910: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 6e (read-config cn
0920: 61 6d 65 20 23 66 20 23 66 29 29 0a 09 20 20 20 ame #f #f))..
0930: 20 20 20 20 28 63 73 76 72 20 28 64 62 3a 6c 6f (csvr (db:lo
0940: 67 70 72 6f 2d 64 61 74 2d 3e 63 73 76 20 64 61 gpro-dat->csv da
0950: 74 20 73 74 65 70 6e 61 6d 65 29 29 0a 09 20 20 t stepname))..
0960: 20 20 20 20 20 28 63 73 76 74 20 28 6c 65 74 2d (csvt (let-
0970: 76 61 6c 75 65 73 20 28 28 20 28 66 6d 74 2d 63 values (( (fmt-c
0980: 65 6c 6c 20 66 6d 74 2d 72 65 63 6f 72 64 20 66 ell fmt-record f
0990: 6d 74 2d 63 73 76 29 20 28 6d 61 6b 65 2d 66 6f mt-csv) (make-fo
09a0: 72 6d 61 74 20 22 2c 22 29 29 29 0a 09 09 09 09 rmat ","))).....
09b0: 20 28 66 6d 74 2d 63 73 76 20 28 6d 61 70 20 6c (fmt-csv (map l
09c0: 69 73 74 2d 3e 63 73 76 2d 72 65 63 6f 72 64 20 ist->csv-record
09d0: 63 73 76 72 29 29 29 29 0a 09 20 20 20 20 20 20 csvr))))..
09e0: 20 28 73 74 61 74 75 73 20 28 63 6f 6e 66 69 67 (status (config
09f0: 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 20 22 66 69 f:lookup dat "fi
0a00: 6e 61 6c 22 20 22 65 78 69 74 2d 73 74 61 74 75 nal" "exit-statu
0a10: 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 6d 73 s")).. (ms
0a20: 67 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c g (configf:l
0a30: 6f 6f 6b 75 70 20 64 61 74 20 22 66 69 6e 61 6c ookup dat "final
0a40: 22 20 22 6d 65 73 73 61 67 65 22 29 29 29 0a 09 " "message")))..
0a50: 20 20 28 72 6d 74 3a 63 73 76 2d 3e 74 65 73 74 (rmt:csv->test
0a60: 2d 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 -data run-id tes
0a70: 74 2d 69 64 20 63 73 76 74 29 0a 09 20 20 28 63 t-id csvt).. (c
0a80: 6f 6e 64 0a 09 20 20 20 28 28 65 71 75 61 6c 3f ond.. ((equal?
0a90: 20 73 74 61 74 75 73 20 22 50 41 53 53 22 29 20 status "PASS")
0aa0: 22 50 41 53 53 22 29 20 3b 3b 20 73 6b 69 70 20 "PASS") ;; skip
0ab0: 74 68 65 20 6d 65 73 73 61 67 65 20 70 61 72 74 the message part
0ac0: 20 69 66 20 73 74 61 74 75 73 20 69 73 20 70 61 if status is pa
0ad0: 73 73 0a 09 20 20 20 28 73 74 61 74 75 73 20 28 ss.. (status (
0ae0: 63 6f 6e 63 20 28 63 6f 6e 66 69 67 66 3a 6c 6f conc (configf:lo
0af0: 6f 6b 75 70 20 64 61 74 20 22 66 69 6e 61 6c 22 okup dat "final"
0b00: 20 22 65 78 69 74 2d 73 74 61 74 75 73 22 29 20 "exit-status")
0b10: 22 3a 20 22 20 28 69 66 20 6d 73 67 20 6d 73 67 ": " (if msg msg
0b20: 20 22 6e 6f 20 6d 65 73 73 61 67 65 22 29 29 29 "no message")))
0b30: 0a 09 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 .. (else #f)))
0b40: 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 ..#f)))..(define
0b50: 20 28 6c 61 75 6e 63 68 3a 72 75 6e 73 74 65 70 (launch:runstep
0b60: 20 65 7a 73 74 65 70 20 72 75 6e 2d 69 64 20 74 ezstep run-id t
0b70: 65 73 74 2d 69 64 20 65 78 69 74 2d 69 6e 66 6f est-id exit-info
0b80: 20 6d 20 74 61 6c 20 74 65 73 74 63 6f 6e 66 69 m tal testconfi
0b90: 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 73 74 65 g). (let* ((ste
0ba0: 70 6e 61 6d 65 20 20 20 20 20 20 20 28 63 61 72 pname (car
0bb0: 20 65 7a 73 74 65 70 29 29 20 20 3b 3b 20 64 6f ezstep)) ;; do
0bc0: 20 73 74 75 66 66 20 74 6f 20 72 75 6e 20 74 68 stuff to run th
0bd0: 65 20 73 74 65 70 0a 09 20 28 73 74 65 70 69 6e e step.. (stepin
0be0: 66 6f 20 20 20 20 20 20 20 28 63 61 64 72 20 65 fo (cadr e
0bf0: 7a 73 74 65 70 29 29 0a 09 20 28 73 74 65 70 70 zstep)).. (stepp
0c00: 61 72 74 73 20 20 20 20 20 20 28 73 74 72 69 6e arts (strin
0c10: 67 2d 6d 61 74 63 68 20 28 72 65 67 65 78 70 20 g-match (regexp
0c20: 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c "^(\\{([^\\}]*)\
0c30: 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 24 22 29 20 \}\\s*|)(.*)$")
0c40: 73 74 65 70 69 6e 66 6f 29 29 0a 09 20 28 73 74 stepinfo)).. (st
0c50: 65 70 70 61 72 6d 73 20 20 20 20 20 20 28 6c 69 epparms (li
0c60: 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 st-ref stepparts
0c70: 20 32 29 29 20 3b 3b 20 66 6f 72 20 66 75 74 75 2)) ;; for futu
0c80: 72 65 20 75 73 65 2c 20 7b 56 41 52 3d 31 2c 32 re use, {VAR=1,2
0c90: 2c 33 7d 2c 20 72 75 6e 20 73 74 65 70 20 66 6f ,3}, run step fo
0ca0: 72 20 65 61 63 68 20 0a 09 20 28 73 74 65 70 63 r each .. (stepc
0cb0: 6d 64 20 20 20 20 20 20 20 20 28 6c 69 73 74 2d md (list-
0cc0: 72 65 66 20 73 74 65 70 70 61 72 74 73 20 33 29 ref stepparts 3)
0cd0: 29 0a 09 20 28 73 63 72 69 70 74 20 20 20 20 20 ).. (script
0ce0: 20 20 20 20 22 22 29 20 3b 20 22 23 21 2f 62 69 "") ; "#!/bi
0cf0: 6e 2f 62 61 73 68 5c 6e 22 29 20 3b 3b 20 79 65 n/bash\n") ;; ye
0d00: 70 2c 20 77 65 20 64 65 70 65 6e 64 20 6f 6e 20 p, we depend on
0d10: 62 69 6e 2f 62 61 73 68 20 46 49 58 4d 45 21 21 bin/bash FIXME!!
0d20: 21 5c 0a 09 20 28 6c 6f 67 70 72 6f 2d 66 69 6c !\.. (logpro-fil
0d30: 65 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e e (conc stepn
0d40: 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 29 0a ame ".logpro")).
0d50: 09 20 28 68 74 6d 6c 2d 66 69 6c 65 20 20 20 20 . (html-file
0d60: 20 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 (conc stepname
0d70: 20 22 2e 68 74 6d 6c 22 29 29 0a 09 20 28 64 61 ".html")).. (da
0d80: 74 2d 66 69 6c 65 20 20 20 20 20 20 20 28 63 6f t-file (co
0d90: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 nc stepname ".da
0da0: 74 22 29 29 0a 09 20 28 74 63 6f 6e 66 69 67 2d t")).. (tconfig-
0db0: 6c 6f 67 70 72 6f 20 28 63 6f 6e 66 69 67 66 3a logpro (configf:
0dc0: 6c 6f 6f 6b 75 70 20 74 65 73 74 63 6f 6e 66 69 lookup testconfi
0dd0: 67 20 22 6c 6f 67 70 72 6f 22 20 73 74 65 70 6e g "logpro" stepn
0de0: 61 6d 65 29 29 0a 09 20 28 6c 6f 67 70 72 6f 2d ame)).. (logpro-
0df0: 75 73 65 64 20 20 20 20 28 66 69 6c 65 2d 65 78 used (file-ex
0e00: 69 73 74 73 3f 20 6c 6f 67 70 72 6f 2d 66 69 6c ists? logpro-fil
0e10: 65 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 61 e))).. (if (a
0e20: 6e 64 20 74 63 6f 6e 66 69 67 2d 6c 6f 67 70 72 nd tconfig-logpr
0e30: 6f 0a 09 20 20 20 20 20 28 6e 6f 74 20 6c 6f 67 o.. (not log
0e40: 70 72 6f 2d 75 73 65 64 29 29 20 3b 3b 20 6e 6f pro-used)) ;; no
0e50: 20 6c 6f 67 70 72 6f 20 66 69 6c 65 20 66 6f 75 logpro file fou
0e60: 6e 64 20 62 75 74 20 68 61 76 65 20 61 20 64 65 nd but have a de
0e70: 66 6e 20 69 6e 20 74 68 65 20 74 65 73 74 63 6f fn in the testco
0e80: 6e 66 69 67 0a 09 28 62 65 67 69 6e 0a 09 20 20 nfig..(begin..
0e90: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
0ea0: 66 69 6c 65 20 6c 6f 67 70 72 6f 2d 66 69 6c 65 file logpro-file
0eb0: 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 .. (lambda ()
0ec0: 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
0ed0: 3b 3b 20 6c 6f 67 70 72 6f 20 66 69 6c 65 20 65 ;; logpro file e
0ee0: 78 74 72 61 63 74 65 64 20 66 72 6f 6d 20 74 65 xtracted from te
0ef0: 73 74 63 6f 6e 66 69 67 5c 6e 22 0a 09 09 20 20 stconfig\n"...
0f00: 20 20 20 22 3b 3b 22 29 0a 09 20 20 20 20 20 20 ";;")..
0f10: 28 70 72 69 6e 74 20 74 63 6f 6e 66 69 67 2d 6c (print tconfig-l
0f20: 6f 67 70 72 6f 29 29 29 0a 09 20 20 28 73 65 74 ogpro))).. (set
0f30: 21 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 74 ! logpro-used #t
0f40: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 ))). . ;;
0f50: 4e 42 2f 2f 20 63 61 6e 20 73 61 66 65 6c 79 20 NB// can safely
0f60: 61 73 73 75 6d 65 20 77 65 20 61 72 65 20 69 6e assume we are in
0f70: 20 74 65 73 74 2d 61 72 65 61 20 64 69 72 65 63 test-area direc
0f80: 74 6f 72 79 0a 20 20 20 20 28 64 65 62 75 67 3a tory. (debug:
0f90: 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 print 4 *default
0fa0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 7a 73 74 -log-port* "ezst
0fb0: 65 70 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a eps:\n stepname:
0fc0: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 73 74 " stepname " st
0fd0: 65 70 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e epinfo: " stepin
0fe0: 66 6f 20 22 20 73 74 65 70 70 61 72 74 73 3a 20 fo " stepparts:
0ff0: 22 20 73 74 65 70 70 61 72 74 73 0a 09 09 20 22 " stepparts... "
1000: 20 73 74 65 70 70 61 72 6d 73 3a 20 22 20 73 74 stepparms: " st
1010: 65 70 70 61 72 6d 73 20 22 20 73 74 65 70 63 6d epparms " stepcm
1020: 64 3a 20 22 20 73 74 65 70 63 6d 64 29 0a 20 20 d: " stepcmd).
1030: 20 20 0a 20 20 20 20 3b 3b 20 3b 3b 20 66 69 72 . ;; ;; fir
1040: 73 74 20 73 6f 75 72 63 65 20 74 68 65 20 70 72 st source the pr
1050: 65 76 69 6f 75 73 20 65 6e 76 69 72 6f 6e 6d 65 evious environme
1060: 6e 74 0a 20 20 20 20 3b 3b 20 28 6c 65 74 20 28 nt. ;; (let (
1070: 28 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 20 (prev-env (conc
1080: 22 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 65 76 ".ezsteps/" prev
1090: 73 74 65 70 20 28 69 66 20 28 73 74 72 69 6e 67 step (if (string
10a0: 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 70 20 -search (regexp
10b0: 22 63 73 68 22 29 20 0a 20 20 20 20 3b 3b 20 20 "csh") . ;;
10c0: 20 20 20 20 09 09 09 09 09 09 09 20 28 67 65 74 ....... (get
10d0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
10e0: 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 29 20 iable "SHELL"))
10f0: 22 2e 63 73 68 22 20 22 2e 73 68 22 29 29 29 29 ".csh" ".sh"))))
1100: 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 . ;; (if (a
1110: 6e 64 20 70 72 65 76 73 74 65 70 20 28 66 69 6c nd prevstep (fil
1120: 65 2d 65 78 69 73 74 73 3f 20 70 72 65 76 2d 65 e-exists? prev-e
1130: 6e 76 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 nv)). ;;
1140: 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 (set! script (
1150: 63 6f 6e 63 20 73 63 72 69 70 74 20 22 73 6f 75 conc script "sou
1160: 72 63 65 20 22 20 70 72 65 76 2d 65 6e 76 29 29 rce " prev-env))
1170: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 63 )). . ;; c
1180: 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 20 all the command
1190: 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 65 70 0a using mt_ezstep.
11a0: 20 20 20 20 3b 3b 20 28 73 65 74 21 20 73 63 72 ;; (set! scr
11b0: 69 70 74 20 28 63 6f 6e 63 20 22 6d 74 5f 65 7a ipt (conc "mt_ez
11c0: 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 20 step " stepname
11d0: 22 20 22 20 28 69 66 20 70 72 65 76 73 74 65 70 " " (if prevstep
11e0: 20 70 72 65 76 73 74 65 70 20 22 78 22 29 20 22 prevstep "x") "
11f0: 20 22 20 73 74 65 70 63 6d 64 29 29 0a 20 20 20 " stepcmd)).
1200: 20 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
1210: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
1220: 67 2d 70 6f 72 74 2a 20 22 73 63 72 69 70 74 3a g-port* "script:
1230: 20 22 20 73 63 72 69 70 74 29 0a 20 20 20 20 28 " script). (
1240: 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 rmt:teststep-set
1250: 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
1260: 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
1270: 20 22 73 74 61 72 74 22 20 22 2d 22 20 23 66 20 "start" "-" #f
1280: 23 66 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 6c #f). ;; now l
1290: 61 75 6e 63 68 20 74 68 65 20 61 63 74 75 61 6c aunch the actual
12a0: 20 70 72 6f 63 65 73 73 0a 20 20 20 20 28 63 61 process. (ca
12b0: 6c 6c 2d 77 69 74 68 2d 65 6e 76 69 72 6f 6e 6d ll-with-environm
12c0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 73 20 0a 20 ent-variables .
12d0: 20 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 (list (cons
12e0: 22 50 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 "PATH" (conc (ge
12f0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
1300: 72 69 61 62 6c 65 20 22 50 41 54 48 22 29 20 22 riable "PATH") "
1310: 3a 2e 22 29 29 29 0a 20 20 20 20 20 28 6c 61 6d :."))). (lam
1320: 62 64 61 20 28 29 20 3b 3b 20 28 70 72 6f 63 65 bda () ;; (proce
1330: 73 73 2d 72 75 6e 20 22 2f 62 69 6e 2f 62 61 73 ss-run "/bin/bas
1340: 68 22 20 22 2d 63 22 20 22 65 78 65 63 20 6c 73 h" "-c" "exec ls
1350: 20 2d 6c 20 2f 74 6d 70 2f 66 6f 6f 62 61 72 20 -l /tmp/foobar
1360: 3e 20 2f 74 6d 70 2f 64 65 6c 6d 65 2d 6d 6f 72 > /tmp/delme-mor
1370: 65 2e 6c 6f 67 20 32 3e 26 31 22 29 0a 20 20 20 e.log 2>&1").
1380: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 20 (let* ((cmd
1390: 28 63 6f 6e 63 20 73 74 65 70 63 6d 64 20 22 20 (conc stepcmd "
13a0: 3e 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c > " stepname ".l
13b0: 6f 67 20 32 3e 26 31 22 29 29 20 3b 3b 20 3e 6f og 2>&1")) ;; >o
13c0: 75 74 66 69 6c 65 20 32 3e 26 31 20 0a 09 20 20 utfile 2>&1 ..
13d0: 20 20 20 20 28 70 69 64 20 28 70 72 6f 63 65 73 (pid (proces
13e0: 73 2d 72 75 6e 20 22 2f 62 69 6e 2f 62 61 73 68 s-run "/bin/bash
13f0: 22 20 28 6c 69 73 74 20 22 2d 63 22 20 63 6d 64 " (list "-c" cmd
1400: 29 29 29 29 0a 09 20 28 72 6d 74 3a 74 65 73 74 )))).. (rmt:test
1410: 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -set-top-process
1420: 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 -pid run-id test
1430: 2d 69 64 20 70 69 64 29 0a 09 20 28 6c 65 74 20 -id pid).. (let
1440: 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 processloop ((i
1450: 30 29 29 0a 09 20 20 20 28 6c 65 74 2d 76 61 6c 0)).. (let-val
1460: 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 ues (((pid-val e
1470: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
1480: 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d 77 61 code)(process-wa
1490: 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 20 it pid #t)))...
14a0: 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 (mutex-loc
14b0: 6b 21 20 6d 29 0a 09 09 20 20 20 20 20 20 20 28 k! m)... (
14c0: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 2d launch:einf-pid-
14d0: 73 65 74 21 20 20 20 20 20 20 20 20 20 65 78 69 set! exi
14e0: 74 2d 69 6e 66 6f 20 70 69 64 29 20 20 20 20 20 t-info pid)
14f0: 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 ;; (vector-s
1500: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 et! exit-info 0
1510: 70 69 64 29 0a 09 09 20 20 20 20 20 20 20 28 6c pid)... (l
1520: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
1530: 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 status-set! exit
1540: 2d 69 6e 66 6f 20 65 78 69 74 2d 73 74 61 74 75 -info exit-statu
1550: 73 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 s) ;; (vector-se
1560: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 t! exit-info 1 e
1570: 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 20 20 xit-status)...
1580: 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e (launch:ein
1590: 66 2d 65 78 69 74 2d 63 6f 64 65 2d 73 65 74 21 f-exit-code-set!
15a0: 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 65 78 69 exit-info exi
15b0: 74 2d 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 65 t-code) ;; (ve
15c0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
15d0: 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 nfo 2 exit-code)
15e0: 0a 09 09 20 20 20 20 20 20 20 28 6d 75 74 65 78 ... (mutex
15f0: 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 20 20 -unlock! m)...
1600: 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 70 69 (if (eq? pi
1610: 64 2d 76 61 6c 20 30 29 0a 09 09 09 20 20 20 28 d-val 0).... (
1620: 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 28 74 begin.... (t
1630: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
1640: 09 09 09 20 20 20 20 20 28 70 72 6f 63 65 73 73 ... (process
1650: 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 0a loop (+ i 1)))).
1660: 09 09 20 20 20 20 20 20 20 29 29 29 29 29 0a 20 .. ))))).
1670: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
1680: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
1690: 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 74 65 70 20 log-port* "step
16a0: 22 20 73 74 65 70 6e 61 6d 65 20 22 20 63 6f 6d " stepname " com
16b0: 70 6c 65 74 65 64 20 77 69 74 68 20 65 78 69 74 pleted with exit
16c0: 20 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 3a code " (launch:
16d0: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 einf-exit-code e
16e0: 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 28 76 xit-info)) ;; (v
16f0: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
1700: 6e 66 6f 20 32 29 29 0a 20 20 20 20 3b 3b 20 6e nfo 2)). ;; n
1710: 6f 77 20 72 75 6e 20 6c 6f 67 70 72 6f 20 69 66 ow run logpro if
1720: 20 6e 65 65 64 65 64 0a 20 20 20 20 28 69 66 20 needed. (if
1730: 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 28 6c 65 logpro-used..(le
1740: 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 t ((pid (process
1750: 2d 72 75 6e 20 28 63 6f 6e 63 20 22 6c 6f 67 70 -run (conc "logp
1760: 72 6f 20 22 20 6c 6f 67 70 72 6f 2d 66 69 6c 65 ro " logpro-file
1770: 20 22 20 22 20 28 63 6f 6e 63 20 73 74 65 70 6e " " (conc stepn
1780: 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 20 3c ame ".html") " <
1790: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f " stepname ".lo
17a0: 67 22 29 29 29 29 0a 09 20 20 28 6c 65 74 20 70 g")))).. (let p
17b0: 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 rocessloop ((i 0
17c0: 29 29 0a 09 20 20 20 20 28 6c 65 74 2d 76 61 6c )).. (let-val
17d0: 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 ues (((pid-val e
17e0: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
17f0: 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d 77 61 code)(process-wa
1800: 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 it pid #t)))....
1810: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
1820: 09 09 09 3b 3b 20 28 6d 61 6b 65 2d 6c 61 75 6e ...;; (make-laun
1830: 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 70 69 64 ch:einf pid: pid
1840: 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 65 78 exit-status: ex
1850: 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 it-status exit-c
1860: 6f 64 65 3a 20 65 78 69 74 2d 63 6f 64 65 29 0a ode: exit-code).
1870: 09 09 09 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d ...(launch:einf-
1880: 70 69 64 2d 73 65 74 21 20 20 20 20 20 20 20 20 pid-set!
1890: 20 65 78 69 74 2d 69 6e 66 6f 20 70 69 64 29 20 exit-info pid)
18a0: 20 20 20 20 20 20 20 20 3b 3b 20 28 76 65 63 74 ;; (vect
18b0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
18c0: 6f 20 30 20 70 69 64 29 0a 09 09 09 28 6c 61 75 o 0 pid)....(lau
18d0: 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 nch:einf-exit-st
18e0: 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d 69 atus-set! exit-i
18f0: 6e 66 6f 20 65 78 69 74 2d 73 74 61 74 75 73 29 nfo exit-status)
1900: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 ;; (vector-set!
1910: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
1920: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 28 6c 61 t-status)....(la
1930: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 unch:einf-exit-c
1940: 6f 64 65 2d 73 65 74 21 20 20 20 65 78 69 74 2d ode-set! exit-
1950: 69 6e 66 6f 20 65 78 69 74 2d 63 6f 64 65 29 20 info exit-code)
1960: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 ;; (vector-set
1970: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
1980: 69 74 2d 63 6f 64 65 29 0a 09 09 09 28 6d 75 74 it-code)....(mut
1990: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 ex-unlock! m)...
19a0: 09 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 .(if (eq? pid-va
19b0: 6c 20 30 29 0a 09 09 09 20 20 20 20 28 62 65 67 l 0).... (beg
19c0: 69 6e 0a 09 09 09 20 20 20 20 20 20 28 74 68 72 in.... (thr
19d0: 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 ead-sleep! 2)...
19e0: 09 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 6c . (processl
19f0: 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 29 0a oop (+ i 1))))).
1a00: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
1a10: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
1a20: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6c 6f 67 t-log-port* "log
1a30: 70 72 6f 20 66 6f 72 20 73 74 65 70 20 22 20 73 pro for step " s
1a40: 74 65 70 6e 61 6d 65 20 22 20 65 78 69 74 65 64 tepname " exited
1a50: 20 77 69 74 68 20 63 6f 64 65 20 22 20 28 6c 61 with code " (la
1a60: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 unch:einf-exit-c
1a70: 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 29 29 ode exit-info)))
1a80: 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 )) ;; (vector-re
1a90: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 29 f exit-info 2)))
1aa0: 29 29 0a 20 20 20 20 0a 20 20 20 20 28 6c 65 74 )). . (let
1ab0: 20 28 28 65 78 69 6e 66 6f 20 28 6c 61 75 6e 63 ((exinfo (launc
1ac0: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 h:einf-exit-code
1ad0: 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 exit-info)) ;;
1ae0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
1af0: 2d 69 6e 66 6f 20 32 29 29 0a 09 20 20 28 6c 6f -info 2)).. (lo
1b00: 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 6f 2d gfna (if logpro-
1b10: 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 70 6e used (conc stepn
1b20: 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 22 29 ame ".html") "")
1b30: 29 0a 09 20 20 28 63 6f 6d 6d 65 6e 74 20 23 66 ).. (comment #f
1b40: 29 29 0a 20 20 20 20 20 20 28 69 66 20 6c 6f 67 )). (if log
1b50: 70 72 6f 2d 75 73 65 64 0a 09 20 20 28 6c 65 74 pro-used.. (let
1b60: 20 28 28 64 61 74 66 69 6c 65 20 28 63 6f 6e 63 ((datfile (conc
1b70: 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 74 22 stepname ".dat"
1b80: 29 29 29 0a 09 20 20 20 20 3b 3b 20 6c 6f 61 64 ))).. ;; load
1b90: 20 74 68 65 20 2e 64 61 74 20 66 69 6c 65 20 69 the .dat file i
1ba0: 6e 74 6f 20 74 68 65 20 74 65 73 74 5f 64 61 74 nto the test_dat
1bb0: 61 20 74 61 62 6c 65 20 69 66 20 69 74 20 65 78 a table if it ex
1bc0: 69 73 74 73 0a 09 20 20 20 20 28 69 66 20 28 66 ists.. (if (f
1bd0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 61 74 66 ile-exists? datf
1be0: 69 6c 65 29 0a 09 09 28 73 65 74 21 20 63 6f 6d ile)...(set! com
1bf0: 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 ment (launch:loa
1c00: 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 6e d-logpro-dat run
1c10: 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 -id test-id step
1c20: 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 28 72 6d name))).. (rm
1c30: 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 20 t:test-set-log!
1c40: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 28 run-id test-id (
1c50: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
1c60: 68 74 6d 6c 22 29 29 29 29 0a 20 20 20 20 20 20 html")))).
1c70: 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 (rmt:teststep-se
1c80: 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
1c90: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
1ca0: 65 20 22 65 6e 64 22 20 65 78 69 6e 66 6f 20 63 e "end" exinfo c
1cb0: 6f 6d 6d 65 6e 74 20 6c 6f 67 66 6e 61 29 29 0a omment logfna)).
1cc0: 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 74 ;; set the t
1cd0: 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 73 est final status
1ce0: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 70 72 6f . (let* ((pro
1cf0: 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 73 cess-exit-status
1d00: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 (launch:einf-ex
1d10: 69 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 it-code exit-inf
1d20: 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 o)) ;; (vector-r
1d30: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 ef exit-info 2))
1d40: 0a 09 20 20 20 28 74 68 69 73 2d 73 74 65 70 2d .. (this-step-
1d50: 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
1d60: 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f ((and (eq?
1d70: 20 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 process-exit-st
1d80: 61 74 75 73 20 32 29 20 6c 6f 67 70 72 6f 2d 75 atus 2) logpro-u
1d90: 73 65 64 29 20 27 77 61 72 6e 29 20 20 20 3b 3b sed) 'warn) ;;
1da0: 20 6c 6f 67 70 72 6f 20 32 20 3d 20 77 61 72 6e logpro 2 = warn
1db0: 69 6e 67 73 0a 09 09 09 20 20 20 20 20 20 28 28 ings.... ((
1dc0: 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 73 73 and (eq? process
1dd0: 2d 65 78 69 74 2d 73 74 61 74 75 73 20 33 29 20 -exit-status 3)
1de0: 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 63 68 logpro-used) 'ch
1df0: 65 63 6b 29 20 20 3b 3b 20 6c 6f 67 70 72 6f 20 eck) ;; logpro
1e00: 33 20 3d 20 63 68 65 63 6b 0a 09 09 09 20 20 20 3 = check....
1e10: 20 20 20 28 28 61 6e 64 20 28 65 71 3f 20 70 72 ((and (eq? pr
1e20: 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 ocess-exit-statu
1e30: 73 20 34 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 s 4) logpro-used
1e40: 29 20 27 77 61 69 76 65 64 29 20 3b 3b 20 6c 6f ) 'waived) ;; lo
1e50: 67 70 72 6f 20 34 20 3d 20 77 61 69 76 65 64 0a gpro 4 = waived.
1e60: 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 ... ((and (
1e70: 65 71 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 74 eq? process-exit
1e80: 2d 73 74 61 74 75 73 20 35 29 20 6c 6f 67 70 72 -status 5) logpr
1e90: 6f 2d 75 73 65 64 29 20 27 61 62 6f 72 74 29 20 o-used) 'abort)
1ea0: 20 3b 3b 20 6c 6f 67 70 72 6f 20 35 20 3d 20 61 ;; logpro 5 = a
1eb0: 62 6f 72 74 0a 09 09 09 20 20 20 20 20 20 28 28 bort.... ((
1ec0: 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 73 73 and (eq? process
1ed0: 2d 65 78 69 74 2d 73 74 61 74 75 73 20 36 29 20 -exit-status 6)
1ee0: 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 73 6b logpro-used) 'sk
1ef0: 69 70 29 20 20 20 3b 3b 20 6c 6f 67 70 72 6f 20 ip) ;; logpro
1f00: 36 20 3d 20 73 6b 69 70 0a 09 09 09 20 20 20 20 6 = skip....
1f10: 20 20 28 28 65 71 3f 20 70 72 6f 63 65 73 73 2d ((eq? process-
1f20: 65 78 69 74 2d 73 74 61 74 75 73 20 30 29 20 20 exit-status 0)
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f40: 20 27 70 61 73 73 29 20 20 20 3b 3b 20 6c 6f 67 'pass) ;; log
1f50: 70 72 6f 20 30 20 3d 20 70 61 73 73 0a 09 09 09 pro 0 = pass....
1f60: 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 (else 'fai
1f70: 6c 29 29 29 0a 09 20 20 20 28 6f 76 65 72 61 6c l))).. (overal
1f80: 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f 6e 64 l-status (cond
1f90: 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 .... ((eq?
1fa0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
1fb0: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
1fc0: 69 6e 66 6f 29 20 32 29 20 27 77 61 72 6e 29 20 info) 2) 'warn)
1fd0: 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 ;; rollup-status
1fe0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
1ff0: 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 20 20 20 t-info 3)....
2000: 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 ((eq? (launch
2010: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
2020: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 30 tus exit-info) 0
2030: 29 20 27 70 61 73 73 29 20 3b 3b 20 28 76 65 63 ) 'pass) ;; (vec
2040: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
2050: 6f 20 33 29 0a 09 09 09 20 20 20 20 20 20 28 65 o 3).... (e
2060: 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 20 20 lse 'fail)))..
2070: 20 28 6e 65 78 74 2d 73 74 61 74 75 73 20 20 20 (next-status
2080: 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 20 20 20 (cond ....
2090: 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c ((eq? overall
20a0: 2d 73 74 61 74 75 73 20 27 70 61 73 73 29 20 74 -status 'pass) t
20b0: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 29 his-step-status)
20c0: 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 .... ((eq?
20d0: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 overall-status '
20e0: 77 61 72 6e 29 0a 09 09 09 20 20 20 20 20 20 20 warn)....
20f0: 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 (if (eq? this-st
2100: 65 70 2d 73 74 61 74 75 73 20 27 66 61 69 6c 29 ep-status 'fail)
2110: 20 27 66 61 69 6c 20 27 77 61 72 6e 29 29 0a 09 'fail 'warn))..
2120: 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 6f 76 .. ((eq? ov
2130: 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 61 62 erall-status 'ab
2140: 6f 72 74 29 20 27 61 62 6f 72 74 29 0a 09 09 09 ort) 'abort)....
2150: 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 (else 'fai
2160: 6c 29 29 29 0a 09 20 20 20 28 6e 65 78 74 2d 73 l))).. (next-s
2170: 74 61 74 65 20 20 20 20 20 20 20 3b 3b 20 22 52 tate ;; "R
2180: 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 57 48 59 20 UNNING") ;; WHY
2190: 57 41 53 20 54 48 49 53 20 43 48 41 4e 47 45 44 WAS THIS CHANGED
21a0: 20 54 4f 20 4e 4f 54 20 55 53 45 20 28 6e 75 6c TO NOT USE (nul
21b0: 6c 3f 20 74 61 6c 29 20 3f 3f 0a 09 20 20 20 20 l? tal) ??..
21c0: 28 63 6f 6e 64 0a 09 20 20 20 20 20 28 28 6e 75 (cond.. ((nu
21d0: 6c 6c 3f 20 74 61 6c 29 20 3b 3b 20 6d 6f 72 65 ll? tal) ;; more
21e0: 20 74 6f 20 72 75 6e 3f 0a 09 20 20 20 20 20 20 to run?..
21f0: 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 20 20 "COMPLETED")..
2200: 20 20 20 28 65 6c 73 65 20 22 52 55 4e 4e 49 4e (else "RUNNIN
2210: 47 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 G")))). (de
2220: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
2230: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
2240: 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 65 69 Exit value recei
2250: 76 65 64 3a 20 22 20 28 6c 61 75 6e 63 68 3a 65 ved: " (launch:e
2260: 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 inf-exit-code ex
2270: 69 74 2d 69 6e 66 6f 29 20 22 20 6c 6f 67 70 72 it-info) " logpr
2280: 6f 2d 75 73 65 64 3a 20 22 20 6c 6f 67 70 72 6f o-used: " logpro
2290: 2d 75 73 65 64 20 0a 09 09 20 20 20 22 20 74 68 -used ... " th
22a0: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 3a 20 is-step-status:
22b0: 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 " this-step-stat
22c0: 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 us " overall-sta
22d0: 74 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c 2d 73 tus: " overall-s
22e0: 74 61 74 75 73 20 0a 09 09 20 20 20 22 20 6e 65 tatus ... " ne
22f0: 78 74 2d 73 74 61 74 75 73 3a 20 22 20 6e 65 78 xt-status: " nex
2300: 74 2d 73 74 61 74 75 73 20 22 20 72 6f 6c 6c 75 t-status " rollu
2310: 70 2d 73 74 61 74 75 73 3a 20 22 20 20 28 6c 61 p-status: " (la
2320: 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 unch:einf-rollup
2330: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 -status exit-inf
2340: 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 o)) ;; (vector-r
2350: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 29 ef exit-info 3))
2360: 0a 20 20 20 20 20 20 28 63 61 73 65 20 6e 65 78 . (case nex
2370: 74 2d 73 74 61 74 75 73 0a 09 28 28 77 61 72 6e t-status..((warn
2380: 29 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 ).. (launch:einf
2390: 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 -rollup-status-s
23a0: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 et! exit-info 2)
23b0: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 ;; (vector-set!
23c0: 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 32 29 20 exit-info 3 2)
23d0: 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 ;; rollup-status
23e0: 0a 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d .. ;; NB// test-
23f0: 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 set-status! does
2400: 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 rdb calls under
2410: 20 74 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 73 the hood.. (tes
2420: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
2430: 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
2440: 69 64 20 6e 65 78 74 2d 73 74 61 74 65 20 22 57 id next-state "W
2450: 41 52 4e 22 20 0a 09 09 09 09 20 28 69 66 20 28 ARN" ..... (if (
2460: 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 eq? this-step-st
2470: 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 atus 'warn) "Log
2480: 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e pro warning foun
2490: 64 22 20 23 66 29 0a 09 09 09 09 20 23 66 29 29 d" #f)..... #f))
24a0: 0a 09 28 28 63 68 65 63 6b 29 0a 09 20 28 6c 61 ..((check).. (la
24b0: 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 unch:einf-rollup
24c0: 2d 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 -status-set! exi
24d0: 74 2d 69 6e 66 6f 20 33 29 20 3b 3b 20 28 76 65 t-info 3) ;; (ve
24e0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
24f0: 6e 66 6f 20 33 20 33 29 20 3b 3b 20 72 6f 6c 6c nfo 3 3) ;; roll
2500: 75 70 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e up-status.. ;; N
2510: 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 B// test-set-sta
2520: 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 tus! does rdb ca
2530: 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f lls under the ho
2540: 6f 64 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 od.. (tests:test
2550: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
2560: 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 -id test-id next
2570: 2d 73 74 61 74 65 20 22 43 48 45 43 4b 22 20 0a -state "CHECK" .
2580: 09 09 09 09 20 28 69 66 20 28 65 71 3f 20 74 68 .... (if (eq? th
2590: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 is-step-status '
25a0: 63 68 65 63 6b 29 20 22 4c 6f 67 70 72 6f 20 63 check) "Logpro c
25b0: 68 65 63 6b 20 66 6f 75 6e 64 22 20 23 66 29 0a heck found" #f).
25c0: 09 09 09 09 20 23 66 29 29 0a 09 28 28 77 61 69 .... #f))..((wai
25d0: 76 65 64 29 0a 09 20 28 6c 61 75 6e 63 68 3a 65 ved).. (launch:e
25e0: 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 inf-rollup-statu
25f0: 73 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f s-set! exit-info
2600: 20 34 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 4) ;; (vector-s
2610: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 et! exit-info 3
2620: 33 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 3) ;; rollup-sta
2630: 74 75 73 0a 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 tus.. ;; NB// te
2640: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 st-set-status! d
2650: 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e oes rdb calls un
2660: 64 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 20 28 der the hood.. (
2670: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
2680: 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
2690: 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 65 st-id next-state
26a0: 20 22 57 41 49 56 45 44 22 20 0a 09 09 09 09 20 "WAIVED" .....
26b0: 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 (if (eq? this-st
26c0: 65 70 2d 73 74 61 74 75 73 20 27 63 68 65 63 6b ep-status 'check
26d0: 29 20 22 4c 6f 67 70 72 6f 20 77 61 69 76 65 64 ) "Logpro waived
26e0: 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 found" #f).....
26f0: 20 23 66 29 29 0a 09 28 28 61 62 6f 72 74 29 0a #f))..((abort).
2700: 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 . (launch:einf-r
2710: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 ollup-status-set
2720: 21 20 65 78 69 74 2d 69 6e 66 6f 20 35 29 20 3b ! exit-info 5) ;
2730: 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 ; (vector-set! e
2740: 78 69 74 2d 69 6e 66 6f 20 33 20 34 29 20 3b 3b xit-info 3 4) ;;
2750: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a 09 rollup-status..
2760: 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 ;; NB// test-se
2770: 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 20 72 t-status! does r
2780: 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 db calls under t
2790: 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 73 74 73 he hood.. (tests
27a0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
27b0: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
27c0: 20 6e 65 78 74 2d 73 74 61 74 65 20 22 41 42 4f next-state "ABO
27d0: 52 54 22 20 0a 09 09 09 09 20 28 69 66 20 28 65 RT" ..... (if (e
27e0: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
27f0: 74 75 73 20 27 61 62 6f 72 74 29 20 22 4c 6f 67 tus 'abort) "Log
2800: 70 72 6f 20 61 62 6f 72 74 20 66 6f 75 6e 64 22 pro abort found"
2810: 20 23 66 29 0a 09 09 09 09 20 23 66 29 29 0a 09 #f)..... #f))..
2820: 28 28 73 6b 69 70 29 0a 09 20 28 6c 61 75 6e 63 ((skip).. (launc
2830: 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 h:einf-rollup-st
2840: 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d 69 atus-set! exit-i
2850: 6e 66 6f 20 36 29 20 3b 3b 20 28 76 65 63 74 6f nfo 6) ;; (vecto
2860: 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f r-set! exit-info
2870: 20 33 20 34 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 3 4) ;; rollup-
2880: 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f 2f status.. ;; NB//
2890: 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 test-set-status
28a0: 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 ! does rdb calls
28b0: 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 0a under the hood.
28c0: 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 . (tests:test-se
28d0: 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
28e0: 20 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 test-id next-st
28f0: 61 74 65 20 22 53 4b 49 50 22 20 0a 09 09 09 09 ate "SKIP" .....
2900: 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 (if (eq? this-s
2910: 74 65 70 2d 73 74 61 74 75 73 20 27 73 6b 69 70 tep-status 'skip
2920: 29 20 22 4c 6f 67 70 72 6f 20 73 6b 69 70 20 66 ) "Logpro skip f
2930: 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 20 23 ound" #f)..... #
2940: 66 29 29 0a 09 28 28 70 61 73 73 29 0a 09 20 28 f))..((pass).. (
2950: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
2960: 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
2970: 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 65 st-id next-state
2980: 20 22 50 41 53 53 22 20 23 66 20 23 66 29 29 0a "PASS" #f #f)).
2990: 09 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c 0a .(else ;; 'fail.
29a0: 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 . (launch:einf-r
29b0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 ollup-status-set
29c0: 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 3b ! exit-info 1) ;
29d0: 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 ; (vector-set! e
29e0: 78 69 74 2d 69 6e 66 6f 20 33 20 31 29 20 3b 3b xit-info 3 1) ;;
29f0: 20 66 6f 72 63 65 20 66 61 69 6c 2c 20 74 68 69 force fail, thi
2a00: 73 20 75 73 65 64 20 74 6f 20 62 65 20 6e 65 78 s used to be nex
2a10: 74 2d 73 74 61 74 65 20 62 75 74 20 74 68 61 74 t-state but that
2a20: 20 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 doesn't make se
2a30: 6e 73 65 2e 20 73 68 6f 75 6c 64 20 61 6c 77 61 nse. should alwa
2a40: 79 73 20 62 65 20 22 43 4f 4d 50 4c 45 54 45 44 ys be "COMPLETED
2a50: 22 20 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 " .. (tests:test
2a60: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
2a70: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 43 4f 4d -id test-id "COM
2a80: 50 4c 45 54 45 44 22 20 22 46 41 49 4c 22 20 28 PLETED" "FAIL" (
2a90: 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 20 conc "Failed at
2aa0: 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 29 step " stepname)
2ab0: 20 23 66 29 0a 09 20 29 29 29 0a 20 20 20 20 6c #f).. ))). l
2ac0: 6f 67 70 72 6f 2d 75 73 65 64 29 29 0a 0a 28 64 ogpro-used))..(d
2ad0: 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 6d 61 efine (launch:ma
2ae0: 6e 61 67 65 2d 73 74 65 70 73 20 72 75 6e 2d 69 nage-steps run-i
2af0: 64 20 74 65 73 74 2d 69 64 20 69 74 65 6d 2d 70 d test-id item-p
2b00: 61 74 68 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ath fullrunscrip
2b10: 74 20 65 7a 73 74 65 70 73 20 74 65 73 74 2d 6e t ezsteps test-n
2b20: 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 67 20 65 ame tconfigreg e
2b30: 78 69 74 2d 69 6e 66 6f 20 6d 29 0a 20 20 3b 3b xit-info m). ;;
2b40: 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 20 20 3b (let-values. ;
2b50: 3b 20 20 28 28 28 70 69 64 20 65 78 69 74 2d 73 ; (((pid exit-s
2b60: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 tatus exit-code)
2b70: 0a 20 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d . ;; (run-n-
2b80: 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 wait fullrunscri
2b90: 70 74 29 29 29 0a 20 20 3b 3b 20 28 74 65 73 74 pt))). ;; (test
2ba0: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
2bb0: 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e s! test-id "RUNN
2bc0: 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 20 23 66 ING" "n/a" #f #f
2bd0: 29 0a 20 20 3b 3b 20 53 69 6e 63 65 20 77 65 20 ). ;; Since we
2be0: 73 68 6f 75 6c 64 20 68 61 76 65 20 61 20 63 6c should have a cl
2bf0: 65 61 6e 20 73 6c 61 74 65 20 61 74 20 74 68 69 ean slate at thi
2c00: 73 20 74 69 6d 65 20 74 68 65 72 65 20 69 73 20 s time there is
2c10: 6e 6f 20 6e 65 65 64 20 74 6f 20 64 6f 20 0a 20 no need to do .
2c20: 20 3b 3b 20 61 6e 79 20 6f 66 20 74 68 65 20 6f ;; any of the o
2c30: 74 68 65 72 20 73 74 75 66 66 20 74 68 61 74 20 ther stuff that
2c40: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
2c50: 74 61 74 75 73 21 20 64 6f 65 73 2e 20 4c 65 74 tatus! does. Let
2c60: 27 73 20 6a 75 73 74 20 0a 20 20 3b 3b 20 66 6f 's just . ;; fo
2c70: 72 63 65 20 52 55 4e 4e 49 4e 47 2f 6e 2f 61 0a rce RUNNING/n/a.
2c80: 0a 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c . ;; (thread-sl
2c90: 65 65 70 21 20 30 2e 33 29 0a 20 20 28 74 65 73 eep! 0.3). (tes
2ca0: 74 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 ts:test-force-st
2cb0: 61 74 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d ate-status! run-
2cc0: 69 64 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e id test-id "RUNN
2cd0: 49 4e 47 22 20 22 6e 2f 61 22 29 0a 20 20 28 72 ING" "n/a"). (r
2ce0: 6d 74 3a 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d mt:roll-up-pass-
2cf0: 66 61 69 6c 2d 63 6f 75 6e 74 73 20 72 75 6e 2d fail-counts run-
2d00: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
2d10: 6d 2d 70 61 74 68 20 23 66 20 22 52 55 4e 4e 49 m-path #f "RUNNI
2d20: 4e 47 22 29 0a 20 20 3b 3b 20 28 74 68 72 65 61 NG"). ;; (threa
2d30: 64 2d 73 6c 65 65 70 21 20 30 2e 33 29 20 3b 3b d-sleep! 0.3) ;;
2d40: 20 4e 46 53 20 73 6c 6f 77 6e 65 73 73 20 68 61 NFS slowness ha
2d50: 73 20 63 61 75 73 65 64 20 67 72 69 65 66 20 68 s caused grief h
2d60: 65 72 65 0a 0a 20 20 3b 3b 20 69 66 20 74 68 65 ere.. ;; if the
2d70: 72 65 20 69 73 20 61 20 72 75 6e 73 63 72 69 70 re is a runscrip
2d80: 74 20 64 6f 20 69 74 20 66 69 72 73 74 0a 20 20 t do it first.
2d90: 28 69 66 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 (if fullrunscrip
2da0: 74 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 t. (let ((p
2db0: 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 id (process-run
2dc0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
2dd0: 0a 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d ..(rmt:test-set-
2de0: 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 top-process-pid
2df0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 run-id test-id p
2e00: 69 64 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 id)..(let loop (
2e10: 28 69 20 30 29 29 0a 09 20 20 28 6c 65 74 2d 76 (i 0)).. (let-v
2e20: 61 6c 75 65 73 0a 09 20 20 20 28 28 28 70 69 64 alues.. (((pid
2e30: 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 -val exit-status
2e40: 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f exit-code) (pro
2e50: 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 cess-wait pid #t
2e60: 29 29 29 0a 09 20 20 20 28 6d 75 74 65 78 2d 6c ))).. (mutex-l
2e70: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 28 6c 61 75 ock! m).. (lau
2e80: 6e 63 68 3a 65 69 6e 66 2d 70 69 64 2d 73 65 74 nch:einf-pid-set
2e90: 21 20 20 20 20 20 20 20 20 20 20 20 65 78 69 74 ! exit
2ea0: 2d 69 6e 66 6f 20 20 70 69 64 29 20 20 20 20 20 -info pid)
2eb0: 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 ;; (vector-s
2ec0: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 et! exit-info 0
2ed0: 70 69 64 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 pid).. (launch
2ee0: 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 :einf-exit-statu
2ef0: 73 2d 73 65 74 21 20 20 20 65 78 69 74 2d 69 6e s-set! exit-in
2f00: 66 6f 20 20 65 78 69 74 2d 73 74 61 74 75 73 29 fo exit-status)
2f10: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 ;; (vector-set!
2f20: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
2f30: 74 2d 73 74 61 74 75 73 29 0a 09 20 20 20 28 6c t-status).. (l
2f40: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
2f50: 63 6f 64 65 2d 73 65 74 21 20 20 20 20 20 65 78 code-set! ex
2f60: 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d 63 6f it-info exit-co
2f70: 64 65 29 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 de) ;; (vector
2f80: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
2f90: 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 20 20 2 exit-code)..
2fa0: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f (launch:einf-ro
2fb0: 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 21 llup-status-set!
2fc0: 20 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 exit-info exit
2fd0: 2d 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 65 63 -code) ;; (vec
2fe0: 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e tor-set! exit-in
2ff0: 66 6f 20 33 20 65 78 69 74 2d 63 6f 64 65 29 20 fo 3 exit-code)
3000: 20 3b 3b 20 72 6f 6c 6c 75 70 20 73 74 61 74 75 ;; rollup statu
3010: 73 0a 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c s.. (mutex-unl
3020: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 28 69 66 20 ock! m).. (if
3030: 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a (eq? pid-val 0).
3040: 09 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 . (begin..
3050: 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 . (thread-sleep!
3060: 20 32 29 0a 09 09 20 28 6c 6f 6f 70 20 28 2b 20 2)... (loop (+
3070: 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 20 29 i 1))).. )
3080: 29 29 29 29 0a 20 20 3b 3b 20 74 68 65 6e 2c 20 )))). ;; then,
3090: 69 66 20 72 75 6e 73 63 72 69 70 74 20 72 61 6e if runscript ran
30a0: 20 6f 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 ok (or did not
30b0: 67 65 74 20 63 61 6c 6c 65 64 29 0a 20 20 3b 3b get called). ;;
30c0: 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 do all the ezst
30d0: 65 70 73 20 28 69 66 20 61 6e 79 29 0a 20 20 28 eps (if any). (
30e0: 69 66 20 65 7a 73 74 65 70 73 0a 20 20 20 20 20 if ezsteps.
30f0: 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 6f 6e (let* ((testcon
3100: 66 69 67 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e fig ;; (read-con
3110: 66 69 67 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 fig (conc work-a
3120: 72 65 61 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 rea "/testconfig
3130: 22 29 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e ") #f #t environ
3140: 2d 70 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e -patt: "pre-laun
3150: 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 29 20 3b ch-env-vars")) ;
3160: 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c ; FIXME??? is al
3170: 6c 6f 77 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 low-system ok he
3180: 72 65 3f 0a 09 20 20 20 20 20 20 3b 3b 20 4e 4f re?.. ;; NO
3190: 54 45 3a 20 69 74 20 69 73 20 74 65 6d 70 74 69 TE: it is tempti
31a0: 6e 67 20 74 6f 20 74 75 72 6e 20 6f 66 66 20 66 ng to turn off f
31b0: 6f 72 63 65 2d 63 72 65 61 74 65 20 6f 66 20 74 orce-create of t
31c0: 65 73 74 63 6f 6e 66 69 67 20 62 75 74 20 64 79 estconfig but dy
31d0: 6e 61 6d 69 63 0a 09 20 20 20 20 20 20 3b 3b 20 namic.. ;;
31e0: 20 20 20 20 20 20 65 7a 73 74 65 70 20 6e 61 6d ezstep nam
31f0: 65 73 20 6e 65 65 64 20 61 20 66 75 6c 6c 20 72 es need a full r
3200: 65 2d 65 76 61 6c 20 68 65 72 65 2e 0a 09 20 20 e-eval here...
3210: 20 20 20 20 28 74 65 73 74 73 3a 67 65 74 2d 74 (tests:get-t
3220: 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e estconfig test-n
3230: 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 67 20 23 ame tconfigreg #
3240: 74 20 66 6f 72 63 65 2d 63 72 65 61 74 65 3a 20 t force-create:
3250: 23 74 29 29 20 3b 3b 20 27 72 65 74 75 72 6e 2d #t)) ;; 'return-
3260: 70 72 6f 63 73 29 29 29 0a 09 20 20 20 20 20 28 procs))).. (
3270: 65 7a 73 74 65 70 73 6c 73 74 20 28 69 66 20 28 ezstepslst (if (
3280: 68 61 73 68 2d 74 61 62 6c 65 3f 20 74 65 73 74 hash-table? test
3290: 63 6f 6e 66 69 67 29 0a 09 09 09 20 20 20 20 20 config)....
32a0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
32b0: 64 65 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 default testconf
32c0: 69 67 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 ig "ezsteps" '()
32d0: 29 0a 09 09 09 20 20 20 20 20 23 66 29 29 29 0a ).... #f))).
32e0: 09 28 69 66 20 74 65 73 74 63 6f 6e 66 69 67 0a .(if testconfig.
32f0: 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 . (hash-table
3300: 2d 73 65 74 21 20 2a 74 65 73 74 63 6f 6e 66 69 -set! *testconfi
3310: 67 73 2a 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 gs* test-name te
3320: 73 74 63 6f 6e 66 69 67 29 20 3b 3b 20 63 61 63 stconfig) ;; cac
3330: 68 65 64 20 66 6f 72 20 6c 61 7a 79 20 72 65 61 hed for lazy rea
3340: 64 73 20 6c 61 74 65 72 20 2e 2e 2e 0a 09 20 20 ds later .....
3350: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
3360: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 (launch:setup)..
3370: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
3380: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
3390: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
33a0: 3a 20 6e 6f 20 74 65 73 74 63 6f 6e 66 69 67 20 : no testconfig
33b0: 66 6f 75 6e 64 20 66 6f 72 20 22 20 74 65 73 74 found for " test
33c0: 2d 6e 61 6d 65 20 22 20 69 6e 20 73 65 61 72 63 -name " in searc
33d0: 68 20 70 61 74 68 3a 5c 6e 20 20 22 0a 09 09 09 h path:\n "....
33e0: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
33f0: 73 70 65 72 73 65 20 28 74 65 73 74 73 3a 67 65 sperse (tests:ge
3400: 74 2d 74 65 73 74 73 2d 73 65 61 72 63 68 2d 70 t-tests-search-p
3410: 61 74 68 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 ath *configdat*)
3420: 20 22 5c 6e 20 20 22 29 29 29 29 0a 09 3b 3b 20 "\n "))))..;;
3430: 61 66 74 65 72 20 61 6c 6c 20 74 68 61 74 2c 20 after all that,
3440: 73 74 69 6c 6c 20 6e 6f 20 74 65 73 74 63 6f 6e still no testcon
3450: 66 69 67 3f 20 54 69 6d 65 20 74 6f 20 61 62 6f fig? Time to abo
3460: 72 74 0a 09 28 69 66 20 28 6e 6f 74 20 74 65 73 rt..(if (not tes
3470: 74 63 6f 6e 66 69 67 29 0a 09 20 20 20 20 28 62 tconfig).. (b
3480: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
3490: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
34a0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
34b0: 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 72 rt* "Failed to r
34c0: 65 73 6f 6c 76 65 20 6d 65 67 61 74 65 73 74 2e esolve megatest.
34d0: 63 6f 6e 66 69 67 2c 20 72 75 6e 63 6f 6e 66 69 config, runconfi
34e0: 67 73 2e 63 6f 6e 66 69 67 20 61 6e 64 20 74 65 gs.config and te
34f0: 73 74 63 6f 6e 66 69 67 20 69 73 73 75 65 73 2e stconfig issues.
3500: 20 47 69 76 69 6e 67 20 75 70 20 6e 6f 77 22 29 Giving up now")
3510: 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 29 .. (exit 1)
3520: 29 29 0a 09 28 69 66 20 28 6e 6f 74 20 28 66 69 ))..(if (not (fi
3530: 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a 73 le-exists? ".ezs
3540: 74 65 70 73 22 29 29 28 63 72 65 61 74 65 2d 64 teps"))(create-d
3550: 69 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 65 irectory ".ezste
3560: 70 73 22 29 29 0a 09 3b 3b 20 69 66 20 65 7a 73 ps"))..;; if ezs
3570: 74 65 70 73 20 77 61 73 20 64 65 66 69 6e 65 64 teps was defined
3580: 20 74 68 65 6e 20 77 65 20 61 72 65 20 73 75 72 then we are sur
3590: 65 20 74 6f 20 68 61 76 65 20 61 74 20 6c 65 61 e to have at lea
35a0: 73 74 20 6f 6e 65 20 73 74 65 70 20 62 75 74 20 st one step but
35b0: 63 68 65 63 6b 20 61 6e 79 77 61 79 0a 09 28 69 check anyway..(i
35c0: 66 20 28 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 74 f (not (> (lengt
35d0: 68 20 65 7a 73 74 65 70 73 6c 73 74 29 20 30 29 h ezstepslst) 0)
35e0: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
35f0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
3600: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3610: 65 7a 73 74 65 70 73 20 64 65 66 69 6e 65 64 20 ezsteps defined
3620: 62 75 74 20 65 7a 73 74 65 70 73 6c 73 74 20 69 but ezstepslst i
3630: 73 20 7a 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a s zero length").
3640: 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
3650: 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 7a 73 (ezstep (car ezs
3660: 74 65 70 73 6c 73 74 29 29 0a 09 09 20 20 20 20 tepslst))...
3670: 20 20 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 (tal (cdr
3680: 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 20 ezstepslst))...
3690: 20 20 20 20 20 20 28 70 72 65 76 73 74 65 70 20 (prevstep
36a0: 23 66 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 63 #f)).. ;; c
36b0: 68 65 63 6b 20 65 78 69 74 2d 69 6e 66 6f 20 28 heck exit-info (
36c0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
36d0: 69 6e 66 6f 20 31 29 0a 09 20 20 20 20 20 20 28 info 1).. (
36e0: 69 66 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d if (launch:einf-
36f0: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
3700: 2d 69 6e 66 6f 29 20 3b 3b 20 28 76 65 63 74 6f -info) ;; (vecto
3710: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
3720: 31 29 0a 09 09 20 20 28 6c 65 74 20 28 28 6c 6f 1)... (let ((lo
3730: 67 70 72 6f 2d 75 73 65 64 20 28 6c 61 75 6e 63 gpro-used (launc
3740: 68 3a 72 75 6e 73 74 65 70 20 65 7a 73 74 65 70 h:runstep ezstep
3750: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
3760: 65 78 69 74 2d 69 6e 66 6f 20 6d 20 74 61 6c 20 exit-info m tal
3770: 74 65 73 74 63 6f 6e 66 69 67 29 29 0a 09 09 09 testconfig))....
3780: 28 73 74 65 70 6e 61 6d 65 20 20 20 20 28 63 61 (stepname (ca
3790: 72 20 65 7a 73 74 65 70 29 29 29 0a 09 09 20 20 r ezstep)))...
37a0: 20 20 3b 3b 20 69 66 20 6c 6f 67 70 72 6f 2d 75 ;; if logpro-u
37b0: 73 65 64 20 72 65 61 64 20 69 6e 20 74 68 65 20 sed read in the
37c0: 73 74 65 70 6e 61 6d 65 2e 64 61 74 20 66 69 6c stepname.dat fil
37d0: 65 0a 09 09 20 20 20 20 28 69 66 20 28 61 6e 64 e... (if (and
37e0: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 66 69 logpro-used (fi
37f0: 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 le-exists? (conc
3800: 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 74 22 stepname ".dat"
3810: 29 29 29 0a 09 09 09 28 6c 61 75 6e 63 68 3a 6c )))....(launch:l
3820: 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 oad-logpro-dat r
3830: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 un-id test-id st
3840: 65 70 6e 61 6d 65 29 29 0a 09 09 20 20 20 20 28 epname))... (
3850: 69 66 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 if (steprun-good
3860: 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 6c ? logpro-used (l
3870: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
3880: 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 29 code exit-info))
3890: 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 ....(if (not (nu
38a0: 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 20 20 20 ll? tal))....
38b0: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
38c0: 20 28 63 64 72 20 74 61 6c 29 20 73 74 65 70 6e (cdr tal) stepn
38d0: 61 6d 65 29 29 0a 09 09 09 28 64 65 62 75 67 3a ame))....(debug:
38e0: 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 print 4 *default
38f0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
3900: 49 4e 47 3a 20 73 74 65 70 20 22 20 28 63 61 72 ING: step " (car
3910: 20 65 7a 73 74 65 70 29 20 22 20 66 61 69 6c 65 ezstep) " faile
3920: 64 2e 20 53 74 6f 70 70 69 6e 67 22 29 29 29 0a d. Stopping"))).
3930: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
3940: 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
3950: 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
3960: 61 20 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 a prior step fai
3970: 6c 65 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 led, stopping at
3980: 20 22 20 65 7a 73 74 65 70 29 29 29 29 29 29 29 " ezstep)))))))
3990: 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ..(define (launc
39a0: 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 72 75 h:monitor-job ru
39b0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 74 65 n-id test-id ite
39c0: 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e 73 63 m-path fullrunsc
39d0: 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 65 73 ript ezsteps tes
39e0: 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 t-name tconfigre
39f0: 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 77 6f g exit-info m wo
3a00: 72 6b 2d 61 72 65 61 20 72 75 6e 74 6c 69 6d 20 rk-area runtlim
3a10: 6d 69 73 63 2d 66 6c 61 67 73 29 0a 20 20 28 6c misc-flags). (l
3a20: 65 74 2a 20 28 28 73 74 61 72 74 2d 73 65 63 6f et* ((start-seco
3a30: 6e 64 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 nds (current-sec
3a40: 6f 6e 64 73 29 29 0a 09 20 28 63 61 6c 63 2d 6d onds)).. (calc-m
3a50: 69 6e 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 inutes (lambda
3a60: 28 29 0a 09 09 09 20 20 28 69 6e 65 78 61 63 74 ().... (inexact
3a70: 2d 3e 65 78 61 63 74 20 0a 09 09 09 20 20 20 28 ->exact .... (
3a80: 72 6f 75 6e 64 20 0a 09 09 09 20 20 20 20 28 2d round .... (-
3a90: 20 0a 09 09 09 20 20 20 20 20 28 63 75 72 72 65 .... (curre
3aa0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 nt-seconds) ....
3ab0: 20 20 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e start-secon
3ac0: 64 73 29 29 29 29 29 0a 09 20 28 6b 69 6c 6c 2d ds))))).. (kill-
3ad0: 74 72 69 65 73 20 30 29 29 0a 20 20 20 20 3b 3b tries 0)). ;;
3ae0: 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c (tests:set-full
3af0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 -meta-info #f te
3b00: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 st-id run-id (ca
3b10: 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b lc-minutes) work
3b20: 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 28 74 -area). ;; (t
3b30: 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 ests:set-full-me
3b40: 74 61 2d 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 ta-info test-id
3b50: 72 75 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e run-id (calc-min
3b60: 75 74 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 29 utes) work-area)
3b70: 0a 20 20 20 20 28 74 65 73 74 73 3a 73 65 74 2d . (tests:set-
3b80: 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 full-meta-info #
3b90: 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 f test-id run-id
3ba0: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 (calc-minutes)
3bb0: 77 6f 72 6b 2d 61 72 65 61 20 31 30 29 0a 20 20 work-area 10).
3bc0: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 (let loop ((mi
3bd0: 6e 75 74 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 nutes (calc-mi
3be0: 6e 75 74 65 73 29 29 0a 09 20 20 20 20 20 20 20 nutes))..
3bf0: 28 63 70 75 2d 6c 6f 61 64 20 20 28 67 65 74 2d (cpu-load (get-
3c00: 63 70 75 2d 6c 6f 61 64 29 29 0a 09 20 20 20 20 cpu-load))..
3c10: 20 20 20 28 64 69 73 6b 2d 66 72 65 65 20 28 67 (disk-free (g
3c20: 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 et-df (current-d
3c30: 69 72 65 63 74 6f 72 79 29 29 29 29 0a 20 20 20 irectory)))).
3c40: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d 63 70 (let ((new-cp
3c50: 75 2d 6c 6f 61 64 20 28 6c 65 74 2a 20 28 28 6c u-load (let* ((l
3c60: 6f 61 64 20 20 28 67 65 74 2d 63 70 75 2d 6c 6f oad (get-cpu-lo
3c70: 61 64 29 29 0a 09 09 09 09 20 28 64 65 6c 74 61 ad))..... (delta
3c80: 20 28 61 62 73 20 28 2d 20 6c 6f 61 64 20 63 70 (abs (- load cp
3c90: 75 2d 6c 6f 61 64 29 29 29 29 0a 09 09 09 20 20 u-load))))....
3ca0: 20 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 30 (if (> delta 0
3cb0: 2e 36 29 20 3b 3b 20 64 6f 6e 27 74 20 62 6f 74 .6) ;; don't bot
3cc0: 68 65 72 20 75 70 64 61 74 69 6e 67 20 77 69 74 her updating wit
3cd0: 68 20 73 6d 61 6c 6c 20 63 68 61 6e 67 65 73 0a h small changes.
3ce0: 09 09 09 09 6c 6f 61 64 0a 09 09 09 09 23 66 29 ....load.....#f)
3cf0: 29 29 0a 09 20 20 20 20 28 6e 65 77 2d 64 69 73 )).. (new-dis
3d00: 6b 2d 66 72 65 65 20 28 6c 65 74 2a 20 28 28 64 k-free (let* ((d
3d10: 66 20 20 20 20 28 67 65 74 2d 64 66 20 28 63 75 f (get-df (cu
3d20: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
3d30: 29 29 0a 09 09 09 09 20 20 28 64 65 6c 74 61 20 ))..... (delta
3d40: 28 61 62 73 20 28 2d 20 64 66 20 64 69 73 6b 2d (abs (- df disk-
3d50: 66 72 65 65 29 29 29 29 0a 09 09 09 20 20 20 20 free))))....
3d60: 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 32 30 (if (> delta 20
3d70: 30 29 20 3b 3b 20 69 67 6e 6f 72 65 20 63 68 61 0) ;; ignore cha
3d80: 6e 67 65 73 20 75 6e 64 65 72 20 32 30 30 20 4d nges under 200 M
3d90: 65 67 0a 09 09 09 09 20 64 66 0a 09 09 09 09 20 eg..... df.....
3da0: 23 66 29 29 29 29 0a 09 28 73 65 74 21 20 6b 69 #f))))..(set! ki
3db0: 6c 6c 2d 6a 6f 62 3f 20 28 6f 72 20 28 74 65 73 ll-job? (or (tes
3dc0: 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 t-get-kill-reque
3dd0: 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 st run-id test-i
3de0: 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 d) ;; run-id tes
3df0: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat))
3e00: 0a 09 09 09 20 20 20 20 28 61 6e 64 20 72 75 6e .... (and run
3e10: 74 6c 69 6d 20 28 6c 65 74 2a 20 28 28 72 75 6e tlim (let* ((run
3e20: 2d 73 65 63 6f 6e 64 73 20 20 20 28 2d 20 28 63 -seconds (- (c
3e30: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 urrent-seconds)
3e40: 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 0a start-seconds)).
3e50: 09 09 09 09 09 09 28 74 69 6d 65 2d 65 78 63 65 ......(time-exce
3e60: 65 64 65 64 20 28 3e 20 72 75 6e 2d 73 65 63 6f eded (> run-seco
3e70: 6e 64 73 20 72 75 6e 74 6c 69 6d 29 29 29 0a 09 nds runtlim)))..
3e80: 09 09 09 09 20 20 20 28 69 66 20 74 69 6d 65 2d .... (if time-
3e90: 65 78 63 65 65 64 65 64 0a 09 09 09 09 09 20 20 exceeded......
3ea0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 (begin.....
3eb0: 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d .. (debug:print-
3ec0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
3ed0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 49 4c 4c 49 log-port* "KILLI
3ee0: 4e 47 20 54 45 53 54 20 44 55 45 20 54 4f 20 54 NG TEST DUE TO T
3ef0: 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 45 45 44 IME LIMIT EXCEED
3f00: 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 20 72 75 ED! Runtime=" ru
3f10: 6e 2d 73 65 63 6f 6e 64 73 20 22 20 73 65 63 6f n-seconds " seco
3f20: 6e 64 73 2c 20 6c 69 6d 69 74 3d 22 20 72 75 6e nds, limit=" run
3f30: 74 6c 69 6d 29 0a 09 09 09 09 09 09 20 23 74 29 tlim)....... #t)
3f40: 0a 09 09 09 09 09 20 20 20 20 20 20 20 23 66 29 ...... #f)
3f50: 29 29 29 29 0a 09 28 74 65 73 74 73 3a 75 70 64 ))))..(tests:upd
3f60: 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d 65 74 61 ate-central-meta
3f70: 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 74 65 73 -info run-id tes
3f80: 74 2d 69 64 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 t-id new-cpu-loa
3f90: 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 20 d new-disk-free
3fa0: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 23 (calc-minutes) #
3fb0: 66 20 23 66 29 0a 09 28 69 66 20 6b 69 6c 6c 2d f #f)..(if kill-
3fc0: 6a 6f 62 3f 20 0a 09 20 20 20 20 28 62 65 67 69 job? .. (begi
3fd0: 6e 0a 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d n.. (mutex-
3fe0: 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 lock! m)..
3ff0: 3b 3b 20 4e 4f 54 45 3a 20 54 68 65 20 70 69 64 ;; NOTE: The pid
4000: 20 63 61 6e 20 63 68 61 6e 67 65 20 61 73 20 64 can change as d
4010: 69 66 66 65 72 65 6e 74 20 73 74 65 70 73 20 61 ifferent steps a
4020: 72 65 20 72 75 6e 2e 20 44 6f 20 77 65 20 6e 65 re run. Do we ne
4030: 65 64 20 68 61 6e 64 73 68 61 6b 69 6e 67 20 62 ed handshaking b
4040: 65 74 77 65 65 6e 20 74 68 69 73 0a 09 20 20 20 etween this..
4050: 20 20 20 3b 3b 20 20 20 20 20 20 20 73 65 63 74 ;; sect
4060: 69 6f 6e 20 61 6e 64 20 74 68 65 20 72 75 6e 69 ion and the runi
4070: 74 20 73 65 63 74 69 6f 6e 3f 20 4f 72 20 61 64 t section? Or ad
4080: 64 20 61 20 6c 6f 6f 70 20 74 68 61 74 20 74 72 d a loop that tr
4090: 69 65 73 20 74 68 72 65 65 20 74 69 6d 65 73 20 ies three times
40a0: 77 69 74 68 20 61 20 31 2f 34 20 73 65 63 6f 6e with a 1/4 secon
40b0: 64 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 d.. ;;
40c0: 20 20 62 65 74 77 65 65 6e 20 74 72 69 65 73 3f between tries?
40d0: 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 .. (let* ((
40e0: 70 69 64 31 20 28 6c 61 75 6e 63 68 3a 65 69 6e pid1 (launch:ein
40f0: 66 2d 70 69 64 20 65 78 69 74 2d 69 6e 66 6f 29 f-pid exit-info)
4100: 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ) ;; (vector-ref
4110: 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 0a 09 exit-info 0))..
4120: 09 20 20 20 20 20 28 70 69 64 32 20 28 72 6d 74 . (pid2 (rmt
4130: 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 :test-get-top-pr
4140: 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 ocess-pid run-id
4150: 20 74 65 73 74 2d 69 64 29 29 0a 09 09 20 20 20 test-id))...
4160: 20 20 28 70 69 64 73 20 28 64 65 6c 65 74 65 2d (pids (delete-
4170: 64 75 70 6c 69 63 61 74 65 73 20 28 66 69 6c 74 duplicates (filt
4180: 65 72 20 6e 75 6d 62 65 72 3f 20 28 6c 69 73 74 er number? (list
4190: 20 70 69 64 31 20 70 69 64 32 29 29 29 29 29 0a pid1 pid2))))).
41a0: 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c ..(if (not (null
41b0: 3f 20 70 69 64 73 29 29 0a 09 09 20 20 20 20 28 ? pids))... (
41c0: 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 66 begin... (f
41d0: 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 20 20 or-each...
41e0: 20 28 6c 61 6d 62 64 61 20 28 70 69 64 29 0a 09 (lambda (pid)..
41f0: 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 .. (handle-excep
4200: 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 tions.... exn..
4210: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 .. (begin....
4220: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
4230: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
4240: 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 61 62 6c 65 og-port* "Unable
4250: 20 74 6f 20 6b 69 6c 6c 20 70 72 6f 63 65 73 73 to kill process
4260: 20 77 69 74 68 20 70 69 64 20 22 20 70 69 64 20 with pid " pid
4270: 22 2c 20 70 6f 73 73 69 62 6c 79 20 61 6c 72 65 ", possibly alre
4280: 61 64 79 20 6b 69 6c 6c 65 64 2e 22 29 0a 09 09 ady killed.")...
4290: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
42a0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
42b0: 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 -port* " message
42c0: 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d : " ((condition-
42d0: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
42e0: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
42f0: 20 65 78 6e 29 29 29 0a 09 09 09 20 20 28 64 65 exn))).... (de
4300: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
4310: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4320: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
4330: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
4340: 6c 20 6a 6f 62 20 22 20 70 69 64 29 20 3b 3b 20 l job " pid) ;;
4350: 20 22 20 28 61 74 74 65 6d 70 74 20 23 20 22 20 " (attempt # "
4360: 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 0a kill-tries ")").
4370: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
4380: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
4390: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 69 67 t-log-port* "Sig
43a0: 6e 61 6c 20 6d 61 73 6b 3d 22 20 28 73 69 67 6e nal mask=" (sign
43b0: 61 6c 2d 6d 61 73 6b 29 29 0a 09 09 09 20 20 3b al-mask)).... ;
43c0: 3b 20 28 69 66 20 28 70 72 6f 63 65 73 73 3a 61 ; (if (process:a
43d0: 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 20 20 live? pid)....
43e0: 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ;; (begin...
43f0: 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 . (map (lambda
4400: 28 70 69 64 2d 6e 75 6d 29 0a 09 09 09 09 20 28 (pid-num)..... (
4410: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 process-signal p
4420: 69 64 2d 6e 75 6d 20 73 69 67 6e 61 6c 2f 74 65 id-num signal/te
4430: 72 6d 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 rm)).... (
4440: 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 62 2d process:get-sub-
4450: 70 69 64 73 20 70 69 64 29 29 0a 09 09 09 20 20 pids pid))....
4460: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 35 (thread-sleep! 5
4470: 29 0a 09 09 09 20 20 3b 3b 20 28 69 66 20 28 70 ).... ;; (if (p
4480: 72 6f 63 65 73 73 3a 70 72 6f 63 65 73 73 2d 61 rocess:process-a
4490: 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 20 20 live? pid)....
44a0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 69 (map (lambda (pi
44b0: 64 2d 6e 75 6d 29 0a 09 09 09 09 20 28 68 61 6e d-num)..... (han
44c0: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
44d0: 09 09 09 20 20 65 78 6e 0a 09 09 09 09 20 20 23 ... exn..... #
44e0: 66 0a 09 09 09 09 20 20 28 70 72 6f 63 65 73 73 f..... (process
44f0: 2d 73 69 67 6e 61 6c 20 70 69 64 2d 6e 75 6d 20 -signal pid-num
4500: 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 29 29 0a 09 signal/kill)))..
4510: 09 09 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 .. (proces
4520: 73 3a 67 65 74 2d 73 75 62 2d 70 69 64 73 20 70 s:get-sub-pids p
4530: 69 64 29 29 29 29 0a 09 09 20 20 20 20 20 20 20 id))))...
4540: 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 ;; (debug:pri
4550: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
4560: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f lt-log-port* "no
4570: 74 20 6b 69 6c 6c 69 6e 67 20 70 72 6f 63 65 73 t killing proces
4580: 73 20 22 20 70 69 64 20 22 20 61 73 20 69 74 20 s " pid " as it
4590: 69 73 20 6e 6f 74 20 61 6c 69 76 65 22 29 29 29 is not alive")))
45a0: 29 0a 09 09 20 20 20 20 20 20 20 70 69 64 73 29 )... pids)
45b0: 0a 09 09 20 20 20 20 20 20 28 74 65 73 74 73 3a ... (tests:
45c0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
45d0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
45e0: 22 4b 49 4c 4c 45 44 22 20 20 22 4b 49 4c 4c 45 "KILLED" "KILLE
45f0: 44 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 D" (args:get-arg
4600: 20 22 2d 6d 22 29 20 23 66 29 29 0a 09 09 20 20 "-m") #f))...
4610: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
4620: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
4630: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
4640: 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 74 68 69 6e og-port* "Nothin
4650: 67 20 74 6f 20 6b 69 6c 6c 2c 20 70 69 64 31 3d g to kill, pid1=
4660: 22 20 70 69 64 31 20 22 2c 20 70 69 64 32 3d 22 " pid1 ", pid2="
4670: 20 70 69 64 32 29 0a 09 09 20 20 20 20 20 20 28 pid2)... (
4680: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
4690: 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 tatus! run-id te
46a0: 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 st-id "KILLED"
46b0: 22 46 41 49 4c 45 44 20 54 4f 20 4b 49 4c 4c 22 "FAILED TO KILL"
46c0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
46d0: 2d 6d 22 29 20 23 66 29 0a 09 09 20 20 20 20 20 -m") #f)...
46e0: 20 29 29 29 0a 09 20 20 20 20 20 20 28 6d 75 74 ))).. (mut
46f0: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
4700: 20 20 20 20 20 3b 3b 20 6e 6f 20 70 6f 69 6e 74 ;; no point
4710: 20 69 6e 20 73 74 69 63 6b 69 6e 67 20 61 72 6f in sticking aro
4720: 75 6e 64 2e 20 45 78 69 74 20 6e 6f 77 2e 0a 09 und. Exit now...
4730: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 0a 09 (exit)))..
4740: 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (if (hash-table-
4750: 72 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 73 63 ref/default misc
4760: 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 6f 69 -flags 'keep-goi
4770: 6e 67 20 23 66 29 0a 09 20 20 20 20 28 62 65 67 ng #f).. (beg
4780: 69 6e 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 in.. (threa
4790: 64 2d 73 6c 65 65 70 21 20 33 29 20 3b 3b 20 28 d-sleep! 3) ;; (
47a0: 2b 20 33 20 28 72 61 6e 64 6f 6d 20 36 29 29 29 + 3 (random 6)))
47b0: 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 ;; add some jit
47c0: 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 ter to the call
47d0: 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 home time to spr
47e0: 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 ead out the db a
47f0: 63 63 65 73 73 65 73 0a 09 20 20 20 20 20 20 28 ccesses.. (
4800: 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 if (hash-table-r
4810: 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 73 63 2d ef/default misc-
4820: 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 6f 69 6e flags 'keep-goin
4830: 67 20 23 66 29 20 20 3b 3b 20 6b 65 65 70 20 6f g #f) ;; keep o
4840: 72 69 67 69 6e 61 6c 73 20 66 6f 72 20 63 70 75 riginals for cpu
4850: 2d 6c 6f 61 64 20 61 6e 64 20 64 69 73 6b 2d 66 -load and disk-f
4860: 72 65 65 20 75 6e 6c 65 73 73 20 74 68 65 79 20 ree unless they
4870: 63 68 61 6e 67 65 20 6d 6f 72 65 20 74 68 61 6e change more than
4880: 20 74 68 65 20 61 6c 6c 6f 77 65 64 20 64 65 6c the allowed del
4890: 74 61 0a 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 ta... (loop (ca
48a0: 6c 63 2d 6d 69 6e 75 74 65 73 29 20 28 6f 72 20 lc-minutes) (or
48b0: 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 63 70 75 new-cpu-load cpu
48c0: 2d 6c 6f 61 64 29 20 28 6f 72 20 6e 65 77 2d 64 -load) (or new-d
48d0: 69 73 6b 2d 66 72 65 65 20 64 69 73 6b 2d 66 72 isk-free disk-fr
48e0: 65 65 29 29 29 29 29 29 29 0a 20 20 20 20 28 74 ee))))))). (t
48f0: 65 73 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 ests:update-cent
4900: 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 ral-meta-info ru
4910: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 28 67 65 n-id test-id (ge
4920: 74 2d 63 70 75 2d 6c 6f 61 64 29 20 28 67 65 74 t-cpu-load) (get
4930: 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 -df (current-dir
4940: 65 63 74 6f 72 79 29 29 28 63 61 6c 63 2d 6d 69 ectory))(calc-mi
4950: 6e 75 74 65 73 29 20 23 66 20 23 66 29 29 29 20 nutes) #f #f)))
4960: 3b 3b 20 4e 4f 54 45 3a 20 43 68 65 63 6b 69 6e ;; NOTE: Checkin
4970: 67 20 74 77 69 63 65 20 66 6f 72 20 6b 65 65 70 g twice for keep
4980: 2d 67 6f 69 6e 67 20 69 73 20 69 6e 74 65 6e 74 -going is intent
4990: 69 6f 6e 61 6c 0a 0a 28 64 65 66 69 6e 65 20 28 ional..(define (
49a0: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 65 launch:execute e
49b0: 6e 63 6f 64 65 64 2d 63 6d 64 29 0a 20 20 20 20 ncoded-cmd).
49c0: 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f (let* ((cmdinfo
49d0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 (common:read
49e0: 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 -encoded-string
49f0: 65 6e 63 6f 64 65 64 2d 63 6d 64 29 29 0a 09 20 encoded-cmd))..
4a00: 20 28 74 63 6f 6e 66 69 67 72 65 67 20 28 74 65 (tconfigreg (te
4a10: 73 74 73 3a 67 65 74 2d 61 6c 6c 29 29 29 0a 20 sts:get-all))).
4a20: 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 (setenv "MT_C
4a30: 4d 44 49 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d MDINFO" encoded-
4a40: 63 6d 64 29 0a 20 20 20 20 28 69 66 20 28 6c 69 cmd). (if (li
4a50: 73 74 3f 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 st? cmdinfo) ;;
4a60: 28 28 74 65 73 74 70 61 74 68 20 2f 74 6d 70 2f ((testpath /tmp/
4a70: 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e mrwellan/jazzmin
4a80: 64 2f 73 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 d/src/example_ru
4a90: 6e 2f 74 65 73 74 73 2f 73 71 6c 69 74 65 73 70 n/tests/sqlitesp
4aa0: 65 65 64 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e eed)..;; (test-n
4ab0: 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 64 29 ame sqlitespeed)
4ac0: 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 (runscript runs
4ad0: 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d 68 6f cript.rb) (db-ho
4ae0: 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 st localhost) (r
4af0: 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c 65 74 2a un-id 1))..(let*
4b00: 20 28 28 74 65 73 74 70 61 74 68 20 20 28 61 73 ((testpath (as
4b10: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
4b20: 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
4b30: 20 20 3b 3b 20 74 65 73 74 70 61 74 68 20 69 73 ;; testpath is
4b40: 20 74 68 65 20 74 65 73 74 20 73 70 65 63 20 61 the test spec a
4b50: 72 65 61 0a 09 20 20 20 20 20 20 20 28 74 6f 70 rea.. (top
4b60: 2d 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 -path (assoc/de
4b70: 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 fault 'toppath
4b80: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4b90: 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 (work-area (a
4ba0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f ssoc/default 'wo
4bb0: 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 rk-area cmdinfo)
4bc0: 29 20 20 3b 3b 20 77 6f 72 6b 2d 61 72 65 61 20 ) ;; work-area
4bd0: 69 73 20 74 68 65 20 74 65 73 74 20 72 75 6e 20 is the test run
4be0: 61 72 65 61 0a 09 20 20 20 20 20 20 20 28 74 65 area.. (te
4bf0: 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
4c00: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
4c10: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
4c20: 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
4c30: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
4c40: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
4c50: 29 29 0a 09 20 20 20 20 20 20 20 28 65 7a 73 74 )).. (ezst
4c60: 65 70 73 20 20 20 28 61 73 73 6f 63 2f 64 65 66 eps (assoc/def
4c70: 61 75 6c 74 20 27 65 7a 73 74 65 70 73 20 20 20 ault 'ezsteps
4c80: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
4c90: 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 ;; (runremote
4ca0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4cb0: 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 runremote cmdinf
4cc0: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 72 61 o)).. (tra
4cd0: 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 nsport (assoc/de
4ce0: 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 fault 'transport
4cf0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4d00: 20 20 20 3b 3b 20 28 73 65 72 76 65 72 69 6e 66 ;; (serverinf
4d10: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4d20: 27 73 65 72 76 65 72 69 6e 66 20 63 6d 64 69 6e 'serverinf cmdin
4d30: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 70 6f fo)).. (po
4d40: 72 74 20 20 20 20 20 20 28 61 73 73 6f 63 2f 64 rt (assoc/d
4d50: 65 66 61 75 6c 74 20 27 70 6f 72 74 20 20 20 20 efault 'port
4d60: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
4d70: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 (run-id (
4d80: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
4d90: 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
4da0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
4db0: 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 -id (assoc/def
4dc0: 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 ault 'test-id
4dd0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
4de0: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 73 (target (as
4df0: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 72 soc/default 'tar
4e00: 67 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 get cmdinfo))
4e10: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
4e20: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
4e30: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
4e40: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
4e50: 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 73 6f (env-ovrd (asso
4e60: 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 2d 6f c/default 'env-o
4e70: 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 vrd cmdinfo))..
4e80: 20 20 20 20 20 20 20 28 73 65 74 2d 76 61 72 73 (set-vars
4e90: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
4ea0: 20 27 73 65 74 2d 76 61 72 73 20 20 63 6d 64 69 'set-vars cmdi
4eb0: 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f 76 65 nfo)) ;; pre-ove
4ec0: 72 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 65 74 rrides from -set
4ed0: 76 61 72 0a 09 20 20 20 20 20 20 20 28 72 75 6e var.. (run
4ee0: 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 65 name (assoc/de
4ef0: 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 20 fault 'runname
4f00: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4f10: 20 20 20 28 6d 65 67 61 74 65 73 74 20 20 28 61 (megatest (a
4f20: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 65 ssoc/default 'me
4f30: 67 61 74 65 73 74 20 20 63 6d 64 69 6e 66 6f 29 gatest cmdinfo)
4f40: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 74 6c ).. (runtl
4f50: 69 6d 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 im (assoc/defa
4f60: 75 6c 74 20 27 72 75 6e 74 6c 69 6d 20 20 20 63 ult 'runtlim c
4f70: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
4f80: 20 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 (item-path (ite
4f90: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
4fa0: 6d 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 mdat)).. (
4fb0: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 mt-bindir-path (
4fc0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d assoc/default 'm
4fd0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d t-bindir-path cm
4fe0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
4ff0: 28 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 (keys #f)..
5000: 20 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 (keyvals
5010: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 #f).. (f
5020: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 ullrunscript (if
5030: 20 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 (not runscript)
5040: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 #f.
5070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5080: 20 20 20 20 20 20 20 20 28 69 66 20 28 73 75 62 (if (sub
5090: 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 string-index "/"
50a0: 20 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 runscript).
50b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50d0: 20 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 runscript ;; u
50e0: 73 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 se unadultered i
50f0: 66 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 f contains slash
5100: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es.
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5120: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
5130: 66 75 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 74 fulln (conc test
5140: 70 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 69 path "/" runscri
5150: 70 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 pt)))..
5160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5170: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
5180: 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 d (file-exists?
5190: 66 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 20 fulln).
51a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51c0: 20 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 2d (file-
51d0: 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 execute-access?
51e0: 66 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 20 fulln)).
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5210: 20 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 20 fulln.
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5240: 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 runscr
5250: 69 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 75 ipt))))) ;; assu
5260: 6d 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 20 me it is on the
5270: 70 61 74 68 0a 09 20 20 20 20 20 20 20 29 20 3b path.. ) ;
5280: 3b 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 ; (rollup-status
5290: 20 30 29 0a 0a 09 20 20 3b 3b 20 4e 46 53 20 6d 0)... ;; NFS m
52a0: 69 67 68 74 20 6e 6f 74 20 68 61 76 65 20 70 72 ight not have pr
52b0: 6f 70 61 67 61 74 65 64 20 74 68 65 20 64 69 72 opagated the dir
52c0: 65 63 74 6f 72 79 20 6d 65 74 61 20 64 61 74 61 ectory meta data
52d0: 20 74 6f 20 74 68 65 20 72 75 6e 20 68 6f 73 74 to the run host
52e0: 20 2d 20 67 69 76 65 20 69 74 20 74 69 6d 65 20 - give it time
52f0: 69 66 20 6e 65 65 64 65 64 0a 09 20 20 28 6c 65 if needed.. (le
5300: 74 20 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 20 30 t loop ((count 0
5310: 29 29 0a 09 20 20 20 20 28 69 66 20 28 6f 72 20 )).. (if (or
5320: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 6f (file-exists? to
5330: 70 2d 70 61 74 68 29 0a 09 09 20 20 20 20 28 3e p-path)... (>
5340: 20 63 6f 75 6e 74 20 31 30 29 29 0a 09 09 28 63 count 10))...(c
5350: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
5360: 74 6f 70 2d 70 61 74 68 29 0a 09 09 28 62 65 67 top-path)...(beg
5370: 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 in... (debug:pr
5380: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
5390: 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 og-port* "INFO:
53a0: 4e 6f 74 20 73 74 61 72 74 69 6e 67 20 6a 6f 62 Not starting job
53b0: 20 79 65 74 20 2d 20 64 69 72 65 63 74 6f 72 79 yet - directory
53c0: 20 22 20 74 6f 70 2d 70 61 74 68 20 22 20 6e 6f " top-path " no
53d0: 74 20 66 6f 75 6e 64 22 29 0a 09 09 20 20 28 74 t found")... (t
53e0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 hread-sleep! 10)
53f0: 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 63 6f ... (loop (+ co
5400: 75 6e 74 20 31 29 29 29 29 29 0a 0a 09 20 20 28 unt 1)))))... (
5410: 6c 65 74 20 28 28 73 69 67 68 61 6e 64 20 28 6c let ((sighand (l
5420: 61 6d 62 64 61 20 28 73 69 67 6e 75 6d 29 0a 09 ambda (signum)..
5430: 09 09 20 20 20 3b 3b 20 28 73 69 67 6e 61 6c 2d .. ;; (signal-
5440: 6d 61 73 6b 21 20 73 69 67 6e 75 6d 29 20 3b 3b mask! signum) ;;
5450: 20 74 6f 20 6d 61 73 6b 20 6f 72 20 6e 6f 74 3f to mask or not?
5460: 20 73 65 65 6d 73 20 74 6f 20 63 61 75 73 65 20 seems to cause
5470: 69 73 73 75 65 73 20 69 6e 20 65 78 69 74 69 6e issues in exitin
5480: 67 0a 09 09 09 20 20 20 28 69 66 20 28 65 71 3f g.... (if (eq?
5490: 20 73 69 67 6e 75 6d 20 73 69 67 6e 61 6c 2f 73 signum signal/s
54a0: 74 6f 70 29 0a 09 09 09 20 20 20 20 20 20 20 28 top).... (
54b0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
54c0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
54d0: 2d 70 6f 72 74 2a 20 22 61 74 74 65 6d 70 74 20 -port* "attempt
54e0: 74 6f 20 53 54 4f 50 20 70 72 6f 63 65 73 73 2e to STOP process.
54f0: 20 45 78 69 74 69 6e 67 2e 22 29 29 0a 09 09 09 Exiting."))....
5500: 20 20 20 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 (set! *time-t
5510: 6f 2d 65 78 69 74 2a 20 23 74 29 0a 09 09 09 20 o-exit* #t)....
5520: 20 20 28 70 72 69 6e 74 20 22 52 65 63 65 69 76 (print "Receiv
5530: 65 64 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e ed signal " sign
5540: 75 6d 20 22 2c 20 63 6c 65 61 6e 69 6e 67 20 75 um ", cleaning u
5550: 70 20 62 65 66 6f 72 65 20 65 78 69 74 2e 20 50 p before exit. P
5560: 6c 65 61 73 65 20 77 61 69 74 2e 2e 2e 22 29 0a lease wait...").
5570: 09 09 09 20 20 20 28 6c 65 74 20 28 28 74 68 31 ... (let ((th1
5580: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c (make-thread (l
5590: 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 20 ambda ().......
55a0: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
55b0: 66 6f 72 63 65 2d 73 74 61 74 65 2d 73 74 61 74 force-state-stat
55c0: 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d us! run-id test-
55d0: 69 64 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 20 id "INCOMPLETE"
55e0: 22 4b 49 4c 4c 45 44 22 29 0a 09 09 09 09 09 09 "KILLED").......
55f0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 4b 69 6c (print "Kil
5600: 6c 65 64 20 62 79 20 73 69 67 6e 61 6c 20 22 20 led by signal "
5610: 73 69 67 6e 75 6d 20 22 2e 20 45 78 69 74 69 6e signum ". Exitin
5620: 67 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 g")....... (
5630: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 thread-sleep! 1)
5640: 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 78 69 ....... (exi
5650: 74 20 31 29 29 29 29 0a 09 09 09 09 20 28 74 68 t 1))))..... (th
5660: 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 2 (make-thread (
5670: 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 09 09 lambda ().......
5680: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 (thread-sle
5690: 65 70 21 20 32 29 0a 09 09 09 09 09 09 20 20 20 ep! 2).......
56a0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
56b0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
56c0: 72 74 2a 20 22 44 6f 6e 65 22 29 0a 09 09 09 09 rt* "Done").....
56d0: 09 09 20 20 20 20 20 28 65 78 69 74 20 34 29 29 .. (exit 4))
56e0: 29 29 29 0a 09 09 09 20 20 20 20 20 28 74 68 72 ))).... (thr
56f0: 65 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a ead-start! th2).
5700: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
5710: 73 74 61 72 74 21 20 74 68 31 29 0a 09 09 09 20 start! th1)....
5720: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
5730: 21 20 74 68 32 29 29 29 29 29 0a 09 20 20 20 20 ! th2)))))..
5740: 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 (set-signal-hand
5750: 6c 65 72 21 20 73 69 67 6e 61 6c 2f 69 6e 74 20 ler! signal/int
5760: 73 69 67 68 61 6e 64 29 0a 09 20 20 20 20 28 73 sighand).. (s
5770: 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 et-signal-handle
5780: 72 21 20 73 69 67 6e 61 6c 2f 74 65 72 6d 20 73 r! signal/term s
5790: 69 67 68 61 6e 64 29 0a 09 20 20 20 20 29 20 3b ighand).. ) ;
57a0: 3b 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 ; (set-signal-ha
57b0: 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 73 74 ndler! signal/st
57c0: 6f 70 20 73 69 67 68 61 6e 64 29 0a 09 20 20 0a op sighand).. .
57d0: 09 20 20 3b 3b 20 44 6f 20 6e 6f 74 20 72 75 6e . ;; Do not run
57e0: 20 74 68 65 20 74 65 73 74 20 69 66 20 69 74 20 the test if it
57f0: 69 73 20 52 45 4d 4f 56 49 4e 47 2c 20 52 55 4e is REMOVING, RUN
5800: 4e 49 4e 47 2c 20 4b 49 4c 4c 52 45 51 20 6f 72 NING, KILLREQ or
5810: 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 REMOTEHOSTSTART
5820: 2c 0a 09 20 20 3b 3b 20 4d 61 72 6b 20 74 68 65 ,.. ;; Mark the
5830: 20 74 65 73 74 20 61 73 20 52 45 4d 4f 54 45 48 test as REMOTEH
5840: 4f 53 54 53 54 41 52 54 20 2a 49 4d 4d 45 44 49 OSTSTART *IMMEDI
5850: 41 54 45 4c 59 2a 0a 09 20 20 3b 3b 0a 09 20 20 ATELY*.. ;;..
5860: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 69 6e 66 (let* ((test-inf
5870: 6f 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d o (rmt:get-test-
5880: 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 info-by-id run-i
5890: 64 20 74 65 73 74 2d 69 64 29 29 0a 09 09 20 28 d test-id))... (
58a0: 74 65 73 74 2d 68 6f 73 74 20 28 64 62 3a 74 65 test-host (db:te
58b0: 73 74 2d 67 65 74 2d 68 6f 73 74 20 20 20 20 20 st-get-host
58c0: 20 20 20 74 65 73 74 2d 69 6e 66 6f 29 29 0a 09 test-info))..
58d0: 09 20 28 74 65 73 74 2d 70 69 64 20 20 28 64 62 . (test-pid (db
58e0: 3a 74 65 73 74 2d 67 65 74 2d 70 72 6f 63 65 73 :test-get-proces
58f0: 73 5f 69 64 20 20 74 65 73 74 2d 69 6e 66 6f 29 s_id test-info)
5900: 29 29 0a 09 20 20 20 20 28 63 6f 6e 64 0a 09 20 )).. (cond..
5910: 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 64 62 ((member (db
5920: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
5930: 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 49 4e test-info) '("IN
5940: 43 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c 45 COMPLETE" "KILLE
5950: 44 22 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 4b 49 D" "UNKNOWN" "KI
5960: 4c 4c 52 45 51 22 20 22 53 54 55 43 4b 22 29 29 LLREQ" "STUCK"))
5970: 20 3b 3b 20 70 72 69 6f 72 20 72 75 6e 20 6f 66 ;; prior run of
5980: 20 74 68 69 73 20 74 65 73 74 20 64 69 64 6e 27 this test didn'
5990: 74 20 63 6f 6d 70 6c 65 74 65 2c 20 67 6f 20 61 t complete, go a
59a0: 68 65 61 64 20 61 6e 64 20 74 72 79 20 74 6f 20 head and try to
59b0: 72 65 72 75 6e 0a 09 20 20 20 20 20 20 28 64 65 rerun.. (de
59c0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
59d0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
59e0: 49 4e 46 4f 3a 20 74 65 73 74 20 69 73 20 49 4e INFO: test is IN
59f0: 43 4f 4d 50 4c 45 54 45 20 6f 72 20 4b 49 4c 4c COMPLETE or KILL
5a00: 45 44 2c 20 74 72 65 61 74 20 74 68 69 73 20 65 ED, treat this e
5a10: 78 65 63 75 74 65 20 63 61 6c 6c 20 61 73 20 61 xecute call as a
5a20: 20 72 65 72 75 6e 20 72 65 71 75 65 73 74 22 29 rerun request")
5a30: 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 74 .. (tests:t
5a40: 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 65 2d est-force-state-
5a50: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
5a60: 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f est-id "REMOTEHO
5a70: 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 29 29 STSTART" "n/a"))
5a80: 20 3b 3b 20 70 72 69 6d 65 20 69 74 20 66 6f 72 ;; prime it for
5a90: 20 72 75 6e 6e 69 6e 67 0a 09 20 20 20 20 20 28 running.. (
5aa0: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
5ab0: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d -get-state test-
5ac0: 69 6e 66 6f 29 20 27 28 22 52 55 4e 4e 49 4e 47 info) '("RUNNING
5ad0: 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 " "REMOTEHOSTSTA
5ae0: 52 54 22 29 29 0a 09 20 20 20 20 20 20 28 69 66 RT")).. (if
5af0: 20 28 70 72 6f 63 65 73 73 3a 61 6c 69 76 65 2d (process:alive-
5b00: 6f 6e 2d 68 6f 73 74 3f 20 74 65 73 74 2d 68 6f on-host? test-ho
5b10: 73 74 20 74 65 73 74 2d 70 69 64 29 0a 09 09 20 st test-pid)...
5b20: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
5b30: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
5b40: 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 20 73 og-port* "test s
5b50: 74 61 74 65 20 69 73 20 22 20 20 28 64 62 3a 74 tate is " (db:t
5b60: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
5b70: 73 74 2d 69 6e 66 6f 29 20 22 20 61 6e 64 20 70 st-info) " and p
5b80: 72 6f 63 65 73 73 20 22 20 74 65 73 74 2d 70 69 rocess " test-pi
5b90: 64 20 22 20 69 73 20 73 74 69 6c 6c 20 72 75 6e d " is still run
5ba0: 6e 69 6e 67 20 6f 6e 20 68 6f 73 74 20 22 20 74 ning on host " t
5bb0: 65 73 74 2d 68 6f 73 74 20 22 2c 20 63 61 6e 6e est-host ", cann
5bc0: 6f 74 20 70 72 6f 63 65 65 64 22 29 0a 09 09 20 ot proceed")...
5bd0: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 (tests:test-for
5be0: 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 ce-state-status!
5bf0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
5c00: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
5c10: 22 20 22 6e 2f 61 22 29 29 29 0a 09 20 20 20 20 " "n/a")))..
5c20: 20 28 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 ((not (member (
5c30: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
5c40: 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 e test-info) '("
5c50: 52 45 4d 4f 56 49 4e 47 22 20 22 52 45 4d 4f 54 REMOVING" "REMOT
5c60: 45 48 4f 53 54 53 54 41 52 54 22 20 22 52 55 4e EHOSTSTART" "RUN
5c70: 4e 49 4e 47 22 20 22 4b 49 4c 4c 52 45 51 22 29 NING" "KILLREQ")
5c80: 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 )).. (tests
5c90: 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 :test-force-stat
5ca0: 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 e-status! run-id
5cb0: 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 test-id "REMOTE
5cc0: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
5cd0: 29 29 0a 09 20 20 20 20 20 28 65 6c 73 65 20 3b )).. (else ;
5ce0: 3b 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 ; (member (db:te
5cf0: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 st-get-state tes
5d00: 74 2d 69 6e 66 6f 29 20 27 28 22 52 45 4d 4f 56 t-info) '("REMOV
5d10: 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 ING" "REMOTEHOST
5d20: 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 22 START" "RUNNING"
5d30: 20 22 4b 49 4c 4c 52 45 51 22 29 29 0a 09 20 20 "KILLREQ"))..
5d40: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
5d50: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
5d60: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 t-log-port* "tes
5d70: 74 20 73 74 61 74 65 20 69 73 20 22 20 28 64 62 t state is " (db
5d80: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
5d90: 74 65 73 74 2d 69 6e 66 6f 29 20 22 2c 20 63 61 test-info) ", ca
5da0: 6e 6e 6f 74 20 70 72 6f 63 65 65 64 22 29 0a 09 nnot proceed")..
5db0: 20 20 20 20 20 20 28 65 78 69 74 29 29 29 29 0a (exit)))).
5dc0: 09 20 20 0a 09 20 20 28 64 65 62 75 67 3a 70 72 . .. (debug:pr
5dd0: 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
5de0: 6f 67 2d 70 6f 72 74 2a 20 22 45 78 65 63 74 75 og-port* "Exectu
5df0: 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 ing " test-name
5e00: 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d 69 64 " (id: " test-id
5e10: 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d 68 6f ") on " (get-ho
5e20: 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 28 73 65 st-name)).. (se
5e30: 74 21 20 6b 65 79 73 20 20 20 20 20 20 20 28 72 t! keys (r
5e40: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 20 mt:get-keys))..
5e50: 20 3b 3b 20 28 72 75 6e 73 3a 73 65 74 2d 6d 65 ;; (runs:set-me
5e60: 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 20 gatest-env-vars
5e70: 72 75 6e 2d 69 64 20 69 6e 6b 65 79 73 3a 20 6b run-id inkeys: k
5e80: 65 79 73 20 69 6e 6b 65 79 76 61 6c 73 3a 20 6b eys inkeyvals: k
5e90: 65 79 76 61 6c 73 29 20 3b 3b 20 74 68 65 73 65 eyvals) ;; these
5ea0: 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 62 may be needed b
5eb0: 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 20 y the launching
5ec0: 70 72 6f 63 65 73 73 0a 09 20 20 3b 3b 20 6f 6e process.. ;; on
5ed0: 65 20 6f 66 20 74 68 65 73 65 20 69 73 20 64 65 e of these is de
5ee0: 66 75 6e 63 74 2f 72 65 64 75 6e 64 61 6e 74 20 funct/redundant
5ef0: 2e 2e 2e 0a 09 20 20 28 69 66 20 28 6e 6f 74 20 ..... (if (not
5f00: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 66 6f (launch:setup fo
5f10: 72 63 65 3a 20 23 74 29 29 0a 09 20 20 20 20 20 rce: #t))..
5f20: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
5f30: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
5f40: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
5f50: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
5f60: 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 iting") ...;; (s
5f70: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
5f80: 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 db)...;; (sqlit
5f90: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
5fa0: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 09 )...(exit 1)))..
5fb0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
5fc0: 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 20 0a ory *toppath*) .
5fd0: 0a 09 20 20 3b 3b 20 4e 4f 54 45 3a 20 43 75 72 .. ;; NOTE: Cur
5fe0: 72 65 6e 74 20 6f 72 64 65 72 20 69 73 20 74 6f rent order is to
5ff0: 20 70 72 6f 63 65 73 73 20 72 75 6e 63 6f 6e 66 process runconf
6000: 69 67 73 20 2a 62 65 66 6f 72 65 2a 20 73 65 74 igs *before* set
6010: 74 69 6e 67 20 74 68 65 20 4d 54 5f 20 76 61 72 ting the MT_ var
6020: 73 2e 20 54 68 69 73 20 0a 09 20 20 3b 3b 20 20 s. This .. ;;
6030: 20 20 20 20 20 73 65 65 6d 73 20 6e 6f 6e 2d 69 seems non-i
6040: 64 65 61 6c 20 62 75 74 20 63 6f 75 6c 64 20 77 deal but could w
6050: 65 6c 6c 20 62 72 65 61 6b 20 73 74 75 66 66 0a ell break stuff.
6060: 09 20 20 3b 3b 20 20 20 20 42 55 47 3f 20 42 55 . ;; BUG? BU
6070: 47 3f 20 42 55 47 3f 0a 09 20 20 0a 09 20 20 28 G? BUG?.. .. (
6080: 6c 65 74 20 28 28 72 63 6f 6e 66 69 67 20 28 66 let ((rconfig (f
6090: 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 73 2d 72 ull-runconfigs-r
60a0: 65 61 64 29 29 29 20 3b 3b 20 28 72 65 61 64 2d ead))) ;; (read-
60b0: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 20 2a 74 config (conc *t
60c0: 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e oppath* "/runcon
60d0: 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 23 66 figs.config") #f
60e0: 20 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 28 6c #t sections: (l
60f0: 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 ist "default" ta
6100: 72 67 65 74 29 29 29 29 0a 09 20 20 20 20 3b 3b rget)))).. ;;
6110: 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 (setup-env-defa
6120: 75 6c 74 73 20 28 63 6f 6e 63 20 2a 74 6f 70 70 ults (conc *topp
6130: 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 ath* "/runconfig
6140: 73 2e 63 6f 6e 66 69 67 22 29 20 72 75 6e 2d 69 s.config") run-i
6150: 64 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 d (make-hash-tab
6160: 6c 65 29 20 6b 65 79 76 61 6c 73 20 74 61 72 67 le) keyvals targ
6170: 65 74 29 0a 09 20 20 20 20 3b 3b 20 28 73 65 74 et).. ;; (set
6180: 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 -run-config-vars
6190: 20 72 75 6e 2d 69 64 20 6b 65 79 76 61 6c 73 20 run-id keyvals
61a0: 74 61 72 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 target) ;; (db:g
61b0: 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 75 6e et-target db run
61c0: 2d 69 64 29 29 0a 09 20 20 20 20 3b 3b 20 4e 6f -id)).. ;; No
61d0: 77 20 68 61 76 65 20 72 75 6e 63 6f 6e 66 69 67 w have runconfig
61e0: 73 20 64 61 74 61 20 6c 6f 61 64 65 64 2c 20 73 s data loaded, s
61f0: 65 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 et environment v
6200: 61 72 73 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 ars.. (for-ea
6210: 63 68 20 28 6c 61 6d 62 64 61 20 28 73 65 63 74 ch (lambda (sect
6220: 69 6f 6e 29 0a 09 09 09 28 66 6f 72 2d 65 61 63 ion)....(for-eac
6230: 68 20 28 6c 61 6d 62 64 61 20 28 76 61 72 76 61 h (lambda (varva
6240: 6c 29 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 l)..... (let
6250: 28 28 76 61 72 20 28 63 61 72 20 76 61 72 76 61 ((var (car varva
6260: 6c 29 29 0a 09 09 09 09 09 20 20 28 76 61 6c 20 l))...... (val
6270: 28 63 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a (cadr varval))).
6280: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 61 .... (if (a
6290: 6e 64 20 28 73 74 72 69 6e 67 3f 20 76 61 72 29 nd (string? var)
62a0: 28 73 74 72 69 6e 67 3f 20 76 61 6c 29 29 0a 09 (string? val))..
62b0: 09 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 .... (begin....
62c0: 09 09 20 20 20 20 28 73 65 74 65 6e 76 20 76 61 .. (setenv va
62d0: 72 20 28 63 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 r (config:eval-s
62e0: 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e tring-in-environ
62f0: 6d 65 6e 74 20 76 61 6c 29 29 29 20 3b 3b 20 76 ment val))) ;; v
6300: 61 6c 29 0a 09 09 09 09 09 20 20 28 64 65 62 75 al)...... (debu
6310: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
6320: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6330: 74 2a 20 22 62 61 64 20 76 61 72 69 61 62 6c 65 t* "bad variable
6340: 20 73 70 65 63 2c 20 22 20 76 61 72 20 22 3d 22 spec, " var "="
6350: 20 76 61 6c 29 29 29 29 0a 09 09 09 09 20 20 28 val))))..... (
6360: 63 6f 6e 66 69 67 66 3a 67 65 74 2d 73 65 63 74 configf:get-sect
6370: 69 6f 6e 20 72 63 6f 6e 66 69 67 20 73 65 63 74 ion rconfig sect
6380: 69 6f 6e 29 29 29 0a 09 09 20 20 20 20 20 20 28 ion)))... (
6390: 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 list "default" t
63a0: 61 72 67 65 74 29 29 29 0a 0a 09 20 20 3b 3b 20 arget)))... ;;
63b0: 4e 46 53 20 6d 69 67 68 74 20 6e 6f 74 20 68 61 NFS might not ha
63c0: 76 65 20 70 72 6f 70 61 67 61 74 65 64 20 74 68 ve propagated th
63d0: 65 20 64 69 72 65 63 74 6f 72 79 20 6d 65 74 61 e directory meta
63e0: 20 64 61 74 61 20 74 6f 20 74 68 65 20 72 75 6e data to the run
63f0: 20 68 6f 73 74 20 2d 20 67 69 76 65 20 69 74 20 host - give it
6400: 74 69 6d 65 20 69 66 20 6e 65 65 64 65 64 0a 09 time if needed..
6410: 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f (let loop ((co
6420: 75 6e 74 20 30 29 29 0a 09 20 20 20 20 28 69 66 unt 0)).. (if
6430: 20 28 6f 72 20 28 66 69 6c 65 2d 65 78 69 73 74 (or (file-exist
6440: 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 s? work-area)...
6450: 20 20 20 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 (> count 10)
6460: 29 0a 09 09 28 63 68 61 6e 67 65 2d 64 69 72 65 )...(change-dire
6470: 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 ctory work-area)
6480: 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 ...(begin... (d
6490: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
64a0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
64b0: 22 49 4e 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 "INFO: Not start
64c0: 69 6e 67 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 ing job yet - di
64d0: 72 65 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 rectory " work-a
64e0: 72 65 61 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 rea " not found"
64f0: 29 0a 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c )... (thread-sl
6500: 65 65 70 21 20 31 30 29 0a 09 09 20 20 28 6c 6f eep! 10)... (lo
6510: 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 op (+ count 1)))
6520: 29 29 0a 0a 09 20 20 3b 3b 20 28 63 68 61 6e 67 ))... ;; (chang
6530: 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
6540: 2d 61 72 65 61 29 20 0a 09 20 20 28 73 65 74 21 -area) .. (set!
6550: 20 6b 65 79 76 61 6c 73 20 20 20 20 28 6b 65 79 keyvals (key
6560: 73 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c s:target->keyval
6570: 20 6b 65 79 73 20 74 61 72 67 65 74 29 29 0a 09 keys target))..
6580: 20 20 3b 3b 20 61 70 70 6c 79 20 70 72 65 2d 6f ;; apply pre-o
6590: 76 65 72 72 69 64 65 73 20 62 65 66 6f 72 65 20 verrides before
65a0: 6f 74 68 65 72 20 76 61 72 69 61 62 6c 65 73 2e other variables.
65b0: 20 54 68 65 20 70 72 65 2d 6f 76 65 72 72 69 64 The pre-overrid
65c0: 65 20 76 61 72 73 20 6d 75 73 74 20 6e 6f 74 0a e vars must not.
65d0: 09 20 20 3b 3b 20 63 6c 6f 62 62 65 72 73 20 74 . ;; clobbers t
65e0: 68 69 6e 67 73 20 66 72 6f 6d 20 74 68 65 20 6f hings from the o
65f0: 66 66 69 63 69 61 6c 20 73 6f 75 72 63 65 73 20 fficial sources
6600: 73 75 63 68 20 61 73 20 6d 65 67 61 74 65 73 74 such as megatest
6610: 2e 63 6f 6e 66 69 67 20 61 6e 64 20 72 75 6e 63 .config and runc
6620: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 0a 09 20 onfigs.config..
6630: 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 73 65 (if (string? se
6640: 74 2d 76 61 72 73 29 0a 09 20 20 20 20 20 20 28 t-vars).. (
6650: 6c 65 74 20 28 28 76 61 72 70 61 69 72 73 20 28 let ((varpairs (
6660: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 73 65 74 string-split set
6670: 2d 76 61 72 73 20 22 2c 22 29 29 29 0a 09 09 28 -vars ",")))...(
6680: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
6690: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
66a0: 20 22 76 61 72 70 61 69 72 73 3a 20 22 20 76 61 "varpairs: " va
66b0: 72 70 61 69 72 73 29 0a 09 09 28 6d 61 70 20 28 rpairs)...(map (
66c0: 6c 61 6d 62 64 61 20 28 76 61 72 70 61 69 72 29 lambda (varpair)
66d0: 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 28 ... (let (
66e0: 28 76 61 72 76 61 6c 20 28 73 74 72 69 6e 67 2d (varval (string-
66f0: 73 70 6c 69 74 20 76 61 72 70 61 69 72 20 22 3d split varpair "=
6700: 22 29 29 29 0a 09 09 09 20 28 69 66 20 28 65 71 "))).... (if (eq
6710: 3f 20 28 6c 65 6e 67 74 68 20 76 61 72 76 61 6c ? (length varval
6720: 29 20 32 29 0a 09 09 09 20 20 20 20 20 28 6c 65 ) 2).... (le
6730: 74 20 28 28 76 61 72 20 28 63 61 72 20 76 61 72 t ((var (car var
6740: 76 61 6c 29 29 0a 09 09 09 09 20 20 20 28 76 61 val))..... (va
6750: 6c 20 28 63 61 64 72 20 76 61 72 76 61 6c 29 29 l (cadr varval))
6760: 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 65 62 ).... (deb
6770: 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 61 ug:print 1 *defa
6780: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 ult-log-port* "A
6790: 64 64 69 6e 67 20 70 72 65 2d 76 61 72 2f 76 61 dding pre-var/va
67a0: 6c 20 22 20 76 61 72 20 22 20 3d 20 22 20 76 61 l " var " = " va
67b0: 6c 20 22 20 74 6f 20 74 68 65 20 65 6e 76 69 72 l " to the envir
67c0: 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 20 20 onment")....
67d0: 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 (setenv var v
67e0: 61 6c 29 29 29 29 29 0a 09 09 20 20 20 20 20 76 al)))))... v
67f0: 61 72 70 61 69 72 73 29 29 29 0a 09 20 20 28 66 arpairs))).. (f
6800: 6f 72 2d 65 61 63 68 0a 09 20 20 20 28 6c 61 6d or-each.. (lam
6810: 62 64 61 20 28 76 61 72 76 61 6c 29 0a 09 20 20 bda (varval)..
6820: 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 (let ((var (c
6830: 61 72 20 76 61 72 76 61 6c 29 29 0a 09 09 20 20 ar varval))...
6840: 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 (val (cadr varv
6850: 61 6c 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 al))).. (i
6860: 66 20 76 61 6c 0a 09 09 20 20 20 28 73 65 74 65 f val... (sete
6870: 6e 76 20 76 61 72 20 76 61 6c 29 0a 09 09 20 20 nv var val)...
6880: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 28 (begin... (
6890: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
68a0: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
68b0: 2d 70 6f 72 74 2a 20 22 72 65 71 75 69 72 65 64 -port* "required
68c0: 20 76 61 72 69 61 62 6c 65 20 22 20 76 61 72 20 variable " var
68d0: 22 20 64 6f 65 73 20 6e 6f 74 20 68 61 76 65 20 " does not have
68e0: 61 20 76 61 6c 69 64 20 76 61 6c 75 65 2e 20 45 a valid value. E
68f0: 78 69 74 69 6e 67 22 29 0a 09 09 20 20 20 20 20 xiting")...
6900: 28 65 78 69 74 29 29 29 29 29 0a 09 20 20 20 20 (exit)))))..
6910: 20 28 6c 69 73 74 20 0a 09 20 20 20 20 20 20 28 (list .. (
6920: 6c 69 73 74 20 20 22 4d 54 5f 54 45 53 54 5f 52 list "MT_TEST_R
6930: 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 UN_DIR" work-are
6940: 61 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 a).. (list
6950: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
6960: 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 test-name)..
6970: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 49 54 45 (list "MT_ITE
6980: 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 M_INFO" (conc it
6990: 65 6d 64 61 74 29 29 0a 09 20 20 20 20 20 20 28 emdat)).. (
69a0: 6c 69 73 74 20 20 22 4d 54 5f 49 54 45 4d 50 41 list "MT_ITEMPA
69b0: 54 48 22 20 20 69 74 65 6d 2d 70 61 74 68 29 0a TH" item-path).
69c0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
69d0: 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
69e0: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 69 name).. (li
69f0: 73 74 20 20 22 4d 54 5f 4d 45 47 41 54 45 53 54 st "MT_MEGATEST
6a00: 22 20 20 6d 65 67 61 74 65 73 74 29 0a 09 20 20 " megatest)..
6a10: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 54 (list "MT_T
6a20: 41 52 47 45 54 22 20 20 20 20 74 61 72 67 65 74 ARGET" target
6a30: 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 ).. (list
6a40: 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 20 20 28 "MT_LINKTREE" (
6a50: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
6a60: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
6a70: 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 0a p" "linktree")).
6a80: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
6a90: 54 5f 54 45 53 54 53 55 49 54 45 4e 41 4d 45 22 T_TESTSUITENAME"
6aa0: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
6ab0: 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 29 29 0a tsuite-name)))).
6ac0: 0a 09 20 20 28 69 66 20 6d 74 2d 62 69 6e 64 69 .. (if mt-bindi
6ad0: 72 2d 70 61 74 68 20 28 73 65 74 65 6e 76 20 22 r-path (setenv "
6ae0: 50 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 PATH" (conc (get
6af0: 65 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 20 env "PATH") ":"
6b00: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 mt-bindir-path))
6b10: 29 0a 09 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d ).. ;; (change-
6b20: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 2d 70 61 directory top-pa
6b30: 74 68 29 0a 09 20 20 3b 3b 20 43 61 6e 20 73 65 th).. ;; Can se
6b40: 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f tup as client fo
6b50: 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f r server mode no
6b60: 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a w.. ;; (client:
6b70: 73 65 74 75 70 29 0a 0a 09 20 20 0a 09 20 20 3b setup)... .. ;
6b80: 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 ; environment ov
6b90: 65 72 72 69 64 65 73 20 61 72 65 20 64 6f 6e 65 errides are done
6ba0: 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 72 65 *before* the re
6bb0: 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 61 6c maining critical
6bc0: 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 61 6c 69 envars... (ali
6bd0: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 st->env-vars env
6be0: 2d 6f 76 72 64 29 0a 09 20 20 28 72 75 6e 73 3a -ovrd).. (runs:
6bf0: 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 set-megatest-env
6c00: 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 69 6e 6b -vars run-id ink
6c10: 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b 65 79 76 eys: keys inkeyv
6c20: 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 0a 09 20 als: keyvals)..
6c30: 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 (set-item-env-v
6c40: 61 72 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 ars itemdat)..
6c50: 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e (save-environmen
6c60: 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 t-as-files "mega
6c70: 74 65 73 74 22 29 0a 09 20 20 3b 3b 20 6f 70 65 test").. ;; ope
6c80: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f 74 20 n-run-close not
6c90: 6e 65 65 64 65 64 20 66 6f 72 20 74 65 73 74 2d needed for test-
6ca0: 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 20 set-meta-info..
6cb0: 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d 66 ;; (tests:set-f
6cc0: 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 ull-meta-info #f
6cd0: 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 test-id run-id
6ce0: 30 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 0 work-area)..
6cf0: 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 ;; (tests:set-fu
6d00: 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 65 73 ll-meta-info tes
6d10: 74 2d 69 64 20 72 75 6e 2d 69 64 20 30 20 77 6f t-id run-id 0 wo
6d20: 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 74 65 73 rk-area).. (tes
6d30: 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 ts:set-full-meta
6d40: 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 -info #f test-id
6d50: 20 72 75 6e 2d 69 64 20 30 20 77 6f 72 6b 2d 61 run-id 0 work-a
6d60: 72 65 61 20 31 30 29 0a 0a 09 20 20 3b 3b 20 28 rea 10)... ;; (
6d70: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
6d80: 33 29 20 3b 3b 20 4e 46 53 20 73 6c 6f 77 6e 65 3) ;; NFS slowne
6d90: 73 73 20 68 61 73 20 63 61 75 73 65 64 20 67 72 ss has caused gr
6da0: 69 65 66 20 68 65 72 65 0a 0a 09 20 20 28 69 66 ief here... (if
6db0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
6dc0: 2d 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 -xterm")..
6dd0: 28 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 72 (set! fullrunscr
6de0: 69 70 74 20 22 78 74 65 72 6d 22 29 0a 09 20 20 ipt "xterm")..
6df0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 66 75 6c (if (and ful
6e00: 6c 72 75 6e 73 63 72 69 70 74 20 0a 09 09 20 20 lrunscript ...
6e10: 20 20 20 20 20 28 66 69 6c 65 2d 65 78 69 73 74 (file-exist
6e20: 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 s? fullrunscript
6e30: 29 0a 09 09 20 20 20 20 20 20 20 28 6e 6f 74 20 )... (not
6e40: 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 (file-execute-ac
6e50: 63 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 cess? fullrunscr
6e60: 69 70 74 29 29 29 0a 09 09 20 20 28 73 79 73 74 ipt)))... (syst
6e70: 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 20 em (conc "chmod
6e80: 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 63 ug+x " fullrunsc
6e90: 72 69 70 74 29 29 29 29 0a 0a 09 20 20 3b 3b 20 ript))))... ;;
6ea0: 57 65 20 61 72 65 20 61 62 6f 75 74 20 74 6f 20 We are about to
6eb0: 61 63 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 actually kick of
6ec0: 66 20 74 68 65 20 74 65 73 74 0a 09 20 20 3b 3b f the test.. ;;
6ed0: 20 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 6f so this is a go
6ee0: 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d 6f od place to remo
6ef0: 76 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 66 ve the records f
6f00: 6f 72 20 0a 09 20 20 3b 3b 20 61 6e 79 20 70 72 or .. ;; any pr
6f10: 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 3b evious runs.. ;
6f20: 3b 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f 76 ; (db:test-remov
6f30: 65 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d 69 e-steps db run-i
6f40: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 d testname itemd
6f50: 61 74 29 0a 09 20 20 3b 3b 20 0a 09 20 20 28 6c at).. ;; .. (l
6f60: 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 20 et* ((m
6f70: 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 (make-mutex))
6f80: 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 20 ... (kill-job?
6f90: 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d 69 #f)... (exit-i
6fa0: 6e 66 6f 20 20 20 20 28 6d 61 6b 65 2d 6c 61 75 nfo (make-lau
6fb0: 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 23 74 nch:einf pid: #t
6fc0: 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 23 74 exit-status: #t
6fd0: 20 65 78 69 74 2d 63 6f 64 65 3a 20 23 74 20 72 exit-code: #t r
6fe0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 30 29 ollup-status: 0)
6ff0: 29 20 3b 3b 20 70 69 64 20 65 78 69 74 2d 73 74 ) ;; pid exit-st
7000: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 20 28 atus exit-code (
7010: 69 2e 65 2e 20 70 72 6f 63 65 73 73 20 77 61 73 i.e. process was
7020: 20 73 75 63 63 65 73 73 66 75 6c 6c 79 20 72 75 successfully ru
7030: 6e 29 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 n) rollup-status
7040: 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 20 ... (job-thread
7050: 20 20 23 66 29 0a 09 09 20 3b 3b 20 28 6b 65 65 #f)... ;; (kee
7060: 70 2d 67 6f 69 6e 67 20 20 20 23 74 29 0a 09 09 p-going #t)...
7070: 20 28 6d 69 73 63 2d 66 6c 61 67 73 20 20 20 28 (misc-flags (
7080: 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d 68 let ((ht (make-h
7090: 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 09 ash-table)))....
70a0: 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 . (hash-table-se
70b0: 74 21 20 68 74 20 27 6b 65 65 70 2d 67 6f 69 6e t! ht 'keep-goin
70c0: 67 20 23 74 29 0a 09 09 09 09 20 68 74 29 29 0a g #t)..... ht)).
70d0: 09 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 20 .. (runit
70e0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
70f0: 20 28 6c 61 75 6e 63 68 3a 6d 61 6e 61 67 65 2d (launch:manage-
7100: 73 74 65 70 73 20 72 75 6e 2d 69 64 20 74 65 73 steps run-id tes
7110: 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 66 t-id item-path f
7120: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 7a 73 ullrunscript ezs
7130: 74 65 70 73 20 74 65 73 74 2d 6e 61 6d 65 20 74 teps test-name t
7140: 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 2d 69 configreg exit-i
7150: 6e 66 6f 20 6d 29 29 29 0a 09 09 20 28 6d 6f 6e nfo m)))... (mon
7160: 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 itorjob (lambd
7170: 61 20 28 29 0a 09 09 09 09 20 28 6c 61 75 6e 63 a ()..... (launc
7180: 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 20 72 h:monitor-job r
7190: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 74 un-id test-id it
71a0: 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e 73 em-path fullruns
71b0: 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 65 cript ezsteps te
71c0: 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 72 st-name tconfigr
71d0: 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 77 eg exit-info m w
71e0: 6f 72 6b 2d 61 72 65 61 20 72 75 6e 74 6c 69 6d ork-area runtlim
71f0: 20 6d 69 73 63 2d 66 6c 61 67 73 29 29 29 0a 09 misc-flags)))..
7200: 09 20 28 74 68 31 20 20 20 20 20 20 20 20 20 20 . (th1
7210: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e (make-thread mon
7220: 69 74 6f 72 6a 6f 62 20 22 6d 6f 6e 69 74 6f 72 itorjob "monitor
7230: 20 6a 6f 62 22 29 29 0a 09 09 20 28 74 68 32 20 job"))... (th2
7240: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 (make-t
7250: 68 72 65 61 64 20 72 75 6e 69 74 20 22 72 75 6e hread runit "run
7260: 20 6a 6f 62 22 29 29 29 0a 09 20 20 20 20 28 73 job"))).. (s
7270: 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 et! job-thread t
7280: 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 h2).. (thread
7290: 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 20 -start! th1)..
72a0: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
72b0: 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 th2).. (thre
72c0: 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 ad-join! th2)..
72d0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
72e0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
72f0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 65 67 61 74 log-port* "Megat
7300: 65 73 74 20 65 78 65 63 74 75 74 65 20 6f 66 20 est exectute of
7310: 74 65 73 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 test " test-name
7320: 20 22 2c 20 69 74 65 6d 20 70 61 74 68 20 22 20 ", item path "
7330: 69 74 65 6d 2d 70 61 74 68 20 22 20 63 6f 6d 70 item-path " comp
7340: 6c 65 74 65 2e 20 4e 6f 74 69 66 79 69 6e 67 20 lete. Notifying
7350: 74 68 65 20 64 62 20 2e 2e 2e 22 29 0a 09 20 20 the db ...")..
7360: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
7370: 74 21 20 6d 69 73 63 2d 66 6c 61 67 73 20 27 6b t! misc-flags 'k
7380: 65 65 70 2d 67 6f 69 6e 67 20 23 66 29 0a 09 20 eep-going #f)..
7390: 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 (thread-join!
73a0: 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 th1).. (thre
73b0: 61 64 2d 73 6c 65 65 70 21 20 31 29 20 20 20 20 ad-sleep! 1)
73c0: 20 20 20 3b 3b 20 67 69 76 62 65 20 74 68 72 65 ;; givbe thre
73d0: 61 64 20 74 68 31 20 61 20 63 68 61 6e 63 65 20 ad th1 a chance
73e0: 74 6f 20 62 65 20 64 6f 6e 65 20 54 4f 44 4f 3a to be done TODO:
73f0: 20 56 65 72 69 66 79 20 74 68 69 73 20 69 73 20 Verify this is
7400: 6e 65 65 64 65 64 2e 20 41 74 20 30 2e 31 20 49 needed. At 0.1 I
7410: 20 77 61 73 20 67 65 74 74 69 6e 67 20 66 61 69 was getting fai
7420: 6c 20 74 6f 20 73 74 6f 70 2c 20 69 6e 63 72 65 l to stop, incre
7430: 61 73 65 64 20 74 6f 20 74 6f 74 61 6c 20 6f 66 ased to total of
7440: 20 31 2e 31 20 73 65 63 2e 0a 09 20 20 20 20 28 1.1 sec... (
7450: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 mutex-lock! m)..
7460: 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d (let* ((item
7470: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
7480: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
7490: 0a 09 09 20 20 20 3b 3b 20 6f 6e 6c 79 20 73 74 ... ;; only st
74a0: 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 6e ate and status n
74b0: 65 65 64 65 64 20 2d 20 75 73 65 20 6c 61 7a 79 eeded - use lazy
74c0: 20 72 6f 75 74 69 6e 65 0a 09 09 20 20 20 28 74 routine... (t
74d0: 65 73 74 69 6e 66 6f 20 20 28 72 6d 74 3a 67 65 estinfo (rmt:ge
74e0: 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 t-testinfo-state
74f0: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 -status run-id t
7500: 65 73 74 2d 69 64 29 29 29 0a 09 20 20 20 20 20 est-id)))..
7510: 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 ;; Am I complet
7520: 65 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 28 ed?.. (if (
7530: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
7540: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e get-state testin
7550: 66 6f 29 20 27 28 22 52 45 4d 4f 54 45 48 4f 53 fo) '("REMOTEHOS
7560: 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 TSTART" "RUNNING
7570: 22 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 49 74 20 ")) ;; NOTE: It
7580: 73 68 6f 75 6c 64 20 2a 6e 6f 74 2a 20 62 65 20 should *not* be
7590: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 20 REMOTEHOSTSTART
75a0: 62 75 74 20 66 6f 72 20 72 65 61 73 6f 6e 73 20 but for reasons
75b0: 49 20 64 6f 6e 27 74 20 79 65 74 20 75 6e 64 65 I don't yet unde
75c0: 72 73 74 61 6e 64 20 69 74 20 73 6f 6d 65 74 69 rstand it someti
75d0: 6d 65 73 20 67 65 74 73 20 73 74 75 63 6b 20 69 mes gets stuck i
75e0: 6e 20 74 68 61 74 20 73 74 61 74 65 20 3b 3b 20 n that state ;;
75f0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
7600: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
7610: 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c testinfo) "COMPL
7620: 45 54 45 44 22 29 29 0a 09 09 20 20 28 6c 65 74 ETED"))... (let
7630: 20 28 28 6e 65 77 2d 73 74 61 74 65 20 20 28 69 ((new-state (i
7640: 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c f kill-job? "KIL
7650: 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 LED" "COMPLETED"
7660: 29 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 28 76 ) ;; (if (eq? (v
7670: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
7680: 6e 66 6f 20 32 29 20 30 29 20 3b 3b 20 65 78 69 nfo 2) 0) ;; exi
7690: 74 65 64 20 77 69 74 68 20 22 67 6f 6f 64 22 20 ted with "good"
76a0: 73 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 20 status.....
76b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 20 3b 3b 20 22 43 4f 4d 50 4c 45 54 45 44 ;; "COMPLETED
76e0: 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 "........
76f0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 62 3a ;; (db:
7700: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
7710: 65 73 74 69 6e 66 6f 29 29 29 20 20 20 3b 3b 20 estinfo))) ;;
7720: 65 6c 73 65 20 70 72 65 73 65 76 65 20 74 68 65 else preseve the
7730: 20 73 74 61 74 65 20 61 73 20 73 65 74 20 77 69 state as set wi
7740: 74 68 69 6e 20 74 68 65 20 74 65 73 74 0a 09 09 thin the test...
7750: 09 09 20 20 20 20 29 0a 09 09 09 28 6e 65 77 2d .. )....(new-
7760: 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
7770: 09 20 20 20 20 20 28 28 6e 6f 74 20 28 6c 61 75 . ((not (lau
7780: 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 nch:einf-exit-st
7790: 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 29 atus exit-info))
77a0: 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 20 "FAIL") ;; job
77b0: 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 2e 2e failed to run ..
77c0: 2e 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 . (vector-ref ex
77d0: 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 20 it-info 1).....
77e0: 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 ((eq? (launc
77f0: 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 h:einf-rollup-st
7800: 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 atus exit-info)
7810: 30 29 20 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 0) ;; (vecto
7820: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
7830: 33 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 3)..... ;;
7840: 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 if the current s
7850: 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 tatus is AUTO th
7860: 65 6e 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 en defer to the
7870: 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 calculated value
7880: 20 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 (i.e. leave thi
7890: 73 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 20 s AUTO).....
78a0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 64 (if (equal? (d
78b0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
78c0: 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 54 s testinfo) "AUT
78d0: 4f 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 53 O") "AUTO" "PASS
78e0: 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 "))..... ((e
78f0: 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d q? (launch:einf-
7900: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
7910: 69 74 2d 69 6e 66 6f 29 20 31 29 20 22 46 41 49 it-info) 1) "FAI
7920: 4c 22 29 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d L") ;; (vector-
7930: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 ref exit-info 3)
7940: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
7950: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
7960: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
7970: 69 6e 66 6f 29 20 32 29 09 20 20 20 20 20 3b 3b info) 2). ;;
7980: 09 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 .(vector-ref exi
7990: 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 20 20 t-info 3).....
79a0: 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 ;; if the cu
79b0: 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 rrent status is
79c0: 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 AUTO the defer t
79d0: 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 o the calculated
79e0: 20 76 61 6c 75 65 20 62 75 74 20 71 75 61 6c 69 value but quali
79f0: 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 68 fy (i.e. make th
7a00: 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 09 is AUTO-WARN)...
7a10: 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 .. (if (equ
7a20: 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 al? (db:test-get
7a30: 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f -status testinfo
7a40: 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d ) "AUTO") "AUTO-
7a50: 57 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 WARN" "WARN"))..
7a60: 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c ... ((eq? (l
7a70: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
7a80: 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e p-status exit-in
7a90: 66 6f 29 20 33 29 20 22 43 48 45 43 4b 22 29 0a fo) 3) "CHECK").
7aa0: 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 .... ((eq? (
7ab0: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c launch:einf-roll
7ac0: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 up-status exit-i
7ad0: 6e 66 6f 29 20 34 29 20 22 57 41 49 56 45 44 22 nfo) 4) "WAIVED"
7ae0: 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f )..... ((eq?
7af0: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f (launch:einf-ro
7b00: 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 llup-status exit
7b10: 2d 69 6e 66 6f 29 20 35 29 20 22 41 42 4f 52 54 -info) 5) "ABORT
7b20: 22 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 ")..... ((eq
7b30: 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 ? (launch:einf-r
7b40: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 ollup-status exi
7b50: 74 2d 69 6e 66 6f 29 20 36 29 20 22 53 4b 49 50 t-info) 6) "SKIP
7b60: 22 29 0a 09 09 09 09 20 20 20 20 20 28 65 6c 73 ")..... (els
7b70: 65 20 22 46 41 49 4c 22 29 29 29 29 20 3b 3b 20 e "FAIL")))) ;;
7b80: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
7b90: 74 75 73 20 74 65 73 74 69 6e 66 6f 29 29 29 0a tus testinfo))).
7ba0: 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
7bb0: 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 nt-info 1 *defau
7bc0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 54 65 lt-log-port* "Te
7bd0: 73 74 20 65 78 69 74 65 64 20 69 6e 20 73 74 61 st exited in sta
7be0: 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 65 te=" (db:test-ge
7bf0: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
7c00: 29 20 22 2c 20 73 65 74 74 69 6e 67 20 73 74 61 ) ", setting sta
7c10: 74 65 2f 73 74 61 74 75 73 20 62 61 73 65 64 20 te/status based
7c20: 6f 6e 20 65 78 69 74 20 63 6f 64 65 20 6f 66 20 on exit code of
7c30: 22 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 " (launch:einf-e
7c40: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
7c50: 69 6e 66 6f 29 20 22 20 61 6e 64 20 72 6f 6c 6c info) " and roll
7c60: 75 70 2d 73 74 61 74 75 73 20 6f 66 20 22 20 28 up-status of " (
7c70: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c launch:einf-roll
7c80: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 up-status exit-i
7c90: 6e 66 6f 29 29 0a 09 09 20 20 20 20 28 74 65 73 nfo))... (tes
7ca0: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
7cb0: 75 73 21 20 72 75 6e 2d 69 64 20 0a 09 09 09 09 us! run-id .....
7cc0: 09 20 20 20 20 74 65 73 74 2d 69 64 20 0a 09 09 . test-id ...
7cd0: 09 09 09 20 20 20 20 6e 65 77 2d 73 74 61 74 65 ... new-state
7ce0: 0a 09 09 09 09 09 20 20 20 20 6e 65 77 2d 73 74 ...... new-st
7cf0: 61 74 75 73 0a 09 09 09 09 09 20 20 20 20 28 61 atus...... (a
7d00: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 rgs:get-arg "-m"
7d10: 29 20 23 66 29 0a 09 09 20 20 20 20 3b 3b 20 6e ) #f)... ;; n
7d20: 65 65 64 20 74 6f 20 75 70 64 61 74 65 20 74 68 eed to update th
7d30: 65 20 74 6f 70 20 74 65 73 74 20 72 65 63 6f 72 e top test recor
7d40: 64 20 69 66 20 50 41 53 53 20 6f 72 20 46 41 49 d if PASS or FAI
7d50: 4c 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 L and this is a
7d60: 73 75 62 74 65 73 74 0a 09 09 20 20 20 20 3b 3b subtest... ;;
7d70: 20 4e 4f 20 4e 45 45 44 20 54 4f 20 43 41 4c 4c NO NEED TO CALL
7d80: 20 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 roll-up-pass-fa
7d90: 69 6c 2d 63 6f 75 6e 74 73 20 48 45 52 45 2c 20 il-counts HERE,
7da0: 54 48 49 53 20 49 53 20 44 4f 4e 45 20 49 4e 20 THIS IS DONE IN
7db0: 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 roll-up-pass-fai
7dc0: 6c 2d 63 6f 75 6e 74 73 20 63 61 6c 6c 65 64 20 l-counts called
7dd0: 62 79 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 by tests:test-se
7de0: 74 2d 73 74 61 74 75 73 21 0a 09 09 20 20 20 20 t-status!...
7df0: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 )).. ;; for
7e00: 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 automated creat
7e10: 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 ion of the rollu
7e20: 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 p html file this
7e30: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
7e40: 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
7e50: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d not (equal? item
7e60: 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 -path ""))... (
7e70: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
7e80: 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 items run-id tes
7e90: 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 t-id test-name #
7ea0: 66 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 f)).. (test
7eb0: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 s:summarize-test
7ec0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
7ed0: 20 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 ;; don't force
7ee0: 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 - just update i
7ef0: 66 20 6e 6f 0a 09 20 20 20 20 20 20 28 72 6d 74 f no.. (rmt
7f00: 3a 75 70 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 :update-run-stat
7f10: 73 20 72 75 6e 2d 69 64 20 28 72 6d 74 3a 67 65 s run-id (rmt:ge
7f20: 74 2d 72 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 t-raw-run-stats
7f30: 72 75 6e 2d 69 64 29 29 29 0a 09 20 20 20 20 28 run-id))).. (
7f40: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 mutex-unlock! m)
7f50: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
7f60: 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
7f70: 67 2d 70 6f 72 74 2a 20 22 4f 75 74 70 75 74 20 g-port* "Output
7f80: 66 72 6f 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 from running " f
7f90: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 2c 20 ullrunscript ",
7fa0: 70 69 64 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 pid " (launch:ei
7fb0: 6e 66 2d 70 69 64 20 65 78 69 74 2d 69 6e 66 6f nf-pid exit-info
7fc0: 29 20 22 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 ) " in work area
7fd0: 20 22 20 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 " .... work-are
7fe0: 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 a ":\n====\n exi
7ff0: 74 20 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 t code " (launch
8000: 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 :einf-exit-code
8010: 65 78 69 74 2d 69 6e 66 6f 29 20 22 5c 6e 22 20 exit-info) "\n"
8020: 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 28 "====\n").. (
8030: 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a if (not (launch:
8040: 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 einf-exit-status
8050: 20 65 78 69 74 2d 69 6e 66 6f 29 29 0a 09 09 28 exit-info))...(
8060: 65 78 69 74 20 34 29 29 29 29 29 29 29 0a 0a 28 exit 4)))))))..(
8070: 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 63 define (launch:c
8080: 61 63 68 65 2d 63 6f 6e 66 69 67 29 0a 20 20 3b ache-config). ;
8090: 3b 20 69 66 20 77 65 20 68 61 76 65 20 61 20 6c ; if we have a l
80a0: 69 6e 6b 74 72 65 65 20 61 6e 64 20 2d 72 75 6e inktree and -run
80b0: 74 65 73 74 73 20 61 6e 64 20 2d 74 61 72 67 65 tests and -targe
80c0: 74 20 61 6e 64 20 74 68 65 20 64 69 72 65 63 74 t and the direct
80d0: 6f 72 79 20 65 78 69 73 74 73 20 64 75 6d 70 20 ory exists dump
80e0: 74 68 65 20 63 6f 6e 66 69 67 0a 20 20 3b 3b 20 the config. ;;
80f0: 74 6f 20 6d 65 67 61 74 65 73 74 2d 28 63 75 72 to megatest-(cur
8100: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 2e 63 66 rent-seconds).cf
8110: 67 20 61 6e 64 20 73 79 6d 6c 69 6e 6b 20 69 74 g and symlink it
8120: 20 74 6f 20 6d 65 67 61 74 65 73 74 2e 63 66 67 to megatest.cfg
8130: 0a 20 20 28 69 66 20 28 61 6e 64 20 2a 63 6f 6e . (if (and *con
8140: 66 69 67 64 61 74 2a 20 0a 09 20 20 20 28 6f 72 figdat* .. (or
8150: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
8160: 2d 72 75 6e 22 29 0a 09 20 20 20 20 20 20 20 28 -run").. (
8170: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 args:get-arg "-r
8180: 75 6e 74 65 73 74 73 22 29 0a 09 20 20 20 20 20 untests")..
8190: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
81a0: 22 2d 65 78 65 63 75 74 65 22 29 29 29 0a 20 20 "-execute"))).
81b0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 69 6e 6b (let* ((link
81c0: 74 72 65 65 20 28 67 65 74 2d 65 6e 76 69 72 6f tree (get-enviro
81d0: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
81e0: 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 29 0a 09 MT_LINKTREE"))..
81f0: 20 20 20 20 20 28 74 61 72 67 65 74 20 20 20 28 (target (
8200: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
8210: 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 20 28 target)).. (
8220: 72 75 6e 6e 61 6d 65 20 20 28 6f 72 20 28 61 72 runname (or (ar
8230: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
8240: 6e 61 6d 65 22 29 0a 09 09 09 20 20 20 28 61 72 name").... (ar
8250: 67 73 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e gs:get-arg ":run
8260: 6e 61 6d 65 22 29 0a 09 09 09 20 20 20 28 67 65 name").... (ge
8270: 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 tenv "MT_RUNNAME
8280: 22 29 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c "))).. (full
8290: 64 69 72 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 dir (conc linkt
82a0: 72 65 65 20 22 2f 22 0a 09 09 09 20 20 20 20 20 ree "/"....
82b0: 74 61 72 67 65 74 20 22 2f 22 0a 09 09 09 20 20 target "/"....
82c0: 20 20 20 72 75 6e 6e 61 6d 65 29 29 29 0a 09 28 runname)))..(
82d0: 69 66 20 28 61 6e 64 20 6c 69 6e 6b 74 72 65 65 if (and linktree
82e0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c (file-exists? l
82f0: 69 6e 6b 74 72 65 65 29 29 20 3b 3b 20 63 61 6e inktree)) ;; can
8300: 27 74 20 70 72 6f 63 65 65 64 20 77 69 74 68 6f 't proceed witho
8310: 75 74 20 6c 69 6e 6b 74 72 65 65 0a 09 20 20 20 ut linktree..
8320: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
8330: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
8340: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
8350: 70 6f 72 74 2a 20 22 48 61 76 65 20 2d 72 75 6e port* "Have -run
8360: 20 77 69 74 68 20 74 61 72 67 65 74 3d 22 20 74 with target=" t
8370: 61 72 67 65 74 20 22 2c 20 72 75 6e 6e 61 6d 65 arget ", runname
8380: 3d 22 20 72 75 6e 6e 61 6d 65 20 22 2c 20 66 75 =" runname ", fu
8390: 6c 6c 64 69 72 3d 22 20 66 75 6c 6c 64 69 72 20 lldir=" fulldir
83a0: 22 2c 20 74 65 73 74 70 61 74 74 3d 22 20 28 6f ", testpatt=" (o
83b0: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
83c0: 22 2d 74 65 73 74 70 61 74 74 22 29 20 22 25 22 "-testpatt") "%"
83d0: 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e )).. (if (n
83e0: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
83f0: 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 20 20 28 fulldir))... (
8400: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
8410: 20 66 75 6c 6c 64 69 72 20 23 74 29 29 20 3b 3b fulldir #t)) ;;
8420: 20 6e 65 65 64 20 74 6f 20 70 72 6f 74 65 63 74 need to protect
8430: 20 77 69 74 68 20 65 78 63 65 70 74 69 6f 6e 20 with exception
8440: 68 61 6e 64 6c 65 72 20 0a 09 20 20 20 20 20 20 handler ..
8450: 28 69 66 20 28 61 6e 64 20 74 61 72 67 65 74 0a (if (and target.
8460: 09 09 20 20 20 20 20 20 20 72 75 6e 6e 61 6d 65 .. runname
8470: 0a 09 09 20 20 20 20 20 20 20 28 66 69 6c 65 2d ... (file-
8480: 65 78 69 73 74 73 3f 20 66 75 6c 6c 64 69 72 29 exists? fulldir)
8490: 29 0a 09 09 20 20 28 6c 65 74 20 28 28 74 6d 70 )... (let ((tmp
84a0: 66 69 6c 65 20 20 28 63 6f 6e 63 20 66 75 6c 6c file (conc full
84b0: 64 69 72 20 22 2f 2e 6d 65 67 61 74 65 73 74 2e dir "/.megatest.
84c0: 63 66 67 2e 22 20 28 63 75 72 72 65 6e 74 2d 73 cfg." (current-s
84d0: 65 63 6f 6e 64 73 29 29 29 0a 09 09 09 28 74 61 econds)))....(ta
84e0: 72 67 66 69 6c 65 20 28 63 6f 6e 63 20 66 75 6c rgfile (conc ful
84f0: 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 65 73 74 ldir "/.megatest
8500: 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 .cfg-" megatest
8510: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
8520: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
8530: 68 29 29 0a 09 09 09 28 72 63 6f 6e 66 69 67 20 h))....(rconfig
8540: 20 28 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 (conc fulldir "
8550: 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 20 6d 65 /.runconfig." me
8560: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
8570: 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 -" megatest-foss
8580: 69 6c 2d 68 61 73 68 29 29 29 0a 09 09 20 20 20 il-hash)))...
8590: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
85a0: 73 3f 20 72 63 6f 6e 66 69 67 29 20 3b 3b 20 6f s? rconfig) ;; o
85b0: 6e 6c 79 20 63 61 63 68 65 20 6d 65 67 61 74 65 nly cache megate
85c0: 73 74 2e 63 6f 6e 66 69 67 20 41 46 54 45 52 20 st.config AFTER
85d0: 72 75 6e 63 6f 6e 66 69 67 73 20 68 61 73 20 62 runconfigs has b
85e0: 65 65 6e 20 63 61 63 68 65 64 0a 09 09 09 28 62 een cached....(b
85f0: 65 67 69 6e 0a 09 09 09 20 20 28 64 65 62 75 67 egin.... (debug
8600: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
8610: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
8620: 20 22 43 61 63 68 69 6e 67 20 6d 65 67 61 74 65 "Caching megate
8630: 73 74 2e 63 6f 6e 66 69 67 20 69 6e 20 22 20 74 st.config in " t
8640: 6d 70 66 69 6c 65 29 0a 09 09 09 20 20 28 63 6f mpfile).... (co
8650: 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 nfigf:write-alis
8660: 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 6d t *configdat* tm
8670: 70 66 69 6c 65 29 0a 09 09 09 20 20 28 73 79 73 pfile).... (sys
8680: 74 65 6d 20 28 63 6f 6e 63 20 22 6c 6e 20 2d 73 tem (conc "ln -s
8690: 66 20 22 20 74 6d 70 66 69 6c 65 20 22 20 22 20 f " tmpfile " "
86a0: 74 61 72 67 66 69 6c 65 29 29 29 29 0a 09 09 20 targfile))))...
86b0: 20 20 20 29 29 29 0a 09 20 20 20 20 28 64 65 62 ))).. (deb
86c0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 20 ug:print-info 1
86d0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
86e0: 74 2a 20 22 4e 6f 20 6c 69 6e 6b 74 72 65 65 20 t* "No linktree
86f0: 79 65 74 2c 20 6e 6f 20 63 61 63 68 69 6e 67 20 yet, no caching
8700: 63 6f 6e 66 69 67 73 2e 22 29 29 29 29 29 0a 0a configs.")))))..
8710: 0a 3b 3b 20 67 61 74 68 65 72 20 61 76 61 69 6c .;; gather avail
8720: 61 62 6c 65 20 69 6e 66 6f 72 6d 61 74 69 6f 6e able information
8730: 2c 20 69 66 20 6c 65 67 69 74 20 72 65 61 64 20 , if legit read
8740: 63 6f 6e 66 69 67 73 20 69 6e 20 74 68 69 73 20 configs in this
8750: 6f 72 64 65 72 3a 0a 3b 3b 0a 3b 3b 20 20 20 69 order:.;;.;; i
8760: 66 20 68 61 76 65 20 63 61 63 68 65 3b 0a 3b 3b f have cache;.;;
8770: 20 20 20 20 20 20 72 65 61 64 20 69 74 20 61 20 read it a
8780: 72 65 74 75 72 6e 20 69 74 0a 3b 3b 20 20 20 65 return it.;; e
8790: 6c 73 65 0a 3b 3b 20 20 20 20 20 6d 65 67 61 74 lse.;; megat
87a0: 65 73 74 2e 63 6f 6e 66 69 67 20 20 20 20 20 28 est.config (
87b0: 64 6f 20 6e 6f 74 20 63 61 63 68 65 29 0a 3b 3b do not cache).;;
87c0: 20 20 20 20 20 72 75 6e 63 6f 6e 66 69 67 73 2e runconfigs.
87d0: 63 6f 6e 66 69 67 20 20 20 28 63 61 63 68 65 20 config (cache
87e0: 69 66 20 61 6c 6c 20 76 61 72 73 20 61 76 61 69 if all vars avai
87f0: 6c 29 0a 3b 3b 20 20 20 20 20 6d 65 67 61 74 65 l).;; megate
8800: 73 74 2e 63 6f 6e 66 69 67 20 20 20 20 20 28 63 st.config (c
8810: 61 63 68 65 20 69 66 20 61 6c 6c 20 76 61 72 73 ache if all vars
8820: 20 61 76 61 69 6c 29 0a 3b 3b 20 20 20 72 65 74 avail).;; ret
8830: 75 72 6e 73 3a 0a 3b 3b 20 20 20 20 20 2a 74 6f urns:.;; *to
8840: 70 70 61 74 68 2a 0a 3b 3b 20 20 20 73 69 64 65 ppath*.;; side
8850: 20 65 66 66 65 63 74 73 3a 0a 3b 3b 20 20 20 20 effects:.;;
8860: 20 73 65 74 73 3b 20 2a 63 6f 6e 66 69 67 64 61 sets; *configda
8870: 74 2a 20 20 20 20 28 6d 65 67 61 74 65 73 74 2e t* (megatest.
8880: 63 6f 6e 66 69 67 20 69 6e 66 6f 29 0a 3b 3b 20 config info).;;
8890: 20 20 20 20 20 20 20 20 20 20 2a 72 75 6e 63 6f *runco
88a0: 6e 66 69 67 64 61 74 2a 20 28 72 75 6e 63 6f 6e nfigdat* (runcon
88b0: 66 69 67 73 2e 63 6f 6e 66 69 67 20 69 6e 66 6f figs.config info
88c0: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 2a ).;; *
88d0: 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 28 73 configstatus* (s
88e0: 74 61 74 75 73 20 6f 66 20 74 68 65 20 72 65 61 tatus of the rea
88f0: 64 20 64 61 74 61 29 0a 3b 3b 0a 28 64 65 66 69 d data).;;.(defi
8900: 6e 65 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 ne (launch:setup
8910: 2d 6e 65 77 20 23 21 6b 65 79 20 28 66 6f 72 63 -new #!key (forc
8920: 65 20 23 66 29 29 0a 20 20 28 6c 65 74 2a 20 28 e #f)). (let* (
8930: 28 74 6f 70 70 61 74 68 20 20 28 6f 72 20 2a 74 (toppath (or *t
8940: 6f 70 70 61 74 68 2a 20 28 67 65 74 65 6e 76 20 oppath* (getenv
8950: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
8960: 45 22 29 29 29 20 3b 3b 20 70 72 65 73 65 72 76 E"))) ;; preserv
8970: 65 20 74 6f 70 70 61 74 68 0a 09 20 28 72 75 6e e toppath.. (run
8980: 6e 61 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 name (common:ar
8990: 67 73 2d 67 65 74 2d 72 75 6e 6e 61 6d 65 29 29 gs-get-runname))
89a0: 0a 09 20 28 74 61 72 67 65 74 20 20 20 28 63 6f .. (target (co
89b0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
89c0: 72 67 65 74 29 29 0a 09 20 28 6c 69 6e 6b 74 72 rget)).. (linktr
89d0: 65 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c ee (common:get-l
89e0: 69 6e 6b 74 72 65 65 29 29 0a 09 20 28 73 65 63 inktree)).. (sec
89f0: 74 69 6f 6e 73 20 28 69 66 20 74 61 72 67 65 74 tions (if target
8a00: 20 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 (list "default"
8a10: 20 74 61 72 67 65 74 29 20 23 66 29 29 20 3b 3b target) #f)) ;;
8a20: 20 66 6f 72 20 72 75 6e 63 6f 6e 66 69 67 73 0a for runconfigs.
8a30: 09 20 28 6d 74 63 6f 6e 66 69 67 20 28 6f 72 20 . (mtconfig (or
8a40: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
8a50: 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 74 65 config") "megate
8a60: 73 74 2e 63 6f 6e 66 69 67 22 29 29 20 3b 3b 20 st.config")) ;;
8a70: 61 6c 6c 6f 77 20 6f 76 65 72 72 69 64 69 6e 67 allow overriding
8a80: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
8a90: 20 0a 09 20 28 72 75 6e 64 69 72 20 20 20 28 69 .. (rundir (i
8aa0: 66 20 28 61 6e 64 20 72 75 6e 6e 61 6d 65 20 74 f (and runname t
8ab0: 61 72 67 65 74 20 6c 69 6e 6b 74 72 65 65 29 28 arget linktree)(
8ac0: 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f conc linktree "/
8ad0: 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e " target "/" run
8ae0: 6e 61 6d 65 29 20 23 66 29 29 0a 09 20 28 6d 74 name) #f)).. (mt
8af0: 63 61 63 68 65 66 20 28 61 6e 64 20 72 75 6e 64 cachef (and rund
8b00: 69 72 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 ir (conc rundir
8b10: 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 74 2e 63 "/" ".megatest.c
8b20: 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 2d 76 fg-" megatest-v
8b30: 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 ersion "-" megat
8b40: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 est-fossil-hash)
8b50: 29 29 0a 09 20 28 72 63 63 61 63 68 65 66 20 28 )).. (rccachef (
8b60: 61 6e 64 20 72 75 6e 64 69 72 20 28 63 6f 6e 63 and rundir (conc
8b70: 20 72 75 6e 64 69 72 20 22 2f 22 20 22 2e 72 75 rundir "/" ".ru
8b80: 6e 63 6f 6e 66 69 67 73 2e 63 66 67 2d 22 20 20 nconfigs.cfg-"
8b90: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
8ba0: 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f "-" megatest-fo
8bb0: 73 73 69 6c 2d 68 61 73 68 29 29 29 0a 09 20 28 ssil-hash))).. (
8bc0: 63 61 6e 63 72 65 61 74 65 20 28 61 6e 64 20 72 cancreate (and r
8bd0: 75 6e 64 69 72 20 28 66 69 6c 65 2d 65 78 69 73 undir (file-exis
8be0: 74 73 3f 20 72 75 6e 64 69 72 29 28 66 69 6c 65 ts? rundir)(file
8bf0: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 72 -write-access? r
8c00: 75 6e 64 69 72 29 29 29 29 0a 20 20 20 20 3b 3b undir)))). ;;
8c10: 20 28 70 72 69 6e 74 20 22 72 75 6e 6e 61 6d 65 (print "runname
8c20: 3a 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 74 61 : " runname " ta
8c30: 72 67 65 74 3a 20 22 20 74 61 72 67 65 74 20 22 rget: " target "
8c40: 20 6d 74 63 61 63 68 65 66 3a 20 22 20 6d 74 63 mtcachef: " mtc
8c50: 61 63 68 65 66 20 22 20 72 63 63 61 63 68 65 66 achef " rccachef
8c60: 3a 20 22 20 72 63 63 61 63 68 65 66 29 0a 20 20 : " rccachef).
8c70: 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 (set! *toppath
8c80: 2a 20 74 6f 70 70 61 74 68 29 20 3b 3b 20 54 68 * toppath) ;; Th
8c90: 69 73 20 69 73 20 6e 65 65 64 65 64 20 77 68 65 is is needed whe
8ca0: 6e 20 77 65 20 61 72 65 20 72 75 6e 6e 69 6e 67 n we are running
8cb0: 20 61 73 20 61 20 74 65 73 74 20 75 73 69 6e 67 as a test using
8cc0: 20 43 4d 44 49 4e 46 4f 20 61 73 20 61 20 64 61 CMDINFO as a da
8cd0: 74 61 73 6f 75 72 63 65 0a 20 20 20 20 28 63 6f tasource. (co
8ce0: 6e 64 0a 20 20 20 20 20 3b 3b 20 64 61 74 61 20 nd. ;; data
8cf0: 77 61 73 20 72 65 61 64 20 61 6e 64 20 63 61 63 was read and cac
8d00: 68 65 64 20 61 6e 64 20 61 76 61 69 6c 61 62 6c hed and availabl
8d10: 65 20 69 6e 20 2a 63 6f 6e 66 69 67 73 74 61 74 e in *configstat
8d20: 75 73 2a 2c 20 74 6f 70 70 61 74 68 20 68 61 73 us*, toppath has
8d30: 20 61 6c 72 65 61 64 79 20 62 65 65 6e 20 73 65 already been se
8d40: 74 0a 20 20 20 20 20 28 28 65 71 3f 20 2a 63 6f t. ((eq? *co
8d50: 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 6c nfigstatus* 'ful
8d60: 6c 64 61 74 61 29 0a 20 20 20 20 20 20 2a 74 6f ldata). *to
8d70: 70 70 61 74 68 2a 29 0a 20 20 20 20 20 3b 3b 20 ppath*). ;;
8d80: 69 66 20 6d 74 63 61 63 68 65 66 20 65 78 69 73 if mtcachef exis
8d90: 74 73 20 6a 75 73 74 20 72 65 61 64 20 69 74 2c ts just read it,
8da0: 20 68 6f 77 65 76 65 72 20 77 65 20 6e 65 65 64 however we need
8db0: 20 74 6f 20 61 73 73 75 6d 65 20 74 6f 70 70 61 to assume toppa
8dc0: 74 68 20 69 73 20 61 76 61 69 6c 61 62 6c 65 20 th is available
8dd0: 69 6e 20 24 4d 54 5f 52 55 4e 5f 41 52 45 41 5f in $MT_RUN_AREA_
8de0: 48 4f 4d 45 0a 20 20 20 20 20 28 28 61 6e 64 20 HOME. ((and
8df0: 6d 74 63 61 63 68 65 66 20 28 66 69 6c 65 2d 65 mtcachef (file-e
8e00: 78 69 73 74 73 3f 20 6d 74 63 61 63 68 65 66 29 xists? mtcachef)
8e10: 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e (get-environmen
8e20: 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 t-variable "MT_R
8e30: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 0a UN_AREA_HOME")).
8e40: 20 20 20 20 20 20 28 73 65 74 21 20 2a 63 6f 6e (set! *con
8e50: 66 69 67 64 61 74 2a 20 20 20 20 28 63 6f 6e 66 figdat* (conf
8e60: 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 6d igf:read-alist m
8e70: 74 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 20 tcachef)).
8e80: 28 73 65 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 (set! *runconfig
8e90: 64 61 74 2a 20 28 63 6f 6e 66 69 67 66 3a 72 65 dat* (configf:re
8ea0: 61 64 2d 61 6c 69 73 74 20 72 63 63 61 63 68 65 ad-alist rccache
8eb0: 66 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 f)). (set!
8ec0: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 20 20 28 *configinfo* (
8ed0: 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a list *configdat*
8ee0: 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 (get-environme
8ef0: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f nt-variable "MT_
8f00: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 RUN_AREA_HOME"))
8f10: 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a 63 ). (set! *c
8f20: 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 onfigstatus* 'fu
8f30: 6c 6c 64 61 74 61 29 0a 20 20 20 20 20 20 28 73 lldata). (s
8f40: 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 et! *toppath*
8f50: 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d (get-environm
8f60: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
8f70: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
8f80: 29 0a 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 ). *toppath
8f90: 2a 29 0a 20 20 20 20 20 3b 3b 20 77 65 20 68 61 *). ;; we ha
8fa0: 76 65 20 61 6c 6c 20 74 68 65 20 69 6e 66 6f 20 ve all the info
8fb0: 6e 65 65 64 65 64 20 74 6f 20 66 75 6c 6c 79 20 needed to fully
8fc0: 70 72 6f 63 65 73 73 20 72 75 6e 63 6f 6e 66 69 process runconfi
8fd0: 67 73 20 61 6e 64 20 6d 65 67 61 74 65 73 74 2e gs and megatest.
8fe0: 63 6f 6e 66 69 67 0a 20 20 20 20 20 28 6d 74 63 config. (mtc
8ff0: 61 63 68 65 66 20 20 20 20 20 20 20 20 20 20 20 achef
9000: 20 20 20 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 . (let*
9010: 28 28 66 69 72 73 74 2d 70 61 73 73 20 20 20 20 ((first-pass
9020: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c
9030: 6f 6e 66 69 67 20 20 20 20 20 20 20 20 3b 3b 20 onfig ;;
9040: 4e 42 2f 2f 20 73 65 74 73 20 4d 54 5f 52 55 4e NB// sets MT_RUN
9050: 5f 41 52 45 41 5f 48 4f 4d 45 20 61 73 20 73 69 _AREA_HOME as si
9060: 64 65 20 65 66 66 65 63 74 0a 09 09 09 20 20 20 de effect....
9070: 20 20 20 20 20 20 20 20 20 20 6d 74 63 6f 6e 66 mtconf
9080: 69 67 0a 09 09 09 09 20 20 20 20 20 65 6e 76 69 ig..... envi
9090: 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f ron-patt: "env-o
90a0: 76 65 72 72 69 64 65 22 0a 09 09 09 09 20 20 20 verride".....
90b0: 20 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a given-toppath:
90c0: 20 74 6f 70 70 61 74 68 0a 09 09 09 09 20 20 20 toppath.....
90d0: 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d pathenvvar: "M
90e0: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
90f0: 29 29 0a 09 20 20 20 20 20 28 66 69 72 73 74 2d )).. (first-
9100: 72 75 6e 64 61 74 20 20 28 6c 65 74 20 28 28 74 rundat (let ((t
9110: 6f 70 70 61 74 68 20 28 69 66 20 74 6f 70 70 61 oppath (if toppa
9120: 74 68 20 0a 09 09 09 09 09 20 20 20 20 20 20 20 th ......
9130: 74 6f 70 70 61 74 68 0a 09 09 09 09 09 20 20 20 toppath......
9140: 20 20 20 20 28 63 61 72 20 66 69 72 73 74 2d 70 (car first-p
9150: 61 73 73 29 29 29 29 0a 09 09 09 20 20 20 20 20 ass))))....
9160: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 3b 3b (read-config ;;
9170: 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 22 (conc toppath "
9180: 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 /runconfigs.conf
9190: 69 67 22 29 0a 09 09 09 20 20 20 20 20 20 20 28 ig").... (
91a0: 63 6f 6e 63 20 28 69 66 20 28 73 74 72 69 6e 67 conc (if (string
91b0: 3f 20 74 6f 70 70 61 74 68 29 0a 09 09 09 09 09 ? toppath)......
91c0: 20 74 6f 70 70 61 74 68 0a 09 09 09 09 09 20 28 toppath...... (
91d0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
91e0: 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e variable "MT_RUN
91f0: 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 0a 09 09 _AREA_HOME"))...
9200: 09 09 20 20 20 20 20 22 2f 72 75 6e 63 6f 6e 66 .. "/runconf
9210: 69 67 73 2e 63 6f 6e 66 69 67 22 29 0a 09 09 09 igs.config")....
9220: 20 20 20 20 20 20 20 2a 72 75 6e 63 6f 6e 66 69 *runconfi
9230: 67 64 61 74 2a 20 23 74 20 0a 09 09 09 20 20 20 gdat* #t ....
9240: 20 20 20 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 sections: se
9250: 63 74 69 6f 6e 73 29 29 29 29 0a 09 28 73 65 74 ctions))))..(set
9260: 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a ! *runconfigdat*
9270: 20 66 69 72 73 74 2d 72 75 6e 64 61 74 29 0a 09 first-rundat)..
9280: 28 69 66 20 66 69 72 73 74 2d 70 61 73 73 20 20 (if first-pass
9290: 3b 3b 20 0a 09 20 20 20 20 28 62 65 67 69 6e 0a ;; .. (begin.
92a0: 09 20 20 20 20 20 20 28 73 65 74 21 20 2a 63 6f . (set! *co
92b0: 6e 66 69 67 64 61 74 2a 20 20 28 63 61 72 20 66 nfigdat* (car f
92c0: 69 72 73 74 2d 70 61 73 73 29 29 0a 09 20 20 20 irst-pass))..
92d0: 20 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 (set! *config
92e0: 69 6e 66 6f 2a 20 66 69 72 73 74 2d 70 61 73 73 info* first-pass
92f0: 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 2a ).. (set! *
9300: 74 6f 70 70 61 74 68 2a 20 20 20 20 28 6f 72 20 toppath* (or
9310: 74 6f 70 70 61 74 68 20 28 63 61 64 72 20 66 69 toppath (cadr fi
9320: 72 73 74 2d 70 61 73 73 29 29 29 20 3b 3b 20 75 rst-pass))) ;; u
9330: 73 65 20 74 68 65 20 67 61 74 68 65 72 65 64 20 se the gathered
9340: 64 61 74 61 20 75 6e 6c 65 73 73 20 61 6c 72 65 data unless alre
9350: 61 64 79 20 68 61 76 65 20 69 74 0a 09 20 20 20 ady have it..
9360: 20 20 20 28 73 65 74 21 20 74 6f 70 70 61 74 68 (set! toppath
9370: 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 *toppath*)
9380: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
9390: 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 20 20 *toppath*)...
93a0: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 28 64 65 (begin... (de
93b0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
93c0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
93d0: 6f 72 74 2a 20 22 79 6f 75 20 61 72 65 20 6e 6f ort* "you are no
93e0: 74 20 69 6e 20 61 20 6d 65 67 61 74 65 73 74 20 t in a megatest
93f0: 61 72 65 61 21 22 29 0a 09 09 20 20 20 20 28 65 area!")... (e
9400: 78 69 74 20 31 29 29 29 0a 09 20 20 20 20 20 20 xit 1)))..
9410: 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f (setenv "MT_RUN_
9420: 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 AREA_HOME" *topp
9430: 61 74 68 2a 29 0a 09 20 20 20 20 20 20 3b 3b 20 ath*).. ;;
9440: 74 68 65 20 73 65 65 64 20 72 65 61 64 20 69 73 the seed read is
9450: 20 64 6f 6e 65 2c 20 6e 6f 77 20 72 65 61 64 20 done, now read
9460: 72 75 6e 63 6f 6e 66 69 67 73 2c 20 63 61 63 68 runconfigs, cach
9470: 65 20 69 74 20 74 68 65 6e 20 72 65 61 64 20 6d e it then read m
9480: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 6f egatest.config o
9490: 6e 65 20 6d 6f 72 65 20 74 69 6d 65 20 61 6e 64 ne more time and
94a0: 20 63 61 63 68 65 20 69 74 0a 09 20 20 20 20 20 cache it..
94b0: 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 (let* ((keys
94c0: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b (rmt:get-k
94d0: 65 79 73 29 29 0a 09 09 20 20 20 20 20 28 6b 65 eys))... (ke
94e0: 79 2d 76 61 6c 73 20 20 20 20 20 28 6b 65 79 73 y-vals (keys
94f0: 3a 74 61 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 :target->keyval
9500: 6b 65 79 73 20 74 61 72 67 65 74 29 29 0a 09 09 keys target))...
9510: 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 20 (linktree
9520: 20 20 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 (or (getenv "
9530: 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 0a 09 09 MT_LINKTREE")...
9540: 09 09 20 20 20 20 20 20 20 28 69 66 20 2a 63 6f .. (if *co
9550: 6e 66 69 67 64 61 74 2a 20 28 63 6f 6e 66 69 67 nfigdat* (config
9560: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
9570: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
9580: 6e 6b 74 72 65 65 22 29 20 23 66 29 29 29 0a 09 nktree") #f)))..
9590: 09 20 20 20 20 20 28 73 65 63 6f 6e 64 2d 70 61 . (second-pa
95a0: 73 73 20 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 ss (find-and-re
95b0: 61 64 2d 63 6f 6e 66 69 67 0a 09 09 09 09 20 20 ad-config.....
95c0: 20 20 6d 74 63 6f 6e 66 69 67 0a 09 09 09 09 20 mtconfig.....
95d0: 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a environ-patt:
95e0: 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 0a "env-override".
95f0: 09 09 09 09 20 20 20 20 67 69 76 65 6e 2d 74 6f .... given-to
9600: 70 70 61 74 68 3a 20 74 6f 70 70 61 74 68 0a 09 ppath: toppath..
9610: 09 09 09 20 20 20 20 70 61 74 68 65 6e 76 76 61 ... pathenvva
9620: 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f r: "MT_RUN_AREA_
9630: 48 4f 4d 45 22 29 29 0a 09 09 20 20 20 20 20 28 HOME"))... (
9640: 72 75 6e 63 6f 6e 66 69 67 64 61 74 20 28 62 65 runconfigdat (be
9650: 67 69 6e 20 20 20 20 20 3b 3b 20 74 68 69 73 20 gin ;; this
9660: 72 65 61 64 20 6f 66 20 74 68 65 20 72 75 6e 63 read of the runc
9670: 6f 6e 66 69 67 73 20 77 69 6c 6c 20 73 65 65 20 onfigs will see
9680: 61 6e 79 20 61 64 6a 75 73 74 6d 65 6e 74 73 20 any adjustments
9690: 6d 61 64 65 20 62 79 20 72 65 2d 72 65 61 64 69 made by re-readi
96a0: 6e 67 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 ng megatest.conf
96b0: 69 67 0a 09 09 09 09 20 20 20 20 20 28 66 6f 72 ig..... (for
96c0: 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b -each (lambda (k
96d0: 74 29 0a 09 09 09 09 09 09 20 28 73 65 74 65 6e t)....... (seten
96e0: 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 v (car kt) (cadr
96f0: 20 6b 74 29 29 29 0a 09 09 09 09 09 20 20 20 20 kt)))......
9700: 20 20 20 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 key-vals)....
9710: 09 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 . (read-conf
9720: 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 ig (conc toppath
9730: 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f "/runconfigs.co
9740: 6e 66 69 67 22 29 20 2a 72 75 6e 63 6f 6e 66 69 nfig") *runconfi
9750: 67 64 61 74 2a 20 23 74 20 0a 09 09 09 09 09 09 gdat* #t .......
9760: 20 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 sections: sect
9770: 69 6f 6e 73 29 29 29 29 0a 09 09 28 69 66 20 63 ions))))...(if c
9780: 61 6e 63 72 65 61 74 65 20 28 63 6f 6e 66 69 67 ancreate (config
9790: 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 72 75 f:write-alist ru
97a0: 6e 63 6f 6e 66 69 67 64 61 74 20 72 63 63 61 63 nconfigdat rccac
97b0: 68 65 66 29 29 0a 09 09 28 73 65 74 21 20 2a 72 hef))...(set! *r
97c0: 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 72 75 6e unconfigdat* run
97d0: 63 6f 6e 66 69 67 64 61 74 29 0a 09 09 28 69 66 configdat)...(if
97e0: 20 63 61 6e 63 72 65 61 74 65 20 28 63 6f 6e 66 cancreate (conf
97f0: 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 igf:write-alist
9800: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 6d 74 63 61 *configdat* mtca
9810: 63 68 65 66 29 29 0a 09 09 28 69 66 20 63 61 6e chef))...(if can
9820: 63 72 65 61 74 65 20 28 73 65 74 21 20 2a 63 6f create (set! *co
9830: 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 6c nfigstatus* 'ful
9840: 6c 64 61 74 61 29 29 29 29 0a 09 20 20 20 20 3b ldata)))).. ;
9850: 3b 20 6e 6f 20 63 6f 6e 66 69 67 73 20 66 6f 75 ; no configs fou
9860: 6e 64 3f 20 73 68 6f 75 6c 64 20 6e 6f 74 20 68 nd? should not h
9870: 61 70 70 65 6e 20 62 75 74 20 6c 65 74 27 73 20 appen but let's
9880: 74 72 79 20 74 6f 20 72 65 63 6f 76 65 72 20 67 try to recover g
9890: 72 61 63 65 66 75 6c 6c 79 2c 20 72 65 74 75 72 racefully, retur
98a0: 6e 20 61 6e 20 65 6d 70 74 79 20 68 61 73 68 2d n an empty hash-
98b0: 74 61 62 6c 65 0a 09 20 20 20 20 28 73 65 74 21 table.. (set!
98c0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 28 6d 61 *configdat* (ma
98d0: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a ke-hash-table)).
98e0: 09 20 20 20 20 29 29 29 0a 20 20 20 20 20 3b 3b . ))). ;;
98f0: 20 65 6c 73 65 20 72 65 61 64 20 77 68 61 74 20 else read what
9900: 79 6f 75 20 63 61 6e 20 61 6e 64 20 73 65 74 20 you can and set
9910: 74 68 65 20 66 6c 61 67 20 61 63 63 6f 72 64 69 the flag accordi
9920: 6e 67 6c 79 0a 20 20 20 20 20 28 65 6c 73 65 0a ngly. (else.
9930: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 66 (let* ((cf
9940: 67 64 61 74 20 20 20 28 66 69 6e 64 2d 61 6e 64 gdat (find-and
9950: 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 0a 09 09 -read-config ...
9960: 09 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 .(or (args:get-a
9970: 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 6d rg "-config") "m
9980: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 egatest.config")
9990: 0a 09 09 09 65 6e 76 69 72 6f 6e 2d 70 61 74 74 ....environ-patt
99a0: 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 : "env-override"
99b0: 0a 09 09 09 67 69 76 65 6e 2d 74 6f 70 70 61 74 ....given-toppat
99c0: 68 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d h: (get-environm
99d0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
99e0: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
99f0: 0a 09 09 09 70 61 74 68 65 6e 76 76 61 72 3a 20 ....pathenvvar:
9a00: 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d "MT_RUN_AREA_HOM
9a10: 45 22 29 29 29 0a 09 28 69 66 20 63 66 67 64 61 E")))..(if cfgda
9a20: 74 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 74 t.. (let* ((t
9a30: 6f 70 70 61 74 68 20 20 28 6f 72 20 28 67 65 74 oppath (or (get
9a40: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
9a50: 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 iable "MT_RUN_AR
9a60: 45 41 5f 48 4f 4d 45 22 29 28 63 61 64 72 20 63 EA_HOME")(cadr c
9a70: 66 67 64 61 74 29 29 29 0a 09 09 20 20 20 28 72 fgdat)))... (r
9a80: 64 61 74 20 20 20 20 20 28 72 65 61 64 2d 63 6f dat (read-co
9a90: 6e 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 nfig (conc toppa
9aa0: 74 68 0a 09 09 09 09 09 09 22 2f 72 75 6e 63 6f th......."/runco
9ab0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 2a nfigs.config") *
9ac0: 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 23 74 runconfigdat* #t
9ad0: 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 sections: secti
9ae0: 6f 6e 73 29 29 29 0a 09 20 20 20 20 20 20 28 73 ons))).. (s
9af0: 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a et! *configinfo*
9b00: 20 20 20 63 66 67 64 61 74 29 0a 09 20 20 20 20 cfgdat)..
9b10: 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 (set! *configd
9b20: 61 74 2a 20 20 20 20 28 63 61 72 20 63 66 67 64 at* (car cfgd
9b30: 61 74 29 29 0a 09 20 20 20 20 20 20 28 73 65 74 at)).. (set
9b40: 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a ! *runconfigdat*
9b50: 20 72 64 61 74 29 0a 09 20 20 20 20 20 20 28 73 rdat).. (s
9b60: 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 et! *toppath*
9b70: 20 20 20 74 6f 70 70 61 74 68 29 0a 09 20 20 20 toppath)..
9b80: 20 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 (set! *config
9b90: 73 74 61 74 75 73 2a 20 27 70 61 72 74 69 61 6c status* 'partial
9ba0: 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
9bb0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
9bc0: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
9bd0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e ult-log-port* "N
9be0: 6f 20 22 20 6d 74 63 6f 6e 66 69 67 20 22 20 66 o " mtconfig " f
9bf0: 69 6c 65 20 66 6f 75 6e 64 2e 20 47 69 76 69 6e ile found. Givin
9c00: 67 20 75 70 2e 22 29 0a 09 20 20 20 20 20 20 28 g up.").. (
9c10: 65 78 69 74 20 32 29 29 29 29 29 29 0a 20 20 20 exit 2)))))).
9c20: 20 3b 3b 20 61 64 64 69 74 69 6f 6e 61 6c 20 68 ;; additional h
9c30: 6f 75 73 65 20 6b 65 65 70 69 6e 67 0a 20 20 20 ouse keeping.
9c40: 20 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 74 72 65 (let* ((linktre
9c50: 65 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 4d e (or (getenv "M
9c60: 54 5f 4c 49 4e 4b 54 52 45 45 22 29 0a 09 09 09 T_LINKTREE")....
9c70: 20 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a (if *configdat*
9c80: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
9c90: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
9ca0: 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 tup" "linktree")
9cb0: 20 23 66 29 29 29 29 0a 20 20 20 20 20 20 28 69 #f)))). (i
9cc0: 66 20 6c 69 6e 6b 74 72 65 65 0a 09 20 20 28 69 f linktree.. (i
9cd0: 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 f (not (file-exi
9ce0: 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a sts? linktree)).
9cf0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
9d00: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
9d10: 6e 73 0a 09 09 20 65 78 6e 0a 09 09 20 28 62 65 ns... exn... (be
9d20: 67 69 6e 0a 09 09 20 20 20 28 64 65 62 75 67 3a gin... (debug:
9d30: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
9d40: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
9d50: 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 65 6e 74 "Something went
9d60: 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 72 79 69 wrong when tryi
9d70: 6e 67 20 74 6f 20 63 72 65 61 74 65 20 6c 69 6e ng to create lin
9d80: 6b 74 72 65 65 20 64 69 72 20 61 74 20 22 20 6c ktree dir at " l
9d90: 69 6e 6b 74 72 65 65 29 0a 09 09 20 20 20 28 64 inktree)... (d
9da0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
9db0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9dc0: 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 " message: " ((c
9dd0: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
9de0: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
9df0: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 'message) exn)).
9e00: 09 09 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 .. (exit 1))..
9e10: 09 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 . (create-direct
9e20: 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 ory linktree #t)
9e30: 29 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 ))).. (begin..
9e40: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
9e50: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
9e60: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6c 69 6e 6b -log-port* "link
9e70: 74 72 65 65 20 6e 6f 74 20 64 65 66 69 6e 65 64 tree not defined
9e80: 20 69 6e 20 5b 73 65 74 75 70 5d 20 73 65 63 74 in [setup] sect
9e90: 69 6f 6e 20 6f 66 20 6d 65 67 61 74 65 73 74 2e ion of megatest.
9ea0: 63 6f 6e 66 69 67 22 29 0a 09 20 20 20 20 3b 3b config").. ;;
9eb0: 20 28 65 78 69 74 20 31 29 0a 09 20 20 20 20 29 (exit 1).. )
9ec0: 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 )). (if (and
9ed0: 2a 74 6f 70 70 61 74 68 2a 0a 09 20 20 20 20 20 *toppath*..
9ee0: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
9ef0: 73 3f 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a 09 s? *toppath*))..
9f00: 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f (setenv "MT_RUN_
9f10: 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 AREA_HOME" *topp
9f20: 61 74 68 2a 29 0a 09 28 62 65 67 69 6e 0a 09 20 ath*)..(begin..
9f30: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
9f40: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
9f50: 6f 67 2d 70 6f 72 74 2a 20 22 66 61 69 6c 65 64 og-port* "failed
9f60: 20 74 6f 20 66 69 6e 64 20 74 68 65 20 74 6f 70 to find the top
9f70: 20 70 61 74 68 20 74 6f 20 79 6f 75 72 20 4d 65 path to your Me
9f80: 67 61 74 65 73 74 20 61 72 65 61 2e 22 29 29 29 gatest area.")))
9f90: 0a 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 29 . *toppath*))
9fa0: 0a 0a 28 64 65 66 69 6e 65 20 6c 61 75 6e 63 68 ..(define launch
9fb0: 3a 73 65 74 75 70 20 6c 61 75 6e 63 68 3a 73 65 :setup launch:se
9fc0: 74 75 70 2d 6e 65 77 29 0a 0a 28 64 65 66 69 6e tup-new)..(defin
9fd0: 65 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b e (get-best-disk
9fe0: 20 63 6f 6e 66 64 61 74 20 74 65 73 74 63 6f 6e confdat testcon
9ff0: 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 64 fig). (let* ((d
a000: 69 73 6b 73 20 20 20 28 6f 72 20 28 61 6e 64 20 isks (or (and
a010: 74 65 73 74 63 6f 6e 66 69 67 20 28 68 61 73 68 testconfig (hash
a020: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
a030: 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 64 lt testconfig "d
a040: 69 73 6b 73 22 20 23 66 29 29 0a 09 09 20 20 20 isks" #f))...
a050: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
a060: 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e 66 64 ef/default confd
a070: 61 74 20 22 64 69 73 6b 73 22 20 23 66 29 29 29 at "disks" #f)))
a080: 0a 09 20 28 6d 69 6e 73 70 61 63 65 20 28 6c 65 .. (minspace (le
a090: 74 20 28 28 6d 20 28 63 6f 6e 66 69 67 66 3a 6c t ((m (configf:l
a0a0: 6f 6f 6b 75 70 20 63 6f 6e 66 64 61 74 20 22 73 ookup confdat "s
a0b0: 65 74 75 70 22 20 22 6d 69 6e 73 70 61 63 65 22 etup" "minspace"
a0c0: 29 29 29 0a 09 09 20 20 20 20 20 28 73 74 72 69 )))... (stri
a0d0: 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 6d ng->number (or m
a0e0: 20 22 31 30 30 30 30 22 29 29 29 29 29 0a 20 20 "10000"))))).
a0f0: 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 28 6c (if disks ..(l
a100: 65 74 20 28 28 72 65 73 20 28 63 6f 6d 6d 6f 6e et ((res (common
a110: 3a 67 65 74 2d 64 69 73 6b 2d 77 69 74 68 2d 6d :get-disk-with-m
a120: 6f 73 74 2d 66 72 65 65 2d 73 70 61 63 65 20 64 ost-free-space d
a130: 69 73 6b 73 20 6d 69 6e 73 70 61 63 65 29 29 29 isks minspace)))
a140: 20 3b 3b 20 6d 69 6e 20 73 69 7a 65 20 6f 66 20 ;; min size of
a150: 31 30 30 30 2c 20 73 65 65 6d 73 20 74 61 64 20 1000, seems tad
a160: 64 75 6d 62 0a 09 20 20 28 69 66 20 72 65 73 0a dumb.. (if res.
a170: 09 20 20 20 20 20 20 28 63 64 72 20 72 65 73 29 . (cdr res)
a180: 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
a190: 09 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 .(if (common:low
a1a0: 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 20 32 30 20 -noise-print 20
a1b0: 22 4e 6f 20 76 61 6c 69 64 20 64 69 73 6b 73 20 "No valid disks
a1c0: 6f 72 20 6e 6f 20 64 69 73 6b 20 77 69 74 68 20 or no disk with
a1d0: 65 6e 6f 75 67 68 20 73 70 61 63 65 22 29 0a 09 enough space")..
a1e0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
a1f0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
a200: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f lt-log-port* "No
a210: 20 76 61 6c 69 64 20 64 69 73 6b 73 20 66 6f 75 valid disks fou
a220: 6e 64 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 63 nd in megatest.c
a230: 6f 6e 66 69 67 2e 20 50 6c 65 61 73 65 20 61 64 onfig. Please ad
a240: 64 20 73 6f 6d 65 20 74 6f 20 79 6f 75 72 20 5b d some to your [
a250: 64 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 61 disks] section a
a260: 6e 64 20 65 6e 73 75 72 65 20 74 68 65 20 64 69 nd ensure the di
a270: 72 65 63 74 6f 72 79 20 65 78 69 73 74 73 20 61 rectory exists a
a280: 6e 64 20 68 61 73 20 65 6e 6f 75 67 68 20 73 70 nd has enough sp
a290: 61 63 65 21 5c 6e 20 20 20 20 59 6f 75 20 63 61 ace!\n You ca
a2a0: 6e 20 63 68 61 6e 67 65 20 6d 69 6e 73 70 61 63 n change minspac
a2b0: 65 20 69 6e 20 74 68 65 20 5b 73 65 74 75 70 5d e in the [setup]
a2c0: 20 73 65 63 74 69 6f 6e 20 6f 66 20 6d 65 67 61 section of mega
a2d0: 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 43 75 72 test.config. Cur
a2e0: 72 65 6e 74 20 73 65 74 74 69 6e 67 20 69 73 3a rent setting is:
a2f0: 20 22 20 6d 69 6e 73 70 61 63 65 29 29 0a 09 09 " minspace))...
a300: 28 65 78 69 74 20 31 29 29 29 29 29 29 29 0a 0a (exit 1)))))))..
a310: 3b 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 63 ;; Desired direc
a320: 74 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a tory structure:.
a330: 3b 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e ;;.;; <linkdir>
a340: 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 - <target> - <t
a350: 65 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 estname> -..;;
a360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a380: 20 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 |.;;
a390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3a0: 20 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b v.;;
a3b0: 20 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c <rundir> - <
a3c0: 74 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 target> - <t
a3d0: 65 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 estname> -|- <it
a3e0: 65 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b empath(s)>.;;.;;
a3f0: 20 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 dir stored in
a400: 74 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 test is:.;; .;;
a410: 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 <linkdir> - <ta
a420: 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d rget> - <testnam
a430: 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 e> [ - <itempath
a440: 3e 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c > ].;; .;; All l
a450: 6f 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 og file links sh
a460: 6f 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 ould be stored r
a470: 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
a480: 6f 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a op of link path.
a490: 3b 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e ;; .;; <target>
a4a0: 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 - <testname> [
a4b0: 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a - <itempath> ] .
a4c0: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 ;;.(define (crea
a4d0: 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e te-work-area run
a4e0: 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 -id run-info key
a4f0: 76 61 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 vals test-id tes
a500: 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d t-src-path disk-
a510: 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 path testname it
a520: 65 6d 64 61 74 20 23 21 6b 65 79 20 28 72 65 6d emdat #!key (rem
a530: 74 72 69 65 73 20 32 29 29 0a 20 20 28 6c 65 74 tries 2)). (let
a540: 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 * ((item-path (i
a550: 66 20 28 73 74 72 69 6e 67 3f 20 69 74 65 6d 64 f (string? itemd
a560: 61 74 29 20 69 74 65 6d 64 61 74 20 28 69 74 65 at) itemdat (ite
a570: 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
a580: 6d 64 61 74 29 29 29 20 3b 3b 20 69 66 20 70 61 mdat))) ;; if pa
a590: 73 73 20 69 6e 20 73 74 72 69 6e 67 20 2d 20 6a ss in string - j
a5a0: 75 73 74 20 75 73 65 20 69 74 0a 09 20 28 72 75 ust use it.. (ru
a5b0: 6e 6e 61 6d 65 20 20 20 28 69 66 20 28 73 74 72 nname (if (str
a5c0: 69 6e 67 3f 20 72 75 6e 2d 69 6e 66 6f 29 20 3b ing? run-info) ;
a5d0: 3b 20 69 66 20 77 65 20 70 61 73 73 20 69 6e 20 ; if we pass in
a5e0: 61 20 73 74 72 69 6e 67 20 61 73 20 72 75 6e 2d a string as run-
a5f0: 69 6e 66 6f 20 75 73 65 20 69 74 20 61 73 20 72 info use it as r
a600: 75 6e 2d 6e 61 6d 65 2e 0a 09 09 09 72 75 6e 2d un-name.....run-
a610: 69 6e 66 6f 0a 09 09 09 28 64 62 3a 67 65 74 2d info....(db:get-
a620: 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
a630: 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e (db:get-rows run
a640: 2d 69 6e 66 6f 29 0a 09 09 09 09 09 09 28 64 62 -info).......(db
a650: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d :get-header run-
a660: 69 6e 66 6f 29 0a 09 09 09 09 09 09 22 72 75 6e info)......."run
a670: 6e 61 6d 65 22 29 29 29 0a 09 20 3b 3b 20 63 6f name"))).. ;; co
a680: 6e 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 62 nvert back to db
a690: 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 : from rdb: - th
a6a0: 69 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 6e is is always run
a6b0: 20 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a 09 at server end..
a6c0: 20 28 74 61 72 67 65 74 20 20 20 28 73 74 72 69 (target (stri
a6d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
a6e0: 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 map cadr keyvals
a6f0: 29 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 2d ) "/"))... (not-
a700: 69 74 65 72 61 74 65 64 20 20 28 65 71 75 61 6c iterated (equal
a710: 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 29 29 ? "" item-path))
a720: 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 74 73 ... ;; all tests
a730: 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 3c 72 are found at <r
a740: 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 undir>/test-base
a750: 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 or <linkdir>/te
a760: 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 74 74 st-base.. (testt
a770: 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 74 61 op-base (conc ta
a780: 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 rget "/" runname
a790: 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a "/" testname)).
a7a0: 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 20 20 . (test-base
a7b0: 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d 62 61 (conc testtop-ba
a7c0: 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 se (if not-itera
a7d0: 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d ted "" "/") item
a7e0: 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 -path))... ;; nb
a7f0: 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 20 69 // if itempath i
a800: 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 69 74 s not "" then it
a810: 20 69 73 20 70 72 65 66 69 78 65 64 20 77 69 74 is prefixed wit
a820: 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 73 74 h "/".. (toptest
a830: 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 73 6b -path (conc disk
a840: 2d 70 61 74 68 20 22 2f 22 20 74 65 73 74 74 6f -path "/" testto
a850: 70 2d 62 61 73 65 29 29 0a 09 20 28 74 65 73 74 p-base)).. (test
a860: 2d 70 61 74 68 20 20 20 20 28 63 6f 6e 63 20 64 -path (conc d
a870: 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 73 isk-path "/" tes
a880: 74 2d 62 61 73 65 29 29 0a 0a 09 20 3b 3b 20 65 t-base))... ;; e
a890: 6e 73 75 72 65 20 74 68 69 73 20 65 78 69 73 74 nsure this exist
a8a0: 73 20 66 69 72 73 74 20 61 73 20 6c 69 6e 6b 73 s first as links
a8b0: 20 74 6f 20 73 75 62 74 65 73 74 73 20 6d 75 73 to subtests mus
a8c0: 74 20 62 65 20 63 72 65 61 74 65 64 20 74 68 65 t be created the
a8d0: 72 65 0a 09 20 28 6c 69 6e 6b 74 72 65 65 20 20 re.. (linktree
a8e0: 28 6c 65 74 20 28 28 72 64 20 28 63 6f 6e 66 69 (let ((rd (confi
a8f0: 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 g-lookup *config
a900: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
a910: 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 20 20 20 nktree")))...
a920: 20 20 20 28 69 66 20 72 64 20 72 64 20 28 63 6f (if rd rd (co
a930: 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 nc *toppath* "/r
a940: 75 6e 73 22 29 29 29 29 0a 0a 09 20 28 6c 6e 6b uns"))))... (lnk
a950: 62 61 73 65 20 20 20 28 63 6f 6e 63 20 6c 69 6e base (conc lin
a960: 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 74 ktree "/" target
a970: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 "/" runname))..
a980: 20 28 6c 6e 6b 70 61 74 68 20 20 20 28 63 6f 6e (lnkpath (con
a990: 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 74 65 c lnkbase "/" te
a9a0: 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 stname)).. (lnkp
a9b0: 61 74 68 66 20 20 28 63 6f 6e 63 20 6c 6e 6b 70 athf (conc lnkp
a9c0: 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 ath (if not-iter
a9d0: 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 ated "" "/") ite
a9e0: 6d 2d 70 61 74 68 29 29 0a 09 20 28 6c 6e 6b 74 m-path)).. (lnkt
a9f0: 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 arget (conc lnkp
aa00: 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 ath "/" item-pat
aa10: 68 29 29 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 h))).. ;; Upd
aa20: 61 74 65 20 74 68 65 20 72 75 6e 64 69 72 20 70 ate the rundir p
aa30: 61 74 68 20 69 6e 20 74 68 65 20 74 65 73 74 20 ath in the test
aa40: 72 65 63 6f 72 64 20 66 6f 72 20 61 6c 6c 2c 20 record for all,
aa50: 72 75 6e 64 69 72 3d 70 68 79 73 69 63 61 6c 2c rundir=physical,
aa60: 20 73 68 6f 72 74 64 69 72 3d 6c 6f 67 69 63 61 shortdir=logica
aa70: 6c 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 l. ;;
aa80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aaa0: 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 72 20 rundir
aab0: 20 20 73 68 6f 72 74 64 69 72 0a 20 20 20 20 28 shortdir. (
aac0: 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c rmt:general-call
aad0: 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 'test-set-rundi
aae0: 72 2d 73 68 6f 72 74 64 69 72 20 72 75 6e 2d 69 r-shortdir run-i
aaf0: 64 20 6c 6e 6b 70 61 74 68 66 20 74 65 73 74 2d d lnkpathf test-
ab00: 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 path testname it
ab10: 65 6d 2d 70 61 74 68 29 0a 0a 20 20 20 20 28 64 em-path).. (d
ab20: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
ab30: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
ab40: 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 20 20 20 6c "INFO:\n l
ab50: 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b 62 61 73 65 nkbase=" lnkbase
ab60: 20 22 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 70 61 "\n lnkpa
ab70: 74 68 3d 22 20 6c 6e 6b 70 61 74 68 20 22 5c 6e th=" lnkpath "\n
ab80: 20 20 74 6f 70 74 65 73 74 2d 70 61 74 68 3d 22 toptest-path="
ab90: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 22 5c toptest-path "\
aba0: 6e 20 20 20 20 20 74 65 73 74 2d 70 61 74 68 3d n test-path=
abb0: 22 20 74 65 73 74 2d 70 61 74 68 29 0a 20 20 20 " test-path).
abc0: 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d (if (not (file-
abd0: 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 exists? linktree
abe0: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
abf0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
ac00: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
ac10: 22 57 41 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 72 "WARNING: linktr
ac20: 65 65 20 64 69 64 20 6e 6f 74 20 65 78 69 73 74 ee did not exist
ac30: 21 20 43 72 65 61 74 69 6e 67 20 69 74 20 6e 6f ! Creating it no
ac40: 77 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 w at " linktree)
ac50: 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
ac60: 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 ctory linktree #
ac70: 74 29 29 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 t))) ;; (system
ac80: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
ac90: 22 20 6c 69 6e 6b 74 72 65 65 29 29 29 29 0a 20 " linktree)))).
aca0: 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 65 ;; create the
acb0: 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 74 directory for t
acc0: 68 65 20 74 65 73 74 73 20 64 69 72 20 6c 69 6e he tests dir lin
acd0: 6b 73 2c 20 74 68 69 73 20 69 73 20 6e 65 65 64 ks, this is need
ace0: 65 64 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 ed no matter wha
acf0: 74 2e 2e 2e 0a 20 20 20 20 28 69 66 20 28 61 6e t.... (if (an
ad00: 64 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 d (not (director
ad10: 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 y-exists? lnkbas
ad20: 65 29 29 0a 09 20 20 20 20 20 28 6e 6f 74 20 28 e)).. (not (
ad30: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b file-exists? lnk
ad40: 62 61 73 65 29 29 29 0a 09 28 68 61 6e 64 6c 65 base)))..(handle
ad50: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 -exceptions.. ex
ad60: 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 n.. (begin.. (
ad70: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
ad80: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
ad90: 2d 70 6f 72 74 2a 20 22 50 72 6f 62 6c 65 6d 20 -port* "Problem
ada0: 63 72 65 61 74 69 6e 67 20 6c 69 6e 6b 74 72 65 creating linktre
adb0: 65 20 62 61 73 65 20 61 74 20 22 20 6c 6e 6b 62 e base at " lnkb
adc0: 61 73 65 29 0a 09 20 20 20 28 70 72 69 6e 74 2d ase).. (print-
add0: 65 72 72 6f 72 2d 6d 65 73 73 61 67 65 20 65 78 error-message ex
ade0: 6e 20 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 n (current-error
adf0: 2d 70 6f 72 74 29 29 29 0a 09 20 28 63 72 65 61 -port))).. (crea
ae00: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b te-directory lnk
ae10: 62 61 73 65 20 23 74 29 29 29 0a 20 20 20 20 0a base #t))). .
ae20: 20 20 20 20 3b 3b 20 75 70 64 61 74 65 20 74 68 ;; update th
ae30: 65 20 74 6f 70 74 65 73 74 20 72 65 63 6f 72 64 e toptest record
ae40: 20 77 69 74 68 20 69 74 73 20 6c 6f 63 61 74 69 with its locati
ae50: 6f 6e 20 72 75 6e 64 69 72 2c 20 63 61 63 68 65 on rundir, cache
ae60: 20 74 68 65 20 70 61 74 68 0a 20 20 20 20 3b 3b the path. ;;
ae70: 20 54 68 69 73 20 77 61 73 73 20 68 69 67 68 6c This wass highl
ae80: 79 20 69 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f y inefficient, o
ae90: 6e 65 20 64 62 20 77 72 69 74 65 20 66 6f 72 20 ne db write for
aea0: 65 76 65 72 79 20 73 75 62 74 65 73 74 2c 20 70 every subtest, p
aeb0: 6f 74 65 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b otentially. ;
aec0: 3b 20 74 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 ; thousands of u
aed0: 6e 6e 65 63 65 73 73 61 72 79 20 75 70 64 61 74 nnecessary updat
aee0: 65 73 2c 20 63 61 63 68 65 20 74 68 65 20 66 61 es, cache the fa
aef0: 63 74 20 69 74 20 77 61 73 20 73 65 74 20 61 6e ct it was set an
af00: 64 20 64 6f 6e 27 74 20 73 65 74 20 69 74 20 0a d don't set it .
af10: 20 20 20 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a ;; again. ..
af20: 20 20 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 ;; Now creat
af30: 65 20 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 e the link from
af40: 74 68 65 20 74 65 73 74 20 70 61 74 68 20 74 6f the test path to
af50: 20 74 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 the link tree,
af60: 68 6f 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 however. ;; i
af70: 66 20 74 68 65 20 74 65 73 74 20 69 73 20 69 74 f the test is it
af80: 65 72 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 erated it is nec
af90: 65 73 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 essary to create
afa0: 20 74 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 the parent path
afb0: 0a 20 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 . ;; to the i
afc0: 74 65 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 teration. use pa
afd0: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
afe0: 20 74 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 to trim the pat
aff0: 68 20 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 h by one. ;;
b000: 6c 65 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e level. (if (n
b010: 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 ot not-iterated)
b020: 20 3b 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 ;; i.e. iterate
b030: 64 0a 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 d..(let ((iterat
b040: 65 64 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 ed-parent (path
b050: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 name-directory (
b060: 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 conc lnkpath "/"
b070: 20 69 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 item-path))))..
b080: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
b090: 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
b0a0: 6f 67 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 69 og-port* "Creati
b0b0: 6e 67 20 69 74 65 72 61 74 65 64 20 70 61 72 65 ng iterated pare
b0c0: 6e 74 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 nt " iterated-pa
b0d0: 72 65 6e 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 rent).. (handle
b0e0: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 -exceptions..
b0f0: 65 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 exn.. (begin..
b100: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
b110: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
b120: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 lt-log-port* " F
b130: 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 ailed to create
b140: 64 69 72 65 63 74 6f 72 79 20 22 20 69 74 65 72 directory " iter
b150: 61 74 65 64 2d 70 61 72 65 6e 74 20 28 28 63 6f ated-parent ((co
b160: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
b170: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
b180: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c message) exn) ",
b190: 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 exiting")..
b1a0: 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 28 (exit 1)).. (
b1b0: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
b1c0: 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 iterated-parent
b1d0: 20 23 74 29 29 29 29 0a 0a 20 20 20 20 28 69 66 #t)))).. (if
b1e0: 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f (symbolic-link?
b1f0: 20 6c 6e 6b 70 61 74 68 29 20 0a 09 28 68 61 6e lnkpath) ..(han
b200: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
b210: 20 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 exn.. (begin..
b220: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
b230: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
b240: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c log-port* " Fail
b250: 65 64 20 74 6f 20 72 65 6d 6f 76 65 20 73 79 6d ed to remove sym
b260: 6c 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 link " lnkpath (
b270: 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
b280: 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
b290: 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
b2a0: 20 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 ", exiting")..
b2b0: 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 28 64 (exit 1)).. (d
b2c0: 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 70 61 elete-file lnkpa
b2d0: 74 68 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 th))).. (if (
b2e0: 6e 6f 74 20 28 6f 72 20 28 66 69 6c 65 2d 65 78 not (or (file-ex
b2f0: 69 73 74 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 ists? lnkpath)..
b300: 09 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b . (symbolic-link
b310: 3f 20 6c 6e 6b 70 61 74 68 29 29 29 0a 09 28 68 ? lnkpath)))..(h
b320: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
b330: 0a 09 20 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a .. exn.. (begin.
b340: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
b350: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
b360: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 t-log-port* " Fa
b370: 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 73 iled to create s
b380: 79 6d 6c 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 ymlink " lnkpath
b390: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
b3a0: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
b3b0: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
b3c0: 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 0a n) ", exiting").
b3d0: 09 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 . (exit 1))..
b3e0: 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 (create-symbolic
b3f0: 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 74 2d 70 61 -link toptest-pa
b400: 74 68 20 6c 6e 6b 70 61 74 68 29 29 29 0a 20 20 th lnkpath))).
b410: 20 20 0a 20 20 20 20 3b 3b 20 4e 42 20 2d 20 54 . ;; NB - T
b420: 68 69 73 20 77 61 73 20 6e 6f 74 20 77 6f 72 6b his was not work
b430: 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f 6d 65 ing right - some
b440: 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 20 6e top tests are n
b450: 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 20 70 ot getting the p
b460: 61 74 68 20 73 65 74 21 21 21 0a 20 20 20 20 3b ath set!!!. ;
b470: 3b 0a 20 20 20 20 3b 3b 20 44 6f 20 74 68 65 20 ;. ;; Do the
b480: 73 65 74 74 69 6e 67 20 6f 66 20 74 68 69 73 20 setting of this
b490: 72 65 63 6f 72 64 20 61 66 74 65 72 20 74 68 65 record after the
b4a0: 20 70 61 74 68 73 20 61 72 65 20 63 72 65 61 74 paths are creat
b4b0: 65 64 20 73 6f 20 74 68 61 74 20 74 68 65 20 73 ed so that the s
b4c0: 68 6f 72 74 64 69 72 20 63 61 6e 20 0a 20 20 20 hortdir can .
b4d0: 20 3b 3b 20 62 65 20 73 65 74 20 74 6f 20 74 68 ;; be set to th
b4e0: 65 20 72 65 61 6c 20 64 69 72 65 63 74 6f 72 79 e real directory
b4f0: 20 6c 6f 63 61 74 69 6f 6e 2e 20 54 68 69 73 20 location. This
b500: 69 73 20 73 61 66 65 72 20 66 6f 72 20 66 75 74 is safer for fut
b510: 75 72 65 20 63 6c 65 61 6e 20 75 70 20 69 66 20 ure clean up if
b520: 74 68 65 20 6c 69 6e 6b 0a 20 20 20 20 3b 3b 20 the link. ;;
b530: 74 72 65 65 20 69 73 20 64 61 6d 61 67 65 64 20 tree is damaged
b540: 6f 72 20 6c 6f 73 74 2e 0a 20 20 20 20 3b 3b 20 or lost.. ;;
b550: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 68 . (if (not (h
b560: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
b570: 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 74 2d 70 fault *toptest-p
b580: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 23 aths* testname #
b590: 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 f))..(let* ((tes
b5a0: 74 69 6e 66 6f 20 20 20 20 20 20 20 28 72 6d 74 tinfo (rmt
b5b0: 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 :get-test-info-b
b5c0: 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 y-id run-id test
b5d0: 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e 2d 69 64 -id)) ;; run-id
b5e0: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
b5f0: 61 74 68 29 29 0a 09 20 20 20 20 20 20 20 28 63 ath)).. (c
b600: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 20 28 69 urr-test-path (i
b610: 66 20 74 65 73 74 69 6e 66 6f 20 3b 3b 20 28 66 f testinfo ;; (f
b620: 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 68 20 2a iledb:get-path *
b630: 66 64 62 2a 0a 09 09 09 09 09 09 09 20 20 20 20 fdb*........
b640: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 70 61 74 68 ;; (db:get-path
b650: 20 64 62 73 74 72 75 63 74 0a 09 09 09 09 20 20 dbstruct.....
b660: 20 3b 3b 20 28 72 6d 74 3a 73 64 62 2d 71 72 79 ;; (rmt:sdb-qry
b670: 20 27 67 65 74 73 74 72 20 0a 09 09 09 09 20 20 'getstr .....
b680: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
b690: 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 20 3b ndir testinfo) ;
b6a0: 3b 20 29 20 3b 3b 20 29 0a 09 09 09 09 20 20 20 ; ) ;; ).....
b6b0: 23 66 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 #f))).. (hash-t
b6c0: 61 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 able-set! *topte
b6d0: 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 st-paths* testna
b6e0: 6d 65 20 63 75 72 72 2d 74 65 73 74 2d 70 61 74 me curr-test-pat
b6f0: 68 29 0a 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 h).. ;; NB// Wa
b700: 73 20 74 68 69 73 20 66 6f 72 20 74 68 65 20 74 s this for the t
b710: 65 73 74 20 6f 72 20 66 6f 72 20 74 68 65 20 70 est or for the p
b720: 61 72 65 6e 74 20 69 6e 20 61 6e 20 69 74 65 72 arent in an iter
b730: 61 74 65 64 20 74 65 73 74 3f 0a 09 20 20 28 72 ated test?.. (r
b740: 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 mt:general-call
b750: 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 'test-set-rundir
b760: 2d 73 68 6f 72 74 64 69 72 20 72 75 6e 2d 69 64 -shortdir run-id
b770: 20 6c 6e 6b 70 61 74 68 20 0a 09 09 09 20 20 20 lnkpath ....
b780: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
b790: 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 09 09 s? lnkpath).....
b7a0: 3b 3b 20 28 72 65 73 6f 6c 76 65 2d 70 61 74 68 ;; (resolve-path
b7b0: 6e 61 6d 65 20 6c 6e 6b 70 61 74 68 29 0a 09 09 name lnkpath)...
b7c0: 09 09 28 63 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 ..(common:nice-p
b7d0: 61 74 68 20 6c 6e 6b 70 61 74 68 29 0a 09 09 09 ath lnkpath)....
b7e0: 09 6c 6e 6b 70 61 74 68 29 0a 09 09 09 20 20 20 .lnkpath)....
b7f0: 20 74 65 73 74 6e 61 6d 65 20 22 22 29 0a 09 20 testname "")..
b800: 20 3b 3b 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c ;; (rmt:general
b810: 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d -call 'test-set-
b820: 72 75 6e 64 69 72 20 72 75 6e 2d 69 64 20 6c 6e rundir run-id ln
b830: 6b 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 22 kpath testname "
b840: 22 29 20 3b 3b 20 74 6f 70 74 65 73 74 2d 70 61 ") ;; toptest-pa
b850: 74 68 29 0a 09 20 20 28 69 66 20 28 6f 72 20 28 th).. (if (or (
b860: 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 2d 70 61 not curr-test-pa
b870: 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 28 64 69 th)... (not (di
b880: 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 rectory-exists?
b890: 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 0a toptest-path))).
b8a0: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
b8b0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
b8c0: 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
b8d0: 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 69 6e 67 -port* "Creating
b8e0: 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 " toptest-path
b8f0: 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c 6e 6b " and link " lnk
b900: 70 61 74 68 29 0a 09 09 28 68 61 6e 64 6c 65 2d path)...(handle-
b910: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 65 78 exceptions... ex
b920: 6e 0a 09 09 20 23 66 20 3b 3b 20 64 6f 6e 27 74 n... #f ;; don't
b930: 20 63 61 72 65 20 74 6f 20 63 61 74 63 68 20 61 care to catch a
b940: 6e 64 20 64 65 61 6c 20 77 69 74 68 20 65 72 72 nd deal with err
b950: 6f 72 73 20 68 65 72 65 20 66 6f 72 20 6e 6f 77 ors here for now
b960: 2e 0a 09 09 20 28 63 72 65 61 74 65 2d 64 69 72 .... (create-dir
b970: 65 63 74 6f 72 79 20 74 6f 70 74 65 73 74 2d 70 ectory toptest-p
b980: 61 74 68 20 23 74 29 29 0a 09 09 28 68 61 73 68 ath #t))...(hash
b990: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 6f 70 -table-set! *top
b9a0: 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 test-paths* test
b9b0: 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d 70 61 74 name toptest-pat
b9c0: 68 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 54 h))))).. ;; T
b9d0: 68 65 20 74 6f 70 74 65 73 74 20 70 61 74 68 20 he toptest path
b9e0: 68 61 73 20 62 65 65 6e 20 63 72 65 61 74 65 64 has been created
b9f0: 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 74 68 , the link to th
ba00: 65 20 74 65 73 74 20 69 6e 20 74 68 65 20 6c 69 e test in the li
ba10: 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 20 20 3b nktree has. ;
ba20: 3b 20 62 65 65 6e 20 63 72 65 61 74 65 64 2e 20 ; been created.
ba30: 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 69 73 20 Now, if this is
ba40: 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 an iterated test
ba50: 20 74 68 65 20 72 65 61 6c 20 74 65 73 74 20 64 the real test d
ba60: 69 72 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 ir must be creat
ba70: 65 64 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ed. (if (not
ba80: 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b not-iterated) ;;
ba90: 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 this is an iter
baa0: 61 74 65 64 20 74 65 73 74 0a 09 28 62 65 67 69 ated test..(begi
bab0: 6e 20 3b 3b 20 28 6c 65 74 20 28 28 6c 6e 6b 74 n ;; (let ((lnkt
bac0: 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 arget (conc lnkp
bad0: 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 ath "/" item-pat
bae0: 68 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 h))).. (debug:p
baf0: 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d rint 2 *default-
bb00: 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 65 74 74 69 log-port* "Setti
bb10: 6e 67 20 75 70 20 73 75 62 20 74 65 73 74 20 72 ng up sub test r
bb20: 75 6e 20 61 72 65 61 22 29 0a 09 20 20 28 64 65 un area").. (de
bb30: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
bb40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
bb50: 20 2d 20 63 72 65 61 74 69 6e 67 20 72 75 6e 20 - creating run
bb60: 61 72 65 61 20 69 6e 20 22 20 74 65 73 74 2d 70 area in " test-p
bb70: 61 74 68 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d ath).. (handle-
bb80: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 exceptions.. e
bb90: 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 xn.. (begin..
bba0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
bbb0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
bbc0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 t-log-port* " Fa
bbd0: 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 64 iled to create d
bbe0: 69 72 65 63 74 6f 72 79 20 22 20 74 65 73 74 2d irectory " test-
bbf0: 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e path ((condition
bc00: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
bc10: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
bc20: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
bc30: 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 g").. (exit
bc40: 31 29 29 0a 09 20 20 20 28 63 72 65 61 74 65 2d 1)).. (create-
bc50: 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 directory test-p
bc60: 61 74 68 20 23 74 29 29 0a 09 20 20 28 64 65 62 ath #t)).. (deb
bc70: 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
bc80: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 0a 09 ult-log-port* ..
bc90: 09 20 20 20 20 20 20 20 22 20 2d 20 63 72 65 61 . " - crea
bca0: 74 69 6e 67 20 6c 69 6e 6b 20 66 72 6f 6d 3a 20 ting link from:
bcb0: 22 20 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 22 " test-path "\n"
bcc0: 0a 09 09 20 20 20 20 20 20 20 22 20 20 20 20 20 ... "
bcd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6f to
bce0: 3a 20 22 20 6c 6e 6b 74 61 72 67 65 74 29 0a 0a : " lnktarget)..
bcf0: 09 20 20 3b 3b 20 49 66 20 74 68 65 72 65 20 69 . ;; If there i
bd00: 73 20 61 6c 72 65 61 64 79 20 61 20 73 79 6d 6c s already a syml
bd10: 69 6e 6b 20 64 65 6c 65 74 65 20 69 74 20 61 6e ink delete it an
bd20: 64 20 72 65 63 72 65 61 74 65 20 69 74 2e 0a 09 d recreate it...
bd30: 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
bd40: 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 ions.. exn..
bd50: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 64 (begin.. (d
bd60: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
bd70: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
bd80: 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 20 74 port* " Failed t
bd90: 6f 20 72 65 2d 63 72 65 61 74 65 20 6c 69 6e 6b o re-create link
bda0: 20 22 20 6c 6e 6b 74 61 72 67 65 74 20 28 28 63 " lnktarget ((c
bdb0: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
bdc0: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
bdd0: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 20 22 'message) exn) "
bde0: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 , exiting")..
bdf0: 20 20 28 65 78 69 74 29 29 0a 09 20 20 20 28 69 (exit)).. (i
be00: 66 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b f (symbolic-link
be10: 3f 20 6c 6e 6b 74 61 72 67 65 74 29 20 20 20 20 ? lnktarget)
be20: 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 6c 6e (delete-file ln
be30: 6b 74 61 72 67 65 74 29 29 0a 09 20 20 20 28 69 ktarget)).. (i
be40: 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 f (not (file-exi
be50: 73 74 73 3f 20 6c 6e 6b 74 61 72 67 65 74 29 29 sts? lnktarget))
be60: 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 (create-symboli
be70: 63 2d 6c 69 6e 6b 20 74 65 73 74 2d 70 61 74 68 c-link test-path
be80: 20 6c 6e 6b 74 61 72 67 65 74 29 29 29 29 29 0a lnktarget))))).
be90: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 64 . (if (not (d
bea0: 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 irectory? test-p
beb0: 61 74 68 29 29 0a 09 28 63 72 65 61 74 65 2d 64 ath))..(create-d
bec0: 69 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 irectory test-pa
bed0: 74 68 20 23 74 29 29 20 3b 3b 20 74 68 69 73 20 th #t)) ;; this
bee0: 69 73 20 61 20 68 61 63 6b 2c 20 49 20 64 6f 6e is a hack, I don
bef0: 27 74 20 6b 6e 6f 77 20 77 68 79 20 6f 75 74 20 't know why out
bf00: 6f 66 20 74 68 65 20 62 6c 75 65 20 74 68 69 73 of the blue this
bf10: 20 70 61 74 68 20 64 6f 65 73 20 6e 6f 74 20 65 path does not e
bf20: 78 69 73 74 20 73 6f 6d 65 74 69 6d 65 73 0a 0a xist sometimes..
bf30: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 65 73 (if (and tes
bf40: 74 2d 73 72 63 2d 70 61 74 68 20 28 64 69 72 65 t-src-path (dire
bf50: 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 61 74 68 ctory? test-path
bf60: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c ))..(begin.. (l
bf70: 65 74 2a 20 28 28 6f 76 72 63 6d 64 20 28 6c 65 et* ((ovrcmd (le
bf80: 74 20 28 28 63 6d 64 20 28 63 6f 6e 66 69 67 2d t ((cmd (config-
bf90: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
bfa0: 74 2a 20 22 73 65 74 75 70 22 20 22 74 65 73 74 t* "setup" "test
bfb0: 63 6f 70 79 63 6d 64 22 29 29 29 0a 09 09 09 20 copycmd")))....
bfc0: 20 20 28 69 66 20 63 6d 64 0a 09 09 09 20 20 20 (if cmd....
bfd0: 20 20 20 20 3b 3b 20 73 75 62 73 74 69 74 75 74 ;; substitut
bfe0: 65 20 74 68 65 20 54 45 53 54 5f 53 52 43 5f 50 e the TEST_SRC_P
bff0: 41 54 48 20 61 6e 64 20 54 45 53 54 5f 54 41 52 ATH and TEST_TAR
c000: 47 5f 50 41 54 48 0a 09 09 09 20 20 20 20 20 20 G_PATH....
c010: 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 (string-substit
c020: 75 74 65 20 22 54 45 53 54 5f 54 41 52 47 5f 50 ute "TEST_TARG_P
c030: 41 54 48 22 20 74 65 73 74 2d 70 61 74 68 0a 09 ATH" test-path..
c040: 09 09 09 09 09 20 20 28 73 74 72 69 6e 67 2d 73 ..... (string-s
c050: 75 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f ubstitute "TEST_
c060: 53 52 43 5f 50 41 54 48 22 20 74 65 73 74 2d 73 SRC_PATH" test-s
c070: 72 63 2d 70 61 74 68 20 63 6d 64 20 23 74 29 20 rc-path cmd #t)
c080: 23 74 29 0a 09 09 09 20 20 20 20 20 20 20 23 66 #t).... #f
c090: 29 29 29 0a 09 09 20 28 63 6d 64 20 20 20 20 28 )))... (cmd (
c0a0: 69 66 20 6f 76 72 63 6d 64 20 0a 09 09 09 20 20 if ovrcmd ....
c0b0: 20 20 20 6f 76 72 63 6d 64 0a 09 09 09 20 20 20 ovrcmd....
c0c0: 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d (conc "rsync -
c0d0: 61 76 22 20 28 69 66 20 28 64 65 62 75 67 3a 64 av" (if (debug:d
c0e0: 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 22 22 20 ebug-mode 1) ""
c0f0: 22 71 22 29 20 22 20 22 20 74 65 73 74 2d 73 72 "q") " " test-sr
c100: 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 73 74 c-path "/ " test
c110: 2d 70 61 74 68 20 22 2f 22 0a 09 09 09 09 20 20 -path "/".....
c120: 20 22 20 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 " >> " test-pat
c130: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
c140: 67 20 32 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 g 2>> " test-pat
c150: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
c160: 67 22 29 29 29 0a 09 09 20 28 73 74 61 74 75 73 g")))... (status
c170: 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a (system cmd))).
c180: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 . (if (not (e
c190: 71 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 09 q? status 0))...
c1a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
c1b0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
c1c0: 2a 20 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 * "ERROR: proble
c1d0: 6d 20 77 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c m with running \
c1e0: 22 22 20 63 6d 64 20 22 5c 22 22 29 29 29 0a 09 "" cmd "\"")))..
c1f0: 20 20 28 6c 69 73 74 20 6c 6e 6b 70 61 74 68 66 (list lnkpathf
c200: 20 6c 6e 6b 70 61 74 68 20 29 29 0a 09 28 69 66 lnkpath ))..(if
c210: 20 28 61 6e 64 20 74 65 73 74 2d 73 72 63 2d 70 (and test-src-p
c220: 61 74 68 20 28 3e 20 72 65 6d 74 72 69 65 73 20 ath (> remtries
c230: 30 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 0)).. (begin.
c240: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
c250: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
c260: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
c270: 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 65 Failed to create
c280: 20 77 6f 72 6b 20 61 72 65 61 20 61 74 20 22 20 work area at "
c290: 74 65 73 74 2d 70 61 74 68 20 22 20 77 69 74 68 test-path " with
c2a0: 20 6c 69 6e 6b 20 61 74 20 22 20 6c 6e 6b 74 61 link at " lnkta
c2b0: 72 67 65 74 20 22 2c 20 72 65 6d 61 69 6e 69 6e rget ", remainin
c2c0: 67 20 61 74 74 65 6d 70 74 73 20 22 20 72 65 6d g attempts " rem
c2d0: 74 72 69 65 73 29 0a 09 20 20 20 20 20 20 3b 3b tries).. ;;
c2e0: 20 0a 09 20 20 20 20 20 20 28 63 72 65 61 74 65 .. (create
c2f0: 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 2d 69 -work-area run-i
c300: 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 d run-info keyva
c310: 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d ls test-id test-
c320: 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 src-path disk-pa
c330: 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d th testname item
c340: 64 61 74 20 72 65 6d 74 72 69 65 73 3a 20 28 2d dat remtries: (-
c350: 20 72 65 6d 74 72 69 65 73 20 31 29 29 29 0a 09 remtries 1)))..
c360: 20 20 20 20 28 6c 69 73 74 20 23 66 20 23 66 29 (list #f #f)
c370: 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b ))))..;; 1. look
c380: 20 74 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 though disks li
c390: 73 74 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 st for disk with
c3a0: 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 most space.;; 2
c3b0: 2e 20 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 . create run dir
c3c0: 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e on disk, path n
c3d0: 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 ame is meaningfu
c3e0: 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c l.;; 3. create l
c3f0: 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 ink from run dir
c400: 20 74 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e to megatest run
c410: 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 s area .;; 4. re
c420: 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 motely run the t
c430: 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 est on allocated
c440: 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f host.;; - co
c450: 75 6c 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f uld be ssh to ho
c460: 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 st from hosts ta
c470: 62 6c 65 20 28 75 70 64 61 74 65 20 72 65 67 75 ble (update regu
c480: 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 larly with load)
c490: 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 .;; - could b
c4a0: 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 e netbatch.;;
c4b0: 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 (launch-test
c4c0: 64 62 20 28 63 61 64 72 20 73 74 61 74 75 73 29 db (cadr status)
c4d0: 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 test-conf)).(de
c4e0: 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 fine (launch-tes
c4f0: 74 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 t test-id run-id
c500: 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c run-info keyval
c510: 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 s runname test-c
c520: 6f 6e 66 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 onf test-name te
c530: 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 74 20 st-path itemdat
c540: 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 6e 67 params). (chang
c550: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
c560: 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 74 2d path*). (alist-
c570: 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e >env-vars ;; con
c580: 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f solidate this co
c590: 64 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 de with the code
c5a0: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d in megatest.scm
c5b0: 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a for "-execute".
c5c0: 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c 69 73 (list ;; (lis
c5d0: 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 t "MT_TEST_RUN_D
c5e0: 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 IR" work-area).
c5f0: 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e (list "MT_RUN
c600: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 _AREA_HOME" *top
c610: 70 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 73 74 path*). (list
c620: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
c630: 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 3b test-name). ;
c640: 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d ; (list "MT_ITEM
c650: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
c660: 6d 64 61 74 29 29 20 0a 20 20 20 20 28 6c 69 73 mdat)) . (lis
c670: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
c680: 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 3b 3b runname). ;;
c690: 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
c6a0: 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
c6b0: 0a 20 20 20 20 29 29 0a 20 20 28 6c 65 74 2a 20 . )). (let*
c6c0: 28 28 74 72 65 67 69 73 74 72 79 20 20 20 20 20 ((tregistry
c6d0: 20 20 28 74 65 73 74 73 3a 67 65 74 2d 61 6c 6c (tests:get-all
c6e0: 29 29 0a 09 20 28 69 74 65 6d 2d 70 61 74 68 20 )).. (item-path
c6f0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 70 20 (let ((ip
c700: 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 (item-list->path
c710: 20 69 74 65 6d 64 61 74 29 29 29 0a 09 09 09 20 itemdat)))....
c720: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
c730: 61 72 73 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ars (list (list
c740: 22 4d 54 5f 49 54 45 4d 50 41 54 48 22 20 69 70 "MT_ITEMPATH" ip
c750: 29 29 29 0a 09 09 09 20 20 20 20 69 70 29 29 0a ))).... ip)).
c760: 09 20 28 74 63 6f 6e 66 69 67 20 20 20 20 20 20 . (tconfig
c770: 20 20 20 28 6f 72 20 28 74 65 73 74 73 3a 67 65 (or (tests:ge
c780: 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 t-testconfig tes
c790: 74 2d 6e 61 6d 65 20 74 72 65 67 69 73 74 72 79 t-name tregistry
c7a0: 20 23 74 20 66 6f 72 63 65 2d 63 72 65 61 74 65 #t force-create
c7b0: 3a 20 23 74 29 0a 09 09 09 20 20 20 20 20 20 74 : #t).... t
c7c0: 65 73 74 2d 63 6f 6e 66 29 29 20 3b 3b 20 66 6f est-conf)) ;; fo
c7d0: 72 63 65 20 72 65 2d 72 65 61 64 20 6e 6f 77 20 rce re-read now
c7e0: 74 68 61 74 20 61 6c 6c 20 76 61 72 73 20 61 72 that all vars ar
c7f0: 65 20 73 65 74 0a 09 20 28 75 73 65 73 68 65 6c e set.. (useshel
c800: 6c 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 l (let ((
c810: 75 73 68 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b ush (config-look
c820: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
c830: 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 jobtools" "u
c840: 73 65 73 68 65 6c 6c 22 29 29 29 0a 09 09 09 20 seshell")))....
c850: 20 20 20 28 69 66 20 75 73 68 20 0a 09 09 09 09 (if ush .....
c860: 28 69 66 20 28 65 71 75 61 6c 3f 20 75 73 68 20 (if (equal? ush
c870: 22 6e 6f 22 29 20 3b 3b 20 6d 75 73 74 20 75 73 "no") ;; must us
c880: 65 20 22 6e 6f 22 20 74 6f 20 4e 4f 54 20 75 73 e "no" to NOT us
c890: 65 20 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 e shell.....
c8a0: 23 66 0a 09 09 09 09 20 20 20 20 75 73 68 29 0a #f..... ush).
c8b0: 09 09 09 09 23 74 29 29 29 20 20 20 20 20 3b 3b ....#t))) ;;
c8c0: 20 64 65 66 61 75 6c 74 20 69 73 20 79 65 73 0a default is yes.
c8d0: 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 20 20 . (runscript
c8e0: 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 (config-looku
c8f0: 70 20 74 63 6f 6e 66 69 67 20 20 20 22 73 65 74 p tconfig "set
c900: 75 70 22 20 20 20 20 20 20 20 20 22 72 75 6e 73 up" "runs
c910: 63 72 69 70 74 22 29 29 0a 09 20 28 65 7a 73 74 cript")).. (ezst
c920: 65 70 73 20 20 20 20 20 20 20 20 20 28 3e 20 28 eps (> (
c930: 6c 65 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 length (hash-tab
c940: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 le-ref/default t
c950: 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 config "ezsteps"
c960: 20 27 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f '())) 0)) ;; do
c970: 6e 27 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 n't send all the
c980: 20 73 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 steps, could be
c990: 20 62 69 67 0a 09 20 28 64 69 73 6b 73 70 61 63 big.. (diskspac
c9a0: 65 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d e (config-
c9b0: 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 lookup tconfig
c9c0: 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 "requirements"
c9d0: 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a 09 20 "diskspace"))..
c9e0: 28 6d 65 6d 6f 72 79 20 20 20 20 20 20 20 20 20 (memory
c9f0: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
ca00: 74 63 6f 6e 66 69 67 20 20 20 22 72 65 71 75 69 tconfig "requi
ca10: 72 65 6d 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 rements" "memory
ca20: 22 29 29 0a 09 20 28 68 6f 73 74 73 20 20 20 20 ")).. (hosts
ca30: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c (config-l
ca40: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
ca50: 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 * "jobtools"
ca60: 20 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 0a 09 "workhosts"))..
ca70: 20 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 (remote-megates
ca80: 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t (config-lookup
ca90: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
caa0: 74 75 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 tup" "executable
cab0: 22 29 29 0a 09 20 28 72 75 6e 2d 74 69 6d 65 2d ")).. (run-time-
cac0: 6c 69 6d 69 74 20 20 28 6f 72 20 28 63 6f 6e 66 limit (or (conf
cad0: 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 74 63 6f 6e igf:lookup tcon
cae0: 66 69 67 20 20 20 22 72 65 71 75 69 72 65 6d 65 fig "requireme
caf0: 6e 74 73 22 20 22 72 75 6e 74 69 6d 65 6c 69 6d nts" "runtimelim
cb00: 22 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e ").... (con
cb10: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 2a 63 6f figf:lookup *co
cb20: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
cb30: 20 22 72 75 6e 74 69 6d 65 6c 69 6d 22 29 29 29 "runtimelim")))
cb40: 0a 09 20 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 .. ;; FIXME SOME
cb50: 44 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f DAY: not good ho
cb60: 77 20 74 68 69 73 20 69 73 20 73 6f 20 6f 62 74 w this is so obt
cb70: 75 73 65 2c 20 74 68 69 73 20 68 61 63 6b 20 69 use, this hack i
cb80: 73 20 74 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 s to .. ;;
cb90: 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 allow
cba0: 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 running from das
cbb0: 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 20 hboard. Extract
cbc0: 74 68 65 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 the path.. ;;
cbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 6f fro
cbe0: 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 m the called meg
cbf0: 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 atest and conver
cc00: 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b t dashboard.. ;;
cc10: 20 20 20 20 20 20 20 20 20 20 20 20 20 09 20 20 .
cc20: 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 or dboard to meg
cc30: 61 74 65 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d atest.. (local-m
cc40: 65 67 61 74 65 73 74 20 20 28 6c 65 74 2a 20 28 egatest (let* (
cc50: 28 6c 6d 20 20 28 63 61 72 20 28 61 72 67 76 29 (lm (car (argv)
cc60: 29 29 0a 09 09 09 09 20 28 64 69 72 20 28 70 61 ))..... (dir (pa
cc70: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
cc80: 20 6c 6d 29 29 0a 09 09 09 09 20 28 65 78 65 20 lm))..... (exe
cc90: 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d (pathname-strip-
cca0: 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a directory lm))).
ccb0: 09 09 09 20 20 20 20 28 63 6f 6e 63 20 28 69 66 ... (conc (if
ccc0: 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 20 22 dir (conc dir "
ccd0: 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 28 63 /") "")..... (c
cce0: 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ase (string->sym
ccf0: 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 20 20 bol exe).....
cd00: 20 28 28 64 62 6f 61 72 64 29 20 20 20 20 22 2e ((dboard) ".
cd10: 2e 2f 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 ./megatest")....
cd20: 09 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 20 . ((mtest)
cd30: 20 20 22 2e 2e 2f 6d 65 67 61 74 65 73 74 22 29 "../megatest")
cd40: 0a 09 09 09 09 20 20 20 20 28 28 64 61 73 68 62 ..... ((dashb
cd50: 6f 61 72 64 29 20 22 6d 65 67 61 74 65 73 74 22 oard) "megatest"
cd60: 29 0a 09 09 09 09 20 20 20 20 28 65 6c 73 65 20 )..... (else
cd70: 65 78 65 29 29 29 29 29 0a 09 20 28 6c 61 75 6e exe))))).. (laun
cd80: 63 68 65 72 20 20 20 20 20 20 20 20 28 63 6f 6d cher (com
cd90: 6d 6f 6e 3a 67 65 74 2d 6c 61 75 6e 63 68 65 72 mon:get-launcher
cda0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 65 73 *configdat* tes
cdb0: 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 t-name item-path
cdc0: 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c 6f )) ;; (config-lo
cdd0: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
cde0: 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
cdf0: 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 20 28 "launcher")).. (
ce00: 74 65 73 74 2d 73 69 67 20 20 20 28 63 6f 6e 63 test-sig (conc
ce10: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
ce20: 74 73 75 69 74 65 2d 6e 61 6d 65 29 20 22 3a 22 tsuite-name) ":"
ce30: 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a 22 20 69 test-name ":" i
ce40: 74 65 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 69 tem-path)) ;; (i
ce50: 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
ce60: 74 65 6d 64 61 74 29 29 29 20 3b 3b 20 74 65 73 temdat))) ;; tes
ce70: 74 2d 70 61 74 68 20 69 73 20 74 68 65 20 66 75 t-path is the fu
ce80: 6c 6c 20 70 61 74 68 20 69 6e 63 6c 75 64 69 6e ll path includin
ce90: 67 20 74 68 65 20 69 74 65 6d 2d 70 61 74 68 0a g the item-path.
cea0: 09 20 28 77 6f 72 6b 2d 61 72 65 61 20 20 23 66 . (work-area #f
ceb0: 29 0a 09 20 28 74 6f 70 74 65 73 74 2d 77 6f 72 ).. (toptest-wor
cec0: 6b 2d 61 72 65 61 20 23 66 29 20 3b 3b 20 66 6f k-area #f) ;; fo
ced0: 72 20 69 74 65 72 61 74 65 64 20 74 65 73 74 73 r iterated tests
cee0: 20 74 68 65 20 74 6f 70 20 74 65 73 74 20 63 6f the top test co
cef0: 6e 74 61 69 6e 73 20 64 61 74 61 20 72 65 6c 65 ntains data rele
cf00: 76 61 6e 74 20 66 6f 72 20 61 6c 6c 0a 09 20 28 vant for all.. (
cf10: 64 69 73 6b 70 61 74 68 20 20 20 23 66 29 0a 09 diskpath #f)..
cf20: 20 28 63 6d 64 70 61 72 6d 73 20 20 20 23 66 29 (cmdparms #f)
cf30: 0a 09 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 23 .. (fullcmd #
cf40: 66 29 20 3b 3b 20 28 64 65 66 69 6e 65 20 61 20 f) ;; (define a
cf50: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
cf60: 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 string (lambda (
cf70: 29 28 77 72 69 74 65 20 78 29 29 29 29 0a 09 20 )(write x))))..
cf80: 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 (mt-bindir-path
cf90: 23 66 29 0a 09 20 28 74 65 73 74 69 6e 66 6f 20 #f).. (testinfo
cfa0: 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d (rmt:get-test-
cfb0: 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 info-by-id run-i
cfc0: 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6d d test-id)).. (m
cfd0: 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 69 6e t_target (strin
cfe0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
cff0: 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 29 ap cadr keyvals)
d000: 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d "/")).. (debug-
d010: 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 param (append (i
d020: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
d030: 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 "-debug") (list
d040: 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a "-debug" (args:
d050: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 get-arg "-debug"
d060: 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 )) '())....
d070: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
d080: 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
d090: 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
d0a0: 27 28 29 29 29 29 29 0a 0a 20 20 20 20 28 73 65 '())))).. (se
d0b0: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 50 41 54 tenv "MT_ITEMPAT
d0c0: 48 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 H" item-path).
d0d0: 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 (if hosts (set
d0e0: 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d ! hosts (string-
d0f0: 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 split hosts))).
d100: 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 ;; set the me
d110: 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c gatest to be cal
d120: 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 led on the remot
d130: 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 e host. (if (
d140: 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 not remote-megat
d150: 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 est)(set! remote
d160: 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d -megatest local-
d170: 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d megatest)) ;; "m
d180: 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 egatest")). (
d190: 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 set! mt-bindir-p
d1a0: 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 ath (pathname-di
d1b0: 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d rectory remote-m
d1c0: 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 egatest)). (i
d1d0: 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 f launcher (set!
d1e0: 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e launcher (strin
d1f0: 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 g-split launcher
d200: 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 ))). ;; set u
d210: 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 p the run work a
d220: 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 rea for this tes
d230: 74 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 t. (if (and (
d240: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 args:get-arg "-p
d250: 72 65 63 6c 65 61 6e 22 29 20 3b 3b 20 75 73 65 reclean") ;; use
d260: 72 20 68 61 73 20 72 65 71 75 65 73 74 65 64 20 r has requested
d270: 74 6f 20 70 72 65 63 6c 65 61 6e 20 66 6f 72 20 to preclean for
d280: 74 68 69 73 20 72 75 6e 0a 09 20 20 20 20 20 28 this run.. (
d290: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 64 62 3a not (member (db:
d2a0: 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 test-get-rundir
d2b0: 74 65 73 74 69 6e 66 6f 29 28 6c 69 73 74 20 22 testinfo)(list "
d2c0: 6e 2f 61 22 20 22 2f 74 6d 70 2f 62 61 64 6e 61 n/a" "/tmp/badna
d2d0: 6d 65 22 29 29 29 29 20 3b 3b 20 6e 2f 61 20 69 me")))) ;; n/a i
d2e0: 73 20 61 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 s a placeholder
d2f0: 61 6e 64 20 74 68 75 73 20 6e 6f 74 20 61 20 72 and thus not a r
d300: 65 61 64 20 64 69 72 0a 09 28 62 65 67 69 6e 0a ead dir..(begin.
d310: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
d320: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
d330: 6c 6f 67 2d 70 6f 72 74 2a 20 22 61 74 74 65 6d log-port* "attem
d340: 70 74 69 6e 67 20 74 6f 20 70 72 65 63 6c 65 61 pting to preclea
d350: 6e 20 64 69 72 65 63 74 6f 72 79 20 22 20 28 64 n directory " (d
d360: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
d370: 72 20 74 65 73 74 69 6e 66 6f 29 20 22 20 66 6f r testinfo) " fo
d380: 72 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e 61 r test " test-na
d390: 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 me "/" item-path
d3a0: 29 0a 09 20 20 28 72 75 6e 73 3a 72 65 6d 6f 76 ).. (runs:remov
d3b0: 65 2d 74 65 73 74 2d 64 69 72 65 63 74 6f 72 79 e-test-directory
d3c0: 20 74 65 73 74 69 6e 66 6f 20 27 72 65 6d 6f 76 testinfo 'remov
d3d0: 65 2d 64 61 74 61 2d 6f 6e 6c 79 29 29 29 20 3b e-data-only))) ;
d3e0: 3b 20 72 65 6d 6f 76 65 20 64 61 74 61 20 6f 6e ; remove data on
d3f0: 6c 79 2c 20 64 6f 20 6e 6f 74 20 70 65 72 74 75 ly, do not pertu
d400: 72 62 20 74 68 65 20 72 65 63 6f 72 64 0a 0a 20 rb the record..
d410: 20 20 20 3b 3b 20 70 72 65 76 65 6e 74 20 6f 76 ;; prevent ov
d420: 65 72 6c 61 70 70 69 6e 67 20 61 63 74 69 6f 6e erlapping action
d430: 73 20 2d 20 73 65 74 20 74 6f 20 4c 41 55 4e 43 s - set to LAUNC
d440: 48 45 44 20 61 73 20 65 61 72 6c 79 20 61 73 20 HED as early as
d450: 70 6f 73 73 69 62 6c 65 0a 20 20 20 20 3b 3b 0a possible. ;;.
d460: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
d470: 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d set-status! run-
d480: 69 64 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e id test-id "LAUN
d490: 43 48 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 CHED" "n/a" #f #
d4a0: 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 f) ;; (if launch
d4b0: 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d -results launch-
d4c0: 72 65 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 results "FAILED"
d4d0: 29 29 0a 20 20 20 20 28 72 6d 74 3a 72 6f 6c 6c )). (rmt:roll
d4e0: 2d 75 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f -up-pass-fail-co
d4f0: 75 6e 74 73 20 72 75 6e 2d 69 64 20 74 65 73 74 unts run-id test
d500: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
d510: 23 66 20 22 4c 41 55 4e 43 48 45 44 22 29 0a 20 #f "LAUNCHED").
d520: 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 61 74 (set! diskpat
d530: 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b h (get-best-disk
d540: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 63 6f *configdat* tco
d550: 6e 66 69 67 29 29 0a 20 20 20 20 28 69 66 20 64 nfig)). (if d
d560: 69 73 6b 70 61 74 68 0a 09 28 6c 65 74 20 28 28 iskpath..(let ((
d570: 64 61 74 20 20 28 63 72 65 61 74 65 2d 77 6f 72 dat (create-wor
d580: 6b 2d 61 72 65 61 20 72 75 6e 2d 69 64 20 72 75 k-area run-id ru
d590: 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 n-info keyvals t
d5a0: 65 73 74 2d 69 64 20 74 65 73 74 2d 70 61 74 68 est-id test-path
d5b0: 20 64 69 73 6b 70 61 74 68 20 74 65 73 74 2d 6e diskpath test-n
d5c0: 61 6d 65 20 69 74 65 6d 64 61 74 29 29 29 0a 09 ame itemdat)))..
d5d0: 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
d5e0: 61 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 20 a (car dat))..
d5f0: 28 73 65 74 21 20 74 6f 70 74 65 73 74 2d 77 6f (set! toptest-wo
d600: 72 6b 2d 61 72 65 61 20 28 63 61 64 72 20 64 61 rk-area (cadr da
d610: 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 t)).. (debug:pr
d620: 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 int-info 2 *defa
d630: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 ult-log-port* "U
d640: 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 61 20 22 sing work area "
d650: 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 28 62 work-area))..(b
d660: 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 77 6f egin.. (set! wo
d670: 72 6b 2d 61 72 65 61 20 28 63 6f 6e 63 20 74 65 rk-area (conc te
d680: 73 74 2d 70 61 74 68 20 22 2f 74 6d 70 5f 72 75 st-path "/tmp_ru
d690: 6e 22 29 29 0a 09 20 20 28 63 72 65 61 74 65 2d n")).. (create-
d6a0: 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 directory work-a
d6b0: 72 65 61 20 23 74 29 0a 09 20 20 28 64 65 62 75 rea #t).. (debu
d6c0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
d6d0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
d6e0: 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 77 RNING: No disk w
d6f0: 6f 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 69 ork area specifi
d700: 65 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e 20 ed - running in
d710: 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 6f the test directo
d720: 72 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 6e ry under tmp_run
d730: 22 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 63 "))). (set! c
d740: 6d 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 3a mdparms (base64:
d750: 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 0a 09 base64-encode ..
d760: 09 20 20 20 20 28 7a 33 3a 65 6e 63 6f 64 65 2d . (z3:encode-
d770: 62 75 66 66 65 72 20 0a 09 09 20 20 20 20 20 28 buffer ... (
d780: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
d790: 74 72 69 6e 67 0a 09 09 20 20 20 20 20 20 20 28 tring... (
d7a0: 6c 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 lambda () ;; (li
d7b0: 73 74 20 27 68 6f 73 74 73 20 20 20 20 20 68 6f st 'hosts ho
d7c0: 73 74 73 29 0a 09 09 09 20 28 77 72 69 74 65 20 sts).... (write
d7d0: 28 6c 69 73 74 20 28 6c 69 73 74 20 27 74 65 73 (list (list 'tes
d7e0: 74 70 61 74 68 20 20 74 65 73 74 2d 70 61 74 68 tpath test-path
d7f0: 29 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 )..... (lis
d800: 74 20 27 74 72 61 6e 73 70 6f 72 74 20 28 63 6f t 'transport (co
d810: 6e 63 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 nc *transport-ty
d820: 70 65 2a 29 29 0a 09 09 09 09 20 20 20 20 20 20 pe*)).....
d830: 3b 3b 20 28 6c 69 73 74 20 27 73 65 72 76 65 72 ;; (list 'server
d840: 69 6e 66 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f inf *server-info
d850: 2a 29 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 *)..... (li
d860: 73 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 st 'toppath *t
d870: 6f 70 70 61 74 68 2a 29 0a 09 09 09 09 20 20 20 oppath*).....
d880: 20 20 20 28 6c 69 73 74 20 27 77 6f 72 6b 2d 61 (list 'work-a
d890: 72 65 61 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 rea work-area)..
d8a0: 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 27 ... (list '
d8b0: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e test-name test-n
d8c0: 61 6d 65 29 20 0a 09 09 09 09 20 20 20 20 20 20 ame) .....
d8d0: 28 6c 69 73 74 20 27 72 75 6e 73 63 72 69 70 74 (list 'runscript
d8e0: 20 72 75 6e 73 63 72 69 70 74 29 20 0a 09 09 09 runscript) ....
d8f0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 27 72 75 . (list 'ru
d900: 6e 2d 69 64 20 20 20 20 72 75 6e 2d 69 64 20 20 n-id run-id
d910: 20 29 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 )..... (li
d920: 73 74 20 27 74 65 73 74 2d 69 64 20 20 20 74 65 st 'test-id te
d930: 73 74 2d 69 64 20 20 29 0a 09 09 09 09 20 20 20 st-id ).....
d940: 20 20 20 3b 3b 20 28 6c 69 73 74 20 27 69 74 65 ;; (list 'ite
d950: 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 68 m-path item-path
d960: 20 29 0a 09 09 09 09 20 20 20 20 20 20 28 6c 69 )..... (li
d970: 73 74 20 27 69 74 65 6d 64 61 74 20 20 20 69 74 st 'itemdat it
d980: 65 6d 64 61 74 20 20 29 0a 09 09 09 09 20 20 20 emdat ).....
d990: 20 20 20 28 6c 69 73 74 20 27 6d 65 67 61 74 65 (list 'megate
d9a0: 73 74 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 st remote-megat
d9b0: 65 73 74 29 0a 09 09 09 09 20 20 20 20 20 20 28 est)..... (
d9c0: 6c 69 73 74 20 27 65 7a 73 74 65 70 73 20 20 20 list 'ezsteps
d9d0: 65 7a 73 74 65 70 73 29 20 0a 09 09 09 09 20 20 ezsteps) .....
d9e0: 20 20 20 20 28 6c 69 73 74 20 27 74 61 72 67 65 (list 'targe
d9f0: 74 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a t mt_target).
da00: 09 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 .... (list
da10: 27 72 75 6e 74 6c 69 6d 20 20 20 28 69 66 20 72 'runtlim (if r
da20: 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 20 28 63 un-time-limit (c
da30: 6f 6d 6d 6f 6e 3a 68 6d 73 2d 73 74 72 69 6e 67 ommon:hms-string
da40: 2d 3e 73 65 63 6f 6e 64 73 20 72 75 6e 2d 74 69 ->seconds run-ti
da50: 6d 65 2d 6c 69 6d 69 74 29 20 23 66 29 29 0a 09 me-limit) #f))..
da60: 09 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 27 ... (list '
da70: 65 6e 76 2d 6f 76 72 64 20 20 28 68 61 73 68 2d env-ovrd (hash-
da80: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
da90: 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 t *configdat* "e
daa0: 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 27 28 29 nv-override" '()
dab0: 29 29 20 0a 09 09 09 09 20 20 20 20 20 20 28 6c )) ..... (l
dac0: 69 73 74 20 27 73 65 74 2d 76 61 72 73 20 20 28 ist 'set-vars (
dad0: 69 66 20 70 61 72 61 6d 73 20 28 68 61 73 68 2d if params (hash-
dae0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
daf0: 74 20 70 61 72 61 6d 73 20 22 2d 73 65 74 76 61 t params "-setva
db00: 72 73 22 20 23 66 29 29 29 0a 09 09 09 09 20 20 rs" #f))).....
db10: 20 20 20 20 28 6c 69 73 74 20 27 72 75 6e 6e 61 (list 'runna
db20: 6d 65 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 me runname)...
db30: 09 09 20 20 20 20 20 20 28 6c 69 73 74 20 27 6d .. (list 'm
db40: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 6d 74 t-bindir-path mt
db50: 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 29 -bindir-path))))
db60: 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 63 6c 65 )))).. ;; cle
db70: 61 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f an out step reco
db80: 72 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 rds from previou
db90: 73 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 s run if they ex
dba0: 69 73 74 0a 20 20 20 20 3b 3b 20 28 72 6d 74 3a ist. ;; (rmt:
dbb0: 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 70 delete-test-step
dbc0: 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 -records run-id
dbd0: 74 65 73 74 2d 69 64 29 0a 20 20 20 20 3b 3b 20 test-id). ;;
dbe0: 69 66 20 74 68 65 20 64 69 72 20 64 6f 65 73 20 if the dir does
dbf0: 6e 6f 74 20 65 78 69 73 74 20 77 65 20 6d 61 79 not exist we may
dc00: 20 68 61 76 65 20 61 20 69 74 65 6d 70 61 74 68 have a itempath
dc10: 20 77 68 65 72 65 20 69 6e 64 69 76 69 64 75 61 where individua
dc20: 6c 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 l variables are
dc30: 61 20 70 61 74 68 2c 20 6c 61 75 6e 63 68 20 61 a path, launch a
dc40: 6e 79 77 61 79 0a 20 20 20 20 28 69 66 20 28 66 nyway. (if (f
dc50: 69 6c 65 2d 65 78 69 73 74 73 3f 20 77 6f 72 6b ile-exists? work
dc60: 2d 61 72 65 61 29 0a 09 28 63 68 61 6e 67 65 2d -area)..(change-
dc70: 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 directory work-a
dc80: 72 65 61 29 29 20 3b 3b 20 73 6f 20 74 68 61 74 rea)) ;; so that
dc90: 20 6c 6f 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 log files from
dca0: 74 68 65 20 6c 61 75 6e 63 68 20 70 72 6f 63 65 the launch proce
dcb0: 73 73 20 64 6f 6e 27 74 20 63 6c 75 74 74 65 72 ss don't clutter
dcc0: 20 74 68 65 20 74 65 73 74 20 64 69 72 0a 20 20 the test dir.
dcd0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 61 (cond. ((a
dce0: 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 74 nd launcher host
dcf0: 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 73 s) ;; must be us
dd00: 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d 65 ing ssh hostname
dd10: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
dd20: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
dd30: 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 73 ncher (car hosts
dd40: 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 )(list remote-me
dd50: 67 61 74 65 73 74 20 22 2d 6d 22 20 74 65 73 74 gatest "-m" test
dd60: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
dd70: 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
dd80: 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b param))). ;;
dd90: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
dda0: 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 append launcher
ddb0: 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 (car hosts)(list
ddc0: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
ddd0: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
dde0: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 ute" cmdparms)))
ddf0: 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 ). (launcher
de00: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
de10: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
de20: 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f ncher (list remo
de30: 74 65 2d 6d 65 67 61 74 65 73 74 20 22 2d 6d 22 te-megatest "-m"
de40: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
de50: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 ute" cmdparms) d
de60: 65 62 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 ebug-param))).
de70: 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c ;; (set! full
de80: 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e cmd (append laun
de90: 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 cher (list remot
dea0: 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d e-megatest test-
deb0: 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 sig "-execute" c
dec0: 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 20 mdparms)))).
ded0: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 69 66 (else. (if
dee0: 20 28 6e 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 (not useshell)(
def0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
df00: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
df10: 20 22 57 41 52 4e 49 4e 47 3a 20 69 6e 74 65 72 "WARNING: inter
df20: 6e 61 6c 20 6c 61 75 6e 63 68 69 6e 67 20 77 69 nal launching wi
df30: 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 77 65 6c 6c ll not work well
df40: 20 77 69 74 68 6f 75 74 20 5c 22 75 73 65 73 68 without \"usesh
df50: 65 6c 6c 20 79 65 73 5c 22 20 69 6e 20 79 6f 75 ell yes\" in you
df60: 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 73 65 63 r [jobtools] sec
df70: 74 69 6f 6e 22 29 29 0a 20 20 20 20 20 20 28 73 tion")). (s
df80: 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
df90: 65 6e 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 end (list remote
dfa0: 2d 6d 65 67 61 74 65 73 74 20 22 2d 6d 22 20 74 -megatest "-m" t
dfb0: 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
dfc0: 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 62 e" cmdparms) deb
dfd0: 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 28 ug-param (list (
dfe0: 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 20 if useshell "&"
dff0: 22 22 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 "")))))). ;;
e000: 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c (set! fullcmd (l
e010: 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
e020: 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
e030: 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
e040: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 (if useshell "&
e050: 22 20 22 22 29 29 29 29 29 0a 20 20 20 20 28 69 " ""))))). (i
e060: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
e070: 22 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 66 "-xterm")(set! f
e080: 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 66 ullcmd (append f
e090: 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 ullcmd (list "-x
e0a0: 74 65 72 6d 22 29 29 29 29 0a 20 20 20 20 28 64 term")))). (d
e0b0: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 ebug:print 1 *de
e0c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
e0d0: 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 "Launching " wor
e0e0: 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 k-area). ;; s
e0f0: 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e et pre-launch-en
e100: 76 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c 61 v-vars before la
e110: 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 unching, keep th
e120: 65 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 61 e vars in prevva
e130: 6c 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 65 ls and put the e
e140: 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 nvionment back w
e150: 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 hen done. (de
e160: 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 bug:print 4 *def
e170: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
e180: 66 75 6c 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 fullcmd: " fullc
e190: 6d 64 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 md). (let* ((
e1a0: 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 commonprevvals (
e1b0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a alist->env-vars.
e1c0: 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 ... (hash-tab
e1d0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
e1e0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 2d configdat* "env-
e1f0: 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 29 29 override" '())))
e200: 0a 09 20 20 20 28 74 65 73 74 70 72 65 76 76 61 .. (testprevva
e210: 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 ls (alist->env
e220: 2d 76 61 72 73 0a 09 09 09 20 20 20 20 28 68 61 -vars.... (ha
e230: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
e240: 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 22 70 72 ault tconfig "pr
e250: 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 e-launch-env-ove
e260: 72 72 69 64 65 73 22 20 27 28 29 29 29 29 0a 09 rrides" '())))..
e270: 20 20 20 28 6d 69 73 63 70 72 65 76 76 61 6c 73 (miscprevvals
e280: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
e290: 61 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 ars ;; consolida
e2a0: 74 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 te this code wit
e2b0: 68 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 h the code in me
e2c0: 67 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 gatest.scm for "
e2d0: 2d 65 78 65 63 75 74 65 22 0a 09 09 09 20 20 20 -execute"....
e2e0: 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 (append (list (
e2f0: 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 list "MT_TEST_RU
e300: 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 N_DIR" work-area
e310: 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 )...... (list "
e320: 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 MT_TEST_NAME" te
e330: 73 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 st-name)......
e340: 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 (list "MT_ITEM_I
e350: 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 NFO" (conc itemd
e360: 61 74 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 at)) ...... (li
e370: 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 st "MT_RUNNAME"
e380: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 runname)......
e390: 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 (list "MT_TARG
e3a0: 45 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 ET" mt_target
e3b0: 29 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 )...... (list "
e3c0: 4d 54 5f 49 54 45 4d 50 41 54 48 22 20 20 69 74 MT_ITEMPATH" it
e3d0: 65 6d 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 em-path)......
e3e0: 29 0a 09 09 09 09 20 20 20 20 69 74 65 6d 64 61 )..... itemda
e3f0: 74 29 29 29 0a 09 20 20 20 3b 3b 20 4c 61 75 6e t))).. ;; Laun
e400: 63 68 77 61 69 74 20 64 65 66 61 75 6c 74 73 20 chwait defaults
e410: 74 6f 20 74 72 75 65 2c 20 6d 75 73 74 20 6f 76 to true, must ov
e420: 65 72 72 69 64 65 20 69 74 20 74 6f 20 74 75 72 erride it to tur
e430: 6e 20 6f 66 66 20 77 61 69 74 0a 09 20 20 20 28 n off wait.. (
e440: 6c 61 75 6e 63 68 77 61 69 74 20 20 20 20 20 28 launchwait (
e450: 69 66 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 if (equal? (conf
e460: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
e470: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
e480: 6c 61 75 6e 63 68 77 61 69 74 22 29 20 22 6e 6f launchwait") "no
e490: 22 29 20 23 66 20 23 74 29 29 0a 09 20 20 20 28 ") #f #t)).. (
e4a0: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 launch-results (
e4b0: 61 70 70 6c 79 20 28 69 66 20 6c 61 75 6e 63 68 apply (if launch
e4c0: 77 61 69 74 0a 09 09 09 09 20 20 20 20 20 20 70 wait..... p
e4d0: 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d 77 rocess:cmd-run-w
e4e0: 69 74 68 2d 73 74 64 65 72 72 2d 3e 6c 69 73 74 ith-stderr->list
e4f0: 0a 09 09 09 09 20 20 20 20 20 20 70 72 6f 63 65 ..... proce
e500: 73 73 2d 72 75 6e 29 0a 09 09 09 09 20 20 28 69 ss-run)..... (i
e510: 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 f useshell.....
e520: 20 20 20 20 20 28 6c 65 74 20 28 28 63 6d 64 73 (let ((cmds
e530: 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 tr (string-inter
e540: 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 sperse fullcmd "
e550: 20 22 29 29 29 0a 09 09 09 09 09 28 69 66 20 6c ")))......(if l
e560: 61 75 6e 63 68 77 61 69 74 0a 09 09 09 09 09 20 aunchwait......
e570: 20 20 20 63 6d 64 73 74 72 0a 09 09 09 09 09 20 cmdstr......
e580: 20 20 20 28 63 6f 6e 63 20 63 6d 64 73 74 72 20 (conc cmdstr
e590: 22 20 3e 3e 20 6d 74 5f 6c 61 75 6e 63 68 2e 6c " >> mt_launch.l
e5a0: 6f 67 20 32 3e 26 31 22 29 29 29 0a 09 09 09 09 og 2>&1"))).....
e5b0: 20 20 20 20 20 20 28 63 61 72 20 66 75 6c 6c 63 (car fullc
e5c0: 6d 64 29 29 0a 09 09 09 09 20 20 28 69 66 20 75 md))..... (if u
e5d0: 73 65 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 20 seshell.....
e5e0: 20 20 27 28 29 0a 09 09 09 09 20 20 20 20 20 20 '().....
e5f0: 28 63 64 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 (cdr fullcmd))))
e600: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
e610: 20 6c 61 75 6e 63 68 77 61 69 74 29 20 3b 3b 20 launchwait) ;;
e620: 67 69 76 65 20 74 68 65 20 4f 53 20 61 20 6c 69 give the OS a li
e630: 74 74 6c 65 20 74 69 6d 65 20 74 6f 20 61 6c 6c ttle time to all
e640: 6f 77 20 74 68 65 20 70 72 6f 63 65 73 73 20 74 ow the process t
e650: 6f 20 73 74 61 72 74 0a 09 20 20 28 74 68 72 65 o start.. (thre
e660: 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 29 29 ad-sleep! 0.01))
e670: 0a 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 . (with-out
e680: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 22 6d 74 5f put-to-file "mt_
e690: 6c 61 75 6e 63 68 2e 6c 6f 67 22 0a 09 28 6c 61 launch.log"..(la
e6a0: 6d 62 64 61 20 28 29 0a 09 20 20 28 70 72 69 6e mbda ().. (prin
e6b0: 74 20 22 4c 41 55 4e 43 48 43 4d 44 3a 20 22 20 t "LAUNCHCMD: "
e6c0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
e6d0: 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 rse fullcmd " ")
e6e0: 29 0a 09 20 20 28 69 66 20 28 6c 69 73 74 3f 20 ).. (if (list?
e6f0: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a launch-results).
e700: 09 20 20 20 20 20 20 28 61 70 70 6c 79 20 70 72 . (apply pr
e710: 69 6e 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c int launch-resul
e720: 74 73 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e ts).. (prin
e730: 74 20 22 4e 4f 54 45 3a 20 6c 61 75 6e 63 68 65 t "NOTE: launche
e740: 64 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c d \"" fullcmd "\
e750: 22 5c 6e 20 20 62 75 74 20 64 69 64 20 6e 6f 74 "\n but did not
e760: 20 77 61 69 74 20 66 6f 72 20 69 74 20 74 6f 20 wait for it to
e770: 70 72 6f 63 65 65 64 2e 20 41 64 64 20 74 68 65 proceed. Add the
e780: 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 6f 20 6d 65 following to me
e790: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 5c 6e gatest.config \n
e7a0: 5b 73 65 74 75 70 5d 5c 6e 6c 61 75 6e 63 68 77 [setup]\nlaunchw
e7b0: 61 69 74 20 79 65 73 5c 6e 20 20 69 66 20 79 6f ait yes\n if yo
e7c0: 75 20 68 61 76 65 20 70 72 6f 62 6c 65 6d 73 20 u have problems
e7d0: 77 69 74 68 20 74 68 69 73 22 29 29 0a 09 20 20 with this"))..
e7e0: 23 3a 61 70 70 65 6e 64 29 29 0a 20 20 20 20 20 #:append)).
e7f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
e800: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
e810: 74 2a 20 22 4c 61 75 6e 63 68 69 6e 67 20 63 6f t* "Launching co
e820: 6d 70 6c 65 74 65 64 2c 20 75 70 64 61 74 69 6e mpleted, updatin
e830: 67 20 64 62 22 29 0a 20 20 20 20 20 20 28 64 65 g db"). (de
e840: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
e850: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
e860: 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a 20 Launch results:
e870: 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 " launch-results
e880: 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 ). (if (not
e890: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
e8a0: 0a 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 . (begi
e8b0: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 n. (p
e8c0: 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 61 69 rint "ERROR: Fai
e8d0: 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 73 74 led to run " (st
e8e0: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
e8f0: 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 22 2c fullcmd " ") ",
e900: 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 0a 20 exiting now").
e910: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 73 ;; (s
e920: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
e930: 20 64 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 db).
e940: 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 ;; good ole "ex
e950: 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f it" seems not to
e960: 20 77 6f 72 6b 0a 20 20 20 20 20 20 20 20 20 20 work.
e970: 20 20 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a 20 ;; (_exit 9).
e980: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 62 75 ;; bu
e990: 74 20 74 68 69 73 20 68 61 63 6b 20 77 69 6c 6c t this hack will
e9a0: 20 77 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f work! Thanks go
e9b0: 20 74 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 to Alan Post of
e9c0: 20 74 68 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 the Chicken ema
e9d0: 69 6c 20 6c 69 73 74 0a 20 20 20 20 20 20 20 20 il list.
e9e0: 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 74 ;; NB// Is t
e9f0: 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 64 his still needed
ea00: 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 65 ? Should be safe
ea10: 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 22 to go back to "
ea20: 65 78 69 74 22 20 6e 6f 77 3f 0a 20 20 20 20 20 exit" now?.
ea30: 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d (process-
ea40: 73 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d signal (current-
ea50: 70 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e process-id) sign
ea60: 61 6c 2f 6b 69 6c 6c 29 0a 20 20 20 20 20 20 20 al/kill).
ea70: 20 20 20 20 20 29 29 0a 20 20 20 20 20 20 28 61 )). (a
ea80: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 6d list->env-vars m
ea90: 69 73 63 70 72 65 76 76 61 6c 73 29 0a 20 20 20 iscprevvals).
eaa0: 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 (alist->env-v
eab0: 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c 73 ars testprevvals
eac0: 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d 3e ). (alist->
ead0: 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 env-vars commonp
eae0: 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 6c revvals). l
eaf0: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 29 0a aunch-results)).
eb00: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
eb10: 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a ory *toppath*)).
eb20: 0a 3b 3b 20 72 65 63 6f 76 65 72 20 61 20 74 65 .;; recover a te
eb30: 73 74 20 77 68 65 72 65 20 74 68 65 20 74 6f 70 st where the top
eb40: 20 63 6f 6e 74 72 6f 6c 6c 69 6e 67 20 6d 74 65 controlling mte
eb50: 73 74 20 6d 61 79 20 68 61 76 65 20 64 69 65 64 st may have died
eb60: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 .;;.(define (lau
eb70: 6e 63 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 nch:recover-test
eb80: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
eb90: 0a 20 20 3b 3b 20 74 68 69 73 20 66 75 6e 63 74 . ;; this funct
eba0: 69 6f 6e 20 69 73 20 63 61 6c 6c 65 64 20 6f 6e ion is called on
ebb0: 20 74 68 65 20 74 65 73 74 20 72 75 6e 20 68 6f the test run ho
ebc0: 73 74 20 76 69 61 20 73 73 68 0a 20 20 3b 3b 0a st via ssh. ;;.
ebd0: 20 20 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 61 74 20 ;; 1. look at
ebe0: 74 68 65 20 70 72 6f 63 65 73 73 20 66 72 6f 6d the process from
ebf0: 20 70 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 69 pid. ;; - i
ec00: 73 20 69 74 20 6f 77 6e 65 64 20 62 79 20 63 61 s it owned by ca
ec10: 6c 6c 69 6e 67 20 75 73 65 72 0a 20 20 3b 3b 20 lling user. ;;
ec20: 20 20 20 2d 20 69 74 20 69 74 27 73 20 72 75 6e - it it's run
ec30: 20 64 69 72 65 63 74 6f 72 79 20 63 6f 72 72 65 directory corre
ec40: 63 74 20 66 6f 72 20 74 68 65 20 74 65 73 74 0a ct for the test.
ec50: 20 20 3b 3b 20 20 20 20 2d 20 69 73 20 74 68 65 ;; - is the
ec60: 72 65 20 61 20 63 6f 6e 74 72 6f 6c 6c 69 6e 67 re a controlling
ec70: 20 6d 74 65 73 74 20 28 6d 61 79 62 65 20 73 74 mtest (maybe st
ec80: 75 63 6b 29 0a 20 20 3b 3b 20 32 2e 20 69 66 20 uck). ;; 2. if
ec90: 72 65 63 6f 76 65 72 79 20 69 73 20 6e 65 65 64 recovery is need
eca0: 65 64 20 77 61 74 63 68 20 70 69 64 0a 20 20 3b ed watch pid. ;
ecb0: 3b 20 20 20 20 2d 20 77 68 65 6e 20 69 74 20 65 ; - when it e
ecc0: 78 69 74 73 20 74 61 6b 65 20 74 68 65 20 65 78 xits take the ex
ecd0: 69 74 20 63 6f 64 65 20 61 6e 64 20 64 6f 20 74 it code and do t
ece0: 68 65 20 6e 65 65 64 66 75 6c 0a 20 20 3b 3b 0a he needful. ;;.
ecf0: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 20 28 72 (let* ((pid (r
ed00: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d mt:test-get-top-
ed10: 70 72 6f 63 65 73 73 2d 69 64 20 72 75 6e 2d 69 process-id run-i
ed20: 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 70 d test-id)).. (p
ed30: 73 72 65 73 20 28 77 69 74 68 2d 69 6e 70 75 74 sres (with-input
ed40: 2d 66 72 6f 6d 2d 70 69 70 65 0a 09 09 20 28 63 -from-pipe... (c
ed50: 6f 6e 63 20 22 70 73 20 2d 46 20 2d 75 20 22 20 onc "ps -F -u "
ed60: 28 63 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 (current-user-na
ed70: 6d 65 29 20 22 20 7c 20 67 72 65 70 20 2d 45 20 me) " | grep -E
ed80: 27 22 20 70 69 64 20 22 20 27 20 7c 20 67 72 65 '" pid " ' | gre
ed90: 70 20 2d 76 20 27 67 72 65 70 20 2d 45 20 22 20 p -v 'grep -E "
eda0: 70 69 64 20 22 27 22 29 0a 09 09 20 28 6c 61 6d pid "'")... (lam
edb0: 62 64 61 20 28 29 0a 09 09 20 20 20 28 72 65 61 bda ()... (rea
edc0: 64 2d 6c 69 6e 65 29 29 29 29 0a 09 20 28 72 75 d-line)))).. (ru
edd0: 6e 64 69 72 20 28 69 66 20 28 73 74 72 69 6e 67 ndir (if (string
ede0: 3f 20 70 73 72 65 73 29 20 3b 3b 20 72 65 61 6c ? psres) ;; real
edf0: 20 70 72 6f 63 65 73 73 20 6f 77 6e 65 64 20 62 process owned b
ee00: 79 20 75 73 65 72 0a 09 09 20 20 20 20 20 28 72 y user... (r
ee10: 65 61 64 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ead-symbolic-lin
ee20: 6b 20 28 63 6f 6e 63 20 22 2f 70 72 6f 63 2f 22 k (conc "/proc/"
ee30: 20 70 69 64 20 22 2f 63 77 64 22 29 29 0a 09 09 pid "/cwd"))...
ee40: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 3b #f))). ;
ee50: 3b 20 6e 6f 77 20 77 61 69 74 20 6f 6e 20 74 68 ; now wait on th
ee60: 61 74 20 70 72 6f 63 65 73 73 20 69 66 20 61 6c at process if al
ee70: 6c 20 69 73 20 63 6f 72 72 65 63 74 0a 20 20 20 l is correct.
ee80: 20 3b 3b 20 70 65 72 69 6f 64 69 63 61 6c 6c 79 ;; periodically
ee90: 20 75 70 64 61 74 65 20 74 68 65 20 64 62 20 77 update the db w
eea0: 69 74 68 20 72 75 6e 74 69 6d 65 0a 20 20 20 20 ith runtime.
eeb0: 3b 3b 20 77 68 65 6e 20 74 68 65 20 70 72 6f 63 ;; when the proc
eec0: 65 73 73 20 65 78 69 74 73 20 6c 6f 6f 6b 20 61 ess exits look a
eed0: 74 20 74 68 65 20 64 62 2c 20 69 66 20 73 74 69 t the db, if sti
eee0: 6c 6c 20 52 55 4e 4e 49 4e 47 20 61 66 74 65 72 ll RUNNING after
eef0: 20 31 30 20 73 65 63 6f 6e 64 73 20 73 65 74 0a 10 seconds set.
ef00: 20 20 20 20 3b 3b 20 73 74 61 74 65 2f 73 74 61 ;; state/sta
ef10: 74 75 73 20 61 70 70 72 6f 70 72 69 61 74 65 6c tus appropriatel
ef20: 79 0a 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 y. (process-w
ef30: 61 69 74 20 70 69 64 29 29 29 0a ait pid))).