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 37 2c 20 4d 61 74 74 68 65 77 06-2017, 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 74 bles csv).(use t
02a0: 79 70 65 64 2d 72 65 63 6f 72 64 73 20 70 61 74 yped-records pat
02b0: 68 6e 61 6d 65 2d 65 78 70 61 6e 64 20 6d 61 74 hname-expand mat
02c0: 63 68 61 62 6c 65 29 0a 0a 28 69 6d 70 6f 72 74 chable)..(import
02d0: 20 28 70 72 65 66 69 78 20 62 61 73 65 36 34 20 (prefix base64
02e0: 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 base64:)).(impor
02f0: 74 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 65 t (prefix sqlite
0300: 33 20 73 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 3 sqlite3:))..(d
0310: 65 63 6c 61 72 65 20 28 75 6e 69 74 20 6c 61 75 eclare (unit lau
0320: 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 65 20 28 nch)).(declare (
0330: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0340: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6e eclare (uses con
0350: 66 69 67 66 29 29 0a 28 64 65 63 6c 61 72 65 20 figf)).(declare
0360: 28 75 73 65 73 20 64 62 29 29 0a 3b 3b 20 28 64 (uses db)).;; (d
0370: 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 64 62 eclare (uses sdb
0380: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
0390: 73 20 74 64 62 29 29 0a 3b 3b 20 28 64 65 63 6c s tdb)).;; (decl
03a0: 61 72 65 20 28 75 73 65 73 20 66 69 6c 65 64 62 are (uses filedb
03b0: 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 22 63 6f ))..(include "co
03c0: 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d mmon_records.scm
03d0: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 6b 65 79 ").(include "key
03e0: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
03f0: 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f include "db_reco
0400: 72 64 73 2e 73 63 6d 22 29 0a 0a 3b 3b 3d 3d 3d rds.scm")..;;===
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0450: 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 65 70 73 0a 3b ===.;; ezsteps.;
0460: 3b 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 3d 3d 3d 3d 3d 3d 3d ================
04a0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 65 7a 73 74 =======..;; ezst
04b0: 65 70 73 20 77 65 72 65 20 67 6f 69 6e 67 20 74 eps were going t
04c0: 6f 20 62 65 20 63 6f 64 65 64 20 61 73 0a 3b 3b o be coded as.;;
04d0: 20 73 74 65 70 6e 61 6d 65 5b 2c 70 72 65 64 73 stepname[,preds
04e0: 74 65 70 31 2c 70 72 65 64 73 74 65 70 32 20 2e tep1,predstep2 .
04f0: 2e 2e 5d 20 5b 7b 56 41 52 31 3d 66 69 72 73 74 ..] [{VAR1=first
0500: 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 7d 5d 20 ,second,third}]
0510: 63 6f 6d 6d 61 6e 64 20 74 6f 20 65 78 65 63 75 command to execu
0520: 74 65 0a 3b 3b 20 20 20 42 55 54 0a 3b 3b 20 6e te.;; BUT.;; n
0530: 6f 77 20 61 72 65 0a 3b 3b 20 73 74 65 70 6e 61 ow are.;; stepna
0540: 6d 65 20 7b 56 41 52 3d 66 69 72 73 74 2c 73 65 me {VAR=first,se
0550: 63 6f 6e 64 2c 74 68 69 72 64 20 2e 2e 2e 7d 20 cond,third ...}
0560: 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 0a 3b 3b 20 77 command ....;; w
0570: 68 65 72 65 20 74 68 65 20 7b 56 41 52 3d 66 69 here the {VAR=fi
0580: 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 rst,second,third
0590: 20 2e 2e 2e 7d 20 69 73 20 6f 70 74 69 6f 6e 61 ...} is optiona
05a0: 6c 2e 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6e 20 l...;; given an
05b0: 65 78 69 74 20 63 6f 64 65 20 61 6e 64 20 77 68 exit code and wh
05c0: 65 74 68 65 72 20 6f 72 20 6e 6f 74 20 6c 6f 67 ether or not log
05d0: 70 72 6f 20 77 61 73 20 75 73 65 64 20 63 61 6c pro was used cal
05e0: 63 75 6c 61 74 65 20 4f 4b 2f 42 41 44 0a 3b 3b culate OK/BAD.;;
05f0: 20 72 65 74 75 72 6e 20 23 74 20 69 66 20 77 65 return #t if we
0600: 20 61 72 65 20 6f 6b 2c 20 23 66 20 6f 74 68 65 are ok, #f othe
0610: 72 77 69 73 65 0a 28 64 65 66 69 6e 65 20 28 73 rwise.(define (s
0620: 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 teprun-good? log
0630: 70 72 6f 20 65 78 69 74 63 6f 64 65 29 0a 20 20 pro exitcode).
0640: 28 6f 72 20 28 65 71 3f 20 65 78 69 74 63 6f 64 (or (eq? exitcod
0650: 65 20 30 29 0a 20 20 20 20 20 20 28 61 6e 64 20 e 0). (and
0660: 6c 6f 67 70 72 6f 20 28 65 71 3f 20 65 78 69 74 logpro (eq? exit
0670: 63 6f 64 65 20 32 29 29 29 29 0a 0a 3b 3b 20 69 code 2))))..;; i
0680: 66 20 68 61 6e 64 65 64 20 61 20 73 74 72 69 6e f handed a strin
0690: 67 2c 20 70 72 6f 63 65 73 73 20 69 74 2c 20 65 g, process it, e
06a0: 6c 73 65 20 6c 6f 6f 6b 20 66 6f 72 20 4d 54 5f lse look for MT_
06b0: 43 4d 44 49 4e 46 4f 0a 28 64 65 66 69 6e 65 20 CMDINFO.(define
06c0: 28 6c 61 75 6e 63 68 3a 67 65 74 2d 63 6d 64 69 (launch:get-cmdi
06d0: 6e 66 6f 2d 61 73 73 6f 63 2d 6c 69 73 74 20 23 nfo-assoc-list #
06e0: 21 6b 65 79 20 28 65 6e 63 6f 64 65 64 2d 63 6d !key (encoded-cm
06f0: 64 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 d #f)). (let ((
0700: 65 6e 63 63 6d 64 20 28 69 66 20 65 6e 63 6f 64 enccmd (if encod
0710: 65 64 2d 63 6d 64 20 65 6e 63 6f 64 65 64 2d 63 ed-cmd encoded-c
0720: 6d 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 md (getenv "MT_C
0730: 4d 44 49 4e 46 4f 22 29 29 29 29 0a 20 20 20 20 MDINFO")))).
0740: 28 69 66 20 65 6e 63 63 6d 64 0a 09 28 63 6f 6d (if enccmd..(com
0750: 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 mon:read-encoded
0760: 2d 73 74 72 69 6e 67 20 65 6e 63 63 6d 64 29 0a -string enccmd).
0770: 09 27 28 29 29 29 29 0a 0a 3b 3b 20 20 20 20 20 .'())))..;;
0780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0790: 20 20 30 20 20 20 20 20 20 20 20 20 20 20 31 20 0 1
07a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 32 20 20 2
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 33 0a 28 64 3.(d
07c0: 65 66 73 74 72 75 63 74 20 6c 61 75 6e 63 68 3a efstruct launch:
07d0: 65 69 6e 66 20 28 70 69 64 20 23 74 29 28 65 78 einf (pid #t)(ex
07e0: 69 74 2d 73 74 61 74 75 73 20 23 74 29 28 65 78 it-status #t)(ex
07f0: 69 74 2d 63 6f 64 65 20 23 74 29 28 72 6f 6c 6c it-code #t)(roll
0800: 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a 0a 3b up-status 0))..;
0810: 3b 20 72 65 74 75 72 6e 20 28 63 6f 6e 63 20 73 ; return (conc s
0820: 74 61 74 75 73 20 22 3a 20 22 20 63 6f 6d 6d 65 tatus ": " comme
0830: 6e 74 29 20 66 72 6f 6d 20 74 68 65 20 66 69 6e nt) from the fin
0840: 61 6c 20 73 65 63 74 69 6f 6e 20 73 6f 20 74 68 al section so th
0850: 61 74 0a 3b 3b 20 20 20 74 68 65 20 63 6f 6d 6d at.;; the comm
0860: 65 6e 74 20 63 61 6e 20 62 65 20 73 65 74 20 69 ent can be set i
0870: 6e 20 74 68 65 20 73 74 65 70 20 72 65 63 6f 72 n the step recor
0880: 64 20 69 6e 20 6c 61 75 6e 63 68 2e 73 63 6d 0a d in launch.scm.
0890: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e ;;.(define (laun
08a0: 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 ch:load-logpro-d
08b0: 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 at run-id test-i
08c0: 64 20 73 74 65 70 6e 61 6d 65 29 0a 20 20 28 6c d stepname). (l
08d0: 65 74 20 28 28 63 6e 61 6d 65 20 28 63 6f 6e 63 et ((cname (conc
08e0: 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 74 22 stepname ".dat"
08f0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 63 6f 6d ))). (if (com
0900: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
0910: 20 63 6e 61 6d 65 29 0a 09 28 6c 65 74 2a 20 28 cname)..(let* (
0920: 28 64 61 74 20 20 28 72 65 61 64 2d 63 6f 6e 66 (dat (read-conf
0930: 69 67 20 63 6e 61 6d 65 20 23 66 20 23 66 29 29 ig cname #f #f))
0940: 0a 09 20 20 20 20 20 20 20 28 63 73 76 72 20 28 .. (csvr (
0950: 64 62 3a 6c 6f 67 70 72 6f 2d 64 61 74 2d 3e 63 db:logpro-dat->c
0960: 73 76 20 64 61 74 20 73 74 65 70 6e 61 6d 65 29 sv dat stepname)
0970: 29 0a 09 20 20 20 20 20 20 20 28 63 73 76 74 20 ).. (csvt
0980: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 66 (let-values (((f
0990: 6d 74 2d 63 65 6c 6c 20 66 6d 74 2d 72 65 63 6f mt-cell fmt-reco
09a0: 72 64 20 66 6d 74 2d 63 73 76 29 20 28 6d 61 6b rd fmt-csv) (mak
09b0: 65 2d 66 6f 72 6d 61 74 20 22 2c 22 29 29 29 0a e-format ","))).
09c0: 09 09 20 20 20 20 20 20 20 28 66 6d 74 2d 63 73 .. (fmt-cs
09d0: 76 20 28 6d 61 70 20 6c 69 73 74 2d 3e 63 73 76 v (map list->csv
09e0: 2d 72 65 63 6f 72 64 20 63 73 76 72 29 29 29 29 -record csvr))))
09f0: 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 .. (status
0a00: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
0a10: 20 64 61 74 20 22 66 69 6e 61 6c 22 20 22 65 78 dat "final" "ex
0a20: 69 74 2d 73 74 61 74 75 73 22 29 29 0a 09 20 20 it-status"))..
0a30: 20 20 20 20 20 28 6d 73 67 20 20 20 20 20 28 63 (msg (c
0a40: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 onfigf:lookup da
0a50: 74 20 22 66 69 6e 61 6c 22 20 22 6d 65 73 73 61 t "final" "messa
0a60: 67 65 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 ge"))).
0a70: 20 28 69 66 20 63 73 76 74 20 20 3b 3b 20 74 68 (if csvt ;; th
0a80: 69 73 20 69 66 20 62 6c 6f 63 6b 65 64 20 73 74 is if blocked st
0a90: 61 63 6b 20 64 75 6d 70 20 63 61 75 73 65 64 20 ack dump caused
0aa0: 62 79 20 2e 64 61 74 20 66 69 6c 65 20 66 72 6f by .dat file fro
0ab0: 6d 20 6c 6f 67 70 72 6f 20 62 65 69 6e 67 20 30 m logpro being 0
0ac0: 2d 62 79 74 65 2e 20 20 66 69 78 65 64 20 62 79 -byte. fixed by
0ad0: 20 75 70 67 72 61 64 69 6e 67 20 6c 6f 67 70 72 upgrading logpr
0ae0: 6f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 o.
0af0: 28 72 6d 74 3a 63 73 76 2d 3e 74 65 73 74 2d 64 (rmt:csv->test-d
0b00: 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ata run-id test-
0b10: 69 64 20 63 73 76 74 29 0a 09 20 20 20 20 20 20 id csvt)..
0b20: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
0b30: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0b40: 2a 20 22 45 52 52 4f 52 3a 20 6e 6f 20 63 73 76 * "ERROR: no csv
0b50: 64 61 74 20 65 78 69 73 74 73 20 66 6f 72 20 72 dat exists for r
0b60: 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 un-id: " run-id
0b70: 22 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 " test-id: " tes
0b80: 74 2d 69 64 20 22 20 73 74 65 70 6e 61 6d 65 3a t-id " stepname:
0b90: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2c 20 63 " stepname ", c
0ba0: 68 65 63 6b 20 74 68 61 74 20 6c 6f 67 70 72 6f heck that logpro
0bb0: 20 76 65 72 73 69 6f 6e 20 69 73 20 31 2e 31 35 version is 1.15
0bc0: 20 6f 72 20 6e 65 77 65 72 22 29 29 0a 09 20 20 or newer"))..
0bd0: 3b 3b 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 ;; (debug:print
0be0: 2d 69 6e 66 6f 20 31 33 20 2a 64 65 66 61 75 6c -info 13 *defaul
0bf0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 72 72 t-log-port* "Err
0c00: 6f 72 3a 20 72 75 6e 2d 69 64 2f 74 65 73 74 2d or: run-id/test-
0c10: 69 64 2f 73 74 65 70 6e 61 6d 65 3d 22 72 75 6e id/stepname="run
0c20: 2d 69 64 22 2f 22 74 65 73 74 2d 69 64 22 2f 22 -id"/"test-id"/"
0c30: 73 74 65 70 6e 61 6d 65 22 20 3d 3e 20 62 61 64 stepname" => bad
0c40: 20 63 73 76 72 3d 22 63 73 76 72 29 0a 09 20 20 csvr="csvr)..
0c50: 3b 3b 20 20 29 0a 09 20 20 28 63 6f 6e 64 0a 09 ;; ).. (cond..
0c60: 20 20 20 28 28 65 71 75 61 6c 3f 20 73 74 61 74 ((equal? stat
0c70: 75 73 20 22 50 41 53 53 22 29 20 22 50 41 53 53 us "PASS") "PASS
0c80: 22 29 20 3b 3b 20 73 6b 69 70 20 74 68 65 20 6d ") ;; skip the m
0c90: 65 73 73 61 67 65 20 70 61 72 74 20 69 66 20 73 essage part if s
0ca0: 74 61 74 75 73 20 69 73 20 70 61 73 73 0a 09 20 tatus is pass..
0cb0: 20 20 28 73 74 61 74 75 73 20 28 63 6f 6e 63 20 (status (conc
0cc0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
0cd0: 64 61 74 20 22 66 69 6e 61 6c 22 20 22 65 78 69 dat "final" "exi
0ce0: 74 2d 73 74 61 74 75 73 22 29 20 22 3a 20 22 20 t-status") ": "
0cf0: 28 69 66 20 6d 73 67 20 6d 73 67 20 22 6e 6f 20 (if msg msg "no
0d00: 6d 65 73 73 61 67 65 22 29 29 29 0a 09 20 20 20 message")))..
0d10: 28 65 6c 73 65 20 23 66 29 29 29 0a 09 23 66 29 (else #f)))..#f)
0d20: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 ))..(define (lau
0d30: 6e 63 68 3a 72 75 6e 73 74 65 70 20 65 7a 73 74 nch:runstep ezst
0d40: 65 70 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ep run-id test-i
0d50: 64 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 74 61 d exit-info m ta
0d60: 6c 20 74 65 73 74 63 6f 6e 66 69 67 29 0a 20 20 l testconfig).
0d70: 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 (let* ((stepname
0d80: 20 20 20 20 20 20 20 28 63 61 72 20 65 7a 73 74 (car ezst
0d90: 65 70 29 29 20 20 3b 3b 20 64 6f 20 73 74 75 66 ep)) ;; do stuf
0da0: 66 20 74 6f 20 72 75 6e 20 74 68 65 20 73 74 65 f to run the ste
0db0: 70 0a 09 20 28 73 74 65 70 69 6e 66 6f 20 20 20 p.. (stepinfo
0dc0: 20 20 20 20 28 63 61 64 72 20 65 7a 73 74 65 70 (cadr ezstep
0dd0: 29 29 0a 09 20 28 73 74 65 70 70 61 72 74 73 20 )).. (stepparts
0de0: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 (string-mat
0df0: 63 68 20 28 72 65 67 65 78 70 20 22 5e 28 5c 5c ch (regexp "^(\\
0e00: 7b 28 5b 5e 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c 73 {([^\\}]*)\\}\\s
0e10: 2a 7c 29 28 2e 2a 29 24 22 29 20 73 74 65 70 69 *|)(.*)$") stepi
0e20: 6e 66 6f 29 29 0a 09 20 28 73 74 65 70 70 61 72 nfo)).. (steppar
0e30: 6d 73 20 20 20 20 20 20 28 6c 69 73 74 2d 72 65 ms (list-re
0e40: 66 20 73 74 65 70 70 61 72 74 73 20 32 29 29 20 f stepparts 2))
0e50: 3b 3b 20 66 6f 72 20 66 75 74 75 72 65 20 75 73 ;; for future us
0e60: 65 2c 20 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c 20 e, {VAR=1,2,3},
0e70: 72 75 6e 20 73 74 65 70 20 66 6f 72 20 65 61 63 run step for eac
0e80: 68 20 0a 09 20 28 73 74 65 70 63 6d 64 20 20 20 h .. (stepcmd
0e90: 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 73 (list-ref s
0ea0: 74 65 70 70 61 72 74 73 20 33 29 29 0a 09 20 28 tepparts 3)).. (
0eb0: 73 63 72 69 70 74 20 20 20 20 20 20 20 20 20 22 script "
0ec0: 22 29 20 3b 20 22 23 21 2f 62 69 6e 2f 62 61 73 ") ; "#!/bin/bas
0ed0: 68 5c 6e 22 29 20 3b 3b 20 79 65 70 2c 20 77 65 h\n") ;; yep, we
0ee0: 20 64 65 70 65 6e 64 20 6f 6e 20 62 69 6e 2f 62 depend on bin/b
0ef0: 61 73 68 20 46 49 58 4d 45 21 21 21 5c 0a 09 20 ash FIXME!!!\..
0f00: 28 6c 6f 67 70 72 6f 2d 66 69 6c 65 20 20 20 20 (logpro-file
0f10: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
0f20: 2e 6c 6f 67 70 72 6f 22 29 29 0a 09 20 28 68 74 .logpro")).. (ht
0f30: 6d 6c 2d 66 69 6c 65 20 20 20 20 20 20 28 63 6f ml-file (co
0f40: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 74 nc stepname ".ht
0f50: 6d 6c 22 29 29 0a 09 20 28 64 61 74 2d 66 69 6c ml")).. (dat-fil
0f60: 65 20 20 20 20 20 20 20 28 63 6f 6e 63 20 73 74 e (conc st
0f70: 65 70 6e 61 6d 65 20 22 2e 64 61 74 22 29 29 0a epname ".dat")).
0f80: 09 20 28 74 63 6f 6e 66 69 67 2d 6c 6f 67 70 72 . (tconfig-logpr
0f90: 6f 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 o (configf:looku
0fa0: 70 20 74 65 73 74 63 6f 6e 66 69 67 20 22 6c 6f p testconfig "lo
0fb0: 67 70 72 6f 22 20 73 74 65 70 6e 61 6d 65 29 29 gpro" stepname))
0fc0: 0a 09 20 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 .. (logpro-used
0fd0: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d (common:file-
0fe0: 65 78 69 73 74 73 3f 20 6c 6f 67 70 72 6f 2d 66 exists? logpro-f
0ff0: 69 6c 65 29 29 29 0a 0a 20 20 20 20 28 69 66 20 ile))).. (if
1000: 28 61 6e 64 20 74 63 6f 6e 66 69 67 2d 6c 6f 67 (and tconfig-log
1010: 70 72 6f 0a 09 20 20 20 20 20 28 6e 6f 74 20 6c pro.. (not l
1020: 6f 67 70 72 6f 2d 75 73 65 64 29 29 20 3b 3b 20 ogpro-used)) ;;
1030: 6e 6f 20 6c 6f 67 70 72 6f 20 66 69 6c 65 20 66 no logpro file f
1040: 6f 75 6e 64 20 62 75 74 20 68 61 76 65 20 61 20 ound but have a
1050: 64 65 66 6e 20 69 6e 20 74 68 65 20 74 65 73 74 defn in the test
1060: 63 6f 6e 66 69 67 0a 09 28 62 65 67 69 6e 0a 09 config..(begin..
1070: 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 (with-output-t
1080: 6f 2d 66 69 6c 65 20 6c 6f 67 70 72 6f 2d 66 69 o-file logpro-fi
1090: 6c 65 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 le.. (lambda
10a0: 28 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 ().. (print
10b0: 20 22 3b 3b 20 6c 6f 67 70 72 6f 20 66 69 6c 65 ";; logpro file
10c0: 20 65 78 74 72 61 63 74 65 64 20 66 72 6f 6d 20 extracted from
10d0: 74 65 73 74 63 6f 6e 66 69 67 5c 6e 22 0a 09 09 testconfig\n"...
10e0: 20 20 20 20 20 22 3b 3b 22 29 0a 09 20 20 20 20 ";;")..
10f0: 20 20 28 70 72 69 6e 74 20 74 63 6f 6e 66 69 67 (print tconfig
1100: 2d 6c 6f 67 70 72 6f 29 29 29 0a 09 20 20 28 73 -logpro))).. (s
1110: 65 74 21 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 et! logpro-used
1120: 23 74 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b #t))). . ;
1130: 3b 20 4e 42 2f 2f 20 63 61 6e 20 73 61 66 65 6c ; NB// can safel
1140: 79 20 61 73 73 75 6d 65 20 77 65 20 61 72 65 20 y assume we are
1150: 69 6e 20 74 65 73 74 2d 61 72 65 61 20 64 69 72 in test-area dir
1160: 65 63 74 6f 72 79 0a 20 20 20 20 28 64 65 62 75 ectory. (debu
1170: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
1180: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 7a lt-log-port* "ez
1190: 73 74 65 70 73 3a 5c 6e 20 73 74 65 70 6e 61 6d steps:\n stepnam
11a0: 65 3a 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 e: " stepname "
11b0: 73 74 65 70 69 6e 66 6f 3a 20 22 20 73 74 65 70 stepinfo: " step
11c0: 69 6e 66 6f 20 22 20 73 74 65 70 70 61 72 74 73 info " stepparts
11d0: 3a 20 22 20 73 74 65 70 70 61 72 74 73 0a 09 09 : " stepparts...
11e0: 20 22 20 73 74 65 70 70 61 72 6d 73 3a 20 22 20 " stepparms: "
11f0: 73 74 65 70 70 61 72 6d 73 20 22 20 73 74 65 70 stepparms " step
1200: 63 6d 64 3a 20 22 20 73 74 65 70 63 6d 64 29 0a cmd: " stepcmd).
1210: 20 20 20 20 0a 20 20 20 20 3b 3b 20 3b 3b 20 66 . ;; ;; f
1220: 69 72 73 74 20 73 6f 75 72 63 65 20 74 68 65 20 irst source the
1230: 70 72 65 76 69 6f 75 73 20 65 6e 76 69 72 6f 6e previous environ
1240: 6d 65 6e 74 0a 20 20 20 20 3b 3b 20 28 6c 65 74 ment. ;; (let
1250: 20 28 28 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e ((prev-env (con
1260: 63 20 22 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 c ".ezsteps/" pr
1270: 65 76 73 74 65 70 20 28 69 66 20 28 73 74 72 69 evstep (if (stri
1280: 6e 67 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 ng-search (regex
1290: 70 20 22 63 73 68 22 29 20 0a 20 20 20 20 3b 3b p "csh") . ;;
12a0: 20 20 20 20 20 20 09 09 09 09 09 09 09 20 28 67 ....... (g
12b0: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
12c0: 61 72 69 61 62 6c 65 20 22 53 48 45 4c 4c 22 29 ariable "SHELL")
12d0: 29 20 22 2e 63 73 68 22 20 22 2e 73 68 22 29 29 ) ".csh" ".sh"))
12e0: 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 69 66 20 )). ;; (if
12f0: 28 61 6e 64 20 70 72 65 76 73 74 65 70 20 28 63 (and prevstep (c
1300: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
1310: 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a 20 20 s? prev-env)).
1320: 20 20 3b 3b 20 20 20 20 20 20 20 28 73 65 74 21 ;; (set!
1330: 20 73 63 72 69 70 74 20 28 63 6f 6e 63 20 73 63 script (conc sc
1340: 72 69 70 74 20 22 73 6f 75 72 63 65 20 22 20 70 ript "source " p
1350: 72 65 76 2d 65 6e 76 29 29 29 29 0a 20 20 20 20 rev-env)))).
1360: 0a 20 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 65 . ;; call the
1370: 20 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d command using m
1380: 74 5f 65 7a 73 74 65 70 0a 20 20 20 20 3b 3b 20 t_ezstep. ;;
1390: 28 73 65 74 21 20 73 63 72 69 70 74 20 28 63 6f (set! script (co
13a0: 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 20 22 20 nc "mt_ezstep "
13b0: 73 74 65 70 6e 61 6d 65 20 22 20 22 20 28 69 66 stepname " " (if
13c0: 20 70 72 65 76 73 74 65 70 20 70 72 65 76 73 74 prevstep prevst
13d0: 65 70 20 22 78 22 29 20 22 20 22 20 73 74 65 70 ep "x") " " step
13e0: 63 6d 64 29 29 0a 20 20 20 20 0a 20 20 20 20 28 cmd)). . (
13f0: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
1400: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1410: 20 22 73 63 72 69 70 74 3a 20 22 20 73 63 72 69 "script: " scri
1420: 70 74 29 0a 20 20 20 20 28 72 6d 74 3a 74 65 73 pt). (rmt:tes
1430: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
1440: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
1450: 20 73 74 65 70 6e 61 6d 65 20 22 73 74 61 72 74 stepname "start
1460: 22 20 22 2d 22 20 23 66 20 23 66 29 0a 20 20 20 " "-" #f #f).
1470: 20 3b 3b 20 6e 6f 77 20 6c 61 75 6e 63 68 20 74 ;; now launch t
1480: 68 65 20 61 63 74 75 61 6c 20 70 72 6f 63 65 73 he actual proces
1490: 73 0a 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 s. (call-with
14a0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
14b0: 69 61 62 6c 65 73 20 0a 20 20 20 20 20 28 6c 69 iables . (li
14c0: 73 74 20 28 63 6f 6e 73 20 22 50 41 54 48 22 20 st (cons "PATH"
14d0: 28 63 6f 6e 63 20 28 67 65 74 2d 65 6e 76 69 72 (conc (get-envir
14e0: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
14f0: 22 50 41 54 48 22 29 20 22 3a 2e 22 29 29 29 0a "PATH") ":."))).
1500: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 (lambda ()
1510: 3b 3b 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 ;; (process-run
1520: 22 2f 62 69 6e 2f 62 61 73 68 22 20 22 2d 63 22 "/bin/bash" "-c"
1530: 20 22 65 78 65 63 20 6c 73 20 2d 6c 20 2f 74 6d "exec ls -l /tm
1540: 70 2f 66 6f 6f 62 61 72 20 3e 20 2f 74 6d 70 2f p/foobar > /tmp/
1550: 64 65 6c 6d 65 2d 6d 6f 72 65 2e 6c 6f 67 20 32 delme-more.log 2
1560: 3e 26 31 22 29 0a 20 20 20 20 20 20 20 28 6c 65 >&1"). (le
1570: 74 2a 20 28 28 63 6d 64 20 28 63 6f 6e 63 20 73 t* ((cmd (conc s
1580: 74 65 70 63 6d 64 20 22 20 3e 20 22 20 73 74 65 tepcmd " > " ste
1590: 70 6e 61 6d 65 20 22 2e 6c 6f 67 20 32 3e 26 31 pname ".log 2>&1
15a0: 22 29 29 20 3b 3b 20 3e 6f 75 74 66 69 6c 65 20 ")) ;; >outfile
15b0: 32 3e 26 31 20 0a 09 20 20 20 20 20 20 28 70 69 2>&1 .. (pi
15c0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 d (process-run "
15d0: 2f 62 69 6e 2f 62 61 73 68 22 20 28 6c 69 73 74 /bin/bash" (list
15e0: 20 22 2d 63 22 20 63 6d 64 29 29 29 29 0a 0a 20 "-c" cmd))))..
15f0: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 (with-ou
1600: 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 22 4d 61 tput-to-file "Ma
1610: 6b 65 66 69 6c 65 2e 65 7a 73 74 65 70 73 22 0a kefile.ezsteps".
1620: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
1630: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
1640: 20 20 20 28 70 72 69 6e 74 20 73 74 65 70 6e 61 (print stepna
1650: 6d 65 20 22 2e 6c 6f 67 20 3a 22 29 0a 20 20 20 me ".log :").
1660: 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 (print
1670: 20 22 5c 74 22 20 63 6d 64 29 0a 20 20 20 20 20 "\t" cmd).
1680: 20 20 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d (if (com
1690: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
16a0: 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 (conc stepname
16b0: 22 2e 6c 6f 67 70 72 6f 22 29 29 0a 20 20 20 20 ".logpro")).
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
16d0: 69 6e 74 20 22 5c 74 6c 6f 67 70 72 6f 20 22 20 int "\tlogpro "
16e0: 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 stepname ".logpr
16f0: 6f 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 o " stepname ".h
1700: 74 6d 6c 20 3c 20 22 20 73 74 65 70 6e 61 6d 65 tml < " stepname
1710: 20 22 2e 6c 6f 67 22 29 29 0a 20 20 20 20 20 20 ".log")).
1720: 20 20 20 20 20 20 20 28 70 72 69 6e 74 29 0a 20 (print).
1730: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 (pri
1740: 6e 74 20 73 74 65 70 6e 61 6d 65 20 22 20 3a 20 nt stepname " :
1750: 22 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 " stepname ".log
1760: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
1770: 28 70 72 69 6e 74 29 29 0a 20 20 20 20 20 20 20 (print)).
1780: 20 20 20 20 23 3a 61 70 70 65 6e 64 29 0a 0a 09 #:append)...
1790: 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 (rmt:test-set-t
17a0: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 op-process-pid r
17b0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 un-id test-id pi
17c0: 64 29 0a 09 20 28 6c 65 74 20 70 72 6f 63 65 73 d).. (let proces
17d0: 73 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 20 sloop ((i 0))..
17e0: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
17f0: 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 (pid-val exit-st
1800: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 atus exit-code)(
1810: 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 process-wait pid
1820: 20 23 74 29 29 29 0a 09 09 20 20 20 20 20 20 20 #t)))...
1830: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
1840: 09 09 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 .. (launch
1850: 3a 65 69 6e 66 2d 70 69 64 2d 73 65 74 21 20 20 :einf-pid-set!
1860: 20 20 20 20 20 20 20 65 78 69 74 2d 69 6e 66 6f exit-info
1870: 20 70 69 64 29 20 20 20 20 20 20 20 20 20 3b 3b pid) ;;
1880: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
1890: 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 it-info 0 pid)..
18a0: 09 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a . (launch:
18b0: 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 einf-exit-status
18c0: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
18d0: 65 78 69 74 2d 73 74 61 74 75 73 29 20 3b 3b 20 exit-status) ;;
18e0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 (vector-set! exi
18f0: 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 t-info 1 exit-st
1900: 61 74 75 73 29 0a 09 09 20 20 20 20 20 20 20 28 atus)... (
1910: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 launch:einf-exit
1920: 2d 63 6f 64 65 2d 73 65 74 21 20 20 20 65 78 69 -code-set! exi
1930: 74 2d 69 6e 66 6f 20 65 78 69 74 2d 63 6f 64 65 t-info exit-code
1940: 29 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 ) ;; (vector-s
1950: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 et! exit-info 2
1960: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 20 20 20 exit-code)...
1970: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
1980: 6b 21 20 6d 29 0a 09 09 20 20 20 20 20 20 20 28 k! m)... (
1990: 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 if (eq? pid-val
19a0: 30 29 0a 09 09 09 20 20 20 28 62 65 67 69 6e 0a 0).... (begin.
19b0: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
19c0: 73 6c 65 65 70 21 20 32 29 0a 09 09 09 20 20 20 sleep! 2)....
19d0: 20 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 (processloop (
19e0: 2b 20 69 20 31 29 29 29 29 0a 09 09 20 20 20 20 + i 1))))...
19f0: 20 20 20 29 29 29 29 29 0a 20 20 20 20 28 64 65 ))))). (de
1a00: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
1a10: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
1a20: 72 74 2a 20 22 73 74 65 70 20 22 20 73 74 65 70 rt* "step " step
1a30: 6e 61 6d 65 20 22 20 63 6f 6d 70 6c 65 74 65 64 name " completed
1a40: 20 77 69 74 68 20 65 78 69 74 20 63 6f 64 65 20 with exit code
1a50: 22 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 " (launch:einf-e
1a60: 78 69 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e xit-code exit-in
1a70: 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d fo)) ;; (vector-
1a80: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
1a90: 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 72 75 6e ). ;; now run
1aa0: 20 6c 6f 67 70 72 6f 20 69 66 20 6e 65 65 64 65 logpro if neede
1ab0: 64 0a 20 20 20 20 28 69 66 20 6c 6f 67 70 72 6f d. (if logpro
1ac0: 2d 75 73 65 64 0a 09 28 6c 65 74 20 28 28 70 69 -used..(let ((pi
1ad0: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 28 d (process-run (
1ae0: 63 6f 6e 63 20 22 6c 6f 67 70 72 6f 20 22 20 6c conc "logpro " l
1af0: 6f 67 70 72 6f 2d 66 69 6c 65 20 22 20 22 20 28 ogpro-file " " (
1b00: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
1b10: 68 74 6d 6c 22 29 20 22 20 3c 20 22 20 73 74 65 html") " < " ste
1b20: 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 29 29 29 pname ".log"))))
1b30: 0a 09 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 .. (let process
1b40: 6c 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 20 20 loop ((i 0))..
1b50: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
1b60: 28 70 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 (pid-val exit-st
1b70: 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 atus exit-code)(
1b80: 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 process-wait pid
1b90: 20 23 74 29 29 29 0a 09 09 09 28 6d 75 74 65 78 #t)))....(mutex
1ba0: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 3b 3b 20 -lock! m)....;;
1bb0: 28 6d 61 6b 65 2d 6c 61 75 6e 63 68 3a 65 69 6e (make-launch:ein
1bc0: 66 20 70 69 64 3a 20 70 69 64 20 65 78 69 74 2d f pid: pid exit-
1bd0: 73 74 61 74 75 73 3a 20 65 78 69 74 2d 73 74 61 status: exit-sta
1be0: 74 75 73 20 65 78 69 74 2d 63 6f 64 65 3a 20 65 tus exit-code: e
1bf0: 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 28 6c 61 xit-code)....(la
1c00: 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 2d 73 65 unch:einf-pid-se
1c10: 74 21 20 20 20 20 20 20 20 20 20 65 78 69 74 2d t! exit-
1c20: 69 6e 66 6f 20 70 69 64 29 20 20 20 20 20 20 20 info pid)
1c30: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 ;; (vector-set
1c40: 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 ! exit-info 0 pi
1c50: 64 29 0a 09 09 09 28 6c 61 75 6e 63 68 3a 65 69 d)....(launch:ei
1c60: 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 2d 73 nf-exit-status-s
1c70: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 65 78 et! exit-info ex
1c80: 69 74 2d 73 74 61 74 75 73 29 20 3b 3b 20 28 76 it-status) ;; (v
1c90: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
1ca0: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
1cb0: 75 73 29 0a 09 09 09 28 6c 61 75 6e 63 68 3a 65 us)....(launch:e
1cc0: 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 2d 73 65 inf-exit-code-se
1cd0: 74 21 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 65 t! exit-info e
1ce0: 78 69 74 2d 63 6f 64 65 29 20 20 20 3b 3b 20 28 xit-code) ;; (
1cf0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
1d00: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
1d10: 65 29 0a 09 09 09 28 6d 75 74 65 78 2d 75 6e 6c e)....(mutex-unl
1d20: 6f 63 6b 21 20 6d 29 0a 09 09 09 28 69 66 20 28 ock! m)....(if (
1d30: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
1d40: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 .. (begin....
1d50: 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c (thread-sl
1d60: 65 65 70 21 20 32 29 0a 09 09 09 20 20 20 20 20 eep! 2)....
1d70: 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b (processloop (+
1d80: 20 69 20 31 29 29 29 29 29 0a 09 20 20 20 20 28 i 1))))).. (
1d90: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
1da0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
1db0: 70 6f 72 74 2a 20 22 6c 6f 67 70 72 6f 20 66 6f port* "logpro fo
1dc0: 72 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d r step " stepnam
1dd0: 65 20 22 20 65 78 69 74 65 64 20 77 69 74 68 20 e " exited with
1de0: 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 3a 65 code " (launch:e
1df0: 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 inf-exit-code ex
1e00: 69 74 2d 69 6e 66 6f 29 29 29 29 29 20 3b 3b 20 it-info))))) ;;
1e10: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
1e20: 2d 69 6e 66 6f 20 32 29 29 29 29 29 0a 20 20 20 -info 2))))).
1e30: 20 0a 20 20 20 20 28 6c 65 74 20 28 28 65 78 69 . (let ((exi
1e40: 6e 66 6f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 nfo (launch:einf
1e50: 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 69 74 2d -exit-code exit-
1e60: 69 6e 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f info)) ;; (vecto
1e70: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
1e80: 32 29 29 0a 09 20 20 28 6c 6f 67 66 6e 61 20 28 2)).. (logfna (
1e90: 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 if logpro-used (
1ea0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
1eb0: 68 74 6d 6c 22 29 20 22 22 29 29 0a 09 20 20 28 html") "")).. (
1ec0: 63 6f 6d 6d 65 6e 74 20 23 66 29 29 0a 20 20 20 comment #f)).
1ed0: 20 20 20 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 (if logpro-us
1ee0: 65 64 0a 09 20 20 28 6c 65 74 20 28 28 64 61 74 ed.. (let ((dat
1ef0: 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e file (conc stepn
1f00: 61 6d 65 20 22 2e 64 61 74 22 29 29 29 0a 09 20 ame ".dat")))..
1f10: 20 20 20 3b 3b 20 6c 6f 61 64 20 74 68 65 20 2e ;; load the .
1f20: 64 61 74 20 66 69 6c 65 20 69 6e 74 6f 20 74 68 dat file into th
1f30: 65 20 74 65 73 74 5f 64 61 74 61 20 74 61 62 6c e test_data tabl
1f40: 65 20 69 66 20 69 74 20 65 78 69 73 74 73 0a 09 e if it exists..
1f50: 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a (if (common:
1f60: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 61 74 file-exists? dat
1f70: 66 69 6c 65 29 0a 09 09 28 73 65 74 21 20 63 6f file)...(set! co
1f80: 6d 6d 65 6e 74 20 28 6c 61 75 6e 63 68 3a 6c 6f mment (launch:lo
1f90: 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 ad-logpro-dat ru
1fa0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 74 65 n-id test-id ste
1fb0: 70 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 28 72 pname))).. (r
1fc0: 6d 74 3a 74 65 73 74 2d 73 65 74 2d 6c 6f 67 21 mt:test-set-log!
1fd0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
1fe0: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
1ff0: 2e 68 74 6d 6c 22 29 29 29 29 0a 20 20 20 20 20 .html")))).
2000: 20 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 (rmt:teststep-s
2010: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
2020: 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 d test-id stepna
2030: 6d 65 20 22 65 6e 64 22 20 65 78 69 6e 66 6f 20 me "end" exinfo
2040: 63 6f 6d 6d 65 6e 74 20 6c 6f 67 66 6e 61 29 29 comment logfna))
2050: 0a 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 . ;; set the
2060: 74 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 test final statu
2070: 73 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 70 72 s. (let* ((pr
2080: 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 ocess-exit-statu
2090: 73 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 s (launch:einf-e
20a0: 78 69 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e xit-code exit-in
20b0: 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d fo)) ;; (vector-
20c0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
20d0: 29 0a 09 20 20 20 28 74 68 69 73 2d 73 74 65 70 ).. (this-step
20e0: 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 -status (cond...
20f0: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 . ((and (eq
2100: 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 ? process-exit-s
2110: 74 61 74 75 73 20 32 29 20 6c 6f 67 70 72 6f 2d tatus 2) logpro-
2120: 75 73 65 64 29 20 27 77 61 72 6e 29 20 20 20 3b used) 'warn) ;
2130: 3b 20 6c 6f 67 70 72 6f 20 32 20 3d 20 77 61 72 ; logpro 2 = war
2140: 6e 69 6e 67 73 0a 09 09 09 20 20 20 20 20 20 28 nings.... (
2150: 28 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 73 (and (eq? proces
2160: 73 2d 65 78 69 74 2d 73 74 61 74 75 73 20 33 29 s-exit-status 3)
2170: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 63 logpro-used) 'c
2180: 68 65 63 6b 29 20 20 3b 3b 20 6c 6f 67 70 72 6f heck) ;; logpro
2190: 20 33 20 3d 20 63 68 65 63 6b 0a 09 09 09 20 20 3 = check....
21a0: 20 20 20 20 28 28 61 6e 64 20 28 65 71 3f 20 70 ((and (eq? p
21b0: 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 rocess-exit-stat
21c0: 75 73 20 34 29 20 6c 6f 67 70 72 6f 2d 75 73 65 us 4) logpro-use
21d0: 64 29 20 27 77 61 69 76 65 64 29 20 3b 3b 20 6c d) 'waived) ;; l
21e0: 6f 67 70 72 6f 20 34 20 3d 20 77 61 69 76 65 64 ogpro 4 = waived
21f0: 0a 09 09 09 20 20 20 20 20 20 28 28 61 6e 64 20 .... ((and
2200: 28 65 71 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 (eq? process-exi
2210: 74 2d 73 74 61 74 75 73 20 35 29 20 6c 6f 67 70 t-status 5) logp
2220: 72 6f 2d 75 73 65 64 29 20 27 61 62 6f 72 74 29 ro-used) 'abort)
2230: 20 20 3b 3b 20 6c 6f 67 70 72 6f 20 35 20 3d 20 ;; logpro 5 =
2240: 61 62 6f 72 74 0a 09 09 09 20 20 20 20 20 20 28 abort.... (
2250: 28 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 73 (and (eq? proces
2260: 73 2d 65 78 69 74 2d 73 74 61 74 75 73 20 36 29 s-exit-status 6)
2270: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 73 logpro-used) 's
2280: 6b 69 70 29 20 20 20 3b 3b 20 6c 6f 67 70 72 6f kip) ;; logpro
2290: 20 36 20 3d 20 73 6b 69 70 0a 09 09 09 20 20 20 6 = skip....
22a0: 20 20 20 28 28 65 71 3f 20 70 72 6f 63 65 73 73 ((eq? process
22b0: 2d 65 78 69 74 2d 73 74 61 74 75 73 20 30 29 20 -exit-status 0)
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d0: 20 20 27 70 61 73 73 29 20 20 20 3b 3b 20 6c 6f 'pass) ;; lo
22e0: 67 70 72 6f 20 30 20 3d 20 70 61 73 73 0a 09 09 gpro 0 = pass...
22f0: 09 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 . (else 'fa
2300: 69 6c 29 29 29 0a 09 20 20 20 28 6f 76 65 72 61 il))).. (overa
2310: 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f 6e ll-status (con
2320: 64 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f d.... ((eq?
2330: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f (launch:einf-ro
2340: 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 llup-status exit
2350: 2d 69 6e 66 6f 29 20 32 29 20 27 77 61 72 6e 29 -info) 2) 'warn)
2360: 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 ;; rollup-statu
2370: 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 s (vector-ref ex
2380: 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 20 20 it-info 3)....
2390: 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 ((eq? (launc
23a0: 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 h:einf-rollup-st
23b0: 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 atus exit-info)
23c0: 30 29 20 27 70 61 73 73 29 20 3b 3b 20 28 76 65 0) 'pass) ;; (ve
23d0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
23e0: 66 6f 20 33 29 0a 09 09 09 20 20 20 20 20 20 28 fo 3).... (
23f0: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 20 else 'fail)))..
2400: 20 20 28 6e 65 78 74 2d 73 74 61 74 75 73 20 20 (next-status
2410: 20 20 20 20 28 63 6f 6e 64 20 0a 09 09 09 20 20 (cond ....
2420: 20 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c ((eq? overal
2430: 6c 2d 73 74 61 74 75 73 20 27 70 61 73 73 29 20 l-status 'pass)
2440: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
2450: 29 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f ).... ((eq?
2460: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 overall-status
2470: 27 77 61 72 6e 29 0a 09 09 09 20 20 20 20 20 20 'warn)....
2480: 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 (if (eq? this-s
2490: 74 65 70 2d 73 74 61 74 75 73 20 27 66 61 69 6c tep-status 'fail
24a0: 29 20 27 66 61 69 6c 20 27 77 61 72 6e 29 29 0a ) 'fail 'warn)).
24b0: 09 09 09 20 20 20 20 20 20 28 28 65 71 3f 20 6f ... ((eq? o
24c0: 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 27 61 verall-status 'a
24d0: 62 6f 72 74 29 20 27 61 62 6f 72 74 29 0a 09 09 bort) 'abort)...
24e0: 09 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 . (else 'fa
24f0: 69 6c 29 29 29 0a 09 20 20 20 28 6e 65 78 74 2d il))).. (next-
2500: 73 74 61 74 65 20 20 20 20 20 20 20 3b 3b 20 22 state ;; "
2510: 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 57 48 59 RUNNING") ;; WHY
2520: 20 57 41 53 20 54 48 49 53 20 43 48 41 4e 47 45 WAS THIS CHANGE
2530: 44 20 54 4f 20 4e 4f 54 20 55 53 45 20 28 6e 75 D TO NOT USE (nu
2540: 6c 6c 3f 20 74 61 6c 29 20 3f 3f 0a 09 20 20 20 ll? tal) ??..
2550: 20 28 63 6f 6e 64 0a 09 20 20 20 20 20 28 28 6e (cond.. ((n
2560: 75 6c 6c 3f 20 74 61 6c 29 20 3b 3b 20 6d 6f 72 ull? tal) ;; mor
2570: 65 20 74 6f 20 72 75 6e 3f 0a 09 20 20 20 20 20 e to run?..
2580: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 20 "COMPLETED")..
2590: 20 20 20 20 28 65 6c 73 65 20 22 52 55 4e 4e 49 (else "RUNNI
25a0: 4e 47 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 NG")))). (d
25b0: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 ebug:print 4 *de
25c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
25d0: 22 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 65 "Exit value rece
25e0: 69 76 65 64 3a 20 22 20 28 6c 61 75 6e 63 68 3a ived: " (launch:
25f0: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 einf-exit-code e
2600: 78 69 74 2d 69 6e 66 6f 29 20 22 20 6c 6f 67 70 xit-info) " logp
2610: 72 6f 2d 75 73 65 64 3a 20 22 20 6c 6f 67 70 72 ro-used: " logpr
2620: 6f 2d 75 73 65 64 20 0a 09 09 20 20 20 22 20 74 o-used ... " t
2630: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 3a his-step-status:
2640: 20 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 " this-step-sta
2650: 74 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 tus " overall-st
2660: 61 74 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c 2d atus: " overall-
2670: 73 74 61 74 75 73 20 0a 09 09 20 20 20 22 20 6e status ... " n
2680: 65 78 74 2d 73 74 61 74 75 73 3a 20 22 20 6e 65 ext-status: " ne
2690: 78 74 2d 73 74 61 74 75 73 20 22 20 72 6f 6c 6c xt-status " roll
26a0: 75 70 2d 73 74 61 74 75 73 3a 20 22 20 20 28 6c up-status: " (l
26b0: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
26c0: 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e p-status exit-in
26d0: 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d fo)) ;; (vector-
26e0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 ref exit-info 3)
26f0: 29 0a 20 20 20 20 20 20 28 63 61 73 65 20 6e 65 ). (case ne
2700: 78 74 2d 73 74 61 74 75 73 0a 09 28 28 77 61 72 xt-status..((war
2710: 6e 29 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e n).. (launch:ein
2720: 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d f-rollup-status-
2730: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 set! exit-info 2
2740: 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 ) ;; (vector-set
2750: 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 32 29 ! exit-info 3 2)
2760: 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 ;; rollup-statu
2770: 73 0a 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 s.. ;; NB// test
2780: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 -set-status! doe
2790: 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 s rdb calls unde
27a0: 72 20 74 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 r the hood.. (te
27b0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
27c0: 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
27d0: 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 65 20 22 -id next-state "
27e0: 57 41 52 4e 22 20 0a 09 09 09 09 20 28 69 66 20 WARN" ..... (if
27f0: 28 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 (eq? this-step-s
2800: 74 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f tatus 'warn) "Lo
2810: 67 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 gpro warning fou
2820: 6e 64 22 20 23 66 29 0a 09 09 09 09 20 23 66 29 nd" #f)..... #f)
2830: 29 0a 09 28 28 63 68 65 63 6b 29 0a 09 20 28 6c )..((check).. (l
2840: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
2850: 70 2d 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 p-status-set! ex
2860: 69 74 2d 69 6e 66 6f 20 33 29 20 3b 3b 20 28 76 it-info 3) ;; (v
2870: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
2880: 69 6e 66 6f 20 33 20 33 29 20 3b 3b 20 72 6f 6c info 3 3) ;; rol
2890: 6c 75 70 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 lup-status.. ;;
28a0: 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 NB// test-set-st
28b0: 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 atus! does rdb c
28c0: 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 alls under the h
28d0: 6f 6f 64 0a 09 20 28 74 65 73 74 73 3a 74 65 73 ood.. (tests:tes
28e0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
28f0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 78 n-id test-id nex
2900: 74 2d 73 74 61 74 65 20 22 43 48 45 43 4b 22 20 t-state "CHECK"
2910: 0a 09 09 09 09 20 28 69 66 20 28 65 71 3f 20 74 ..... (if (eq? t
2920: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
2930: 27 63 68 65 63 6b 29 20 22 4c 6f 67 70 72 6f 20 'check) "Logpro
2940: 63 68 65 63 6b 20 66 6f 75 6e 64 22 20 23 66 29 check found" #f)
2950: 0a 09 09 09 09 20 23 66 29 29 0a 09 28 28 77 61 ..... #f))..((wa
2960: 69 76 65 64 29 0a 09 20 28 6c 61 75 6e 63 68 3a ived).. (launch:
2970: 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 einf-rollup-stat
2980: 75 73 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 us-set! exit-inf
2990: 6f 20 34 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d o 4) ;; (vector-
29a0: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 set! exit-info 3
29b0: 20 33 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 3) ;; rollup-st
29c0: 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f 2f 20 74 atus.. ;; NB// t
29d0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
29e0: 64 6f 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 does rdb calls u
29f0: 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 20 nder the hood..
2a00: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
2a10: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
2a20: 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 est-id next-stat
2a30: 65 20 22 57 41 49 56 45 44 22 20 0a 09 09 09 09 e "WAIVED" .....
2a40: 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d 73 (if (eq? this-s
2a50: 74 65 70 2d 73 74 61 74 75 73 20 27 63 68 65 63 tep-status 'chec
2a60: 6b 29 20 22 4c 6f 67 70 72 6f 20 77 61 69 76 65 k) "Logpro waive
2a70: 64 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 d found" #f)....
2a80: 09 20 23 66 29 29 0a 09 28 28 61 62 6f 72 74 29 . #f))..((abort)
2a90: 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d .. (launch:einf-
2aa0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 rollup-status-se
2ab0: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 35 29 20 t! exit-info 5)
2ac0: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
2ad0: 65 78 69 74 2d 69 6e 66 6f 20 33 20 34 29 20 3b exit-info 3 4) ;
2ae0: 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a ; rollup-status.
2af0: 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 . ;; NB// test-s
2b00: 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 20 et-status! does
2b10: 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 rdb calls under
2b20: 74 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 73 74 the hood.. (test
2b30: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
2b40: 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
2b50: 64 20 6e 65 78 74 2d 73 74 61 74 65 20 22 41 42 d next-state "AB
2b60: 4f 52 54 22 20 0a 09 09 09 09 20 28 69 66 20 28 ORT" ..... (if (
2b70: 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 eq? this-step-st
2b80: 61 74 75 73 20 27 61 62 6f 72 74 29 20 22 4c 6f atus 'abort) "Lo
2b90: 67 70 72 6f 20 61 62 6f 72 74 20 66 6f 75 6e 64 gpro abort found
2ba0: 22 20 23 66 29 0a 09 09 09 09 20 23 66 29 29 0a " #f)..... #f)).
2bb0: 09 28 28 73 6b 69 70 29 0a 09 20 28 6c 61 75 6e .((skip).. (laun
2bc0: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
2bd0: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
2be0: 69 6e 66 6f 20 36 29 20 3b 3b 20 28 76 65 63 74 info 6) ;; (vect
2bf0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2c00: 6f 20 33 20 34 29 20 3b 3b 20 72 6f 6c 6c 75 70 o 3 4) ;; rollup
2c10: 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f -status.. ;; NB/
2c20: 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 / test-set-statu
2c30: 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c s! does rdb call
2c40: 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 s under the hood
2c50: 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 .. (tests:test-s
2c60: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
2c70: 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 d test-id next-s
2c80: 74 61 74 65 20 22 53 4b 49 50 22 20 0a 09 09 09 tate "SKIP" ....
2c90: 09 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 2d . (if (eq? this-
2ca0: 73 74 65 70 2d 73 74 61 74 75 73 20 27 73 6b 69 step-status 'ski
2cb0: 70 29 20 22 4c 6f 67 70 72 6f 20 73 6b 69 70 20 p) "Logpro skip
2cc0: 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 09 09 20 found" #f).....
2cd0: 23 66 29 29 0a 09 28 28 70 61 73 73 29 0a 09 20 #f))..((pass)..
2ce0: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
2cf0: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
2d00: 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 est-id next-stat
2d10: 65 20 22 50 41 53 53 22 20 23 66 20 23 66 29 29 e "PASS" #f #f))
2d20: 0a 09 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c ..(else ;; 'fail
2d30: 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d .. (launch:einf-
2d40: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 rollup-status-se
2d50: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 20 t! exit-info 1)
2d60: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
2d70: 65 78 69 74 2d 69 6e 66 6f 20 33 20 31 29 20 3b exit-info 3 1) ;
2d80: 3b 20 66 6f 72 63 65 20 66 61 69 6c 2c 20 74 68 ; force fail, th
2d90: 69 73 20 75 73 65 64 20 74 6f 20 62 65 20 6e 65 is used to be ne
2da0: 78 74 2d 73 74 61 74 65 20 62 75 74 20 74 68 61 xt-state but tha
2db0: 74 20 64 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 t doesn't make s
2dc0: 65 6e 73 65 2e 20 73 68 6f 75 6c 64 20 61 6c 77 ense. should alw
2dd0: 61 79 73 20 62 65 20 22 43 4f 4d 50 4c 45 54 45 ays be "COMPLETE
2de0: 44 22 20 0a 09 20 28 74 65 73 74 73 3a 74 65 73 D" .. (tests:tes
2df0: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
2e00: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 43 4f n-id test-id "CO
2e10: 4d 50 4c 45 54 45 44 22 20 22 46 41 49 4c 22 20 MPLETED" "FAIL"
2e20: 28 63 6f 6e 63 20 22 46 61 69 6c 65 64 20 61 74 (conc "Failed at
2e30: 20 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 step " stepname
2e40: 29 20 23 66 29 0a 09 20 29 29 29 0a 20 20 20 20 ) #f).. ))).
2e50: 6c 6f 67 70 72 6f 2d 75 73 65 64 29 29 0a 0a 28 logpro-used))..(
2e60: 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 6d define (launch:m
2e70: 61 6e 61 67 65 2d 73 74 65 70 73 20 72 75 6e 2d anage-steps run-
2e80: 69 64 20 74 65 73 74 2d 69 64 20 69 74 65 6d 2d id test-id item-
2e90: 70 61 74 68 20 66 75 6c 6c 72 75 6e 73 63 72 69 path fullrunscri
2ea0: 70 74 20 65 7a 73 74 65 70 73 20 74 65 73 74 2d pt ezsteps test-
2eb0: 6e 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 67 20 name tconfigreg
2ec0: 65 78 69 74 2d 69 6e 66 6f 20 6d 29 0a 20 20 3b exit-info m). ;
2ed0: 3b 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 20 20 ; (let-values.
2ee0: 3b 3b 20 20 28 28 28 70 69 64 20 65 78 69 74 2d ;; (((pid exit-
2ef0: 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 status exit-code
2f00: 29 0a 20 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e ). ;; (run-n
2f10: 2d 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 -wait fullrunscr
2f20: 69 70 74 29 29 29 0a 20 20 3b 3b 20 28 74 65 73 ipt))). ;; (tes
2f30: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
2f40: 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 55 4e us! test-id "RUN
2f50: 4e 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 20 23 NING" "n/a" #f #
2f60: 66 29 0a 20 20 3b 3b 20 53 69 6e 63 65 20 77 65 f). ;; Since we
2f70: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 61 20 63 should have a c
2f80: 6c 65 61 6e 20 73 6c 61 74 65 20 61 74 20 74 68 lean slate at th
2f90: 69 73 20 74 69 6d 65 20 74 68 65 72 65 20 69 73 is time there is
2fa0: 20 6e 6f 20 6e 65 65 64 20 74 6f 20 64 6f 20 0a no need to do .
2fb0: 20 20 3b 3b 20 61 6e 79 20 6f 66 20 74 68 65 20 ;; any of the
2fc0: 6f 74 68 65 72 20 73 74 75 66 66 20 74 68 61 74 other stuff that
2fd0: 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d tests:test-set-
2fe0: 73 74 61 74 75 73 21 20 64 6f 65 73 2e 20 4c 65 status! does. Le
2ff0: 74 27 73 20 6a 75 73 74 20 0a 20 20 3b 3b 20 66 t's just . ;; f
3000: 6f 72 63 65 20 52 55 4e 4e 49 4e 47 2f 6e 2f 61 orce RUNNING/n/a
3010: 0a 0a 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 .. ;; (thread-s
3020: 6c 65 65 70 21 20 30 2e 33 29 0a 20 20 3b 3b 20 leep! 0.3). ;;
3030: 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 63 (tests:test-forc
3040: 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 20 e-state-status!
3050: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 run-id test-id "
3060: 52 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 29 0a RUNNING" "n/a").
3070: 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 (rmt:set-state
3080: 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c -status-and-roll
3090: 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 -up-items run-id
30a0: 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d test-name item-
30b0: 70 61 74 68 20 22 52 55 4e 4e 49 4e 47 22 20 23 path "RUNNING" #
30c0: 66 20 23 66 29 20 0a 20 20 3b 3b 20 28 74 68 72 f #f) . ;; (thr
30d0: 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 33 29 20 ead-sleep! 0.3)
30e0: 3b 3b 20 4e 46 53 20 73 6c 6f 77 6e 65 73 73 20 ;; NFS slowness
30f0: 68 61 73 20 63 61 75 73 65 64 20 67 72 69 65 66 has caused grief
3100: 20 68 65 72 65 0a 0a 20 20 3b 3b 20 69 66 20 74 here.. ;; if t
3110: 68 65 72 65 20 69 73 20 61 20 72 75 6e 73 63 72 here is a runscr
3120: 69 70 74 20 64 6f 20 69 74 20 66 69 72 73 74 0a ipt do it first.
3130: 20 20 28 69 66 20 66 75 6c 6c 72 75 6e 73 63 72 (if fullrunscr
3140: 69 70 74 0a 20 20 20 20 20 20 28 6c 65 74 20 28 ipt. (let (
3150: 28 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 (pid (process-ru
3160: 6e 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 n fullrunscript)
3170: 29 29 0a 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 ))..(rmt:test-se
3180: 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 t-top-process-pi
3190: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
31a0: 20 70 69 64 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 pid)..(let loop
31b0: 20 28 28 69 20 30 29 29 0a 09 20 20 28 6c 65 74 ((i 0)).. (let
31c0: 2d 76 61 6c 75 65 73 0a 09 20 20 20 28 28 28 70 -values.. (((p
31d0: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat
31e0: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 20 28 70 us exit-code) (p
31f0: 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 rocess-wait pid
3200: 23 74 29 29 29 0a 09 20 20 20 28 6d 75 74 65 78 #t))).. (mutex
3210: 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 28 6c -lock! m).. (l
3220: 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 2d 73 aunch:einf-pid-s
3230: 65 74 21 20 20 20 20 20 20 20 20 20 20 20 65 78 et! ex
3240: 69 74 2d 69 6e 66 6f 20 20 70 69 64 29 20 20 20 it-info pid)
3250: 20 20 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 ;; (vector
3260: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
3270: 30 20 70 69 64 29 0a 09 20 20 20 28 6c 61 75 6e 0 pid).. (laun
3280: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 ch:einf-exit-sta
3290: 74 75 73 2d 73 65 74 21 20 20 20 65 78 69 74 2d tus-set! exit-
32a0: 69 6e 66 6f 20 20 65 78 69 74 2d 73 74 61 74 75 info exit-statu
32b0: 73 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 s) ;; (vector-se
32c0: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 t! exit-info 1 e
32d0: 78 69 74 2d 73 74 61 74 75 73 29 0a 09 20 20 20 xit-status)..
32e0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 (launch:einf-exi
32f0: 74 2d 63 6f 64 65 2d 73 65 74 21 20 20 20 20 20 t-code-set!
3300: 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d exit-info exit-
3310: 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 65 63 74 code) ;; (vect
3320: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
3330: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
3340: 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d (launch:einf-
3350: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 rollup-status-se
3360: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 t! exit-info ex
3370: 69 74 2d 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 it-code) ;; (v
3380: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
3390: 69 6e 66 6f 20 33 20 65 78 69 74 2d 63 6f 64 65 info 3 exit-code
33a0: 29 20 20 3b 3b 20 72 6f 6c 6c 75 70 20 73 74 61 ) ;; rollup sta
33b0: 74 75 73 0a 09 20 20 20 28 6d 75 74 65 78 2d 75 tus.. (mutex-u
33c0: 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 28 69 nlock! m).. (i
33d0: 66 20 28 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 f (eq? pid-val 0
33e0: 29 0a 09 20 20 20 20 20 20 20 28 62 65 67 69 6e ).. (begin
33f0: 0a 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ... (thread-slee
3400: 70 21 20 32 29 0a 09 09 20 28 6c 6f 6f 70 20 28 p! 2)... (loop (
3410: 2b 20 69 20 31 29 29 29 0a 09 20 20 20 20 20 20 + i 1)))..
3420: 20 29 29 29 29 29 0a 20 20 3b 3b 20 74 68 65 6e ))))). ;; then
3430: 2c 20 69 66 20 72 75 6e 73 63 72 69 70 74 20 72 , if runscript r
3440: 61 6e 20 6f 6b 20 28 6f 72 20 64 69 64 20 6e 6f an ok (or did no
3450: 74 20 67 65 74 20 63 61 6c 6c 65 64 29 0a 20 20 t get called).
3460: 3b 3b 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a ;; do all the ez
3470: 73 74 65 70 73 20 28 69 66 20 61 6e 79 29 0a 20 steps (if any).
3480: 20 28 69 66 20 65 7a 73 74 65 70 73 0a 20 20 20 (if ezsteps.
3490: 20 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 63 (let* ((testc
34a0: 6f 6e 66 69 67 20 3b 3b 20 28 72 65 61 64 2d 63 onfig ;; (read-c
34b0: 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f 72 6b onfig (conc work
34c0: 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f 6e 66 -area "/testconf
34d0: 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 69 72 ig") #f #t envir
34e0: 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d 6c 61 on-patt: "pre-la
34f0: 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 29 unch-env-vars"))
3500: 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 73 20 ;; FIXME??? is
3510: 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f 6b 20 allow-system ok
3520: 68 65 72 65 3f 0a 09 20 20 20 20 20 20 3b 3b 20 here?.. ;;
3530: 4e 4f 54 45 3a 20 69 74 20 69 73 20 74 65 6d 70 NOTE: it is temp
3540: 74 69 6e 67 20 74 6f 20 74 75 72 6e 20 6f 66 66 ting to turn off
3550: 20 66 6f 72 63 65 2d 63 72 65 61 74 65 20 6f 66 force-create of
3560: 20 74 65 73 74 63 6f 6e 66 69 67 20 62 75 74 20 testconfig but
3570: 64 79 6e 61 6d 69 63 0a 09 20 20 20 20 20 20 3b dynamic.. ;
3580: 3b 20 20 20 20 20 20 20 65 7a 73 74 65 70 20 6e ; ezstep n
3590: 61 6d 65 73 20 6e 65 65 64 20 61 20 66 75 6c 6c ames need a full
35a0: 20 72 65 2d 65 76 61 6c 20 68 65 72 65 2e 0a 09 re-eval here...
35b0: 20 20 20 20 20 20 28 74 65 73 74 73 3a 67 65 74 (tests:get
35c0: 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 -testconfig test
35d0: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
35e0: 74 63 6f 6e 66 69 67 72 65 67 20 23 74 20 66 6f tconfigreg #t fo
35f0: 72 63 65 2d 63 72 65 61 74 65 3a 20 23 74 29 29 rce-create: #t))
3600: 20 3b 3b 20 27 72 65 74 75 72 6e 2d 70 72 6f 63 ;; 'return-proc
3610: 73 29 29 29 0a 09 20 20 20 20 20 28 65 7a 73 74 s))).. (ezst
3620: 65 70 73 6c 73 74 20 28 69 66 20 28 68 61 73 68 epslst (if (hash
3630: 2d 74 61 62 6c 65 3f 20 74 65 73 74 63 6f 6e 66 -table? testconf
3640: 69 67 29 0a 09 09 09 20 20 20 20 20 28 68 61 73 ig).... (has
3650: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
3660: 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 ult testconfig "
3670: 65 7a 73 74 65 70 73 22 20 27 28 29 29 0a 09 09 ezsteps" '())...
3680: 09 20 20 20 20 20 23 66 29 29 29 0a 09 28 69 66 . #f)))..(if
3690: 20 74 65 73 74 63 6f 6e 66 69 67 0a 09 20 20 20 testconfig..
36a0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 (hash-table-set
36b0: 21 20 2a 74 65 73 74 63 6f 6e 66 69 67 73 2a 20 ! *testconfigs*
36c0: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 63 6f test-name testco
36d0: 6e 66 69 67 29 20 3b 3b 20 63 61 63 68 65 64 20 nfig) ;; cached
36e0: 66 6f 72 20 6c 61 7a 79 20 72 65 61 64 73 20 6c for lazy reads l
36f0: 61 74 65 72 20 2e 2e 2e 0a 09 20 20 20 20 28 62 ater ..... (b
3700: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 6c 61 75 egin.. (lau
3710: 6e 63 68 3a 73 65 74 75 70 29 0a 09 20 20 20 20 nch:setup)..
3720: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
3730: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3740: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 6e 6f rt* "WARNING: no
3750: 20 74 65 73 74 63 6f 6e 66 69 67 20 66 6f 75 6e testconfig foun
3760: 64 20 66 6f 72 20 22 20 74 65 73 74 2d 6e 61 6d d for " test-nam
3770: 65 20 22 20 69 6e 20 73 65 61 72 63 68 20 70 61 e " in search pa
3780: 74 68 3a 5c 6e 20 20 22 0a 09 09 09 20 20 20 28 th:\n ".... (
3790: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
37a0: 73 65 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 se (tests:get-te
37b0: 73 74 73 2d 73 65 61 72 63 68 2d 70 61 74 68 20 sts-search-path
37c0: 2a 63 6f 6e 66 69 67 64 61 74 2a 29 20 22 5c 6e *configdat*) "\n
37d0: 20 20 22 29 29 29 29 0a 09 3b 3b 20 61 66 74 65 "))))..;; afte
37e0: 72 20 61 6c 6c 20 74 68 61 74 2c 20 73 74 69 6c r all that, stil
37f0: 6c 20 6e 6f 20 74 65 73 74 63 6f 6e 66 69 67 3f l no testconfig?
3800: 20 54 69 6d 65 20 74 6f 20 61 62 6f 72 74 0a 09 Time to abort..
3810: 28 69 66 20 28 6e 6f 74 20 74 65 73 74 63 6f 6e (if (not testcon
3820: 66 69 67 29 0a 09 20 20 20 20 28 62 65 67 69 6e fig).. (begin
3830: 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
3840: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
3850: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3860: 22 46 61 69 6c 65 64 20 74 6f 20 72 65 73 6f 6c "Failed to resol
3870: 76 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 ve megatest.conf
3880: 69 67 2c 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 ig, runconfigs.c
3890: 6f 6e 66 69 67 20 61 6e 64 20 74 65 73 74 63 6f onfig and testco
38a0: 6e 66 69 67 20 69 73 73 75 65 73 2e 20 47 69 76 nfig issues. Giv
38b0: 69 6e 67 20 75 70 20 6e 6f 77 22 29 0a 09 20 20 ing up now")..
38c0: 20 20 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 (exit 1)))..
38d0: 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e (if (not (common
38e0: 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e :file-exists? ".
38f0: 65 7a 73 74 65 70 73 22 29 29 28 63 72 65 61 74 ezsteps"))(creat
3900: 65 2d 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a e-directory ".ez
3910: 73 74 65 70 73 22 29 29 0a 09 3b 3b 20 69 66 20 steps"))..;; if
3920: 65 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 69 ezsteps was defi
3930: 6e 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 20 ned then we are
3940: 73 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 20 sure to have at
3950: 6c 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 62 least one step b
3960: 75 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 0a ut check anyway.
3970: 09 28 69 66 20 28 6e 6f 74 20 28 3e 20 28 6c 65 .(if (not (> (le
3980: 6e 67 74 68 20 65 7a 73 74 65 70 73 6c 73 74 29 ngth ezstepslst)
3990: 20 30 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 0)).. (debug
39a0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
39b0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
39c0: 2a 20 22 65 7a 73 74 65 70 73 20 64 65 66 69 6e * "ezsteps defin
39d0: 65 64 20 62 75 74 20 65 7a 73 74 65 70 73 6c 73 ed but ezstepsls
39e0: 74 20 69 73 20 7a 65 72 6f 20 6c 65 6e 67 74 68 t is zero length
39f0: 22 29 0a 09 20 20 20 20 28 6c 65 74 20 6c 6f 6f ").. (let loo
3a00: 70 20 28 28 65 7a 73 74 65 70 20 28 63 61 72 20 p ((ezstep (car
3a10: 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 20 ezstepslst))...
3a20: 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 (tal (c
3a30: 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a dr ezstepslst)).
3a40: 09 09 20 20 20 20 20 20 20 28 70 72 65 76 73 74 .. (prevst
3a50: 65 70 20 23 66 29 29 0a 09 20 20 20 20 20 20 3b ep #f)).. ;
3a60: 3b 20 63 68 65 63 6b 20 65 78 69 74 2d 69 6e 66 ; check exit-inf
3a70: 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 o (vector-ref ex
3a80: 69 74 2d 69 6e 66 6f 20 31 29 0a 09 20 20 20 20 it-info 1)..
3a90: 20 20 28 69 66 20 28 6c 61 75 6e 63 68 3a 65 69 (if (launch:ei
3aa0: 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 20 65 nf-exit-status e
3ab0: 78 69 74 2d 69 6e 66 6f 29 20 3b 3b 20 28 76 65 xit-info) ;; (ve
3ac0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
3ad0: 66 6f 20 31 29 0a 09 09 20 20 28 6c 65 74 20 28 fo 1)... (let (
3ae0: 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 6c 61 (logpro-used (la
3af0: 75 6e 63 68 3a 72 75 6e 73 74 65 70 20 65 7a 73 unch:runstep ezs
3b00: 74 65 70 20 72 75 6e 2d 69 64 20 74 65 73 74 2d tep run-id test-
3b10: 69 64 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 74 id exit-info m t
3b20: 61 6c 20 74 65 73 74 63 6f 6e 66 69 67 29 29 0a al testconfig)).
3b30: 09 09 09 28 73 74 65 70 6e 61 6d 65 20 20 20 20 ...(stepname
3b40: 28 63 61 72 20 65 7a 73 74 65 70 29 29 29 0a 09 (car ezstep)))..
3b50: 09 20 20 20 20 3b 3b 20 69 66 20 6c 6f 67 70 72 . ;; if logpr
3b60: 6f 2d 75 73 65 64 20 72 65 61 64 20 69 6e 20 74 o-used read in t
3b70: 68 65 20 73 74 65 70 6e 61 6d 65 2e 64 61 74 20 he stepname.dat
3b80: 66 69 6c 65 0a 09 09 20 20 20 20 28 69 66 20 28 file... (if (
3b90: 61 6e 64 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 and logpro-used
3ba0: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
3bb0: 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 65 70 6e sts? (conc stepn
3bc0: 61 6d 65 20 22 2e 64 61 74 22 29 29 29 0a 09 09 ame ".dat")))...
3bd0: 09 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f .(launch:load-lo
3be0: 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 gpro-dat run-id
3bf0: 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 test-id stepname
3c00: 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 73 74 ))... (if (st
3c10: 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 70 eprun-good? logp
3c20: 72 6f 2d 75 73 65 64 20 28 6c 61 75 6e 63 68 3a ro-used (launch:
3c30: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 einf-exit-code e
3c40: 78 69 74 2d 69 6e 66 6f 29 29 0a 09 09 09 28 69 xit-info))....(i
3c50: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 f (not (null? ta
3c60: 6c 29 29 0a 09 09 09 20 20 20 20 28 6c 6f 6f 70 l)).... (loop
3c70: 20 28 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 (car tal) (cdr
3c80: 74 61 6c 29 20 73 74 65 70 6e 61 6d 65 29 29 0a tal) stepname)).
3c90: 09 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
3ca0: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
3cb0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 73 ort* "WARNING: s
3cc0: 74 65 70 20 22 20 28 63 61 72 20 65 7a 73 74 65 tep " (car ezste
3cd0: 70 29 20 22 20 66 61 69 6c 65 64 2e 20 53 74 6f p) " failed. Sto
3ce0: 70 70 69 6e 67 22 29 29 29 0a 09 09 20 20 28 64 pping")))... (d
3cf0: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 ebug:print 4 *de
3d00: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3d10: 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 6f "WARNING: a prio
3d20: 72 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 73 r step failed, s
3d30: 74 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a 73 topping at " ezs
3d40: 74 65 70 29 29 29 29 29 29 29 0a 0a 28 64 65 66 tep)))))))..(def
3d50: 69 6e 65 20 28 6c 61 75 6e 63 68 3a 6d 6f 6e 69 ine (launch:moni
3d60: 74 6f 72 2d 6a 6f 62 20 72 75 6e 2d 69 64 20 74 tor-job run-id t
3d70: 65 73 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 est-id item-path
3d80: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 fullrunscript e
3d90: 7a 73 74 65 70 73 20 74 65 73 74 2d 6e 61 6d 65 zsteps test-name
3da0: 20 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 tconfigreg exit
3db0: 2d 69 6e 66 6f 20 6d 20 77 6f 72 6b 2d 61 72 65 -info m work-are
3dc0: 61 20 72 75 6e 74 6c 69 6d 20 6d 69 73 63 2d 66 a runtlim misc-f
3dd0: 6c 61 67 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 lags). (let* ((
3de0: 75 70 64 61 74 65 2d 70 65 72 69 6f 64 20 28 73 update-period (s
3df0: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f tring->number (o
3e00: 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 r (configf:looku
3e10: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
3e20: 65 74 75 70 22 20 22 74 65 73 74 2d 73 74 61 74 etup" "test-stat
3e30: 73 2d 75 70 64 61 74 65 2d 70 65 72 69 6f 64 22 s-update-period"
3e40: 29 20 22 33 30 22 29 29 29 0a 20 20 20 20 20 20 ) "30"))).
3e50: 20 20 20 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 (start-second
3e60: 73 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e s (current-secon
3e70: 64 73 29 29 0a 09 20 28 63 61 6c 63 2d 6d 69 6e ds)).. (calc-min
3e80: 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 28 29 utes (lambda ()
3e90: 0a 09 09 09 20 20 28 69 6e 65 78 61 63 74 2d 3e .... (inexact->
3ea0: 65 78 61 63 74 20 0a 09 09 09 20 20 20 28 72 6f exact .... (ro
3eb0: 75 6e 64 20 0a 09 09 09 20 20 20 20 28 2d 20 0a und .... (- .
3ec0: 09 09 09 20 20 20 20 20 28 63 75 72 72 65 6e 74 ... (current
3ed0: 2d 73 65 63 6f 6e 64 73 29 20 0a 09 09 09 20 20 -seconds) ....
3ee0: 20 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 start-seconds
3ef0: 29 29 29 29 29 0a 09 20 28 6b 69 6c 6c 2d 74 72 ))))).. (kill-tr
3f00: 69 65 73 20 30 29 29 0a 20 20 20 20 3b 3b 20 28 ies 0)). ;; (
3f10: 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d tests:set-full-m
3f20: 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 eta-info #f test
3f30: 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 6c 63 -id run-id (calc
3f40: 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b 2d 61 -minutes) work-a
3f50: 72 65 61 29 0a 20 20 20 20 3b 3b 20 28 74 65 73 rea). ;; (tes
3f60: 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 ts:set-full-meta
3f70: 2d 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 75 -info test-id ru
3f80: 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e 75 74 n-id (calc-minut
3f90: 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 es) work-area).
3fa0: 20 20 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 (tests:set-fu
3fb0: 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 ll-meta-info #f
3fc0: 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 test-id run-id (
3fd0: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f calc-minutes) wo
3fe0: 72 6b 2d 61 72 65 61 20 31 30 29 0a 20 20 20 20 rk-area 10).
3ff0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 (let loop ((minu
4000: 74 65 73 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 tes (calc-minu
4010: 74 65 73 29 29 0a 09 20 20 20 20 20 20 20 28 63 tes)).. (c
4020: 70 75 2d 6c 6f 61 64 20 20 28 61 6c 69 73 74 2d pu-load (alist-
4030: 72 65 66 20 27 61 64 6a 2d 63 6f 72 65 2d 6c 6f ref 'adj-core-lo
4040: 61 64 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6e ad (common:get-n
4050: 6f 72 6d 61 6c 69 7a 65 64 2d 63 70 75 2d 6c 6f ormalized-cpu-lo
4060: 61 64 20 23 66 29 29 29 0a 09 20 20 20 20 20 20 ad #f)))..
4070: 20 28 64 69 73 6b 2d 66 72 65 65 20 28 67 65 74 (disk-free (get
4080: 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 -df (current-dir
4090: 65 63 74 6f 72 79 29 29 29 0a 20 20 20 20 20 20 ectory))).
40a0: 20 20 20 20 20 20 20 20 20 28 6c 61 73 74 2d 73 (last-s
40b0: 79 6e 63 20 28 63 75 72 72 65 6e 74 2d 73 65 63 ync (current-sec
40c0: 6f 6e 64 73 29 29 29 0a 20 20 20 20 20 20 28 6c onds))). (l
40d0: 65 74 2a 20 28 28 6f 76 65 72 2d 74 69 6d 65 20 et* ((over-time
40e0: 20 20 20 20 28 3e 20 28 63 75 72 72 65 6e 74 2d (> (current-
40f0: 73 65 63 6f 6e 64 73 29 20 28 2b 20 6c 61 73 74 seconds) (+ last
4100: 2d 73 79 6e 63 20 75 70 64 61 74 65 2d 70 65 72 -sync update-per
4110: 69 6f 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 iod))).
4120: 20 20 20 20 28 6e 65 77 2d 63 70 75 2d 6c 6f 61 (new-cpu-loa
4130: 64 20 20 28 6c 65 74 2a 20 28 28 6c 6f 61 64 20 d (let* ((load
4140: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 64 6a (alist-ref 'adj
4150: 2d 63 6f 72 65 2d 6c 6f 61 64 20 28 63 6f 6d 6d -core-load (comm
4160: 6f 6e 3a 67 65 74 2d 6e 6f 72 6d 61 6c 69 7a 65 on:get-normalize
4170: 64 2d 63 70 75 2d 6c 6f 61 64 20 23 66 29 29 29 d-cpu-load #f)))
4180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41a0: 20 20 20 20 28 64 65 6c 74 61 20 28 61 62 73 20 (delta (abs
41b0: 28 2d 20 6c 6f 61 64 20 63 70 75 2d 6c 6f 61 64 (- load cpu-load
41c0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
41d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41e0: 20 20 20 28 69 66 20 28 3e 20 64 65 6c 74 61 20 (if (> delta
41f0: 30 2e 31 29 20 3b 3b 20 64 6f 6e 27 74 20 62 6f 0.1) ;; don't bo
4200: 74 68 65 72 20 75 70 64 61 74 69 6e 67 20 77 69 ther updating wi
4210: 74 68 20 73 6d 61 6c 6c 20 63 68 61 6e 67 65 73 th small changes
4220: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4240: 20 20 20 6c 6f 61 64 0a 20 20 20 20 20 20 20 20 load.
4250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4260: 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 0a #f))).
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
4280: 77 2d 64 69 73 6b 2d 66 72 65 65 20 28 6c 65 74 w-disk-free (let
4290: 2a 20 28 28 64 66 20 20 20 20 28 69 66 20 6f 76 * ((df (if ov
42a0: 65 72 2d 74 69 6d 65 20 3b 3b 20 6f 6e 6c 79 20 er-time ;; only
42b0: 67 65 74 20 64 66 20 65 76 65 72 79 20 33 30 20 get df every 30
42c0: 73 65 63 6f 6e 64 73 0a 20 20 20 20 20 20 20 20 seconds.
42d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 20 20 20 20 20 28 67 65 74 2d 64 66 20 28 63 (get-df (c
4300: 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 urrent-directory
4310: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4340: 20 64 69 73 6b 2d 66 72 65 65 29 29 0a 20 20 20 disk-free)).
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4370: 28 64 65 6c 74 61 20 28 61 62 73 20 28 2d 20 64 (delta (abs (- d
4380: 66 20 64 69 73 6b 2d 66 72 65 65 29 29 29 29 0a f disk-free)))).
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
43b0: 66 20 28 61 6e 64 20 28 3e 20 64 66 20 30 29 0a f (and (> df 0).
43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43e0: 20 20 20 20 20 20 20 28 3e 20 28 2f 20 64 65 6c (> (/ del
43f0: 74 61 20 64 66 29 20 30 2e 31 29 29 20 3b 3b 20 ta df) 0.1)) ;;
4400: 28 3e 20 64 65 6c 74 61 20 32 30 30 29 20 3b 3b (> delta 200) ;;
4410: 20 69 67 6e 6f 72 65 20 63 68 61 6e 67 65 73 20 ignore changes
4420: 75 6e 64 65 72 20 32 30 30 20 4d 65 67 0a 20 20 under 200 Meg.
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 64 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 df.
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 20 #f))).
4480: 20 20 20 20 20 20 20 20 28 64 6f 2d 73 79 6e 63 (do-sync
4490: 20 20 20 20 20 20 20 28 6f 72 20 6e 65 77 2d 63 (or new-c
44a0: 70 75 2d 6c 6f 61 64 20 6e 65 77 2d 64 69 73 6b pu-load new-disk
44b0: 2d 66 72 65 65 20 6f 76 65 72 2d 74 69 6d 65 29 -free over-time)
44c0: 29 29 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 )). (debu
44d0: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
44e0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 70 lt-log-port* "cp
44f0: 75 3a 20 22 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 u: " new-cpu-loa
4500: 64 20 22 20 64 69 73 6b 3a 20 22 20 6e 65 77 2d d " disk: " new-
4510: 64 69 73 6b 2d 66 72 65 65 20 22 20 6c 61 73 74 disk-free " last
4520: 2d 73 79 6e 63 3a 20 22 20 6c 61 73 74 2d 73 79 -sync: " last-sy
4530: 6e 63 20 22 20 64 6f 2d 73 79 6e 63 3a 20 22 20 nc " do-sync: "
4540: 64 6f 2d 73 79 6e 63 29 0a 09 28 73 65 74 21 20 do-sync)..(set!
4550: 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 6f 72 20 28 74 kill-job? (or (t
4560: 65 73 74 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 est-get-kill-req
4570: 75 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 74 uest run-id test
4580: 2d 69 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 -id) ;; run-id t
4590: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 est-name itemdat
45a0: 29 29 0a 09 09 09 20 20 20 20 28 61 6e 64 20 72 )).... (and r
45b0: 75 6e 74 6c 69 6d 20 28 6c 65 74 2a 20 28 28 72 untlim (let* ((r
45c0: 75 6e 2d 73 65 63 6f 6e 64 73 20 20 20 28 2d 20 un-seconds (-
45d0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
45e0: 29 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 ) start-seconds)
45f0: 29 0a 09 09 09 09 09 09 28 74 69 6d 65 2d 65 78 ).......(time-ex
4600: 63 65 65 64 65 64 20 28 3e 20 72 75 6e 2d 73 65 ceeded (> run-se
4610: 63 6f 6e 64 73 20 72 75 6e 74 6c 69 6d 29 29 29 conds runtlim)))
4620: 0a 09 09 09 09 09 20 20 20 28 69 66 20 74 69 6d ...... (if tim
4630: 65 2d 65 78 63 65 65 64 65 64 0a 09 09 09 09 09 e-exceeded......
4640: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
4650: 09 09 09 09 20 28 64 65 62 75 67 3a 70 72 69 6e .... (debug:prin
4660: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
4670: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 49 4c t-log-port* "KIL
4680: 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 54 4f LING TEST DUE TO
4690: 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 45 TIME LIMIT EXCE
46a0: 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 20 EDED! Runtime="
46b0: 72 75 6e 2d 73 65 63 6f 6e 64 73 20 22 20 73 65 run-seconds " se
46c0: 63 6f 6e 64 73 2c 20 6c 69 6d 69 74 3d 22 20 72 conds, limit=" r
46d0: 75 6e 74 6c 69 6d 29 0a 09 09 09 09 09 09 20 23 untlim)....... #
46e0: 74 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 23 t)...... #
46f0: 66 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 f))))). (
4700: 69 66 20 64 6f 2d 73 79 6e 63 0a 20 20 20 20 20 if do-sync.
4710: 20 20 20 20 20 20 20 28 74 65 73 74 73 3a 75 70 (tests:up
4720: 64 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d 65 74 date-central-met
4730: 61 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 74 65 a-info run-id te
4740: 73 74 2d 69 64 20 6e 65 77 2d 63 70 75 2d 6c 6f st-id new-cpu-lo
4750: 61 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 ad new-disk-free
4760: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 (calc-minutes)
4770: 23 66 20 23 66 29 29 0a 09 28 69 66 20 6b 69 6c #f #f))..(if kil
4780: 6c 2d 6a 6f 62 3f 20 0a 09 20 20 20 20 28 62 65 l-job? .. (be
4790: 67 69 6e 0a 09 20 20 20 20 20 20 28 6d 75 74 65 gin.. (mute
47a0: 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 x-lock! m)..
47b0: 20 20 3b 3b 20 4e 4f 54 45 3a 20 54 68 65 20 70 ;; NOTE: The p
47c0: 69 64 20 63 61 6e 20 63 68 61 6e 67 65 20 61 73 id can change as
47d0: 20 64 69 66 66 65 72 65 6e 74 20 73 74 65 70 73 different steps
47e0: 20 61 72 65 20 72 75 6e 2e 20 44 6f 20 77 65 20 are run. Do we
47f0: 6e 65 65 64 20 68 61 6e 64 73 68 61 6b 69 6e 67 need handshaking
4800: 20 62 65 74 77 65 65 6e 20 74 68 69 73 0a 09 20 between this..
4810: 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 73 65 ;; se
4820: 63 74 69 6f 6e 20 61 6e 64 20 74 68 65 20 72 75 ction and the ru
4830: 6e 69 74 20 73 65 63 74 69 6f 6e 3f 20 4f 72 20 nit section? Or
4840: 61 64 64 20 61 20 6c 6f 6f 70 20 74 68 61 74 20 add a loop that
4850: 74 72 69 65 73 20 74 68 72 65 65 20 74 69 6d 65 tries three time
4860: 73 20 77 69 74 68 20 61 20 31 2f 34 20 73 65 63 s with a 1/4 sec
4870: 6f 6e 64 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 ond.. ;;
4880: 20 20 20 20 62 65 74 77 65 65 6e 20 74 72 69 65 between trie
4890: 73 3f 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 s?.. (let*
48a0: 28 28 70 69 64 31 20 28 6c 61 75 6e 63 68 3a 65 ((pid1 (launch:e
48b0: 69 6e 66 2d 70 69 64 20 65 78 69 74 2d 69 6e 66 inf-pid exit-inf
48c0: 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 o)) ;; (vector-r
48d0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 ef exit-info 0))
48e0: 0a 09 09 20 20 20 20 20 28 70 69 64 32 20 28 72 ... (pid2 (r
48f0: 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d mt:test-get-top-
4900: 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d process-pid run-
4910: 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 09 20 id test-id))...
4920: 20 20 20 20 28 70 69 64 73 20 28 64 65 6c 65 74 (pids (delet
4930: 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 66 69 e-duplicates (fi
4940: 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 28 6c 69 lter number? (li
4950: 73 74 20 70 69 64 31 20 70 69 64 32 29 29 29 29 st pid1 pid2))))
4960: 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 6e 75 )...(if (not (nu
4970: 6c 6c 3f 20 70 69 64 73 29 29 0a 09 09 20 20 20 ll? pids))...
4980: 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 20 (begin...
4990: 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 20 (for-each...
49a0: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 29 (lambda (pid)
49b0: 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 63 .... (handle-exc
49c0: 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e eptions.... exn
49d0: 0a 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 .... (begin....
49e0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
49f0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
4a00: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 61 62 -log-port* "Unab
4a10: 6c 65 20 74 6f 20 6b 69 6c 6c 20 70 72 6f 63 65 le to kill proce
4a20: 73 73 20 77 69 74 68 20 70 69 64 20 22 20 70 69 ss with pid " pi
4a30: 64 20 22 2c 20 70 6f 73 73 69 62 6c 79 20 61 6c d ", possibly al
4a40: 72 65 61 64 79 20 6b 69 6c 6c 65 64 2e 22 29 0a ready killed.").
4a50: 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
4a60: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
4a70: 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 og-port* " messa
4a80: 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f ge: " ((conditio
4a90: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
4aa0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
4ab0: 65 29 20 65 78 6e 29 29 29 0a 09 09 09 20 20 28 e) exn))).... (
4ac0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
4ad0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4ae0: 20 22 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 "WARNING: Reque
4af0: 73 74 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b st received to k
4b00: 69 6c 6c 20 6a 6f 62 20 22 20 70 69 64 29 20 3b ill job " pid) ;
4b10: 3b 20 20 22 20 28 61 74 74 65 6d 70 74 20 23 20 ; " (attempt #
4b20: 22 20 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 " kill-tries ")"
4b30: 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ).... (debug:pr
4b40: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
4b50: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 ult-log-port* "S
4b60: 69 67 6e 61 6c 20 6d 61 73 6b 3d 22 20 28 73 69 ignal mask=" (si
4b70: 67 6e 61 6c 2d 6d 61 73 6b 29 29 0a 09 09 09 20 gnal-mask))....
4b80: 20 3b 3b 20 28 69 66 20 28 70 72 6f 63 65 73 73 ;; (if (process
4b90: 3a 61 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 :alive? pid)....
4ba0: 20 20 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a ;; (begin.
4bb0: 09 09 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 ... (map (lambd
4bc0: 61 20 28 70 69 64 2d 6e 75 6d 29 0a 09 09 09 09 a (pid-num).....
4bd0: 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c (process-signal
4be0: 20 70 69 64 2d 6e 75 6d 20 73 69 67 6e 61 6c 2f pid-num signal/
4bf0: 74 65 72 6d 29 29 0a 09 09 09 20 20 20 20 20 20 term))....
4c00: 20 28 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 (process:get-su
4c10: 62 2d 70 69 64 73 20 70 69 64 29 29 0a 09 09 09 b-pids pid))....
4c20: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
4c30: 20 35 29 0a 09 09 09 20 20 3b 3b 20 28 69 66 20 5).... ;; (if
4c40: 28 70 72 6f 63 65 73 73 3a 70 72 6f 63 65 73 73 (process:process
4c50: 2d 61 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 -alive? pid)....
4c60: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
4c70: 70 69 64 2d 6e 75 6d 29 0a 09 09 09 09 20 28 68 pid-num)..... (h
4c80: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
4c90: 0a 09 09 09 09 20 20 65 78 6e 0a 09 09 09 09 20 ..... exn.....
4ca0: 20 23 66 0a 09 09 09 09 20 20 28 70 72 6f 63 65 #f..... (proce
4cb0: 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 2d 6e 75 ss-signal pid-nu
4cc0: 6d 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 29 29 m signal/kill)))
4cd0: 0a 09 09 09 20 20 20 20 20 20 20 28 70 72 6f 63 .... (proc
4ce0: 65 73 73 3a 67 65 74 2d 73 75 62 2d 70 69 64 73 ess:get-sub-pids
4cf0: 20 70 69 64 29 29 29 29 0a 09 09 20 20 20 20 20 pid))))...
4d00: 20 20 3b 3b 20 20 20 20 28 64 65 62 75 67 3a 70 ;; (debug:p
4d10: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
4d20: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4d30: 6e 6f 74 20 6b 69 6c 6c 69 6e 67 20 70 72 6f 63 not killing proc
4d40: 65 73 73 20 22 20 70 69 64 20 22 20 61 73 20 69 ess " pid " as i
4d50: 74 20 69 73 20 6e 6f 74 20 61 6c 69 76 65 22 29 t is not alive")
4d60: 29 29 29 0a 09 09 20 20 20 20 20 20 20 70 69 64 )))... pid
4d70: 73 29 0a 09 09 20 20 20 20 20 20 28 74 65 73 74 s)... (test
4d80: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
4d90: 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
4da0: 64 20 22 4b 49 4c 4c 45 44 22 20 20 22 4b 49 4c d "KILLED" "KIL
4db0: 4c 45 44 22 20 28 61 72 67 73 3a 67 65 74 2d 61 LED" (args:get-a
4dc0: 72 67 20 22 2d 6d 22 29 20 23 66 29 29 0a 09 09 rg "-m") #f))...
4dd0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
4de0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
4df0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
4e00: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 74 68 -log-port* "Noth
4e10: 69 6e 67 20 74 6f 20 6b 69 6c 6c 2c 20 70 69 64 ing to kill, pid
4e20: 31 3d 22 20 70 69 64 31 20 22 2c 20 70 69 64 32 1=" pid1 ", pid2
4e30: 3d 22 20 70 69 64 32 29 0a 09 09 20 20 20 20 20 =" pid2)...
4e40: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 (tests:test-set
4e50: 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 -status! run-id
4e60: 74 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 test-id "KILLED"
4e70: 20 20 22 46 41 49 4c 45 44 20 54 4f 20 4b 49 4c "FAILED TO KIL
4e80: 4c 22 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 L" (args:get-arg
4e90: 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 20 20 20 "-m") #f)...
4ea0: 20 20 20 29 29 29 0a 09 20 20 20 20 20 20 28 6d ))).. (m
4eb0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
4ec0: 09 20 20 20 20 20 20 3b 3b 20 6e 6f 20 70 6f 69 . ;; no poi
4ed0: 6e 74 20 69 6e 20 73 74 69 63 6b 69 6e 67 20 61 nt in sticking a
4ee0: 72 6f 75 6e 64 2e 20 45 78 69 74 20 6e 6f 77 2e round. Exit now.
4ef0: 0a 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 .. (exit)))
4f00: 0a 09 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c ..(if (hash-tabl
4f10: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 e-ref/default mi
4f20: 73 63 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 sc-flags 'keep-g
4f30: 6f 69 6e 67 20 23 66 29 0a 09 20 20 20 20 28 62 oing #f).. (b
4f40: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 74 68 72 egin.. (thr
4f50: 65 61 64 2d 73 6c 65 65 70 21 20 33 29 20 3b 3b ead-sleep! 3) ;;
4f60: 20 28 2b 20 33 20 28 72 61 6e 64 6f 6d 20 36 29 (+ 3 (random 6)
4f70: 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a )) ;; add some j
4f80: 69 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c itter to the cal
4f90: 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 l home time to s
4fa0: 70 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 pread out the db
4fb0: 20 61 63 63 65 73 73 65 73 0a 09 20 20 20 20 20 accesses..
4fc0: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
4fd0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 73 -ref/default mis
4fe0: 63 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 6f c-flags 'keep-go
4ff0: 69 6e 67 20 23 66 29 20 20 3b 3b 20 6b 65 65 70 ing #f) ;; keep
5000: 20 6f 72 69 67 69 6e 61 6c 73 20 66 6f 72 20 63 originals for c
5010: 70 75 2d 6c 6f 61 64 20 61 6e 64 20 64 69 73 6b pu-load and disk
5020: 2d 66 72 65 65 20 75 6e 6c 65 73 73 20 74 68 65 -free unless the
5030: 79 20 63 68 61 6e 67 65 20 6d 6f 72 65 20 74 68 y change more th
5040: 61 6e 20 74 68 65 20 61 6c 6c 6f 77 65 64 20 64 an the allowed d
5050: 65 6c 74 61 0a 09 09 20 20 28 6c 6f 6f 70 20 28 elta... (loop (
5060: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 0a 20 20 calc-minutes).
5070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5080: 20 20 20 20 20 20 28 6f 72 20 6e 65 77 2d 63 70 (or new-cp
5090: 75 2d 6c 6f 61 64 20 63 70 75 2d 6c 6f 61 64 29 u-load cpu-load)
50a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
50b0: 20 20 20 20 20 20 20 20 20 28 6f 72 20 6e 65 77 (or new
50c0: 2d 64 69 73 6b 2d 66 72 65 65 20 64 69 73 6b 2d -disk-free disk-
50d0: 66 72 65 65 29 0a 20 20 20 20 20 20 20 20 20 20 free).
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
50f0: 66 20 64 6f 2d 73 79 6e 63 20 28 63 75 72 72 65 f do-sync (curre
5100: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6c 61 73 74 nt-seconds) last
5110: 2d 73 79 6e 63 29 29 29 29 29 29 29 0a 20 20 20 -sync))))))).
5120: 20 28 74 65 73 74 73 3a 75 70 64 61 74 65 2d 63 (tests:update-c
5130: 65 6e 74 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f entral-meta-info
5140: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
5150: 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 20 28 (get-cpu-load) (
5160: 67 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d get-df (current-
5170: 64 69 72 65 63 74 6f 72 79 29 29 28 63 61 6c 63 directory))(calc
5180: 2d 6d 69 6e 75 74 65 73 29 20 23 66 20 23 66 29 -minutes) #f #f)
5190: 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 43 68 65 63 )) ;; NOTE: Chec
51a0: 6b 69 6e 67 20 74 77 69 63 65 20 66 6f 72 20 6b king twice for k
51b0: 65 65 70 2d 67 6f 69 6e 67 20 69 73 20 69 6e 74 eep-going is int
51c0: 65 6e 74 69 6f 6e 61 6c 0a 0a 0a 28 64 65 66 69 entional...(defi
51d0: 6e 65 20 28 6c 61 75 6e 63 68 3a 65 78 65 63 75 ne (launch:execu
51e0: 74 65 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a te encoded-cmd).
51f0: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 (let* ((cmdinf
5200: 6f 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 o (common:rea
5210: 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
5220: 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 29 0a 09 encoded-cmd))..
5230: 20 28 74 63 6f 6e 66 69 67 72 65 67 20 23 66 29 (tconfigreg #f)
5240: 29 0a 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d ). (setenv "M
5250: 54 5f 43 4d 44 49 4e 46 4f 22 20 65 6e 63 6f 64 T_CMDINFO" encod
5260: 65 64 2d 63 6d 64 29 0a 20 20 20 20 3b 3b 28 62 ed-cmd). ;;(b
5270: 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 b-check-path msg
5280: 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 : "launch:execut
5290: 65 20 69 6e 63 6f 6d 69 6e 67 22 29 0a 20 20 20 e incoming").
52a0: 20 28 69 66 20 28 6c 69 73 74 3f 20 63 6d 64 69 (if (list? cmdi
52b0: 6e 66 6f 29 20 3b 3b 20 28 28 74 65 73 74 70 61 nfo) ;; ((testpa
52c0: 74 68 20 2f 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e th /tmp/mrwellan
52d0: 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 /jazzmind/src/ex
52e0: 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 74 73 2f ample_run/tests/
52f0: 73 71 6c 69 74 65 73 70 65 65 64 29 0a 09 3b 3b sqlitespeed)..;;
5300: 20 28 74 65 73 74 2d 6e 61 6d 65 20 73 71 6c 69 (test-name sqli
5310: 74 65 73 70 65 65 64 29 20 28 72 75 6e 73 63 72 tespeed) (runscr
5320: 69 70 74 20 72 75 6e 73 63 72 69 70 74 2e 72 62 ipt runscript.rb
5330: 29 20 28 64 62 2d 68 6f 73 74 20 6c 6f 63 61 6c ) (db-host local
5340: 68 6f 73 74 29 20 28 72 75 6e 2d 69 64 20 31 29 host) (run-id 1)
5350: 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 70 )..(let* ((testp
5360: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
5370: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
5380: 6d 64 69 6e 66 6f 29 29 20 20 3b 3b 20 74 65 73 mdinfo)) ;; tes
5390: 74 70 61 74 68 20 69 73 20 74 68 65 20 74 65 73 tpath is the tes
53a0: 74 20 73 70 65 63 20 61 72 65 61 0a 09 20 20 20 t spec area..
53b0: 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 20 28 (top-path (
53c0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
53d0: 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 6f oppath cmdinfo
53e0: 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b )).. (work
53f0: 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
5400: 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
5410: 63 6d 64 69 6e 66 6f 29 29 20 20 3b 3b 20 77 6f cmdinfo)) ;; wo
5420: 72 6b 2d 61 72 65 61 20 69 73 20 74 68 65 20 74 rk-area is the t
5430: 65 73 74 20 72 75 6e 20 61 72 65 61 0a 09 20 20 est run area..
5440: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
5450: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5460: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
5470: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
5480: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
5490: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
54a0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
54b0: 20 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 (ezsteps (a
54c0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a ssoc/default 'ez
54d0: 73 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 steps cmdinfo)
54e0: 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 72 75 ).. ;; (ru
54f0: 6e 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 2f 64 nremote (assoc/d
5500: 65 66 61 75 6c 74 20 27 72 75 6e 72 65 6d 6f 74 efault 'runremot
5510: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
5520: 20 20 20 20 3b 3b 20 28 74 72 61 6e 73 70 6f 72 ;; (transpor
5530: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
5540: 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d 64 69 'transport cmdi
5550: 6e 66 6f 29 29 20 20 3b 3b 20 6e 6f 74 20 75 73 nfo)) ;; not us
5560: 65 64 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 73 ed.. ;; (s
5570: 65 72 76 65 72 69 6e 66 20 28 61 73 73 6f 63 2f erverinf (assoc/
5580: 64 65 66 61 75 6c 74 20 27 73 65 72 76 65 72 69 default 'serveri
5590: 6e 66 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 nf cmdinfo))..
55a0: 20 20 20 20 20 3b 3b 20 28 70 6f 72 74 20 20 20 ;; (port
55b0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
55c0: 74 20 27 70 6f 72 74 20 20 20 20 20 20 63 6d 64 t 'port cmd
55d0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
55e0: 73 65 72 76 65 72 75 72 6c 20 28 61 73 73 6f 63 serverurl (assoc
55f0: 2f 64 65 66 61 75 6c 74 20 27 73 65 72 76 65 72 /default 'server
5600: 75 72 6c 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 url cmdinfo))..
5610: 20 20 20 20 20 20 28 68 6f 6d 65 68 6f 73 74 20 (homehost
5620: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5630: 27 68 6f 6d 65 68 6f 73 74 20 20 63 6d 64 69 6e 'homehost cmdin
5640: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 fo)).. (ru
5650: 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 2f 64 n-id (assoc/d
5660: 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 20 20 efault 'run-id
5670: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
5680: 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 20 28 (test-id (
5690: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
56a0: 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 66 6f est-id cmdinfo
56b0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 72 67 )).. (targ
56c0: 65 74 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 et (assoc/def
56d0: 61 75 6c 74 20 27 74 61 72 67 65 74 20 20 20 20 ault 'target
56e0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
56f0: 20 20 28 61 72 65 61 6e 61 6d 65 20 20 28 61 73 (areaname (as
5700: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 61 72 65 soc/default 'are
5710: 61 6e 61 6d 65 20 20 63 6d 64 69 6e 66 6f 29 29 aname cmdinfo))
5720: 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 .. (itemda
5730: 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 t (assoc/defau
5740: 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d lt 'itemdat cm
5750: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5760: 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 73 6f (env-ovrd (asso
5770: 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 2d 6f c/default 'env-o
5780: 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 vrd cmdinfo))..
5790: 20 20 20 20 20 20 20 28 73 65 74 2d 76 61 72 73 (set-vars
57a0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
57b0: 20 27 73 65 74 2d 76 61 72 73 20 20 63 6d 64 69 'set-vars cmdi
57c0: 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f 76 65 nfo)) ;; pre-ove
57d0: 72 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 65 74 rrides from -set
57e0: 76 61 72 0a 09 20 20 20 20 20 20 20 28 72 75 6e var.. (run
57f0: 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 65 name (assoc/de
5800: 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 20 fault 'runname
5810: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5820: 20 20 20 28 6d 65 67 61 74 65 73 74 20 20 28 61 (megatest (a
5830: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 65 ssoc/default 'me
5840: 67 61 74 65 73 74 20 20 63 6d 64 69 6e 66 6f 29 gatest cmdinfo)
5850: 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e 74 6c ).. (runtl
5860: 69 6d 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 im (assoc/defa
5870: 75 6c 74 20 27 72 75 6e 74 6c 69 6d 20 20 20 63 ult 'runtlim c
5880: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
5890: 20 28 63 6f 6e 74 6f 75 72 20 20 20 28 61 73 73 (contour (ass
58a0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 63 6f 6e 74 oc/default 'cont
58b0: 6f 75 72 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a our cmdinfo)).
58c0: 09 20 20 20 20 20 20 20 28 69 74 65 6d 2d 70 61 . (item-pa
58d0: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
58e0: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
58f0: 20 20 20 20 20 20 28 6d 74 2d 62 69 6e 64 69 72 (mt-bindir
5900: 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64 65 66 -path (assoc/def
5910: 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d ault 'mt-bindir-
5920: 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29 0a 09 path cmdinfo))..
5930: 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 20 20 (keys
5940: 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 6b #f).. (k
5950: 65 79 76 61 6c 73 20 20 20 23 66 29 0a 09 20 20 eyvals #f)..
5960: 20 20 20 20 20 28 66 75 6c 6c 72 75 6e 73 63 72 (fullrunscr
5970: 69 70 74 20 28 69 66 20 28 6e 6f 74 20 72 75 6e ipt (if (not run
5980: 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 20 20 script).
5990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59a0: 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 20 20 #f.
59b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
59d0: 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d 69 6e if (substring-in
59e0: 64 65 78 20 22 2f 22 20 72 75 6e 73 63 72 69 70 dex "/" runscrip
59f0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
5a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a10: 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 runscri
5a20: 70 74 20 3b 3b 20 75 73 65 20 75 6e 61 64 75 6c pt ;; use unadul
5a30: 74 65 72 65 64 20 69 66 20 63 6f 6e 74 61 69 6e tered if contain
5a40: 73 20 73 6c 61 73 68 65 73 0a 20 20 20 20 20 20 s slashes.
5a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a70: 28 6c 65 74 20 28 28 66 75 6c 6c 6e 20 28 63 6f (let ((fulln (co
5a80: 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f 22 nc work-area "/"
5a90: 20 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 20 runscript)))..
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ac0: 20 28 69 66 20 28 61 6e 64 20 28 63 6f 6d 6d 6f (if (and (commo
5ad0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 n:file-exists? f
5ae0: 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 20 20 ulln).
5af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b10: 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 2d 65 (file-e
5b20: 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 xecute-access? f
5b30: 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 20 20 ulln)).
5b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b60: 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 20 20 fulln.
5b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b90: 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 72 69 runscri
5ba0: 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 75 6d pt))))) ;; assum
5bb0: 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 20 70 e it is on the p
5bc0: 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 ath.
5bd0: 20 20 20 28 63 68 65 63 6b 2d 77 6f 72 6b 2d 61 (check-work-a
5be0: 72 65 61 20 20 20 20 20 20 20 20 20 20 20 28 6c rea (l
5bf0: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
5c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c20: 20 20 20 20 20 3b 3b 20 4e 46 53 20 6d 69 67 68 ;; NFS migh
5c30: 74 20 6e 6f 74 20 68 61 76 65 20 70 72 6f 70 61 t not have propa
5c40: 67 61 74 65 64 20 74 68 65 20 64 69 72 65 63 74 gated the direct
5c50: 6f 72 79 20 6d 65 74 61 20 64 61 74 61 20 74 6f ory meta data to
5c60: 20 74 68 65 20 72 75 6e 20 68 6f 73 74 20 2d 20 the run host -
5c70: 67 69 76 65 20 69 74 20 74 69 6d 65 20 69 66 20 give it time if
5c80: 6e 65 65 64 65 64 0a 20 20 20 20 20 20 20 20 20 needed.
5c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cb0: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 (let loop ((c
5cc0: 6f 75 6e 74 20 30 29 29 0a 20 20 20 20 20 20 20 ount 0)).
5cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cf0: 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 (if (or (
5d00: 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 6f 72 79 common:directory
5d10: 2d 65 78 69 73 74 73 3f 20 77 6f 72 6b 2d 61 72 -exists? work-ar
5d20: 65 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ea).
5d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d50: 20 20 20 20 20 20 20 20 20 20 28 3e 20 63 6f 75 (> cou
5d60: 6e 74 20 31 30 29 29 0a 20 20 20 20 20 20 20 20 nt 10)).
5d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d90: 20 20 20 20 20 20 20 20 20 20 28 63 68 61 6e 67 (chang
5da0: 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
5db0: 2d 61 72 65 61 29 0a 20 20 20 20 20 20 20 20 20 -area).
5dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5de0: 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a (begin.
5df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e20: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
5e30: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
5e40: 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 4e 6f 74 port* "INFO: Not
5e50: 20 73 74 61 72 74 69 6e 67 20 6a 6f 62 20 79 65 starting job ye
5e60: 74 20 2d 20 64 69 72 65 63 74 6f 72 79 20 22 20 t - directory "
5e70: 77 6f 72 6b 2d 61 72 65 61 20 22 20 6e 6f 74 20 work-area " not
5e80: 66 6f 75 6e 64 22 29 0a 20 20 20 20 20 20 20 20 found").
5e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5eb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 68 72 (thr
5ec0: 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 0a 20 ead-sleep! 10).
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f00: 20 20 20 28 6c 6f 6f 70 20 28 2b 20 63 6f 75 6e (loop (+ coun
5f10: 74 20 31 29 29 29 29 29 0a 0a 20 20 20 20 20 20 t 1)))))..
5f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f40: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
5f50: 73 74 72 69 6e 67 3d 3f 20 20 28 63 6f 6d 6d 6f string=? (commo
5f60: 6e 3a 72 65 61 6c 2d 70 61 74 68 20 77 6f 72 6b n:real-path work
5f70: 2d 61 72 65 61 29 28 63 6f 6d 6d 6f 6e 3a 72 65 -area)(common:re
5f80: 61 6c 2d 70 61 74 68 20 28 63 75 72 72 65 6e 74 al-path (current
5f90: 2d 64 69 72 65 63 74 6f 72 79 29 29 29 29 0a 20 -directory)))).
5fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5fd0: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6000: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
6010: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
6020: 6c 6f 67 2d 70 6f 72 74 2a 0a 20 20 20 20 20 20 log-port*.
6030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6060: 20 20 20 20 20 20 20 20 20 22 49 4e 46 4f 3a 20 "INFO:
6070: 77 65 20 61 72 65 20 65 78 70 65 63 74 69 6e 67 we are expecting
6080: 20 74 6f 20 62 65 20 69 6e 20 64 69 72 65 63 74 to be in direct
6090: 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 20 ory " work-area
60a0: 22 5c 6e 22 0a 20 20 20 20 20 20 20 20 20 20 20 "\n".
60b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60e0: 20 20 20 20 22 20 20 20 20 20 62 75 74 20 77 65 " but we
60f0: 20 61 72 65 20 61 63 74 75 61 6c 6c 79 20 69 6e are actually in
6100: 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 22 the directory "
6110: 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 (current-direct
6120: 6f 72 79 29 20 22 5c 6e 22 0a 20 20 20 20 20 20 ory) "\n".
6130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6160: 20 20 20 20 20 20 20 20 20 22 20 20 20 20 20 64 " d
6170: 6f 69 6e 67 20 61 6e 6f 74 68 65 72 20 63 68 61 oing another cha
6180: 6e 67 65 20 64 69 72 2e 22 29 0a 20 20 20 20 20 nge dir.").
6190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 (ch
61c0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
61d0: 6f 72 6b 2d 61 72 65 61 29 29 29 0a 20 20 20 20 ork-area))).
61e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6200: 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 .
6210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6230: 20 20 20 20 20 3b 3b 20 73 70 6f 74 20 63 68 65 ;; spot che
6240: 63 6b 20 74 68 61 74 20 74 68 65 20 66 69 6c 65 ck that the file
6250: 73 20 69 6e 20 74 65 73 74 70 61 74 68 20 61 72 s in testpath ar
6260: 65 20 61 76 61 69 6c 61 62 6c 65 2e 20 54 6f 6f e available. Too
6270: 20 6f 66 74 65 6e 20 4e 46 53 20 64 65 6c 61 79 often NFS delay
6280: 73 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d 73 s cause problems
6290: 20 68 65 72 65 2e 0a 20 20 20 20 20 20 20 20 20 here..
62a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62c0: 20 20 20 28 6c 65 74 20 28 28 66 69 6c 65 73 20 (let ((files
62d0: 20 20 20 20 20 28 67 6c 6f 62 20 28 63 6f 6e 63 (glob (conc
62e0: 20 74 65 73 74 70 61 74 68 20 22 2f 2a 22 29 29 testpath "/*"))
62f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6320: 20 20 20 20 28 62 61 64 2d 66 69 6c 65 73 20 27 (bad-files '
6330: 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ())).
6340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6360: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 (for-each.
6370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6390: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
63a0: 62 64 61 20 28 66 75 6c 6c 6e 61 6d 65 29 0a 20 bda (fullname).
63b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 28 6c 65 74 2a 20 28 28 66 6e 61 6d 65 20 28 70 (let* ((fname (p
63f0: 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 athname-strip-di
6400: 72 65 63 74 6f 72 79 20 66 75 6c 6c 6e 61 6d 65 rectory fullname
6410: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6440: 20 20 20 20 20 20 20 20 20 20 20 28 74 61 72 67 (targ
6450: 6e 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 n (conc work-are
6460: 61 20 22 2f 22 20 66 6e 61 6d 65 29 29 29 0a 20 a "/" fname))).
6470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 6c 65 (if (not (file
64b0: 2d 65 78 69 73 74 73 3f 20 74 61 72 67 6e 29 29 -exists? targn))
64c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
64d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64f0: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 62 61 (set! ba
6500: 64 2d 66 69 6c 65 73 20 28 63 6f 6e 73 20 66 6e d-files (cons fn
6510: 61 6d 65 20 62 61 64 2d 66 69 6c 65 73 29 29 29 ame bad-files)))
6520: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6550: 20 20 66 69 6c 65 73 29 0a 20 20 20 20 20 20 20 files).
6560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6580: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
6590: 28 6e 75 6c 6c 3f 20 62 61 64 2d 66 69 6c 65 73 (null? bad-files
65a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
65b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65d0: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
65e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6610: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
6620: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6630: 2a 20 22 49 4e 46 4f 3a 20 74 65 73 74 20 64 61 * "INFO: test da
6640: 74 61 20 66 72 6f 6d 20 22 20 74 65 73 74 70 61 ta from " testpa
6650: 74 68 20 22 20 6e 6f 74 20 63 6f 70 69 65 64 20 th " not copied
6660: 70 72 6f 70 65 72 6c 79 20 6f 72 20 66 69 6c 65 properly or file
6670: 73 79 73 74 65 6d 20 70 72 6f 62 6c 65 6d 73 20 system problems
6680: 63 61 75 73 69 6e 67 20 64 61 74 61 20 74 6f 20 causing data to
6690: 6e 6f 74 20 62 65 20 66 6f 75 6e 64 2e 20 52 65 not be found. Re
66a0: 2d 72 75 6e 6e 69 6e 67 20 74 68 65 20 63 6f 70 -running the cop
66b0: 79 20 63 6f 6d 6d 61 6e 64 2e 22 29 0a 20 20 20 y command.").
66c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66f0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6700: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6710: 74 2a 20 22 49 4e 46 4f 3a 20 6d 69 73 73 69 6e t* "INFO: missin
6720: 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 22 20 77 g files from " w
6730: 6f 72 6b 2d 61 72 65 61 20 22 3a 20 22 20 28 73 ork-area ": " (s
6740: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
6750: 65 20 62 61 64 2d 66 69 6c 65 73 20 22 2c 20 22 e bad-files ", "
6760: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6790: 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 74 (launch:t
67a0: 65 73 74 2d 63 6f 70 79 20 74 65 73 74 70 61 74 est-copy testpat
67b0: 68 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 29 0a h work-area)))).
67c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67e0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6f ;; o
67f0: 6e 65 20 6d 6f 72 65 20 74 69 6d 65 2c 20 63 68 ne more time, ch
6800: 61 6e 67 65 20 74 6f 20 74 68 65 20 77 6f 72 6b ange to the work
6810: 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 0a -area directory.
6820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6840: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 (cha
6850: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
6860: 72 6b 2d 61 72 65 61 29 29 29 0a 09 20 20 20 20 rk-area)))..
6870: 20 20 20 29 20 3b 3b 20 6c 65 74 2a 0a 0a 09 20 ) ;; let*...
6880: 20 28 69 66 20 63 6f 6e 74 6f 75 72 20 28 73 65 (if contour (se
6890: 74 65 6e 76 20 22 4d 54 5f 43 4f 4e 54 4f 55 52 tenv "MT_CONTOUR
68a0: 22 20 63 6f 6e 74 6f 75 72 29 29 0a 09 20 20 0a " contour)).. .
68b0: 09 20 20 3b 3b 20 69 6d 6d 65 64 69 61 74 65 64 . ;; immediated
68c0: 20 73 65 74 20 73 6f 6d 65 20 6b 65 79 20 76 61 set some key va
68d0: 72 69 61 62 6c 65 73 20 66 72 6f 6d 20 43 4d 44 riables from CMD
68e0: 49 4e 46 4f 20 64 61 74 61 2c 20 79 65 73 2c 20 INFO data, yes,
68f0: 74 68 65 73 65 20 77 69 6c 6c 20 62 65 20 73 65 these will be se
6900: 74 20 61 67 61 69 6e 20 62 65 6c 6f 77 20 2e 2e t again below ..
6910: 2e 0a 09 20 20 3b 3b 0a 09 20 20 28 73 65 74 65 ... ;;.. (sete
6920: 6e 76 20 22 4d 54 5f 54 45 53 54 53 55 49 54 45 nv "MT_TESTSUITE
6930: 4e 41 4d 45 22 20 61 72 65 61 6e 61 6d 65 29 0a NAME" areaname).
6940: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 . (setenv "MT_R
6950: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 74 6f UN_AREA_HOME" to
6960: 70 2d 70 61 74 68 29 0a 09 20 20 28 73 65 74 21 p-path).. (set!
6970: 20 2a 74 6f 70 70 61 74 68 2a 20 74 6f 70 2d 70 *toppath* top-p
6980: 61 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 28 ath). (
6990: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
69a0: 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b 20 74 *toppath*) ;; t
69b0: 65 6d 70 6f 72 61 72 69 6c 79 20 73 77 69 74 63 emporarily switc
69c0: 68 20 74 6f 20 74 68 65 20 72 75 6e 20 61 72 65 h to the run are
69d0: 61 20 68 6f 6d 65 0a 09 20 20 28 73 65 74 65 6e a home.. (seten
69e0: 76 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 v "MT_TEST_RUN_D
69f0: 49 52 22 20 20 77 6f 72 6b 2d 61 72 65 61 29 0a IR" work-area).
6a00: 0a 09 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 .. (launch:setu
6a10: 70 29 20 3b 3b 20 73 68 6f 75 6c 64 20 62 65 20 p) ;; should be
6a20: 70 72 6f 70 65 72 6c 79 20 69 6e 20 74 68 65 20 properly in the
6a30: 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 20 6e 6f run area home no
6a40: 77 0a 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 w. ..
6a50: 28 73 65 74 21 20 74 63 6f 6e 66 69 67 72 65 67 (set! tconfigreg
6a60: 20 28 74 65 73 74 73 3a 67 65 74 2d 61 6c 6c 29 (tests:get-all)
6a70: 29 0a 09 20 20 28 6c 65 74 20 28 28 73 69 67 68 ).. (let ((sigh
6a80: 61 6e 64 20 28 6c 61 6d 62 64 61 20 28 73 69 67 and (lambda (sig
6a90: 6e 75 6d 29 0a 09 09 09 20 20 20 3b 3b 20 28 73 num).... ;; (s
6aa0: 69 67 6e 61 6c 2d 6d 61 73 6b 21 20 73 69 67 6e ignal-mask! sign
6ab0: 75 6d 29 20 3b 3b 20 74 6f 20 6d 61 73 6b 20 6f um) ;; to mask o
6ac0: 72 20 6e 6f 74 3f 20 73 65 65 6d 73 20 74 6f 20 r not? seems to
6ad0: 63 61 75 73 65 20 69 73 73 75 65 73 20 69 6e 20 cause issues in
6ae0: 65 78 69 74 69 6e 67 0a 09 09 09 20 20 20 28 69 exiting.... (i
6af0: 66 20 28 65 71 3f 20 73 69 67 6e 75 6d 20 73 69 f (eq? signum si
6b00: 67 6e 61 6c 2f 73 74 6f 70 29 0a 09 09 09 20 20 gnal/stop)....
6b10: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
6b20: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
6b30: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 61 74 lt-log-port* "at
6b40: 74 65 6d 70 74 20 74 6f 20 53 54 4f 50 20 70 72 tempt to STOP pr
6b50: 6f 63 65 73 73 2e 20 45 78 69 74 69 6e 67 2e 22 ocess. Exiting."
6b60: 29 29 0a 09 09 09 20 20 20 28 73 65 74 21 20 2a )).... (set! *
6b70: 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 23 74 time-to-exit* #t
6b80: 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 20 22 ).... (print "
6b90: 52 65 63 65 69 76 65 64 20 73 69 67 6e 61 6c 20 Received signal
6ba0: 22 20 73 69 67 6e 75 6d 20 22 2c 20 63 6c 65 61 " signum ", clea
6bb0: 6e 69 6e 67 20 75 70 20 62 65 66 6f 72 65 20 65 ning up before e
6bc0: 78 69 74 2e 20 50 6c 65 61 73 65 20 77 61 69 74 xit. Please wait
6bd0: 2e 2e 2e 22 29 0a 09 09 09 20 20 20 28 6c 65 74 ...").... (let
6be0: 20 28 28 74 68 31 20 28 6d 61 6b 65 2d 74 68 72 ((th1 (make-thr
6bf0: 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 ead (lambda ()..
6c00: 09 09 09 09 09 20 20 20 20 20 28 72 6d 74 3a 74 ..... (rmt:t
6c10: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
6c20: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
6c30: 2d 69 64 20 22 49 4e 43 4f 4d 50 4c 45 54 45 22 -id "INCOMPLETE"
6c40: 20 22 4b 49 4c 4c 45 44 22 20 23 66 29 0a 09 09 "KILLED" #f)...
6c50: 09 09 09 09 20 20 20 20 20 28 70 72 69 6e 74 20 .... (print
6c60: 22 4b 69 6c 6c 65 64 20 62 79 20 73 69 67 6e 61 "Killed by signa
6c70: 6c 20 22 20 73 69 67 6e 75 6d 20 22 2e 20 45 78 l " signum ". Ex
6c80: 69 74 69 6e 67 22 29 0a 09 09 09 09 09 09 20 20 iting").......
6c90: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
6ca0: 21 20 31 29 0a 09 09 09 09 09 09 20 20 20 20 20 ! 1).......
6cb0: 28 65 78 69 74 20 31 29 29 29 29 0a 09 09 09 09 (exit 1)))).....
6cc0: 20 28 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 (th2 (make-thre
6cd0: 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 ad (lambda ()...
6ce0: 09 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 .... (thread
6cf0: 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 09 09 09 -sleep! 2)......
6d00: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
6d10: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
6d20: 67 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 22 29 0a g-port* "Done").
6d30: 09 09 09 09 09 09 20 20 20 20 20 28 65 78 69 74 ...... (exit
6d40: 20 34 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 4)))))....
6d50: 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 (thread-start! t
6d60: 68 32 29 0a 09 09 09 20 20 20 20 20 28 74 68 72 h2).... (thr
6d70: 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a ead-start! th1).
6d80: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
6d90: 6a 6f 69 6e 21 20 74 68 32 29 29 29 29 29 0a 09 join! th2)))))..
6da0: 20 20 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d (set-signal-
6db0: 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f handler! signal/
6dc0: 69 6e 74 20 73 69 67 68 61 6e 64 29 0a 09 20 20 int sighand)..
6dd0: 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 (set-signal-ha
6de0: 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 74 65 ndler! signal/te
6df0: 72 6d 20 73 69 67 68 61 6e 64 29 0a 09 20 20 20 rm sighand)..
6e00: 20 29 20 3b 3b 20 28 73 65 74 2d 73 69 67 6e 61 ) ;; (set-signa
6e10: 6c 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 l-handler! signa
6e20: 6c 2f 73 74 6f 70 20 73 69 67 68 61 6e 64 29 0a l/stop sighand).
6e30: 09 20 20 0a 09 20 20 3b 3b 20 44 6f 20 6e 6f 74 . .. ;; Do not
6e40: 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 69 66 run the test if
6e50: 20 69 74 20 69 73 20 52 45 4d 4f 56 49 4e 47 2c it is REMOVING,
6e60: 20 52 55 4e 4e 49 4e 47 2c 20 4b 49 4c 4c 52 45 RUNNING, KILLRE
6e70: 51 20 6f 72 20 52 45 4d 4f 54 45 48 4f 53 54 53 Q or REMOTEHOSTS
6e80: 54 41 52 54 2c 0a 09 20 20 3b 3b 20 4d 61 72 6b TART,.. ;; Mark
6e90: 20 74 68 65 20 74 65 73 74 20 61 73 20 52 45 4d the test as REM
6ea0: 4f 54 45 48 4f 53 54 53 54 41 52 54 20 2a 49 4d OTEHOSTSTART *IM
6eb0: 4d 45 44 49 41 54 45 4c 59 2a 0a 09 20 20 3b 3b MEDIATELY*.. ;;
6ec0: 0a 09 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 .. (let* ((test
6ed0: 2d 69 6e 66 6f 20 28 72 6d 74 3a 67 65 74 2d 74 -info (rmt:get-t
6ee0: 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 est-info-by-id r
6ef0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a un-id test-id)).
6f00: 09 09 20 28 74 65 73 74 2d 68 6f 73 74 20 28 69 .. (test-host (i
6f10: 66 20 74 65 73 74 2d 69 6e 66 6f 0a 09 09 09 09 f test-info.....
6f20: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 (db:test-get-hos
6f30: 74 20 20 20 20 20 20 20 20 74 65 73 74 2d 69 6e t test-in
6f40: 66 6f 29 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 fo).....(begin..
6f50: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
6f60: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
6f70: 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 66 -port* "ERROR: f
6f80: 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 61 20 ailed to find a
6f90: 72 65 63 6f 72 64 20 66 6f 72 20 74 65 73 74 2d record for test-
6fa0: 69 64 20 22 20 74 65 73 74 2d 69 64 20 22 2c 20 id " test-id ",
6fb0: 65 78 69 74 69 6e 67 2e 22 29 0a 09 09 09 09 20 exiting.").....
6fc0: 20 28 65 78 69 74 29 29 29 29 0a 09 09 20 28 74 (exit))))... (t
6fd0: 65 73 74 2d 70 69 64 20 20 28 64 62 3a 74 65 73 est-pid (db:tes
6fe0: 74 2d 67 65 74 2d 70 72 6f 63 65 73 73 5f 69 64 t-get-process_id
6ff0: 20 20 74 65 73 74 2d 69 6e 66 6f 29 29 29 0a 09 test-info)))..
7000: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
7010: 20 20 20 20 20 20 20 3b 3b 20 2d 6d 72 77 2d 20 ;; -mrw-
7020: 49 27 6d 20 72 65 6d 6f 76 69 6e 67 20 4b 49 4c I'm removing KIL
7030: 4c 52 45 51 20 66 72 6f 6d 20 74 68 69 73 20 6c LREQ from this l
7040: 69 73 74 20 73 6f 20 74 68 61 74 20 61 20 74 65 ist so that a te
7050: 73 74 20 69 6e 20 4b 49 4c 4c 52 45 51 20 73 74 st in KILLREQ st
7060: 61 74 65 20 69 73 20 74 72 65 61 74 65 64 20 61 ate is treated a
7070: 73 20 61 20 22 64 6f 20 6e 6f 74 20 72 75 6e 22 s a "do not run"
7080: 20 66 6c 61 67 2e 0a 09 20 20 20 20 20 28 28 6d flag... ((m
7090: 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d 67 ember (db:test-g
70a0: 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e et-state test-in
70b0: 66 6f 29 20 27 28 22 49 4e 43 4f 4d 50 4c 45 54 fo) '("INCOMPLET
70c0: 45 22 20 22 4b 49 4c 4c 45 44 22 20 22 55 4e 4b E" "KILLED" "UNK
70d0: 4e 4f 57 4e 22 20 22 53 54 55 43 4b 22 29 29 20 NOWN" "STUCK"))
70e0: 3b 3b 20 70 72 69 6f 72 20 72 75 6e 20 6f 66 20 ;; prior run of
70f0: 74 68 69 73 20 74 65 73 74 20 64 69 64 6e 27 74 this test didn't
7100: 20 63 6f 6d 70 6c 65 74 65 2c 20 67 6f 20 61 68 complete, go ah
7110: 65 61 64 20 61 6e 64 20 74 72 79 20 74 6f 20 72 ead and try to r
7120: 65 72 75 6e 0a 09 20 20 20 20 20 20 28 64 65 62 erun.. (deb
7130: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
7140: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 ult-log-port* "I
7150: 4e 46 4f 3a 20 74 65 73 74 20 69 73 20 49 4e 43 NFO: test is INC
7160: 4f 4d 50 4c 45 54 45 20 6f 72 20 4b 49 4c 4c 45 OMPLETE or KILLE
7170: 44 2c 20 74 72 65 61 74 20 74 68 69 73 20 65 78 D, treat this ex
7180: 65 63 75 74 65 20 63 61 6c 6c 20 61 73 20 61 20 ecute call as a
7190: 72 65 72 75 6e 20 72 65 71 75 65 73 74 22 29 0a rerun request").
71a0: 09 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 73 . ;; (tests
71b0: 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 :test-force-stat
71c0: 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 e-status! run-id
71d0: 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 test-id "REMOTE
71e0: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
71f0: 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ).. (rmt:te
7200: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
7210: 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d tus run-id test-
7220: 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 id "REMOTEHOSTST
7230: 41 52 54 22 20 22 6e 2f 61 22 20 23 66 29 0a 09 ART" "n/a" #f)..
7240: 20 20 20 20 20 20 29 20 3b 3b 20 70 72 69 6d 65 ) ;; prime
7250: 20 69 74 20 66 6f 72 20 72 75 6e 6e 69 6e 67 0a it for running.
7260: 09 20 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 . ((member (
7270: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
7280: 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 e test-info) '("
7290: 52 55 4e 4e 49 4e 47 22 20 22 52 45 4d 4f 54 45 RUNNING" "REMOTE
72a0: 48 4f 53 54 53 54 41 52 54 22 29 29 0a 09 20 20 HOSTSTART"))..
72b0: 20 20 20 20 28 69 66 20 28 70 72 6f 63 65 73 73 (if (process
72c0: 3a 61 6c 69 76 65 2d 6f 6e 2d 68 6f 73 74 3f 20 :alive-on-host?
72d0: 74 65 73 74 2d 68 6f 73 74 20 74 65 73 74 2d 70 test-host test-p
72e0: 69 64 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 id)... (debug:p
72f0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
7300: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7310: 22 74 65 73 74 20 73 74 61 74 65 20 69 73 20 22 "test state is "
7320: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
7330: 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 tate test-info)
7340: 22 20 61 6e 64 20 70 72 6f 63 65 73 73 20 22 20 " and process "
7350: 74 65 73 74 2d 70 69 64 20 22 20 69 73 20 73 74 test-pid " is st
7360: 69 6c 6c 20 72 75 6e 6e 69 6e 67 20 6f 6e 20 68 ill running on h
7370: 6f 73 74 20 22 20 74 65 73 74 2d 68 6f 73 74 20 ost " test-host
7380: 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f 63 65 65 ", cannot procee
7390: 64 22 29 0a 09 09 20 20 3b 3b 20 28 74 65 73 74 d")... ;; (test
73a0: 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 s:test-force-sta
73b0: 74 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 te-status! run-i
73c0: 64 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 d test-id "REMOT
73d0: 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 EHOSTSTART" "n/a
73e0: 22 29 0a 09 09 20 20 28 72 6d 74 3a 74 65 73 74 ")... (rmt:test
73f0: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
7400: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
7410: 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 "REMOTEHOSTSTAR
7420: 54 22 20 22 6e 2f 61 22 20 23 66 29 0a 09 09 20 T" "n/a" #f)...
7430: 20 29 29 0a 09 20 20 20 20 20 28 28 6e 6f 74 20 )).. ((not
7440: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
7450: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d -get-state test-
7460: 69 6e 66 6f 29 20 27 28 22 52 45 4d 4f 56 49 4e info) '("REMOVIN
7470: 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 G" "REMOTEHOSTST
7480: 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 ART" "RUNNING" "
7490: 4b 49 4c 4c 52 45 51 22 29 29 29 0a 09 20 20 20 KILLREQ")))..
74a0: 20 20 20 3b 3b 20 28 74 65 73 74 73 3a 74 65 73 ;; (tests:tes
74b0: 74 2d 66 6f 72 63 65 2d 73 74 61 74 65 2d 73 74 t-force-state-st
74c0: 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 atus! run-id tes
74d0: 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 t-id "REMOTEHOST
74e0: 53 54 41 52 54 22 20 22 6e 2f 61 22 29 0a 09 20 START" "n/a")..
74f0: 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 (rmt:test-s
7500: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 et-state-status
7510: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 run-id test-id "
7520: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART"
7530: 20 22 6e 2f 61 22 20 23 66 29 0a 09 20 20 20 20 "n/a" #f)..
7540: 20 20 29 0a 09 20 20 20 20 20 28 65 6c 73 65 20 ).. (else
7550: 3b 3b 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 ;; (member (db:t
7560: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
7570: 73 74 2d 69 6e 66 6f 29 20 27 28 22 52 45 4d 4f st-info) '("REMO
7580: 56 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 VING" "REMOTEHOS
7590: 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 TSTART" "RUNNING
75a0: 22 20 22 4b 49 4c 4c 52 45 51 22 29 29 0a 09 20 " "KILLREQ"))..
75b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
75c0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
75d0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 lt-log-port* "te
75e0: 73 74 20 73 74 61 74 65 20 69 73 20 22 20 28 64 st state is " (d
75f0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
7600: 20 74 65 73 74 2d 69 6e 66 6f 29 20 22 2c 20 63 test-info) ", c
7610: 61 6e 6e 6f 74 20 70 72 6f 63 65 65 64 22 29 0a annot proceed").
7620: 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 29 . (exit))))
7630: 0a 09 20 20 0a 09 20 20 28 64 65 62 75 67 3a 70 .. .. (debug:p
7640: 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d rint 2 *default-
7650: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 78 65 63 74 log-port* "Exect
7660: 75 69 6e 67 20 22 20 74 65 73 74 2d 6e 61 6d 65 uing " test-name
7670: 20 22 20 28 69 64 3a 20 22 20 74 65 73 74 2d 69 " (id: " test-i
7680: 64 20 22 29 20 6f 6e 20 22 20 28 67 65 74 2d 68 d ") on " (get-h
7690: 6f 73 74 2d 6e 61 6d 65 29 29 0a 09 20 20 28 73 ost-name)).. (s
76a0: 65 74 21 20 6b 65 79 73 20 20 20 20 20 20 20 28 et! keys (
76b0: 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 rmt:get-keys))..
76c0: 20 20 3b 3b 20 28 72 75 6e 73 3a 73 65 74 2d 6d ;; (runs:set-m
76d0: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
76e0: 20 72 75 6e 2d 69 64 20 69 6e 6b 65 79 73 3a 20 run-id inkeys:
76f0: 6b 65 79 73 20 69 6e 6b 65 79 76 61 6c 73 3a 20 keys inkeyvals:
7700: 6b 65 79 76 61 6c 73 29 20 3b 3b 20 74 68 65 73 keyvals) ;; thes
7710: 65 20 6d 61 79 20 62 65 20 6e 65 65 64 65 64 20 e may be needed
7720: 62 79 20 74 68 65 20 6c 61 75 6e 63 68 69 6e 67 by the launching
7730: 20 70 72 6f 63 65 73 73 0a 09 20 20 3b 3b 20 6f process.. ;; o
7740: 6e 65 20 6f 66 20 74 68 65 73 65 20 69 73 20 64 ne of these is d
7750: 65 66 75 6e 63 74 2f 72 65 64 75 6e 64 61 6e 74 efunct/redundant
7760: 20 2e 2e 2e 0a 09 20 20 28 69 66 20 28 6e 6f 74 ..... (if (not
7770: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 66 (launch:setup f
7780: 6f 72 63 65 2d 72 65 72 65 61 64 3a 20 23 74 29 orce-reread: #t)
7790: 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
77a0: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
77b0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
77c0: 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 73 rt* "Failed to s
77d0: 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 29 20 etup, exiting")
77e0: 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 ...;; (sqlite3:f
77f0: 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 09 3b inalize! db)...;
7800: 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c ; (sqlite3:final
7810: 69 7a 65 21 20 74 64 62 29 0a 09 09 28 65 78 69 ize! tdb)...(exi
7820: 74 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 t 1))).
7830: 20 3b 3b 20 76 61 6c 69 64 61 74 65 20 74 68 61 ;; validate tha
7840: 74 20 74 68 65 20 74 65 73 74 20 72 75 6e 20 61 t the test run a
7850: 72 65 61 20 69 73 20 61 76 61 69 6c 61 62 6c 65 rea is available
7860: 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 . (chec
7870: 6b 2d 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 k-work-area).
7880: 20 20 20 20 20 20 20 0a 20 20 20 20 20 20 20 20 .
7890: 20 20 3b 3b 20 73 74 69 6c 6c 20 6e 65 65 64 20 ;; still need
78a0: 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 72 75 to go back to ru
78b0: 6e 20 61 72 65 61 20 68 6f 6d 65 20 66 6f 72 20 n area home for
78c0: 6e 65 78 74 20 63 6f 75 70 6c 65 20 73 74 65 70 next couple step
78d0: 73 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 s.. (change-dir
78e0: 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 2a ectory *toppath*
78f0: 29 20 0a 0a 09 20 20 3b 3b 20 4e 4f 54 45 3a 20 ) ... ;; NOTE:
7900: 43 75 72 72 65 6e 74 20 6f 72 64 65 72 20 69 73 Current order is
7910: 20 74 6f 20 70 72 6f 63 65 73 73 20 72 75 6e 63 to process runc
7920: 6f 6e 66 69 67 73 20 2a 62 65 66 6f 72 65 2a 20 onfigs *before*
7930: 73 65 74 74 69 6e 67 20 74 68 65 20 4d 54 5f 20 setting the MT_
7940: 76 61 72 73 2e 20 54 68 69 73 20 0a 09 20 20 3b vars. This .. ;
7950: 3b 20 20 20 20 20 20 20 73 65 65 6d 73 20 6e 6f ; seems no
7960: 6e 2d 69 64 65 61 6c 20 62 75 74 20 63 6f 75 6c n-ideal but coul
7970: 64 20 77 65 6c 6c 20 62 72 65 61 6b 20 73 74 75 d well break stu
7980: 66 66 0a 09 20 20 3b 3b 20 20 20 20 42 55 47 3f ff.. ;; BUG?
7990: 20 42 55 47 3f 20 42 55 47 3f 0a 09 20 20 0a 09 BUG? BUG?.. ..
79a0: 20 20 28 6c 65 74 20 28 28 72 63 6f 6e 66 69 67 (let ((rconfig
79b0: 20 28 66 75 6c 6c 2d 72 75 6e 63 6f 6e 66 69 67 (full-runconfig
79c0: 73 2d 72 65 61 64 29 29 20 3b 3b 20 28 72 65 61 s-read)) ;; (rea
79d0: 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 20 d-config (conc
79e0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 *toppath* "/runc
79f0: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 onfigs.config")
7a00: 23 66 20 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 #f #t sections:
7a10: 28 6c 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 (list "default"
7a20: 74 61 72 67 65 74 29 29 29 29 0a 09 09 28 77 63 target))))...(wc
7a30: 6f 6e 66 69 67 20 28 72 65 61 64 2d 63 6f 6e 66 onfig (read-conf
7a40: 69 67 20 22 77 61 69 76 65 72 73 2e 63 6f 6e 66 ig "waivers.conf
7a50: 69 67 22 20 23 66 20 23 74 20 73 65 63 74 69 6f ig" #f #t sectio
7a60: 6e 73 3a 20 60 28 20 22 64 65 66 61 75 6c 74 22 ns: `( "default"
7a70: 20 2c 74 61 72 67 65 74 20 29 29 29 29 20 3b 3b ,target )))) ;;
7a80: 20 72 65 61 64 20 74 68 65 20 77 61 69 76 65 72 read the waiver
7a90: 73 20 63 6f 6e 66 69 67 20 69 66 20 69 74 20 65 s config if it e
7aa0: 78 69 73 74 73 0a 09 20 20 20 20 3b 3b 20 28 73 xists.. ;; (s
7ab0: 65 74 75 70 2d 65 6e 76 2d 64 65 66 61 75 6c 74 etup-env-default
7ac0: 73 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 s (conc *toppath
7ad0: 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 * "/runconfigs.c
7ae0: 6f 6e 66 69 67 22 29 20 72 75 6e 2d 69 64 20 28 onfig") run-id (
7af0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
7b00: 20 6b 65 79 76 61 6c 73 20 74 61 72 67 65 74 29 keyvals target)
7b10: 0a 09 20 20 20 20 3b 3b 20 28 73 65 74 2d 72 75 .. ;; (set-ru
7b20: 6e 2d 63 6f 6e 66 69 67 2d 76 61 72 73 20 72 75 n-config-vars ru
7b30: 6e 2d 69 64 20 6b 65 79 76 61 6c 73 20 74 61 72 n-id keyvals tar
7b40: 67 65 74 29 20 3b 3b 20 28 64 62 3a 67 65 74 2d get) ;; (db:get-
7b50: 74 61 72 67 65 74 20 64 62 20 72 75 6e 2d 69 64 target db run-id
7b60: 29 29 0a 09 20 20 20 20 3b 3b 20 4e 6f 77 20 68 )).. ;; Now h
7b70: 61 76 65 20 72 75 6e 63 6f 6e 66 69 67 73 20 64 ave runconfigs d
7b80: 61 74 61 20 6c 6f 61 64 65 64 2c 20 73 65 74 20 ata loaded, set
7b90: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 73 environment vars
7ba0: 0a 09 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 .. (for-each
7bb0: 28 6c 61 6d 62 64 61 20 28 73 65 63 74 69 6f 6e (lambda (section
7bc0: 29 0a 09 09 09 28 66 6f 72 2d 65 61 63 68 20 28 )....(for-each (
7bd0: 6c 61 6d 62 64 61 20 28 76 61 72 76 61 6c 29 0a lambda (varval).
7be0: 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 76 .... (let ((v
7bf0: 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 ar (car varval))
7c00: 0a 09 09 09 09 09 20 20 28 76 61 6c 20 28 63 61 ...... (val (ca
7c10: 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 09 dr varval)))....
7c20: 09 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 . (if (and
7c30: 28 73 74 72 69 6e 67 3f 20 76 61 72 29 28 73 74 (string? var)(st
7c40: 72 69 6e 67 3f 20 76 61 6c 29 29 0a 09 09 09 09 ring? val)).....
7c50: 09 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 20 . (begin......
7c60: 20 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 28 (setenv var (
7c70: 63 6f 6e 66 69 67 3a 65 76 61 6c 2d 73 74 72 69 config:eval-stri
7c80: 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f 6e 6d 65 6e ng-in-environmen
7c90: 74 20 76 61 6c 29 29 29 20 3b 3b 20 76 61 6c 29 t val))) ;; val)
7ca0: 0a 09 09 09 09 09 20 20 28 64 65 62 75 67 3a 70 ...... (debug:p
7cb0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
7cc0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7cd0: 22 62 61 64 20 76 61 72 69 61 62 6c 65 20 73 70 "bad variable sp
7ce0: 65 63 2c 20 22 20 76 61 72 20 22 3d 22 20 76 61 ec, " var "=" va
7cf0: 6c 29 29 29 29 0a 09 09 09 09 20 20 28 63 6f 6e l))))..... (con
7d00: 66 69 67 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e figf:get-section
7d10: 20 72 63 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e rconfig section
7d20: 29 29 29 0a 09 09 20 20 20 20 20 20 28 6c 69 73 )))... (lis
7d30: 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 t "default" targ
7d40: 65 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 et))).
7d50: 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 68 ;;(bb-check-path
7d60: 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 78 msg: "launch:ex
7d70: 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 6b ecute post block
7d80: 20 31 22 29 0a 0a 09 20 20 3b 3b 20 4e 46 53 20 1")... ;; NFS
7d90: 6d 69 67 68 74 20 6e 6f 74 20 68 61 76 65 20 70 might not have p
7da0: 72 6f 70 61 67 61 74 65 64 20 74 68 65 20 64 69 ropagated the di
7db0: 72 65 63 74 6f 72 79 20 6d 65 74 61 20 64 61 74 rectory meta dat
7dc0: 61 20 74 6f 20 74 68 65 20 72 75 6e 20 68 6f 73 a to the run hos
7dd0: 74 20 2d 20 67 69 76 65 20 69 74 20 74 69 6d 65 t - give it time
7de0: 20 69 66 20 6e 65 65 64 65 64 0a 09 20 20 28 6c if needed.. (l
7df0: 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 20 et loop ((count
7e00: 30 29 29 0a 09 20 20 20 20 28 69 66 20 28 6f 72 0)).. (if (or
7e10: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
7e20: 69 73 74 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 ists? work-area)
7e30: 0a 09 09 20 20 20 20 28 3e 20 63 6f 75 6e 74 20 ... (> count
7e40: 31 30 29 29 0a 09 09 28 63 68 61 6e 67 65 2d 64 10))...(change-d
7e50: 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
7e60: 65 61 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 ea)...(begin...
7e70: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
7e80: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
7e90: 74 2a 20 22 49 4e 46 4f 3a 20 4e 6f 74 20 73 74 t* "INFO: Not st
7ea0: 61 72 74 69 6e 67 20 6a 6f 62 20 79 65 74 20 2d arting job yet -
7eb0: 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 directory " wor
7ec0: 6b 2d 61 72 65 61 20 22 20 6e 6f 74 20 66 6f 75 k-area " not fou
7ed0: 6e 64 22 29 0a 09 09 20 20 28 74 68 72 65 61 64 nd")... (thread
7ee0: 2d 73 6c 65 65 70 21 20 31 30 29 0a 09 09 20 20 -sleep! 10)...
7ef0: 28 6c 6f 6f 70 20 28 2b 20 63 6f 75 6e 74 20 31 (loop (+ count 1
7f00: 29 29 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 )))))..
7f10: 20 3b 3b 20 6e 6f 77 20 77 65 20 63 61 6e 20 73 ;; now we can s
7f20: 77 69 74 63 68 20 74 6f 20 74 68 65 20 77 6f 72 witch to the wor
7f30: 6b 2d 61 72 65 61 3f 0a 20 20 20 20 20 20 20 20 k-area?.
7f40: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
7f50: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 ory work-area).
7f60: 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 ;;(bb-c
7f70: 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 heck-path msg: "
7f80: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 launch:execute p
7f90: 6f 73 74 20 62 6c 6f 63 6b 20 31 2e 35 22 29 0a ost block 1.5").
7fa0: 09 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 . ;; (change-di
7fb0: 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are
7fc0: 61 29 20 0a 09 20 20 28 73 65 74 21 20 6b 65 79 a) .. (set! key
7fd0: 76 61 6c 73 20 20 20 20 28 6b 65 79 73 3a 74 61 vals (keys:ta
7fe0: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
7ff0: 73 20 74 61 72 67 65 74 29 29 0a 09 20 20 3b 3b s target)).. ;;
8000: 20 61 70 70 6c 79 20 70 72 65 2d 6f 76 65 72 72 apply pre-overr
8010: 69 64 65 73 20 62 65 66 6f 72 65 20 6f 74 68 65 ides before othe
8020: 72 20 76 61 72 69 61 62 6c 65 73 2e 20 54 68 65 r variables. The
8030: 20 70 72 65 2d 6f 76 65 72 72 69 64 65 20 76 61 pre-override va
8040: 72 73 20 6d 75 73 74 20 6e 6f 74 0a 09 20 20 3b rs must not.. ;
8050: 3b 20 63 6c 6f 62 62 65 72 73 20 74 68 69 6e 67 ; clobbers thing
8060: 73 20 66 72 6f 6d 20 74 68 65 20 6f 66 66 69 63 s from the offic
8070: 69 61 6c 20 73 6f 75 72 63 65 73 20 73 75 63 68 ial sources such
8080: 20 61 73 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e as megatest.con
8090: 66 69 67 20 61 6e 64 20 72 75 6e 63 6f 6e 66 69 fig and runconfi
80a0: 67 73 2e 63 6f 6e 66 69 67 0a 09 20 20 28 69 66 gs.config.. (if
80b0: 20 28 73 74 72 69 6e 67 3f 20 73 65 74 2d 76 61 (string? set-va
80c0: 72 73 29 0a 09 20 20 20 20 20 20 28 6c 65 74 20 rs).. (let
80d0: 28 28 76 61 72 70 61 69 72 73 20 28 73 74 72 69 ((varpairs (stri
80e0: 6e 67 2d 73 70 6c 69 74 20 73 65 74 2d 76 61 72 ng-split set-var
80f0: 73 20 22 2c 22 29 29 29 0a 09 09 28 64 65 62 75 s ",")))...(debu
8100: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
8110: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 76 61 lt-log-port* "va
8120: 72 70 61 69 72 73 3a 20 22 20 76 61 72 70 61 69 rpairs: " varpai
8130: 72 73 29 0a 09 09 28 6d 61 70 20 28 6c 61 6d 62 rs)...(map (lamb
8140: 64 61 20 28 76 61 72 70 61 69 72 29 0a 09 09 20 da (varpair)...
8150: 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 (let ((var
8160: 76 61 6c 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 val (string-spli
8170: 74 20 76 61 72 70 61 69 72 20 22 3d 22 29 29 29 t varpair "=")))
8180: 0a 09 09 09 20 28 69 66 20 28 65 71 3f 20 28 6c .... (if (eq? (l
8190: 65 6e 67 74 68 20 76 61 72 76 61 6c 29 20 32 29 ength varval) 2)
81a0: 0a 09 09 09 20 20 20 20 20 28 6c 65 74 20 28 28 .... (let ((
81b0: 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 var (car varval)
81c0: 29 0a 09 09 09 09 20 20 20 28 76 61 6c 20 28 63 )..... (val (c
81d0: 61 64 72 20 76 61 72 76 61 6c 29 29 29 0a 09 09 adr varval)))...
81e0: 09 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
81f0: 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 2d rint 1 *default-
8200: 6c 6f 67 2d 70 6f 72 74 2a 20 22 41 64 64 69 6e log-port* "Addin
8210: 67 20 70 72 65 2d 76 61 72 2f 76 61 6c 20 22 20 g pre-var/val "
8220: 76 61 72 20 22 20 3d 20 22 20 76 61 6c 20 22 20 var " = " val "
8230: 74 6f 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 to the environme
8240: 6e 74 22 29 0a 09 09 09 20 20 20 20 20 20 20 28 nt").... (
8250: 73 65 74 65 6e 76 20 76 61 72 20 76 61 6c 29 29 setenv var val))
8260: 29 29 29 0a 09 09 20 20 20 20 20 76 61 72 70 61 )))... varpa
8270: 69 72 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 irs))).
8280: 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 ;;(bb-check-pat
8290: 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 h msg: "launch:e
82a0: 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 xecute post bloc
82b0: 6b 20 32 22 29 0a 09 20 20 28 66 6f 72 2d 65 61 k 2").. (for-ea
82c0: 63 68 0a 09 20 20 20 28 6c 61 6d 62 64 61 20 28 ch.. (lambda (
82d0: 76 61 72 76 61 6c 29 0a 09 20 20 20 20 20 28 6c varval).. (l
82e0: 65 74 20 28 28 76 61 72 20 28 63 61 72 20 76 61 et ((var (car va
82f0: 72 76 61 6c 29 29 0a 09 09 20 20 20 28 76 61 6c rval))... (val
8300: 20 28 63 61 64 72 20 76 61 72 76 61 6c 29 29 29 (cadr varval)))
8310: 0a 09 20 20 20 20 20 20 20 28 69 66 20 76 61 6c .. (if val
8320: 0a 09 09 20 20 20 28 73 65 74 65 6e 76 20 76 61 ... (setenv va
8330: 72 20 76 61 6c 29 0a 09 09 20 20 20 28 62 65 67 r val)... (beg
8340: 69 6e 0a 09 09 20 20 20 20 20 28 64 65 62 75 67 in... (debug
8350: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
8360: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8370: 2a 20 22 72 65 71 75 69 72 65 64 20 76 61 72 69 * "required vari
8380: 61 62 6c 65 20 22 20 76 61 72 20 22 20 64 6f 65 able " var " doe
8390: 73 20 6e 6f 74 20 68 61 76 65 20 61 20 76 61 6c s not have a val
83a0: 69 64 20 76 61 6c 75 65 2e 20 45 78 69 74 69 6e id value. Exitin
83b0: 67 22 29 0a 09 09 20 20 20 20 20 28 65 78 69 74 g")... (exit
83c0: 29 29 29 29 29 0a 09 20 20 20 20 20 28 6c 69 73 ))))).. (lis
83d0: 74 20 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 t .. (list
83e0: 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 "MT_TEST_RUN_DI
83f0: 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 R" work-area)..
8400: 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f (list "MT_
8410: 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d TEST_NAME" test-
8420: 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 6c 69 name).. (li
8430: 73 74 20 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 st "MT_ITEM_INF
8440: 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 O" (conc itemdat
8450: 29 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 )).. (list
8460: 20 22 4d 54 5f 49 54 45 4d 50 41 54 48 22 20 20 "MT_ITEMPATH"
8470: 69 74 65 6d 2d 70 61 74 68 29 0a 09 20 20 20 20 item-path)..
8480: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 52 55 4e (list "MT_RUN
8490: 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 NAME" runname)
84a0: 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 .. (list "
84b0: 4d 54 5f 4d 45 47 41 54 45 53 54 22 20 20 6d 65 MT_MEGATEST" me
84c0: 67 61 74 65 73 74 29 0a 09 20 20 20 20 20 20 28 gatest).. (
84d0: 6c 69 73 74 20 20 22 4d 54 5f 54 41 52 47 45 54 list "MT_TARGET
84e0: 22 20 20 20 20 74 61 72 67 65 74 29 0a 09 20 20 " target)..
84f0: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 4c (list "MT_L
8500: 49 4e 4b 54 52 45 45 22 20 20 28 63 6f 6d 6d 6f INKTREE" (commo
8510: 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 n:get-linktree))
8520: 20 3b 3b 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f ;; (configf:loo
8530: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
8540: 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 "setup" "linktre
8550: 65 22 29 29 0a 09 20 20 20 20 20 20 28 6c 69 73 e")).. (lis
8560: 74 20 20 22 4d 54 5f 54 45 53 54 53 55 49 54 45 t "MT_TESTSUITE
8570: 4e 41 4d 45 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 NAME" (common:ge
8580: 74 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 t-testsuite-name
8590: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b )))). ;
85a0: 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 ;(bb-check-path
85b0: 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 msg: "launch:exe
85c0: 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 6b 20 cute post block
85d0: 33 22 29 0a 0a 09 20 20 28 69 66 20 6d 74 2d 62 3")... (if mt-b
85e0: 69 6e 64 69 72 2d 70 61 74 68 20 28 73 65 74 65 indir-path (sete
85f0: 6e 76 20 22 50 41 54 48 22 20 28 63 6f 6e 63 20 nv "PATH" (conc
8600: 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 20 (getenv "PATH")
8610: 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 ":" mt-bindir-pa
8620: 74 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 th))).
8630: 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 68 ;;(bb-check-path
8640: 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 78 msg: "launch:ex
8650: 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 6b ecute post block
8660: 20 34 22 29 0a 09 20 20 3b 3b 20 28 63 68 61 6e 4").. ;; (chan
8670: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 ge-directory top
8680: 2d 70 61 74 68 29 0a 09 20 20 3b 3b 20 43 61 6e -path).. ;; Can
8690: 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 setup as client
86a0: 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 for server mode
86b0: 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 now.. ;; (clie
86c0: 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 0a 09 nt:setup)... ..
86d0: 20 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 ;; environment
86e0: 20 6f 76 65 72 72 69 64 65 73 20 61 72 65 20 64 overrides are d
86f0: 6f 6e 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 one *before* the
8700: 20 72 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 remaining criti
8710: 63 61 6c 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 cal envars... (
8720: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
8730: 65 6e 76 2d 6f 76 72 64 29 0a 20 20 20 20 20 20 env-ovrd).
8740: 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d ;;(bb-check-
8750: 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 path msg: "launc
8760: 68 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 h:execute post b
8770: 6c 6f 63 6b 20 34 31 22 29 0a 09 20 20 28 72 75 lock 41").. (ru
8780: 6e 73 3a 73 65 74 2d 6d 65 67 61 74 65 73 74 2d ns:set-megatest-
8790: 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 env-vars run-id
87a0: 69 6e 6b 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b inkeys: keys ink
87b0: 65 79 76 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 eyvals: keyvals)
87c0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 . ;;(bb
87d0: 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a -check-path msg:
87e0: 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 "launch:execute
87f0: 20 70 6f 73 74 20 62 6c 6f 63 6b 20 34 32 22 29 post block 42")
8800: 0a 09 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e .. (set-item-en
8810: 76 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a v-vars itemdat).
8820: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d ;;(bb-
8830: 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 check-path msg:
8840: 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 "launch:execute
8850: 70 6f 73 74 20 62 6c 6f 63 6b 20 34 33 22 29 0a post block 43").
8860: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
8870: 28 62 6c 61 63 6b 6c 69 73 74 20 28 63 6f 6e 66 (blacklist (conf
8880: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
8890: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
88a0: 62 6c 61 63 6b 6c 69 73 74 76 61 72 73 22 29 29 blacklistvars"))
88b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 ). (i
88c0: 66 20 62 6c 61 63 6b 6c 69 73 74 0a 20 20 20 20 f blacklist.
88d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 61 76 (sav
88e0: 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 e-environment-as
88f0: 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 65 73 74 -files "megatest
8900: 22 20 69 67 6e 6f 72 65 76 61 72 73 3a 20 28 73 " ignorevars: (s
8910: 74 72 69 6e 67 2d 73 70 6c 69 74 20 62 6c 61 63 tring-split blac
8920: 6b 6c 69 73 74 29 29 0a 20 20 20 20 20 20 20 20 klist)).
8930: 20 20 20 20 20 20 20 20 28 73 61 76 65 2d 65 6e (save-en
8940: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
8950: 65 73 20 22 6d 65 67 61 74 65 73 74 22 29 29 29 es "megatest")))
8960: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 . ;;(bb
8970: 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a -check-path msg:
8980: 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 "launch:execute
8990: 20 70 6f 73 74 20 62 6c 6f 63 6b 20 34 34 22 29 post block 44")
89a0: 0a 09 20 20 3b 3b 20 6f 70 65 6e 2d 72 75 6e 2d .. ;; open-run-
89b0: 63 6c 6f 73 65 20 6e 6f 74 20 6e 65 65 64 65 64 close not needed
89c0: 20 66 6f 72 20 74 65 73 74 2d 73 65 74 2d 6d 65 for test-set-me
89d0: 74 61 2d 69 6e 66 6f 0a 09 20 20 3b 3b 20 28 74 ta-info.. ;; (t
89e0: 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 ests:set-full-me
89f0: 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d ta-info #f test-
8a00: 69 64 20 72 75 6e 2d 69 64 20 30 20 77 6f 72 6b id run-id 0 work
8a10: 2d 61 72 65 61 29 0a 09 20 20 3b 3b 20 28 74 65 -area).. ;; (te
8a20: 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 sts:set-full-met
8a30: 61 2d 69 6e 66 6f 20 74 65 73 74 2d 69 64 20 72 a-info test-id r
8a40: 75 6e 2d 69 64 20 30 20 77 6f 72 6b 2d 61 72 65 un-id 0 work-are
8a50: 61 29 0a 09 20 20 28 74 65 73 74 73 3a 73 65 74 a).. (tests:set
8a60: 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 -full-meta-info
8a70: 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 #f test-id run-i
8a80: 64 20 30 20 77 6f 72 6b 2d 61 72 65 61 20 31 30 d 0 work-area 10
8a90: 29 0a 0a 09 20 20 3b 3b 20 28 74 68 72 65 61 64 )... ;; (thread
8aa0: 2d 73 6c 65 65 70 21 20 30 2e 33 29 20 3b 3b 20 -sleep! 0.3) ;;
8ab0: 4e 46 53 20 73 6c 6f 77 6e 65 73 73 20 68 61 73 NFS slowness has
8ac0: 20 63 61 75 73 65 64 20 67 72 69 65 66 20 68 65 caused grief he
8ad0: 72 65 0a 0a 09 20 20 28 69 66 20 28 61 72 67 73 re... (if (args
8ae0: 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d :get-arg "-xterm
8af0: 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 ").. (set!
8b00: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 22 78 fullrunscript "x
8b10: 74 65 72 6d 22 29 0a 09 20 20 20 20 20 20 28 69 term").. (i
8b20: 66 20 28 61 6e 64 20 66 75 6c 6c 72 75 6e 73 63 f (and fullrunsc
8b30: 72 69 70 74 20 0a 09 09 20 20 20 20 20 20 20 28 ript ... (
8b40: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
8b50: 74 73 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ts? fullrunscrip
8b60: 74 29 0a 09 09 20 20 20 20 20 20 20 28 6e 6f 74 t)... (not
8b70: 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 (file-execute-a
8b80: 63 63 65 73 73 3f 20 66 75 6c 6c 72 75 6e 73 63 ccess? fullrunsc
8b90: 72 69 70 74 29 29 29 0a 09 09 20 20 28 73 79 73 ript)))... (sys
8ba0: 74 65 6d 20 28 63 6f 6e 63 20 22 63 68 6d 6f 64 tem (conc "chmod
8bb0: 20 75 67 2b 78 20 22 20 66 75 6c 6c 72 75 6e 73 ug+x " fullruns
8bc0: 63 72 69 70 74 29 29 29 29 0a 0a 09 20 20 3b 3b cript))))... ;;
8bd0: 20 57 65 20 61 72 65 20 61 62 6f 75 74 20 74 6f We are about to
8be0: 20 61 63 74 75 61 6c 6c 79 20 6b 69 63 6b 20 6f actually kick o
8bf0: 66 66 20 74 68 65 20 74 65 73 74 0a 09 20 20 3b ff the test.. ;
8c00: 3b 20 73 6f 20 74 68 69 73 20 69 73 20 61 20 67 ; so this is a g
8c10: 6f 6f 64 20 70 6c 61 63 65 20 74 6f 20 72 65 6d ood place to rem
8c20: 6f 76 65 20 74 68 65 20 72 65 63 6f 72 64 73 20 ove the records
8c30: 66 6f 72 20 0a 09 20 20 3b 3b 20 61 6e 79 20 70 for .. ;; any p
8c40: 72 65 76 69 6f 75 73 20 72 75 6e 73 0a 09 20 20 revious runs..
8c50: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 72 65 6d 6f ;; (db:test-remo
8c60: 76 65 2d 73 74 65 70 73 20 64 62 20 72 75 6e 2d ve-steps db run-
8c70: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
8c80: 64 61 74 29 0a 09 20 20 3b 3b 20 0a 09 20 20 28 dat).. ;; .. (
8c90: 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 let* ((m
8ca0: 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 (make-mutex)
8cb0: 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 )... (kill-job?
8cc0: 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d #f)... (exit-
8cd0: 69 6e 66 6f 20 20 20 20 28 6d 61 6b 65 2d 6c 61 info (make-la
8ce0: 75 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 23 unch:einf pid: #
8cf0: 74 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 23 t exit-status: #
8d00: 74 20 65 78 69 74 2d 63 6f 64 65 3a 20 23 74 20 t exit-code: #t
8d10: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 30 rollup-status: 0
8d20: 29 29 20 3b 3b 20 70 69 64 20 65 78 69 74 2d 73 )) ;; pid exit-s
8d30: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 20 tatus exit-code
8d40: 28 69 2e 65 2e 20 70 72 6f 63 65 73 73 20 77 61 (i.e. process wa
8d50: 73 20 73 75 63 63 65 73 73 66 75 6c 6c 79 20 72 s successfully r
8d60: 75 6e 29 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 un) rollup-statu
8d70: 73 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 s... (job-thread
8d80: 20 20 20 23 66 29 0a 09 09 20 3b 3b 20 28 6b 65 #f)... ;; (ke
8d90: 65 70 2d 67 6f 69 6e 67 20 20 20 23 74 29 0a 09 ep-going #t)..
8da0: 09 20 28 6d 69 73 63 2d 66 6c 61 67 73 20 20 20 . (misc-flags
8db0: 28 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d (let ((ht (make-
8dc0: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 hash-table)))...
8dd0: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
8de0: 65 74 21 20 68 74 20 27 6b 65 65 70 2d 67 6f 69 et! ht 'keep-goi
8df0: 6e 67 20 23 74 29 0a 09 09 09 09 20 68 74 29 29 ng #t)..... ht))
8e00: 0a 09 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 ... (runit
8e10: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
8e20: 09 20 28 6c 61 75 6e 63 68 3a 6d 61 6e 61 67 65 . (launch:manage
8e30: 2d 73 74 65 70 73 20 72 75 6e 2d 69 64 20 74 65 -steps run-id te
8e40: 73 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 st-id item-path
8e50: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 7a fullrunscript ez
8e60: 73 74 65 70 73 20 74 65 73 74 2d 6e 61 6d 65 20 steps test-name
8e70: 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 2d tconfigreg exit-
8e80: 69 6e 66 6f 20 6d 29 29 29 0a 09 09 20 28 6d 6f info m)))... (mo
8e90: 6e 69 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 nitorjob (lamb
8ea0: 64 61 20 28 29 0a 09 09 09 09 20 28 6c 61 75 6e da ()..... (laun
8eb0: 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 20 ch:monitor-job
8ec0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 run-id test-id i
8ed0: 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e tem-path fullrun
8ee0: 73 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 script ezsteps t
8ef0: 65 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 est-name tconfig
8f00: 72 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 reg exit-info m
8f10: 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 74 6c 69 work-area runtli
8f20: 6d 20 6d 69 73 63 2d 66 6c 61 67 73 29 29 29 0a m misc-flags))).
8f30: 09 09 20 28 74 68 31 20 20 20 20 20 20 20 20 20 .. (th1
8f40: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 6d 6f (make-thread mo
8f50: 6e 69 74 6f 72 6a 6f 62 20 22 6d 6f 6e 69 74 6f nitorjob "monito
8f60: 72 20 6a 6f 62 22 29 29 0a 09 09 20 28 74 68 32 r job"))... (th2
8f70: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
8f80: 74 68 72 65 61 64 20 72 75 6e 69 74 20 22 72 75 thread runit "ru
8f90: 6e 20 6a 6f 62 22 29 29 29 0a 09 20 20 20 20 28 n job"))).. (
8fa0: 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 61 64 20 set! job-thread
8fb0: 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 th2).. (threa
8fc0: 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 20 d-start! th1)..
8fd0: 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 (thread-start
8fe0: 21 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 72 ! th2).. (thr
8ff0: 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 29 0a 09 ead-join! th2)..
9000: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
9010: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
9020: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d 65 67 61 -log-port* "Mega
9030: 74 65 73 74 20 65 78 65 63 74 75 74 65 20 6f 66 test exectute of
9040: 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e 61 6d test " test-nam
9050: 65 20 22 2c 20 69 74 65 6d 20 70 61 74 68 20 22 e ", item path "
9060: 20 69 74 65 6d 2d 70 61 74 68 20 22 20 63 6f 6d item-path " com
9070: 70 6c 65 74 65 2e 20 4e 6f 74 69 66 79 69 6e 67 plete. Notifying
9080: 20 74 68 65 20 64 62 20 2e 2e 2e 22 29 0a 09 20 the db ...")..
9090: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
90a0: 65 74 21 20 6d 69 73 63 2d 66 6c 61 67 73 20 27 et! misc-flags '
90b0: 6b 65 65 70 2d 67 6f 69 6e 67 20 23 66 29 0a 09 keep-going #f)..
90c0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
90d0: 21 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 ! th1).. (thr
90e0: 65 61 64 2d 73 6c 65 65 70 21 20 31 29 20 20 20 ead-sleep! 1)
90f0: 20 20 20 20 3b 3b 20 67 69 76 62 65 20 74 68 72 ;; givbe thr
9100: 65 61 64 20 74 68 31 20 61 20 63 68 61 6e 63 65 ead th1 a chance
9110: 20 74 6f 20 62 65 20 64 6f 6e 65 20 54 4f 44 4f to be done TODO
9120: 3a 20 56 65 72 69 66 79 20 74 68 69 73 20 69 73 : Verify this is
9130: 20 6e 65 65 64 65 64 2e 20 41 74 20 30 2e 31 20 needed. At 0.1
9140: 49 20 77 61 73 20 67 65 74 74 69 6e 67 20 66 61 I was getting fa
9150: 69 6c 20 74 6f 20 73 74 6f 70 2c 20 69 6e 63 72 il to stop, incr
9160: 65 61 73 65 64 20 74 6f 20 74 6f 74 61 6c 20 6f eased to total o
9170: 66 20 31 2e 31 20 73 65 63 2e 0a 09 20 20 20 20 f 1.1 sec...
9180: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
9190: 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 . (let* ((ite
91a0: 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 m-path (item-lis
91b0: 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 t->path itemdat)
91c0: 29 0a 09 09 20 20 20 3b 3b 20 6f 6e 6c 79 20 73 )... ;; only s
91d0: 74 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 tate and status
91e0: 6e 65 65 64 65 64 20 2d 20 75 73 65 20 6c 61 7a needed - use laz
91f0: 79 20 72 6f 75 74 69 6e 65 0a 09 09 20 20 20 28 y routine... (
9200: 74 65 73 74 69 6e 66 6f 20 20 28 72 6d 74 3a 67 testinfo (rmt:g
9210: 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 et-testinfo-stat
9220: 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 e-status run-id
9230: 74 65 73 74 2d 69 64 29 29 29 0a 09 20 20 20 20 test-id)))..
9240: 20 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 ;; Am I comple
9250: 74 65 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 ted?.. (if
9260: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
9270: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 -get-state testi
9280: 6e 66 6f 29 20 27 28 22 52 45 4d 4f 54 45 48 4f nfo) '("REMOTEHO
9290: 53 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e STSTART" "RUNNIN
92a0: 47 22 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 49 74 G")) ;; NOTE: It
92b0: 20 73 68 6f 75 6c 64 20 2a 6e 6f 74 2a 20 62 65 should *not* be
92c0: 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 REMOTEHOSTSTART
92d0: 20 62 75 74 20 66 6f 72 20 72 65 61 73 6f 6e 73 but for reasons
92e0: 20 49 20 64 6f 6e 27 74 20 79 65 74 20 75 6e 64 I don't yet und
92f0: 65 72 73 74 61 6e 64 20 69 74 20 73 6f 6d 65 74 erstand it somet
9300: 69 6d 65 73 20 67 65 74 73 20 73 74 75 63 6b 20 imes gets stuck
9310: 69 6e 20 74 68 61 74 20 73 74 61 74 65 20 3b 3b in that state ;;
9320: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 (not (equal? (d
9330: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
9340: 20 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 testinfo) "COMP
9350: 4c 45 54 45 44 22 29 29 0a 09 09 20 20 28 6c 65 LETED"))... (le
9360: 74 20 28 28 6e 65 77 2d 73 74 61 74 65 20 20 28 t ((new-state (
9370: 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 if kill-job? "KI
9380: 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 LLED" "COMPLETED
9390: 22 29 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 28 ") ;; (if (eq? (
93a0: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
93b0: 69 6e 66 6f 20 32 29 20 30 29 20 3b 3b 20 65 78 info 2) 0) ;; ex
93c0: 69 74 65 64 20 77 69 74 68 20 22 67 6f 6f 64 22 ited with "good"
93d0: 20 73 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 status.....
93e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9400: 20 20 20 20 3b 3b 20 22 43 4f 4d 50 4c 45 54 45 ;; "COMPLETE
9410: 44 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 D"........
9420: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 62 ;; (db
9430: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
9440: 74 65 73 74 69 6e 66 6f 29 29 29 20 20 20 3b 3b testinfo))) ;;
9450: 20 65 6c 73 65 20 70 72 65 73 65 76 65 20 74 68 else preseve th
9460: 65 20 73 74 61 74 65 20 61 73 20 73 65 74 20 77 e state as set w
9470: 69 74 68 69 6e 20 74 68 65 20 74 65 73 74 0a 09 ithin the test..
9480: 09 09 09 20 20 20 20 29 0a 09 09 09 28 6e 65 77 ... )....(new
9490: 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 -status (cond...
94a0: 09 09 20 20 20 20 20 28 28 6e 6f 74 20 28 6c 61 .. ((not (la
94b0: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 unch:einf-exit-s
94c0: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
94d0: 29 20 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 ) "FAIL") ;; job
94e0: 20 66 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 2e failed to run .
94f0: 2e 2e 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 .. (vector-ref e
9500: 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 xit-info 1).....
9510: 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e ((eq? (laun
9520: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
9530: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
9540: 20 30 29 20 20 20 20 20 3b 3b 20 28 76 65 63 74 0) ;; (vect
9550: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
9560: 20 33 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 3)..... ;;
9570: 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 if the current
9580: 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 status is AUTO t
9590: 68 65 6e 20 64 65 66 65 72 20 74 6f 20 74 68 65 hen defer to the
95a0: 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 calculated valu
95b0: 65 20 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 e (i.e. leave th
95c0: 69 73 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 is AUTO).....
95d0: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
95e0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
95f0: 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 us testinfo) "AU
9600: 54 4f 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 TO") "AUTO" "PAS
9610: 53 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 S"))..... ((
9620: 65 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 eq? (launch:einf
9630: 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 -rollup-status e
9640: 78 69 74 2d 69 6e 66 6f 29 20 31 29 20 22 46 41 xit-info) 1) "FA
9650: 49 4c 22 29 20 20 3b 3b 20 28 76 65 63 74 6f 72 IL") ;; (vector
9660: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 -ref exit-info 3
9670: 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f )..... ((eq?
9680: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f (launch:einf-ro
9690: 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 llup-status exit
96a0: 2d 69 6e 66 6f 29 20 32 29 09 20 20 20 20 20 3b -info) 2). ;
96b0: 3b 09 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 ;.(vector-ref ex
96c0: 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 20 it-info 3).....
96d0: 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 ;; if the c
96e0: 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 urrent status is
96f0: 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 AUTO the defer
9700: 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 to the calculate
9710: 64 20 76 61 6c 75 65 20 62 75 74 20 71 75 61 6c d value but qual
9720: 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 ify (i.e. make t
9730: 68 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 his AUTO-WARN)..
9740: 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 71 ... (if (eq
9750: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
9760: 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 t-status testinf
9770: 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f o) "AUTO") "AUTO
9780: 2d 57 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a -WARN" "WARN")).
9790: 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 .... ((eq? (
97a0: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c launch:einf-roll
97b0: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 up-status exit-i
97c0: 6e 66 6f 29 20 33 29 20 22 43 48 45 43 4b 22 29 nfo) 3) "CHECK")
97d0: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
97e0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
97f0: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
9800: 69 6e 66 6f 29 20 34 29 20 22 57 41 49 56 45 44 info) 4) "WAIVED
9810: 22 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 ")..... ((eq
9820: 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 ? (launch:einf-r
9830: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 ollup-status exi
9840: 74 2d 69 6e 66 6f 29 20 35 29 20 22 41 42 4f 52 t-info) 5) "ABOR
9850: 54 22 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 T")..... ((e
9860: 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d q? (launch:einf-
9870: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
9880: 69 74 2d 69 6e 66 6f 29 20 36 29 20 22 53 4b 49 it-info) 6) "SKI
9890: 50 22 29 0a 09 09 09 09 20 20 20 20 20 28 65 6c P")..... (el
98a0: 73 65 20 22 46 41 49 4c 22 29 29 29 29 20 3b 3b se "FAIL")))) ;;
98b0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
98c0: 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 29 29 atus testinfo)))
98d0: 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
98e0: 69 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 int-info 1 *defa
98f0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 54 ult-log-port* "T
9900: 65 73 74 20 65 78 69 74 65 64 20 69 6e 20 73 74 est exited in st
9910: 61 74 65 3d 22 20 28 64 62 3a 74 65 73 74 2d 67 ate=" (db:test-g
9920: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
9930: 6f 29 20 22 2c 20 73 65 74 74 69 6e 67 20 73 74 o) ", setting st
9940: 61 74 65 2f 73 74 61 74 75 73 20 62 61 73 65 64 ate/status based
9950: 20 6f 6e 20 65 78 69 74 20 63 6f 64 65 20 6f 66 on exit code of
9960: 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d " (launch:einf-
9970: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
9980: 2d 69 6e 66 6f 29 20 22 20 61 6e 64 20 72 6f 6c -info) " and rol
9990: 6c 75 70 2d 73 74 61 74 75 73 20 6f 66 20 22 20 lup-status of "
99a0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
99b0: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
99c0: 69 6e 66 6f 29 29 0a 09 09 20 20 20 20 28 74 65 info))... (te
99d0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
99e0: 74 75 73 21 20 72 75 6e 2d 69 64 20 0a 09 09 09 tus! run-id ....
99f0: 09 09 20 20 20 20 74 65 73 74 2d 69 64 20 0a 09 .. test-id ..
9a00: 09 09 09 09 20 20 20 20 6e 65 77 2d 73 74 61 74 .... new-stat
9a10: 65 0a 09 09 09 09 09 20 20 20 20 6e 65 77 2d 73 e...... new-s
9a20: 74 61 74 75 73 0a 09 09 09 09 09 20 20 20 20 28 tatus...... (
9a30: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
9a40: 22 29 20 23 66 29 0a 09 09 20 20 20 20 3b 3b 20 ") #f)... ;;
9a50: 6e 65 65 64 20 74 6f 20 75 70 64 61 74 65 20 74 need to update t
9a60: 68 65 20 74 6f 70 20 74 65 73 74 20 72 65 63 6f he top test reco
9a70: 72 64 20 69 66 20 50 41 53 53 20 6f 72 20 46 41 rd if PASS or FA
9a80: 49 4c 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 IL and this is a
9a90: 20 73 75 62 74 65 73 74 0a 09 09 20 20 20 20 3b subtest... ;
9aa0: 3b 20 4e 4f 20 4e 45 45 44 20 54 4f 20 43 41 4c ; NO NEED TO CAL
9ab0: 4c 20 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 L set-state-stat
9ac0: 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 us-and-roll-up-i
9ad0: 74 65 6d 73 20 48 45 52 45 2c 20 54 48 49 53 20 tems HERE, THIS
9ae0: 49 53 20 44 4f 4e 45 20 49 4e 20 73 65 74 2d 73 IS DONE IN set-s
9af0: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
9b00: 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 63 61 roll-up-items ca
9b10: 6c 6c 65 64 20 62 79 20 74 65 73 74 73 3a 74 65 lled by tests:te
9b20: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 0a 09 st-set-status!..
9b30: 09 20 20 20 20 29 29 0a 09 20 20 20 20 20 20 3b . )).. ;
9b40: 3b 20 66 6f 72 20 61 75 74 6f 6d 61 74 65 64 20 ; for automated
9b50: 63 72 65 61 74 69 6f 6e 20 6f 66 20 74 68 65 20 creation of the
9b60: 72 6f 6c 6c 75 70 20 68 74 6d 6c 20 66 69 6c 65 rollup html file
9b70: 20 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 this is a good
9b80: 70 6c 61 63 65 2e 2e 2e 0a 09 20 20 20 20 20 20 place.....
9b90: 28 69 66 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f (if (not (equal?
9ba0: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 0a item-path "")).
9bb0: 09 09 20 20 28 74 65 73 74 73 3a 73 75 6d 6d 61 .. (tests:summa
9bc0: 72 69 7a 65 2d 69 74 65 6d 73 20 72 75 6e 2d 69 rize-items run-i
9bd0: 64 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 6e d test-id test-n
9be0: 61 6d 65 20 23 66 29 29 0a 09 20 20 20 20 20 20 ame #f))..
9bf0: 28 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 (tests:summarize
9c00: 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 73 -test run-id tes
9c10: 74 2d 69 64 29 20 20 3b 3b 20 64 6f 6e 27 74 20 t-id) ;; don't
9c20: 66 6f 72 63 65 20 2d 20 6a 75 73 74 20 75 70 64 force - just upd
9c30: 61 74 65 20 69 66 20 6e 6f 0a 09 20 20 20 20 20 ate if no..
9c40: 20 28 72 6d 74 3a 75 70 64 61 74 65 2d 72 75 6e (rmt:update-run
9c50: 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 20 28 72 -stats run-id (r
9c60: 6d 74 3a 67 65 74 2d 72 61 77 2d 72 75 6e 2d 73 mt:get-raw-run-s
9c70: 74 61 74 73 20 72 75 6e 2d 69 64 29 29 29 0a 09 tats run-id)))..
9c80: 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 (mutex-unloc
9c90: 6b 21 20 6d 29 0a 09 20 20 20 20 28 64 65 62 75 k! m).. (debu
9ca0: 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 g:print 2 *defau
9cb0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4f 75 lt-log-port* "Ou
9cc0: 74 70 75 74 20 66 72 6f 6d 20 72 75 6e 6e 69 6e tput from runnin
9cd0: 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 g " fullrunscrip
9ce0: 74 20 22 2c 20 70 69 64 20 22 20 28 6c 61 75 6e t ", pid " (laun
9cf0: 63 68 3a 65 69 6e 66 2d 70 69 64 20 65 78 69 74 ch:einf-pid exit
9d00: 2d 69 6e 66 6f 29 20 22 20 69 6e 20 77 6f 72 6b -info) " in work
9d10: 20 61 72 65 61 20 22 20 0a 09 09 09 20 77 6f 72 area " .... wor
9d20: 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d 3d 3d 5c k-area ":\n====\
9d30: 6e 20 65 78 69 74 20 63 6f 64 65 20 22 20 28 6c n exit code " (l
9d40: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
9d50: 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 20 code exit-info)
9d60: 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 "\n" "====\n")..
9d70: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
9d80: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 unch:einf-exit-s
9d90: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
9da0: 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 0a )...(exit 4)))).
9db0: 20 20 20 20 20 20 20 20 29 29 29 0a 0a 3b 3b 20 )))..;;
9dc0: 44 4f 20 4e 4f 54 20 55 53 45 20 2d 20 63 61 63 DO NOT USE - cac
9dd0: 68 69 6e 67 20 6f 66 20 63 6f 6e 66 69 67 73 20 hing of configs
9de0: 69 73 20 68 61 6e 64 6c 65 64 20 69 6e 20 6c 61 is handled in la
9df0: 75 6e 63 68 3a 73 65 74 75 70 20 6e 6f 77 2e 0a unch:setup now..
9e00: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e ;;.(define (laun
9e10: 63 68 3a 63 61 63 68 65 2d 63 6f 6e 66 69 67 29 ch:cache-config)
9e20: 0a 20 20 3b 3b 20 69 66 20 77 65 20 68 61 76 65 . ;; if we have
9e30: 20 61 20 6c 69 6e 6b 74 72 65 65 20 61 6e 64 20 a linktree and
9e40: 2d 72 75 6e 74 65 73 74 73 20 61 6e 64 20 2d 74 -runtests and -t
9e50: 61 72 67 65 74 20 61 6e 64 20 74 68 65 20 64 69 arget and the di
9e60: 72 65 63 74 6f 72 79 20 65 78 69 73 74 73 20 64 rectory exists d
9e70: 75 6d 70 20 74 68 65 20 63 6f 6e 66 69 67 0a 20 ump the config.
9e80: 20 3b 3b 20 74 6f 20 6d 65 67 61 74 65 73 74 2d ;; to megatest-
9e90: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
9ea0: 29 2e 63 66 67 20 61 6e 64 20 73 79 6d 6c 69 6e ).cfg and symlin
9eb0: 6b 20 69 74 20 74 6f 20 6d 65 67 61 74 65 73 74 k it to megatest
9ec0: 2e 63 66 67 0a 20 20 28 69 66 20 28 61 6e 64 20 .cfg. (if (and
9ed0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 0a 09 20 20 *configdat* ..
9ee0: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
9ef0: 72 67 20 22 2d 72 75 6e 22 29 0a 09 20 20 20 20 rg "-run")..
9f00: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
9f10: 20 22 2d 72 75 6e 74 65 73 74 73 22 29 0a 09 20 "-runtests")..
9f20: 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d (args:get-
9f30: 61 72 67 20 22 2d 65 78 65 63 75 74 65 22 29 29 arg "-execute"))
9f40: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
9f50: 6c 69 6e 6b 74 72 65 65 20 28 63 6f 6d 6d 6f 6e linktree (common
9f60: 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 20 :get-linktree))
9f70: 3b 3b 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d ;; (get-environm
9f80: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
9f90: 5f 4c 49 4e 4b 54 52 45 45 22 29 29 0a 09 20 20 _LINKTREE"))..
9fa0: 20 20 20 28 74 61 72 67 65 74 20 20 20 28 63 6f (target (co
9fb0: 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d 74 61 mmon:args-get-ta
9fc0: 72 67 65 74 20 65 78 69 74 2d 69 66 2d 62 61 64 rget exit-if-bad
9fd0: 3a 20 23 74 29 29 0a 09 20 20 20 20 20 28 72 75 : #t)).. (ru
9fe0: 6e 6e 61 6d 65 20 20 28 6f 72 20 28 61 72 67 73 nname (or (args
9ff0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 :get-arg "-runna
a000: 6d 65 22 29 0a 09 09 09 20 20 20 28 61 72 67 73 me").... (args
a010: 3a 67 65 74 2d 61 72 67 20 22 3a 72 75 6e 6e 61 :get-arg ":runna
a020: 6d 65 22 29 0a 09 09 09 20 20 20 28 67 65 74 65 me").... (gete
a030: 6e 76 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 29 nv "MT_RUNNAME")
a040: 29 29 0a 09 20 20 20 20 20 28 66 75 6c 6c 64 69 )).. (fulldi
a050: 72 20 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 r (conc linktre
a060: 65 20 22 2f 22 0a 09 09 09 20 20 20 20 20 74 61 e "/".... ta
a070: 72 67 65 74 20 22 2f 22 0a 09 09 09 20 20 20 20 rget "/"....
a080: 20 72 75 6e 6e 61 6d 65 29 29 29 0a 09 28 69 66 runname)))..(if
a090: 20 28 61 6e 64 20 6c 69 6e 6b 74 72 65 65 20 28 (and linktree (
a0a0: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
a0b0: 74 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 20 3b ts? linktree)) ;
a0c0: 3b 20 63 61 6e 27 74 20 70 72 6f 63 65 65 64 20 ; can't proceed
a0d0: 77 69 74 68 6f 75 74 20 6c 69 6e 6b 74 72 65 65 without linktree
a0e0: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
a0f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
a100: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
a110: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 48 61 76 65 -log-port* "Have
a120: 20 2d 72 75 6e 20 77 69 74 68 20 74 61 72 67 65 -run with targe
a130: 74 3d 22 20 74 61 72 67 65 74 20 22 2c 20 72 75 t=" target ", ru
a140: 6e 6e 61 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 20 nname=" runname
a150: 22 2c 20 66 75 6c 6c 64 69 72 3d 22 20 66 75 6c ", fulldir=" ful
a160: 6c 64 69 72 20 22 2c 20 74 65 73 74 70 61 74 74 ldir ", testpatt
a170: 3d 22 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 =" (or (args:get
a180: 2d 61 72 67 20 22 2d 74 65 73 74 70 61 74 74 22 -arg "-testpatt"
a190: 29 20 22 25 22 29 29 0a 09 20 20 20 20 20 20 28 ) "%")).. (
a1a0: 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a if (not (common:
a1b0: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c file-exists? ful
a1c0: 6c 64 69 72 29 29 0a 09 09 20 20 28 63 72 65 61 ldir))... (crea
a1d0: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 66 75 6c te-directory ful
a1e0: 6c 64 69 72 20 23 74 29 29 20 3b 3b 20 6e 65 65 ldir #t)) ;; nee
a1f0: 64 20 74 6f 20 70 72 6f 74 65 63 74 20 77 69 74 d to protect wit
a200: 68 20 65 78 63 65 70 74 69 6f 6e 20 68 61 6e 64 h exception hand
a210: 6c 65 72 20 0a 09 20 20 20 20 20 20 28 69 66 20 ler .. (if
a220: 28 61 6e 64 20 74 61 72 67 65 74 0a 09 09 20 20 (and target...
a230: 20 20 20 20 20 72 75 6e 6e 61 6d 65 0a 09 09 20 runname...
a240: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (common:fi
a250: 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 64 le-exists? fulld
a260: 69 72 29 29 0a 09 09 20 20 28 6c 65 74 20 28 28 ir))... (let ((
a270: 74 6d 70 66 69 6c 65 20 20 28 63 6f 6e 63 20 66 tmpfile (conc f
a280: 75 6c 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 65 ulldir "/.megate
a290: 73 74 2e 63 66 67 2e 22 20 28 63 75 72 72 65 6e st.cfg." (curren
a2a0: 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 09 09 t-seconds)))....
a2b0: 28 74 61 72 67 66 69 6c 65 20 28 63 6f 6e 63 20 (targfile (conc
a2c0: 66 75 6c 6c 64 69 72 20 22 2f 2e 6d 65 67 61 74 fulldir "/.megat
a2d0: 65 73 74 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 est.cfg-" megat
a2e0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 est-version "-"
a2f0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
a300: 68 61 73 68 29 29 0a 09 09 09 28 72 63 6f 6e 66 hash))....(rconf
a310: 69 67 20 20 28 63 6f 6e 63 20 66 75 6c 6c 64 69 ig (conc fulldi
a320: 72 20 22 2f 2e 72 75 6e 63 6f 6e 66 69 67 2e 22 r "/.runconfig."
a330: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
a340: 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 n "-" megatest-f
a350: 6f 73 73 69 6c 2d 68 61 73 68 29 29 29 0a 09 09 ossil-hash)))...
a360: 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a (if (common:
a370: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 63 6f file-exists? rco
a380: 6e 66 69 67 29 20 3b 3b 20 6f 6e 6c 79 20 63 61 nfig) ;; only ca
a390: 63 68 65 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e che megatest.con
a3a0: 66 69 67 20 41 46 54 45 52 20 72 75 6e 63 6f 6e fig AFTER runcon
a3b0: 66 69 67 73 20 68 61 73 20 62 65 65 6e 20 63 61 figs has been ca
a3c0: 63 68 65 64 0a 09 09 09 28 62 65 67 69 6e 0a 09 ched....(begin..
a3d0: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
a3e0: 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 -info 0 *default
a3f0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 61 63 68 -log-port* "Cach
a400: 69 6e 67 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e ing megatest.con
a410: 66 69 67 20 69 6e 20 22 20 74 6d 70 66 69 6c 65 fig in " tmpfile
a420: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a430: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
a440: 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 69 6e 2d (not (common:in-
a450: 72 75 6e 6e 69 6e 67 2d 74 65 73 74 3f 29 29 0a running-test?)).
a460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
a480: 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 onfigf:write-ali
a490: 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 st *configdat* t
a4a0: 6d 70 66 69 6c 65 29 29 0a 09 09 09 20 20 28 73 mpfile)).... (s
a4b0: 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6c 6e 20 ystem (conc "ln
a4c0: 2d 73 66 20 22 20 74 6d 70 66 69 6c 65 20 22 20 -sf " tmpfile "
a4d0: 22 20 74 61 72 67 66 69 6c 65 29 29 29 29 0a 09 " targfile))))..
a4e0: 09 20 20 20 20 29 29 29 0a 09 20 20 20 20 28 64 . ))).. (d
a4f0: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
a500: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
a510: 6f 72 74 2a 20 22 4e 6f 20 6c 69 6e 6b 74 72 65 ort* "No linktre
a520: 65 20 79 65 74 2c 20 6e 6f 20 63 61 63 68 69 6e e yet, no cachin
a530: 67 20 63 6f 6e 66 69 67 73 2e 22 29 29 29 29 29 g configs.")))))
a540: 0a 0a 0a 3b 3b 20 67 61 74 68 65 72 20 61 76 61 ...;; gather ava
a550: 69 6c 61 62 6c 65 20 69 6e 66 6f 72 6d 61 74 69 ilable informati
a560: 6f 6e 2c 20 69 66 20 6c 65 67 69 74 20 72 65 61 on, if legit rea
a570: 64 20 63 6f 6e 66 69 67 73 20 69 6e 20 74 68 69 d configs in thi
a580: 73 20 6f 72 64 65 72 3a 0a 3b 3b 0a 3b 3b 20 20 s order:.;;.;;
a590: 20 69 66 20 68 61 76 65 20 63 61 63 68 65 3b 0a if have cache;.
a5a0: 3b 3b 20 20 20 20 20 20 72 65 61 64 20 69 74 20 ;; read it
a5b0: 61 20 72 65 74 75 72 6e 20 69 74 0a 3b 3b 20 20 a return it.;;
a5c0: 20 65 6c 73 65 0a 3b 3b 20 20 20 20 20 6d 65 67 else.;; meg
a5d0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 20 20 20 atest.config
a5e0: 20 28 64 6f 20 6e 6f 74 20 63 61 63 68 65 29 0a (do not cache).
a5f0: 3b 3b 20 20 20 20 20 72 75 6e 63 6f 6e 66 69 67 ;; runconfig
a600: 73 2e 63 6f 6e 66 69 67 20 20 20 28 63 61 63 68 s.config (cach
a610: 65 20 69 66 20 61 6c 6c 20 76 61 72 73 20 61 76 e if all vars av
a620: 61 69 6c 29 0a 3b 3b 20 20 20 20 20 6d 65 67 61 ail).;; mega
a630: 74 65 73 74 2e 63 6f 6e 66 69 67 20 20 20 20 20 test.config
a640: 28 63 61 63 68 65 20 69 66 20 61 6c 6c 20 76 61 (cache if all va
a650: 72 73 20 61 76 61 69 6c 29 0a 3b 3b 20 20 20 72 rs avail).;; r
a660: 65 74 75 72 6e 73 3a 0a 3b 3b 20 20 20 20 20 2a eturns:.;; *
a670: 74 6f 70 70 61 74 68 2a 0a 3b 3b 20 20 20 73 69 toppath*.;; si
a680: 64 65 20 65 66 66 65 63 74 73 3a 0a 3b 3b 20 20 de effects:.;;
a690: 20 20 20 73 65 74 73 3b 20 2a 63 6f 6e 66 69 67 sets; *config
a6a0: 64 61 74 2a 20 20 20 20 28 6d 65 67 61 74 65 73 dat* (megates
a6b0: 74 2e 63 6f 6e 66 69 67 20 69 6e 66 6f 29 0a 3b t.config info).;
a6c0: 3b 20 20 20 20 20 20 20 20 20 20 20 2a 72 75 6e ; *run
a6d0: 63 6f 6e 66 69 67 64 61 74 2a 20 28 72 75 6e 63 configdat* (runc
a6e0: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 69 6e onfigs.config in
a6f0: 66 6f 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 fo).;;
a700: 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 *configstatus*
a710: 28 73 74 61 74 75 73 20 6f 66 20 74 68 65 20 72 (status of the r
a720: 65 61 64 20 64 61 74 61 29 0a 3b 3b 0a 28 64 65 ead data).;;.(de
a730: 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 73 65 74 fine (launch:set
a740: 75 70 20 23 21 6b 65 79 20 28 66 6f 72 63 65 2d up #!key (force-
a750: 72 65 72 65 61 64 20 23 66 29 20 28 61 72 65 61 reread #f) (area
a760: 70 61 74 68 20 23 66 29 29 0a 20 20 28 6d 75 74 path #f)). (mut
a770: 65 78 2d 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 ex-lock! *launch
a780: 2d 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 0a 20 -setup-mutex*).
a790: 20 28 69 66 20 28 61 6e 64 20 2a 74 6f 70 70 61 (if (and *toppa
a7a0: 74 68 2a 0a 09 20 20 20 28 65 71 3f 20 2a 63 6f th*.. (eq? *co
a7b0: 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 6c nfigstatus* 'ful
a7c0: 6c 64 61 74 61 29 20 28 6e 6f 74 20 66 6f 72 63 ldata) (not forc
a7d0: 65 2d 72 65 72 65 61 64 29 29 20 3b 3b 20 67 6f e-reread)) ;; go
a7e0: 74 20 69 74 20 61 6c 6c 0a 20 20 20 20 20 20 28 t it all. (
a7f0: 62 65 67 69 6e 0a 09 28 64 65 62 75 67 3a 70 72 begin..(debug:pr
a800: 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
a810: 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 45 3a 20 og-port* "NOTE:
a820: 73 6b 69 70 70 69 6e 67 20 6c 61 75 6e 63 68 3a skipping launch:
a830: 73 65 74 75 70 2d 62 6f 64 79 20 63 61 6c 6c 20 setup-body call
a840: 73 69 6e 63 65 20 77 65 20 68 61 76 65 20 66 75 since we have fu
a850: 6c 6c 64 61 74 61 22 29 0a 09 28 6d 75 74 65 78 lldata")..(mutex
a860: 2d 75 6e 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 -unlock! *launch
a870: 2d 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 0a 09 -setup-mutex*)..
a880: 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 *toppath*).
a890: 20 28 6c 65 74 20 28 28 72 65 73 20 28 6c 61 75 (let ((res (lau
a8a0: 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 66 nch:setup-body f
a8b0: 6f 72 63 65 2d 72 65 72 65 61 64 3a 20 66 6f 72 orce-reread: for
a8c0: 63 65 2d 72 65 72 65 61 64 20 61 72 65 61 70 61 ce-reread areapa
a8d0: 74 68 3a 20 61 72 65 61 70 61 74 68 29 29 29 0a th: areapath))).
a8e0: 09 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 .(mutex-unlock!
a8f0: 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 *launch-setup-mu
a900: 74 65 78 2a 29 0a 09 72 65 73 29 29 29 0a 0a 3b tex*)..res)))..;
a910: 3b 20 72 65 74 75 72 6e 20 70 61 74 68 73 20 64 ; return paths d
a920: 65 70 65 6e 64 69 6e 67 20 6f 6e 20 77 68 61 74 epending on what
a930: 20 69 6e 66 6f 20 69 73 20 61 76 61 69 6c 61 62 info is availab
a940: 6c 65 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 le..;;.(define (
a950: 6c 61 75 6e 63 68 3a 67 65 74 2d 63 61 63 68 65 launch:get-cache
a960: 2d 66 69 6c 65 2d 70 61 74 68 73 20 61 72 65 61 -file-paths area
a970: 70 61 74 68 20 74 6f 70 70 61 74 68 20 74 61 72 path toppath tar
a980: 67 65 74 20 6d 74 63 6f 6e 66 69 67 29 0a 20 20 get mtconfig).
a990: 28 6c 65 74 2a 20 28 28 75 73 65 2d 63 61 63 68 (let* ((use-cach
a9a0: 65 20 28 63 6f 6d 6d 6f 6e 3a 75 73 65 2d 63 61 e (common:use-ca
a9b0: 63 68 65 3f 29 29 0a 20 20 20 20 20 20 20 20 20 che?)).
a9c0: 28 72 75 6e 6e 61 6d 65 20 20 28 63 6f 6d 6d 6f (runname (commo
a9d0: 6e 3a 61 72 67 73 2d 67 65 74 2d 72 75 6e 6e 61 n:args-get-runna
a9e0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c me)). (l
a9f0: 69 6e 6b 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a inktree (common:
aa00: 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 0a 20 get-linktree)).
aa10: 20 20 20 20 20 20 20 20 28 74 65 73 74 6e 61 6d (testnam
aa20: 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 66 75 e (common:get-fu
aa30: 6c 6c 2d 74 65 73 74 2d 6e 61 6d 65 29 29 0a 20 ll-test-name)).
aa40: 20 20 20 20 20 20 20 20 28 72 75 6e 64 69 72 20 (rundir
aa50: 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e 6e 61 (if (and runna
aa60: 6d 65 20 74 61 72 67 65 74 20 6c 69 6e 6b 74 72 me target linktr
aa70: 65 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ee).
aa80: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
aa90: 6f 6e 3a 64 69 72 65 63 74 6f 72 79 2d 77 72 69 on:directory-wri
aaa0: 74 61 62 6c 65 3f 20 28 63 6f 6e 63 20 6c 69 6e table? (conc lin
aab0: 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 65 74 ktree "/" target
aac0: 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 20 "/" runname)).
aad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aae0: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 #f)).
aaf0: 20 20 20 20 28 74 65 73 74 64 69 72 20 20 28 69 (testdir (i
ab00: 66 20 28 61 6e 64 20 72 75 6e 64 69 72 20 74 65 f (and rundir te
ab10: 73 74 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 stname).
ab20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ab30: 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 6f 72 79 common:directory
ab40: 2d 77 72 69 74 61 62 6c 65 3f 20 28 63 6f 6e 63 -writable? (conc
ab50: 20 72 75 6e 64 69 72 20 22 2f 22 20 74 65 73 74 rundir "/" test
ab60: 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 name)).
ab70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
ab80: 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 61 63 )). (cac
ab90: 68 65 64 69 72 20 28 6f 72 20 74 65 73 74 64 69 hedir (or testdi
aba0: 72 20 72 75 6e 64 69 72 29 29 0a 20 20 20 20 20 r rundir)).
abb0: 20 20 20 20 28 6d 74 63 61 63 68 65 66 20 28 61 (mtcachef (a
abc0: 6e 64 20 63 61 63 68 65 64 69 72 20 28 63 6f 6e nd cachedir (con
abd0: 63 20 63 61 63 68 65 64 69 72 20 22 2f 22 20 22 c cachedir "/" "
abe0: 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2d 22 20 .megatest.cfg-"
abf0: 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f megatest-versio
ac00: 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 n "-" megatest-f
ac10: 6f 73 73 69 6c 2d 68 61 73 68 29 29 29 0a 20 20 ossil-hash))).
ac20: 20 20 20 20 20 20 20 28 72 63 63 61 63 68 65 66 (rccachef
ac30: 20 28 61 6e 64 20 63 61 63 68 65 64 69 72 20 28 (and cachedir (
ac40: 63 6f 6e 63 20 63 61 63 68 65 64 69 72 20 22 2f conc cachedir "/
ac50: 22 20 22 2e 72 75 6e 63 6f 6e 66 69 67 73 2e 63 " ".runconfigs.c
ac60: 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 2d 76 fg-" megatest-v
ac70: 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 ersion "-" megat
ac80: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 est-fossil-hash)
ac90: 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 ))). (debug:p
aca0: 72 69 6e 74 2d 69 6e 66 6f 20 36 20 2a 64 65 66 rint-info 6 *def
acb0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 0a ault-log-port* .
acc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
acd0: 20 20 20 20 20 20 22 72 75 6e 6e 61 6d 65 3d 22 "runname="
ace0: 20 72 75 6e 6e 61 6d 65 20 0a 20 20 20 20 20 20 runname .
acf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad00: 22 5c 6e 20 20 6c 69 6e 6b 74 72 65 65 3d 22 20 "\n linktree="
ad10: 6c 69 6e 6b 74 72 65 65 0a 20 20 20 20 20 20 20 linktree.
ad20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
ad30: 5c 6e 20 20 74 65 73 74 6e 61 6d 65 3d 22 20 74 \n testname=" t
ad40: 65 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 estname.
ad50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 5c "\
ad60: 6e 20 20 72 75 6e 64 69 72 3d 22 20 72 75 6e 64 n rundir=" rund
ad70: 69 72 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 ir .
ad80: 20 20 20 20 20 20 20 20 20 20 22 5c 6e 20 20 74 "\n t
ad90: 65 73 74 64 69 72 3d 22 20 74 65 73 74 64 69 72 estdir=" testdir
ada0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
adb0: 20 20 20 20 20 20 20 20 22 5c 6e 20 20 63 61 63 "\n cac
adc0: 68 65 64 69 72 3d 22 20 63 61 63 68 65 64 69 72 hedir=" cachedir
add0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ade0: 20 20 20 20 20 20 20 22 5c 6e 20 20 6d 74 63 61 "\n mtca
adf0: 63 68 65 66 3d 22 20 6d 74 63 61 63 68 65 66 0a chef=" mtcachef.
ae00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ae10: 20 20 20 20 20 20 22 5c 6e 20 20 72 63 63 61 63 "\n rccac
ae20: 68 65 66 3d 22 20 72 63 63 61 63 68 65 66 29 0a hef=" rccachef).
ae30: 20 20 20 20 28 63 6f 6e 73 20 6d 74 63 61 63 68 (cons mtcach
ae40: 65 66 20 72 63 63 61 63 68 65 66 29 29 29 0a 0a ef rccachef)))..
ae50: 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a (define (launch:
ae60: 73 65 74 75 70 2d 62 6f 64 79 20 23 21 6b 65 79 setup-body #!key
ae70: 20 28 66 6f 72 63 65 2d 72 65 72 65 61 64 20 23 (force-reread #
ae80: 66 29 20 28 61 72 65 61 70 61 74 68 20 23 66 29 f) (areapath #f)
ae90: 29 0a 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 ). (if (and (eq
aea0: 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a ? *configstatus*
aeb0: 20 27 66 75 6c 6c 64 61 74 61 29 0a 09 20 20 20 'fulldata)..
aec0: 2a 74 6f 70 70 61 74 68 2a 0a 09 20 20 20 28 6e *toppath*.. (n
aed0: 6f 74 20 66 6f 72 63 65 2d 72 65 72 65 61 64 29 ot force-reread)
aee0: 29 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 ) ;; no need to
aef0: 72 65 70 72 6f 63 65 73 73 0a 20 20 20 20 20 20 reprocess.
af00: 2a 74 6f 70 70 61 74 68 2a 20 20 20 3b 3b 20 72 *toppath* ;; r
af10: 65 74 75 72 6e 20 74 6f 70 70 61 74 68 0a 20 20 eturn toppath.
af20: 20 20 20 20 28 6c 65 74 2a 20 28 28 75 73 65 2d (let* ((use-
af30: 63 61 63 68 65 20 28 63 6f 6d 6d 6f 6e 3a 75 73 cache (common:us
af40: 65 2d 63 61 63 68 65 3f 29 29 20 3b 3b 20 42 42 e-cache?)) ;; BB
af50: 2d 20 75 73 65 2d 63 61 63 68 65 20 63 68 65 63 - use-cache chec
af60: 6b 73 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 66 ks *configdat* f
af70: 6f 72 20 75 73 65 2d 63 61 63 68 65 20 73 65 74 or use-cache set
af80: 74 69 6e 67 2e 20 20 57 65 20 64 6f 20 6e 6f 74 ting. We do not
af90: 20 68 61 76 65 20 2a 63 6f 6e 66 69 67 64 61 74 have *configdat
afa0: 2a 2e 20 20 42 6f 6f 74 73 74 72 61 70 70 69 6e *. Bootstrappin
afb0: 67 20 70 72 6f 62 6c 65 6d 20 68 65 72 65 2e 0a g problem here..
afc0: 09 20 20 20 20 20 28 74 6f 70 70 61 74 68 20 20 . (toppath
afd0: 28 6f 72 20 2a 74 6f 70 70 61 74 68 2a 20 61 72 (or *toppath* ar
afe0: 65 61 70 61 74 68 20 28 67 65 74 65 6e 76 20 22 eapath (getenv "
aff0: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
b000: 22 29 29 29 20 3b 3b 20 70 72 65 73 65 72 76 65 "))) ;; preserve
b010: 20 74 6f 70 70 61 74 68 0a 09 20 20 20 20 20 28 toppath.. (
b020: 74 61 72 67 65 74 20 20 20 28 63 6f 6d 6d 6f 6e target (common
b030: 3a 61 72 67 73 2d 67 65 74 2d 74 61 72 67 65 74 :args-get-target
b040: 29 29 0a 09 20 20 20 20 20 28 73 65 63 74 69 6f )).. (sectio
b050: 6e 73 20 28 69 66 20 74 61 72 67 65 74 20 28 6c ns (if target (l
b060: 69 73 74 20 22 64 65 66 61 75 6c 74 22 20 74 61 ist "default" ta
b070: 72 67 65 74 29 20 23 66 29 29 20 3b 3b 20 66 6f rget) #f)) ;; fo
b080: 72 20 72 75 6e 63 6f 6e 66 69 67 73 0a 09 20 20 r runconfigs..
b090: 20 20 20 28 6d 74 63 6f 6e 66 69 67 20 28 6f 72 (mtconfig (or
b0a0: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
b0b0: 2d 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 74 -config") "megat
b0c0: 65 73 74 2e 63 6f 6e 66 69 67 22 29 29 20 3b 3b est.config")) ;;
b0d0: 20 61 6c 6c 6f 77 20 6f 76 65 72 72 69 64 69 6e allow overridin
b0e0: 67 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 g megatest.confi
b0f0: 67 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 g .
b100: 28 63 61 63 68 65 66 69 6c 65 73 20 28 6c 61 75 (cachefiles (lau
b110: 6e 63 68 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 nch:get-cache-fi
b120: 6c 65 2d 70 61 74 68 73 20 61 72 65 61 70 61 74 le-paths areapat
b130: 68 20 74 6f 70 70 61 74 68 20 74 61 72 67 65 74 h toppath target
b140: 20 6d 74 63 6f 6e 66 69 67 29 29 0a 09 20 20 20 mtconfig))..
b150: 20 20 3b 3b 20 63 68 65 63 6b 69 6e 67 20 66 6f ;; checking fo
b160: 72 20 6e 75 6c 6c 20 63 61 63 68 65 66 69 6c 65 r null cachefile
b170: 73 20 73 68 6f 75 6c 64 20 6e 6f 74 20 62 65 20 s should not be
b180: 6e 65 63 65 73 73 61 72 79 2c 20 49 20 77 61 73 necessary, I was
b190: 20 73 65 65 69 6e 67 20 65 72 72 6f 72 20 63 61 seeing error ca
b1a0: 72 20 6f 66 20 27 28 29 2c 20 6d 69 67 68 74 20 r of '(), might
b1b0: 62 65 20 61 20 63 68 69 63 6b 65 6e 20 62 75 67 be a chicken bug
b1c0: 20 6f 72 20 61 20 72 65 64 20 68 65 72 72 69 6e or a red herrin
b1d0: 67 20 2e 2e 2e 0a 09 20 20 20 20 20 28 6d 74 63 g ..... (mtc
b1e0: 61 63 68 65 66 20 20 20 28 69 66 20 28 6e 75 6c achef (if (nul
b1f0: 6c 3f 20 63 61 63 68 65 66 69 6c 65 73 29 0a 09 l? cachefiles)..
b200: 09 09 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 .. #f....
b210: 20 20 28 63 61 72 20 63 61 63 68 65 66 69 6c 65 (car cachefile
b220: 73 29 29 29 20 3b 3b 20 28 61 6e 64 20 63 61 63 s))) ;; (and cac
b230: 68 65 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 hedir (conc cach
b240: 65 64 69 72 20 22 2f 22 20 22 2e 6d 65 67 61 74 edir "/" ".megat
b250: 65 73 74 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 est.cfg-" megat
b260: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 est-version "-"
b270: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
b280: 68 61 73 68 29 29 29 0a 09 20 20 20 20 20 28 72 hash))).. (r
b290: 63 63 61 63 68 65 66 20 20 20 28 69 66 20 28 6e ccachef (if (n
b2a0: 75 6c 6c 3f 20 63 61 63 68 65 66 69 6c 65 73 29 ull? cachefiles)
b2b0: 0a 09 09 09 20 20 20 20 20 23 66 0a 09 09 09 20 .... #f....
b2c0: 20 20 20 20 28 63 64 72 20 63 61 63 68 65 66 69 (cdr cachefi
b2d0: 6c 65 73 29 29 29 29 20 3b 3b 20 28 61 6e 64 20 les)))) ;; (and
b2e0: 63 61 63 68 65 64 69 72 20 28 63 6f 6e 63 20 63 cachedir (conc c
b2f0: 61 63 68 65 64 69 72 20 22 2f 22 20 22 2e 72 75 achedir "/" ".ru
b300: 6e 63 6f 6e 66 69 67 73 2e 63 66 67 2d 22 20 20 nconfigs.cfg-"
b310: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
b320: 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f "-" megatest-fo
b330: 73 73 69 6c 2d 68 61 73 68 29 29 29 0a 09 20 20 ssil-hash)))..
b340: 20 20 20 20 3b 3b 20 28 63 61 6e 63 72 65 61 74 ;; (cancreat
b350: 65 20 28 61 6e 64 20 63 61 63 68 65 64 69 72 20 e (and cachedir
b360: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
b370: 73 74 73 3f 20 63 61 63 68 65 64 69 72 29 28 66 sts? cachedir)(f
b380: 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 ile-write-access
b390: 3f 20 63 61 63 68 65 64 69 72 29 20 28 6e 6f 74 ? cachedir) (not
b3a0: 20 28 63 6f 6d 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e (common:in-runn
b3b0: 69 6e 67 2d 74 65 73 74 3f 29 29 29 29 29 0a 09 ing-test?)))))..
b3c0: 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 (set! *toppath*
b3d0: 74 6f 70 70 61 74 68 29 20 3b 3b 20 54 68 69 73 toppath) ;; This
b3e0: 20 69 73 20 6e 65 65 64 65 64 20 77 68 65 6e 20 is needed when
b3f0: 77 65 20 61 72 65 20 72 75 6e 6e 69 6e 67 20 61 we are running a
b400: 73 20 61 20 74 65 73 74 20 75 73 69 6e 67 20 43 s a test using C
b410: 4d 44 49 4e 46 4f 20 61 73 20 61 20 64 61 74 61 MDINFO as a data
b420: 73 6f 75 72 63 65 0a 20 20 20 20 20 20 20 20 3b source. ;
b430: 3b 28 42 42 3e 20 22 6c 61 75 6e 63 68 3a 73 65 ;(BB> "launch:se
b440: 74 75 70 2d 62 6f 64 79 20 2d 2d 20 63 61 63 68 tup-body -- cach
b450: 65 66 69 6c 65 73 3d 22 63 61 63 68 65 66 69 6c efiles="cachefil
b460: 65 73 29 0a 09 28 63 6f 6e 64 0a 09 20 3b 3b 20 es)..(cond.. ;;
b470: 69 66 20 6d 74 63 61 63 68 65 66 20 65 78 69 73 if mtcachef exis
b480: 74 73 20 6a 75 73 74 20 72 65 61 64 20 69 74 2c ts just read it,
b490: 20 68 6f 77 65 76 65 72 20 77 65 20 6e 65 65 64 however we need
b4a0: 20 74 6f 20 61 73 73 75 6d 65 20 74 6f 70 70 61 to assume toppa
b4b0: 74 68 20 69 73 20 61 76 61 69 6c 61 62 6c 65 20 th is available
b4c0: 69 6e 20 24 4d 54 5f 52 55 4e 5f 41 52 45 41 5f in $MT_RUN_AREA_
b4d0: 48 4f 4d 45 0a 09 20 28 28 61 6e 64 20 28 6e 6f HOME.. ((and (no
b4e0: 74 20 66 6f 72 63 65 2d 72 65 72 65 61 64 29 0a t force-reread).
b4f0: 09 20 20 20 20 20 20 20 6d 74 63 61 63 68 65 66 . mtcachef
b500: 20 20 72 63 63 61 63 68 65 66 0a 09 20 20 20 20 rccachef..
b510: 20 20 20 75 73 65 2d 63 61 63 68 65 0a 09 20 20 use-cache..
b520: 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f (get-enviro
b530: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
b540: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
b550: 22 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d ").. (comm
b560: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
b570: 6d 74 63 61 63 68 65 66 29 0a 09 20 20 20 20 20 mtcachef)..
b580: 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 (common:file-e
b590: 78 69 73 74 73 3f 20 72 63 63 61 63 68 65 66 29 xists? rccachef)
b5a0: 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 ). ;;(B
b5b0: 42 3e 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 B> "launch:setup
b5c0: 2d 62 6f 64 79 20 2d 2d 20 63 6f 6e 64 20 62 72 -body -- cond br
b5d0: 61 6e 63 68 20 31 20 2d 20 75 73 65 2d 63 61 63 anch 1 - use-cac
b5e0: 68 65 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 he"). (
b5f0: 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a set! *configdat*
b600: 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 (configf:rea
b610: 64 2d 61 6c 69 73 74 20 6d 74 63 61 63 68 65 66 d-alist mtcachef
b620: 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 )). ;;(
b630: 42 42 3e 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 BB> "launch:setu
b640: 70 2d 62 6f 64 79 20 2d 2d 20 31 20 73 65 74 21 p-body -- 1 set!
b650: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 3d 22 2a 63 *configdat*="*c
b660: 6f 6e 66 69 67 64 61 74 2a 29 0a 09 20 20 28 73 onfigdat*).. (s
b670: 65 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 et! *runconfigda
b680: 74 2a 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 t* (configf:read
b690: 2d 61 6c 69 73 74 20 72 63 63 61 63 68 65 66 29 -alist rccachef)
b6a0: 29 0a 09 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 ).. (set! *conf
b6b0: 69 67 69 6e 66 6f 2a 20 20 20 28 6c 69 73 74 20 iginfo* (list
b6c0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 28 67 65 *configdat* (ge
b6d0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
b6e0: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
b6f0: 52 45 41 5f 48 4f 4d 45 22 29 29 29 0a 09 20 20 REA_HOME")))..
b700: 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 (set! *configsta
b710: 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a tus* 'fulldata).
b720: 09 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 . (set! *toppat
b730: 68 2a 20 20 20 20 20 20 28 67 65 74 2d 65 6e 76 h* (get-env
b740: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
b750: 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 e "MT_RUN_AREA_H
b760: 4f 4d 45 22 29 29 0a 09 20 20 2a 74 6f 70 70 61 OME")).. *toppa
b770: 74 68 2a 29 0a 09 20 3b 3b 20 74 68 65 72 65 20 th*).. ;; there
b780: 61 72 65 20 6e 6f 20 65 78 69 73 74 69 6e 67 20 are no existing
b790: 63 61 63 68 65 64 20 63 6f 6e 66 69 67 73 2c 20 cached configs,
b7a0: 64 6f 20 66 75 6c 6c 20 72 65 61 64 73 20 6f 66 do full reads of
b7b0: 20 74 68 65 20 63 6f 6e 66 69 67 73 20 61 6e 64 the configs and
b7c0: 20 63 61 63 68 65 20 74 68 65 6d 0a 09 20 3b 3b cache them.. ;;
b7d0: 20 77 65 20 68 61 76 65 20 61 6c 6c 20 74 68 65 we have all the
b7e0: 20 69 6e 66 6f 20 6e 65 65 64 65 64 20 74 6f 20 info needed to
b7f0: 66 75 6c 6c 79 20 70 72 6f 63 65 73 73 20 72 75 fully process ru
b800: 6e 63 6f 6e 66 69 67 73 20 61 6e 64 20 6d 65 67 nconfigs and meg
b810: 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 20 28 atest.config.. (
b820: 28 61 6e 64 20 3b 3b 20 28 6e 6f 74 20 66 6f 72 (and ;; (not for
b830: 63 65 2d 72 65 72 65 61 64 29 20 3b 3b 20 66 6f ce-reread) ;; fo
b840: 72 63 65 2d 72 65 72 65 61 64 20 69 73 20 69 72 rce-reread is ir
b850: 72 65 6c 65 76 61 6e 74 20 69 6e 20 74 68 65 20 relevant in the
b860: 41 4e 44 2c 20 63 6f 75 6c 64 20 68 6f 77 65 76 AND, could howev
b870: 65 72 20 4f 52 20 69 74 3f 0a 09 20 20 20 20 20 er OR it?..
b880: 20 20 6d 74 63 61 63 68 65 66 0a 09 20 20 20 20 mtcachef..
b890: 20 20 20 72 63 63 61 63 68 65 66 29 20 3b 3b 20 rccachef) ;;
b8a0: 42 42 2d 20 77 68 79 20 61 72 65 20 77 65 20 64 BB- why are we d
b8b0: 6f 69 6e 67 20 74 68 69 73 20 77 69 74 68 6f 75 oing this withou
b8c0: 74 20 61 73 6b 69 6e 67 20 69 66 20 63 61 63 68 t asking if cach
b8d0: 69 6e 67 20 69 73 20 64 65 73 69 72 65 64 3f 0a ing is desired?.
b8e0: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e ;;(BB>
b8f0: 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 "launch:setup-b
b900: 6f 64 79 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e ody -- cond bran
b910: 63 68 20 32 22 29 0a 09 20 20 28 6c 65 74 2a 20 ch 2").. (let*
b920: 28 28 66 69 72 73 74 2d 70 61 73 73 20 20 20 20 ((first-pass
b930: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c
b940: 6f 6e 66 69 67 20 20 20 20 20 20 20 20 3b 3b 20 onfig ;;
b950: 4e 42 2f 2f 20 73 65 74 73 20 4d 54 5f 52 55 4e NB// sets MT_RUN
b960: 5f 41 52 45 41 5f 48 4f 4d 45 20 61 73 20 73 69 _AREA_HOME as si
b970: 64 65 20 65 66 66 65 63 74 0a 09 09 09 09 20 6d de effect..... m
b980: 74 63 6f 6e 66 69 67 0a 09 09 09 09 20 65 6e 76 tconfig..... env
b990: 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d iron-patt: "env-
b9a0: 6f 76 65 72 72 69 64 65 22 0a 09 09 09 09 20 67 override"..... g
b9b0: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 74 6f iven-toppath: to
b9c0: 70 70 61 74 68 0a 09 09 09 09 20 70 61 74 68 65 ppath..... pathe
b9d0: 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 nvvar: "MT_RUN_A
b9e0: 52 45 41 5f 48 4f 4d 45 22 29 29 0a 09 09 20 28 REA_HOME"))... (
b9f0: 66 69 72 73 74 2d 72 75 6e 64 61 74 20 20 28 6c first-rundat (l
ba00: 65 74 20 28 28 74 6f 70 70 61 74 68 20 28 69 66 et ((toppath (if
ba10: 20 74 6f 70 70 61 74 68 20 0a 09 09 09 09 09 09 toppath .......
ba20: 20 20 20 74 6f 70 70 61 74 68 0a 09 09 09 09 09 toppath......
ba30: 09 20 20 20 28 63 61 72 20 66 69 72 73 74 2d 70 . (car first-p
ba40: 61 73 73 29 29 29 29 0a 09 09 09 09 20 20 28 72 ass))))..... (r
ba50: 65 61 64 2d 63 6f 6e 66 69 67 20 3b 3b 20 28 63 ead-config ;; (c
ba60: 6f 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 onc toppath "/ru
ba70: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
ba80: 29 20 3b 3b 20 74 68 69 73 20 73 68 6f 75 6c 64 ) ;; this should
ba90: 20 62 65 20 63 6f 6e 76 65 72 74 65 64 20 74 6f be converted to
baa0: 20 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 runconfig:read
bab0: 62 75 74 20 69 74 20 69 73 20 6e 6f 6e 2d 74 72 but it is non-tr
bac0: 69 76 69 61 6c 2c 20 6c 65 61 76 69 6e 67 20 69 ivial, leaving i
bad0: 74 20 66 6f 72 20 6e 6f 77 2e 0a 09 09 09 09 20 t for now......
bae0: 20 20 28 63 6f 6e 63 20 28 69 66 20 28 73 74 72 (conc (if (str
baf0: 69 6e 67 3f 20 74 6f 70 70 61 74 68 29 0a 09 09 ing? toppath)...
bb00: 09 09 09 20 20 20 20 20 74 6f 70 70 61 74 68 0a ... toppath.
bb10: 09 09 09 09 09 20 20 20 20 20 28 67 65 74 2d 65 ..... (get-e
bb20: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
bb30: 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ble "MT_RUN_AREA
bb40: 5f 48 4f 4d 45 22 29 29 0a 09 09 09 09 09 20 22 _HOME"))...... "
bb50: 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 /runconfigs.conf
bb60: 69 67 22 29 0a 09 09 09 09 20 20 20 2a 72 75 6e ig")..... *run
bb70: 63 6f 6e 66 69 67 64 61 74 2a 20 23 74 20 0a 09 configdat* #t ..
bb80: 09 09 09 20 20 20 73 65 63 74 69 6f 6e 73 3a 20 ... sections:
bb90: 73 65 63 74 69 6f 6e 73 29 29 29 29 0a 09 20 20 sections))))..
bba0: 20 20 28 73 65 74 21 20 2a 72 75 6e 63 6f 6e 66 (set! *runconf
bbb0: 69 67 64 61 74 2a 20 66 69 72 73 74 2d 72 75 6e igdat* first-run
bbc0: 64 61 74 29 0a 09 20 20 20 20 28 69 66 20 66 69 dat).. (if fi
bbd0: 72 73 74 2d 70 61 73 73 20 20 3b 3b 20 0a 09 09 rst-pass ;; ...
bbe0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
bbf0: 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 ;;(BB>
bc00: 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f "launch:setup-bo
bc10: 64 79 20 2d 2d 20 5c 22 66 69 72 73 74 2d 70 61 dy -- \"first-pa
bc20: 73 73 5c 22 3d 66 69 72 73 74 2d 70 61 73 73 22 ss\"=first-pass"
bc30: 29 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f 6e )... (set! *con
bc40: 66 69 67 64 61 74 2a 20 20 28 63 61 72 20 66 69 figdat* (car fi
bc50: 72 73 74 2d 70 61 73 73 29 29 0a 20 20 20 20 20 rst-pass)).
bc60: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 ;;(
bc70: 42 42 3e 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 BB> "launch:setu
bc80: 70 2d 62 6f 64 79 20 2d 2d 20 32 20 73 65 74 21 p-body -- 2 set!
bc90: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 3d 22 2a 63 *configdat*="*c
bca0: 6f 6e 66 69 67 64 61 74 2a 29 0a 09 09 20 20 28 onfigdat*)... (
bcb0: 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f set! *configinfo
bcc0: 2a 20 66 69 72 73 74 2d 70 61 73 73 29 0a 09 09 * first-pass)...
bcd0: 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 (set! *toppath
bce0: 2a 20 20 20 20 28 6f 72 20 74 6f 70 70 61 74 68 * (or toppath
bcf0: 20 28 63 61 64 72 20 66 69 72 73 74 2d 70 61 73 (cadr first-pas
bd00: 73 29 29 29 20 3b 3b 20 75 73 65 20 74 68 65 20 s))) ;; use the
bd10: 67 61 74 68 65 72 65 64 20 64 61 74 61 20 75 6e gathered data un
bd20: 6c 65 73 73 20 61 6c 72 65 61 64 79 20 68 61 76 less already hav
bd30: 65 20 69 74 0a 09 09 20 20 28 73 65 74 21 20 74 e it... (set! t
bd40: 6f 70 70 61 74 68 20 20 20 20 20 20 2a 74 6f 70 oppath *top
bd50: 70 61 74 68 2a 29 0a 09 09 20 20 28 69 66 20 28 path*)... (if (
bd60: 6e 6f 74 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 not *toppath*)..
bd70: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
bd80: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 .(debug:print-er
bd90: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
bda0: 6f 67 2d 70 6f 72 74 2a 20 22 79 6f 75 20 61 72 og-port* "you ar
bdb0: 65 20 6e 6f 74 20 69 6e 20 61 20 6d 65 67 61 74 e not in a megat
bdc0: 65 73 74 20 61 72 65 61 21 22 29 0a 09 09 09 28 est area!")....(
bdd0: 65 78 69 74 20 31 29 29 29 0a 09 09 20 20 28 73 exit 1)))... (s
bde0: 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 etenv "MT_RUN_AR
bdf0: 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 EA_HOME" *toppat
be00: 68 2a 29 0a 09 09 20 20 3b 3b 20 74 68 65 20 73 h*)... ;; the s
be10: 65 65 64 20 72 65 61 64 20 69 73 20 64 6f 6e 65 eed read is done
be20: 2c 20 6e 6f 77 20 72 65 61 64 20 72 75 6e 63 6f , now read runco
be30: 6e 66 69 67 73 2c 20 63 61 63 68 65 20 69 74 20 nfigs, cache it
be40: 74 68 65 6e 20 72 65 61 64 20 6d 65 67 61 74 65 then read megate
be50: 73 74 2e 63 6f 6e 66 69 67 20 6f 6e 65 20 6d 6f st.config one mo
be60: 72 65 20 74 69 6d 65 20 61 6e 64 20 63 61 63 68 re time and cach
be70: 65 20 69 74 0a 09 09 20 20 28 6c 65 74 2a 20 28 e it... (let* (
be80: 28 6b 65 79 73 20 20 20 20 20 20 20 20 20 28 72 (keys (r
be90: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 29 0a 09 09 mt:get-keys))...
bea0: 09 20 28 6b 65 79 2d 76 61 6c 73 20 20 20 20 20 . (key-vals
beb0: 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 (keys:target->ke
bec0: 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 yval keys target
bed0: 29 29 0a 09 09 09 20 28 6c 69 6e 6b 74 72 65 65 )).... (linktree
bee0: 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
bef0: 2d 6c 69 6e 6b 74 72 65 65 29 29 20 3b 3b 20 28 -linktree)) ;; (
bf00: 6f 72 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 4c or (getenv "MT_L
bf10: 49 4e 4b 54 52 45 45 22 29 28 69 66 20 2a 63 6f INKTREE")(if *co
bf20: 6e 66 69 67 64 61 74 2a 20 28 63 6f 6e 66 69 67 nfigdat* (config
bf30: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
bf40: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
bf50: 6e 6b 74 72 65 65 22 29 20 23 66 29 29 29 0a 09 nktree") #f)))..
bf60: 09 09 09 09 3b 20 20 20 20 20 28 69 66 20 2a 63 ....; (if *c
bf70: 6f 6e 66 69 67 64 61 74 2a 0a 09 09 09 09 09 3b onfigdat*......;
bf80: 20 09 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f . (configf:lo
bf90: 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
bfa0: 20 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 "setup" "linktr
bfb0: 65 65 22 29 0a 09 09 09 09 09 3b 20 09 20 20 20 ee")......; .
bfc0: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
bfd0: 22 2f 6c 74 22 29 29 29 29 0a 09 09 09 20 28 73 "/lt")))).... (s
bfe0: 65 63 6f 6e 64 2d 70 61 73 73 20 20 28 66 69 6e econd-pass (fin
bff0: 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 d-and-read-confi
c000: 67 0a 09 09 09 09 09 6d 74 63 6f 6e 66 69 67 0a g......mtconfig.
c010: 09 09 09 09 09 65 6e 76 69 72 6f 6e 2d 70 61 74 .....environ-pat
c020: 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t: "env-override
c030: 22 0a 09 09 09 09 09 67 69 76 65 6e 2d 74 6f 70 "......given-top
c040: 70 61 74 68 3a 20 74 6f 70 70 61 74 68 0a 09 09 path: toppath...
c050: 09 09 09 70 61 74 68 65 6e 76 76 61 72 3a 20 22 ...pathenvvar: "
c060: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
c070: 22 29 29 0a 09 09 09 20 28 72 75 6e 63 6f 6e 66 ")).... (runconf
c080: 69 67 64 61 74 20 28 62 65 67 69 6e 20 20 20 20 igdat (begin
c090: 20 3b 3b 20 74 68 69 73 20 72 65 61 64 20 6f 66 ;; this read of
c0a0: 20 74 68 65 20 72 75 6e 63 6f 6e 66 69 67 73 20 the runconfigs
c0b0: 77 69 6c 6c 20 73 65 65 20 61 6e 79 20 61 64 6a will see any adj
c0c0: 75 73 74 6d 65 6e 74 73 20 6d 61 64 65 20 62 79 ustments made by
c0d0: 20 72 65 2d 72 65 61 64 69 6e 67 20 6d 65 67 61 re-reading mega
c0e0: 74 65 73 74 2e 63 6f 6e 66 69 67 0a 09 09 09 09 test.config.....
c0f0: 09 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d . (for-each (lam
c100: 62 64 61 20 28 6b 74 29 0a 09 09 09 09 09 09 20 bda (kt).......
c110: 20 20 20 20 28 73 65 74 65 6e 76 20 28 63 61 72 (setenv (car
c120: 20 6b 74 29 20 28 63 61 64 72 20 6b 74 29 29 29 kt) (cadr kt)))
c130: 0a 09 09 09 09 09 09 20 20 20 6b 65 79 2d 76 61 ....... key-va
c140: 6c 73 29 0a 09 09 09 09 09 20 28 72 65 61 64 2d ls)...... (read-
c150: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 config (conc top
c160: 70 61 74 68 20 22 2f 72 75 6e 63 6f 6e 66 69 67 path "/runconfig
c170: 73 2e 63 6f 6e 66 69 67 22 29 20 2a 72 75 6e 63 s.config") *runc
c180: 6f 6e 66 69 67 64 61 74 2a 20 23 74 20 3b 3b 20 onfigdat* #t ;;
c190: 63 6f 6e 73 69 64 65 72 20 75 73 69 6e 67 20 72 consider using r
c1a0: 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 73 6f unconfig:read so
c1b0: 6d 65 20 64 61 79 20 2e 2e 2e 0a 09 09 09 09 09 me day .........
c1c0: 09 20 20 20 20 20 20 73 65 63 74 69 6f 6e 73 3a . sections:
c1d0: 20 73 65 63 74 69 6f 6e 73 29 29 29 0a 20 20 20 sections))).
c1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c1f0: 20 20 20 20 20 20 28 63 61 63 68 65 66 69 6c 65 (cachefile
c200: 73 20 20 20 28 6c 61 75 6e 63 68 3a 67 65 74 2d s (launch:get-
c210: 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 74 68 73 cache-file-paths
c220: 20 61 72 65 61 70 61 74 68 20 74 6f 70 70 61 74 areapath toppat
c230: 68 20 74 61 72 67 65 74 20 6d 74 63 6f 6e 66 69 h target mtconfi
c240: 67 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 g)).
c250: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 74 (mt
c260: 63 61 63 68 65 66 20 20 20 20 20 28 63 61 72 20 cachef (car
c270: 63 61 63 68 65 66 69 6c 65 73 29 29 0a 20 20 20 cachefiles)).
c280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c290: 20 20 20 20 20 20 28 72 63 63 61 63 68 65 66 20 (rccachef
c2a0: 20 20 20 20 28 63 64 72 20 63 61 63 68 65 66 69 (cdr cachefi
c2b0: 6c 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 les))).
c2c0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 74 ;; t
c2d0: 72 61 70 20 65 78 63 65 70 74 69 6f 6e 20 64 75 rap exception du
c2e0: 65 20 74 6f 20 73 74 61 6c 65 20 4e 46 53 20 68 e to stale NFS h
c2f0: 61 6e 64 6c 65 20 2d 2d 20 45 72 72 6f 72 3a 20 andle -- Error:
c300: 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 66 69 6c (open-output-fil
c310: 65 29 20 63 61 6e 6e 6f 74 20 6f 70 65 6e 20 66 e) cannot open f
c320: 69 6c 65 20 2d 20 53 74 61 6c 65 20 4e 46 53 20 ile - Stale NFS
c330: 66 69 6c 65 20 68 61 6e 64 6c 65 3a 20 22 2f 70 file handle: "/p
c340: 2f 66 64 6b 2f 67 77 61 2f 6c 65 66 6b 6f 77 69 /fdk/gwa/lefkowi
c350: 74 2f 6d 74 54 65 73 74 69 6e 67 2f 71 61 2f 70 t/mtTesting/qa/p
c360: 72 69 6d 62 65 71 61 2f 6c 69 6e 6b 73 2f 70 31 rimbeqa/links/p1
c370: 32 32 32 2f 31 31 2f 50 44 4b 5f 72 31 2e 31 2e 222/11/PDK_r1.1.
c380: 31 2f 70 72 69 6d 2f 63 6c 65 61 6e 2f 70 63 65 1/prim/clean/pce
c390: 6c 6c 5f 74 65 73 74 67 65 6e 2f 2e 72 75 6e 63 ll_testgen/.runc
c3a0: 6f 6e 66 69 67 73 2e 63 66 67 2d 31 2e 36 34 32 onfigs.cfg-1.642
c3b0: 37 2d 37 64 31 65 37 38 39 63 62 33 66 36 32 66 7-7d1e789cb3f62f
c3c0: 39 63 64 65 37 31 39 61 34 38 36 35 62 62 35 31 9cde719a4865bb51
c3d0: 62 33 63 31 37 65 61 38 35 33 22 20 2d 20 74 69 b3c17ea853" - ti
c3e0: 63 6b 65 74 20 32 32 30 35 34 36 33 34 32 0a 20 cket 220546342.
c3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c400: 20 20 20 3b 3b 20 54 4f 44 4f 20 2d 20 63 6f 6e ;; TODO - con
c410: 73 69 64 65 72 20 31 29 20 75 73 69 6e 67 20 73 sider 1) using s
c420: 69 6d 70 6c 65 2d 6c 6f 63 6b 20 74 6f 20 62 72 imple-lock to br
c430: 61 63 6b 65 74 20 63 61 63 68 65 20 77 72 69 74 acket cache writ
c440: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
c450: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
c460: 20 20 20 20 20 20 20 20 20 32 29 20 63 61 63 68 2) cach
c470: 65 20 69 6e 20 68 61 73 68 20 6f 6e 20 73 65 72 e in hash on ser
c480: 76 65 72 2c 20 73 69 6e 63 65 20 6e 65 65 64 20 ver, since need
c490: 74 6f 20 64 6f 20 72 6d 74 3a 20 61 6e 79 77 61 to do rmt: anywa
c4a0: 79 20 74 6f 20 6c 6f 63 6b 2e 0a 0a 09 09 20 20 y to lock.....
c4b0: 20 20 28 69 66 20 72 63 63 61 63 68 65 66 0a 20 (if rccachef.
c4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4d0: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 (common:f
c4e0: 61 69 6c 2d 73 61 66 65 0a 20 20 20 20 20 20 20 ail-safe.
c4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c500: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
c510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c520: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 (configf
c530: 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 72 75 6e :write-alist run
c540: 63 6f 6e 66 69 67 64 61 74 20 72 63 63 61 63 68 configdat rccach
c550: 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ef)).
c560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
c570: 6f 6e 63 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 onc "Could not w
c580: 72 69 74 65 20 63 61 63 68 65 20 66 69 6c 65 20 rite cache file
c590: 2d 20 22 72 63 63 61 63 68 65 66 29 29 29 0a 20 - "rccachef))).
c5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c5b0: 20 20 20 28 69 66 20 6d 74 63 61 63 68 65 66 0a (if mtcachef.
c5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c5d0: 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
c5e0: 66 61 69 6c 2d 73 61 66 65 0a 20 20 20 20 20 20 fail-safe.
c5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c600: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
c610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c620: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
c630: 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 2a 63 f:write-alist *c
c640: 6f 6e 66 69 67 64 61 74 2a 20 6d 74 63 61 63 68 onfigdat* mtcach
c650: 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ef)).
c660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
c670: 6f 6e 63 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 onc "Could not w
c680: 72 69 74 65 20 63 61 63 68 65 20 66 69 6c 65 20 rite cache file
c690: 2d 20 22 6d 74 63 61 63 68 65 66 29 29 29 0a 09 - "mtcachef)))..
c6a0: 09 20 20 20 20 28 73 65 74 21 20 2a 72 75 6e 63 . (set! *runc
c6b0: 6f 6e 66 69 67 64 61 74 2a 20 72 75 6e 63 6f 6e onfigdat* runcon
c6c0: 66 69 67 64 61 74 29 0a 09 09 20 20 20 20 28 69 figdat)... (i
c6d0: 66 20 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 f (and rccachef
c6e0: 6d 74 63 61 63 68 65 66 29 20 28 73 65 74 21 20 mtcachef) (set!
c6f0: 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 *configstatus* '
c700: 66 75 6c 6c 64 61 74 61 29 29 29 29 0a 09 09 3b fulldata))))...;
c710: 3b 20 6e 6f 20 63 6f 6e 66 69 67 73 20 66 6f 75 ; no configs fou
c720: 6e 64 3f 20 73 68 6f 75 6c 64 20 6e 6f 74 20 68 nd? should not h
c730: 61 70 70 65 6e 20 62 75 74 20 6c 65 74 27 73 20 appen but let's
c740: 74 72 79 20 74 6f 20 72 65 63 6f 76 65 72 20 67 try to recover g
c750: 72 61 63 65 66 75 6c 6c 79 2c 20 72 65 74 75 72 racefully, retur
c760: 6e 20 61 6e 20 65 6d 70 74 79 20 68 61 73 68 2d n an empty hash-
c770: 74 61 62 6c 65 0a 09 09 28 73 65 74 21 20 2a 63 table...(set! *c
c780: 6f 6e 66 69 67 64 61 74 2a 20 28 6d 61 6b 65 2d onfigdat* (make-
c790: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 09 29 hash-table))...)
c7a0: 29 29 0a 0a 09 20 3b 3b 20 65 6c 73 65 20 72 65 ))... ;; else re
c7b0: 61 64 20 77 68 61 74 20 79 6f 75 20 63 61 6e 20 ad what you can
c7c0: 61 6e 64 20 73 65 74 20 74 68 65 20 66 6c 61 67 and set the flag
c7d0: 20 61 63 63 6f 72 64 69 6e 67 6c 79 0a 09 20 3b accordingly.. ;
c7e0: 3b 20 68 65 72 65 20 77 65 20 64 6f 6e 27 74 20 ; here we don't
c7f0: 68 61 76 65 20 65 69 74 68 65 72 20 6d 74 63 6f have either mtco
c800: 6e 66 69 67 20 6f 72 20 72 63 63 61 63 68 65 66 nfig or rccachef
c810: 0a 09 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 .. (else.
c820: 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 6e 63 ;;(BB> "launc
c830: 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d 2d 20 h:setup-body --
c840: 63 6f 6e 64 20 62 72 61 6e 63 68 20 33 20 2d 20 cond branch 3 -
c850: 65 6c 73 65 22 29 0a 09 20 20 28 6c 65 74 2a 20 else").. (let*
c860: 28 28 63 66 67 64 61 74 20 20 20 28 66 69 6e 64 ((cfgdat (find
c870: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
c880: 20 0a 09 09 09 20 20 20 20 28 6f 72 20 28 61 72 .... (or (ar
c890: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e gs:get-arg "-con
c8a0: 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e fig") "megatest.
c8b0: 63 6f 6e 66 69 67 22 29 0a 09 09 09 20 20 20 20 config")....
c8c0: 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 environ-patt: "e
c8d0: 6e 76 2d 6f 76 65 72 72 69 64 65 22 0a 09 09 09 nv-override"....
c8e0: 20 20 20 20 67 69 76 65 6e 2d 74 6f 70 70 61 74 given-toppat
c8f0: 68 3a 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d h: (get-environm
c900: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
c910: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
c920: 0a 09 09 09 20 20 20 20 70 61 74 68 65 6e 76 76 .... pathenvv
c930: 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ar: "MT_RUN_AREA
c940: 5f 48 4f 4d 45 22 29 29 29 0a 0a 20 20 20 20 20 _HOME")))..
c950: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
c960: 63 66 67 64 61 74 20 28 6c 69 73 74 3f 20 63 66 cfgdat (list? cf
c970: 67 64 61 74 29 20 28 3e 20 28 6c 65 6e 67 74 68 gdat) (> (length
c980: 20 63 66 67 64 61 74 29 20 30 29 20 28 68 61 73 cfgdat) 0) (has
c990: 68 2d 74 61 62 6c 65 3f 20 28 63 61 72 20 63 66 h-table? (car cf
c9a0: 67 64 61 74 29 29 29 0a 09 09 28 6c 65 74 2a 20 gdat)))...(let*
c9b0: 28 28 74 6f 70 70 61 74 68 20 20 28 6f 72 20 28 ((toppath (or (
c9c0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
c9d0: 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e variable "MT_RUN
c9e0: 5f 41 52 45 41 5f 48 4f 4d 45 22 29 28 63 61 64 _AREA_HOME")(cad
c9f0: 72 20 63 66 67 64 61 74 29 29 29 0a 09 09 20 20 r cfgdat)))...
ca00: 20 20 20 20 20 28 72 64 61 74 20 20 20 20 20 28 (rdat (
ca10: 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e read-config (con
ca20: 63 20 74 6f 70 70 61 74 68 20 20 3b 3b 20 63 6f c toppath ;; co
ca30: 6e 76 65 72 74 20 74 68 69 73 20 74 6f 20 75 73 nvert this to us
ca40: 65 20 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 64 e runconfig:read
ca50: 21 0a 09 09 09 09 09 09 20 20 20 20 22 2f 72 75 !....... "/ru
ca60: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
ca70: 29 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a ) *runconfigdat*
ca80: 20 23 74 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 #t sections: se
ca90: 63 74 69 6f 6e 73 29 29 29 0a 09 09 20 20 28 73 ctions)))... (s
caa0: 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a et! *configinfo*
cab0: 20 20 20 63 66 67 64 61 74 29 0a 09 09 20 20 28 cfgdat)... (
cac0: 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a set! *configdat*
cad0: 20 20 20 20 28 63 61 72 20 63 66 67 64 61 74 29 (car cfgdat)
cae0: 29 0a 09 09 20 20 28 73 65 74 21 20 2a 72 75 6e )... (set! *run
caf0: 63 6f 6e 66 69 67 64 61 74 2a 20 72 64 61 74 29 configdat* rdat)
cb00: 0a 09 09 20 20 28 73 65 74 21 20 2a 74 6f 70 70 ... (set! *topp
cb10: 61 74 68 2a 20 20 20 20 20 20 74 6f 70 70 61 74 ath* toppat
cb20: 68 29 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f h)... (set! *co
cb30: 6e 66 69 67 73 74 61 74 75 73 2a 20 27 70 61 72 nfigstatus* 'par
cb40: 74 69 61 6c 29 29 0a 09 09 28 62 65 67 69 6e 0a tial))...(begin.
cb50: 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
cb60: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
cb70: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 t-log-port* "No
cb80: 22 20 6d 74 63 6f 6e 66 69 67 20 22 20 66 69 6c " mtconfig " fil
cb90: 65 20 66 6f 75 6e 64 2e 20 47 69 76 69 6e 67 20 e found. Giving
cba0: 75 70 2e 22 29 0a 09 09 20 20 28 65 78 69 74 20 up.")... (exit
cbb0: 32 29 29 29 29 29 29 0a 09 3b 3b 20 43 4f 4e 44 2))))))..;; COND
cbc0: 20 65 6e 64 73 20 68 65 72 65 2e 0a 09 0a 09 3b ends here.....;
cbd0: 3b 20 61 64 64 69 74 69 6f 6e 61 6c 20 68 6f 75 ; additional hou
cbe0: 73 65 20 6b 65 65 70 69 6e 67 0a 09 28 6c 65 74 se keeping..(let
cbf0: 2a 20 28 28 6c 69 6e 6b 74 72 65 65 20 28 63 6f * ((linktree (co
cc00: 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 mmon:get-linktre
cc10: 65 29 29 29 0a 09 20 20 28 69 66 20 6c 69 6e 6b e))).. (if link
cc20: 74 72 65 65 0a 09 20 20 20 20 20 20 28 62 65 67 tree.. (beg
cc30: 69 6e 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 63 in...(if (not (c
cc40: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
cc50: 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 09 s? linktree))...
cc60: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 (begin...
cc70: 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 (handle-excep
cc80: 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 tions.... exn..
cc90: 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 .. (begin....
cca0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
ccb0: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
ccc0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 6f 6d 65 74 log-port* "Somet
ccd0: 68 69 6e 67 20 77 65 6e 74 20 77 72 6f 6e 67 20 hing went wrong
cce0: 77 68 65 6e 20 74 72 79 69 6e 67 20 74 6f 20 63 when trying to c
ccf0: 72 65 61 74 65 20 6c 69 6e 6b 74 72 65 65 20 64 reate linktree d
cd00: 69 72 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 ir at " linktree
cd10: 29 0a 09 09 09 20 20 20 20 28 64 65 62 75 67 3a ).... (debug:
cd20: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
cd30: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
cd40: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
cd50: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
cd60: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
cd70: 61 67 65 29 20 65 78 6e 29 29 0a 09 09 09 20 20 age) exn))....
cd80: 20 20 28 65 78 69 74 20 31 29 29 0a 09 09 09 28 (exit 1))....(
cd90: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
cda0: 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 29 29 29 linktree #t))))
cdb0: 0a 09 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 ...(handle-excep
cdc0: 74 69 6f 6e 73 0a 09 09 20 20 20 20 65 78 6e 0a tions... exn.
cdd0: 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 .. (begin...
cde0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
cdf0: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
ce00: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 6f lt-log-port* "So
ce10: 6d 65 74 68 69 6e 67 20 77 65 6e 74 20 77 72 6f mething went wro
ce20: 6e 67 20 77 68 65 6e 20 74 72 79 69 6e 67 20 74 ng when trying t
ce30: 6f 20 63 72 65 61 74 65 20 6c 69 6e 6b 20 74 6f o create link to
ce40: 20 6c 69 6e 6b 74 72 65 65 20 61 74 20 22 20 2a linktree at " *
ce50: 74 6f 70 70 61 74 68 2a 29 0a 09 09 20 20 20 20 toppath*)...
ce60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
ce70: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
ce80: 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 rt* " message: "
ce90: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
cea0: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
ceb0: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
cec0: 6e 29 29 29 0a 09 09 20 20 28 6c 65 74 20 28 28 n)))... (let ((
ced0: 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 2a 74 6f 70 tlink (conc *top
cee0: 70 61 74 68 2a 20 22 2f 6c 74 22 29 29 29 0a 09 path* "/lt")))..
cef0: 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 . (if (not (c
cf00: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
cf10: 73 3f 20 74 6c 69 6e 6b 29 29 0a 09 09 09 28 63 s? tlink))....(c
cf20: 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c reate-symbolic-l
cf30: 69 6e 6b 20 6c 69 6e 6b 74 72 65 65 20 74 6c 69 ink linktree tli
cf40: 6e 6b 29 29 29 29 29 0a 09 20 20 20 20 20 20 28 nk))))).. (
cf50: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
cf60: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
cf70: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
cf80: 22 6c 69 6e 6b 74 72 65 65 20 6e 6f 74 20 64 65 "linktree not de
cf90: 66 69 6e 65 64 20 69 6e 20 5b 73 65 74 75 70 5d fined in [setup]
cfa0: 20 73 65 63 74 69 6f 6e 20 6f 66 20 6d 65 67 61 section of mega
cfb0: 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 09 test.config")...
cfc0: 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 2a 74 )))..(if (and *t
cfd0: 6f 70 70 61 74 68 2a 0a 09 09 20 28 64 69 72 65 oppath*... (dire
cfe0: 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 2a 74 ctory-exists? *t
cff0: 6f 70 70 61 74 68 2a 29 29 0a 09 20 20 20 20 28 oppath*)).. (
d000: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 73 65 begin.. (se
d010: 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 tenv "MT_RUN_ARE
d020: 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 A_HOME" *toppath
d030: 2a 29 0a 09 20 20 20 20 20 20 28 73 65 74 65 6e *).. (seten
d040: 76 20 22 4d 54 5f 54 45 53 54 53 55 49 54 45 4e v "MT_TESTSUITEN
d050: 41 4d 45 22 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 AME" (common:get
d060: 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 -testsuite-name)
d070: 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 )).. (begin..
d080: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
d090: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
d0a0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
d0b0: 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 74 68 ailed to find th
d0c0: 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 79 6f e top path to yo
d0d0: 75 72 20 4d 65 67 61 74 65 73 74 20 61 72 65 61 ur Megatest area
d0e0: 2e 22 29 0a 09 20 20 20 20 20 20 28 73 65 74 21 .").. (set!
d0f0: 20 2a 74 6f 70 70 61 74 68 2a 20 23 66 29 20 3b *toppath* #f) ;
d100: 3b 20 66 6f 72 63 65 20 69 74 20 74 6f 20 62 65 ; force it to be
d110: 20 66 61 6c 73 65 20 73 6f 20 77 65 20 72 65 74 false so we ret
d120: 75 72 6e 20 23 66 0a 09 20 20 20 20 20 20 23 66 urn #f.. #f
d130: 29 29 0a 09 0a 20 20 20 20 20 20 20 20 3b 3b 20 ))... ;;
d140: 6f 6e 65 20 6d 6f 72 65 20 61 74 74 65 6d 70 74 one more attempt
d150: 20 74 6f 20 63 61 63 68 65 20 74 68 65 20 63 6f to cache the co
d160: 6e 66 69 67 73 20 66 6f 72 20 66 75 74 75 72 65 nfigs for future
d170: 20 72 65 61 64 69 6e 67 0a 20 20 20 20 20 20 20 reading.
d180: 20 28 6c 65 74 2a 20 28 28 63 61 63 68 65 66 69 (let* ((cachefi
d190: 6c 65 73 20 20 20 28 6c 61 75 6e 63 68 3a 67 65 les (launch:ge
d1a0: 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 74 t-cache-file-pat
d1b0: 68 73 20 61 72 65 61 70 61 74 68 20 74 6f 70 70 hs areapath topp
d1c0: 61 74 68 20 74 61 72 67 65 74 20 6d 74 63 6f 6e ath target mtcon
d1d0: 66 69 67 29 29 0a 20 20 20 20 20 20 20 20 20 20 fig)).
d1e0: 20 20 20 20 20 28 6d 74 63 61 63 68 65 66 20 20 (mtcachef
d1f0: 20 20 20 28 63 61 72 20 63 61 63 68 65 66 69 6c (car cachefil
d200: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
d210: 20 20 20 20 28 72 63 63 61 63 68 65 66 20 20 20 (rccachef
d220: 20 20 28 63 64 72 20 63 61 63 68 65 66 69 6c 65 (cdr cachefile
d230: 73 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 s)))..
d240: 3b 3b 20 74 72 61 70 20 65 78 63 65 70 74 69 6f ;; trap exceptio
d250: 6e 20 64 75 65 20 74 6f 20 73 74 61 6c 65 20 4e n due to stale N
d260: 46 53 20 68 61 6e 64 6c 65 20 2d 2d 20 45 72 72 FS handle -- Err
d270: 6f 72 3a 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 or: (open-output
d280: 2d 66 69 6c 65 29 20 63 61 6e 6e 6f 74 20 6f 70 -file) cannot op
d290: 65 6e 20 66 69 6c 65 20 2d 20 53 74 61 6c 65 20 en file - Stale
d2a0: 4e 46 53 20 66 69 6c 65 20 68 61 6e 64 6c 65 3a NFS file handle:
d2b0: 20 22 2f 70 2f 66 64 6b 2f 67 77 61 2f 6c 65 66 "/p/fdk/gwa/lef
d2c0: 6b 6f 77 69 74 2f 6d 74 54 65 73 74 69 6e 67 2f kowit/mtTesting/
d2d0: 71 61 2f 70 72 69 6d 62 65 71 61 2f 6c 69 6e 6b qa/primbeqa/link
d2e0: 73 2f 70 31 32 32 32 2f 31 31 2f 50 44 4b 5f 72 s/p1222/11/PDK_r
d2f0: 31 2e 31 2e 31 2f 70 72 69 6d 2f 63 6c 65 61 6e 1.1.1/prim/clean
d300: 2f 70 63 65 6c 6c 5f 74 65 73 74 67 65 6e 2f 2e /pcell_testgen/.
d310: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 66 67 2d 31 runconfigs.cfg-1
d320: 2e 36 34 32 37 2d 37 64 31 65 37 38 39 63 62 33 .6427-7d1e789cb3
d330: 66 36 32 66 39 63 64 65 37 31 39 61 34 38 36 35 f62f9cde719a4865
d340: 62 62 35 31 62 33 63 31 37 65 61 38 35 33 22 20 bb51b3c17ea853"
d350: 2d 20 74 69 63 6b 65 74 20 32 32 30 35 34 36 33 - ticket 2205463
d360: 34 32 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 42. ;;
d370: 54 4f 44 4f 20 2d 20 63 6f 6e 73 69 64 65 72 20 TODO - consider
d380: 31 29 20 75 73 69 6e 67 20 73 69 6d 70 6c 65 2d 1) using simple-
d390: 6c 6f 63 6b 20 74 6f 20 62 72 61 63 6b 65 74 20 lock to bracket
d3a0: 63 61 63 68 65 20 77 72 69 74 65 0a 20 20 20 20 cache write.
d3b0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 ;;
d3c0: 20 20 20 20 20 20 20 20 20 32 29 20 63 61 63 68 2) cach
d3d0: 65 20 69 6e 20 68 61 73 68 20 6f 6e 20 73 65 72 e in hash on ser
d3e0: 76 65 72 2c 20 73 69 6e 63 65 20 6e 65 65 64 20 ver, since need
d3f0: 74 6f 20 64 6f 20 72 6d 74 3a 20 61 6e 79 77 61 to do rmt: anywa
d400: 79 20 74 6f 20 6c 6f 63 6b 2e 0a 20 20 20 20 20 y to lock..
d410: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 63 (if (and rc
d420: 63 61 63 68 65 66 20 2a 72 75 6e 63 6f 6e 66 69 cachef *runconfi
d430: 67 64 61 74 2a 20 28 6e 6f 74 20 28 63 6f 6d 6d gdat* (not (comm
d440: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
d450: 72 63 63 61 63 68 65 66 29 29 29 0a 20 20 20 20 rccachef))).
d460: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
d470: 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 20 20 n:fail-safe.
d480: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
d490: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
d4a0: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
d4b0: 77 72 69 74 65 2d 61 6c 69 73 74 20 2a 72 75 6e write-alist *run
d4c0: 63 6f 6e 66 69 67 64 61 74 2a 20 72 63 63 61 63 configdat* rccac
d4d0: 68 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 hef)).
d4e0: 20 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c (conc "Coul
d4f0: 64 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 68 d not write cach
d500: 65 20 66 69 6c 65 20 2d 20 22 72 63 63 61 63 68 e file - "rccach
d510: 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ef)).
d520: 20 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 28 ). (
d530: 69 66 20 28 61 6e 64 20 6d 74 63 61 63 68 65 66 if (and mtcachef
d540: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 20 20 *configdat*
d550: 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c (not (common:fil
d560: 65 2d 65 78 69 73 74 73 3f 20 6d 74 63 61 63 68 e-exists? mtcach
d570: 65 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ef))).
d580: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 61 69 6c (common:fail
d590: 2d 73 61 66 65 0a 20 20 20 20 20 20 20 20 20 20 -safe.
d5a0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
d5b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d5c0: 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d (configf:write-
d5d0: 61 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 alist *configdat
d5e0: 2a 20 6d 74 63 61 63 68 65 66 29 29 0a 20 20 20 * mtcachef)).
d5f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
d600: 63 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 72 69 c "Could not wri
d610: 74 65 20 63 61 63 68 65 20 66 69 6c 65 20 2d 20 te cache file -
d620: 22 6d 74 63 61 63 68 65 66 29 29 0a 20 20 20 20 "mtcachef)).
d630: 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 ).
d640: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 (if (and r
d650: 63 63 61 63 68 65 66 20 6d 74 63 61 63 68 65 66 ccachef mtcachef
d660: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 *runconfigdat*
d670: 2a 63 6f 6e 66 69 67 64 61 74 2a 29 0a 20 20 20 *configdat*).
d680: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
d690: 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 *configstatus*
d6a0: 27 66 75 6c 6c 64 61 74 61 29 29 29 0a 0a 09 3b 'fulldata)))...;
d6b0: 3b 20 69 66 20 68 61 76 65 20 2d 61 70 70 65 6e ; if have -appen
d6c0: 64 2d 63 6f 6e 66 69 67 20 74 68 65 6e 20 72 65 d-config then re
d6d0: 61 64 20 61 6e 64 20 61 70 70 65 6e 64 20 68 65 ad and append he
d6e0: 72 65 0a 09 28 6c 65 74 20 28 28 63 66 6e 61 6d re..(let ((cfnam
d6f0: 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 e (args:get-arg
d700: 22 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 22 "-append-config"
d710: 29 29 29 0a 09 20 20 28 69 66 20 28 61 6e 64 20 ))).. (if (and
d720: 63 66 6e 61 6d 65 0a 09 09 20 20 20 28 66 69 6c cfname... (fil
d730: 65 2d 72 65 61 64 2d 61 63 63 65 73 73 3f 20 63 e-read-access? c
d740: 66 6e 61 6d 65 29 29 0a 09 20 20 20 20 20 20 28 fname)).. (
d750: 72 65 61 64 2d 63 6f 6e 66 69 67 20 63 66 6e 61 read-config cfna
d760: 6d 65 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 23 me *configdat* #
d770: 74 29 29 29 20 3b 3b 20 76 61 6c 75 65 73 20 61 t))) ;; values a
d780: 72 65 20 61 64 64 65 64 20 74 6f 20 74 68 65 20 re added to the
d790: 68 61 73 68 2c 20 6e 6f 20 6e 65 65 64 20 74 6f hash, no need to
d7a0: 20 64 6f 20 61 6e 79 74 68 69 6e 67 20 73 70 65 do anything spe
d7b0: 63 69 61 6c 2e 0a 09 2a 74 6f 70 70 61 74 68 2a cial...*toppath*
d7c0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 67 65 )))..(define (ge
d7d0: 74 2d 62 65 73 74 2d 64 69 73 6b 20 63 6f 6e 66 t-best-disk conf
d7e0: 64 61 74 20 74 65 73 74 63 6f 6e 66 69 67 29 0a dat testconfig).
d7f0: 20 20 28 6c 65 74 2a 20 28 28 64 69 73 6b 73 20 (let* ((disks
d800: 20 20 28 6f 72 20 28 61 6e 64 20 74 65 73 74 63 (or (and testc
d810: 6f 6e 66 69 67 20 28 68 61 73 68 2d 74 61 62 6c onfig (hash-tabl
d820: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
d830: 73 74 63 6f 6e 66 69 67 20 22 64 69 73 6b 73 22 stconfig "disks"
d840: 20 23 66 29 29 0a 09 09 20 20 20 20 20 20 28 68 #f))... (h
d850: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
d860: 66 61 75 6c 74 20 63 6f 6e 66 64 61 74 20 22 64 fault confdat "d
d870: 69 73 6b 73 22 20 23 66 29 29 29 0a 09 20 28 6d isks" #f))).. (m
d880: 69 6e 73 70 61 63 65 20 28 6c 65 74 20 28 28 6d inspace (let ((m
d890: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
d8a0: 20 63 6f 6e 66 64 61 74 20 22 73 65 74 75 70 22 confdat "setup"
d8b0: 20 22 6d 69 6e 73 70 61 63 65 22 29 29 29 0a 09 "minspace")))..
d8c0: 09 20 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 6e . (string->n
d8d0: 75 6d 62 65 72 20 28 6f 72 20 6d 20 22 31 30 30 umber (or m "100
d8e0: 30 30 22 29 29 29 29 29 0a 20 20 20 20 28 69 66 00"))))). (if
d8f0: 20 64 69 73 6b 73 20 0a 09 28 6c 65 74 20 28 28 disks ..(let ((
d900: 72 65 73 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d res (common:get-
d910: 64 69 73 6b 2d 77 69 74 68 2d 6d 6f 73 74 2d 66 disk-with-most-f
d920: 72 65 65 2d 73 70 61 63 65 20 64 69 73 6b 73 20 ree-space disks
d930: 6d 69 6e 73 70 61 63 65 29 29 29 20 3b 3b 20 6d minspace))) ;; m
d940: 69 6e 20 73 69 7a 65 20 6f 66 20 31 30 30 30 2c in size of 1000,
d950: 20 73 65 65 6d 73 20 74 61 64 20 64 75 6d 62 0a seems tad dumb.
d960: 09 20 20 28 69 66 20 72 65 73 0a 09 20 20 20 20 . (if res..
d970: 20 20 28 63 64 72 20 72 65 73 29 0a 09 20 20 20 (cdr res)..
d980: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 69 66 20 (begin...(if
d990: 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 2d 6e 6f 69 73 (common:low-nois
d9a0: 65 2d 70 72 69 6e 74 20 32 30 20 22 4e 6f 20 76 e-print 20 "No v
d9b0: 61 6c 69 64 20 64 69 73 6b 73 20 6f 72 20 6e 6f alid disks or no
d9c0: 20 64 69 73 6b 20 77 69 74 68 20 65 6e 6f 75 67 disk with enoug
d9d0: 68 20 73 70 61 63 65 22 29 0a 09 09 20 20 20 20 h space")...
d9e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
d9f0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
da00: 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 76 61 6c 69 g-port* "No vali
da10: 64 20 64 69 73 6b 73 20 66 6f 75 6e 64 20 69 6e d disks found in
da20: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
da30: 2e 20 50 6c 65 61 73 65 20 61 64 64 20 73 6f 6d . Please add som
da40: 65 20 74 6f 20 79 6f 75 72 20 5b 64 69 73 6b 73 e to your [disks
da50: 5d 20 73 65 63 74 69 6f 6e 20 61 6e 64 20 65 6e ] section and en
da60: 73 75 72 65 20 74 68 65 20 64 69 72 65 63 74 6f sure the directo
da70: 72 79 20 65 78 69 73 74 73 20 61 6e 64 20 68 61 ry exists and ha
da80: 73 20 65 6e 6f 75 67 68 20 73 70 61 63 65 21 5c s enough space!\
da90: 6e 20 20 20 20 59 6f 75 20 63 61 6e 20 63 68 61 n You can cha
daa0: 6e 67 65 20 6d 69 6e 73 70 61 63 65 20 69 6e 20 nge minspace in
dab0: 74 68 65 20 5b 73 65 74 75 70 5d 20 73 65 63 74 the [setup] sect
dac0: 69 6f 6e 20 6f 66 20 6d 65 67 61 74 65 73 74 2e ion of megatest.
dad0: 63 6f 6e 66 69 67 2e 20 43 75 72 72 65 6e 74 20 config. Current
dae0: 73 65 74 74 69 6e 67 20 69 73 3a 20 22 20 6d 69 setting is: " mi
daf0: 6e 73 70 61 63 65 29 29 0a 09 09 28 65 78 69 74 nspace))...(exit
db00: 20 31 29 29 29 29 29 29 29 20 3b 3b 20 54 4f 44 1))))))) ;; TOD
db10: 4f 20 2d 20 6d 6f 76 65 20 74 68 65 20 65 78 69 O - move the exi
db20: 74 20 74 6f 20 74 68 65 20 63 61 6c 6c 69 6e 67 t to the calling
db30: 20 6c 6f 63 61 74 69 6f 6e 20 61 6e 64 20 72 65 location and re
db40: 74 75 72 6e 20 23 66 0a 0a 28 64 65 66 69 6e 65 turn #f..(define
db50: 20 28 6c 61 75 6e 63 68 3a 74 65 73 74 2d 63 6f (launch:test-co
db60: 70 79 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 py test-src-path
db70: 20 74 65 73 74 2d 70 61 74 68 29 0a 20 20 28 6c test-path). (l
db80: 65 74 2a 20 28 28 6f 76 72 63 6d 64 20 28 6c 65 et* ((ovrcmd (le
db90: 74 20 28 28 63 6d 64 20 28 63 6f 6e 66 69 67 2d t ((cmd (config-
dba0: 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 lookup *configda
dbb0: 74 2a 20 22 73 65 74 75 70 22 20 22 74 65 73 74 t* "setup" "test
dbc0: 63 6f 70 79 63 6d 64 22 29 29 29 0a 09 09 20 20 copycmd")))...
dbd0: 20 28 69 66 20 63 6d 64 0a 09 09 20 20 20 20 20 (if cmd...
dbe0: 20 20 3b 3b 20 73 75 62 73 74 69 74 75 74 65 20 ;; substitute
dbf0: 74 68 65 20 54 45 53 54 5f 53 52 43 5f 50 41 54 the TEST_SRC_PAT
dc00: 48 20 61 6e 64 20 54 45 53 54 5f 54 41 52 47 5f H and TEST_TARG_
dc10: 50 41 54 48 0a 09 09 20 20 20 20 20 20 20 28 73 PATH... (s
dc20: 74 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 tring-substitute
dc30: 20 22 54 45 53 54 5f 54 41 52 47 5f 50 41 54 48 "TEST_TARG_PATH
dc40: 22 20 74 65 73 74 2d 70 61 74 68 0a 09 09 09 09 " test-path.....
dc50: 09 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 . (string-subst
dc60: 69 74 75 74 65 20 22 54 45 53 54 5f 53 52 43 5f itute "TEST_SRC_
dc70: 50 41 54 48 22 20 74 65 73 74 2d 73 72 63 2d 70 PATH" test-src-p
dc80: 61 74 68 20 63 6d 64 20 23 74 29 20 23 74 29 0a ath cmd #t) #t).
dc90: 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 .. #f)))..
dca0: 20 28 63 6d 64 20 20 20 20 28 69 66 20 6f 76 72 (cmd (if ovr
dcb0: 63 6d 64 20 0a 09 09 20 20 20 20 20 6f 76 72 63 cmd ... ovrc
dcc0: 6d 64 0a 09 09 20 20 20 20 20 28 63 6f 6e 63 20 md... (conc
dcd0: 22 72 73 79 6e 63 20 2d 61 76 22 20 28 69 66 20 "rsync -av" (if
dce0: 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d 6f 64 (debug:debug-mod
dcf0: 65 20 31 29 20 22 22 20 22 71 22 29 20 22 20 22 e 1) "" "q") " "
dd00: 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 22 test-src-path "
dd10: 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f / " test-path "/
dd20: 22 0a 09 09 09 20 20 20 22 20 3e 3e 20 22 20 74 ".... " >> " t
dd30: 65 73 74 2d 70 61 74 68 20 22 2f 6d 74 5f 6c 61 est-path "/mt_la
dd40: 75 6e 63 68 2e 6c 6f 67 20 32 3e 3e 20 22 20 74 unch.log 2>> " t
dd50: 65 73 74 2d 70 61 74 68 20 22 2f 6d 74 5f 6c 61 est-path "/mt_la
dd60: 75 6e 63 68 2e 6c 6f 67 22 29 29 29 0a 09 20 28 unch.log"))).. (
dd70: 73 74 61 74 75 73 20 28 73 79 73 74 65 6d 20 63 status (system c
dd80: 6d 64 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e md))). (if (n
dd90: 6f 74 20 28 65 71 3f 20 73 74 61 74 75 73 20 30 ot (eq? status 0
dda0: 29 29 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 ))..(debug:print
ddb0: 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
ddc0: 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 70 72 port* "ERROR: pr
ddd0: 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 6e 6e 69 oblem with runni
dde0: 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c 22 22 29 ng \"" cmd "\"")
ddf0: 29 29 29 0a 0a 0a 3b 3b 20 44 65 73 69 72 65 64 )))...;; Desired
de00: 20 64 69 72 65 63 74 6f 72 79 20 73 74 72 75 63 directory struc
de10: 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 3c 6c 69 ture:.;;.;; <li
de20: 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 65 74 nkdir> - <target
de30: 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d > - <testname> -
de40: 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ..;;
de50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de60: 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b 20 20 20 |.;;
de70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de90: 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 69 72 3e v.;; <rundir>
dea0: 20 20 2d 20 20 3c 74 61 72 67 65 74 3e 20 20 2d - <target> -
deb0: 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 3e 20 2d <testname> -
dec0: 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 73 29 3e |- <itempath(s)>
ded0: 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 74 6f 72 .;;.;; dir stor
dee0: 65 64 20 69 6e 20 74 65 73 74 20 69 73 3a 0a 3b ed in test is:.;
def0: 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e ; .;; <linkdir>
df00: 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 - <target> - <t
df10: 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 estname> [ - <it
df20: 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 0a 3b 3b empath> ].;; .;;
df30: 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 20 6c 69 All log file li
df40: 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 20 73 74 nks should be st
df50: 6f 72 65 64 20 72 65 6c 61 74 69 76 65 20 74 6f ored relative to
df60: 20 74 68 65 20 74 6f 70 20 6f 66 20 6c 69 6e 6b the top of link
df70: 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b 20 3c 74 path.;; .;; <t
df80: 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 arget> - <testna
df90: 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 me> [ - <itempat
dfa0: 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 69 6e 65 h> ] .;;.(define
dfb0: 20 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 (create-work-ar
dfc0: 65 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e ea run-id run-in
dfd0: 66 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 2d fo keyvals test-
dfe0: 69 64 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 id test-src-path
dff0: 20 64 69 73 6b 2d 70 61 74 68 20 74 65 73 74 6e disk-path testn
e000: 61 6d 65 20 69 74 65 6d 64 61 74 20 23 21 6b 65 ame itemdat #!ke
e010: 79 20 28 72 65 6d 74 72 69 65 73 20 32 29 29 0a y (remtries 2)).
e020: 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 (let* ((item-p
e030: 61 74 68 20 28 69 66 20 28 73 74 72 69 6e 67 3f ath (if (string?
e040: 20 69 74 65 6d 64 61 74 29 20 69 74 65 6d 64 61 itemdat) itemda
e050: 74 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 t (item-list->pa
e060: 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b th itemdat))) ;;
e070: 20 69 66 20 70 61 73 73 20 69 6e 20 73 74 72 69 if pass in stri
e080: 6e 67 20 2d 20 6a 75 73 74 20 75 73 65 20 69 74 ng - just use it
e090: 0a 09 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 69 .. (runname (i
e0a0: 66 20 28 73 74 72 69 6e 67 3f 20 72 75 6e 2d 69 f (string? run-i
e0b0: 6e 66 6f 29 20 3b 3b 20 69 66 20 77 65 20 70 61 nfo) ;; if we pa
e0c0: 73 73 20 69 6e 20 61 20 73 74 72 69 6e 67 20 61 ss in a string a
e0d0: 73 20 72 75 6e 2d 69 6e 66 6f 20 75 73 65 20 69 s run-info use i
e0e0: 74 20 61 73 20 72 75 6e 2d 6e 61 6d 65 2e 0a 09 t as run-name...
e0f0: 09 09 72 75 6e 2d 69 6e 66 6f 0a 09 09 09 28 64 ..run-info....(d
e100: 62 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 b:get-value-by-h
e110: 65 61 64 65 72 20 28 64 62 3a 67 65 74 2d 72 6f eader (db:get-ro
e120: 77 73 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 ws run-info)....
e130: 09 09 09 28 64 62 3a 67 65 74 2d 68 65 61 64 65 ...(db:get-heade
e140: 72 20 72 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 r run-info).....
e150: 09 09 22 72 75 6e 6e 61 6d 65 22 29 29 29 0a 09 .."runname")))..
e160: 20 28 63 6f 6e 74 6f 75 72 20 20 20 23 66 29 20 (contour #f)
e170: 3b 3b 20 4e 4f 54 20 52 45 41 44 59 20 46 4f 52 ;; NOT READY FOR
e180: 20 54 48 49 53 20 28 61 72 67 73 3a 67 65 74 2d THIS (args:get-
e190: 61 72 67 20 22 2d 63 6f 6e 74 6f 75 72 22 29 29 arg "-contour"))
e1a0: 0a 09 20 3b 3b 20 63 6f 6e 76 65 72 74 20 62 61 .. ;; convert ba
e1b0: 63 6b 20 74 6f 20 64 62 3a 20 66 72 6f 6d 20 72 ck to db: from r
e1c0: 64 62 3a 20 2d 20 74 68 69 73 20 69 73 20 61 6c db: - this is al
e1d0: 77 61 79 73 20 72 75 6e 20 61 74 20 73 65 72 76 ways run at serv
e1e0: 65 72 20 65 6e 64 0a 09 20 28 74 61 72 67 65 74 er end.. (target
e1f0: 20 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 (string-inter
e200: 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 64 72 sperse (map cadr
e210: 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 0a keyvals) "/")).
e220: 0a 09 20 28 6e 6f 74 2d 69 74 65 72 61 74 65 64 .. (not-iterated
e230: 20 20 28 65 71 75 61 6c 3f 20 22 22 20 69 74 65 (equal? "" ite
e240: 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 61 m-path))... ;; a
e250: 6c 6c 20 74 65 73 74 73 20 61 72 65 20 66 6f 75 ll tests are fou
e260: 6e 64 20 61 74 20 3c 72 75 6e 64 69 72 3e 2f 74 nd at <rundir>/t
e270: 65 73 74 2d 62 61 73 65 20 6f 72 20 3c 6c 69 6e est-base or <lin
e280: 6b 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 0a kdir>/test-base.
e290: 09 20 28 74 65 73 74 74 6f 70 2d 62 61 73 65 20 . (testtop-base
e2a0: 28 63 6f 6e 63 20 74 61 72 67 65 74 20 22 2f 22 (conc target "/"
e2b0: 20 72 75 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 runname "/" tes
e2c0: 74 6e 61 6d 65 29 29 0a 09 20 28 74 65 73 74 2d tname)).. (test-
e2d0: 62 61 73 65 20 20 20 20 28 63 6f 6e 63 20 74 65 base (conc te
e2e0: 73 74 74 6f 70 2d 62 61 73 65 20 28 69 66 20 6e sttop-base (if n
e2f0: 6f 74 2d 69 74 65 72 61 74 65 64 20 22 22 20 22 ot-iterated "" "
e300: 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 29 29 0a /") item-path)).
e310: 0a 09 20 3b 3b 20 6e 62 2f 2f 20 69 66 20 69 74 .. ;; nb// if it
e320: 65 6d 70 61 74 68 20 69 73 20 6e 6f 74 20 22 22 empath is not ""
e330: 20 74 68 65 6e 20 69 74 20 69 73 20 70 72 65 66 then it is pref
e340: 69 78 65 64 20 77 69 74 68 20 22 2f 22 0a 09 20 ixed with "/"..
e350: 28 74 6f 70 74 65 73 74 2d 70 61 74 68 20 28 63 (toptest-path (c
e360: 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 28 69 onc disk-path (i
e370: 66 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 20 f contour (conc
e380: 22 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 29 "/" contour) "")
e390: 20 22 2f 22 20 74 65 73 74 74 6f 70 2d 62 61 73 "/" testtop-bas
e3a0: 65 29 29 0a 09 20 28 74 65 73 74 2d 70 61 74 68 e)).. (test-path
e3b0: 20 20 20 20 28 63 6f 6e 63 20 64 69 73 6b 2d 70 (conc disk-p
e3c0: 61 74 68 20 28 69 66 20 63 6f 6e 74 6f 75 72 20 ath (if contour
e3d0: 28 63 6f 6e 63 20 22 2f 22 20 63 6f 6e 74 6f 75 (conc "/" contou
e3e0: 72 29 20 22 22 29 20 22 2f 22 20 74 65 73 74 2d r) "") "/" test-
e3f0: 62 61 73 65 29 29 0a 0a 09 20 3b 3b 20 65 6e 73 base))... ;; ens
e400: 75 72 65 20 74 68 69 73 20 65 78 69 73 74 73 20 ure this exists
e410: 66 69 72 73 74 20 61 73 20 6c 69 6e 6b 73 20 74 first as links t
e420: 6f 20 73 75 62 74 65 73 74 73 20 6d 75 73 74 20 o subtests must
e430: 62 65 20 63 72 65 61 74 65 64 20 74 68 65 72 65 be created there
e440: 0a 09 20 28 6c 69 6e 6b 74 72 65 65 20 20 28 63 .. (linktree (c
e450: 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 ommon:get-linktr
e460: 65 65 29 29 0a 09 20 3b 3b 20 57 41 53 3a 20 28 ee)).. ;; WAS: (
e470: 6c 65 74 20 28 28 72 64 20 28 63 6f 6e 66 69 67 let ((rd (config
e480: 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
e490: 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 6e at* "setup" "lin
e4a0: 6b 74 72 65 65 22 29 29 29 0a 09 20 3b 3b 20 20 ktree"))).. ;;
e4b0: 20 20 20 20 20 20 20 28 69 66 20 72 64 20 72 64 (if rd rd
e4c0: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
e4d0: 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 09 20 3b "/runs")))).. ;
e4e0: 3b 20 77 68 69 63 68 20 73 65 65 6d 73 20 77 72 ; which seems wr
e4f0: 6f 6e 67 20 2e 2e 2e 0a 0a 09 20 28 6c 6e 6b 62 ong ...... (lnkb
e500: 61 73 65 20 20 20 28 63 6f 6e 63 20 6c 69 6e 6b ase (conc link
e510: 74 72 65 65 20 28 69 66 20 63 6f 6e 74 6f 75 72 tree (if contour
e520: 20 28 63 6f 6e 63 20 22 2f 22 20 63 6f 6e 74 6f (conc "/" conto
e530: 75 72 29 20 22 22 29 20 22 2f 22 20 74 61 72 67 ur) "") "/" targ
e540: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 et "/" runname))
e550: 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 20 28 63 .. (lnkpath (c
e560: 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 onc lnkbase "/"
e570: 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e testname)).. (ln
e580: 6b 70 61 74 68 66 20 20 28 63 6f 6e 63 20 6c 6e kpathf (conc ln
e590: 6b 70 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 kpath (if not-it
e5a0: 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 erated "" "/") i
e5b0: 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 28 6c 6e tem-path)).. (ln
e5c0: 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 20 6c 6e ktarget (conc ln
e5d0: 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 kpath "/" item-p
e5e0: 61 74 68 29 29 29 0a 0a 20 20 20 20 3b 3b 20 55 ath))).. ;; U
e5f0: 70 64 61 74 65 20 74 68 65 20 72 75 6e 64 69 72 pdate the rundir
e600: 20 70 61 74 68 20 69 6e 20 74 68 65 20 74 65 73 path in the tes
e610: 74 20 72 65 63 6f 72 64 20 66 6f 72 20 61 6c 6c t record for all
e620: 2c 20 72 75 6e 64 69 72 3d 70 68 79 73 69 63 61 , rundir=physica
e630: 6c 2c 20 73 68 6f 72 74 64 69 72 3d 6c 6f 67 69 l, shortdir=logi
e640: 63 61 6c 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 cal. ;;
e650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e670: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 64 69 rundi
e680: 72 20 20 20 73 68 6f 72 74 64 69 72 0a 20 20 20 r shortdir.
e690: 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 (rmt:general-ca
e6a0: 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e ll 'test-set-run
e6b0: 64 69 72 2d 73 68 6f 72 74 64 69 72 20 72 75 6e dir-shortdir run
e6c0: 2d 69 64 20 6c 6e 6b 70 61 74 68 66 20 74 65 73 -id lnkpathf tes
e6d0: 74 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 t-path testname
e6e0: 69 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 69 64 item-path run-id
e6f0: 29 0a 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
e700: 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
e710: 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 5c og-port* "INFO:\
e720: 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 65 3d n lnkbase=
e730: 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 20 20 " lnkbase "\n
e740: 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 6c 6e lnkpath=" ln
e750: 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 74 65 kpath "\n topte
e760: 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 65 73 st-path=" toptes
e770: 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 20 74 t-path "\n t
e780: 65 73 74 2d 70 61 74 68 3d 22 20 74 65 73 74 2d est-path=" test-
e790: 70 61 74 68 29 0a 20 20 20 20 28 69 66 20 28 6e path). (if (n
e7a0: 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d ot (common:file-
e7b0: 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 65 exists? linktree
e7c0: 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 ))..(begin.. (d
e7d0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
e7e0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
e7f0: 22 57 41 52 4e 49 4e 47 3a 20 6c 69 6e 6b 74 72 "WARNING: linktr
e800: 65 65 20 64 69 64 20 6e 6f 74 20 65 78 69 73 74 ee did not exist
e810: 21 20 43 72 65 61 74 69 6e 67 20 69 74 20 6e 6f ! Creating it no
e820: 77 20 61 74 20 22 20 6c 69 6e 6b 74 72 65 65 29 w at " linktree)
e830: 0a 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 .. (create-dire
e840: 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 ctory linktree #
e850: 74 29 29 29 20 3b 3b 20 28 73 79 73 74 65 6d 20 t))) ;; (system
e860: 28 63 6f 6e 63 20 22 6d 6b 64 69 72 20 2d 70 20 (conc "mkdir -p
e870: 22 20 6c 69 6e 6b 74 72 65 65 29 29 29 29 0a 20 " linktree)))).
e880: 20 20 20 3b 3b 20 63 72 65 61 74 65 20 74 68 65 ;; create the
e890: 20 64 69 72 65 63 74 6f 72 79 20 66 6f 72 20 74 directory for t
e8a0: 68 65 20 74 65 73 74 73 20 64 69 72 20 6c 69 6e he tests dir lin
e8b0: 6b 73 2c 20 74 68 69 73 20 69 73 20 6e 65 65 64 ks, this is need
e8c0: 65 64 20 6e 6f 20 6d 61 74 74 65 72 20 77 68 61 ed no matter wha
e8d0: 74 2e 2e 2e 0a 20 20 20 20 28 69 66 20 28 61 6e t.... (if (an
e8e0: 64 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 64 d (not (common:d
e8f0: 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f irectory-exists?
e900: 20 6c 6e 6b 62 61 73 65 29 29 0a 09 20 20 20 20 lnkbase))..
e910: 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (not (common:fi
e920: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 le-exists? lnkba
e930: 73 65 29 29 29 0a 09 28 68 61 6e 64 6c 65 2d 65 se)))..(handle-e
e940: 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a xceptions.. exn.
e950: 09 20 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 . (begin.. (de
e960: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
e970: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
e980: 6f 72 74 2a 20 22 50 72 6f 62 6c 65 6d 20 63 72 ort* "Problem cr
e990: 65 61 74 69 6e 67 20 6c 69 6e 6b 74 72 65 65 20 eating linktree
e9a0: 62 61 73 65 20 61 74 20 22 20 6c 6e 6b 62 61 73 base at " lnkbas
e9b0: 65 29 0a 09 20 20 20 28 70 72 69 6e 74 2d 65 72 e).. (print-er
e9c0: 72 6f 72 2d 6d 65 73 73 61 67 65 20 65 78 6e 20 ror-message exn
e9d0: 28 63 75 72 72 65 6e 74 2d 65 72 72 6f 72 2d 70 (current-error-p
e9e0: 6f 72 74 29 29 29 0a 09 20 28 63 72 65 61 74 65 ort))).. (create
e9f0: 2d 64 69 72 65 63 74 6f 72 79 20 6c 6e 6b 62 61 -directory lnkba
ea00: 73 65 20 23 74 29 29 29 0a 20 20 20 20 0a 20 20 se #t))). .
ea10: 20 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 ;; update the
ea20: 74 6f 70 74 65 73 74 20 72 65 63 6f 72 64 20 77 toptest record w
ea30: 69 74 68 20 69 74 73 20 6c 6f 63 61 74 69 6f 6e ith its location
ea40: 20 72 75 6e 64 69 72 2c 20 63 61 63 68 65 20 74 rundir, cache t
ea50: 68 65 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 54 he path. ;; T
ea60: 68 69 73 20 77 61 73 73 20 68 69 67 68 6c 79 20 his wass highly
ea70: 69 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e 65 inefficient, one
ea80: 20 64 62 20 77 72 69 74 65 20 66 6f 72 20 65 76 db write for ev
ea90: 65 72 79 20 73 75 62 74 65 73 74 2c 20 70 6f 74 ery subtest, pot
eaa0: 65 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 entially. ;;
eab0: 74 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e 6e thousands of unn
eac0: 65 63 65 73 73 61 72 79 20 75 70 64 61 74 65 73 ecessary updates
ead0: 2c 20 63 61 63 68 65 20 74 68 65 20 66 61 63 74 , cache the fact
eae0: 20 69 74 20 77 61 73 20 73 65 74 20 61 6e 64 20 it was set and
eaf0: 64 6f 6e 27 74 20 73 65 74 20 69 74 20 0a 20 20 don't set it .
eb00: 20 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 20 ;; again. ..
eb10: 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 ;; Now create
eb20: 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 the link from th
eb30: 65 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 e test path to t
eb40: 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f he link tree, ho
eb50: 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 wever. ;; if
eb60: 74 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 the test is iter
eb70: 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 ated it is neces
eb80: 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 sary to create t
eb90: 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 he parent path.
eba0: 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 ;; to the ite
ebb0: 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 ration. use path
ebc0: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 name-directory t
ebd0: 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 o trim the path
ebe0: 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 by one. ;; le
ebf0: 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 vel. (if (not
ec00: 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b not-iterated) ;
ec10: 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a ; i.e. iterated.
ec20: 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 .(let ((iterated
ec30: 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 -parent (pathna
ec40: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f me-directory (co
ec50: 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 nc lnkpath "/" i
ec60: 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 tem-path))))..
ec70: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
ec80: 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
ec90: 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 69 6e 67 -port* "Creating
eca0: 20 69 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 iterated parent
ecb0: 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 " iterated-pare
ecc0: 6e 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 nt).. (handle-e
ecd0: 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 xceptions.. ex
ece0: 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 n.. (begin..
ecf0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
ed00: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
ed10: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 -log-port* " Fai
ed20: 6c 65 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 led to create di
ed30: 72 65 63 74 6f 72 79 20 22 20 69 74 65 72 61 74 rectory " iterat
ed40: 65 64 2d 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 ed-parent ((cond
ed50: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
ed60: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
ed70: 73 73 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 ssage) exn) ", e
ed80: 78 69 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 xiting").. (
ed90: 65 78 69 74 20 31 29 29 0a 09 20 20 20 28 63 72 exit 1)).. (cr
eda0: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 69 eate-directory i
edb0: 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 23 terated-parent #
edc0: 74 29 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 t)))).. (if (
edd0: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
ede0: 6e 6b 70 61 74 68 29 20 0a 09 28 68 61 6e 64 6c nkpath) ..(handl
edf0: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 e-exceptions.. e
ee00: 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 xn.. (begin..
ee10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
ee20: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
ee30: 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 g-port* " Failed
ee40: 20 74 6f 20 72 65 6d 6f 76 65 20 73 79 6d 6c 69 to remove symli
ee50: 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 63 nk " lnkpath ((c
ee60: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
ee70: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
ee80: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 20 22 'message) exn) "
ee90: 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 20 , exiting")..
eea0: 28 65 78 69 74 20 31 29 29 0a 09 20 28 64 65 6c (exit 1)).. (del
eeb0: 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 70 61 74 68 ete-file lnkpath
eec0: 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f ))).. (if (no
eed0: 74 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a 66 69 t (or (common:fi
eee0: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 61 le-exists? lnkpa
eef0: 74 68 29 0a 09 09 20 28 73 79 6d 62 6f 6c 69 63 th)... (symbolic
ef00: 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 29 -link? lnkpath))
ef10: 29 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 )..(handle-excep
ef20: 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 tions.. exn.. (b
ef30: 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a egin.. (debug:
ef40: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
ef50: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
ef60: 20 22 20 46 61 69 6c 65 64 20 74 6f 20 63 72 65 " Failed to cre
ef70: 61 74 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e ate symlink " ln
ef80: 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f kpath ((conditio
ef90: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
efa0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
efb0: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 e) exn) ", exiti
efc0: 6e 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 ng").. (exit 1
efd0: 29 29 0a 09 20 28 63 72 65 61 74 65 2d 73 79 6d )).. (create-sym
efe0: 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 bolic-link topte
eff0: 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 st-path lnkpath)
f000: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 4e )). . ;; N
f010: 42 20 2d 20 54 68 69 73 20 77 61 73 20 6e 6f 74 B - This was not
f020: 20 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 2d working right -
f030: 20 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 20 some top tests
f040: 61 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 are not getting
f050: 74 68 65 20 70 61 74 68 20 73 65 74 21 21 21 0a the path set!!!.
f060: 20 20 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 44 6f ;;. ;; Do
f070: 20 74 68 65 20 73 65 74 74 69 6e 67 20 6f 66 20 the setting of
f080: 74 68 69 73 20 72 65 63 6f 72 64 20 61 66 74 65 this record afte
f090: 72 20 74 68 65 20 70 61 74 68 73 20 61 72 65 20 r the paths are
f0a0: 63 72 65 61 74 65 64 20 73 6f 20 74 68 61 74 20 created so that
f0b0: 74 68 65 20 73 68 6f 72 74 64 69 72 20 63 61 6e the shortdir can
f0c0: 20 0a 20 20 20 20 3b 3b 20 62 65 20 73 65 74 20 . ;; be set
f0d0: 74 6f 20 74 68 65 20 72 65 61 6c 20 64 69 72 65 to the real dire
f0e0: 63 74 6f 72 79 20 6c 6f 63 61 74 69 6f 6e 2e 20 ctory location.
f0f0: 54 68 69 73 20 69 73 20 73 61 66 65 72 20 66 6f This is safer fo
f100: 72 20 66 75 74 75 72 65 20 63 6c 65 61 6e 20 75 r future clean u
f110: 70 20 69 66 20 74 68 65 20 6c 69 6e 6b 0a 20 20 p if the link.
f120: 20 20 3b 3b 20 74 72 65 65 20 69 73 20 64 61 6d ;; tree is dam
f130: 61 67 65 64 20 6f 72 20 6c 6f 73 74 2e 0a 20 20 aged or lost..
f140: 20 20 3b 3b 20 0a 20 20 20 20 28 69 66 20 28 6e ;; . (if (n
f150: 6f 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 ot (hash-table-r
f160: 65 66 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 74 ef/default *topt
f170: 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e est-paths* testn
f180: 61 6d 65 20 23 66 29 29 0a 09 28 6c 65 74 2a 20 ame #f))..(let*
f190: 28 28 74 65 73 74 69 6e 66 6f 20 20 20 20 20 20 ((testinfo
f1a0: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
f1b0: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
f1c0: 20 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 test-id)) ;; r
f1d0: 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 un-id testname i
f1e0: 74 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 tem-path))..
f1f0: 20 20 20 28 63 75 72 72 2d 74 65 73 74 2d 70 61 (curr-test-pa
f200: 74 68 20 28 69 66 20 74 65 73 74 69 6e 66 6f 20 th (if testinfo
f210: 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 ;; (filedb:get-p
f220: 61 74 68 20 2a 66 64 62 2a 0a 09 09 09 09 09 09 ath *fdb*.......
f230: 09 20 20 20 20 20 3b 3b 20 28 64 62 3a 67 65 74 . ;; (db:get
f240: 2d 70 61 74 68 20 64 62 73 74 72 75 63 74 0a 09 -path dbstruct..
f250: 09 09 09 20 20 20 3b 3b 20 28 72 6d 74 3a 73 64 ... ;; (rmt:sd
f260: 62 2d 71 72 79 20 27 67 65 74 73 74 72 20 0a 09 b-qry 'getstr ..
f270: 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 2d 67 ... (db:test-g
f280: 65 74 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e et-rundir testin
f290: 66 6f 29 20 3b 3b 20 29 20 3b 3b 20 29 0a 09 09 fo) ;; ) ;; )...
f2a0: 09 09 20 20 20 23 66 29 29 29 0a 09 20 20 28 68 .. #f))).. (h
f2b0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
f2c0: 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 toptest-paths* t
f2d0: 65 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 estname curr-tes
f2e0: 74 2d 70 61 74 68 29 0a 09 20 20 3b 3b 20 4e 42 t-path).. ;; NB
f2f0: 2f 2f 20 57 61 73 20 74 68 69 73 20 66 6f 72 20 // Was this for
f300: 74 68 65 20 74 65 73 74 20 6f 72 20 66 6f 72 20 the test or for
f310: 74 68 65 20 70 61 72 65 6e 74 20 69 6e 20 61 6e the parent in an
f320: 20 69 74 65 72 61 74 65 64 20 74 65 73 74 3f 0a iterated test?.
f330: 09 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d . (rmt:general-
f340: 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d 72 call 'test-set-r
f350: 75 6e 64 69 72 2d 73 68 6f 72 74 64 69 72 20 72 undir-shortdir r
f360: 75 6e 2d 69 64 20 6c 6e 6b 70 61 74 68 20 0a 09 un-id lnkpath ..
f370: 09 09 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f .. (if (commo
f380: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c n:file-exists? l
f390: 6e 6b 70 61 74 68 29 0a 09 09 09 09 3b 3b 20 28 nkpath).....;; (
f3a0: 72 65 73 6f 6c 76 65 2d 70 61 74 68 6e 61 6d 65 resolve-pathname
f3b0: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 09 09 28 63 lnkpath).....(c
f3c0: 6f 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 ommon:nice-path
f3d0: 6c 6e 6b 70 61 74 68 29 0a 09 09 09 09 6c 6e 6b lnkpath).....lnk
f3e0: 70 61 74 68 29 0a 09 09 09 20 20 20 20 74 65 73 path).... tes
f3f0: 74 6e 61 6d 65 20 22 22 20 72 75 6e 2d 69 64 29 tname "" run-id)
f400: 0a 09 20 20 3b 3b 20 28 72 6d 74 3a 67 65 6e 65 .. ;; (rmt:gene
f410: 72 61 6c 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 ral-call 'test-s
f420: 65 74 2d 72 75 6e 64 69 72 20 72 75 6e 2d 69 64 et-rundir run-id
f430: 20 6c 6e 6b 70 61 74 68 20 74 65 73 74 6e 61 6d lnkpath testnam
f440: 65 20 22 22 29 20 3b 3b 20 74 6f 70 74 65 73 74 e "") ;; toptest
f450: 2d 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f -path).. (if (o
f460: 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 r (not curr-test
f470: 2d 70 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 -path)... (not
f480: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
f490: 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 s? toptest-path)
f4a0: 29 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e )).. (begin
f4b0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ...(debug:print-
f4c0: 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
f4d0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 log-port* "Creat
f4e0: 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 ing " toptest-pa
f4f0: 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 th " and link "
f500: 6c 6e 6b 70 61 74 68 29 0a 09 09 28 68 61 6e 64 lnkpath)...(hand
f510: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
f520: 20 65 78 6e 0a 09 09 20 23 66 20 3b 3b 20 64 6f exn... #f ;; do
f530: 6e 27 74 20 63 61 72 65 20 74 6f 20 63 61 74 63 n't care to catc
f540: 68 20 61 6e 64 20 64 65 61 6c 20 77 69 74 68 20 h and deal with
f550: 65 72 72 6f 72 73 20 68 65 72 65 20 66 6f 72 20 errors here for
f560: 6e 6f 77 2e 0a 09 09 20 28 63 72 65 61 74 65 2d now.... (create-
f570: 64 69 72 65 63 74 6f 72 79 20 74 6f 70 74 65 73 directory toptes
f580: 74 2d 70 61 74 68 20 23 74 29 29 0a 09 09 28 68 t-path #t))...(h
f590: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
f5a0: 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 toptest-paths* t
f5b0: 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 74 2d estname toptest-
f5c0: 70 61 74 68 29 29 29 29 29 0a 0a 20 20 20 20 3b path))))).. ;
f5d0: 3b 20 54 68 65 20 74 6f 70 74 65 73 74 20 70 61 ; The toptest pa
f5e0: 74 68 20 68 61 73 20 62 65 65 6e 20 63 72 65 61 th has been crea
f5f0: 74 65 64 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f ted, the link to
f600: 20 74 68 65 20 74 65 73 74 20 69 6e 20 74 68 65 the test in the
f610: 20 6c 69 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 linktree has.
f620: 20 20 3b 3b 20 62 65 65 6e 20 63 72 65 61 74 65 ;; been create
f630: 64 2e 20 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 d. Now, if this
f640: 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 is an iterated t
f650: 65 73 74 20 74 68 65 20 72 65 61 6c 20 74 65 73 est the real tes
f660: 74 20 64 69 72 20 6d 75 73 74 20 62 65 20 63 72 t dir must be cr
f670: 65 61 74 65 64 0a 20 20 20 20 28 69 66 20 28 6e eated. (if (n
f680: 6f 74 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 ot not-iterated)
f690: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 6e 20 69 ;; this is an i
f6a0: 74 65 72 61 74 65 64 20 74 65 73 74 0a 09 28 62 terated test..(b
f6b0: 65 67 69 6e 20 3b 3b 20 28 6c 65 74 20 28 28 6c egin ;; (let ((l
f6c0: 6e 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 20 6c nktarget (conc l
f6d0: 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 6d 2d nkpath "/" item-
f6e0: 70 61 74 68 29 29 29 0a 09 20 20 28 64 65 62 75 path))).. (debu
f6f0: 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 75 g:print 2 *defau
f700: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 65 lt-log-port* "Se
f710: 74 74 69 6e 67 20 75 70 20 73 75 62 20 74 65 73 tting up sub tes
f720: 74 20 72 75 6e 20 61 72 65 61 22 29 0a 09 20 20 t run area")..
f730: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
f740: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
f750: 2a 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 72 * " - creating r
f760: 75 6e 20 61 72 65 61 20 69 6e 20 22 20 74 65 73 un area in " tes
f770: 74 2d 70 61 74 68 29 0a 09 20 20 28 68 61 6e 64 t-path).. (hand
f780: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 le-exceptions..
f790: 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 6e exn.. (begin
f7a0: 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
f7b0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
f7c0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
f7d0: 20 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 74 Failed to creat
f7e0: 65 20 64 69 72 65 63 74 6f 72 79 20 22 20 74 65 e directory " te
f7f0: 73 74 2d 70 61 74 68 20 28 28 63 6f 6e 64 69 74 st-path ((condit
f800: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
f810: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
f820: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 age) exn) ", exi
f830: 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 ting").. (ex
f840: 69 74 20 31 29 29 0a 09 20 20 20 28 63 72 65 61 it 1)).. (crea
f850: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 te-directory tes
f860: 74 2d 70 61 74 68 20 23 74 29 29 0a 09 20 20 28 t-path #t)).. (
f870: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
f880: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
f890: 20 0a 09 09 20 20 20 20 20 20 20 22 20 2d 20 63 ... " - c
f8a0: 72 65 61 74 69 6e 67 20 6c 69 6e 6b 20 66 72 6f reating link fro
f8b0: 6d 3a 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 m: " test-path "
f8c0: 5c 6e 22 0a 09 09 20 20 20 20 20 20 20 22 20 20 \n"... "
f8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f8e0: 20 74 6f 3a 20 22 20 6c 6e 6b 74 61 72 67 65 74 to: " lnktarget
f8f0: 29 0a 0a 09 20 20 3b 3b 20 49 66 20 74 68 65 72 )... ;; If ther
f900: 65 20 69 73 20 61 6c 72 65 61 64 79 20 61 20 73 e is already a s
f910: 79 6d 6c 69 6e 6b 20 64 65 6c 65 74 65 20 69 74 ymlink delete it
f920: 20 61 6e 64 20 72 65 63 72 65 61 74 65 20 69 74 and recreate it
f930: 2e 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 ... (handle-exc
f940: 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a eptions.. exn.
f950: 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
f960: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
f970: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
f980: 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
f990: 64 20 74 6f 20 72 65 2d 63 72 65 61 74 65 20 6c d to re-create l
f9a0: 69 6e 6b 20 22 20 6c 6e 6b 74 61 72 67 65 74 20 ink " lnktarget
f9b0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
f9c0: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
f9d0: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
f9e0: 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 ) ", exiting")..
f9f0: 20 20 20 20 20 28 65 78 69 74 29 29 0a 09 20 20 (exit))..
fa00: 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d 6c (if (symbolic-l
fa10: 69 6e 6b 3f 20 6c 6e 6b 74 61 72 67 65 74 29 20 ink? lnktarget)
fa20: 20 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 (delete-file
fa30: 20 6c 6e 6b 74 61 72 67 65 74 29 29 0a 09 20 20 lnktarget))..
fa40: 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f (if (not (commo
fa50: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c n:file-exists? l
fa60: 6e 6b 74 61 72 67 65 74 29 29 20 28 63 72 65 61 nktarget)) (crea
fa70: 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b te-symbolic-link
fa80: 20 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 test-path lnkta
fa90: 72 67 65 74 29 29 29 29 29 0a 0a 20 20 20 20 28 rget))))).. (
faa0: 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f if (not (directo
fab0: 72 79 3f 20 74 65 73 74 2d 70 61 74 68 29 29 0a ry? test-path)).
fac0: 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f .(create-directo
fad0: 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 29 ry test-path #t)
fae0: 29 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 68 ) ;; this is a h
faf0: 61 63 6b 2c 20 49 20 64 6f 6e 27 74 20 6b 6e 6f ack, I don't kno
fb00: 77 20 77 68 79 20 6f 75 74 20 6f 66 20 74 68 65 w why out of the
fb10: 20 62 6c 75 65 20 74 68 69 73 20 70 61 74 68 20 blue this path
fb20: 64 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 20 73 does not exist s
fb30: 6f 6d 65 74 69 6d 65 73 0a 0a 20 20 20 20 28 69 ometimes.. (i
fb40: 66 20 28 61 6e 64 20 74 65 73 74 2d 73 72 63 2d f (and test-src-
fb50: 70 61 74 68 20 28 64 69 72 65 63 74 6f 72 79 3f path (directory?
fb60: 20 74 65 73 74 2d 70 61 74 68 29 29 0a 09 28 62 test-path))..(b
fb70: 65 67 69 6e 0a 09 20 20 28 6c 61 75 6e 63 68 3a egin.. (launch:
fb80: 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 2d 73 test-copy test-s
fb90: 72 63 2d 70 61 74 68 20 74 65 73 74 2d 70 61 74 rc-path test-pat
fba0: 68 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e 6b 70 h).. (list lnkp
fbb0: 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 29 0a athf lnkpath )).
fbc0: 09 28 69 66 20 28 61 6e 64 20 74 65 73 74 2d 73 .(if (and test-s
fbd0: 72 63 2d 70 61 74 68 20 28 3e 20 72 65 6d 74 72 rc-path (> remtr
fbe0: 69 65 73 20 30 29 29 0a 09 20 20 20 20 28 62 65 ies 0)).. (be
fbf0: 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 gin.. (debu
fc00: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
fc10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
fc20: 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 72 t* "Failed to cr
fc30: 65 61 74 65 20 77 6f 72 6b 20 61 72 65 61 20 61 eate work area a
fc40: 74 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 t " test-path "
fc50: 77 69 74 68 20 6c 69 6e 6b 20 61 74 20 22 20 6c with link at " l
fc60: 6e 6b 74 61 72 67 65 74 20 22 2c 20 72 65 6d 61 nktarget ", rema
fc70: 69 6e 69 6e 67 20 61 74 74 65 6d 70 74 73 20 22 ining attempts "
fc80: 20 72 65 6d 74 72 69 65 73 29 0a 09 20 20 20 20 remtries)..
fc90: 20 20 3b 3b 20 0a 09 20 20 20 20 20 20 28 63 72 ;; .. (cr
fca0: 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 72 eate-work-area r
fcb0: 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b un-id run-info k
fcc0: 65 79 76 61 6c 73 20 74 65 73 74 2d 69 64 20 74 eyvals test-id t
fcd0: 65 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 est-src-path dis
fce0: 6b 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 k-path testname
fcf0: 69 74 65 6d 64 61 74 20 72 65 6d 74 72 69 65 73 itemdat remtries
fd00: 3a 20 28 2d 20 72 65 6d 74 72 69 65 73 20 31 29 : (- remtries 1)
fd10: 29 29 0a 09 20 20 20 20 28 6c 69 73 74 20 23 66 )).. (list #f
fd20: 20 23 66 29 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 #f)))))..;; 1.
fd30: 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 6b look though disk
fd40: 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b 20 s list for disk
fd50: 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 0a with most space.
fd60: 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 6e ;; 2. create run
fd70: 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 61 dir on disk, pa
fd80: 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e 69 th name is meani
fd90: 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 ngful.;; 3. crea
fda0: 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 6e te link from run
fdb0: 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 74 dir to megatest
fdc0: 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 34 runs area .;; 4
fdd0: 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 74 . remotely run t
fde0: 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 he test on alloc
fdf0: 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 20 ated host.;;
fe00: 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 74 - could be ssh t
fe10: 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 74 o host from host
fe20: 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 20 s table (update
fe30: 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 6c regularly with l
fe40: 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 oad).;; - cou
fe50: 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a 3b ld be netbatch.;
fe60: 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d 74 ; (launch-t
fe70: 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 61 est db (cadr sta
fe80: 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 29 tus) test-conf))
fe90: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
fea0: 2d 74 65 73 74 20 74 65 73 74 2d 69 64 20 72 75 -test test-id ru
feb0: 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 n-id run-info ke
fec0: 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 74 65 yvals runname te
fed0: 73 74 2d 63 6f 6e 66 20 74 65 73 74 2d 6e 61 6d st-conf test-nam
fee0: 65 20 74 65 73 74 2d 70 61 74 68 20 69 74 65 6d e test-path item
fef0: 64 61 74 20 70 61 72 61 6d 73 29 0a 20 20 28 6d dat params). (m
ff00: 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 6c 61 75 6e utex-lock! *laun
ff10: 63 68 2d 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 ch-setup-mutex*)
ff20: 20 3b 3b 20 73 65 74 74 69 6e 67 20 76 61 72 69 ;; setting vari
ff30: 61 62 6c 65 73 20 61 6e 64 20 70 72 6f 63 65 73 ables and proces
ff40: 73 69 6e 67 20 74 68 65 20 74 65 73 74 63 6f 6e sing the testcon
ff50: 66 69 67 20 69 73 20 4e 4f 54 20 74 68 72 65 61 fig is NOT threa
ff60: 64 2d 73 61 66 65 2c 20 72 65 75 73 65 20 74 68 d-safe, reuse th
ff70: 65 20 6c 61 75 6e 63 68 2d 73 65 74 75 70 20 6d e launch-setup m
ff80: 75 74 65 78 0a 20 20 28 6c 65 74 2a 20 28 20 3b utex. (let* ( ;
ff90: 3b 20 28 6c 6f 63 6b 2d 6b 65 79 20 20 20 20 20 ; (lock-key
ffa0: 20 20 20 28 63 6f 6e 63 20 22 74 65 73 74 2d 22 (conc "test-"
ffb0: 20 74 65 73 74 2d 69 64 29 29 0a 09 3b 3b 20 28 test-id))..;; (
ffc0: 67 6f 74 2d 6c 6f 63 6b 20 20 20 20 20 20 20 20 got-lock
ffd0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 6f 63 6b (let loop ((lock
ffe0: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 6e 6f 2d (rmt:no-
fff0: 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c 6f sync-get-lock lo
10000 63 6b 2d 6b 65 79 29 29 0a 09 3b 3b 20 09 09 09 ck-key))..;; ...
10010 20 20 20 20 20 28 65 78 70 69 72 65 2d 74 69 6d (expire-tim
10020 65 20 28 2b 20 28 63 75 72 72 65 6e 74 2d 73 65 e (+ (current-se
10030 63 6f 6e 64 73 29 20 31 35 29 29 29 20 3b 3b 20 conds) 15))) ;;
10040 67 69 76 65 20 75 70 20 6f 6e 20 67 65 74 74 69 give up on getti
10050 6e 67 20 74 68 65 20 6c 6f 63 6b 20 61 6e 64 20 ng the lock and
10060 73 74 65 61 6c 20 69 74 20 61 66 74 65 72 20 31 steal it after 1
10070 35 20 73 65 63 6f 6e 64 73 0a 09 3b 3b 20 09 09 5 seconds..;; ..
10080 20 20 20 20 28 69 66 20 28 63 61 72 20 6c 6f 63 (if (car loc
10090 6b 29 0a 09 3b 3b 20 09 09 09 23 74 0a 09 3b 3b k)..;; ...#t..;;
100a0 20 09 09 09 28 69 66 20 28 3e 20 28 63 75 72 72 ...(if (> (curr
100b0 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 65 78 70 ent-seconds) exp
100c0 69 72 65 2d 74 69 6d 65 29 0a 09 3b 3b 20 09 09 ire-time)..;; ..
100d0 09 20 20 20 20 28 62 65 67 69 6e 0a 09 3b 3b 20 . (begin..;;
100e0 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
100f0 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
10100 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
10110 22 54 69 6d 65 64 20 6f 75 74 20 77 61 69 74 69 "Timed out waiti
10120 6e 67 20 66 6f 72 20 61 20 6c 6f 63 6b 20 74 6f ng for a lock to
10130 20 6c 61 75 6e 63 68 20 74 65 73 74 20 22 20 6b launch test " k
10140 65 79 76 61 6c 73 20 22 20 22 20 72 75 6e 6e 61 eyvals " " runna
10150 6d 65 20 22 20 22 20 74 65 73 74 2d 6e 61 6d 65 me " " test-name
10160 20 22 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a " " test-path).
10170 09 3b 3b 20 09 09 09 20 20 20 20 20 20 28 72 6d .;; ... (rm
10180 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 6c t:no-sync-del! l
10190 6f 63 6b 2d 6b 65 79 29 20 3b 3b 20 64 65 73 74 ock-key) ;; dest
101a0 72 6f 79 20 74 68 65 20 6c 6f 63 6b 0a 09 3b 3b roy the lock..;;
101b0 20 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 ... (loop
101c0 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 (rmt:no-sync-get
101d0 2d 6c 6f 63 6b 20 6c 6f 63 6b 2d 6b 65 79 29 20 -lock lock-key)
101e0 65 78 70 69 72 65 2d 74 69 6d 65 29 29 20 3b 3b expire-time)) ;;
101f0 20 0a 09 3b 3b 20 09 09 09 20 20 20 20 28 62 65 ..;; ... (be
10200 67 69 6e 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 gin..;; ...
10210 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
10220 31 29 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 20 1)..;; ...
10230 28 6c 6f 6f 70 20 28 72 6d 74 3a 6e 6f 2d 73 79 (loop (rmt:no-sy
10240 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c 6f 63 6b nc-get-lock lock
10250 2d 6b 65 79 29 20 65 78 70 69 72 65 2d 74 69 6d -key) expire-tim
10260 65 29 29 29 29 29 29 0a 09 20 28 69 74 65 6d 2d e)))))).. (item-
10270 70 61 74 68 20 20 20 20 20 20 20 28 69 74 65 6d path (item
10280 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
10290 64 61 74 29 29 0a 09 20 28 63 6f 6e 74 6f 75 72 dat)).. (contour
102a0 20 20 20 20 20 20 20 20 20 23 66 29 29 20 3b 3b #f)) ;;
102b0 20 4e 4f 54 20 52 45 41 44 59 20 46 4f 52 20 54 NOT READY FOR T
102c0 48 49 53 20 28 61 72 67 73 3a 67 65 74 2d 61 72 HIS (args:get-ar
102d0 67 20 22 2d 63 6f 6e 74 6f 75 72 22 29 29 29 0a g "-contour"))).
102e0 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
102f0 64 65 6c 74 61 20 20 20 20 20 20 20 20 28 2d 20 delta (-
10300 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
10310 29 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 2a 29 ) *last-launch*)
10320 29 0a 09 20 20 20 20 20 20 20 28 6c 61 75 6e 63 ).. (launc
10330 68 2d 64 65 6c 61 79 20 28 63 6f 6e 66 69 67 66 h-delay (configf
10340 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 20 2a :lookup-number *
10350 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
10360 70 22 20 22 6c 61 75 6e 63 68 2d 64 65 6c 61 79 p" "launch-delay
10370 22 20 64 65 66 61 75 6c 74 3a 20 31 29 29 29 0a " default: 1))).
10380 20 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 75 (if (> lau
10390 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 29 nch-delay delta)
103a0 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 .. (begin..
103b0 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 2d (if (common:low-
103c0 6e 6f 69 73 65 2d 70 72 69 6e 74 20 31 32 30 30 noise-print 1200
103d0 20 22 74 65 73 74 20 6c 61 75 6e 63 68 20 64 65 "test launch de
103e0 6c 61 79 22 29 20 3b 3b 20 65 76 65 72 79 20 74 lay") ;; every t
103f0 77 6f 20 68 6f 75 72 73 20 6f 72 20 73 6f 20 72 wo hours or so r
10400 65 6d 69 6e 64 20 74 68 65 20 75 73 65 72 20 61 emind the user a
10410 62 6f 75 74 20 6c 61 75 6e 63 68 20 64 65 6c 61 bout launch dela
10420 79 2e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e y....(debug:prin
10430 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
10440 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f 54 t-log-port* "NOT
10450 45 3a 20 74 65 73 74 20 6c 61 75 6e 63 68 65 73 E: test launches
10460 20 61 72 65 20 64 65 6c 61 79 65 64 20 62 79 20 are delayed by
10470 22 20 6c 61 75 6e 63 68 2d 64 65 6c 61 79 20 22 " launch-delay "
10480 20 73 65 63 6f 6e 64 73 2e 20 53 65 65 20 6d 65 seconds. See me
10490 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 6c 61 gatest.config la
104a0 75 6e 63 68 2d 64 65 6c 61 79 20 73 65 74 74 69 unch-delay setti
104b0 6e 67 20 74 6f 20 61 64 6a 75 73 74 2e 22 29 29 ng to adjust."))
104c0 20 3b 3b 20 6c 61 75 6e 63 68 20 6f 66 20 22 20 ;; launch of "
104d0 74 65 73 74 2d 6e 61 6d 65 20 22 20 66 6f 72 20 test-name " for
104e0 22 20 28 2d 20 6c 61 75 6e 63 68 2d 64 65 6c 61 " (- launch-dela
104f0 79 20 64 65 6c 74 61 29 20 22 20 73 65 63 6f 6e y delta) " secon
10500 64 73 22 29 29 0a 09 20 20 20 20 28 74 68 72 65 ds")).. (thre
10510 61 64 2d 73 6c 65 65 70 21 20 28 2d 20 6c 61 75 ad-sleep! (- lau
10520 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 29 nch-delay delta)
10530 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 2d 20 ).. (loop (-
10540 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
10550 29 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 2a 29 ) *last-launch*)
10560 20 6c 61 75 6e 63 68 2d 64 65 6c 61 79 29 29 29 launch-delay)))
10570 29 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 ). (change-di
10580 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
10590 2a 29 0a 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 *). (alist->e
105a0 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 6f nv-vars ;; conso
105b0 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f 64 65 lidate this code
105c0 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 20 69 with the code i
105d0 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 66 n megatest.scm f
105e0 6f 72 20 22 2d 65 78 65 63 75 74 65 22 2c 20 2a or "-execute", *
105f0 6d 61 79 62 65 2a 20 2d 20 74 68 65 20 6c 6f 6e maybe* - the lon
10600 67 65 72 20 74 68 65 79 20 61 72 65 20 73 65 74 ger they are set
10610 20 74 68 65 20 6c 6f 6e 67 65 72 20 65 61 63 68 the longer each
10620 20 6c 61 75 6e 63 68 20 74 61 6b 65 73 20 28 6d launch takes (m
10630 75 73 74 20 62 65 20 6e 6f 6e 2d 6f 76 65 72 6c ust be non-overl
10640 61 70 70 69 6e 67 20 77 69 74 68 20 74 68 65 20 apping with the
10650 76 61 72 73 29 0a 20 20 20 20 20 28 61 70 70 65 vars). (appe
10660 6e 64 0a 20 20 20 20 20 20 28 6c 69 73 74 0a 20 nd. (list.
10670 20 20 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f (list "MT_
10680 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a RUN_AREA_HOME" *
10690 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 20 toppath*).
106a0 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 5f (list "MT_TEST_
106b0 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 NAME" test-name)
106c0 0a 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 4d . (list "M
106d0 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e T_RUNNAME" run
106e0 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 28 6c 69 name). (li
106f0 73 74 20 22 4d 54 5f 49 54 45 4d 50 41 54 48 22 st "MT_ITEMPATH"
10700 20 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 20 item-path).
10710 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 43 4f (list "MT_CO
10720 4e 54 4f 55 52 22 20 20 20 63 6f 6e 74 6f 75 72 NTOUR" contour
10730 29 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ). ).
10740 20 69 74 65 6d 64 61 74 29 29 0a 20 20 20 20 28 itemdat)). (
10750 6c 65 74 2a 20 28 28 74 72 65 67 69 73 74 72 79 let* ((tregistry
10760 20 20 20 20 20 20 20 28 74 65 73 74 73 3a 67 65 (tests:ge
10770 74 2d 61 6c 6c 29 29 20 3b 3b 20 74 68 69 72 64 t-all)) ;; third
10780 20 70 61 72 61 6d 20 28 62 65 6c 6f 77 29 20 69 param (below) i
10790 73 20 73 79 73 74 65 6d 2d 61 6c 6c 6f 77 65 64 s system-allowed
107a0 0a 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 66 . ;; f
107b0 6f 72 20 74 63 6f 6e 66 69 67 2c 20 77 68 79 20 or tconfig, why
107c0 64 6f 20 77 65 20 61 6c 6c 6f 77 20 66 61 6c 6c do we allow fall
107d0 62 61 63 6b 20 74 6f 20 74 65 73 74 2d 63 6f 6e back to test-con
107e0 66 3f 0a 09 20 20 20 28 74 63 6f 6e 66 69 67 20 f?.. (tconfig
107f0 20 20 20 20 20 20 20 20 28 6f 72 20 28 74 65 73 (or (tes
10800 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 ts:get-testconfi
10810 67 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d g test-name item
10820 2d 70 61 74 68 20 74 72 65 67 69 73 74 72 79 20 -path tregistry
10830 23 74 20 66 6f 72 63 65 2d 63 72 65 61 74 65 3a #t force-create:
10840 20 23 74 29 0a 09 09 09 09 28 62 65 67 69 6e 0a #t).....(begin.
10850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10870 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
10880 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
10890 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 66 61 rt* "WARNING: fa
108a0 6c 6c 69 6e 67 20 62 61 63 6b 20 74 6f 20 70 72 lling back to pr
108b0 65 2d 63 61 6c 63 75 6c 61 74 65 64 20 74 65 73 e-calculated tes
108c0 74 63 6f 6e 66 69 67 2e 20 54 68 69 73 20 69 73 tconfig. This is
108d0 20 6c 69 6b 65 6c 79 20 6e 6f 74 20 64 65 73 69 likely not desi
108e0 72 65 64 2e 22 29 0a 20 20 20 20 20 20 20 20 20 red.").
108f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10900 20 20 20 20 20 20 20 20 20 74 65 73 74 2d 63 6f test-co
10910 6e 66 29 29 29 20 3b 3b 20 66 6f 72 63 65 20 72 nf))) ;; force r
10920 65 2d 72 65 61 64 20 6e 6f 77 20 74 68 61 74 20 e-read now that
10930 61 6c 6c 20 76 61 72 73 20 61 72 65 20 73 65 74 all vars are set
10940 0a 09 20 20 20 28 75 73 65 73 68 65 6c 6c 20 20 .. (useshell
10950 20 20 20 20 20 20 28 6c 65 74 20 28 28 75 73 68 (let ((ush
10960 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
10970 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
10980 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 73 65 73 tools" "uses
10990 68 65 6c 6c 22 29 29 29 0a 09 09 09 20 20 20 20 hell")))....
109a0 20 20 28 69 66 20 75 73 68 20 0a 09 09 09 09 20 (if ush .....
109b0 20 28 69 66 20 28 65 71 75 61 6c 3f 20 75 73 68 (if (equal? ush
109c0 20 22 6e 6f 22 29 20 3b 3b 20 6d 75 73 74 20 75 "no") ;; must u
109d0 73 65 20 22 6e 6f 22 20 74 6f 20 4e 4f 54 20 75 se "no" to NOT u
109e0 73 65 20 73 68 65 6c 6c 0a 09 09 09 09 20 20 20 se shell.....
109f0 20 20 20 23 66 0a 09 09 09 09 20 20 20 20 20 20 #f.....
10a00 75 73 68 29 0a 09 09 09 09 20 20 23 74 29 29 29 ush)..... #t)))
10a10 20 20 20 20 20 3b 3b 20 64 65 66 61 75 6c 74 20 ;; default
10a20 69 73 20 79 65 73 0a 09 20 20 20 28 72 75 6e 73 is yes.. (runs
10a30 63 72 69 70 74 20 20 20 20 20 20 20 28 63 6f 6e cript (con
10a40 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 fig-lookup tconf
10a50 69 67 20 20 20 22 73 65 74 75 70 22 20 20 20 20 ig "setup"
10a60 20 20 20 20 22 72 75 6e 73 63 72 69 70 74 22 29 "runscript")
10a70 29 0a 09 20 20 20 28 65 7a 73 74 65 70 73 20 20 ).. (ezsteps
10a80 20 20 20 20 20 20 20 28 3e 20 28 6c 65 6e 67 74 (> (lengt
10a90 68 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 h (hash-table-re
10aa0 66 2f 64 65 66 61 75 6c 74 20 74 63 6f 6e 66 69 f/default tconfi
10ab0 67 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 g "ezsteps" '())
10ac0 29 20 30 29 29 20 3b 3b 20 64 6f 6e 27 74 20 73 ) 0)) ;; don't s
10ad0 65 6e 64 20 61 6c 6c 20 74 68 65 20 73 74 65 70 end all the step
10ae0 73 2c 20 63 6f 75 6c 64 20 62 65 20 62 69 67 0a s, could be big.
10af0 09 20 20 20 3b 3b 20 28 64 69 73 6b 73 70 61 63 . ;; (diskspac
10b00 65 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d e (config-
10b10 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 lookup tconfig
10b20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 "requirements"
10b30 22 64 69 73 6b 73 70 61 63 65 22 29 29 0a 09 20 "diskspace"))..
10b40 20 20 3b 3b 20 28 6d 65 6d 6f 72 79 20 20 20 20 ;; (memory
10b50 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f (config-lo
10b60 6f 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 20 22 okup tconfig "
10b70 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 6d requirements" "m
10b80 65 6d 6f 72 79 22 29 29 0a 09 20 20 20 3b 3b 20 emory")).. ;;
10b90 28 68 6f 73 74 73 20 20 20 20 20 20 20 20 20 20 (hosts
10ba0 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
10bb0 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
10bc0 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b tools" "work
10bd0 68 6f 73 74 73 22 29 29 20 3b 3b 20 49 27 6d 20 hosts")) ;; I'm
10be0 70 72 65 74 74 79 20 73 75 72 65 20 74 68 69 73 pretty sure this
10bf0 20 77 61 73 20 6e 65 76 65 72 20 63 6f 6d 70 6c was never compl
10c00 65 74 65 64 0a 09 20 20 20 28 72 65 6d 6f 74 65 eted.. (remote
10c10 2d 6d 65 67 61 74 65 73 74 20 28 63 6f 6e 66 69 -megatest (confi
10c20 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 g-lookup *config
10c30 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 65 78 dat* "setup" "ex
10c40 65 63 75 74 61 62 6c 65 22 29 29 0a 09 20 20 20 ecutable"))..
10c50 28 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 20 (run-time-limit
10c60 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
10c70 6f 6b 75 70 20 20 74 63 6f 6e 66 69 67 20 20 20 okup tconfig
10c80 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 "requirements" "
10c90 72 75 6e 74 69 6d 65 6c 69 6d 22 29 0a 09 09 09 runtimelim")....
10ca0 09 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 .(configf:lookup
10cb0 20 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 *configdat* "s
10cc0 65 74 75 70 22 20 22 72 75 6e 74 69 6d 65 6c 69 etup" "runtimeli
10cd0 6d 22 29 29 29 0a 09 20 20 20 3b 3b 20 46 49 58 m"))).. ;; FIX
10ce0 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 ME SOMEDAY: not
10cf0 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 69 73 good how this is
10d00 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 69 73 so obtuse, this
10d10 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 20 20 hack is to ..
10d20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
10d30 20 20 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 allow running
10d40 20 66 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e from dashboard.
10d50 20 45 78 74 72 61 63 74 20 74 68 65 20 70 61 74 Extract the pat
10d60 68 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 h.. ;;
10d70 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 68 65 from the
10d80 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 73 74 called megatest
10d90 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 61 73 and convert das
10da0 68 62 6f 61 72 64 0a 09 20 20 20 3b 3b 20 20 20 hboard.. ;;
10db0 20 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 . or
10dc0 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 dboard to megate
10dd0 73 74 0a 09 20 20 20 28 6c 6f 63 61 6c 2d 6d 65 st.. (local-me
10de0 67 61 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 gatest (let* ((
10df0 6c 6d 20 20 28 63 61 72 20 28 61 72 67 76 29 29 lm (car (argv))
10e00 29 0a 09 09 09 09 20 20 20 28 64 69 72 20 28 70 )..... (dir (p
10e10 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 athname-director
10e20 79 20 6c 6d 29 29 0a 09 09 09 09 20 20 20 28 65 y lm))..... (e
10e30 78 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 xe (pathname-str
10e40 69 70 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 ip-directory lm)
10e50 29 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e )).... (con
10e60 63 20 28 69 66 20 64 69 72 20 28 63 6f 6e 63 20 c (if dir (conc
10e70 64 69 72 20 22 2f 22 29 20 22 22 29 0a 09 09 09 dir "/") "")....
10e80 09 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 . (case (stri
10e90 6e 67 2d 3e 73 79 6d 62 6f 6c 20 65 78 65 29 0a ng->symbol exe).
10ea0 09 09 09 09 20 20 20 20 20 20 28 28 64 62 6f 61 .... ((dboa
10eb0 72 64 29 20 20 20 20 22 2e 2e 2f 6d 65 67 61 74 rd) "../megat
10ec0 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 20 20 est").....
10ed0 28 28 6d 74 65 73 74 29 20 20 20 20 20 22 2e 2e ((mtest) "..
10ee0 2f 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 /megatest").....
10ef0 20 20 20 20 20 20 28 28 64 61 73 68 62 6f 61 72 ((dashboar
10f00 64 29 20 22 6d 65 67 61 74 65 73 74 22 29 0a 09 d) "megatest")..
10f10 09 09 09 20 20 20 20 20 20 28 65 6c 73 65 20 65 ... (else e
10f20 78 65 29 29 29 29 29 0a 09 20 20 20 28 6c 61 75 xe))))).. (lau
10f30 6e 63 68 65 72 20 20 20 20 20 20 20 20 28 63 6f ncher (co
10f40 6d 6d 6f 6e 3a 67 65 74 2d 6c 61 75 6e 63 68 65 mmon:get-launche
10f50 72 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 65 r *configdat* te
10f60 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
10f70 68 29 29 20 3b 3b 20 28 63 6f 6e 66 69 67 2d 6c h)) ;; (config-l
10f80 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
10f90 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 * "jobtools"
10fa0 20 22 6c 61 75 6e 63 68 65 72 22 29 29 0a 09 20 "launcher"))..
10fb0 20 20 28 74 65 73 74 2d 73 69 67 20 20 20 20 20 (test-sig
10fc0 20 20 20 28 63 6f 6e 63 20 28 63 6f 6d 6d 6f 6e (conc (common
10fd0 3a 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e :get-testsuite-n
10fe0 61 6d 65 29 20 22 3a 22 20 74 65 73 74 2d 6e 61 ame) ":" test-na
10ff0 6d 65 20 22 3a 22 20 69 74 65 6d 2d 70 61 74 68 me ":" item-path
11000 29 29 20 3b 3b 20 28 69 74 65 6d 2d 6c 69 73 74 )) ;; (item-list
11010 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
11020 29 20 3b 3b 20 74 65 73 74 2d 70 61 74 68 20 69 ) ;; test-path i
11030 73 20 74 68 65 20 66 75 6c 6c 20 70 61 74 68 20 s the full path
11040 69 6e 63 6c 75 64 69 6e 67 20 74 68 65 20 69 74 including the it
11050 65 6d 2d 70 61 74 68 0a 09 20 20 20 28 77 6f 72 em-path.. (wor
11060 6b 2d 61 72 65 61 20 20 20 20 20 20 20 23 66 29 k-area #f)
11070 0a 09 20 20 20 28 74 6f 70 74 65 73 74 2d 77 6f .. (toptest-wo
11080 72 6b 2d 61 72 65 61 20 23 66 29 20 3b 3b 20 66 rk-area #f) ;; f
11090 6f 72 20 69 74 65 72 61 74 65 64 20 74 65 73 74 or iterated test
110a0 73 20 74 68 65 20 74 6f 70 20 74 65 73 74 20 63 s the top test c
110b0 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 72 65 6c ontains data rel
110c0 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c 0a 09 20 evant for all..
110d0 20 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 66 (diskpath #f
110e0 29 0a 09 20 20 20 28 63 6d 64 70 61 72 6d 73 20 ).. (cmdparms
110f0 20 20 23 66 29 0a 09 20 20 20 28 66 75 6c 6c 63 #f).. (fullc
11100 6d 64 20 20 20 20 23 66 29 20 3b 3b 20 28 64 65 md #f) ;; (de
11110 66 69 6e 65 20 61 20 28 77 69 74 68 2d 6f 75 74 fine a (with-out
11120 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c put-to-string (l
11130 61 6d 62 64 61 20 28 29 28 77 72 69 74 65 20 78 ambda ()(write x
11140 29 29 29 29 0a 09 20 20 20 28 6d 74 2d 62 69 6e )))).. (mt-bin
11150 64 69 72 2d 70 61 74 68 20 23 66 29 0a 09 20 20 dir-path #f)..
11160 20 28 74 65 73 74 69 6e 66 6f 20 20 20 28 72 6d (testinfo (rm
11170 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d t:get-test-info-
11180 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 73 by-id run-id tes
11190 74 2d 69 64 29 29 0a 09 20 20 20 28 6d 74 5f 74 t-id)).. (mt_t
111a0 61 72 67 65 74 20 20 28 73 74 72 69 6e 67 2d 69 arget (string-i
111b0 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 ntersperse (map
111c0 63 61 64 72 20 6b 65 79 76 61 6c 73 29 20 22 2f cadr keyvals) "/
111d0 22 29 29 0a 09 20 20 20 28 64 65 62 75 67 2d 70 ")).. (debug-p
111e0 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 66 aram (append (if
111f0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
11200 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 20 -debug") (list
11210 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a 67 "-debug" (args:g
11220 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 et-arg "-debug")
11230 29 20 27 28 29 29 0a 09 09 09 09 28 69 66 20 28 ) '()).....(if (
11240 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6c args:get-arg "-l
11250 6f 67 67 69 6e 67 22 29 28 6c 69 73 74 20 22 2d ogging")(list "-
11260 6c 6f 67 67 69 6e 67 22 29 20 27 28 29 29 29 29 logging") '())))
11270 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 68 ). ;; (if h
11280 6f 73 74 73 20 28 73 65 74 21 20 68 6f 73 74 73 osts (set! hosts
11290 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 68 (string-split h
112a0 6f 73 74 73 29 29 29 0a 20 20 20 20 20 20 3b 3b osts))). ;;
112b0 20 73 65 74 20 74 68 65 20 6d 65 67 61 74 65 73 set the megates
112c0 74 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 20 6f t to be called o
112d0 6e 20 74 68 65 20 72 65 6d 6f 74 65 20 68 6f 73 n the remote hos
112e0 74 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 t. (if (not
112f0 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
11300 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d 6d 65 )(set! remote-me
11310 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 67 gatest local-meg
11320 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 67 61 atest)) ;; "mega
11330 74 65 73 74 22 29 29 0a 20 20 20 20 20 20 28 73 test")). (s
11340 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 et! mt-bindir-pa
11350 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 th (pathname-dir
11360 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 ectory remote-me
11370 67 61 74 65 73 74 29 29 0a 20 20 20 20 20 20 28 gatest)). (
11380 69 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 if launcher (set
11390 21 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 ! launcher (stri
113a0 6e 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 ng-split launche
113b0 72 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 73 65 r))). ;; se
113c0 74 20 75 70 20 74 68 65 20 72 75 6e 20 77 6f 72 t up the run wor
113d0 6b 20 61 72 65 61 20 66 6f 72 20 74 68 69 73 20 k area for this
113e0 74 65 73 74 0a 20 20 20 20 20 20 28 69 66 20 28 test. (if (
113f0 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
11400 67 20 22 2d 70 72 65 63 6c 65 61 6e 22 29 20 3b g "-preclean") ;
11410 3b 20 75 73 65 72 20 68 61 73 20 72 65 71 75 65 ; user has reque
11420 73 74 65 64 20 74 6f 20 70 72 65 63 6c 65 61 6e sted to preclean
11430 20 66 6f 72 20 74 68 69 73 20 72 75 6e 0a 09 20 for this run..
11440 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 (not (memb
11450 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d er (db:test-get-
11460 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 rundir testinfo)
11470 28 6c 69 73 74 20 22 6e 2f 61 22 20 22 2f 74 6d (list "n/a" "/tm
11480 70 2f 62 61 64 6e 61 6d 65 22 29 29 29 29 20 3b p/badname")))) ;
11490 3b 20 6e 2f 61 20 69 73 20 61 20 70 6c 61 63 65 ; n/a is a place
114a0 68 6f 6c 64 65 72 20 61 6e 64 20 74 68 75 73 20 holder and thus
114b0 6e 6f 74 20 61 20 72 65 61 64 20 64 69 72 0a 09 not a read dir..
114c0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
114d0 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
114e0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
114f0 6f 72 74 2a 20 22 61 74 74 65 6d 70 74 69 6e 67 ort* "attempting
11500 20 74 6f 20 70 72 65 63 6c 65 61 6e 20 64 69 72 to preclean dir
11510 65 63 74 6f 72 79 20 22 20 28 64 62 3a 74 65 73 ectory " (db:tes
11520 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes
11530 74 69 6e 66 6f 29 20 22 20 66 6f 72 20 74 65 73 tinfo) " for tes
11540 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 2f t " test-name "/
11550 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 20 20 " item-path)..
11560 20 20 28 72 75 6e 73 3a 72 65 6d 6f 76 65 2d 74 (runs:remove-t
11570 65 73 74 2d 64 69 72 65 63 74 6f 72 79 20 74 65 est-directory te
11580 73 74 69 6e 66 6f 20 27 72 65 6d 6f 76 65 2d 64 stinfo 'remove-d
11590 61 74 61 2d 6f 6e 6c 79 29 29 29 20 3b 3b 20 72 ata-only))) ;; r
115a0 65 6d 6f 76 65 20 64 61 74 61 20 6f 6e 6c 79 2c emove data only,
115b0 20 64 6f 20 6e 6f 74 20 70 65 72 74 75 72 62 20 do not perturb
115c0 74 68 65 20 72 65 63 6f 72 64 0a 20 20 20 20 20 the record.
115d0 20 0a 20 20 20 20 20 20 3b 3b 20 70 72 65 76 65 . ;; preve
115e0 6e 74 20 6f 76 65 72 6c 61 70 70 69 6e 67 20 61 nt overlapping a
115f0 63 74 69 6f 6e 73 20 2d 20 73 65 74 20 74 6f 20 ctions - set to
11600 4c 41 55 4e 43 48 45 44 20 61 73 20 65 61 72 6c LAUNCHED as earl
11610 79 20 61 73 20 70 6f 73 73 69 62 6c 65 0a 20 20 y as possible.
11620 20 20 20 20 3b 3b 0a 20 20 20 20 20 20 3b 3b 20 ;;. ;;
11630 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 61 the following ca
11640 6c 6c 20 68 61 6e 64 6c 65 73 20 77 61 69 76 65 ll handles waive
11650 72 20 70 72 6f 70 6f 67 61 74 69 6f 6e 2e 20 63 r propogation. c
11660 61 6e 6e 6f 74 20 79 65 74 20 63 6f 6e 64 65 6e annot yet conden
11670 73 65 20 69 6e 74 6f 20 72 6f 6c 6c 2d 75 70 2d se into roll-up-
11680 70 61 73 73 2d 66 61 69 6c 0a 20 20 20 20 20 20 pass-fail.
11690 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
116a0 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
116b0 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 est-id "LAUNCHED
116c0 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b " "n/a" #f #f) ;
116d0 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 ; (if launch-res
116e0 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 ults launch-resu
116f0 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 lts "FAILED")).
11700 20 20 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 (rmt:set-st
11710 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
11720 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e oll-up-items run
11730 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
11740 65 6d 2d 70 61 74 68 20 23 66 20 22 4c 41 55 4e em-path #f "LAUN
11750 43 48 45 44 22 20 23 66 29 0a 20 20 20 20 20 20 CHED" #f).
11760 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 ;; (pp (hash-tab
11770 6c 65 2d 3e 61 6c 69 73 74 20 74 63 6f 6e 66 69 le->alist tconfi
11780 67 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 g)). (set!
11790 64 69 73 6b 70 61 74 68 20 28 67 65 74 2d 62 65 diskpath (get-be
117a0 73 74 2d 64 69 73 6b 20 2a 63 6f 6e 66 69 67 64 st-disk *configd
117b0 61 74 2a 20 74 63 6f 6e 66 69 67 29 29 0a 20 20 at* tconfig)).
117c0 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 68 (if diskpath
117d0 0a 09 20 20 28 6c 65 74 20 28 28 64 61 74 20 20 .. (let ((dat
117e0 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 (create-work-are
117f0 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 a run-id run-inf
11800 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 2d 69 o keyvals test-i
11810 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b d test-path disk
11820 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 path test-name i
11830 74 65 6d 64 61 74 29 29 29 0a 09 20 20 20 20 28 temdat))).. (
11840 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
11850 63 61 72 20 64 61 74 29 29 0a 09 20 20 20 20 28 car dat)).. (
11860 73 65 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 set! toptest-wor
11870 6b 2d 61 72 65 61 20 28 63 61 64 72 20 64 61 74 k-area (cadr dat
11880 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 )).. (debug:p
11890 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 rint-info 2 *def
118a0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
118b0 55 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 61 20 Using work area
118c0 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 " work-area))..
118d0 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 (begin.. (se
118e0 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f t! work-area (co
118f0 6e 63 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 nc test-path "/t
11900 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 20 20 28 mp_run")).. (
11910 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
11920 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 work-area #t)..
11930 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
11940 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
11950 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
11960 4e 6f 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 No disk work are
11970 61 20 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 a specified - ru
11980 6e 6e 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 nning in the tes
11990 74 20 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 t directory unde
119a0 72 20 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 r tmp_run"))).
119b0 20 20 20 20 28 73 65 74 21 20 63 6d 64 70 61 72 (set! cmdpar
119c0 6d 73 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 ms (base64:base6
119d0 34 2d 65 6e 63 6f 64 65 20 0a 09 09 20 20 20 20 4-encode ...
119e0 20 20 28 7a 33 3a 65 6e 63 6f 64 65 2d 62 75 66 (z3:encode-buf
119f0 66 65 72 20 0a 09 09 20 20 20 20 20 20 20 28 77 fer ... (w
11a00 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 ith-output-to-st
11a10 72 69 6e 67 0a 09 09 09 20 28 6c 61 6d 62 64 61 ring.... (lambda
11a20 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f () ;; (list 'ho
11a30 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 sts hosts)..
11a40 09 09 20 20 20 28 77 72 69 74 65 20 28 6c 69 73 .. (write (lis
11a50 74 20 28 6c 69 73 74 20 27 74 65 73 74 70 61 74 t (list 'testpat
11a60 68 20 20 74 65 73 74 2d 70 61 74 68 29 0a 09 09 h test-path)...
11a70 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 74 72 61 ...;; (list 'tra
11a80 6e 73 70 6f 72 74 20 28 63 6f 6e 63 20 2a 74 72 nsport (conc *tr
11a90 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 29 29 0a ansport-type*)).
11aa0 09 09 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 73 .....;; (list 's
11ab0 65 72 76 65 72 69 6e 66 20 2a 73 65 72 76 65 72 erverinf *server
11ac0 2d 69 6e 66 6f 2a 29 0a 09 09 09 09 09 28 6c 69 -info*)......(li
11ad0 73 74 20 27 68 6f 6d 65 68 6f 73 74 20 20 28 6c st 'homehost (l
11ae0 65 74 2a 20 28 28 68 68 64 61 74 20 28 63 6f 6d et* ((hhdat (com
11af0 6d 6f 6e 3a 67 65 74 2d 68 6f 6d 65 68 6f 73 74 mon:get-homehost
11b00 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 69 )))........ (i
11b10 66 20 68 68 64 61 74 0a 09 09 09 09 09 09 09 20 f hhdat........
11b20 20 20 20 20 20 20 28 63 61 72 20 68 68 64 61 74 (car hhdat
11b30 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 )........
11b40 23 66 29 29 29 0a 09 09 09 09 09 28 6c 69 73 74 #f)))......(list
11b50 20 27 73 65 72 76 65 72 75 72 6c 20 28 69 66 20 'serverurl (if
11b60 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 09 09 09 09 *runremote*.....
11b70 09 09 09 20 20 20 20 20 28 72 65 6d 6f 74 65 2d ... (remote-
11b80 73 65 72 76 65 72 2d 75 72 6c 20 2a 72 75 6e 72 server-url *runr
11b90 65 6d 6f 74 65 2a 29 0a 09 09 09 09 09 09 09 20 emote*)........
11ba0 20 20 20 20 23 66 29 29 20 3b 3b 0a 09 09 09 09 #f)) ;;.....
11bb0 09 28 6c 69 73 74 20 27 61 72 65 61 6e 61 6d 65 .(list 'areaname
11bc0 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 (common:get-te
11bd0 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 0a 09 stsuite-name))..
11be0 09 09 09 09 28 6c 69 73 74 20 27 74 6f 70 70 61 ....(list 'toppa
11bf0 74 68 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a th *toppath*).
11c00 09 09 09 09 09 28 6c 69 73 74 20 27 77 6f 72 6b .....(list 'work
11c10 2d 61 72 65 61 20 77 6f 72 6b 2d 61 72 65 61 29 -area work-area)
11c20 0a 09 09 09 09 09 28 6c 69 73 74 20 27 74 65 73 ......(list 'tes
11c30 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 t-name test-name
11c40 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 27 72 ) ......(list 'r
11c50 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
11c60 70 74 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 pt) ......(list
11c70 27 72 75 6e 2d 69 64 20 20 20 20 72 75 6e 2d 69 'run-id run-i
11c80 64 20 20 20 29 0a 09 09 09 09 09 28 6c 69 73 74 d )......(list
11c90 20 27 74 65 73 74 2d 69 64 20 20 20 74 65 73 74 'test-id test
11ca0 2d 69 64 20 20 29 0a 09 09 09 09 09 3b 3b 20 28 -id )......;; (
11cb0 6c 69 73 74 20 27 69 74 65 6d 2d 70 61 74 68 20 list 'item-path
11cc0 69 74 65 6d 2d 70 61 74 68 20 29 0a 09 09 09 09 item-path ).....
11cd0 09 28 6c 69 73 74 20 27 69 74 65 6d 64 61 74 20 .(list 'itemdat
11ce0 20 20 69 74 65 6d 64 61 74 20 20 29 0a 09 09 09 itemdat )....
11cf0 09 09 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 ..(list 'megates
11d00 74 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 t remote-megate
11d10 73 74 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 st)......(list '
11d20 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 65 70 ezsteps ezstep
11d30 73 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 27 s) ......(list '
11d40 74 61 72 67 65 74 20 20 20 20 6d 74 5f 74 61 72 target mt_tar
11d50 67 65 74 29 0a 09 09 09 09 09 28 6c 69 73 74 20 get)......(list
11d60 27 63 6f 6e 74 6f 75 72 20 20 20 63 6f 6e 74 6f 'contour conto
11d70 75 72 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 ur)......(list '
11d80 72 75 6e 74 6c 69 6d 20 20 20 28 69 66 20 72 75 runtlim (if ru
11d90 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 20 28 63 6f n-time-limit (co
11da0 6d 6d 6f 6e 3a 68 6d 73 2d 73 74 72 69 6e 67 2d mmon:hms-string-
11db0 3e 73 65 63 6f 6e 64 73 20 72 75 6e 2d 74 69 6d >seconds run-tim
11dc0 65 2d 6c 69 6d 69 74 29 20 23 66 29 29 0a 09 09 e-limit) #f))...
11dd0 09 09 09 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 ...(list 'env-ov
11de0 72 64 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d rd (hash-table-
11df0 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e ref/default *con
11e00 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 figdat* "env-ove
11e10 72 72 69 64 65 22 20 27 28 29 29 29 20 0a 09 09 rride" '())) ...
11e20 09 09 09 28 6c 69 73 74 20 27 73 65 74 2d 76 61 ...(list 'set-va
11e30 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 20 28 rs (if params (
11e40 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 hash-table-ref/d
11e50 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 22 2d efault params "-
11e60 73 65 74 76 61 72 73 22 20 23 66 29 29 29 0a 09 setvars" #f)))..
11e70 09 09 09 09 28 6c 69 73 74 20 27 72 75 6e 6e 61 ....(list 'runna
11e80 6d 65 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 me runname)...
11e90 09 09 09 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e ...(list 'mt-bin
11ea0 64 69 72 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 dir-path mt-bind
11eb0 69 72 2d 70 61 74 68 29 29 29 29 29 29 29 29 0a ir-path)))))))).
11ec0 20 20 20 20 20 20 0a 20 20 20 20 20 20 3b 3b 20 . ;;
11ed0 63 6c 65 61 6e 20 6f 75 74 20 73 74 65 70 20 72 clean out step r
11ee0 65 63 6f 72 64 73 20 66 72 6f 6d 20 70 72 65 76 ecords from prev
11ef0 69 6f 75 73 20 72 75 6e 20 69 66 20 74 68 65 79 ious run if they
11f00 20 65 78 69 73 74 0a 20 20 20 20 20 20 3b 3b 20 exist. ;;
11f10 28 72 6d 74 3a 64 65 6c 65 74 65 2d 74 65 73 74 (rmt:delete-test
11f20 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 20 72 75 -step-records ru
11f30 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 20 n-id test-id).
11f40 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 64 69 ;; if the di
11f50 72 20 64 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 r does not exist
11f60 20 77 65 20 6d 61 79 20 68 61 76 65 20 61 20 69 we may have a i
11f70 74 65 6d 70 61 74 68 20 77 68 65 72 65 20 69 6e tempath where in
11f80 64 69 76 69 64 75 61 6c 20 76 61 72 69 61 62 6c dividual variabl
11f90 65 73 20 61 72 65 20 61 20 70 61 74 68 2c 20 6c es are a path, l
11fa0 61 75 6e 63 68 20 61 6e 79 77 61 79 0a 20 20 20 aunch anyway.
11fb0 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 (if (common:f
11fc0 69 6c 65 2d 65 78 69 73 74 73 3f 20 77 6f 72 6b ile-exists? work
11fd0 2d 61 72 65 61 29 0a 09 20 20 28 63 68 61 6e 67 -area).. (chang
11fe0 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
11ff0 2d 61 72 65 61 29 29 20 3b 3b 20 73 6f 20 74 68 -area)) ;; so th
12000 61 74 20 6c 6f 67 20 66 69 6c 65 73 20 66 72 6f at log files fro
12010 6d 20 74 68 65 20 6c 61 75 6e 63 68 20 70 72 6f m the launch pro
12020 63 65 73 73 20 64 6f 6e 27 74 20 63 6c 75 74 74 cess don't clutt
12030 65 72 20 74 68 65 20 74 65 73 74 20 64 69 72 0a er the test dir.
12040 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
12050 20 20 20 3b 3b 20 28 28 61 6e 64 20 6c 61 75 6e ;; ((and laun
12060 63 68 65 72 20 68 6f 73 74 73 29 20 3b 3b 20 6d cher hosts) ;; m
12070 75 73 74 20 62 65 20 75 73 69 6e 67 20 73 73 68 ust be using ssh
12080 20 68 6f 73 74 6e 61 6d 65 0a 20 20 20 20 20 20 hostname.
12090 20 3b 3b 20 20 20 20 28 73 65 74 21 20 66 75 6c ;; (set! ful
120a0 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
120b0 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 73 ncher (car hosts
120c0 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 )(list remote-me
120d0 67 61 74 65 73 74 20 22 2d 6d 22 20 74 65 73 74 gatest "-m" test
120e0 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
120f0 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
12100 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 20 20 param))).
12110 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
12120 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
12130 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 r (car hosts)(li
12140 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
12150 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
12160 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 ecute" cmdparms)
12170 29 29 29 0a 20 20 20 20 20 20 20 28 6c 61 75 6e ))). (laun
12180 63 68 65 72 0a 09 28 73 65 74 21 20 66 75 6c 6c cher..(set! full
12190 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e cmd (append laun
121a0 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 cher (list remot
121b0 65 2d 6d 65 67 61 74 65 73 74 20 22 2d 6d 22 20 e-megatest "-m"
121c0 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 test-sig "-execu
121d0 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 te" cmdparms) de
121e0 62 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 bug-param))).
121f0 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c ;; (set! ful
12200 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
12210 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f ncher (list remo
12220 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
12230 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
12240 63 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 cmdparms)))).
12250 20 20 20 20 28 65 6c 73 65 0a 09 28 69 66 20 28 (else..(if (
12260 6e 6f 74 20 75 73 65 73 68 65 6c 6c 29 28 64 65 not useshell)(de
12270 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
12280 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12290 57 41 52 4e 49 4e 47 3a 20 69 6e 74 65 72 6e 61 WARNING: interna
122a0 6c 20 6c 61 75 6e 63 68 69 6e 67 20 77 69 6c 6c l launching will
122b0 20 6e 6f 74 20 77 6f 72 6b 20 77 65 6c 6c 20 77 not work well w
122c0 69 74 68 6f 75 74 20 5c 22 75 73 65 73 68 65 6c ithout \"useshel
122d0 6c 20 79 65 73 5c 22 20 69 6e 20 79 6f 75 72 20 l yes\" in your
122e0 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 73 65 63 74 69 [jobtools] secti
122f0 6f 6e 22 29 29 0a 09 28 73 65 74 21 20 66 75 6c on"))..(set! ful
12300 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 28 6c 69 lcmd (append (li
12310 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
12320 73 74 20 22 2d 6d 22 20 74 65 73 74 2d 73 69 67 st "-m" test-sig
12330 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
12340 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
12350 6d 20 28 6c 69 73 74 20 28 69 66 20 75 73 65 73 m (list (if uses
12360 68 65 6c 6c 20 22 26 22 20 22 22 29 29 29 29 29 hell "&" "")))))
12370 29 0a 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 ). ;; (set!
12380 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 72 fullcmd (list r
12390 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
123a0 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
123b0 65 22 20 63 6d 64 70 61 72 6d 73 20 28 69 66 20 e" cmdparms (if
123c0 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 29 useshell "&" "")
123d0 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 )))). (if (
123e0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 78 args:get-arg "-x
123f0 74 65 72 6d 22 29 28 73 65 74 21 20 66 75 6c 6c term")(set! full
12400 63 6d 64 20 28 61 70 70 65 6e 64 20 66 75 6c 6c cmd (append full
12410 63 6d 64 20 28 6c 69 73 74 20 22 2d 78 74 65 72 cmd (list "-xter
12420 6d 22 29 29 29 29 0a 20 20 20 20 20 20 28 64 65 m")))). (de
12430 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
12440 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
12450 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b Launching " work
12460 2d 61 72 65 61 29 0a 20 20 20 20 20 20 3b 3b 20 -area). ;;
12470 73 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 set pre-launch-e
12480 6e 76 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c nv-vars before l
12490 61 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 aunching, keep t
124a0 68 65 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 he vars in prevv
124b0 61 6c 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 als and put the
124c0 65 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 envionment back
124d0 77 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 20 20 when done.
124e0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a (debug:print 4 *
124f0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
12500 2a 20 22 66 75 6c 6c 63 6d 64 3a 20 22 20 66 75 * "fullcmd: " fu
12510 6c 6c 63 6d 64 29 0a 20 20 20 20 20 20 28 73 65 llcmd). (se
12520 74 21 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 2a t! *last-launch*
12530 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
12540 73 29 29 20 3b 3b 20 61 6c 6c 20 74 68 61 74 20 s)) ;; all that
12550 6a 75 6e 6b 20 61 62 6f 76 65 20 74 61 6b 65 73 junk above takes
12560 20 74 69 6d 65 2c 20 73 65 74 20 74 68 69 73 20 time, set this
12570 61 73 20 6c 61 74 65 20 61 73 20 70 6f 73 73 69 as late as possi
12580 62 6c 65 2e 0a 20 20 20 20 20 20 28 6c 65 74 2a ble.. (let*
12590 20 28 28 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c ((commonprevval
125a0 73 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 s (alist->env-va
125b0 72 73 0a 09 09 09 20 20 20 20 20 20 28 68 61 73 rs.... (has
125c0 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
125d0 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 ult *configdat*
125e0 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 27 "env-override" '
125f0 28 29 29 29 29 0a 09 20 20 20 20 20 28 6d 69 73 ()))).. (mis
12600 63 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c 69 cprevvals (ali
12610 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 st->env-vars ;;
12620 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 69 73 consolidate this
12630 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 20 63 code with the c
12640 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 74 2e ode in megatest.
12650 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 75 74 scm for "-execut
12660 65 22 0a 09 09 09 20 20 20 20 20 20 28 61 70 70 e".... (app
12670 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 73 74 20 end (list (list
12680 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 "MT_TEST_RUN_DIR
12690 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 " work-area)....
126a0 09 09 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f .. (list "MT_
126b0 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 2d TEST_NAME" test-
126c0 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 20 20 28 name)...... (
126d0 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e list "MT_ITEM_IN
126e0 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
126f0 74 29 29 20 0a 09 09 09 09 09 20 20 20 20 28 6c t)) ...... (l
12700 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 ist "MT_RUNNAME"
12710 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 runname).....
12720 09 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 . (list "MT_T
12730 41 52 47 45 54 22 20 20 20 20 6d 74 5f 74 61 72 ARGET" mt_tar
12740 67 65 74 29 0a 09 09 09 09 09 20 20 20 20 28 6c get)...... (l
12750 69 73 74 20 22 4d 54 5f 49 54 45 4d 50 41 54 48 ist "MT_ITEMPATH
12760 22 20 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 09 " item-path)...
12770 09 09 09 20 20 20 20 29 0a 09 09 09 09 20 20 20 ... ).....
12780 20 20 20 69 74 65 6d 64 61 74 29 29 29 0a 09 20 itemdat)))..
12790 20 20 20 20 28 74 65 73 74 70 72 65 76 76 61 6c (testprevval
127a0 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d s (alist->env-
127b0 76 61 72 73 0a 09 09 09 20 20 20 20 20 20 28 68 vars.... (h
127c0 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
127d0 66 61 75 6c 74 20 74 63 6f 6e 66 69 67 20 22 70 fault tconfig "p
127e0 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 re-launch-env-ov
127f0 65 72 72 69 64 65 73 22 20 27 28 29 29 29 29 0a errides" '()))).
12800 09 20 20 20 20 20 3b 3b 20 4c 61 75 6e 63 68 77 . ;; Launchw
12810 61 69 74 20 64 65 66 61 75 6c 74 73 20 74 6f 20 ait defaults to
12820 74 72 75 65 2c 20 6d 75 73 74 20 6f 76 65 72 72 true, must overr
12830 69 64 65 20 69 74 20 74 6f 20 74 75 72 6e 20 6f ide it to turn o
12840 66 66 20 77 61 69 74 0a 09 20 20 20 20 20 28 6c ff wait.. (l
12850 61 75 6e 63 68 77 61 69 74 20 20 20 20 20 28 69 aunchwait (i
12860 66 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 69 f (equal? (confi
12870 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
12880 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c gdat* "setup" "l
12890 61 75 6e 63 68 77 61 69 74 22 29 20 22 6e 6f 22 aunchwait") "no"
128a0 29 20 23 66 20 23 74 29 29 0a 09 20 20 20 20 20 ) #f #t))..
128b0 28 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 (launch-results
128c0 28 61 70 70 6c 79 20 28 69 66 20 6c 61 75 6e 63 (apply (if launc
128d0 68 77 61 69 74 0a 09 09 09 09 09 70 72 6f 63 65 hwait......proce
128e0 73 73 3a 63 6d 64 2d 72 75 6e 2d 77 69 74 68 2d ss:cmd-run-with-
128f0 73 74 64 65 72 72 2d 3e 6c 69 73 74 0a 09 09 09 stderr->list....
12900 09 09 70 72 6f 63 65 73 73 2d 72 75 6e 29 0a 09 ..process-run)..
12910 09 09 09 20 20 20 20 28 69 66 20 75 73 65 73 68 ... (if usesh
12920 65 6c 6c 0a 09 09 09 09 09 28 6c 65 74 20 28 28 ell......(let ((
12930 63 6d 64 73 74 72 20 28 73 74 72 69 6e 67 2d 69 cmdstr (string-i
12940 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
12950 6d 64 20 22 20 22 29 29 29 0a 09 09 09 09 09 20 md " ")))......
12960 20 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 0a (if launchwait.
12970 09 09 09 09 09 20 20 20 20 20 20 63 6d 64 73 74 ..... cmdst
12980 72 0a 09 09 09 09 09 20 20 20 20 20 20 28 63 6f r...... (co
12990 6e 63 20 63 6d 64 73 74 72 20 22 20 3e 3e 20 6d nc cmdstr " >> m
129a0 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 20 32 3e 26 t_launch.log 2>&
129b0 31 20 26 22 29 29 29 0a 09 09 09 09 09 28 63 61 1 &")))......(ca
129c0 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 r fullcmd)).....
129d0 20 20 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c (if useshell
129e0 0a 09 09 09 09 09 27 28 29 0a 09 09 09 09 09 28 ......'()......(
129f0 63 64 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 29 cdr fullcmd)))))
12a00 0a 20 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d . (mutex-
12a10 75 6e 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 2d unlock! *launch-
12a20 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 20 3b 3b setup-mutex*) ;;
12a30 20 79 65 73 2c 20 72 65 61 6c 6c 79 20 73 68 6f yes, really sho
12a40 75 6c 64 20 6d 75 74 65 78 20 61 6c 6c 20 74 68 uld mutex all th
12a50 65 20 77 61 79 20 74 6f 20 68 65 72 65 2e 20 4e e way to here. N
12a60 65 65 64 20 74 6f 20 70 75 74 20 74 68 69 73 20 eed to put this
12a70 65 6e 74 69 72 65 20 70 72 6f 63 65 73 73 20 69 entire process i
12a80 6e 74 6f 20 61 20 66 6f 72 6b 2e 0a 09 3b 3b 20 nto a fork...;;
12a90 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c (rmt:no-sync-del
12aa0 21 20 6c 6f 63 6b 2d 6b 65 79 29 20 20 20 20 20 ! lock-key)
12ab0 20 20 20 20 3b 3b 20 72 65 6c 65 61 73 65 20 74 ;; release t
12ac0 68 65 20 6c 6f 63 6b 20 66 6f 72 20 73 74 61 72 he lock for star
12ad0 74 69 6e 67 20 74 68 69 73 20 74 65 73 74 0a 09 ting this test..
12ae0 28 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 77 (if (not launchw
12af0 61 69 74 29 20 3b 3b 20 67 69 76 65 20 74 68 65 ait) ;; give the
12b00 20 4f 53 20 61 20 6c 69 74 74 6c 65 20 74 69 6d OS a little tim
12b10 65 20 74 6f 20 61 6c 6c 6f 77 20 74 68 65 20 70 e to allow the p
12b20 72 6f 63 65 73 73 20 74 6f 20 73 74 61 72 74 0a rocess to start.
12b30 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 . (thread-sle
12b40 65 70 21 20 30 2e 30 31 29 29 0a 09 28 77 69 74 ep! 0.01))..(wit
12b50 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 h-output-to-file
12b60 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 22 "mt_launch.log"
12b70 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 .. (lambda ()..
12b80 20 20 20 20 28 70 72 69 6e 74 20 22 4c 41 55 4e (print "LAUN
12b90 43 48 43 4d 44 3a 20 22 20 28 73 74 72 69 6e 67 CHCMD: " (string
12ba0 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
12bb0 6c 63 6d 64 20 22 20 22 29 29 0a 09 20 20 20 20 lcmd " "))..
12bc0 28 69 66 20 28 6c 69 73 74 3f 20 6c 61 75 6e 63 (if (list? launc
12bd0 68 2d 72 65 73 75 6c 74 73 29 0a 09 09 28 61 70 h-results)...(ap
12be0 70 6c 79 20 70 72 69 6e 74 20 6c 61 75 6e 63 68 ply print launch
12bf0 2d 72 65 73 75 6c 74 73 29 0a 09 09 28 70 72 69 -results)...(pri
12c00 6e 74 20 22 4e 4f 54 45 3a 20 6c 61 75 6e 63 68 nt "NOTE: launch
12c10 65 64 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ed \"" fullcmd "
12c20 5c 22 5c 6e 20 20 62 75 74 20 64 69 64 20 6e 6f \"\n but did no
12c30 74 20 77 61 69 74 20 66 6f 72 20 69 74 20 74 6f t wait for it to
12c40 20 70 72 6f 63 65 65 64 2e 20 41 64 64 20 74 68 proceed. Add th
12c50 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 6f 20 6d e following to m
12c60 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 5c egatest.config \
12c70 6e 5b 73 65 74 75 70 5d 5c 6e 6c 61 75 6e 63 68 n[setup]\nlaunch
12c80 77 61 69 74 20 79 65 73 5c 6e 20 20 69 66 20 79 wait yes\n if y
12c90 6f 75 20 68 61 76 65 20 70 72 6f 62 6c 65 6d 73 ou have problems
12ca0 20 77 69 74 68 20 74 68 69 73 22 29 29 0a 09 20 with this"))..
12cb0 20 20 20 23 3a 61 70 70 65 6e 64 29 29 0a 09 28 #:append))..(
12cc0 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
12cd0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
12ce0 20 22 4c 61 75 6e 63 68 69 6e 67 20 63 6f 6d 70 "Launching comp
12cf0 6c 65 74 65 64 2c 20 75 70 64 61 74 69 6e 67 20 leted, updating
12d00 64 62 22 29 0a 09 28 64 65 62 75 67 3a 70 72 69 db")..(debug:pri
12d10 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
12d20 67 2d 70 6f 72 74 2a 20 22 4c 61 75 6e 63 68 20 g-port* "Launch
12d30 72 65 73 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 results: " launc
12d40 68 2d 72 65 73 75 6c 74 73 29 0a 09 28 69 66 20 h-results)..(if
12d50 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 (not launch-resu
12d60 6c 74 73 29 0a 09 20 20 20 20 28 62 65 67 69 6e lts).. (begin
12d70 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
12d80 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f ERROR: Failed to
12d90 20 72 75 6e 20 22 20 28 73 74 72 69 6e 67 2d 69 run " (string-i
12da0 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
12db0 6d 64 20 22 20 22 29 20 22 2c 20 65 78 69 74 69 md " ") ", exiti
12dc0 6e 67 20 6e 6f 77 22 29 0a 09 20 20 20 20 20 20 ng now")..
12dd0 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ;; (sqlite3:fina
12de0 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 20 lize! db)..
12df0 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 ;; good ole "ex
12e00 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f it" seems not to
12e10 20 77 6f 72 6b 0a 09 20 20 20 20 20 20 3b 3b 20 work.. ;;
12e20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 20 20 20 (_exit 9)..
12e30 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
12e40 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
12e50 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
12e60 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
12e70 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 en email list..
12e80 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 ;; NB// Is
12e90 74 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 this still neede
12ea0 64 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 d? Should be saf
12eb0 65 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 e to go back to
12ec0 22 65 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 "exit" now?..
12ed0 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e (process-sign
12ee0 61 6c 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 al (current-proc
12ef0 65 73 73 2d 69 64 29 20 73 69 67 6e 61 6c 2f 6b ess-id) signal/k
12f00 69 6c 6c 29 0a 09 20 20 20 20 20 20 29 29 0a 09 ill).. ))..
12f10 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
12f20 20 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 09 miscprevvals)..
12f30 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
12f40 20 74 65 73 74 70 72 65 76 76 61 6c 73 29 0a 09 testprevvals)..
12f50 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
12f60 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 commonprevvals)
12f70 0a 09 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 ..launch-results
12f80 29 29 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 )). (change-d
12f90 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
12fa0 68 2a 29 29 29 0a 0a 3b 3b 20 72 65 63 6f 76 65 h*)))..;; recove
12fb0 72 20 61 20 74 65 73 74 20 77 68 65 72 65 20 74 r a test where t
12fc0 68 65 20 74 6f 70 20 63 6f 6e 74 72 6f 6c 6c 69 he top controlli
12fd0 6e 67 20 6d 74 65 73 74 20 6d 61 79 20 68 61 76 ng mtest may hav
12fe0 65 20 64 69 65 64 0a 3b 3b 0a 28 64 65 66 69 6e e died.;;.(defin
12ff0 65 20 28 6c 61 75 6e 63 68 3a 72 65 63 6f 76 65 e (launch:recove
13000 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 r-test run-id te
13010 73 74 2d 69 64 29 0a 20 20 3b 3b 20 74 68 69 73 st-id). ;; this
13020 20 66 75 6e 63 74 69 6f 6e 20 69 73 20 63 61 6c function is cal
13030 6c 65 64 20 6f 6e 20 74 68 65 20 74 65 73 74 20 led on the test
13040 72 75 6e 20 68 6f 73 74 20 76 69 61 20 73 73 68 run host via ssh
13050 0a 20 20 3b 3b 0a 20 20 3b 3b 20 31 2e 20 6c 6f . ;;. ;; 1. lo
13060 6f 6b 20 61 74 20 74 68 65 20 70 72 6f 63 65 73 ok at the proces
13070 73 20 66 72 6f 6d 20 70 69 64 0a 20 20 3b 3b 20 s from pid. ;;
13080 20 20 20 2d 20 69 73 20 69 74 20 6f 77 6e 65 64 - is it owned
13090 20 62 79 20 63 61 6c 6c 69 6e 67 20 75 73 65 72 by calling user
130a0 0a 20 20 3b 3b 20 20 20 20 2d 20 69 74 20 69 74 . ;; - it it
130b0 27 73 20 72 75 6e 20 64 69 72 65 63 74 6f 72 79 's run directory
130c0 20 63 6f 72 72 65 63 74 20 66 6f 72 20 74 68 65 correct for the
130d0 20 74 65 73 74 0a 20 20 3b 3b 20 20 20 20 2d 20 test. ;; -
130e0 69 73 20 74 68 65 72 65 20 61 20 63 6f 6e 74 72 is there a contr
130f0 6f 6c 6c 69 6e 67 20 6d 74 65 73 74 20 28 6d 61 olling mtest (ma
13100 79 62 65 20 73 74 75 63 6b 29 0a 20 20 3b 3b 20 ybe stuck). ;;
13110 32 2e 20 69 66 20 72 65 63 6f 76 65 72 79 20 69 2. if recovery i
13120 73 20 6e 65 65 64 65 64 20 77 61 74 63 68 20 70 s needed watch p
13130 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 77 68 65 id. ;; - whe
13140 6e 20 69 74 20 65 78 69 74 73 20 74 61 6b 65 20 n it exits take
13150 74 68 65 20 65 78 69 74 20 63 6f 64 65 20 61 6e the exit code an
13160 64 20 64 6f 20 74 68 65 20 6e 65 65 64 66 75 6c d do the needful
13170 0a 20 20 3b 3b 0a 20 20 28 6c 65 74 2a 20 28 28 . ;;. (let* ((
13180 70 69 64 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 pid (rmt:test-ge
13190 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 69 64 t-top-process-id
131a0 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
131b0 29 0a 09 20 28 70 73 72 65 73 20 28 77 69 74 68 ).. (psres (with
131c0 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 65 -input-from-pipe
131d0 0a 09 09 20 28 63 6f 6e 63 20 22 70 73 20 2d 46 ... (conc "ps -F
131e0 20 2d 75 20 22 20 28 63 75 72 72 65 6e 74 2d 75 -u " (current-u
131f0 73 65 72 2d 6e 61 6d 65 29 20 22 20 7c 20 67 72 ser-name) " | gr
13200 65 70 20 2d 45 20 27 22 20 70 69 64 20 22 20 27 ep -E '" pid " '
13210 20 7c 20 67 72 65 70 20 2d 76 20 27 67 72 65 70 | grep -v 'grep
13220 20 2d 45 20 22 20 70 69 64 20 22 27 22 29 0a 09 -E " pid "'")..
13230 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 . (lambda ()...
13240 20 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 29 (read-line))))
13250 0a 09 20 28 72 75 6e 64 69 72 20 28 69 66 20 28 .. (rundir (if (
13260 73 74 72 69 6e 67 3f 20 70 73 72 65 73 29 20 3b string? psres) ;
13270 3b 20 72 65 61 6c 20 70 72 6f 63 65 73 73 20 6f ; real process o
13280 77 6e 65 64 20 62 79 20 75 73 65 72 0a 09 09 20 wned by user...
13290 20 20 20 20 28 72 65 61 64 2d 73 79 6d 62 6f 6c (read-symbol
132a0 69 63 2d 6c 69 6e 6b 20 28 63 6f 6e 63 20 22 2f ic-link (conc "/
132b0 70 72 6f 63 2f 22 20 70 69 64 20 22 2f 63 77 64 proc/" pid "/cwd
132c0 22 29 29 0a 09 09 20 20 20 20 20 23 66 29 29 29 "))... #f)))
132d0 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 77 61 69 74 . ;; now wait
132e0 20 6f 6e 20 74 68 61 74 20 70 72 6f 63 65 73 73 on that process
132f0 20 69 66 20 61 6c 6c 20 69 73 20 63 6f 72 72 65 if all is corre
13300 63 74 0a 20 20 20 20 3b 3b 20 70 65 72 69 6f 64 ct. ;; period
13310 69 63 61 6c 6c 79 20 75 70 64 61 74 65 20 74 68 ically update th
13320 65 20 64 62 20 77 69 74 68 20 72 75 6e 74 69 6d e db with runtim
13330 65 0a 20 20 20 20 3b 3b 20 77 68 65 6e 20 74 68 e. ;; when th
13340 65 20 70 72 6f 63 65 73 73 20 65 78 69 74 73 20 e process exits
13350 6c 6f 6f 6b 20 61 74 20 74 68 65 20 64 62 2c 20 look at the db,
13360 69 66 20 73 74 69 6c 6c 20 52 55 4e 4e 49 4e 47 if still RUNNING
13370 20 61 66 74 65 72 20 31 30 20 73 65 63 6f 6e 64 after 10 second
13380 73 20 73 65 74 0a 20 20 20 20 3b 3b 20 73 74 61 s set. ;; sta
13390 74 65 2f 73 74 61 74 75 73 20 61 70 70 72 6f 70 te/status approp
133a0 72 69 61 74 65 6c 79 0a 20 20 20 20 28 70 72 6f riately. (pro
133b0 63 65 73 73 2d 77 61 69 74 20 70 69 64 29 29 29 cess-wait pid)))
133c0 0a .