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 0a 28 69 6e 63 (uses db))..(inc
0370: 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 lude "common_rec
0380: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0390: 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 64 73 ude "key_records
03a0: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
03b0: 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 "db_records.scm"
03c0: 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d )..;;===========
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 ===========.;; e
0410: 7a 73 74 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d zsteps.;;=======
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 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============.
0460: 0a 3b 3b 20 65 7a 73 74 65 70 73 20 77 65 72 65 .;; ezsteps were
0470: 20 67 6f 69 6e 67 20 74 6f 20 62 65 20 63 6f 64 going to be cod
0480: 65 64 20 61 73 0a 3b 3b 20 73 74 65 70 6e 61 6d ed as.;; stepnam
0490: 65 5b 2c 70 72 65 64 73 74 65 70 31 2c 70 72 65 e[,predstep1,pre
04a0: 64 73 74 65 70 32 20 2e 2e 2e 5d 20 5b 7b 56 41 dstep2 ...] [{VA
04b0: 52 31 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c R1=first,second,
04c0: 74 68 69 72 64 7d 5d 20 63 6f 6d 6d 61 6e 64 20 third}] command
04d0: 74 6f 20 65 78 65 63 75 74 65 0a 3b 3b 20 20 20 to execute.;;
04e0: 42 55 54 0a 3b 3b 20 6e 6f 77 20 61 72 65 0a 3b BUT.;; now are.;
04f0: 3b 20 73 74 65 70 6e 61 6d 65 20 7b 56 41 52 3d ; stepname {VAR=
0500: 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 first,second,thi
0510: 72 64 20 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e 64 20 rd ...} command
0520: 2e 2e 2e 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 ....;; where the
0530: 20 7b 56 41 52 3d 66 69 72 73 74 2c 73 65 63 6f {VAR=first,seco
0540: 6e 64 2c 74 68 69 72 64 20 2e 2e 2e 7d 20 69 73 nd,third ...} is
0550: 20 6f 70 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 optional...;; g
0560: 69 76 65 6e 20 61 6e 20 65 78 69 74 20 63 6f 64 iven an exit cod
0570: 65 20 61 6e 64 20 77 68 65 74 68 65 72 20 6f 72 e and whether or
0580: 20 6e 6f 74 20 6c 6f 67 70 72 6f 20 77 61 73 20 not logpro was
0590: 75 73 65 64 20 63 61 6c 63 75 6c 61 74 65 20 4f used calculate O
05a0: 4b 2f 42 41 44 0a 3b 3b 20 72 65 74 75 72 6e 20 K/BAD.;; return
05b0: 23 74 20 69 66 20 77 65 20 61 72 65 20 6f 6b 2c #t if we are ok,
05c0: 20 23 66 20 6f 74 68 65 72 77 69 73 65 0a 28 64 #f otherwise.(d
05d0: 65 66 69 6e 65 20 28 73 74 65 70 72 75 6e 2d 67 efine (steprun-g
05e0: 6f 6f 64 3f 20 6c 6f 67 70 72 6f 20 65 78 69 74 ood? logpro exit
05f0: 63 6f 64 65 29 0a 20 20 28 6f 72 20 28 65 71 3f code). (or (eq?
0600: 20 65 78 69 74 63 6f 64 65 20 30 29 0a 20 20 20 exitcode 0).
0610: 20 20 20 28 61 6e 64 20 6c 6f 67 70 72 6f 20 28 (and logpro (
0620: 65 71 3f 20 65 78 69 74 63 6f 64 65 20 32 29 29 eq? exitcode 2))
0630: 29 29 0a 0a 3b 3b 20 69 66 20 68 61 6e 64 65 64 ))..;; if handed
0640: 20 61 20 73 74 72 69 6e 67 2c 20 70 72 6f 63 65 a string, proce
0650: 73 73 20 69 74 2c 20 65 6c 73 65 20 6c 6f 6f 6b ss it, else look
0660: 20 66 6f 72 20 4d 54 5f 43 4d 44 49 4e 46 4f 0a for MT_CMDINFO.
0670: 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a (define (launch:
0680: 67 65 74 2d 63 6d 64 69 6e 66 6f 2d 61 73 73 6f get-cmdinfo-asso
0690: 63 2d 6c 69 73 74 20 23 21 6b 65 79 20 28 65 6e c-list #!key (en
06a0: 63 6f 64 65 64 2d 63 6d 64 20 23 66 29 29 0a 20 coded-cmd #f)).
06b0: 20 28 6c 65 74 20 28 28 65 6e 63 63 6d 64 20 28 (let ((enccmd (
06c0: 69 66 20 65 6e 63 6f 64 65 64 2d 63 6d 64 20 65 if encoded-cmd e
06d0: 6e 63 6f 64 65 64 2d 63 6d 64 20 28 67 65 74 65 ncoded-cmd (gete
06e0: 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f 22 29 nv "MT_CMDINFO")
06f0: 29 29 29 0a 20 20 20 20 28 69 66 20 65 6e 63 63 ))). (if encc
0700: 6d 64 0a 09 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 md..(common:read
0710: 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 20 -encoded-string
0720: 65 6e 63 63 6d 64 29 0a 09 27 28 29 29 29 29 0a enccmd)..'()))).
0730: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
0740: 20 20 20 20 20 20 20 20 20 20 30 20 20 20 20 20 0
0750: 20 20 20 20 20 20 31 20 20 20 20 20 20 20 20 20 1
0760: 20 20 20 20 20 32 20 20 20 20 20 20 20 20 20 20 2
0770: 20 20 20 20 33 0a 28 64 65 66 73 74 72 75 63 74 3.(defstruct
0780: 20 6c 61 75 6e 63 68 3a 65 69 6e 66 20 28 70 69 launch:einf (pi
0790: 64 20 23 74 29 28 65 78 69 74 2d 73 74 61 74 75 d #t)(exit-statu
07a0: 73 20 23 74 29 28 65 78 69 74 2d 63 6f 64 65 20 s #t)(exit-code
07b0: 23 74 29 28 72 6f 6c 6c 75 70 2d 73 74 61 74 75 #t)(rollup-statu
07c0: 73 20 30 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e s 0))..;; return
07d0: 20 28 63 6f 6e 63 20 73 74 61 74 75 73 20 22 3a (conc status ":
07e0: 20 22 20 63 6f 6d 6d 65 6e 74 29 20 66 72 6f 6d " comment) from
07f0: 20 74 68 65 20 66 69 6e 61 6c 20 73 65 63 74 69 the final secti
0800: 6f 6e 20 73 6f 20 74 68 61 74 0a 3b 3b 20 20 20 on so that.;;
0810: 74 68 65 20 63 6f 6d 6d 65 6e 74 20 63 61 6e 20 the comment can
0820: 62 65 20 73 65 74 20 69 6e 20 74 68 65 20 73 74 be set in the st
0830: 65 70 20 72 65 63 6f 72 64 20 69 6e 20 6c 61 75 ep record in lau
0840: 6e 63 68 2e 73 63 6d 0a 3b 3b 0a 28 64 65 66 69 nch.scm.;;.(defi
0850: 6e 65 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d ne (launch:load-
0860: 6c 6f 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 logpro-dat run-i
0870: 64 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 d test-id stepna
0880: 6d 65 29 0a 20 20 28 6c 65 74 20 28 28 63 6e 61 me). (let ((cna
0890: 6d 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d me (conc stepnam
08a0: 65 20 22 2e 64 61 74 22 29 29 29 0a 20 20 20 20 e ".dat"))).
08b0: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (if (common:file
08c0: 2d 65 78 69 73 74 73 3f 20 63 6e 61 6d 65 29 0a -exists? cname).
08d0: 09 28 6c 65 74 2a 20 28 28 64 61 74 20 20 28 72 .(let* ((dat (r
08e0: 65 61 64 2d 63 6f 6e 66 69 67 20 63 6e 61 6d 65 ead-config cname
08f0: 20 23 66 20 23 66 29 29 0a 09 20 20 20 20 20 20 #f #f))..
0900: 20 28 63 73 76 72 20 28 64 62 3a 6c 6f 67 70 72 (csvr (db:logpr
0910: 6f 2d 64 61 74 2d 3e 63 73 76 20 64 61 74 20 73 o-dat->csv dat s
0920: 74 65 70 6e 61 6d 65 29 29 0a 09 20 20 20 20 20 tepname))..
0930: 20 20 28 63 73 76 74 20 28 6c 65 74 2d 76 61 6c (csvt (let-val
0940: 75 65 73 20 28 28 28 66 6d 74 2d 63 65 6c 6c 20 ues (((fmt-cell
0950: 66 6d 74 2d 72 65 63 6f 72 64 20 66 6d 74 2d 63 fmt-record fmt-c
0960: 73 76 29 20 28 6d 61 6b 65 2d 66 6f 72 6d 61 74 sv) (make-format
0970: 20 22 2c 22 29 29 29 0a 09 09 20 20 20 20 20 20 ",")))...
0980: 20 28 66 6d 74 2d 63 73 76 20 28 6d 61 70 20 6c (fmt-csv (map l
0990: 69 73 74 2d 3e 63 73 76 2d 72 65 63 6f 72 64 20 ist->csv-record
09a0: 63 73 76 72 29 29 29 29 0a 09 20 20 20 20 20 20 csvr))))..
09b0: 20 28 73 74 61 74 75 73 20 28 63 6f 6e 66 69 67 (status (config
09c0: 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 20 22 66 69 f:lookup dat "fi
09d0: 6e 61 6c 22 20 22 65 78 69 74 2d 73 74 61 74 75 nal" "exit-statu
09e0: 73 22 29 29 0a 09 20 20 20 20 20 20 20 28 6d 73 s")).. (ms
09f0: 67 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c g (configf:l
0a00: 6f 6f 6b 75 70 20 64 61 74 20 22 66 69 6e 61 6c ookup dat "final
0a10: 22 20 22 6d 65 73 73 61 67 65 22 29 29 29 0a 20 " "message"))).
0a20: 20 20 20 20 20 20 20 20 20 28 69 66 20 63 73 76 (if csv
0a30: 74 20 20 3b 3b 20 74 68 69 73 20 69 66 20 62 6c t ;; this if bl
0a40: 6f 63 6b 65 64 20 73 74 61 63 6b 20 64 75 6d 70 ocked stack dump
0a50: 20 63 61 75 73 65 64 20 62 79 20 2e 64 61 74 20 caused by .dat
0a60: 66 69 6c 65 20 66 72 6f 6d 20 6c 6f 67 70 72 6f file from logpro
0a70: 20 62 65 69 6e 67 20 30 2d 62 79 74 65 2e 20 20 being 0-byte.
0a80: 66 69 78 65 64 20 62 79 20 75 70 67 72 61 64 69 fixed by upgradi
0a90: 6e 67 20 6c 6f 67 70 72 6f 0a 20 20 20 20 20 20 ng logpro.
0aa0: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 63 73 76 (rmt:csv
0ab0: 2d 3e 74 65 73 74 2d 64 61 74 61 20 72 75 6e 2d ->test-data run-
0ac0: 69 64 20 74 65 73 74 2d 69 64 20 63 73 76 74 29 id test-id csvt)
0ad0: 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
0ae0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
0af0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 log-port* "ERROR
0b00: 3a 20 6e 6f 20 63 73 76 64 61 74 20 65 78 69 73 : no csvdat exis
0b10: 74 73 20 66 6f 72 20 72 75 6e 2d 69 64 3a 20 22 ts for run-id: "
0b20: 20 72 75 6e 2d 69 64 20 22 20 74 65 73 74 2d 69 run-id " test-i
0b30: 64 3a 20 22 20 74 65 73 74 2d 69 64 20 22 20 73 d: " test-id " s
0b40: 74 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e tepname: " stepn
0b50: 61 6d 65 20 22 2c 20 63 68 65 63 6b 20 74 68 61 ame ", check tha
0b60: 74 20 6c 6f 67 70 72 6f 20 76 65 72 73 69 6f 6e t logpro version
0b70: 20 69 73 20 31 2e 31 35 20 6f 72 20 6e 65 77 65 is 1.15 or newe
0b80: 72 22 29 29 0a 09 20 20 3b 3b 20 20 28 64 65 62 r")).. ;; (deb
0b90: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 31 33 ug:print-info 13
0ba0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
0bb0: 72 74 2a 20 22 45 72 72 6f 72 3a 20 72 75 6e 2d rt* "Error: run-
0bc0: 69 64 2f 74 65 73 74 2d 69 64 2f 73 74 65 70 6e id/test-id/stepn
0bd0: 61 6d 65 3d 22 72 75 6e 2d 69 64 22 2f 22 74 65 ame="run-id"/"te
0be0: 73 74 2d 69 64 22 2f 22 73 74 65 70 6e 61 6d 65 st-id"/"stepname
0bf0: 22 20 3d 3e 20 62 61 64 20 63 73 76 72 3d 22 63 " => bad csvr="c
0c00: 73 76 72 29 0a 09 20 20 3b 3b 20 20 29 0a 09 20 svr).. ;; )..
0c10: 20 28 63 6f 6e 64 0a 09 20 20 20 28 28 65 71 75 (cond.. ((equ
0c20: 61 6c 3f 20 73 74 61 74 75 73 20 22 50 41 53 53 al? status "PASS
0c30: 22 29 20 22 50 41 53 53 22 29 20 3b 3b 20 73 6b ") "PASS") ;; sk
0c40: 69 70 20 74 68 65 20 6d 65 73 73 61 67 65 20 70 ip the message p
0c50: 61 72 74 20 69 66 20 73 74 61 74 75 73 20 69 73 art if status is
0c60: 20 70 61 73 73 0a 09 20 20 20 28 73 74 61 74 75 pass.. (statu
0c70: 73 20 28 63 6f 6e 63 20 28 63 6f 6e 66 69 67 66 s (conc (configf
0c80: 3a 6c 6f 6f 6b 75 70 20 64 61 74 20 22 66 69 6e :lookup dat "fin
0c90: 61 6c 22 20 22 65 78 69 74 2d 73 74 61 74 75 73 al" "exit-status
0ca0: 22 29 20 22 3a 20 22 20 28 69 66 20 6d 73 67 20 ") ": " (if msg
0cb0: 6d 73 67 20 22 6e 6f 20 6d 65 73 73 61 67 65 22 msg "no message"
0cc0: 29 29 29 0a 09 20 20 20 28 65 6c 73 65 20 23 66 ))).. (else #f
0cd0: 29 29 29 0a 09 23 66 29 29 29 0a 0a 28 64 65 66 )))..#f)))..(def
0ce0: 69 6e 65 20 28 6c 61 75 6e 63 68 3a 72 75 6e 73 ine (launch:runs
0cf0: 74 65 70 20 65 7a 73 74 65 70 20 72 75 6e 2d 69 tep ezstep run-i
0d00: 64 20 74 65 73 74 2d 69 64 20 65 78 69 74 2d 69 d test-id exit-i
0d10: 6e 66 6f 20 6d 20 74 61 6c 20 74 65 73 74 63 6f nfo m tal testco
0d20: 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 nfig). (let* ((
0d30: 73 74 65 70 6e 61 6d 65 20 20 20 20 20 20 20 28 stepname (
0d40: 63 61 72 20 65 7a 73 74 65 70 29 29 20 20 3b 3b car ezstep)) ;;
0d50: 20 64 6f 20 73 74 75 66 66 20 74 6f 20 72 75 6e do stuff to run
0d60: 20 74 68 65 20 73 74 65 70 0a 09 20 28 73 74 65 the step.. (ste
0d70: 70 69 6e 66 6f 20 20 20 20 20 20 20 28 63 61 64 pinfo (cad
0d80: 72 20 65 7a 73 74 65 70 29 29 0a 09 20 28 73 74 r ezstep)).. (st
0d90: 65 70 70 61 72 74 73 20 20 20 20 20 20 28 73 74 epparts (st
0da0: 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 65 ring-match (rege
0db0: 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d 5d xp "^(\\{([^\\}]
0dc0: 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 24 *)\\}\\s*|)(.*)$
0dd0: 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a 09 20 ") stepinfo))..
0de0: 28 73 74 65 70 70 61 72 6d 73 20 20 20 20 20 20 (stepparms
0df0: 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 61 (list-ref steppa
0e00: 72 74 73 20 32 29 29 20 3b 3b 20 66 6f 72 20 66 rts 2)) ;; for f
0e10: 75 74 75 72 65 20 75 73 65 2c 20 7b 56 41 52 3d uture use, {VAR=
0e20: 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 73 74 65 70 1,2,3}, run step
0e30: 20 66 6f 72 20 65 61 63 68 20 0a 09 20 28 73 74 for each .. (st
0e40: 65 70 63 6d 64 20 20 20 20 20 20 20 20 28 6c 69 epcmd (li
0e50: 73 74 2d 72 65 66 20 73 74 65 70 70 61 72 74 73 st-ref stepparts
0e60: 20 33 29 29 0a 09 20 28 73 63 72 69 70 74 20 20 3)).. (script
0e70: 20 20 20 20 20 20 20 22 22 29 20 3b 20 22 23 21 "") ; "#!
0e80: 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 29 20 3b 3b /bin/bash\n") ;;
0e90: 20 79 65 70 2c 20 77 65 20 64 65 70 65 6e 64 20 yep, we depend
0ea0: 6f 6e 20 62 69 6e 2f 62 61 73 68 20 46 49 58 4d on bin/bash FIXM
0eb0: 45 21 21 21 5c 0a 09 20 28 6c 6f 67 70 72 6f 2d E!!!\.. (logpro-
0ec0: 66 69 6c 65 20 20 20 20 28 63 6f 6e 63 20 73 74 file (conc st
0ed0: 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 epname ".logpro"
0ee0: 29 29 0a 09 20 28 68 74 6d 6c 2d 66 69 6c 65 20 )).. (html-file
0ef0: 20 20 20 20 20 28 63 6f 6e 63 20 73 74 65 70 6e (conc stepn
0f00: 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 0a 09 20 ame ".html"))..
0f10: 28 64 61 74 2d 66 69 6c 65 20 20 20 20 20 20 20 (dat-file
0f20: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
0f30: 2e 64 61 74 22 29 29 0a 09 20 28 74 63 6f 6e 66 .dat")).. (tconf
0f40: 69 67 2d 6c 6f 67 70 72 6f 20 28 63 6f 6e 66 69 ig-logpro (confi
0f50: 67 66 3a 6c 6f 6f 6b 75 70 20 74 65 73 74 63 6f gf:lookup testco
0f60: 6e 66 69 67 20 22 6c 6f 67 70 72 6f 22 20 73 74 nfig "logpro" st
0f70: 65 70 6e 61 6d 65 29 29 0a 09 20 28 6c 6f 67 70 epname)).. (logp
0f80: 72 6f 2d 75 73 65 64 20 20 20 20 28 63 6f 6d 6d ro-used (comm
0f90: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
0fa0: 6c 6f 67 70 72 6f 2d 66 69 6c 65 29 29 29 0a 0a logpro-file)))..
0fb0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 63 6f (if (and tco
0fc0: 6e 66 69 67 2d 6c 6f 67 70 72 6f 0a 09 20 20 20 nfig-logpro..
0fd0: 20 20 28 6e 6f 74 20 6c 6f 67 70 72 6f 2d 75 73 (not logpro-us
0fe0: 65 64 29 29 20 3b 3b 20 6e 6f 20 6c 6f 67 70 72 ed)) ;; no logpr
0ff0: 6f 20 66 69 6c 65 20 66 6f 75 6e 64 20 62 75 74 o file found but
1000: 20 68 61 76 65 20 61 20 64 65 66 6e 20 69 6e 20 have a defn in
1010: 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 0a 09 the testconfig..
1020: 28 62 65 67 69 6e 0a 09 20 20 28 77 69 74 68 2d (begin.. (with-
1030: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 6c output-to-file l
1040: 6f 67 70 72 6f 2d 66 69 6c 65 0a 09 20 20 20 20 ogpro-file..
1050: 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 20 20 20 (lambda ()..
1060: 20 20 28 70 72 69 6e 74 20 22 3b 3b 20 6c 6f 67 (print ";; log
1070: 70 72 6f 20 66 69 6c 65 20 65 78 74 72 61 63 74 pro file extract
1080: 65 64 20 66 72 6f 6d 20 74 65 73 74 63 6f 6e 66 ed from testconf
1090: 69 67 5c 6e 22 0a 09 09 20 20 20 20 20 22 3b 3b ig\n"... ";;
10a0: 22 29 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 ").. (print
10b0: 20 74 63 6f 6e 66 69 67 2d 6c 6f 67 70 72 6f 29 tconfig-logpro)
10c0: 29 29 0a 09 20 20 28 73 65 74 21 20 6c 6f 67 70 )).. (set! logp
10d0: 72 6f 2d 75 73 65 64 20 23 74 29 29 29 0a 20 20 ro-used #t))).
10e0: 20 20 0a 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 63 . ;; NB// c
10f0: 61 6e 20 73 61 66 65 6c 79 20 61 73 73 75 6d 65 an safely assume
1100: 20 77 65 20 61 72 65 20 69 6e 20 74 65 73 74 2d we are in test-
1110: 61 72 65 61 20 64 69 72 65 63 74 6f 72 79 0a 20 area directory.
1120: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
1130: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
1140: 6f 72 74 2a 20 22 65 7a 73 74 65 70 73 3a 5c 6e ort* "ezsteps:\n
1150: 20 73 74 65 70 6e 61 6d 65 3a 20 22 20 73 74 65 stepname: " ste
1160: 70 6e 61 6d 65 20 22 20 73 74 65 70 69 6e 66 6f pname " stepinfo
1170: 3a 20 22 20 73 74 65 70 69 6e 66 6f 20 22 20 73 : " stepinfo " s
1180: 74 65 70 70 61 72 74 73 3a 20 22 20 73 74 65 70 tepparts: " step
1190: 70 61 72 74 73 0a 09 09 20 22 20 73 74 65 70 70 parts... " stepp
11a0: 61 72 6d 73 3a 20 22 20 73 74 65 70 70 61 72 6d arms: " stepparm
11b0: 73 20 22 20 73 74 65 70 63 6d 64 3a 20 22 20 73 s " stepcmd: " s
11c0: 74 65 70 63 6d 64 29 0a 20 20 20 20 0a 20 20 20 tepcmd). .
11d0: 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 6f 75 ;; ;; first sou
11e0: 72 63 65 20 74 68 65 20 70 72 65 76 69 6f 75 73 rce the previous
11f0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 20 20 20 environment.
1200: 20 3b 3b 20 28 6c 65 74 20 28 28 70 72 65 76 2d ;; (let ((prev-
1210: 65 6e 76 20 28 63 6f 6e 63 20 22 2e 65 7a 73 74 env (conc ".ezst
1220: 65 70 73 2f 22 20 70 72 65 76 73 74 65 70 20 28 eps/" prevstep (
1230: 69 66 20 28 73 74 72 69 6e 67 2d 73 65 61 72 63 if (string-searc
1240: 68 20 28 72 65 67 65 78 70 20 22 63 73 68 22 29 h (regexp "csh")
1250: 20 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 09 09 . ;; ..
1260: 09 09 09 09 09 20 28 67 65 74 2d 65 6e 76 69 72 ..... (get-envir
1270: 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 onment-variable
1280: 22 53 48 45 4c 4c 22 29 29 20 22 2e 63 73 68 22 "SHELL")) ".csh"
1290: 20 22 2e 73 68 22 29 29 29 29 0a 20 20 20 20 3b ".sh")))). ;
12a0: 3b 20 20 20 28 69 66 20 28 61 6e 64 20 70 72 65 ; (if (and pre
12b0: 76 73 74 65 70 20 28 63 6f 6d 6d 6f 6e 3a 66 69 vstep (common:fi
12c0: 6c 65 2d 65 78 69 73 74 73 3f 20 70 72 65 76 2d le-exists? prev-
12d0: 65 6e 76 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 env)). ;;
12e0: 20 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 (set! script
12f0: 28 63 6f 6e 63 20 73 63 72 69 70 74 20 22 73 6f (conc script "so
1300: 75 72 63 65 20 22 20 70 72 65 76 2d 65 6e 76 29 urce " prev-env)
1310: 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 ))). . ;;
1320: 63 61 6c 6c 20 74 68 65 20 63 6f 6d 6d 61 6e 64 call the command
1330: 20 75 73 69 6e 67 20 6d 74 5f 65 7a 73 74 65 70 using mt_ezstep
1340: 0a 20 20 20 20 3b 3b 20 28 73 65 74 21 20 73 63 . ;; (set! sc
1350: 72 69 70 74 20 28 63 6f 6e 63 20 22 6d 74 5f 65 ript (conc "mt_e
1360: 7a 73 74 65 70 20 22 20 73 74 65 70 6e 61 6d 65 zstep " stepname
1370: 20 22 20 22 20 28 69 66 20 70 72 65 76 73 74 65 " " (if prevste
1380: 70 20 70 72 65 76 73 74 65 70 20 22 78 22 29 20 p prevstep "x")
1390: 22 20 22 20 73 74 65 70 63 6d 64 29 29 0a 20 20 " " stepcmd)).
13a0: 20 20 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
13b0: 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c int 4 *default-l
13c0: 6f 67 2d 70 6f 72 74 2a 20 22 73 63 72 69 70 74 og-port* "script
13d0: 3a 20 22 20 73 63 72 69 70 74 29 0a 20 20 20 20 : " script).
13e0: 28 72 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 (rmt:teststep-se
13f0: 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
1400: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
1410: 65 20 22 73 74 61 72 74 22 20 22 2d 22 20 23 66 e "start" "-" #f
1420: 20 23 66 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 #f). ;; now
1430: 6c 61 75 6e 63 68 20 74 68 65 20 61 63 74 75 61 launch the actua
1440: 6c 20 70 72 6f 63 65 73 73 0a 20 20 20 20 28 63 l process. (c
1450: 61 6c 6c 2d 77 69 74 68 2d 65 6e 76 69 72 6f 6e all-with-environ
1460: 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 73 20 0a ment-variables .
1470: 20 20 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 (list (cons
1480: 20 22 50 41 54 48 22 20 28 63 6f 6e 63 20 28 67 "PATH" (conc (g
1490: 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 et-environment-v
14a0: 61 72 69 61 62 6c 65 20 22 50 41 54 48 22 29 20 ariable "PATH")
14b0: 22 3a 2e 22 29 29 29 0a 20 20 20 20 20 28 6c 61 ":."))). (la
14c0: 6d 62 64 61 20 28 29 20 3b 3b 20 28 70 72 6f 63 mbda () ;; (proc
14d0: 65 73 73 2d 72 75 6e 20 22 2f 62 69 6e 2f 62 61 ess-run "/bin/ba
14e0: 73 68 22 20 22 2d 63 22 20 22 65 78 65 63 20 6c sh" "-c" "exec l
14f0: 73 20 2d 6c 20 2f 74 6d 70 2f 66 6f 6f 62 61 72 s -l /tmp/foobar
1500: 20 3e 20 2f 74 6d 70 2f 64 65 6c 6d 65 2d 6d 6f > /tmp/delme-mo
1510: 72 65 2e 6c 6f 67 20 32 3e 26 31 22 29 0a 20 20 re.log 2>&1").
1520: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 (let* ((cmd
1530: 20 28 63 6f 6e 63 20 73 74 65 70 63 6d 64 20 22 (conc stepcmd "
1540: 20 3e 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e > " stepname ".
1550: 6c 6f 67 20 32 3e 26 31 22 29 29 20 3b 3b 20 3e log 2>&1")) ;; >
1560: 6f 75 74 66 69 6c 65 20 32 3e 26 31 20 0a 09 20 outfile 2>&1 ..
1570: 20 20 20 20 20 28 70 69 64 20 28 70 72 6f 63 65 (pid (proce
1580: 73 73 2d 72 75 6e 20 22 2f 62 69 6e 2f 62 61 73 ss-run "/bin/bas
1590: 68 22 20 28 6c 69 73 74 20 22 2d 63 22 20 63 6d h" (list "-c" cm
15a0: 64 29 29 29 29 0a 0a 20 20 20 20 20 20 20 20 20 d))))..
15b0: 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d (with-output-to-
15c0: 66 69 6c 65 20 22 4d 61 6b 65 66 69 6c 65 2e 65 file "Makefile.e
15d0: 7a 73 74 65 70 73 22 0a 20 20 20 20 20 20 20 20 zsteps".
15e0: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
15f0: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 69 6e (prin
1600: 74 20 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 t stepname ".log
1610: 20 3a 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 :").
1620: 20 20 28 70 72 69 6e 74 20 22 5c 74 22 20 63 6d (print "\t" cm
1630: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
1640: 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 (if (common:file
1650: 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 -exists? (conc s
1660: 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f tepname ".logpro
1670: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
1680: 20 20 20 20 20 28 70 72 69 6e 74 20 22 5c 74 6c (print "\tl
1690: 6f 67 70 72 6f 20 22 20 73 74 65 70 6e 61 6d 65 ogpro " stepname
16a0: 20 22 2e 6c 6f 67 70 72 6f 20 22 20 73 74 65 70 ".logpro " step
16b0: 6e 61 6d 65 20 22 2e 68 74 6d 6c 20 3c 20 22 20 name ".html < "
16c0: 73 74 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 22 29 stepname ".log")
16d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
16e0: 70 72 69 6e 74 29 0a 20 20 20 20 20 20 20 20 20 print).
16f0: 20 20 20 20 28 70 72 69 6e 74 20 73 74 65 70 6e (print stepn
1700: 61 6d 65 20 22 20 3a 20 22 20 73 74 65 70 6e 61 ame " : " stepna
1710: 6d 65 20 22 2e 6c 6f 67 22 29 0a 20 20 20 20 20 me ".log").
1720: 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 29 29 (print))
1730: 0a 20 20 20 20 20 20 20 20 20 20 20 23 3a 61 70 . #:ap
1740: 70 65 6e 64 29 0a 0a 09 20 28 72 6d 74 3a 74 65 pend)... (rmt:te
1750: 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 6f 63 65 st-set-top-proce
1760: 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 ss-pid run-id te
1770: 73 74 2d 69 64 20 70 69 64 29 0a 09 20 28 6c 65 st-id pid).. (le
1780: 74 20 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 t processloop ((
1790: 69 20 30 29 29 0a 09 20 20 20 28 6c 65 74 2d 76 i 0)).. (let-v
17a0: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
17b0: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
17c0: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
17d0: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
17e0: 09 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c . (mutex-l
17f0: 6f 63 6b 21 20 6d 29 0a 09 09 20 20 20 20 20 20 ock! m)...
1800: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 (launch:einf-pi
1810: 64 2d 73 65 74 21 20 20 20 20 20 20 20 20 20 65 d-set! e
1820: 78 69 74 2d 69 6e 66 6f 20 70 69 64 29 20 20 20 xit-info pid)
1830: 20 20 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 ;; (vector
1840: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1850: 30 20 70 69 64 29 0a 09 09 20 20 20 20 20 20 20 0 pid)...
1860: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 (launch:einf-exi
1870: 74 2d 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 t-status-set! ex
1880: 69 74 2d 69 6e 66 6f 20 65 78 69 74 2d 73 74 61 it-info exit-sta
1890: 74 75 73 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d tus) ;; (vector-
18a0: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 set! exit-info 1
18b0: 20 65 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 exit-status)...
18c0: 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 (launch:e
18d0: 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 2d 73 65 inf-exit-code-se
18e0: 74 21 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 65 t! exit-info e
18f0: 78 69 74 2d 63 6f 64 65 29 20 20 20 3b 3b 20 28 xit-code) ;; (
1900: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
1910: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
1920: 65 29 0a 09 09 20 20 20 20 20 20 20 28 6d 75 74 e)... (mut
1930: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 09 ex-unlock! m)...
1940: 20 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 (if (eq?
1950: 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 09 20 20 pid-val 0)....
1960: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 (begin....
1970: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 (thread-sleep! 2
1980: 29 0a 09 09 09 20 20 20 20 20 28 70 72 6f 63 65 ).... (proce
1990: 73 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 ssloop (+ i 1)))
19a0: 29 0a 09 09 20 20 20 20 20 20 20 29 29 29 29 29 )... )))))
19b0: 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
19c0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
19d0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 73 74 65 t-log-port* "ste
19e0: 70 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 63 p " stepname " c
19f0: 6f 6d 70 6c 65 74 65 64 20 77 69 74 68 20 65 78 ompleted with ex
1a00: 69 74 20 63 6f 64 65 20 22 20 28 6c 61 75 6e 63 it code " (launc
1a10: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 h:einf-exit-code
1a20: 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 exit-info)) ;;
1a30: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
1a40: 2d 69 6e 66 6f 20 32 29 29 0a 20 20 20 20 3b 3b -info 2)). ;;
1a50: 20 6e 6f 77 20 72 75 6e 20 6c 6f 67 70 72 6f 20 now run logpro
1a60: 69 66 20 6e 65 65 64 65 64 0a 20 20 20 20 28 69 if needed. (i
1a70: 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 28 f logpro-used..(
1a80: 6c 65 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 let ((pid (proce
1a90: 73 73 2d 72 75 6e 20 28 63 6f 6e 63 20 22 6c 6f ss-run (conc "lo
1aa0: 67 70 72 6f 20 22 20 6c 6f 67 70 72 6f 2d 66 69 gpro " logpro-fi
1ab0: 6c 65 20 22 20 22 20 28 63 6f 6e 63 20 73 74 65 le " " (conc ste
1ac0: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
1ad0: 20 3c 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2e < " stepname ".
1ae0: 6c 6f 67 22 29 29 29 29 0a 09 20 20 28 6c 65 74 log")))).. (let
1af0: 20 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 processloop ((i
1b00: 20 30 29 29 0a 09 20 20 20 20 28 6c 65 74 2d 76 0)).. (let-v
1b10: 61 6c 75 65 73 20 28 28 28 70 69 64 2d 76 61 6c alues (((pid-val
1b20: 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 exit-status exi
1b30: 74 2d 63 6f 64 65 29 28 70 72 6f 63 65 73 73 2d t-code)(process-
1b40: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
1b50: 09 09 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d ..(mutex-lock! m
1b60: 29 0a 09 09 09 3b 3b 20 28 6d 61 6b 65 2d 6c 61 )....;; (make-la
1b70: 75 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 70 unch:einf pid: p
1b80: 69 64 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 id exit-status:
1b90: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
1ba0: 2d 63 6f 64 65 3a 20 65 78 69 74 2d 63 6f 64 65 -code: exit-code
1bb0: 29 0a 09 09 09 28 6c 61 75 6e 63 68 3a 65 69 6e )....(launch:ein
1bc0: 66 2d 70 69 64 2d 73 65 74 21 20 20 20 20 20 20 f-pid-set!
1bd0: 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 70 69 64 exit-info pid
1be0: 29 20 20 20 20 20 20 20 20 20 3b 3b 20 28 76 65 ) ;; (ve
1bf0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
1c00: 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 28 6c nfo 0 pid)....(l
1c10: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
1c20: 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 status-set! exit
1c30: 2d 69 6e 66 6f 20 65 78 69 74 2d 73 74 61 74 75 -info exit-statu
1c40: 73 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 s) ;; (vector-se
1c50: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 t! exit-info 1 e
1c60: 78 69 74 2d 73 74 61 74 75 73 29 0a 09 09 09 28 xit-status)....(
1c70: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 launch:einf-exit
1c80: 2d 63 6f 64 65 2d 73 65 74 21 20 20 20 65 78 69 -code-set! exi
1c90: 74 2d 69 6e 66 6f 20 65 78 69 74 2d 63 6f 64 65 t-info exit-code
1ca0: 29 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 ) ;; (vector-s
1cb0: 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 et! exit-info 2
1cc0: 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 09 28 6d exit-code)....(m
1cd0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
1ce0: 09 09 09 28 69 66 20 28 65 71 3f 20 70 69 64 2d ...(if (eq? pid-
1cf0: 76 61 6c 20 30 29 0a 09 09 09 20 20 20 20 28 62 val 0).... (b
1d00: 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 28 74 egin.... (t
1d10: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a hread-sleep! 2).
1d20: 09 09 09 20 20 20 20 20 20 28 70 72 6f 63 65 73 ... (proces
1d30: 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 29 sloop (+ i 1))))
1d40: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
1d50: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
1d60: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6c ult-log-port* "l
1d70: 6f 67 70 72 6f 20 66 6f 72 20 73 74 65 70 20 22 ogpro for step "
1d80: 20 73 74 65 70 6e 61 6d 65 20 22 20 65 78 69 74 stepname " exit
1d90: 65 64 20 77 69 74 68 20 63 6f 64 65 20 22 20 28 ed with code " (
1da0: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 launch:einf-exit
1db0: 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 -code exit-info)
1dc0: 29 29 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d )))) ;; (vector-
1dd0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
1de0: 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 28 6c )))). . (l
1df0: 65 74 20 28 28 65 78 69 6e 66 6f 20 28 6c 61 75 et ((exinfo (lau
1e00: 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f nch:einf-exit-co
1e10: 64 65 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b de exit-info)) ;
1e20: 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 ; (vector-ref ex
1e30: 69 74 2d 69 6e 66 6f 20 32 29 29 0a 09 20 20 28 it-info 2)).. (
1e40: 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 logfna (if logpr
1e50: 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 o-used (conc ste
1e60: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
1e70: 22 29 29 0a 09 20 20 28 63 6f 6d 6d 65 6e 74 20 ")).. (comment
1e80: 23 66 29 29 0a 20 20 20 20 20 20 28 69 66 20 6c #f)). (if l
1e90: 6f 67 70 72 6f 2d 75 73 65 64 0a 09 20 20 28 6c ogpro-used.. (l
1ea0: 65 74 20 28 28 64 61 74 66 69 6c 65 20 28 63 6f et ((datfile (co
1eb0: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 nc stepname ".da
1ec0: 74 22 29 29 29 0a 09 20 20 20 20 3b 3b 20 6c 6f t"))).. ;; lo
1ed0: 61 64 20 74 68 65 20 2e 64 61 74 20 66 69 6c 65 ad the .dat file
1ee0: 20 69 6e 74 6f 20 74 68 65 20 74 65 73 74 5f 64 into the test_d
1ef0: 61 74 61 20 74 61 62 6c 65 20 69 66 20 69 74 20 ata table if it
1f00: 65 78 69 73 74 73 0a 09 20 20 20 20 28 69 66 20 exists.. (if
1f10: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
1f20: 73 74 73 3f 20 64 61 74 66 69 6c 65 29 0a 09 09 sts? datfile)...
1f30: 28 73 65 74 21 20 63 6f 6d 6d 65 6e 74 20 28 6c (set! comment (l
1f40: 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 aunch:load-logpr
1f50: 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 o-dat run-id tes
1f60: 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 29 29 29 t-id stepname)))
1f70: 0a 09 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d .. (rmt:test-
1f80: 73 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 set-log! run-id
1f90: 74 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 test-id (conc st
1fa0: 65 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 epname ".html"))
1fb0: 29 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 74 65 )). (rmt:te
1fc0: 73 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 ststep-set-statu
1fd0: 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
1fe0: 64 20 73 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 d stepname "end"
1ff0: 20 65 78 69 6e 66 6f 20 63 6f 6d 6d 65 6e 74 20 exinfo comment
2000: 6c 6f 67 66 6e 61 29 29 0a 20 20 20 20 3b 3b 20 logfna)). ;;
2010: 73 65 74 20 74 68 65 20 74 65 73 74 20 66 69 6e set the test fin
2020: 61 6c 20 73 74 61 74 75 73 0a 20 20 20 20 28 6c al status. (l
2030: 65 74 2a 20 28 28 70 72 6f 63 65 73 73 2d 65 78 et* ((process-ex
2040: 69 74 2d 73 74 61 74 75 73 20 28 6c 61 75 6e 63 it-status (launc
2050: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 h:einf-exit-code
2060: 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 exit-info)) ;;
2070: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
2080: 2d 69 6e 66 6f 20 32 29 29 0a 09 20 20 20 28 74 -info 2)).. (t
2090: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
20a0: 28 63 6f 6e 64 0a 09 09 09 20 20 20 20 20 20 28 (cond.... (
20b0: 28 61 6e 64 20 28 65 71 3f 20 70 72 6f 63 65 73 (and (eq? proces
20c0: 73 2d 65 78 69 74 2d 73 74 61 74 75 73 20 32 29 s-exit-status 2)
20d0: 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 77 logpro-used) 'w
20e0: 61 72 6e 29 20 20 20 3b 3b 20 6c 6f 67 70 72 6f arn) ;; logpro
20f0: 20 32 20 3d 20 77 61 72 6e 69 6e 67 73 0a 09 09 2 = warnings...
2100: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 . ((and (eq
2110: 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 ? process-exit-s
2120: 74 61 74 75 73 20 33 29 20 6c 6f 67 70 72 6f 2d tatus 3) logpro-
2130: 75 73 65 64 29 20 27 63 68 65 63 6b 29 20 20 3b used) 'check) ;
2140: 3b 20 6c 6f 67 70 72 6f 20 33 20 3d 20 63 68 65 ; logpro 3 = che
2150: 63 6b 0a 09 09 09 20 20 20 20 20 20 28 28 61 6e ck.... ((an
2160: 64 20 28 65 71 3f 20 70 72 6f 63 65 73 73 2d 65 d (eq? process-e
2170: 78 69 74 2d 73 74 61 74 75 73 20 34 29 20 6c 6f xit-status 4) lo
2180: 67 70 72 6f 2d 75 73 65 64 29 20 27 77 61 69 76 gpro-used) 'waiv
2190: 65 64 29 20 3b 3b 20 6c 6f 67 70 72 6f 20 34 20 ed) ;; logpro 4
21a0: 3d 20 77 61 69 76 65 64 0a 09 09 09 20 20 20 20 = waived....
21b0: 20 20 28 28 61 6e 64 20 28 65 71 3f 20 70 72 6f ((and (eq? pro
21c0: 63 65 73 73 2d 65 78 69 74 2d 73 74 61 74 75 73 cess-exit-status
21d0: 20 35 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 5) logpro-used)
21e0: 20 27 61 62 6f 72 74 29 20 20 3b 3b 20 6c 6f 67 'abort) ;; log
21f0: 70 72 6f 20 35 20 3d 20 61 62 6f 72 74 0a 09 09 pro 5 = abort...
2200: 09 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 71 . ((and (eq
2210: 3f 20 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 ? process-exit-s
2220: 74 61 74 75 73 20 36 29 20 6c 6f 67 70 72 6f 2d tatus 6) logpro-
2230: 75 73 65 64 29 20 27 73 6b 69 70 29 20 20 20 3b used) 'skip) ;
2240: 3b 20 6c 6f 67 70 72 6f 20 36 20 3d 20 73 6b 69 ; logpro 6 = ski
2250: 70 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3f p.... ((eq?
2260: 20 70 72 6f 63 65 73 73 2d 65 78 69 74 2d 73 74 process-exit-st
2270: 61 74 75 73 20 30 29 20 20 20 20 20 20 20 20 20 atus 0)
2280: 20 20 20 20 20 20 20 20 20 20 27 70 61 73 73 29 'pass)
2290: 20 20 20 3b 3b 20 6c 6f 67 70 72 6f 20 30 20 3d ;; logpro 0 =
22a0: 20 70 61 73 73 0a 09 09 09 20 20 20 20 20 20 28 pass.... (
22b0: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 20 else 'fail)))..
22c0: 20 20 28 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 (overall-statu
22d0: 73 20 20 20 28 63 6f 6e 64 0a 09 09 09 20 20 20 s (cond....
22e0: 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 ((eq? (launch
22f0: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
2300: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 32 tus exit-info) 2
2310: 29 20 27 77 61 72 6e 29 20 3b 3b 20 72 6f 6c 6c ) 'warn) ;; roll
2320: 75 70 2d 73 74 61 74 75 73 20 28 76 65 63 74 6f up-status (vecto
2330: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2340: 33 29 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 3).... ((eq
2350: 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 ? (launch:einf-r
2360: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 ollup-status exi
2370: 74 2d 69 6e 66 6f 29 20 30 29 20 27 70 61 73 73 t-info) 0) 'pass
2380: 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ) ;; (vector-ref
2390: 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 exit-info 3)...
23a0: 09 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 . (else 'fa
23b0: 69 6c 29 29 29 0a 09 20 20 20 28 6e 65 78 74 2d il))).. (next-
23c0: 73 74 61 74 75 73 20 20 20 20 20 20 28 63 6f 6e status (con
23d0: 64 20 0a 09 09 09 20 20 20 20 20 20 28 28 65 71 d .... ((eq
23e0: 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 ? overall-status
23f0: 20 27 70 61 73 73 29 20 74 68 69 73 2d 73 74 65 'pass) this-ste
2400: 70 2d 73 74 61 74 75 73 29 0a 09 09 09 20 20 20 p-status)....
2410: 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c ((eq? overall
2420: 2d 73 74 61 74 75 73 20 27 77 61 72 6e 29 0a 09 -status 'warn)..
2430: 09 09 20 20 20 20 20 20 20 28 69 66 20 28 65 71 .. (if (eq
2440: 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ? this-step-stat
2450: 75 73 20 27 66 61 69 6c 29 20 27 66 61 69 6c 20 us 'fail) 'fail
2460: 27 77 61 72 6e 29 29 0a 09 09 09 20 20 20 20 20 'warn))....
2470: 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 ((eq? overall-s
2480: 74 61 74 75 73 20 27 61 62 6f 72 74 29 20 27 61 tatus 'abort) 'a
2490: 62 6f 72 74 29 0a 09 09 09 20 20 20 20 20 20 28 bort).... (
24a0: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 20 else 'fail)))..
24b0: 20 20 28 6e 65 78 74 2d 73 74 61 74 65 20 20 20 (next-state
24c0: 20 20 20 20 3b 3b 20 22 52 55 4e 4e 49 4e 47 22 ;; "RUNNING"
24d0: 29 20 3b 3b 20 57 48 59 20 57 41 53 20 54 48 49 ) ;; WHY WAS THI
24e0: 53 20 43 48 41 4e 47 45 44 20 54 4f 20 4e 4f 54 S CHANGED TO NOT
24f0: 20 55 53 45 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 USE (null? tal)
2500: 20 3f 3f 0a 09 20 20 20 20 28 63 6f 6e 64 0a 09 ??.. (cond..
2510: 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 74 61 6c ((null? tal
2520: 29 20 3b 3b 20 6d 6f 72 65 20 74 6f 20 72 75 6e ) ;; more to run
2530: 3f 0a 09 20 20 20 20 20 20 22 43 4f 4d 50 4c 45 ?.. "COMPLE
2540: 54 45 44 22 29 0a 09 20 20 20 20 20 28 65 6c 73 TED").. (els
2550: 65 20 22 52 55 4e 4e 49 4e 47 22 29 29 29 29 0a e "RUNNING")))).
2560: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
2570: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
2580: 67 2d 70 6f 72 74 2a 20 22 45 78 69 74 20 76 61 g-port* "Exit va
2590: 6c 75 65 20 72 65 63 65 69 76 65 64 3a 20 22 20 lue received: "
25a0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 (launch:einf-exi
25b0: 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f t-code exit-info
25c0: 29 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 3a ) " logpro-used:
25d0: 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 0a " logpro-used .
25e0: 09 09 20 20 20 22 20 74 68 69 73 2d 73 74 65 70 .. " this-step
25f0: 2d 73 74 61 74 75 73 3a 20 22 20 74 68 69 73 2d -status: " this-
2600: 73 74 65 70 2d 73 74 61 74 75 73 20 22 20 6f 76 step-status " ov
2610: 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a 20 22 20 erall-status: "
2620: 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 20 0a overall-status .
2630: 09 09 20 20 20 22 20 6e 65 78 74 2d 73 74 61 74 .. " next-stat
2640: 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 75 us: " next-statu
2650: 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 s " rollup-statu
2660: 73 3a 20 22 20 20 28 6c 61 75 6e 63 68 3a 65 69 s: " (launch:ei
2670: 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 nf-rollup-status
2680: 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 exit-info)) ;;
2690: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
26a0: 2d 69 6e 66 6f 20 33 29 29 0a 20 20 20 20 20 20 -info 3)).
26b0: 28 63 61 73 65 20 6e 65 78 74 2d 73 74 61 74 75 (case next-statu
26c0: 73 0a 09 28 28 77 61 72 6e 29 0a 09 20 28 6c 61 s..((warn).. (la
26d0: 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 unch:einf-rollup
26e0: 2d 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 -status-set! exi
26f0: 74 2d 69 6e 66 6f 20 32 29 20 3b 3b 20 28 76 65 t-info 2) ;; (ve
2700: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
2710: 6e 66 6f 20 33 20 32 29 20 3b 3b 20 72 6f 6c 6c nfo 3 2) ;; roll
2720: 75 70 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e up-status.. ;; N
2730: 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 B// test-set-sta
2740: 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 tus! does rdb ca
2750: 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f lls under the ho
2760: 6f 64 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 od.. (tests:test
2770: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
2780: 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 -id test-id next
2790: 2d 73 74 61 74 65 20 22 57 41 52 4e 22 20 0a 09 -state "WARN" ..
27a0: 09 09 09 20 28 69 66 20 28 65 71 3f 20 74 68 69 ... (if (eq? thi
27b0: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 77 s-step-status 'w
27c0: 61 72 6e 29 20 22 4c 6f 67 70 72 6f 20 77 61 72 arn) "Logpro war
27d0: 6e 69 6e 67 20 66 6f 75 6e 64 22 20 23 66 29 0a ning found" #f).
27e0: 09 09 09 09 20 23 66 29 29 0a 09 28 28 63 68 65 .... #f))..((che
27f0: 63 6b 29 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 ck).. (launch:ei
2800: 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 nf-rollup-status
2810: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
2820: 33 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 3) ;; (vector-se
2830: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 33 t! exit-info 3 3
2840: 29 20 3b 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 ) ;; rollup-stat
2850: 75 73 0a 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 us.. ;; NB// tes
2860: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 64 6f t-set-status! do
2870: 65 73 20 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 es rdb calls und
2880: 65 72 20 74 68 65 20 68 6f 6f 64 0a 09 20 28 74 er the hood.. (t
2890: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
28a0: 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 atus! run-id tes
28b0: 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 65 20 t-id next-state
28c0: 22 43 48 45 43 4b 22 20 0a 09 09 09 09 20 28 69 "CHECK" ..... (i
28d0: 66 20 28 65 71 3f 20 74 68 69 73 2d 73 74 65 70 f (eq? this-step
28e0: 2d 73 74 61 74 75 73 20 27 63 68 65 63 6b 29 20 -status 'check)
28f0: 22 4c 6f 67 70 72 6f 20 63 68 65 63 6b 20 66 6f "Logpro check fo
2900: 75 6e 64 22 20 23 66 29 0a 09 09 09 09 20 23 66 und" #f)..... #f
2910: 29 29 0a 09 28 28 77 61 69 76 65 64 29 0a 09 20 ))..((waived)..
2920: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
2930: 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 21 20 lup-status-set!
2940: 65 78 69 74 2d 69 6e 66 6f 20 34 29 20 3b 3b 20 exit-info 4) ;;
2950: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 (vector-set! exi
2960: 74 2d 69 6e 66 6f 20 33 20 33 29 20 3b 3b 20 72 t-info 3 3) ;; r
2970: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a 09 20 3b ollup-status.. ;
2980: 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d ; NB// test-set-
2990: 73 74 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 status! does rdb
29a0: 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 calls under the
29b0: 20 68 6f 6f 64 0a 09 20 28 74 65 73 74 73 3a 74 hood.. (tests:t
29c0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
29d0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e run-id test-id n
29e0: 65 78 74 2d 73 74 61 74 65 20 22 57 41 49 56 45 ext-state "WAIVE
29f0: 44 22 20 0a 09 09 09 09 20 28 69 66 20 28 65 71 D" ..... (if (eq
2a00: 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 ? this-step-stat
2a10: 75 73 20 27 63 68 65 63 6b 29 20 22 4c 6f 67 70 us 'check) "Logp
2a20: 72 6f 20 77 61 69 76 65 64 20 66 6f 75 6e 64 22 ro waived found"
2a30: 20 23 66 29 0a 09 09 09 09 20 23 66 29 29 0a 09 #f)..... #f))..
2a40: 28 28 61 62 6f 72 74 29 0a 09 20 28 6c 61 75 6e ((abort).. (laun
2a50: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
2a60: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
2a70: 69 6e 66 6f 20 35 29 20 3b 3b 20 28 76 65 63 74 info 5) ;; (vect
2a80: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2a90: 6f 20 33 20 34 29 20 3b 3b 20 72 6f 6c 6c 75 70 o 3 4) ;; rollup
2aa0: 2d 73 74 61 74 75 73 0a 09 20 3b 3b 20 4e 42 2f -status.. ;; NB/
2ab0: 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 / test-set-statu
2ac0: 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 6c 6c s! does rdb call
2ad0: 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f 6f 64 s under the hood
2ae0: 0a 09 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 .. (tests:test-s
2af0: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
2b00: 64 20 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 d test-id next-s
2b10: 74 61 74 65 20 22 41 42 4f 52 54 22 20 0a 09 09 tate "ABORT" ...
2b20: 09 09 20 28 69 66 20 28 65 71 3f 20 74 68 69 73 .. (if (eq? this
2b30: 2d 73 74 65 70 2d 73 74 61 74 75 73 20 27 61 62 -step-status 'ab
2b40: 6f 72 74 29 20 22 4c 6f 67 70 72 6f 20 61 62 6f ort) "Logpro abo
2b50: 72 74 20 66 6f 75 6e 64 22 20 23 66 29 0a 09 09 rt found" #f)...
2b60: 09 09 20 23 66 29 29 0a 09 28 28 73 6b 69 70 29 .. #f))..((skip)
2b70: 0a 09 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d .. (launch:einf-
2b80: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 rollup-status-se
2b90: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 36 29 20 t! exit-info 6)
2ba0: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
2bb0: 65 78 69 74 2d 69 6e 66 6f 20 33 20 34 29 20 3b exit-info 3 4) ;
2bc0: 3b 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 0a ; rollup-status.
2bd0: 09 20 3b 3b 20 4e 42 2f 2f 20 74 65 73 74 2d 73 . ;; NB// test-s
2be0: 65 74 2d 73 74 61 74 75 73 21 20 64 6f 65 73 20 et-status! does
2bf0: 72 64 62 20 63 61 6c 6c 73 20 75 6e 64 65 72 20 rdb calls under
2c00: 74 68 65 20 68 6f 6f 64 0a 09 20 28 74 65 73 74 the hood.. (test
2c10: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
2c20: 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
2c30: 64 20 6e 65 78 74 2d 73 74 61 74 65 20 22 53 4b d next-state "SK
2c40: 49 50 22 20 0a 09 09 09 09 20 28 69 66 20 28 65 IP" ..... (if (e
2c50: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
2c60: 74 75 73 20 27 73 6b 69 70 29 20 22 4c 6f 67 70 tus 'skip) "Logp
2c70: 72 6f 20 73 6b 69 70 20 66 6f 75 6e 64 22 20 23 ro skip found" #
2c80: 66 29 0a 09 09 09 09 20 23 66 29 29 0a 09 28 28 f)..... #f))..((
2c90: 70 61 73 73 29 0a 09 20 28 74 65 73 74 73 3a 74 pass).. (tests:t
2ca0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
2cb0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e run-id test-id n
2cc0: 65 78 74 2d 73 74 61 74 65 20 22 50 41 53 53 22 ext-state "PASS"
2cd0: 20 23 66 20 23 66 29 29 0a 09 28 65 6c 73 65 20 #f #f))..(else
2ce0: 3b 3b 20 27 66 61 69 6c 0a 09 20 28 6c 61 75 6e ;; 'fail.. (laun
2cf0: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
2d00: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
2d10: 69 6e 66 6f 20 31 29 20 3b 3b 20 28 76 65 63 74 info 1) ;; (vect
2d20: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2d30: 6f 20 33 20 31 29 20 3b 3b 20 66 6f 72 63 65 20 o 3 1) ;; force
2d40: 66 61 69 6c 2c 20 74 68 69 73 20 75 73 65 64 20 fail, this used
2d50: 74 6f 20 62 65 20 6e 65 78 74 2d 73 74 61 74 65 to be next-state
2d60: 20 62 75 74 20 74 68 61 74 20 64 6f 65 73 6e 27 but that doesn'
2d70: 74 20 6d 61 6b 65 20 73 65 6e 73 65 2e 20 73 68 t make sense. sh
2d80: 6f 75 6c 64 20 61 6c 77 61 79 73 20 62 65 20 22 ould always be "
2d90: 43 4f 4d 50 4c 45 54 45 44 22 20 0a 09 20 28 74 COMPLETED" .. (t
2da0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
2db0: 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 atus! run-id tes
2dc0: 74 2d 69 64 20 22 43 4f 4d 50 4c 45 54 45 44 22 t-id "COMPLETED"
2dd0: 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 22 46 "FAIL" (conc "F
2de0: 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 22 20 ailed at step "
2df0: 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a 09 20 stepname) #f)..
2e00: 29 29 29 0a 20 20 20 20 6c 6f 67 70 72 6f 2d 75 ))). logpro-u
2e10: 73 65 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 sed))..(define (
2e20: 6c 61 75 6e 63 68 3a 6d 61 6e 61 67 65 2d 73 74 launch:manage-st
2e30: 65 70 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d eps run-id test-
2e40: 69 64 20 69 74 65 6d 2d 70 61 74 68 20 66 75 6c id item-path ful
2e50: 6c 72 75 6e 73 63 72 69 70 74 20 65 7a 73 74 65 lrunscript ezste
2e60: 70 73 20 74 65 73 74 2d 6e 61 6d 65 20 74 63 6f ps test-name tco
2e70: 6e 66 69 67 72 65 67 20 65 78 69 74 2d 69 6e 66 nfigreg exit-inf
2e80: 6f 20 6d 29 0a 20 20 3b 3b 20 28 6c 65 74 2d 76 o m). ;; (let-v
2e90: 61 6c 75 65 73 0a 20 20 3b 3b 20 20 28 28 28 70 alues. ;; (((p
2ea0: 69 64 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 id exit-status e
2eb0: 78 69 74 2d 63 6f 64 65 29 0a 20 20 3b 3b 20 20 xit-code). ;;
2ec0: 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 20 66 75 (run-n-wait fu
2ed0: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 20 llrunscript))).
2ee0: 20 3b 3b 20 28 74 65 73 74 73 3a 74 65 73 74 2d ;; (tests:test-
2ef0: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test
2f00: 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e -id "RUNNING" "n
2f10: 2f 61 22 20 23 66 20 23 66 29 0a 20 20 3b 3b 20 /a" #f #f). ;;
2f20: 53 69 6e 63 65 20 77 65 20 73 68 6f 75 6c 64 20 Since we should
2f30: 68 61 76 65 20 61 20 63 6c 65 61 6e 20 73 6c 61 have a clean sla
2f40: 74 65 20 61 74 20 74 68 69 73 20 74 69 6d 65 20 te at this time
2f50: 74 68 65 72 65 20 69 73 20 6e 6f 20 6e 65 65 64 there is no need
2f60: 20 74 6f 20 64 6f 20 0a 20 20 3b 3b 20 61 6e 79 to do . ;; any
2f70: 20 6f 66 20 74 68 65 20 6f 74 68 65 72 20 73 74 of the other st
2f80: 75 66 66 20 74 68 61 74 20 74 65 73 74 73 3a 74 uff that tests:t
2f90: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
2fa0: 64 6f 65 73 2e 20 4c 65 74 27 73 20 6a 75 73 74 does. Let's just
2fb0: 20 0a 20 20 3b 3b 20 66 6f 72 63 65 20 52 55 4e . ;; force RUN
2fc0: 4e 49 4e 47 2f 6e 2f 61 0a 0a 20 20 3b 3b 20 28 NING/n/a.. ;; (
2fd0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
2fe0: 33 29 0a 20 20 3b 3b 20 28 74 65 73 74 73 3a 74 3). ;; (tests:t
2ff0: 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 65 2d est-force-state-
3000: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
3010: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
3020: 20 22 6e 2f 61 22 29 0a 20 20 28 72 6d 74 3a 73 "n/a"). (rmt:s
3030: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
3040: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
3050: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
3060: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 22 52 55 me item-path "RU
3070: 4e 4e 49 4e 47 22 20 23 66 20 23 66 29 20 0a 20 NNING" #f #f) .
3080: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
3090: 70 21 20 30 2e 33 29 20 3b 3b 20 4e 46 53 20 73 p! 0.3) ;; NFS s
30a0: 6c 6f 77 6e 65 73 73 20 68 61 73 20 63 61 75 73 lowness has caus
30b0: 65 64 20 67 72 69 65 66 20 68 65 72 65 0a 0a 20 ed grief here..
30c0: 20 3b 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 ;; if there is
30d0: 61 20 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 a runscript do i
30e0: 74 20 66 69 72 73 74 0a 20 20 28 69 66 20 66 75 t first. (if fu
30f0: 6c 6c 72 75 6e 73 63 72 69 70 74 0a 20 20 20 20 llrunscript.
3100: 20 20 28 6c 65 74 20 28 28 70 69 64 20 28 70 72 (let ((pid (pr
3110: 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c 6c 72 75 ocess-run fullru
3120: 6e 73 63 72 69 70 74 29 29 29 0a 09 28 72 6d 74 nscript)))..(rmt
3130: 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 2d 70 72 :test-set-top-pr
3140: 6f 63 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 ocess-pid run-id
3150: 20 74 65 73 74 2d 69 64 20 70 69 64 29 0a 09 28 test-id pid)..(
3160: 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 30 29 29 let loop ((i 0))
3170: 0a 09 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a .. (let-values.
3180: 09 20 20 20 28 28 28 70 69 64 2d 76 61 6c 20 65 . (((pid-val e
3190: 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d xit-status exit-
31a0: 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 2d 77 code) (process-w
31b0: 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 20 ait pid #t)))..
31c0: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
31d0: 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 ).. (launch:ei
31e0: 6e 66 2d 70 69 64 2d 73 65 74 21 20 20 20 20 20 nf-pid-set!
31f0: 20 20 20 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 exit-info
3200: 20 70 69 64 29 20 20 20 20 20 20 20 20 20 3b 3b pid) ;;
3210: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
3220: 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 29 0a 09 it-info 0 pid)..
3230: 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d (launch:einf-
3240: 65 78 69 74 2d 73 74 61 74 75 73 2d 73 65 74 21 exit-status-set!
3250: 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 exit-info ex
3260: 69 74 2d 73 74 61 74 75 73 29 20 3b 3b 20 28 76 it-status) ;; (v
3270: 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d ector-set! exit-
3280: 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 61 74 info 1 exit-stat
3290: 75 73 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 3a us).. (launch:
32a0: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 2d 73 einf-exit-code-s
32b0: 65 74 21 20 20 20 20 20 65 78 69 74 2d 69 6e 66 et! exit-inf
32c0: 6f 20 20 65 78 69 74 2d 63 6f 64 65 29 20 20 20 o exit-code)
32d0: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
32e0: 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 69 74 exit-info 2 exit
32f0: 2d 63 6f 64 65 29 0a 09 20 20 20 28 6c 61 75 6e -code).. (laun
3300: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
3310: 74 61 74 75 73 2d 73 65 74 21 20 65 78 69 74 2d tatus-set! exit-
3320: 69 6e 66 6f 20 20 65 78 69 74 2d 63 6f 64 65 29 info exit-code)
3330: 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 ;; (vector-se
3340: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 33 20 65 t! exit-info 3 e
3350: 78 69 74 2d 63 6f 64 65 29 20 20 3b 3b 20 72 6f xit-code) ;; ro
3360: 6c 6c 75 70 20 73 74 61 74 75 73 0a 09 20 20 20 llup status..
3370: 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d (mutex-unlock! m
3380: 29 0a 09 20 20 20 28 69 66 20 28 65 71 3f 20 70 ).. (if (eq? p
3390: 69 64 2d 76 61 6c 20 30 29 0a 09 20 20 20 20 20 id-val 0)..
33a0: 20 20 28 62 65 67 69 6e 0a 09 09 20 28 74 68 72 (begin... (thr
33b0: 65 61 64 2d 73 6c 65 65 70 21 20 32 29 0a 09 09 ead-sleep! 2)...
33c0: 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 (loop (+ i 1)))
33d0: 0a 09 20 20 20 20 20 20 20 29 29 29 29 29 0a 20 .. ))))).
33e0: 20 3b 3b 20 74 68 65 6e 2c 20 69 66 20 72 75 6e ;; then, if run
33f0: 73 63 72 69 70 74 20 72 61 6e 20 6f 6b 20 28 6f script ran ok (o
3400: 72 20 64 69 64 20 6e 6f 74 20 67 65 74 20 63 61 r did not get ca
3410: 6c 6c 65 64 29 0a 20 20 3b 3b 20 64 6f 20 61 6c lled). ;; do al
3420: 6c 20 74 68 65 20 65 7a 73 74 65 70 73 20 28 69 l the ezsteps (i
3430: 66 20 61 6e 79 29 0a 20 20 28 69 66 20 65 7a 73 f any). (if ezs
3440: 74 65 70 73 0a 20 20 20 20 20 20 28 6c 65 74 2a teps. (let*
3450: 20 28 28 74 65 73 74 63 6f 6e 66 69 67 20 3b 3b ((testconfig ;;
3460: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 (read-config (c
3470: 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 2f onc work-area "/
3480: 74 65 73 74 63 6f 6e 66 69 67 22 29 20 23 66 20 testconfig") #f
3490: 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 3a #t environ-patt:
34a0: 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 "pre-launch-env
34b0: 2d 76 61 72 73 22 29 29 20 3b 3b 20 46 49 58 4d -vars")) ;; FIXM
34c0: 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 2d 73 79 E??? is allow-sy
34d0: 73 74 65 6d 20 6f 6b 20 68 65 72 65 3f 0a 09 20 stem ok here?..
34e0: 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 69 74 ;; NOTE: it
34f0: 20 69 73 20 74 65 6d 70 74 69 6e 67 20 74 6f 20 is tempting to
3500: 74 75 72 6e 20 6f 66 66 20 66 6f 72 63 65 2d 63 turn off force-c
3510: 72 65 61 74 65 20 6f 66 20 74 65 73 74 63 6f 6e reate of testcon
3520: 66 69 67 20 62 75 74 20 64 79 6e 61 6d 69 63 0a fig but dynamic.
3530: 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 . ;;
3540: 65 7a 73 74 65 70 20 6e 61 6d 65 73 20 6e 65 65 ezstep names nee
3550: 64 20 61 20 66 75 6c 6c 20 72 65 2d 65 76 61 6c d a full re-eval
3560: 20 68 65 72 65 2e 0a 09 20 20 20 20 20 20 28 74 here... (t
3570: 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e ests:get-testcon
3580: 66 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 fig test-name it
3590: 65 6d 2d 70 61 74 68 20 74 63 6f 6e 66 69 67 72 em-path tconfigr
35a0: 65 67 20 23 74 20 66 6f 72 63 65 2d 63 72 65 61 eg #t force-crea
35b0: 74 65 3a 20 23 74 29 29 20 3b 3b 20 27 72 65 74 te: #t)) ;; 'ret
35c0: 75 72 6e 2d 70 72 6f 63 73 29 29 29 0a 09 20 20 urn-procs)))..
35d0: 20 20 20 28 65 7a 73 74 65 70 73 6c 73 74 20 28 (ezstepslst (
35e0: 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 if (hash-table?
35f0: 74 65 73 74 63 6f 6e 66 69 67 29 0a 09 09 09 20 testconfig)....
3600: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
3610: 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 73 74 ref/default test
3620: 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 config "ezsteps"
3630: 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 23 66 '()).... #f
3640: 29 29 29 0a 09 28 69 66 20 74 65 73 74 63 6f 6e )))..(if testcon
3650: 66 69 67 0a 09 20 20 20 20 28 68 61 73 68 2d 74 fig.. (hash-t
3660: 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 74 63 able-set! *testc
3670: 6f 6e 66 69 67 73 2a 20 74 65 73 74 2d 6e 61 6d onfigs* test-nam
3680: 65 20 74 65 73 74 63 6f 6e 66 69 67 29 20 3b 3b e testconfig) ;;
3690: 20 63 61 63 68 65 64 20 66 6f 72 20 6c 61 7a 79 cached for lazy
36a0: 20 72 65 61 64 73 20 6c 61 74 65 72 20 2e 2e 2e reads later ...
36b0: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
36c0: 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 (launch:setu
36d0: 70 29 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 p).. (debug
36e0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
36f0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
3700: 4e 49 4e 47 3a 20 6e 6f 20 74 65 73 74 63 6f 6e NING: no testcon
3710: 66 69 67 20 66 6f 75 6e 64 20 66 6f 72 20 22 20 fig found for "
3720: 74 65 73 74 2d 6e 61 6d 65 20 22 20 69 6e 20 73 test-name " in s
3730: 65 61 72 63 68 20 70 61 74 68 3a 5c 6e 20 20 22 earch path:\n "
3740: 0a 09 09 09 20 20 20 28 73 74 72 69 6e 67 2d 69 .... (string-i
3750: 6e 74 65 72 73 70 65 72 73 65 20 28 74 65 73 74 ntersperse (test
3760: 73 3a 67 65 74 2d 74 65 73 74 73 2d 73 65 61 72 s:get-tests-sear
3770: 63 68 2d 70 61 74 68 20 2a 63 6f 6e 66 69 67 64 ch-path *configd
3780: 61 74 2a 29 20 22 5c 6e 20 20 22 29 29 29 29 0a at*) "\n ")))).
3790: 09 3b 3b 20 61 66 74 65 72 20 61 6c 6c 20 74 68 .;; after all th
37a0: 61 74 2c 20 73 74 69 6c 6c 20 6e 6f 20 74 65 73 at, still no tes
37b0: 74 63 6f 6e 66 69 67 3f 20 54 69 6d 65 20 74 6f tconfig? Time to
37c0: 20 61 62 6f 72 74 0a 09 28 69 66 20 28 6e 6f 74 abort..(if (not
37d0: 20 74 65 73 74 63 6f 6e 66 69 67 29 0a 09 20 20 testconfig)..
37e0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
37f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
3800: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
3810: 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 20 g-port* "Failed
3820: 74 6f 20 72 65 73 6f 6c 76 65 20 6d 65 67 61 74 to resolve megat
3830: 65 73 74 2e 63 6f 6e 66 69 67 2c 20 72 75 6e 63 est.config, runc
3840: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 61 6e onfigs.config an
3850: 64 20 74 65 73 74 63 6f 6e 66 69 67 20 69 73 73 d testconfig iss
3860: 75 65 73 2e 20 47 69 76 69 6e 67 20 75 70 20 6e ues. Giving up n
3870: 6f 77 22 29 0a 09 20 20 20 20 20 20 28 65 78 69 ow").. (exi
3880: 74 20 31 29 29 29 0a 09 28 69 66 20 28 6e 6f 74 t 1)))..(if (not
3890: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
38a0: 69 73 74 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 ists? ".ezsteps"
38b0: 29 29 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ))(create-direct
38c0: 6f 72 79 20 22 2e 65 7a 73 74 65 70 73 22 29 29 ory ".ezsteps"))
38d0: 0a 09 3b 3b 20 69 66 20 65 7a 73 74 65 70 73 20 ..;; if ezsteps
38e0: 77 61 73 20 64 65 66 69 6e 65 64 20 74 68 65 6e was defined then
38f0: 20 77 65 20 61 72 65 20 73 75 72 65 20 74 6f 20 we are sure to
3900: 68 61 76 65 20 61 74 20 6c 65 61 73 74 20 6f 6e have at least on
3910: 65 20 73 74 65 70 20 62 75 74 20 63 68 65 63 6b e step but check
3920: 20 61 6e 79 77 61 79 0a 09 28 69 66 20 28 6e 6f anyway..(if (no
3930: 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a 73 t (> (length ezs
3940: 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 20 20 tepslst) 0))..
3950: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
3960: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
3970: 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 7a 73 74 65 log-port* "ezste
3980: 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 20 65 ps defined but e
3990: 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a 65 72 zstepslst is zer
39a0: 6f 20 6c 65 6e 67 74 68 22 29 0a 09 20 20 20 20 o length")..
39b0: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 (let loop ((ezst
39c0: 65 70 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c ep (car ezstepsl
39d0: 73 74 29 29 0a 09 09 20 20 20 20 20 20 20 28 74 st))... (t
39e0: 61 6c 20 20 20 20 28 63 64 72 20 65 7a 73 74 65 al (cdr ezste
39f0: 70 73 6c 73 74 29 29 0a 09 09 20 20 20 20 20 20 pslst))...
3a00: 20 28 70 72 65 76 73 74 65 70 20 23 66 29 29 0a (prevstep #f)).
3a10: 09 20 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 . ;; check
3a20: 65 78 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f exit-info (vecto
3a30: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
3a40: 31 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 6c 1).. (if (l
3a50: 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d aunch:einf-exit-
3a60: 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f status exit-info
3a70: 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ) ;; (vector-ref
3a80: 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 exit-info 1)...
3a90: 20 20 28 6c 65 74 20 28 28 6c 6f 67 70 72 6f 2d (let ((logpro-
3aa0: 75 73 65 64 20 28 6c 61 75 6e 63 68 3a 72 75 6e used (launch:run
3ab0: 73 74 65 70 20 65 7a 73 74 65 70 20 72 75 6e 2d step ezstep run-
3ac0: 69 64 20 74 65 73 74 2d 69 64 20 65 78 69 74 2d id test-id exit-
3ad0: 69 6e 66 6f 20 6d 20 74 61 6c 20 74 65 73 74 63 info m tal testc
3ae0: 6f 6e 66 69 67 29 29 0a 09 09 09 28 73 74 65 70 onfig))....(step
3af0: 6e 61 6d 65 20 20 20 20 28 63 61 72 20 65 7a 73 name (car ezs
3b00: 74 65 70 29 29 29 0a 09 09 20 20 20 20 3b 3b 20 tep)))... ;;
3b10: 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 72 if logpro-used r
3b20: 65 61 64 20 69 6e 20 74 68 65 20 73 74 65 70 6e ead in the stepn
3b30: 61 6d 65 2e 64 61 74 20 66 69 6c 65 0a 09 09 20 ame.dat file...
3b40: 20 20 20 28 69 66 20 28 61 6e 64 20 6c 6f 67 70 (if (and logp
3b50: 72 6f 2d 75 73 65 64 20 28 63 6f 6d 6d 6f 6e 3a ro-used (common:
3b60: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f file-exists? (co
3b70: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 nc stepname ".da
3b80: 74 22 29 29 29 0a 09 09 09 28 6c 61 75 6e 63 68 t")))....(launch
3b90: 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 74 :load-logpro-dat
3ba0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
3bb0: 73 74 65 70 6e 61 6d 65 29 29 0a 09 09 20 20 20 stepname))...
3bc0: 20 28 69 66 20 28 73 74 65 70 72 75 6e 2d 67 6f (if (steprun-go
3bd0: 6f 64 3f 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 od? logpro-used
3be0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 (launch:einf-exi
3bf0: 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 6f t-code exit-info
3c00: 29 29 0a 09 09 09 28 69 66 20 28 6e 6f 74 20 28 ))....(if (not (
3c10: 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 09 20 null? tal))....
3c20: 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 (loop (car ta
3c30: 6c 29 20 28 63 64 72 20 74 61 6c 29 20 73 74 65 l) (cdr tal) ste
3c40: 70 6e 61 6d 65 29 29 0a 09 09 09 28 64 65 62 75 pname))....(debu
3c50: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
3c60: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 lt-log-port* "WA
3c70: 52 4e 49 4e 47 3a 20 73 74 65 70 20 22 20 28 63 RNING: step " (c
3c80: 61 72 20 65 7a 73 74 65 70 29 20 22 20 66 61 69 ar ezstep) " fai
3c90: 6c 65 64 2e 20 53 74 6f 70 70 69 6e 67 22 29 29 led. Stopping"))
3ca0: 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 )... (debug:pri
3cb0: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
3cc0: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
3cd0: 3a 20 61 20 70 72 69 6f 72 20 73 74 65 70 20 66 : a prior step f
3ce0: 61 69 6c 65 64 2c 20 73 74 6f 70 70 69 6e 67 20 ailed, stopping
3cf0: 61 74 20 22 20 65 7a 73 74 65 70 29 29 29 29 29 at " ezstep)))))
3d00: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 ))..(define (lau
3d10: 6e 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 nch:monitor-job
3d20: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 run-id test-id i
3d30: 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e tem-path fullrun
3d40: 73 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 script ezsteps t
3d50: 65 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 est-name tconfig
3d60: 72 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 reg exit-info m
3d70: 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 74 6c 69 work-area runtli
3d80: 6d 20 6d 69 73 63 2d 66 6c 61 67 73 29 0a 20 20 m misc-flags).
3d90: 28 6c 65 74 2a 20 28 28 75 70 64 61 74 65 2d 70 (let* ((update-p
3da0: 65 72 69 6f 64 20 28 73 74 72 69 6e 67 2d 3e 6e eriod (string->n
3db0: 75 6d 62 65 72 20 28 6f 72 20 28 63 6f 6e 66 69 umber (or (confi
3dc0: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
3dd0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 74 gdat* "setup" "t
3de0: 65 73 74 2d 73 74 61 74 73 2d 75 70 64 61 74 65 est-stats-update
3df0: 2d 70 65 72 69 6f 64 22 29 20 22 33 30 22 29 29 -period") "30"))
3e00: 29 0a 20 20 20 20 20 20 20 20 20 28 73 74 61 72 ). (star
3e10: 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 72 72 65 t-seconds (curre
3e20: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 20 28 nt-seconds)).. (
3e30: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c calc-minutes (l
3e40: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 28 69 ambda ().... (i
3e50: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 nexact->exact ..
3e60: 09 09 20 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 .. (round ....
3e70: 20 20 20 20 28 2d 20 0a 09 09 09 20 20 20 20 20 (- ....
3e80: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
3e90: 29 20 0a 09 09 09 20 20 20 20 20 73 74 61 72 74 ) .... start
3ea0: 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 20 -seconds)))))..
3eb0: 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a (kill-tries 0)).
3ec0: 20 20 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 ;; (tests:se
3ed0: 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f t-full-meta-info
3ee0: 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d #f test-id run-
3ef0: 69 64 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 id (calc-minutes
3f00: 29 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 ) work-area).
3f10: 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d 66 ;; (tests:set-f
3f20: 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 65 ull-meta-info te
3f30: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 st-id run-id (ca
3f40: 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b lc-minutes) work
3f50: 2d 61 72 65 61 29 0a 20 20 20 20 28 74 65 73 74 -area). (test
3f60: 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d s:set-full-meta-
3f70: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
3f80: 72 75 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e run-id (calc-min
3f90: 75 74 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 20 utes) work-area
3fa0: 31 30 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 10). (let loo
3fb0: 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28 63 p ((minutes (c
3fc0: 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 0a 09 20 alc-minutes))..
3fd0: 20 20 20 20 20 20 28 63 70 75 2d 6c 6f 61 64 20 (cpu-load
3fe0: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 64 6a (alist-ref 'adj
3ff0: 2d 63 6f 72 65 2d 6c 6f 61 64 20 28 63 6f 6d 6d -core-load (comm
4000: 6f 6e 3a 67 65 74 2d 6e 6f 72 6d 61 6c 69 7a 65 on:get-normalize
4010: 64 2d 63 70 75 2d 6c 6f 61 64 20 23 66 29 29 29 d-cpu-load #f)))
4020: 0a 09 20 20 20 20 20 20 20 28 64 69 73 6b 2d 66 .. (disk-f
4030: 72 65 65 20 28 67 65 74 2d 64 66 20 28 63 75 72 ree (get-df (cur
4040: 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 rent-directory))
4050: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4060: 20 28 6c 61 73 74 2d 73 79 6e 63 20 28 63 75 72 (last-sync (cur
4070: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a rent-seconds))).
4080: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6f 76 (let* ((ov
4090: 65 72 2d 74 69 6d 65 20 20 20 20 20 28 3e 20 28 er-time (> (
40a0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
40b0: 20 28 2b 20 6c 61 73 74 2d 73 79 6e 63 20 75 70 (+ last-sync up
40c0: 64 61 74 65 2d 70 65 72 69 6f 64 29 29 29 0a 20 date-period))).
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 (new
40e0: 2d 63 70 75 2d 6c 6f 61 64 20 20 28 6c 65 74 2a -cpu-load (let*
40f0: 20 28 28 6c 6f 61 64 20 20 28 61 6c 69 73 74 2d ((load (alist-
4100: 72 65 66 20 27 61 64 6a 2d 63 6f 72 65 2d 6c 6f ref 'adj-core-lo
4110: 61 64 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6e ad (common:get-n
4120: 6f 72 6d 61 6c 69 7a 65 64 2d 63 70 75 2d 6c 6f ormalized-cpu-lo
4130: 61 64 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 ad #f))).
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4150: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 6c (del
4160: 74 61 20 28 61 62 73 20 28 2d 20 6c 6f 61 64 20 ta (abs (- load
4170: 63 70 75 2d 6c 6f 61 64 29 29 29 29 0a 20 20 20 cpu-load)))).
4180: 20 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 28 69 66 20 28 (if (
41a0: 3e 20 64 65 6c 74 61 20 30 2e 31 29 20 3b 3b 20 > delta 0.1) ;;
41b0: 64 6f 6e 27 74 20 62 6f 74 68 65 72 20 75 70 64 don't bother upd
41c0: 61 74 69 6e 67 20 77 69 74 68 20 73 6d 61 6c 6c ating with small
41d0: 20 63 68 61 6e 67 65 73 0a 20 20 20 20 20 20 20 changes.
41e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41f0: 20 20 20 20 20 20 20 20 20 20 20 6c 6f 61 64 0a load.
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4220: 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 #f))).
4230: 20 20 20 20 20 28 6e 65 77 2d 64 69 73 6b 2d 66 (new-disk-f
4240: 72 65 65 20 28 6c 65 74 2a 20 28 28 64 66 20 20 ree (let* ((df
4250: 20 20 28 69 66 20 6f 76 65 72 2d 74 69 6d 65 20 (if over-time
4260: 3b 3b 20 6f 6e 6c 79 20 67 65 74 20 64 66 20 65 ;; only get df e
4270: 76 65 72 79 20 33 30 20 73 65 63 6f 6e 64 73 0a very 30 seconds.
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 (g
42b0: 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 et-df (current-d
42c0: 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 20 20 irectory)).
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 20 20 20 64 69 73 6b 2d 66 72 disk-fr
4300: 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ee)).
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4320: 20 20 20 20 20 20 20 20 28 64 65 6c 74 61 20 28 (delta (
4330: 61 62 73 20 28 2d 20 64 66 20 64 69 73 6b 2d 66 abs (- df disk-f
4340: 72 65 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 ree)))).
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4360: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
4370: 3e 20 64 66 20 30 29 0a 20 20 20 20 20 20 20 20 > df 0).
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
43a0: 3e 20 28 2f 20 64 65 6c 74 61 20 64 66 29 20 30 > (/ delta df) 0
43b0: 2e 31 29 29 20 3b 3b 20 28 3e 20 64 65 6c 74 61 .1)) ;; (> delta
43c0: 20 32 30 30 29 20 3b 3b 20 69 67 6e 6f 72 65 20 200) ;; ignore
43d0: 63 68 61 6e 67 65 73 20 75 6e 64 65 72 20 32 30 changes under 20
43e0: 30 20 4d 65 67 0a 20 20 20 20 20 20 20 20 20 20 0 Meg.
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 20 20 20 20 20 20 20 64 66 0a 20 20 20 20 20 df.
4410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
4430: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4440: 28 64 6f 2d 73 79 6e 63 20 20 20 20 20 20 20 28 (do-sync (
4450: 6f 72 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 or new-cpu-load
4460: 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 20 6f 76 new-disk-free ov
4470: 65 72 2d 74 69 6d 65 29 29 29 0a 20 20 20 20 20 er-time))).
4480: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
4490: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
44a0: 6f 72 74 2a 20 22 63 70 75 3a 20 22 20 6e 65 77 ort* "cpu: " new
44b0: 2d 63 70 75 2d 6c 6f 61 64 20 22 20 64 69 73 6b -cpu-load " disk
44c0: 3a 20 22 20 6e 65 77 2d 64 69 73 6b 2d 66 72 65 : " new-disk-fre
44d0: 65 20 22 20 6c 61 73 74 2d 73 79 6e 63 3a 20 22 e " last-sync: "
44e0: 20 6c 61 73 74 2d 73 79 6e 63 20 22 20 64 6f 2d last-sync " do-
44f0: 73 79 6e 63 3a 20 22 20 64 6f 2d 73 79 6e 63 29 sync: " do-sync)
4500: 0a 09 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 ..(set! kill-job
4510: 3f 20 28 6f 72 20 28 74 65 73 74 2d 67 65 74 2d ? (or (test-get-
4520: 6b 69 6c 6c 2d 72 65 71 75 65 73 74 20 72 75 6e kill-request run
4530: 2d 69 64 20 74 65 73 74 2d 69 64 29 20 3b 3b 20 -id test-id) ;;
4540: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
4550: 20 69 74 65 6d 64 61 74 29 29 0a 09 09 09 20 20 itemdat))....
4560: 20 20 28 61 6e 64 20 72 75 6e 74 6c 69 6d 20 28 (and runtlim (
4570: 6c 65 74 2a 20 28 28 72 75 6e 2d 73 65 63 6f 6e let* ((run-secon
4580: 64 73 20 20 20 28 2d 20 28 63 75 72 72 65 6e 74 ds (- (current
4590: 2d 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 2d -seconds) start-
45a0: 73 65 63 6f 6e 64 73 29 29 0a 09 09 09 09 09 09 seconds)).......
45b0: 28 74 69 6d 65 2d 65 78 63 65 65 64 65 64 20 28 (time-exceeded (
45c0: 3e 20 72 75 6e 2d 73 65 63 6f 6e 64 73 20 72 75 > run-seconds ru
45d0: 6e 74 6c 69 6d 29 29 29 0a 09 09 09 09 09 20 20 ntlim)))......
45e0: 20 28 69 66 20 74 69 6d 65 2d 65 78 63 65 65 64 (if time-exceed
45f0: 65 64 0a 09 09 09 09 09 20 20 20 20 20 20 20 28 ed...... (
4600: 62 65 67 69 6e 0a 09 09 09 09 09 09 20 28 64 65 begin....... (de
4610: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
4620: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
4630: 72 74 2a 20 22 4b 49 4c 4c 49 4e 47 20 54 45 53 rt* "KILLING TES
4640: 54 20 44 55 45 20 54 4f 20 54 49 4d 45 20 4c 49 T DUE TO TIME LI
4650: 4d 49 54 20 45 58 43 45 45 44 45 44 21 20 52 75 MIT EXCEEDED! Ru
4660: 6e 74 69 6d 65 3d 22 20 72 75 6e 2d 73 65 63 6f ntime=" run-seco
4670: 6e 64 73 20 22 20 73 65 63 6f 6e 64 73 2c 20 6c nds " seconds, l
4680: 69 6d 69 74 3d 22 20 72 75 6e 74 6c 69 6d 29 0a imit=" runtlim).
4690: 09 09 09 09 09 09 20 23 74 29 0a 09 09 09 09 09 ...... #t)......
46a0: 20 20 20 20 20 20 20 23 66 29 29 29 29 29 0a 20 #f))))).
46b0: 20 20 20 20 20 20 20 28 69 66 20 64 6f 2d 73 79 (if do-sy
46c0: 6e 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 nc. (
46d0: 74 65 73 74 73 3a 75 70 64 61 74 65 2d 63 65 6e tests:update-cen
46e0: 74 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 tral-meta-info r
46f0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 un-id test-id ne
4700: 77 2d 63 70 75 2d 6c 6f 61 64 20 6e 65 77 2d 64 w-cpu-load new-d
4710: 69 73 6b 2d 66 72 65 65 20 28 63 61 6c 63 2d 6d isk-free (calc-m
4720: 69 6e 75 74 65 73 29 20 23 66 20 23 66 29 29 0a inutes) #f #f)).
4730: 09 28 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a .(if kill-job? .
4740: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
4750: 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 (mutex-lock!
4760: 6d 29 0a 09 20 20 20 20 20 20 3b 3b 20 4e 4f 54 m).. ;; NOT
4770: 45 3a 20 54 68 65 20 70 69 64 20 63 61 6e 20 63 E: The pid can c
4780: 68 61 6e 67 65 20 61 73 20 64 69 66 66 65 72 65 hange as differe
4790: 6e 74 20 73 74 65 70 73 20 61 72 65 20 72 75 6e nt steps are run
47a0: 2e 20 44 6f 20 77 65 20 6e 65 65 64 20 68 61 6e . Do we need han
47b0: 64 73 68 61 6b 69 6e 67 20 62 65 74 77 65 65 6e dshaking between
47c0: 20 74 68 69 73 0a 09 20 20 20 20 20 20 3b 3b 20 this.. ;;
47d0: 20 20 20 20 20 20 73 65 63 74 69 6f 6e 20 61 6e section an
47e0: 64 20 74 68 65 20 72 75 6e 69 74 20 73 65 63 74 d the runit sect
47f0: 69 6f 6e 3f 20 4f 72 20 61 64 64 20 61 20 6c 6f ion? Or add a lo
4800: 6f 70 20 74 68 61 74 20 74 72 69 65 73 20 74 68 op that tries th
4810: 72 65 65 20 74 69 6d 65 73 20 77 69 74 68 20 61 ree times with a
4820: 20 31 2f 34 20 73 65 63 6f 6e 64 0a 09 20 20 20 1/4 second..
4830: 20 20 20 3b 3b 20 20 20 20 20 20 20 62 65 74 77 ;; betw
4840: 65 65 6e 20 74 72 69 65 73 3f 0a 09 20 20 20 20 een tries?..
4850: 20 20 28 6c 65 74 2a 20 28 28 70 69 64 31 20 28 (let* ((pid1 (
4860: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 20 launch:einf-pid
4870: 65 78 69 74 2d 69 6e 66 6f 29 29 20 3b 3b 20 28 exit-info)) ;; (
4880: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
4890: 69 6e 66 6f 20 30 29 29 0a 09 09 20 20 20 20 20 info 0))...
48a0: 28 70 69 64 32 20 28 72 6d 74 3a 74 65 73 74 2d (pid2 (rmt:test-
48b0: 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d get-top-process-
48c0: 70 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d pid run-id test-
48d0: 69 64 29 29 0a 09 09 20 20 20 20 20 28 70 69 64 id))... (pid
48e0: 73 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 63 s (delete-duplic
48f0: 61 74 65 73 20 28 66 69 6c 74 65 72 20 6e 75 6d ates (filter num
4900: 62 65 72 3f 20 28 6c 69 73 74 20 70 69 64 31 20 ber? (list pid1
4910: 70 69 64 32 29 29 29 29 29 0a 09 09 28 69 66 20 pid2)))))...(if
4920: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 70 69 64 73 (not (null? pids
4930: 29 29 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a ))... (begin.
4940: 09 09 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 .. (for-eac
4950: 68 0a 09 09 20 20 20 20 20 20 20 28 6c 61 6d 62 h... (lamb
4960: 64 61 20 28 70 69 64 29 0a 09 09 09 20 28 68 61 da (pid).... (ha
4970: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
4980: 09 09 09 20 20 65 78 6e 0a 09 09 09 20 20 28 62 ... exn.... (b
4990: 65 67 69 6e 0a 09 09 09 20 20 20 20 28 64 65 62 egin.... (deb
49a0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
49b0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
49c0: 74 2a 20 22 55 6e 61 62 6c 65 20 74 6f 20 6b 69 t* "Unable to ki
49d0: 6c 6c 20 70 72 6f 63 65 73 73 20 77 69 74 68 20 ll process with
49e0: 70 69 64 20 22 20 70 69 64 20 22 2c 20 70 6f 73 pid " pid ", pos
49f0: 73 69 62 6c 79 20 61 6c 72 65 61 64 79 20 6b 69 sibly already ki
4a00: 6c 6c 65 64 2e 22 29 0a 09 09 09 20 20 20 20 28 lled.").... (
4a10: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
4a20: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4a30: 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 " message: " ((
4a40: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
4a50: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
4a60: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
4a70: 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 ).... (debug:pr
4a80: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
4a90: 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e og-port* "WARNIN
4aa0: 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 G: Request recei
4ab0: 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 ved to kill job
4ac0: 22 20 70 69 64 29 20 3b 3b 20 20 22 20 28 61 74 " pid) ;; " (at
4ad0: 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d 74 tempt # " kill-t
4ae0: 72 69 65 73 20 22 29 22 29 0a 09 09 09 20 20 28 ries ")").... (
4af0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
4b00: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
4b10: 70 6f 72 74 2a 20 22 53 69 67 6e 61 6c 20 6d 61 port* "Signal ma
4b20: 73 6b 3d 22 20 28 73 69 67 6e 61 6c 2d 6d 61 73 sk=" (signal-mas
4b30: 6b 29 29 0a 09 09 09 20 20 3b 3b 20 28 69 66 20 k)).... ;; (if
4b40: 28 70 72 6f 63 65 73 73 3a 61 6c 69 76 65 3f 20 (process:alive?
4b50: 70 69 64 29 0a 09 09 09 20 20 3b 3b 20 20 20 20 pid).... ;;
4b60: 20 28 62 65 67 69 6e 0a 09 09 09 20 20 28 6d 61 (begin.... (ma
4b70: 70 20 28 6c 61 6d 62 64 61 20 28 70 69 64 2d 6e p (lambda (pid-n
4b80: 75 6d 29 0a 09 09 09 09 20 28 70 72 6f 63 65 73 um)..... (proces
4b90: 73 2d 73 69 67 6e 61 6c 20 70 69 64 2d 6e 75 6d s-signal pid-num
4ba0: 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 0a 09 signal/term))..
4bb0: 09 09 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 .. (proces
4bc0: 73 3a 67 65 74 2d 73 75 62 2d 70 69 64 73 20 70 s:get-sub-pids p
4bd0: 69 64 29 29 0a 09 09 09 20 20 28 74 68 72 65 61 id)).... (threa
4be0: 64 2d 73 6c 65 65 70 21 20 35 29 0a 09 09 09 20 d-sleep! 5)....
4bf0: 20 3b 3b 20 28 69 66 20 28 70 72 6f 63 65 73 73 ;; (if (process
4c00: 3a 70 72 6f 63 65 73 73 2d 61 6c 69 76 65 3f 20 :process-alive?
4c10: 70 69 64 29 0a 09 09 09 20 20 28 6d 61 70 20 28 pid).... (map (
4c20: 6c 61 6d 62 64 61 20 28 70 69 64 2d 6e 75 6d 29 lambda (pid-num)
4c30: 0a 09 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 ..... (handle-ex
4c40: 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 20 20 65 ceptions..... e
4c50: 78 6e 0a 09 09 09 09 20 20 23 66 0a 09 09 09 09 xn..... #f.....
4c60: 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 (process-signa
4c70: 6c 20 70 69 64 2d 6e 75 6d 20 73 69 67 6e 61 6c l pid-num signal
4c80: 2f 6b 69 6c 6c 29 29 29 0a 09 09 09 20 20 20 20 /kill)))....
4c90: 20 20 20 28 70 72 6f 63 65 73 73 3a 67 65 74 2d (process:get-
4ca0: 73 75 62 2d 70 69 64 73 20 70 69 64 29 29 29 29 sub-pids pid))))
4cb0: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ... ;;
4cc0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
4cd0: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
4ce0: 2d 70 6f 72 74 2a 20 22 6e 6f 74 20 6b 69 6c 6c -port* "not kill
4cf0: 69 6e 67 20 70 72 6f 63 65 73 73 20 22 20 70 69 ing process " pi
4d00: 64 20 22 20 61 73 20 69 74 20 69 73 20 6e 6f 74 d " as it is not
4d10: 20 61 6c 69 76 65 22 29 29 29 29 0a 09 09 20 20 alive"))))...
4d20: 20 20 20 20 20 70 69 64 73 29 0a 09 09 20 20 20 pids)...
4d30: 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 (tests:test-s
4d40: 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 et-status! run-i
4d50: 64 20 74 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 d test-id "KILLE
4d60: 44 22 20 20 22 4b 49 4c 4c 45 44 22 20 28 61 72 D" "KILLED" (ar
4d70: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
4d80: 20 23 66 29 29 0a 09 09 20 20 20 20 28 62 65 67 #f))... (beg
4d90: 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 in... (debu
4da0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
4db0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
4dc0: 74 2a 20 22 4e 6f 74 68 69 6e 67 20 74 6f 20 6b t* "Nothing to k
4dd0: 69 6c 6c 2c 20 70 69 64 31 3d 22 20 70 69 64 31 ill, pid1=" pid1
4de0: 20 22 2c 20 70 69 64 32 3d 22 20 70 69 64 32 29 ", pid2=" pid2)
4df0: 0a 09 09 20 20 20 20 20 20 28 74 65 73 74 73 3a ... (tests:
4e00: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
4e10: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
4e20: 22 4b 49 4c 4c 45 44 22 20 20 22 46 41 49 4c 45 "KILLED" "FAILE
4e30: 44 20 54 4f 20 4b 49 4c 4c 22 20 28 61 72 67 73 D TO KILL" (args
4e40: 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 :get-arg "-m") #
4e50: 66 29 0a 09 09 20 20 20 20 20 20 29 29 29 0a 09 f)... )))..
4e60: 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c (mutex-unl
4e70: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 3b ock! m).. ;
4e80: 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 73 74 ; no point in st
4e90: 69 63 6b 69 6e 67 20 61 72 6f 75 6e 64 2e 20 45 icking around. E
4ea0: 78 69 74 20 6e 6f 77 2e 0a 09 20 20 20 20 20 20 xit now...
4eb0: 28 65 78 69 74 29 29 29 0a 09 28 69 66 20 28 68 (exit)))..(if (h
4ec0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
4ed0: 66 61 75 6c 74 20 6d 69 73 63 2d 66 6c 61 67 73 fault misc-flags
4ee0: 20 27 6b 65 65 70 2d 67 6f 69 6e 67 20 23 66 29 'keep-going #f)
4ef0: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
4f00: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
4f10: 70 21 20 33 29 20 3b 3b 20 28 2b 20 33 20 28 72 p! 3) ;; (+ 3 (r
4f20: 61 6e 64 6f 6d 20 36 29 29 29 20 3b 3b 20 61 64 andom 6))) ;; ad
4f30: 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 20 74 6f d some jitter to
4f40: 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d 65 20 74 the call home t
4f50: 69 6d 65 20 74 6f 20 73 70 72 65 61 64 20 6f 75 ime to spread ou
4f60: 74 20 74 68 65 20 64 62 20 61 63 63 65 73 73 65 t the db accesse
4f70: 73 0a 09 20 20 20 20 20 20 28 69 66 20 28 68 61 s.. (if (ha
4f80: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
4f90: 61 75 6c 74 20 6d 69 73 63 2d 66 6c 61 67 73 20 ault misc-flags
4fa0: 27 6b 65 65 70 2d 67 6f 69 6e 67 20 23 66 29 20 'keep-going #f)
4fb0: 20 3b 3b 20 6b 65 65 70 20 6f 72 69 67 69 6e 61 ;; keep origina
4fc0: 6c 73 20 66 6f 72 20 63 70 75 2d 6c 6f 61 64 20 ls for cpu-load
4fd0: 61 6e 64 20 64 69 73 6b 2d 66 72 65 65 20 75 6e and disk-free un
4fe0: 6c 65 73 73 20 74 68 65 79 20 63 68 61 6e 67 65 less they change
4ff0: 20 6d 6f 72 65 20 74 68 61 6e 20 74 68 65 20 61 more than the a
5000: 6c 6c 6f 77 65 64 20 64 65 6c 74 61 0a 09 09 20 llowed delta...
5010: 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d 6d 69 6e (loop (calc-min
5020: 75 74 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 utes).
5030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
5040: 72 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 63 r new-cpu-load c
5050: 70 75 2d 6c 6f 61 64 29 0a 20 20 20 20 20 20 20 pu-load).
5060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5070: 20 28 6f 72 20 6e 65 77 2d 64 69 73 6b 2d 66 72 (or new-disk-fr
5080: 65 65 20 64 69 73 6b 2d 66 72 65 65 29 0a 20 20 ee disk-free).
5090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50a0: 20 20 20 20 20 20 28 69 66 20 64 6f 2d 73 79 6e (if do-syn
50b0: 63 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e c (current-secon
50c0: 64 73 29 20 6c 61 73 74 2d 73 79 6e 63 29 29 29 ds) last-sync)))
50d0: 29 29 29 29 0a 20 20 20 20 28 74 65 73 74 73 3a )))). (tests:
50e0: 75 70 64 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d update-central-m
50f0: 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 eta-info run-id
5100: 74 65 73 74 2d 69 64 20 28 67 65 74 2d 63 70 75 test-id (get-cpu
5110: 2d 6c 6f 61 64 29 20 28 67 65 74 2d 64 66 20 28 -load) (get-df (
5120: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
5130: 79 29 29 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 y))(calc-minutes
5140: 29 20 23 66 20 23 66 29 29 29 20 3b 3b 20 4e 4f ) #f #f))) ;; NO
5150: 54 45 3a 20 43 68 65 63 6b 69 6e 67 20 74 77 69 TE: Checking twi
5160: 63 65 20 66 6f 72 20 6b 65 65 70 2d 67 6f 69 6e ce for keep-goin
5170: 67 20 69 73 20 69 6e 74 65 6e 74 69 6f 6e 61 6c g is intentional
5180: 0a 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e ...(define (laun
5190: 63 68 3a 65 78 65 63 75 74 65 20 65 6e 63 6f 64 ch:execute encod
51a0: 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 74 2a 20 ed-cmd). (let*
51b0: 28 28 63 6d 64 69 6e 66 6f 20 20 20 20 28 63 6f ((cmdinfo (co
51c0: 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 mmon:read-encode
51d0: 64 2d 73 74 72 69 6e 67 20 65 6e 63 6f 64 65 64 d-string encoded
51e0: 2d 63 6d 64 29 29 0a 09 20 28 74 63 6f 6e 66 69 -cmd)).. (tconfi
51f0: 67 72 65 67 20 23 66 29 29 0a 20 20 20 20 28 73 greg #f)). (s
5200: 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
5210: 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a O" encoded-cmd).
5220: 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d ;;(bb-check-
5230: 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 path msg: "launc
5240: 68 3a 65 78 65 63 75 74 65 20 69 6e 63 6f 6d 69 h:execute incomi
5250: 6e 67 22 29 0a 20 20 20 20 28 69 66 20 28 6c 69 ng"). (if (li
5260: 73 74 3f 20 63 6d 64 69 6e 66 6f 29 20 3b 3b 20 st? cmdinfo) ;;
5270: 28 28 74 65 73 74 70 61 74 68 20 2f 74 6d 70 2f ((testpath /tmp/
5280: 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d 69 6e mrwellan/jazzmin
5290: 64 2f 73 72 63 2f 65 78 61 6d 70 6c 65 5f 72 75 d/src/example_ru
52a0: 6e 2f 74 65 73 74 73 2f 73 71 6c 69 74 65 73 70 n/tests/sqlitesp
52b0: 65 65 64 29 0a 09 3b 3b 20 28 74 65 73 74 2d 6e eed)..;; (test-n
52c0: 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 64 29 ame sqlitespeed)
52d0: 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 (runscript runs
52e0: 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d 68 6f cript.rb) (db-ho
52f0: 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 28 72 st localhost) (r
5300: 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c 65 74 2a un-id 1))..(let*
5310: 20 28 28 74 65 73 74 70 61 74 68 20 20 28 61 73 ((testpath (as
5320: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 soc/default 'tes
5330: 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f 29 29 tpath cmdinfo))
5340: 20 20 3b 3b 20 74 65 73 74 70 61 74 68 20 69 73 ;; testpath is
5350: 20 74 68 65 20 74 65 73 74 20 73 70 65 63 20 61 the test spec a
5360: 72 65 61 0a 09 20 20 20 20 20 20 20 28 74 6f 70 rea.. (top
5370: 2d 70 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 -path (assoc/de
5380: 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 20 20 fault 'toppath
5390: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
53a0: 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 28 61 (work-area (a
53b0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 77 6f ssoc/default 'wo
53c0: 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 6f 29 rk-area cmdinfo)
53d0: 29 20 20 3b 3b 20 77 6f 72 6b 2d 61 72 65 61 20 ) ;; work-area
53e0: 69 73 20 74 68 65 20 74 65 73 74 20 72 75 6e 20 is the test run
53f0: 61 72 65 61 0a 09 20 20 20 20 20 20 20 28 74 65 area.. (te
5400: 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 2f 64 st-name (assoc/d
5410: 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e 61 6d efault 'test-nam
5420: 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 e cmdinfo))..
5430: 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 28 (runscript (
5440: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
5450: 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 66 6f unscript cmdinfo
5460: 29 29 0a 09 20 20 20 20 20 20 20 28 65 7a 73 74 )).. (ezst
5470: 65 70 73 20 20 20 28 61 73 73 6f 63 2f 64 65 66 eps (assoc/def
5480: 61 75 6c 74 20 27 65 7a 73 74 65 70 73 20 20 20 ault 'ezsteps
5490: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
54a0: 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 ;; (runremote
54b0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
54c0: 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 runremote cmdinf
54d0: 6f 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 o)).. ;; (
54e0: 74 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 transport (assoc
54f0: 2f 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 /default 'transp
5500: 6f 72 74 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b ort cmdinfo)) ;
5510: 3b 20 6e 6f 74 20 75 73 65 64 0a 09 20 20 20 20 ; not used..
5520: 20 20 20 3b 3b 20 28 73 65 72 76 65 72 69 6e 66 ;; (serverinf
5530: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
5540: 27 73 65 72 76 65 72 69 6e 66 20 63 6d 64 69 6e 'serverinf cmdin
5550: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 fo)).. ;;
5560: 28 70 6f 72 74 20 20 20 20 20 20 28 61 73 73 6f (port (asso
5570: 63 2f 64 65 66 61 75 6c 74 20 27 70 6f 72 74 20 c/default 'port
5580: 20 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 cmdinfo))..
5590: 20 20 20 20 20 20 20 28 73 65 72 76 65 72 75 72 (serverur
55a0: 6c 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 l (assoc/default
55b0: 20 27 73 65 72 76 65 72 75 72 6c 20 63 6d 64 69 'serverurl cmdi
55c0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 68 nfo)).. (h
55d0: 6f 6d 65 68 6f 73 74 20 20 28 61 73 73 6f 63 2f omehost (assoc/
55e0: 64 65 66 61 75 6c 74 20 27 68 6f 6d 65 68 6f 73 default 'homehos
55f0: 74 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 t cmdinfo))..
5600: 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 (run-id
5610: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
5620: 72 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 run-id cmdinf
5630: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 o)).. (tes
5640: 74 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 t-id (assoc/de
5650: 66 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 fault 'test-id
5660: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
5670: 20 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 (target (a
5680: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 ssoc/default 'ta
5690: 72 67 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 rget cmdinfo)
56a0: 29 0a 09 20 20 20 20 20 20 20 28 61 72 65 61 6e ).. (arean
56b0: 61 6d 65 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ame (assoc/defa
56c0: 75 6c 74 20 27 61 72 65 61 6e 61 6d 65 20 20 63 ult 'areaname c
56d0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
56e0: 20 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 (itemdat (ass
56f0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d oc/default 'item
5700: 64 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a dat cmdinfo)).
5710: 09 20 20 20 20 20 20 20 28 65 6e 76 2d 6f 76 72 . (env-ovr
5720: 64 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c d (assoc/defaul
5730: 74 20 27 65 6e 76 2d 6f 76 72 64 20 20 63 6d 64 t 'env-ovrd cmd
5740: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
5750: 73 65 74 2d 76 61 72 73 20 20 28 61 73 73 6f 63 set-vars (assoc
5760: 2f 64 65 66 61 75 6c 74 20 27 73 65 74 2d 76 61 /default 'set-va
5770: 72 73 20 20 63 6d 64 69 6e 66 6f 29 29 20 3b 3b rs cmdinfo)) ;;
5780: 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 66 pre-overrides f
5790: 72 6f 6d 20 2d 73 65 74 76 61 72 0a 09 20 20 20 rom -setvar..
57a0: 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 (runname (
57b0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
57c0: 75 6e 6e 61 6d 65 20 20 20 63 6d 64 69 6e 66 6f unname cmdinfo
57d0: 29 29 0a 09 20 20 20 20 20 20 20 28 6d 65 67 61 )).. (mega
57e0: 74 65 73 74 20 20 28 61 73 73 6f 63 2f 64 65 66 test (assoc/def
57f0: 61 75 6c 74 20 27 6d 65 67 61 74 65 73 74 20 20 ault 'megatest
5800: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
5810: 20 20 28 72 75 6e 74 6c 69 6d 20 20 20 28 61 73 (runtlim (as
5820: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e soc/default 'run
5830: 74 6c 69 6d 20 20 20 63 6d 64 69 6e 66 6f 29 29 tlim cmdinfo))
5840: 0a 09 20 20 20 20 20 20 20 28 63 6f 6e 74 6f 75 .. (contou
5850: 72 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 r (assoc/defau
5860: 6c 74 20 27 63 6f 6e 74 6f 75 72 20 20 20 63 6d lt 'contour cm
5870: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
5880: 28 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d (item-path (item
5890: 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
58a0: 64 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 6d dat)).. (m
58b0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 t-bindir-path (a
58c0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 ssoc/default 'mt
58d0: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 -bindir-path cmd
58e0: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
58f0: 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 20 keys #f)..
5900: 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 (keyvals
5910: 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 75 #f).. (fu
5920: 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 llrunscript (if
5930: 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 0a (not runscript).
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5960: 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 #f.
5970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5980: 20 20 20 20 20 20 20 28 69 66 20 28 73 75 62 73 (if (subs
5990: 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 tring-index "/"
59a0: 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 runscript).
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 20
59d0: 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 runscript ;; us
59e0: 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 66 e unadultered if
59f0: 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 contains slashe
5a00: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
5a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a20: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 (let ((f
5a30: 75 6c 6c 6e 20 28 63 6f 6e 63 20 77 6f 72 6b 2d ulln (conc work-
5a40: 61 72 65 61 20 22 2f 22 20 72 75 6e 73 63 72 69 area "/" runscri
5a50: 70 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 pt)))..
5a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a70: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
5a80: 64 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 d (common:file-e
5a90: 78 69 73 74 73 3f 20 66 75 6c 6c 6e 29 0a 20 20 xists? fulln).
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 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ad0: 20 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 (file-execute-a
5ae0: 63 63 65 73 73 3f 20 66 75 6c 6c 6e 29 29 0a 20 ccess? fulln)).
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 20 20 20 20 66 75 6c ful
5b20: 6c 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ln.
5b30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b50: 20 72 75 6e 73 63 72 69 70 74 29 29 29 29 29 20 runscript)))))
5b60: 3b 3b 20 61 73 73 75 6d 65 20 69 74 20 69 73 20 ;; assume it is
5b70: 6f 6e 20 74 68 65 20 70 61 74 68 0a 20 20 20 20 on the path.
5b80: 20 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 (chec
5b90: 6b 2d 77 6f 72 6b 2d 61 72 65 61 20 20 20 20 20 k-work-area
5ba0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
5bb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
5be0: 4e 46 53 20 6d 69 67 68 74 20 6e 6f 74 20 68 61 NFS might not ha
5bf0: 76 65 20 70 72 6f 70 61 67 61 74 65 64 20 74 68 ve propagated th
5c00: 65 20 64 69 72 65 63 74 6f 72 79 20 6d 65 74 61 e directory meta
5c10: 20 64 61 74 61 20 74 6f 20 74 68 65 20 72 75 6e data to the run
5c20: 20 68 6f 73 74 20 2d 20 67 69 76 65 20 69 74 20 host - give it
5c30: 74 69 6d 65 20 69 66 20 6e 65 65 64 65 64 0a 20 time if needed.
5c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c60: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
5c70: 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 20 30 29 29 loop ((count 0))
5c80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
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 28 (
5cb0: 69 66 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a 64 if (or (common:d
5cc0: 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f irectory-exists?
5cd0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 work-area).
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 20 20 20 20 20 20 20 20 20
5d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d10: 20 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a (> count 10)).
5d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
5d60: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 ory work-area).
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 20 20 20 20 20 20
5da0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
5db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 64 65 62 (deb
5de0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
5df0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 ult-log-port* "I
5e00: 4e 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e NFO: Not startin
5e10: 67 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 72 65 g job yet - dire
5e20: 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
5e30: 61 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a a " not found").
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e70: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
5e80: 70 21 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 p! 10).
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 28 6c 6f 6f 70 (loop
5ec0: 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 29 (+ count 1)))))
5ed0: 0a 0a 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 28 69 (i
5f00: 66 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 3f f (not (string=?
5f10: 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 6c 2d 70 (common:real-p
5f20: 61 74 68 20 77 6f 72 6b 2d 61 72 65 61 29 28 63 ath work-area)(c
5f30: 6f 6d 6d 6f 6e 3a 72 65 61 6c 2d 70 61 74 68 20 ommon:real-path
5f40: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
5f50: 72 79 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ry)))).
5f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f80: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
5fd0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
5fe0: 2a 0a 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 20 20 20 20 20 20 20 20
6010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6020: 20 22 49 4e 46 4f 3a 20 77 65 20 61 72 65 20 65 "INFO: we are e
6030: 78 70 65 63 74 69 6e 67 20 74 6f 20 62 65 20 69 xpecting to be i
6040: 6e 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f n directory " wo
6050: 72 6b 2d 61 72 65 61 20 22 5c 6e 22 0a 20 20 20 rk-area "\n".
6060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6090: 20 20 20 20 20 20 20 20 20 20 20 20 22 20 20 20 "
60a0: 20 20 62 75 74 20 77 65 20 61 72 65 20 61 63 74 but we are act
60b0: 75 61 6c 6c 79 20 69 6e 20 74 68 65 20 64 69 72 ually in the dir
60c0: 65 63 74 6f 72 79 20 22 20 28 63 75 72 72 65 6e ectory " (curren
60d0: 74 2d 64 69 72 65 63 74 6f 72 79 29 20 22 5c 6e t-directory) "\n
60e0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ".
60f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6120: 20 22 20 20 20 20 20 64 6f 69 6e 67 20 61 6e 6f " doing ano
6130: 74 68 65 72 20 63 68 61 6e 67 65 20 64 69 72 2e ther change dir.
6140: 22 29 0a 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 20 20 20 20 20 20 20
6170: 20 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 (change-dir
6180: 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 ectory work-area
6190: 29 29 29 0a 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 20 20 20
61c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
61d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
61f0: 73 70 6f 74 20 63 68 65 63 6b 20 74 68 61 74 20 spot check that
6200: 74 68 65 20 66 69 6c 65 73 20 69 6e 20 74 65 73 the files in tes
6210: 74 70 61 74 68 20 61 72 65 20 61 76 61 69 6c 61 tpath are availa
6220: 62 6c 65 2e 20 54 6f 6f 20 6f 66 74 65 6e 20 4e ble. Too often N
6230: 46 53 20 64 65 6c 61 79 73 20 63 61 75 73 65 20 FS delays cause
6240: 70 72 6f 62 6c 65 6d 73 20 68 65 72 65 2e 0a 20 problems here..
6250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6270: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
6280: 28 28 66 69 6c 65 73 20 20 20 20 20 20 28 67 6c ((files (gl
6290: 6f 62 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 ob (conc testpat
62a0: 68 20 22 2f 2a 22 29 29 29 0a 20 20 20 20 20 20 h "/*"))).
62b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 61 64 (bad
62e0: 2d 66 69 6c 65 73 20 27 28 29 29 29 0a 20 20 20 -files '())).
62f0: 20 20 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 28 66 6f 72 2d (for-
6320: 65 61 63 68 0a 20 20 20 20 20 20 20 20 20 20 20 each.
6330: 20 20 20 20 20 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 28 6c 61 6d 62 64 61 20 28 66 75 6c (lambda (ful
6360: 6c 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 lname).
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 28 6c 65 74 2a 20 28 28 (let* ((
63a0: 66 6e 61 6d 65 20 28 70 61 74 68 6e 61 6d 65 2d fname (pathname-
63b0: 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 20 strip-directory
63c0: 66 75 6c 6c 6e 61 6d 65 29 29 0a 20 20 20 20 20 fullname)).
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6400: 20 20 20 28 74 61 72 67 6e 20 28 63 6f 6e 63 20 (targn (conc
6410: 77 6f 72 6b 2d 61 72 65 61 20 22 2f 22 20 66 6e work-area "/" fn
6420: 61 6d 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 ame))).
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 20 20 20 20 20
6450: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
6460: 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ot (file-exists?
6470: 20 74 61 72 67 6e 29 29 0a 20 20 20 20 20 20 20 targn)).
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 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64b0: 28 73 65 74 21 20 62 61 64 2d 66 69 6c 65 73 20 (set! bad-files
64c0: 28 63 6f 6e 73 20 66 6e 61 6d 65 20 62 61 64 2d (cons fname bad-
64d0: 66 69 6c 65 73 29 29 29 29 29 0a 20 20 20 20 20 files))))).
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 20 20 20 20 20 20 20 20
6500: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 73 29 files)
6510: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6520: 20 20 20 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 28 (
6540: 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 62 if (not (null? b
6550: 61 64 2d 66 69 6c 65 73 29 29 0a 20 20 20 20 20 ad-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 20 20 20 20 20 20 28 62 65 (be
6590: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
65a0: 20 20 20 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 28 64 65 62 75 67 3a 70 (debug:p
65d0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
65e0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a log-port* "INFO:
65f0: 20 74 65 73 74 20 64 61 74 61 20 66 72 6f 6d 20 test data from
6600: 22 20 74 65 73 74 70 61 74 68 20 22 20 6e 6f 74 " testpath " not
6610: 20 63 6f 70 69 65 64 20 70 72 6f 70 65 72 6c 79 copied properly
6620: 20 6f 72 20 66 69 6c 65 73 79 73 74 65 6d 20 70 or filesystem p
6630: 72 6f 62 6c 65 6d 73 20 63 61 75 73 69 6e 67 20 roblems causing
6640: 64 61 74 61 20 74 6f 20 6e 6f 74 20 62 65 20 66 data to not be f
6650: 6f 75 6e 64 2e 20 52 65 2d 72 75 6e 6e 69 6e 67 ound. Re-running
6660: 20 74 68 65 20 63 6f 70 79 20 63 6f 6d 6d 61 6e the copy comman
6670: 64 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 d.").
6680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66a0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
66b0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
66c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f -log-port* "INFO
66d0: 3a 20 6d 69 73 73 69 6e 67 20 66 69 6c 65 73 20 : missing files
66e0: 66 72 6f 6d 20 22 20 77 6f 72 6b 2d 61 72 65 61 from " work-area
66f0: 20 22 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e ": " (string-in
6700: 74 65 72 73 70 65 72 73 65 20 62 61 64 2d 66 69 tersperse bad-fi
6710: 6c 65 73 20 22 2c 20 22 29 29 0a 20 20 20 20 20 les ", ")).
6720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6750: 6c 61 75 6e 63 68 3a 74 65 73 74 2d 63 6f 70 79 launch:test-copy
6760: 20 74 65 73 74 70 61 74 68 20 77 6f 72 6b 2d 61 testpath work-a
6770: 72 65 61 29 29 29 29 0a 20 20 20 20 20 20 20 20 rea)))).
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 20 20 20 20 20 20 20 20 20
67a0: 20 20 20 20 3b 3b 20 6f 6e 65 20 6d 6f 72 65 20 ;; one more
67b0: 74 69 6d 65 2c 20 63 68 61 6e 67 65 20 74 6f 20 time, change to
67c0: 74 68 65 20 77 6f 72 6b 2d 61 72 65 61 20 64 69 the work-area di
67d0: 72 65 63 74 6f 72 79 0a 20 20 20 20 20 20 20 20 rectory.
67e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6800: 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 (change-dire
6810: 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 ctory work-area)
6820: 29 29 0a 09 20 20 20 20 20 20 20 29 20 3b 3b 20 )).. ) ;;
6830: 6c 65 74 2a 0a 0a 09 20 20 28 69 66 20 63 6f 6e let*... (if con
6840: 74 6f 75 72 20 28 73 65 74 65 6e 76 20 22 4d 54 tour (setenv "MT
6850: 5f 43 4f 4e 54 4f 55 52 22 20 63 6f 6e 74 6f 75 _CONTOUR" contou
6860: 72 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 69 6d r)).. .. ;; im
6870: 6d 65 64 69 61 74 65 64 20 73 65 74 20 73 6f 6d mediated set som
6880: 65 20 6b 65 79 20 76 61 72 69 61 62 6c 65 73 20 e key variables
6890: 66 72 6f 6d 20 43 4d 44 49 4e 46 4f 20 64 61 74 from CMDINFO dat
68a0: 61 2c 20 79 65 73 2c 20 74 68 65 73 65 20 77 69 a, yes, these wi
68b0: 6c 6c 20 62 65 20 73 65 74 20 61 67 61 69 6e 20 ll be set again
68c0: 62 65 6c 6f 77 20 2e 2e 2e 0a 09 20 20 3b 3b 0a below ..... ;;.
68d0: 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 . (setenv "MT_T
68e0: 45 53 54 53 55 49 54 45 4e 41 4d 45 22 20 61 72 ESTSUITENAME" ar
68f0: 65 61 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 eaname).. (sete
6900: 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f nv "MT_RUN_AREA_
6910: 48 4f 4d 45 22 20 74 6f 70 2d 70 61 74 68 29 0a HOME" top-path).
6920: 09 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 . (set! *toppat
6930: 68 2a 20 74 6f 70 2d 70 61 74 68 29 0a 20 20 20 h* top-path).
6940: 20 20 20 20 20 20 20 28 63 68 61 6e 67 65 2d 64 (change-d
6950: 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
6960: 68 2a 29 20 3b 3b 20 74 65 6d 70 6f 72 61 72 69 h*) ;; temporari
6970: 6c 79 20 73 77 69 74 63 68 20 74 6f 20 74 68 65 ly switch to the
6980: 20 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 0a 09 run area home..
6990: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 (setenv "MT_TE
69a0: 53 54 5f 52 55 4e 5f 44 49 52 22 20 20 77 6f 72 ST_RUN_DIR" wor
69b0: 6b 2d 61 72 65 61 29 0a 0a 09 20 20 28 6c 61 75 k-area)... (lau
69c0: 6e 63 68 3a 73 65 74 75 70 29 20 3b 3b 20 73 68 nch:setup) ;; sh
69d0: 6f 75 6c 64 20 62 65 20 70 72 6f 70 65 72 6c 79 ould be properly
69e0: 20 69 6e 20 74 68 65 20 72 75 6e 20 61 72 65 61 in the run area
69f0: 20 68 6f 6d 65 20 6e 6f 77 0a 20 20 20 20 20 20 home now.
6a00: 20 20 20 20 0a 09 20 20 28 73 65 74 21 20 74 63 .. (set! tc
6a10: 6f 6e 66 69 67 72 65 67 20 28 74 65 73 74 73 3a onfigreg (tests:
6a20: 67 65 74 2d 61 6c 6c 29 29 0a 09 20 20 28 6c 65 get-all)).. (le
6a30: 74 20 28 28 73 69 67 68 61 6e 64 20 28 6c 61 6d t ((sighand (lam
6a40: 62 64 61 20 28 73 69 67 6e 75 6d 29 0a 09 09 09 bda (signum)....
6a50: 20 20 20 3b 3b 20 28 73 69 67 6e 61 6c 2d 6d 61 ;; (signal-ma
6a60: 73 6b 21 20 73 69 67 6e 75 6d 29 20 3b 3b 20 74 sk! signum) ;; t
6a70: 6f 20 6d 61 73 6b 20 6f 72 20 6e 6f 74 3f 20 73 o mask or not? s
6a80: 65 65 6d 73 20 74 6f 20 63 61 75 73 65 20 69 73 eems to cause is
6a90: 73 75 65 73 20 69 6e 20 65 78 69 74 69 6e 67 0a sues in exiting.
6aa0: 09 09 09 20 20 20 28 69 66 20 28 65 71 3f 20 73 ... (if (eq? s
6ab0: 69 67 6e 75 6d 20 73 69 67 6e 61 6c 2f 73 74 6f ignum signal/sto
6ac0: 70 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 65 p).... (de
6ad0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
6ae0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6af0: 6f 72 74 2a 20 22 61 74 74 65 6d 70 74 20 74 6f ort* "attempt to
6b00: 20 53 54 4f 50 20 70 72 6f 63 65 73 73 2e 20 45 STOP process. E
6b10: 78 69 74 69 6e 67 2e 22 29 29 0a 09 09 09 20 20 xiting."))....
6b20: 20 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d (set! *time-to-
6b30: 65 78 69 74 2a 20 23 74 29 0a 09 09 09 20 20 20 exit* #t)....
6b40: 28 70 72 69 6e 74 20 22 52 65 63 65 69 76 65 64 (print "Received
6b50: 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d signal " signum
6b60: 20 22 2c 20 63 6c 65 61 6e 69 6e 67 20 75 70 20 ", cleaning up
6b70: 62 65 66 6f 72 65 20 65 78 69 74 2e 20 50 6c 65 before exit. Ple
6b80: 61 73 65 20 77 61 69 74 2e 2e 2e 22 29 0a 09 09 ase wait...")...
6b90: 09 20 20 20 28 6c 65 74 20 28 28 74 68 31 20 28 . (let ((th1 (
6ba0: 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d make-thread (lam
6bb0: 62 64 61 20 28 29 0a 09 09 09 09 09 09 20 20 20 bda ().......
6bc0: 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d (rmt:test-set-
6bd0: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
6be0: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 49 4e 43 -id test-id "INC
6bf0: 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c 45 44 OMPLETE" "KILLED
6c00: 22 20 23 66 29 0a 09 09 09 09 09 09 20 20 20 20 " #f).......
6c10: 20 28 70 72 69 6e 74 20 22 4b 69 6c 6c 65 64 20 (print "Killed
6c20: 62 79 20 73 69 67 6e 61 6c 20 22 20 73 69 67 6e by signal " sign
6c30: 75 6d 20 22 2e 20 45 78 69 74 69 6e 67 22 29 0a um ". Exiting").
6c40: 09 09 09 09 09 09 20 20 20 20 20 28 74 68 72 65 ...... (thre
6c50: 61 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 09 09 ad-sleep! 1)....
6c60: 09 09 09 20 20 20 20 20 28 65 78 69 74 20 31 29 ... (exit 1)
6c70: 29 29 29 0a 09 09 09 09 20 28 74 68 32 20 28 6d )))..... (th2 (m
6c80: 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 ake-thread (lamb
6c90: 64 61 20 28 29 0a 09 09 09 09 09 09 20 20 20 20 da ().......
6ca0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
6cb0: 32 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 2)....... (d
6cc0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
6cd0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6ce0: 22 44 6f 6e 65 22 29 0a 09 09 09 09 09 09 20 20 "Done").......
6cf0: 20 20 20 28 65 78 69 74 20 34 29 29 29 29 29 0a (exit 4))))).
6d00: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
6d10: 73 74 61 72 74 21 20 74 68 32 29 0a 09 09 09 20 start! th2)....
6d20: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
6d30: 74 21 20 74 68 31 29 0a 09 09 09 20 20 20 20 20 t! th1)....
6d40: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
6d50: 32 29 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 2))))).. (set
6d60: 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 -signal-handler!
6d70: 20 73 69 67 6e 61 6c 2f 69 6e 74 20 73 69 67 68 signal/int sigh
6d80: 61 6e 64 29 0a 09 20 20 20 20 28 73 65 74 2d 73 and).. (set-s
6d90: 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 20 73 ignal-handler! s
6da0: 69 67 6e 61 6c 2f 74 65 72 6d 20 73 69 67 68 61 ignal/term sigha
6db0: 6e 64 29 0a 09 20 20 20 20 29 20 3b 3b 20 28 73 nd).. ) ;; (s
6dc0: 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 et-signal-handle
6dd0: 72 21 20 73 69 67 6e 61 6c 2f 73 74 6f 70 20 73 r! signal/stop s
6de0: 69 67 68 61 6e 64 29 0a 09 20 20 0a 09 20 20 3b ighand).. .. ;
6df0: 3b 20 44 6f 20 6e 6f 74 20 72 75 6e 20 74 68 65 ; Do not run the
6e00: 20 74 65 73 74 20 69 66 20 69 74 20 69 73 20 52 test if it is R
6e10: 45 4d 4f 56 49 4e 47 2c 20 52 55 4e 4e 49 4e 47 EMOVING, RUNNING
6e20: 2c 20 4b 49 4c 4c 52 45 51 20 6f 72 20 52 45 4d , KILLREQ or REM
6e30: 4f 54 45 48 4f 53 54 53 54 41 52 54 2c 0a 09 20 OTEHOSTSTART,..
6e40: 20 3b 3b 20 4d 61 72 6b 20 74 68 65 20 74 65 73 ;; Mark the tes
6e50: 74 20 61 73 20 52 45 4d 4f 54 45 48 4f 53 54 53 t as REMOTEHOSTS
6e60: 54 41 52 54 20 2a 49 4d 4d 45 44 49 41 54 45 4c TART *IMMEDIATEL
6e70: 59 2a 0a 09 20 20 3b 3b 0a 09 20 20 28 6c 65 74 Y*.. ;;.. (let
6e80: 2a 20 28 28 74 65 73 74 2d 69 6e 66 6f 20 28 72 * ((test-info (r
6e90: 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f mt:get-test-info
6ea0: 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 65 -by-id run-id te
6eb0: 73 74 2d 69 64 29 29 0a 09 09 20 28 74 65 73 74 st-id))... (test
6ec0: 2d 68 6f 73 74 20 28 69 66 20 74 65 73 74 2d 69 -host (if test-i
6ed0: 6e 66 6f 0a 09 09 09 09 28 64 62 3a 74 65 73 74 nfo.....(db:test
6ee0: 2d 67 65 74 2d 68 6f 73 74 20 20 20 20 20 20 20 -get-host
6ef0: 20 74 65 73 74 2d 69 6e 66 6f 29 0a 09 09 09 09 test-info).....
6f00: 28 62 65 67 69 6e 0a 09 09 09 09 20 20 28 64 65 (begin..... (de
6f10: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
6f20: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6f30: 45 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 74 6f ERROR: failed to
6f40: 20 66 69 6e 64 20 61 20 72 65 63 6f 72 64 20 66 find a record f
6f50: 6f 72 20 74 65 73 74 2d 69 64 20 22 20 74 65 73 or test-id " tes
6f60: 74 2d 69 64 20 22 2c 20 65 78 69 74 69 6e 67 2e t-id ", exiting.
6f70: 22 29 0a 09 09 09 09 20 20 28 65 78 69 74 29 29 ")..... (exit))
6f80: 29 29 0a 09 09 20 28 74 65 73 74 2d 70 69 64 20 ))... (test-pid
6f90: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 72 (db:test-get-pr
6fa0: 6f 63 65 73 73 5f 69 64 20 20 74 65 73 74 2d 69 ocess_id test-i
6fb0: 6e 66 6f 29 29 29 0a 09 20 20 20 20 28 63 6f 6e nfo))).. (con
6fc0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3b d. ;
6fd0: 3b 20 2d 6d 72 77 2d 20 49 27 6d 20 72 65 6d 6f ; -mrw- I'm remo
6fe0: 76 69 6e 67 20 4b 49 4c 4c 52 45 51 20 66 72 6f ving KILLREQ fro
6ff0: 6d 20 74 68 69 73 20 6c 69 73 74 20 73 6f 20 74 m this list so t
7000: 68 61 74 20 61 20 74 65 73 74 20 69 6e 20 4b 49 hat a test in KI
7010: 4c 4c 52 45 51 20 73 74 61 74 65 20 69 73 20 74 LLREQ state is t
7020: 72 65 61 74 65 64 20 61 73 20 61 20 22 64 6f 20 reated as a "do
7030: 6e 6f 74 20 72 75 6e 22 20 66 6c 61 67 2e 0a 09 not run" flag...
7040: 20 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 64 ((member (d
7050: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
7060: 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 49 test-info) '("I
7070: 4e 43 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c NCOMPLETE" "KILL
7080: 45 44 22 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 53 ED" "UNKNOWN" "S
7090: 54 55 43 4b 22 29 29 20 3b 3b 20 70 72 69 6f 72 TUCK")) ;; prior
70a0: 20 72 75 6e 20 6f 66 20 74 68 69 73 20 74 65 73 run of this tes
70b0: 74 20 64 69 64 6e 27 74 20 63 6f 6d 70 6c 65 74 t didn't complet
70c0: 65 2c 20 67 6f 20 61 68 65 61 64 20 61 6e 64 20 e, go ahead and
70d0: 74 72 79 20 74 6f 20 72 65 72 75 6e 0a 09 20 20 try to rerun..
70e0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
70f0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7100: 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 74 65 73 port* "INFO: tes
7110: 74 20 69 73 20 49 4e 43 4f 4d 50 4c 45 54 45 20 t is INCOMPLETE
7120: 6f 72 20 4b 49 4c 4c 45 44 2c 20 74 72 65 61 74 or KILLED, treat
7130: 20 74 68 69 73 20 65 78 65 63 75 74 65 20 63 61 this execute ca
7140: 6c 6c 20 61 73 20 61 20 72 65 72 75 6e 20 72 65 ll as a rerun re
7150: 71 75 65 73 74 22 29 0a 09 20 20 20 20 20 20 3b quest").. ;
7160: 3b 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f ; (tests:test-fo
7170: 72 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 rce-state-status
7180: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
7190: 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 "REMOTEHOSTSTAR
71a0: 54 22 20 22 6e 2f 61 22 29 0a 09 20 20 20 20 20 T" "n/a")..
71b0: 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 (rmt:test-set-s
71c0: 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d tate-status run-
71d0: 69 64 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f id test-id "REMO
71e0: 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f TEHOSTSTART" "n/
71f0: 61 22 20 23 66 29 0a 09 20 20 20 20 20 20 29 20 a" #f).. )
7200: 3b 3b 20 70 72 69 6d 65 20 69 74 20 66 6f 72 20 ;; prime it for
7210: 72 75 6e 6e 69 6e 67 0a 09 20 20 20 20 20 28 28 running.. ((
7220: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
7230: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 get-state test-i
7240: 6e 66 6f 29 20 27 28 22 52 55 4e 4e 49 4e 47 22 nfo) '("RUNNING"
7250: 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 "REMOTEHOSTSTAR
7260: 54 22 29 29 0a 09 20 20 20 20 20 20 28 69 66 20 T")).. (if
7270: 28 70 72 6f 63 65 73 73 3a 61 6c 69 76 65 2d 6f (process:alive-o
7280: 6e 2d 68 6f 73 74 3f 20 74 65 73 74 2d 68 6f 73 n-host? test-hos
7290: 74 20 74 65 73 74 2d 70 69 64 29 0a 09 09 20 20 t test-pid)...
72a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
72b0: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
72c0: 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 20 73 74 g-port* "test st
72d0: 61 74 65 20 69 73 20 22 20 20 28 64 62 3a 74 65 ate is " (db:te
72e0: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 st-get-state tes
72f0: 74 2d 69 6e 66 6f 29 20 22 20 61 6e 64 20 70 72 t-info) " and pr
7300: 6f 63 65 73 73 20 22 20 74 65 73 74 2d 70 69 64 ocess " test-pid
7310: 20 22 20 69 73 20 73 74 69 6c 6c 20 72 75 6e 6e " is still runn
7320: 69 6e 67 20 6f 6e 20 68 6f 73 74 20 22 20 74 65 ing on host " te
7330: 73 74 2d 68 6f 73 74 20 22 2c 20 63 61 6e 6e 6f st-host ", canno
7340: 74 20 70 72 6f 63 65 65 64 22 29 0a 09 09 20 20 t proceed")...
7350: 3b 3b 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 ;; (tests:test-f
7360: 6f 72 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 orce-state-statu
7370: 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 s! run-id test-i
7380: 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 d "REMOTEHOSTSTA
7390: 52 54 22 20 22 6e 2f 61 22 29 0a 09 09 20 20 28 RT" "n/a")... (
73a0: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 rmt:test-set-sta
73b0: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
73c0: 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 test-id "REMOTE
73d0: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
73e0: 20 23 66 29 0a 09 09 20 20 29 29 0a 09 20 20 20 #f)... ))..
73f0: 20 20 28 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 ((not (member
7400: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
7410: 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 te test-info) '(
7420: 22 52 45 4d 4f 56 49 4e 47 22 20 22 52 45 4d 4f "REMOVING" "REMO
7430: 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 52 55 TEHOSTSTART" "RU
7440: 4e 4e 49 4e 47 22 20 22 4b 49 4c 4c 52 45 51 22 NNING" "KILLREQ"
7450: 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 74 ))).. ;; (t
7460: 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d ests:test-force-
7470: 73 74 61 74 65 2d 73 74 61 74 75 73 21 20 72 75 state-status! ru
7480: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 52 45 n-id test-id "RE
7490: 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 22 MOTEHOSTSTART" "
74a0: 6e 2f 61 22 29 0a 09 20 20 20 20 20 20 28 72 6d n/a").. (rm
74b0: 74 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 65 t:test-set-state
74c0: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 -status run-id t
74d0: 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f est-id "REMOTEHO
74e0: 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 20 23 STSTART" "n/a" #
74f0: 66 29 0a 09 20 20 20 20 20 20 29 0a 09 20 20 20 f).. )..
7500: 20 20 28 65 6c 73 65 20 3b 3b 20 28 6d 65 6d 62 (else ;; (memb
7510: 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d er (db:test-get-
7520: 73 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 state test-info)
7530: 20 27 28 22 52 45 4d 4f 56 49 4e 47 22 20 22 52 '("REMOVING" "R
7540: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 EMOTEHOSTSTART"
7550: 22 52 55 4e 4e 49 4e 47 22 20 22 4b 49 4c 4c 52 "RUNNING" "KILLR
7560: 45 51 22 29 29 0a 09 20 20 20 20 20 20 28 64 65 EQ")).. (de
7570: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
7580: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
7590: 6f 72 74 2a 20 22 74 65 73 74 20 73 74 61 74 65 ort* "test state
75a0: 20 69 73 20 22 20 28 64 62 3a 74 65 73 74 2d 67 is " (db:test-g
75b0: 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e et-state test-in
75c0: 66 6f 29 20 22 2c 20 63 61 6e 6e 6f 74 20 70 72 fo) ", cannot pr
75d0: 6f 63 65 65 64 22 29 0a 09 20 20 20 20 20 20 28 oceed").. (
75e0: 65 78 69 74 29 29 29 29 0a 09 20 20 0a 09 20 20 exit)))).. ..
75f0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
7600: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
7610: 2a 20 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 * "Exectuing " t
7620: 65 73 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 est-name " (id:
7630: 22 20 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 " test-id ") on
7640: 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 " (get-host-name
7650: 29 29 0a 09 20 20 28 73 65 74 21 20 6b 65 79 73 )).. (set! keys
7660: 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d (rmt:get-
7670: 6b 65 79 73 29 29 0a 09 20 20 3b 3b 20 28 72 75 keys)).. ;; (ru
7680: 6e 73 3a 73 65 74 2d 6d 65 67 61 74 65 73 74 2d ns:set-megatest-
7690: 65 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 env-vars run-id
76a0: 69 6e 6b 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b inkeys: keys ink
76b0: 65 79 76 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 eyvals: keyvals)
76c0: 20 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 62 65 ;; these may be
76d0: 20 6e 65 65 64 65 64 20 62 79 20 74 68 65 20 6c needed by the l
76e0: 61 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 73 73 aunching process
76f0: 0a 09 20 20 3b 3b 20 6f 6e 65 20 6f 66 20 74 68 .. ;; one of th
7700: 65 73 65 20 69 73 20 64 65 66 75 6e 63 74 2f 72 ese is defunct/r
7710: 65 64 75 6e 64 61 6e 74 20 2e 2e 2e 0a 09 20 20 edundant .....
7720: 28 69 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 (if (not (launch
7730: 3a 73 65 74 75 70 20 66 6f 72 63 65 2d 72 65 72 :setup force-rer
7740: 65 61 64 3a 20 23 74 29 29 0a 09 20 20 20 20 20 ead: #t))..
7750: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
7760: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
7770: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
7780: 6c 65 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 led to setup, ex
7790: 69 74 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 iting") ...;; (s
77a0: 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 qlite3:finalize!
77b0: 20 64 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 db)...;; (sqlit
77c0: 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 e3:finalize! tdb
77d0: 29 0a 09 09 28 65 78 69 74 20 31 29 29 29 0a 20 )...(exit 1))).
77e0: 20 20 20 20 20 20 20 20 20 3b 3b 20 76 61 6c 69 ;; vali
77f0: 64 61 74 65 20 74 68 61 74 20 74 68 65 20 74 65 date that the te
7800: 73 74 20 72 75 6e 20 61 72 65 61 20 69 73 20 61 st run area is a
7810: 76 61 69 6c 61 62 6c 65 0a 20 20 20 20 20 20 20 vailable.
7820: 20 20 20 28 63 68 65 63 6b 2d 77 6f 72 6b 2d 61 (check-work-a
7830: 72 65 61 29 0a 20 20 20 20 20 20 20 20 20 20 0a rea). .
7840: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 74 69 ;; sti
7850: 6c 6c 20 6e 65 65 64 20 74 6f 20 67 6f 20 62 61 ll need to go ba
7860: 63 6b 20 74 6f 20 72 75 6e 20 61 72 65 61 20 68 ck to run area h
7870: 6f 6d 65 20 66 6f 72 20 6e 65 78 74 20 63 6f 75 ome for next cou
7880: 70 6c 65 20 73 74 65 70 73 0a 09 20 20 28 63 68 ple steps.. (ch
7890: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a ange-directory *
78a0: 74 6f 70 70 61 74 68 2a 29 20 0a 0a 09 20 20 3b toppath*) ... ;
78b0: 3b 20 4e 4f 54 45 3a 20 43 75 72 72 65 6e 74 20 ; NOTE: Current
78c0: 6f 72 64 65 72 20 69 73 20 74 6f 20 70 72 6f 63 order is to proc
78d0: 65 73 73 20 72 75 6e 63 6f 6e 66 69 67 73 20 2a ess runconfigs *
78e0: 62 65 66 6f 72 65 2a 20 73 65 74 74 69 6e 67 20 before* setting
78f0: 74 68 65 20 4d 54 5f 20 76 61 72 73 2e 20 54 68 the MT_ vars. Th
7900: 69 73 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 is .. ;;
7910: 73 65 65 6d 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 seems non-ideal
7920: 62 75 74 20 63 6f 75 6c 64 20 77 65 6c 6c 20 62 but could well b
7930: 72 65 61 6b 20 73 74 75 66 66 0a 09 20 20 3b 3b reak stuff.. ;;
7940: 20 20 20 20 42 55 47 3f 20 42 55 47 3f 20 42 55 BUG? BUG? BU
7950: 47 3f 0a 09 20 20 0a 09 20 20 28 6c 65 74 20 28 G?.. .. (let (
7960: 28 72 63 6f 6e 66 69 67 20 28 66 75 6c 6c 2d 72 (rconfig (full-r
7970: 75 6e 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 unconfigs-read))
7980: 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 ;; (read-config
7990: 20 28 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 (conc *toppath
79a0: 2a 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 * "/runconfigs.c
79b0: 6f 6e 66 69 67 22 29 20 23 66 20 23 74 20 73 65 onfig") #f #t se
79c0: 63 74 69 6f 6e 73 3a 20 28 6c 69 73 74 20 22 64 ctions: (list "d
79d0: 65 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 29 efault" target))
79e0: 29 29 0a 09 09 28 77 63 6f 6e 66 69 67 20 28 72 ))...(wconfig (r
79f0: 65 61 64 2d 63 6f 6e 66 69 67 20 22 77 61 69 76 ead-config "waiv
7a00: 65 72 73 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 ers.config" #f #
7a10: 74 20 73 65 63 74 69 6f 6e 73 3a 20 60 28 20 22 t sections: `( "
7a20: 64 65 66 61 75 6c 74 22 20 2c 74 61 72 67 65 74 default" ,target
7a30: 20 29 29 29 29 20 3b 3b 20 72 65 61 64 20 74 68 )))) ;; read th
7a40: 65 20 77 61 69 76 65 72 73 20 63 6f 6e 66 69 67 e waivers config
7a50: 20 69 66 20 69 74 20 65 78 69 73 74 73 0a 09 20 if it exists..
7a60: 20 20 20 3b 3b 20 28 73 65 74 75 70 2d 65 6e 76 ;; (setup-env
7a70: 2d 64 65 66 61 75 6c 74 73 20 28 63 6f 6e 63 20 -defaults (conc
7a80: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 *toppath* "/runc
7a90: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 onfigs.config")
7aa0: 72 75 6e 2d 69 64 20 28 6d 61 6b 65 2d 68 61 73 run-id (make-has
7ab0: 68 2d 74 61 62 6c 65 29 20 6b 65 79 76 61 6c 73 h-table) keyvals
7ac0: 20 74 61 72 67 65 74 29 0a 09 20 20 20 20 3b 3b target).. ;;
7ad0: 20 28 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 (set-run-config
7ae0: 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 6b 65 79 -vars run-id key
7af0: 76 61 6c 73 20 74 61 72 67 65 74 29 20 3b 3b 20 vals target) ;;
7b00: 28 64 62 3a 67 65 74 2d 74 61 72 67 65 74 20 64 (db:get-target d
7b10: 62 20 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 b run-id))..
7b20: 3b 3b 20 4e 6f 77 20 68 61 76 65 20 72 75 6e 63 ;; Now have runc
7b30: 6f 6e 66 69 67 73 20 64 61 74 61 20 6c 6f 61 64 onfigs data load
7b40: 65 64 2c 20 73 65 74 20 65 6e 76 69 72 6f 6e 6d ed, set environm
7b50: 65 6e 74 20 76 61 72 73 0a 09 20 20 20 20 28 66 ent vars.. (f
7b60: 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 or-each (lambda
7b70: 28 73 65 63 74 69 6f 6e 29 0a 09 09 09 28 66 6f (section)....(fo
7b80: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
7b90: 76 61 72 76 61 6c 29 0a 09 09 09 09 20 20 20 20 varval).....
7ba0: 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 (let ((var (car
7bb0: 76 61 72 76 61 6c 29 29 0a 09 09 09 09 09 20 20 varval))......
7bc0: 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 (val (cadr varva
7bd0: 6c 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 l)))..... (
7be0: 69 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f if (and (string?
7bf0: 20 76 61 72 29 28 73 74 72 69 6e 67 3f 20 76 61 var)(string? va
7c00: 6c 29 29 0a 09 09 09 09 09 20 20 28 62 65 67 69 l))...... (begi
7c10: 6e 0a 09 09 09 09 09 20 20 20 20 28 73 65 74 65 n...... (sete
7c20: 6e 76 20 76 61 72 20 28 63 6f 6e 66 69 67 3a 65 nv var (config:e
7c30: 76 61 6c 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e val-string-in-en
7c40: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 6c 29 29 29 vironment val)))
7c50: 20 3b 3b 20 76 61 6c 29 0a 09 09 09 09 09 20 20 ;; val)......
7c60: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
7c70: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
7c80: 67 2d 70 6f 72 74 2a 20 22 62 61 64 20 76 61 72 g-port* "bad var
7c90: 69 61 62 6c 65 20 73 70 65 63 2c 20 22 20 76 61 iable spec, " va
7ca0: 72 20 22 3d 22 20 76 61 6c 29 29 29 29 0a 09 09 r "=" val))))...
7cb0: 09 09 20 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 .. (configf:get
7cc0: 2d 73 65 63 74 69 6f 6e 20 72 63 6f 6e 66 69 67 -section rconfig
7cd0: 20 73 65 63 74 69 6f 6e 29 29 29 0a 09 09 20 20 section)))...
7ce0: 20 20 20 20 28 6c 69 73 74 20 22 64 65 66 61 75 (list "defau
7cf0: 6c 74 22 20 74 61 72 67 65 74 29 29 29 0a 20 20 lt" target))).
7d00: 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 ;;(bb-ch
7d10: 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c eck-path msg: "l
7d20: 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 6f aunch:execute po
7d30: 73 74 20 62 6c 6f 63 6b 20 31 22 29 0a 0a 09 20 st block 1")...
7d40: 20 3b 3b 20 4e 46 53 20 6d 69 67 68 74 20 6e 6f ;; NFS might no
7d50: 74 20 68 61 76 65 20 70 72 6f 70 61 67 61 74 65 t have propagate
7d60: 64 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 d the directory
7d70: 6d 65 74 61 20 64 61 74 61 20 74 6f 20 74 68 65 meta data to the
7d80: 20 72 75 6e 20 68 6f 73 74 20 2d 20 67 69 76 65 run host - give
7d90: 20 69 74 20 74 69 6d 65 20 69 66 20 6e 65 65 64 it time if need
7da0: 65 64 0a 09 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ed.. (let loop
7db0: 28 28 63 6f 75 6e 74 20 30 29 29 0a 09 20 20 20 ((count 0))..
7dc0: 20 28 69 66 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e (if (or (common
7dd0: 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 77 6f :file-exists? wo
7de0: 72 6b 2d 61 72 65 61 29 0a 09 09 20 20 20 20 28 rk-area)... (
7df0: 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a 09 09 28 > count 10))...(
7e00: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
7e10: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 28 62 work-area)...(b
7e20: 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a egin... (debug:
7e30: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
7e40: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f -log-port* "INFO
7e50: 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e 67 20 6a : Not starting j
7e60: 6f 62 20 79 65 74 20 2d 20 64 69 72 65 63 74 6f ob yet - directo
7e70: 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 20 22 ry " work-area "
7e80: 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 09 20 not found")...
7e90: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
7ea0: 31 30 29 0a 09 09 20 20 28 6c 6f 6f 70 20 28 2b 10)... (loop (+
7eb0: 20 63 6f 75 6e 74 20 31 29 29 29 29 29 0a 0a 20 count 1)))))..
7ec0: 20 20 20 20 20 20 20 20 20 3b 3b 20 6e 6f 77 20 ;; now
7ed0: 77 65 20 63 61 6e 20 73 77 69 74 63 68 20 74 6f we can switch to
7ee0: 20 74 68 65 20 77 6f 72 6b 2d 61 72 65 61 3f 0a the work-area?.
7ef0: 20 20 20 20 20 20 20 20 20 20 28 63 68 61 6e 67 (chang
7f00: 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f 72 6b e-directory work
7f10: 2d 61 72 65 61 29 0a 20 20 20 20 20 20 20 20 20 -area).
7f20: 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 ;;(bb-check-pat
7f30: 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 h msg: "launch:e
7f40: 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 xecute post bloc
7f50: 6b 20 31 2e 35 22 29 0a 09 20 20 3b 3b 20 28 63 k 1.5").. ;; (c
7f60: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
7f70: 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 20 20 28 work-area) .. (
7f80: 73 65 74 21 20 6b 65 79 76 61 6c 73 20 20 20 20 set! keyvals
7f90: 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b 65 (keys:target->ke
7fa0: 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 65 74 yval keys target
7fb0: 29 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 20 70 )).. ;; apply p
7fc0: 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 65 66 re-overrides bef
7fd0: 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 61 62 ore other variab
7fe0: 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f 76 65 les. The pre-ove
7ff0: 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 74 20 rride vars must
8000: 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 62 65 not.. ;; clobbe
8010: 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d 20 74 rs things from t
8020: 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f 75 72 he official sour
8030: 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 67 61 ces such as mega
8040: 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 20 test.config and
8050: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
8060: 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 6e 67 g.. (if (string
8070: 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 20 20 ? set-vars)..
8080: 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 61 69 (let ((varpai
8090: 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 rs (string-split
80a0: 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 29 29 set-vars ",")))
80b0: 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 ...(debug:print
80c0: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
80d0: 6f 72 74 2a 20 22 76 61 72 70 61 69 72 73 3a 20 ort* "varpairs:
80e0: 22 20 76 61 72 70 61 69 72 73 29 0a 09 09 28 6d " varpairs)...(m
80f0: 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 72 70 ap (lambda (varp
8100: 61 69 72 29 0a 09 09 20 20 20 20 20 20 20 28 6c air)... (l
8110: 65 74 20 28 28 76 61 72 76 61 6c 20 28 73 74 72 et ((varval (str
8120: 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 61 69 ing-split varpai
8130: 72 20 22 3d 22 29 29 29 0a 09 09 09 20 28 69 66 r "="))).... (if
8140: 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 61 (eq? (length va
8150: 72 76 61 6c 29 20 32 29 0a 09 09 09 20 20 20 20 rval) 2)....
8160: 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 (let ((var (car
8170: 20 76 61 72 76 61 6c 29 29 0a 09 09 09 09 20 20 varval)).....
8180: 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 (val (cadr varv
8190: 61 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 al)))....
81a0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 2a (debug:print 1 *
81b0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
81c0: 2a 20 22 41 64 64 69 6e 67 20 70 72 65 2d 76 61 * "Adding pre-va
81d0: 72 2f 76 61 6c 20 22 20 76 61 72 20 22 20 3d 20 r/val " var " =
81e0: 22 20 76 61 6c 20 22 20 74 6f 20 74 68 65 20 65 " val " to the e
81f0: 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 09 09 nvironment")....
8200: 20 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 76 (setenv v
8210: 61 72 20 76 61 6c 29 29 29 29 29 0a 09 09 20 20 ar val)))))...
8220: 20 20 20 76 61 72 70 61 69 72 73 29 29 29 0a 20 varpairs))).
8230: 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 ;;(bb-c
8240: 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 heck-path msg: "
8250: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 launch:execute p
8260: 6f 73 74 20 62 6c 6f 63 6b 20 32 22 29 0a 09 20 ost block 2")..
8270: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 28 (for-each.. (
8280: 6c 61 6d 62 64 61 20 28 76 61 72 76 61 6c 29 0a lambda (varval).
8290: 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 . (let ((var
82a0: 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 0a 09 (car varval))..
82b0: 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 . (val (cadr v
82c0: 61 72 76 61 6c 29 29 29 0a 09 20 20 20 20 20 20 arval)))..
82d0: 20 28 69 66 20 76 61 6c 0a 09 09 20 20 20 28 73 (if val... (s
82e0: 65 74 65 6e 76 20 76 61 72 20 76 61 6c 29 0a 09 etenv var val)..
82f0: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 . (begin...
8300: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
8310: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
8320: 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 71 75 69 log-port* "requi
8330: 72 65 64 20 76 61 72 69 61 62 6c 65 20 22 20 76 red variable " v
8340: 61 72 20 22 20 64 6f 65 73 20 6e 6f 74 20 68 61 ar " does not ha
8350: 76 65 20 61 20 76 61 6c 69 64 20 76 61 6c 75 65 ve a valid value
8360: 2e 20 45 78 69 74 69 6e 67 22 29 0a 09 09 20 20 . Exiting")...
8370: 20 20 20 28 65 78 69 74 29 29 29 29 29 0a 09 20 (exit)))))..
8380: 20 20 20 20 28 6c 69 73 74 20 0a 09 20 20 20 20 (list ..
8390: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 54 45 53 (list "MT_TES
83a0: 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d T_RUN_DIR" work-
83b0: 61 72 65 61 29 0a 09 20 20 20 20 20 20 28 6c 69 area).. (li
83c0: 73 74 20 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d st "MT_TEST_NAM
83d0: 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 20 E" test-name)..
83e0: 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f (list "MT_
83f0: 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 ITEM_INFO" (conc
8400: 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 20 20 itemdat))..
8410: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 49 54 45 (list "MT_ITE
8420: 4d 50 41 54 48 22 20 20 69 74 65 6d 2d 70 61 74 MPATH" item-pat
8430: 68 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 h).. (list
8440: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 "MT_RUNNAME"
8450: 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 runname)..
8460: 28 6c 69 73 74 20 20 22 4d 54 5f 4d 45 47 41 54 (list "MT_MEGAT
8470: 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 29 0a EST" megatest).
8480: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
8490: 54 5f 54 41 52 47 45 54 22 20 20 20 20 74 61 72 T_TARGET" tar
84a0: 67 65 74 29 0a 09 20 20 20 20 20 20 28 6c 69 73 get).. (lis
84b0: 74 20 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 t "MT_LINKTREE"
84c0: 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 (common:get-li
84d0: 6e 6b 74 72 65 65 29 29 20 3b 3b 20 28 63 6f 6e nktree)) ;; (con
84e0: 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
84f0: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
8500: 22 6c 69 6e 6b 74 72 65 65 22 29 29 0a 09 20 20 "linktree"))..
8510: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 54 (list "MT_T
8520: 45 53 54 53 55 49 54 45 4e 41 4d 45 22 20 28 63 ESTSUITENAME" (c
8530: 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 75 ommon:get-testsu
8540: 69 74 65 2d 6e 61 6d 65 29 29 29 29 0a 20 20 20 ite-name)))).
8550: 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 ;;(bb-che
8560: 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 ck-path msg: "la
8570: 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 6f 73 unch:execute pos
8580: 74 20 62 6c 6f 63 6b 20 33 22 29 0a 0a 09 20 20 t block 3")...
8590: 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 (if mt-bindir-pa
85a0: 74 68 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 th (setenv "PATH
85b0: 22 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 " (conc (getenv
85c0: 22 50 41 54 48 22 29 20 22 3a 22 20 6d 74 2d 62 "PATH") ":" mt-b
85d0: 69 6e 64 69 72 2d 70 61 74 68 29 29 29 0a 20 20 indir-path))).
85e0: 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 ;;(bb-ch
85f0: 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c eck-path msg: "l
8600: 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 6f aunch:execute po
8610: 73 74 20 62 6c 6f 63 6b 20 34 22 29 0a 09 20 20 st block 4")..
8620: 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 ;; (change-direc
8630: 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a 09 tory top-path)..
8640: 20 20 3b 3b 20 43 61 6e 20 73 65 74 75 70 20 61 ;; Can setup a
8650: 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 73 65 72 s client for ser
8660: 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a 09 20 20 ver mode now..
8670: 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 74 75 70 ;; (client:setup
8680: 29 0a 0a 09 20 20 0a 09 20 20 3b 3b 20 65 6e 76 )... .. ;; env
8690: 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 72 69 64 ironment overrid
86a0: 65 73 20 61 72 65 20 64 6f 6e 65 20 2a 62 65 66 es are done *bef
86b0: 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 69 6e 69 ore* the remaini
86c0: 6e 67 20 63 72 69 74 69 63 61 6c 20 65 6e 76 61 ng critical enva
86d0: 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 2d 3e 65 rs... (alist->e
86e0: 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f 76 72 64 nv-vars env-ovrd
86f0: 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 ). ;;(b
8700: 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 b-check-path msg
8710: 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 : "launch:execut
8720: 65 20 70 6f 73 74 20 62 6c 6f 63 6b 20 34 31 22 e post block 41"
8730: 29 0a 09 20 20 28 72 75 6e 73 3a 73 65 74 2d 6d ).. (runs:set-m
8740: 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 61 72 73 egatest-env-vars
8750: 20 72 75 6e 2d 69 64 20 69 6e 6b 65 79 73 3a 20 run-id inkeys:
8760: 6b 65 79 73 20 69 6e 6b 65 79 76 61 6c 73 3a 20 keys inkeyvals:
8770: 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 20 20 20 keyvals).
8780: 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 ;;(bb-check-p
8790: 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 ath msg: "launch
87a0: 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c :execute post bl
87b0: 6f 63 6b 20 34 32 22 29 0a 09 20 20 28 73 65 74 ock 42").. (set
87c0: 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 73 20 69 -item-env-vars i
87d0: 74 65 6d 64 61 74 29 0a 20 20 20 20 20 20 20 20 temdat).
87e0: 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 ;;(bb-check-pa
87f0: 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a th msg: "launch:
8800: 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f execute post blo
8810: 63 6b 20 34 33 22 29 0a 20 20 20 20 20 20 20 20 ck 43").
8820: 20 20 28 6c 65 74 20 28 28 62 6c 61 63 6b 6c 69 (let ((blackli
8830: 73 74 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b st (configf:look
8840: 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
8850: 73 65 74 75 70 22 20 22 62 6c 61 63 6b 6c 69 73 setup" "blacklis
8860: 74 76 61 72 73 22 29 29 29 0a 20 20 20 20 20 20 tvars"))).
8870: 20 20 20 20 20 20 28 69 66 20 62 6c 61 63 6b 6c (if blackl
8880: 69 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 ist.
8890: 20 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f (save-enviro
88a0: 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 nment-as-files "
88b0: 6d 65 67 61 74 65 73 74 22 20 69 67 6e 6f 72 65 megatest" ignore
88c0: 76 61 72 73 3a 20 28 73 74 72 69 6e 67 2d 73 70 vars: (string-sp
88d0: 6c 69 74 20 62 6c 61 63 6b 6c 69 73 74 29 29 0a lit blacklist)).
88e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88f0: 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e (save-environmen
8900: 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 t-as-files "mega
8910: 74 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 20 test"))).
8920: 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 ;;(bb-check-p
8930: 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 ath msg: "launch
8940: 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c :execute post bl
8950: 6f 63 6b 20 34 34 22 29 0a 09 20 20 3b 3b 20 6f ock 44").. ;; o
8960: 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f pen-run-close no
8970: 74 20 6e 65 65 64 65 64 20 66 6f 72 20 74 65 73 t needed for tes
8980: 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a t-set-meta-info.
8990: 09 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 . ;; (tests:set
89a0: 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 -full-meta-info
89b0: 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 #f test-id run-i
89c0: 64 20 30 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 d 0 work-area)..
89d0: 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d ;; (tests:set-
89e0: 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 full-meta-info t
89f0: 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 30 20 est-id run-id 0
8a00: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 74 work-area).. (t
8a10: 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 ests:set-full-me
8a20: 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d ta-info #f test-
8a30: 69 64 20 72 75 6e 2d 69 64 20 30 20 77 6f 72 6b id run-id 0 work
8a40: 2d 61 72 65 61 20 31 30 29 0a 0a 09 20 20 3b 3b -area 10)... ;;
8a50: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
8a60: 30 2e 33 29 20 3b 3b 20 4e 46 53 20 73 6c 6f 77 0.3) ;; NFS slow
8a70: 6e 65 73 73 20 68 61 73 20 63 61 75 73 65 64 20 ness has caused
8a80: 67 72 69 65 66 20 68 65 72 65 0a 0a 09 20 20 28 grief here... (
8a90: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
8aa0: 20 22 2d 78 74 65 72 6d 22 29 0a 09 20 20 20 20 "-xterm")..
8ab0: 20 20 28 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 (set! fullruns
8ac0: 63 72 69 70 74 20 22 78 74 65 72 6d 22 29 0a 09 cript "xterm")..
8ad0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 66 (if (and f
8ae0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 0a 09 09 ullrunscript ...
8af0: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 (common:f
8b00: 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c ile-exists? full
8b10: 72 75 6e 73 63 72 69 70 74 29 0a 09 09 20 20 20 runscript)...
8b20: 20 20 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 (not (file-e
8b30: 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 xecute-access? f
8b40: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
8b50: 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e .. (system (con
8b60: 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 c "chmod ug+x "
8b70: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 fullrunscript)))
8b80: 29 0a 0a 09 20 20 3b 3b 20 57 65 20 61 72 65 20 )... ;; We are
8b90: 61 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c 6c about to actuall
8ba0: 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 74 y kick off the t
8bb0: 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 68 69 est.. ;; so thi
8bc0: 73 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 s is a good plac
8bd0: 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 e to remove the
8be0: 72 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 20 20 records for ..
8bf0: 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 73 20 ;; any previous
8c00: 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 3a 74 runs.. ;; (db:t
8c10: 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 73 est-remove-steps
8c20: 20 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e db run-id testn
8c30: 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 20 ame itemdat)..
8c40: 3b 3b 20 0a 09 20 20 28 6c 65 74 2a 20 28 28 6d ;; .. (let* ((m
8c50: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b (mak
8c60: 65 2d 6d 75 74 65 78 29 29 0a 09 09 20 28 6b 69 e-mutex))... (ki
8c70: 6c 6c 2d 6a 6f 62 3f 20 20 20 20 23 66 29 0a 09 ll-job? #f)..
8c80: 09 20 28 65 78 69 74 2d 69 6e 66 6f 20 20 20 20 . (exit-info
8c90: 28 6d 61 6b 65 2d 6c 61 75 6e 63 68 3a 65 69 6e (make-launch:ein
8ca0: 66 20 70 69 64 3a 20 23 74 20 65 78 69 74 2d 73 f pid: #t exit-s
8cb0: 74 61 74 75 73 3a 20 23 74 20 65 78 69 74 2d 63 tatus: #t exit-c
8cc0: 6f 64 65 3a 20 23 74 20 72 6f 6c 6c 75 70 2d 73 ode: #t rollup-s
8cd0: 74 61 74 75 73 3a 20 30 29 29 20 3b 3b 20 70 69 tatus: 0)) ;; pi
8ce0: 64 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 d exit-status ex
8cf0: 69 74 2d 63 6f 64 65 20 28 69 2e 65 2e 20 70 72 it-code (i.e. pr
8d00: 6f 63 65 73 73 20 77 61 73 20 73 75 63 63 65 73 ocess was succes
8d10: 73 66 75 6c 6c 79 20 72 75 6e 29 20 72 6f 6c 6c sfully run) roll
8d20: 75 70 2d 73 74 61 74 75 73 0a 09 09 20 28 6a 6f up-status... (jo
8d30: 62 2d 74 68 72 65 61 64 20 20 20 23 66 29 0a 09 b-thread #f)..
8d40: 09 20 3b 3b 20 28 6b 65 65 70 2d 67 6f 69 6e 67 . ;; (keep-going
8d50: 20 20 20 23 74 29 0a 09 09 20 28 6d 69 73 63 2d #t)... (misc-
8d60: 66 6c 61 67 73 20 20 20 28 6c 65 74 20 28 28 68 flags (let ((h
8d70: 74 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 t (make-hash-tab
8d80: 6c 65 29 29 29 0a 09 09 09 09 20 28 68 61 73 68 le)))..... (hash
8d90: 2d 74 61 62 6c 65 2d 73 65 74 21 20 68 74 20 27 -table-set! ht '
8da0: 6b 65 65 70 2d 67 6f 69 6e 67 20 23 74 29 0a 09 keep-going #t)..
8db0: 09 09 09 20 68 74 29 29 0a 09 09 20 28 72 75 6e ... ht))... (run
8dc0: 69 74 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 it (lambd
8dd0: 61 20 28 29 0a 09 09 09 09 20 28 6c 61 75 6e 63 a ()..... (launc
8de0: 68 3a 6d 61 6e 61 67 65 2d 73 74 65 70 73 20 72 h:manage-steps r
8df0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 74 un-id test-id it
8e00: 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e 73 em-path fullruns
8e10: 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 65 cript ezsteps te
8e20: 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 72 st-name tconfigr
8e30: 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 29 29 eg exit-info m))
8e40: 29 0a 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 )... (monitorjob
8e50: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 (lambda ()...
8e60: 09 09 20 28 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 .. (launch:monit
8e70: 6f 72 2d 6a 6f 62 20 20 72 75 6e 2d 69 64 20 74 or-job run-id t
8e80: 65 73 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 est-id item-path
8e90: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 fullrunscript e
8ea0: 7a 73 74 65 70 73 20 74 65 73 74 2d 6e 61 6d 65 zsteps test-name
8eb0: 20 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 tconfigreg exit
8ec0: 2d 69 6e 66 6f 20 6d 20 77 6f 72 6b 2d 61 72 65 -info m work-are
8ed0: 61 20 72 75 6e 74 6c 69 6d 20 6d 69 73 63 2d 66 a runtlim misc-f
8ee0: 6c 61 67 73 29 29 29 0a 09 09 20 28 74 68 31 20 lags)))... (th1
8ef0: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 (make-t
8f00: 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 hread monitorjob
8f10: 20 22 6d 6f 6e 69 74 6f 72 20 6a 6f 62 22 29 29 "monitor job"))
8f20: 0a 09 09 20 28 74 68 32 20 20 20 20 20 20 20 20 ... (th2
8f30: 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 (make-thread r
8f40: 75 6e 69 74 20 22 72 75 6e 20 6a 6f 62 22 29 29 unit "run job"))
8f50: 29 0a 09 20 20 20 20 28 73 65 74 21 20 6a 6f 62 ).. (set! job
8f60: 2d 74 68 72 65 61 64 20 74 68 32 29 0a 09 20 20 -thread th2)..
8f70: 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 (thread-start!
8f80: 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 th1).. (thre
8f90: 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 ad-start! th2)..
8fa0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
8fb0: 21 20 74 68 32 29 0a 09 20 20 20 20 28 64 65 62 ! th2).. (deb
8fc0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
8fd0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8fe0: 74 2a 20 22 4d 65 67 61 74 65 73 74 20 65 78 65 t* "Megatest exe
8ff0: 63 74 75 74 65 20 6f 66 20 74 65 73 74 20 22 20 ctute of test "
9000: 74 65 73 74 2d 6e 61 6d 65 20 22 2c 20 69 74 65 test-name ", ite
9010: 6d 20 70 61 74 68 20 22 20 69 74 65 6d 2d 70 61 m path " item-pa
9020: 74 68 20 22 20 63 6f 6d 70 6c 65 74 65 2e 20 4e th " complete. N
9030: 6f 74 69 66 79 69 6e 67 20 74 68 65 20 64 62 20 otifying the db
9040: 2e 2e 2e 22 29 0a 09 20 20 20 20 28 68 61 73 68 ...").. (hash
9050: 2d 74 61 62 6c 65 2d 73 65 74 21 20 6d 69 73 63 -table-set! misc
9060: 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 6f 69 -flags 'keep-goi
9070: 6e 67 20 23 66 29 0a 09 20 20 20 20 28 74 68 72 ng #f).. (thr
9080: 65 61 64 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 09 ead-join! th1)..
9090: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
90a0: 70 21 20 31 29 20 20 20 20 20 20 20 3b 3b 20 67 p! 1) ;; g
90b0: 69 76 62 65 20 74 68 72 65 61 64 20 74 68 31 20 ivbe thread th1
90c0: 61 20 63 68 61 6e 63 65 20 74 6f 20 62 65 20 64 a chance to be d
90d0: 6f 6e 65 20 54 4f 44 4f 3a 20 56 65 72 69 66 79 one TODO: Verify
90e0: 20 74 68 69 73 20 69 73 20 6e 65 65 64 65 64 2e this is needed.
90f0: 20 41 74 20 30 2e 31 20 49 20 77 61 73 20 67 65 At 0.1 I was ge
9100: 74 74 69 6e 67 20 66 61 69 6c 20 74 6f 20 73 74 tting fail to st
9110: 6f 70 2c 20 69 6e 63 72 65 61 73 65 64 20 74 6f op, increased to
9120: 20 74 6f 74 61 6c 20 6f 66 20 31 2e 31 20 73 65 total of 1.1 se
9130: 63 2e 0a 09 20 20 20 20 28 6d 75 74 65 78 2d 6c c... (mutex-l
9140: 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 28 6c 65 ock! m).. (le
9150: 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 t* ((item-path (
9160: 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 item-list->path
9170: 69 74 65 6d 64 61 74 29 29 0a 09 09 20 20 20 3b itemdat))... ;
9180: 3b 20 6f 6e 6c 79 20 73 74 61 74 65 20 61 6e 64 ; only state and
9190: 20 73 74 61 74 75 73 20 6e 65 65 64 65 64 20 2d status needed -
91a0: 20 75 73 65 20 6c 61 7a 79 20 72 6f 75 74 69 6e use lazy routin
91b0: 65 0a 09 09 20 20 20 28 74 65 73 74 69 6e 66 6f e... (testinfo
91c0: 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 69 (rmt:get-testi
91d0: 6e 66 6f 2d 73 74 61 74 65 2d 73 74 61 74 75 73 nfo-state-status
91e0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
91f0: 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 41 6d 20 )).. ;; Am
9200: 49 20 63 6f 6d 70 6c 65 74 65 64 3f 0a 09 20 20 I completed?..
9210: 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 72 20 (if (member
9220: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
9230: 74 65 20 74 65 73 74 69 6e 66 6f 29 20 27 28 22 te testinfo) '("
9240: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART"
9250: 20 22 52 55 4e 4e 49 4e 47 22 29 29 20 3b 3b 20 "RUNNING")) ;;
9260: 4e 4f 54 45 3a 20 49 74 20 73 68 6f 75 6c 64 20 NOTE: It should
9270: 2a 6e 6f 74 2a 20 62 65 20 52 45 4d 4f 54 45 48 *not* be REMOTEH
9280: 4f 53 54 53 54 41 52 54 20 62 75 74 20 66 6f 72 OSTSTART but for
9290: 20 72 65 61 73 6f 6e 73 20 49 20 64 6f 6e 27 74 reasons I don't
92a0: 20 79 65 74 20 75 6e 64 65 72 73 74 61 6e 64 20 yet understand
92b0: 69 74 20 73 6f 6d 65 74 69 6d 65 73 20 67 65 74 it sometimes get
92c0: 73 20 73 74 75 63 6b 20 69 6e 20 74 68 61 74 20 s stuck in that
92d0: 73 74 61 74 65 20 3b 3b 20 28 6e 6f 74 20 28 65 state ;; (not (e
92e0: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
92f0: 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 et-state testinf
9300: 6f 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 o) "COMPLETED"))
9310: 0a 09 09 20 20 28 6c 65 74 20 28 28 6e 65 77 2d ... (let ((new-
9320: 73 74 61 74 65 20 20 28 69 66 20 6b 69 6c 6c 2d state (if kill-
9330: 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 job? "KILLED" "C
9340: 4f 4d 50 4c 45 54 45 44 22 29 20 3b 3b 20 28 69 OMPLETED") ;; (i
9350: 66 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 f (eq? (vector-r
9360: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
9370: 30 29 20 3b 3b 20 65 78 69 74 65 64 20 77 69 74 0) ;; exited wit
9380: 68 20 22 67 6f 6f 64 22 20 73 74 61 74 75 73 0a h "good" status.
9390: 09 09 09 09 20 20 20 20 20 20 20 20 20 20 20 20 ....
93a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93b0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 22 ;; "
93c0: 43 4f 4d 50 4c 45 54 45 44 22 0a 09 09 09 09 09 COMPLETED"......
93d0: 09 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
93e0: 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 ;; (db:test-ge
93f0: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
9400: 29 29 29 20 20 20 3b 3b 20 65 6c 73 65 20 70 72 ))) ;; else pr
9410: 65 73 65 76 65 20 74 68 65 20 73 74 61 74 65 20 eseve the state
9420: 61 73 20 73 65 74 20 77 69 74 68 69 6e 20 74 68 as set within th
9430: 65 20 74 65 73 74 0a 09 09 09 09 20 20 20 20 29 e test..... )
9440: 0a 09 09 09 28 6e 65 77 2d 73 74 61 74 75 73 20 ....(new-status
9450: 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 20 28 (cond..... (
9460: 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 65 69 6e (not (launch:ein
9470: 66 2d 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 f-exit-status ex
9480: 69 74 2d 69 6e 66 6f 29 29 20 22 46 41 49 4c 22 it-info)) "FAIL"
9490: 29 20 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 64 20 ) ;; job failed
94a0: 74 6f 20 72 75 6e 20 2e 2e 2e 20 28 76 65 63 74 to run ... (vect
94b0: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
94c0: 20 31 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 1)..... ((e
94d0: 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d q? (launch:einf-
94e0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
94f0: 69 74 2d 69 6e 66 6f 29 20 30 29 20 20 20 20 20 it-info) 0)
9500: 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 ;; (vector-ref e
9510: 78 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 xit-info 3).....
9520: 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 ;; if the
9530: 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 current status i
9540: 73 20 41 55 54 4f 20 74 68 65 6e 20 64 65 66 65 s AUTO then defe
9550: 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 r to the calcula
9560: 74 65 64 20 76 61 6c 75 65 20 28 69 2e 65 2e 20 ted value (i.e.
9570: 6c 65 61 76 65 20 74 68 69 73 20 41 55 54 4f 29 leave this AUTO)
9580: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
9590: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
95a0: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 get-status testi
95b0: 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 nfo) "AUTO") "AU
95c0: 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 09 09 TO" "PASS"))....
95d0: 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 . ((eq? (lau
95e0: 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d nch:einf-rollup-
95f0: 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f status exit-info
9600: 29 20 31 29 20 22 46 41 49 4c 22 29 20 20 3b 3b ) 1) "FAIL") ;;
9610: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
9620: 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 20 20 t-info 3).....
9630: 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 ((eq? (launch
9640: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
9650: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 32 tus exit-info) 2
9660: 29 09 20 20 20 20 20 3b 3b 09 28 76 65 63 74 6f ). ;;.(vecto
9670: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
9680: 33 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 3)..... ;;
9690: 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 if the current s
96a0: 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 tatus is AUTO th
96b0: 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 e defer to the c
96c0: 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 alculated value
96d0: 62 75 74 20 71 75 61 6c 69 66 79 20 28 69 2e 65 but qualify (i.e
96e0: 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 55 54 4f . make this AUTO
96f0: 2d 57 41 52 4e 29 0a 09 09 09 09 20 20 20 20 20 -WARN).....
9700: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 (if (equal? (db
9710: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
9720: 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f testinfo) "AUTO
9730: 22 29 20 22 41 55 54 4f 2d 57 41 52 4e 22 20 22 ") "AUTO-WARN" "
9740: 57 41 52 4e 22 29 29 0a 09 09 09 09 20 20 20 20 WARN")).....
9750: 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 3a 65 ((eq? (launch:e
9760: 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 inf-rollup-statu
9770: 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 33 29 20 s exit-info) 3)
9780: 22 43 48 45 43 4b 22 29 0a 09 09 09 09 20 20 20 "CHECK").....
9790: 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 3a ((eq? (launch:
97a0: 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 einf-rollup-stat
97b0: 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 34 29 us exit-info) 4)
97c0: 20 22 57 41 49 56 45 44 22 29 0a 09 09 09 09 20 "WAIVED").....
97d0: 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 ((eq? (launc
97e0: 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 h:einf-rollup-st
97f0: 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 atus exit-info)
9800: 35 29 20 22 41 42 4f 52 54 22 29 0a 09 09 09 09 5) "ABORT").....
9810: 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e ((eq? (laun
9820: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
9830: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
9840: 20 36 29 20 22 53 4b 49 50 22 29 0a 09 09 09 09 6) "SKIP").....
9850: 20 20 20 20 20 28 65 6c 73 65 20 22 46 41 49 4c (else "FAIL
9860: 22 29 29 29 29 20 3b 3b 20 28 64 62 3a 74 65 73 ")))) ;; (db:tes
9870: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
9880: 74 69 6e 66 6f 29 29 29 0a 09 09 20 20 20 20 28 tinfo)))... (
9890: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
98a0: 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
98b0: 70 6f 72 74 2a 20 22 54 65 73 74 20 65 78 69 74 port* "Test exit
98c0: 65 64 20 69 6e 20 73 74 61 74 65 3d 22 20 28 64 ed in state=" (d
98d0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
98e0: 20 74 65 73 74 69 6e 66 6f 29 20 22 2c 20 73 65 testinfo) ", se
98f0: 74 74 69 6e 67 20 73 74 61 74 65 2f 73 74 61 74 tting state/stat
9900: 75 73 20 62 61 73 65 64 20 6f 6e 20 65 78 69 74 us based on exit
9910: 20 63 6f 64 65 20 6f 66 20 22 20 28 6c 61 75 6e code of " (laun
9920: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 ch:einf-exit-sta
9930: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 22 tus exit-info) "
9940: 20 61 6e 64 20 72 6f 6c 6c 75 70 2d 73 74 61 74 and rollup-stat
9950: 75 73 20 6f 66 20 22 20 28 6c 61 75 6e 63 68 3a us of " (launch:
9960: 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 einf-rollup-stat
9970: 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 29 0a 09 us exit-info))..
9980: 09 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 . (tests:test
9990: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
99a0: 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 74 65 -id ...... te
99b0: 73 74 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 st-id ......
99c0: 6e 65 77 2d 73 74 61 74 65 0a 09 09 09 09 09 20 new-state......
99d0: 20 20 20 6e 65 77 2d 73 74 61 74 75 73 0a 09 09 new-status...
99e0: 09 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 ... (args:get
99f0: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
9a00: 09 20 20 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 . ;; need to
9a10: 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 20 74 update the top t
9a20: 65 73 74 20 72 65 63 6f 72 64 20 69 66 20 50 41 est record if PA
9a30: 53 53 20 6f 72 20 46 41 49 4c 20 61 6e 64 20 74 SS or FAIL and t
9a40: 68 69 73 20 69 73 20 61 20 73 75 62 74 65 73 74 his is a subtest
9a50: 0a 09 09 20 20 20 20 3b 3b 20 4e 4f 20 4e 45 45 ... ;; NO NEE
9a60: 44 20 54 4f 20 43 41 4c 4c 20 73 65 74 2d 73 74 D TO CALL set-st
9a70: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
9a80: 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 48 45 52 oll-up-items HER
9a90: 45 2c 20 54 48 49 53 20 49 53 20 44 4f 4e 45 20 E, THIS IS DONE
9aa0: 49 4e 20 73 65 74 2d 73 74 61 74 65 2d 73 74 61 IN set-state-sta
9ab0: 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d tus-and-roll-up-
9ac0: 69 74 65 6d 73 20 63 61 6c 6c 65 64 20 62 79 20 items called by
9ad0: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
9ae0: 74 61 74 75 73 21 0a 09 09 20 20 20 20 29 29 0a tatus!... )).
9af0: 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 . ;; for au
9b00: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
9b10: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
9b20: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
9b30: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
9b40: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
9b50: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
9b60: 74 68 20 22 22 29 29 0a 09 09 20 20 28 74 65 73 th ""))... (tes
9b70: 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ts:summarize-ite
9b80: 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ms run-id test-i
9b90: 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 29 d test-name #f))
9ba0: 0a 09 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 .. (tests:s
9bb0: 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 20 72 75 ummarize-test ru
9bc0: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 20 20 3b n-id test-id) ;
9bd0: 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 20 2d 20 ; don't force -
9be0: 6a 75 73 74 20 75 70 64 61 74 65 20 69 66 20 6e just update if n
9bf0: 6f 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 75 70 o.. (rmt:up
9c00: 64 61 74 65 2d 72 75 6e 2d 73 74 61 74 73 20 72 date-run-stats r
9c10: 75 6e 2d 69 64 20 28 72 6d 74 3a 67 65 74 2d 72 un-id (rmt:get-r
9c20: 61 77 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 6e aw-run-stats run
9c30: 2d 69 64 29 29 29 0a 09 20 20 20 20 28 6d 75 74 -id))).. (mut
9c40: 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 20 ex-unlock! m)..
9c50: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
9c60: 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
9c70: 6f 72 74 2a 20 22 4f 75 74 70 75 74 20 66 72 6f ort* "Output fro
9c80: 6d 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c m running " full
9c90: 72 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 64 runscript ", pid
9ca0: 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d " (launch:einf-
9cb0: 70 69 64 20 65 78 69 74 2d 69 6e 66 6f 29 20 22 pid exit-info) "
9cc0: 20 69 6e 20 77 6f 72 6b 20 61 72 65 61 20 22 20 in work area "
9cd0: 0a 09 09 09 20 77 6f 72 6b 2d 61 72 65 61 20 22 .... work-area "
9ce0: 3a 5c 6e 3d 3d 3d 3d 5c 6e 20 65 78 69 74 20 63 :\n====\n exit c
9cf0: 6f 64 65 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 ode " (launch:ei
9d00: 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 69 nf-exit-code exi
9d10: 74 2d 69 6e 66 6f 29 20 22 5c 6e 22 20 22 3d 3d t-info) "\n" "==
9d20: 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 28 69 66 20 ==\n").. (if
9d30: 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 65 69 6e (not (launch:ein
9d40: 66 2d 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 f-exit-status ex
9d50: 69 74 2d 69 6e 66 6f 29 29 0a 09 09 28 65 78 69 it-info))...(exi
9d60: 74 20 34 29 29 29 29 0a 20 20 20 20 20 20 20 20 t 4)))).
9d70: 29 29 29 0a 0a 3b 3b 20 44 4f 20 4e 4f 54 20 55 )))..;; DO NOT U
9d80: 53 45 20 2d 20 63 61 63 68 69 6e 67 20 6f 66 20 SE - caching of
9d90: 63 6f 6e 66 69 67 73 20 69 73 20 68 61 6e 64 6c configs is handl
9da0: 65 64 20 69 6e 20 6c 61 75 6e 63 68 3a 73 65 74 ed in launch:set
9db0: 75 70 20 6e 6f 77 2e 0a 3b 3b 0a 28 64 65 66 69 up now..;;.(defi
9dc0: 6e 65 20 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 ne (launch:cache
9dd0: 2d 63 6f 6e 66 69 67 29 0a 20 20 3b 3b 20 69 66 -config). ;; if
9de0: 20 77 65 20 68 61 76 65 20 61 20 6c 69 6e 6b 74 we have a linkt
9df0: 72 65 65 20 61 6e 64 20 2d 72 75 6e 74 65 73 74 ree and -runtest
9e00: 73 20 61 6e 64 20 2d 74 61 72 67 65 74 20 61 6e s and -target an
9e10: 64 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 d the directory
9e20: 65 78 69 73 74 73 20 64 75 6d 70 20 74 68 65 20 exists dump the
9e30: 63 6f 6e 66 69 67 0a 20 20 3b 3b 20 74 6f 20 6d config. ;; to m
9e40: 65 67 61 74 65 73 74 2d 28 63 75 72 72 65 6e 74 egatest-(current
9e50: 2d 73 65 63 6f 6e 64 73 29 2e 63 66 67 20 61 6e -seconds).cfg an
9e60: 64 20 73 79 6d 6c 69 6e 6b 20 69 74 20 74 6f 20 d symlink it to
9e70: 6d 65 67 61 74 65 73 74 2e 63 66 67 0a 20 20 28 megatest.cfg. (
9e80: 69 66 20 28 61 6e 64 20 2a 63 6f 6e 66 69 67 64 if (and *configd
9e90: 61 74 2a 20 0a 09 20 20 20 28 6f 72 20 28 61 72 at* .. (or (ar
9ea0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e gs:get-arg "-run
9eb0: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
9ec0: 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 :get-arg "-runte
9ed0: 73 74 73 22 29 0a 09 20 20 20 20 20 20 20 28 61 sts").. (a
9ee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 rgs:get-arg "-ex
9ef0: 65 63 75 74 65 22 29 29 29 0a 20 20 20 20 20 20 ecute"))).
9f00: 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 74 72 65 65 (let* ((linktree
9f10: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e (common:get-lin
9f20: 6b 74 72 65 65 29 29 20 3b 3b 20 28 67 65 74 2d ktree)) ;; (get-
9f30: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
9f40: 61 62 6c 65 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 able "MT_LINKTRE
9f50: 45 22 29 29 0a 09 20 20 20 20 20 28 74 61 72 67 E")).. (targ
9f60: 65 74 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 et (common:arg
9f70: 73 2d 67 65 74 2d 74 61 72 67 65 74 20 65 78 69 s-get-target exi
9f80: 74 2d 69 66 2d 62 61 64 3a 20 23 74 29 29 0a 09 t-if-bad: #t))..
9f90: 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 28 (runname (
9fa0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
9fb0: 20 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 "-runname")....
9fc0: 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 (args:get-arg
9fd0: 20 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 ":runname")....
9fe0: 20 20 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 (getenv "MT_R
9ff0: 55 4e 4e 41 4d 45 22 29 29 29 0a 09 20 20 20 20 UNNAME")))..
a000: 20 28 66 75 6c 6c 64 69 72 20 20 28 63 6f 6e 63 (fulldir (conc
a010: 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 0a 09 09 linktree "/"...
a020: 09 20 20 20 20 20 74 61 72 67 65 74 20 22 2f 22 . target "/"
a030: 0a 09 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 .... runname
a040: 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 6c 69 )))..(if (and li
a050: 6e 6b 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 66 nktree (common:f
a060: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b ile-exists? link
a070: 74 72 65 65 29 29 20 3b 3b 20 63 61 6e 27 74 20 tree)) ;; can't
a080: 70 72 6f 63 65 65 64 20 77 69 74 68 6f 75 74 20 proceed without
a090: 6c 69 6e 6b 74 72 65 65 0a 09 20 20 20 20 28 62 linktree.. (b
a0a0: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
a0b0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
a0c0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
a0d0: 74 2a 20 22 48 61 76 65 20 2d 72 75 6e 20 77 69 t* "Have -run wi
a0e0: 74 68 20 74 61 72 67 65 74 3d 22 20 74 61 72 67 th target=" targ
a0f0: 65 74 20 22 2c 20 72 75 6e 6e 61 6d 65 3d 22 20 et ", runname="
a100: 72 75 6e 6e 61 6d 65 20 22 2c 20 66 75 6c 6c 64 runname ", fulld
a110: 69 72 3d 22 20 66 75 6c 6c 64 69 72 20 22 2c 20 ir=" fulldir ",
a120: 74 65 73 74 70 61 74 74 3d 22 20 28 6f 72 20 28 testpatt=" (or (
a130: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 args:get-arg "-t
a140: 65 73 74 70 61 74 74 22 29 20 22 25 22 29 29 0a estpatt") "%")).
a150: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
a160: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
a170: 73 74 73 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 sts? fulldir))..
a180: 09 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 . (create-direc
a190: 74 6f 72 79 20 66 75 6c 6c 64 69 72 20 23 74 29 tory fulldir #t)
a1a0: 29 20 3b 3b 20 6e 65 65 64 20 74 6f 20 70 72 6f ) ;; need to pro
a1b0: 74 65 63 74 20 77 69 74 68 20 65 78 63 65 70 74 tect with except
a1c0: 69 6f 6e 20 68 61 6e 64 6c 65 72 20 0a 09 20 20 ion handler ..
a1d0: 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 61 72 (if (and tar
a1e0: 67 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e get... run
a1f0: 6e 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 63 name... (c
a200: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
a210: 73 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 20 s? fulldir))...
a220: 20 28 6c 65 74 20 28 28 74 6d 70 66 69 6c 65 20 (let ((tmpfile
a230: 20 28 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 (conc fulldir "
a240: 2f 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2e 22 /.megatest.cfg."
a250: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
a260: 73 29 29 29 0a 09 09 09 28 74 61 72 67 66 69 6c s)))....(targfil
a270: 65 20 28 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 e (conc fulldir
a280: 22 2f 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2d "/.megatest.cfg-
a290: 22 20 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
a2a0: 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 ion "-" megatest
a2b0: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 29 0a 09 -fossil-hash))..
a2c0: 09 09 28 72 63 6f 6e 66 69 67 20 20 28 63 6f 6e ..(rconfig (con
a2d0: 63 20 66 75 6c 6c 64 69 72 20 22 2f 2e 72 75 6e c fulldir "/.run
a2e0: 63 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 config." megates
a2f0: 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 t-version "-" me
a300: 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 gatest-fossil-ha
a310: 73 68 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 sh)))... (if
a320: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
a330: 73 74 73 3f 20 72 63 6f 6e 66 69 67 29 20 3b 3b sts? rconfig) ;;
a340: 20 6f 6e 6c 79 20 63 61 63 68 65 20 6d 65 67 61 only cache mega
a350: 74 65 73 74 2e 63 6f 6e 66 69 67 20 41 46 54 45 test.config AFTE
a360: 52 20 72 75 6e 63 6f 6e 66 69 67 73 20 68 61 73 R runconfigs has
a370: 20 62 65 65 6e 20 63 61 63 68 65 64 0a 09 09 09 been cached....
a380: 28 62 65 67 69 6e 0a 09 09 09 20 20 28 64 65 62 (begin.... (deb
a390: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
a3a0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
a3b0: 74 2a 20 22 43 61 63 68 69 6e 67 20 6d 65 67 61 t* "Caching mega
a3c0: 74 65 73 74 2e 63 6f 6e 66 69 67 20 69 6e 20 22 test.config in "
a3d0: 20 74 6d 70 66 69 6c 65 29 0a 20 20 20 20 20 20 tmpfile).
a3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f (if (not (co
a400: 6d 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d mmon:in-running-
a410: 74 65 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 test?)).
a420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a430: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 77 (configf:w
a440: 72 69 74 65 2d 61 6c 69 73 74 20 2a 63 6f 6e 66 rite-alist *conf
a450: 69 67 64 61 74 2a 20 74 6d 70 66 69 6c 65 29 29 igdat* tmpfile))
a460: 0a 09 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 .... (system (c
a470: 6f 6e 63 20 22 6c 6e 20 2d 73 66 20 22 20 74 6d onc "ln -sf " tm
a480: 70 66 69 6c 65 20 22 20 22 20 74 61 72 67 66 69 pfile " " targfi
a490: 6c 65 29 29 29 29 0a 09 09 20 20 20 20 29 29 29 le))))... )))
a4a0: 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
a4b0: 6e 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 nt-info 1 *defau
a4c0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f lt-log-port* "No
a4d0: 20 6c 69 6e 6b 74 72 65 65 20 79 65 74 2c 20 6e linktree yet, n
a4e0: 6f 20 63 61 63 68 69 6e 67 20 63 6f 6e 66 69 67 o caching config
a4f0: 73 2e 22 29 29 29 29 29 0a 0a 0a 3b 3b 20 67 61 s.")))))...;; ga
a500: 74 68 65 72 20 61 76 61 69 6c 61 62 6c 65 20 69 ther available i
a510: 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 69 66 20 6c nformation, if l
a520: 65 67 69 74 20 72 65 61 64 20 63 6f 6e 66 69 67 egit read config
a530: 73 20 69 6e 20 74 68 69 73 20 6f 72 64 65 72 3a s in this order:
a540: 0a 3b 3b 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 .;;.;; if have
a550: 20 63 61 63 68 65 3b 0a 3b 3b 20 20 20 20 20 20 cache;.;;
a560: 72 65 61 64 20 69 74 20 61 20 72 65 74 75 72 6e read it a return
a570: 20 69 74 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b it.;; else.;;
a580: 20 20 20 20 20 6d 65 67 61 74 65 73 74 2e 63 6f megatest.co
a590: 6e 66 69 67 20 20 20 20 20 28 64 6f 20 6e 6f 74 nfig (do not
a5a0: 20 63 61 63 68 65 29 0a 3b 3b 20 20 20 20 20 72 cache).;; r
a5b0: 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 unconfigs.config
a5c0: 20 20 20 28 63 61 63 68 65 20 69 66 20 61 6c 6c (cache if all
a5d0: 20 76 61 72 73 20 61 76 61 69 6c 29 0a 3b 3b 20 vars avail).;;
a5e0: 20 20 20 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e megatest.con
a5f0: 66 69 67 20 20 20 20 20 28 63 61 63 68 65 20 69 fig (cache i
a600: 66 20 61 6c 6c 20 76 61 72 73 20 61 76 61 69 6c f all vars avail
a610: 29 0a 3b 3b 20 20 20 72 65 74 75 72 6e 73 3a 0a ).;; returns:.
a620: 3b 3b 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a ;; *toppath*
a630: 0a 3b 3b 20 20 20 73 69 64 65 20 65 66 66 65 63 .;; side effec
a640: 74 73 3a 0a 3b 3b 20 20 20 20 20 73 65 74 73 3b ts:.;; sets;
a650: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 20 20 *configdat*
a660: 28 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 (megatest.config
a670: 20 69 6e 66 6f 29 0a 3b 3b 20 20 20 20 20 20 20 info).;;
a680: 20 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 *runconfigda
a690: 74 2a 20 28 72 75 6e 63 6f 6e 66 69 67 73 2e 63 t* (runconfigs.c
a6a0: 6f 6e 66 69 67 20 69 6e 66 6f 29 0a 3b 3b 20 20 onfig info).;;
a6b0: 20 20 20 20 20 20 20 20 20 2a 63 6f 6e 66 69 67 *config
a6c0: 73 74 61 74 75 73 2a 20 28 73 74 61 74 75 73 20 status* (status
a6d0: 6f 66 20 74 68 65 20 72 65 61 64 20 64 61 74 61 of the read data
a6e0: 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 ).;;.(define (la
a6f0: 75 6e 63 68 3a 73 65 74 75 70 20 23 21 6b 65 79 unch:setup #!key
a700: 20 28 66 6f 72 63 65 2d 72 65 72 65 61 64 20 23 (force-reread #
a710: 66 29 20 28 61 72 65 61 70 61 74 68 20 23 66 29 f) (areapath #f)
a720: 29 0a 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 ). (mutex-lock!
a730: 20 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d *launch-setup-m
a740: 75 74 65 78 2a 29 0a 20 20 28 69 66 20 28 61 6e utex*). (if (an
a750: 64 20 2a 74 6f 70 70 61 74 68 2a 0a 09 20 20 20 d *toppath*..
a760: 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 (eq? *configstat
a770: 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 20 28 us* 'fulldata) (
a780: 6e 6f 74 20 66 6f 72 63 65 2d 72 65 72 65 61 64 not force-reread
a790: 29 29 20 3b 3b 20 67 6f 74 20 69 74 20 61 6c 6c )) ;; got it all
a7a0: 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 . (begin..(
a7b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
a7c0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
a7d0: 20 22 4e 4f 54 45 3a 20 73 6b 69 70 70 69 6e 67 "NOTE: skipping
a7e0: 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f launch:setup-bo
a7f0: 64 79 20 63 61 6c 6c 20 73 69 6e 63 65 20 77 65 dy call since we
a800: 20 68 61 76 65 20 66 75 6c 6c 64 61 74 61 22 29 have fulldata")
a810: 0a 09 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 ..(mutex-unlock!
a820: 20 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d *launch-setup-m
a830: 75 74 65 78 2a 29 0a 09 2a 74 6f 70 70 61 74 68 utex*)..*toppath
a840: 2a 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 *). (let ((
a850: 72 65 73 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 res (launch:setu
a860: 70 2d 62 6f 64 79 20 66 6f 72 63 65 2d 72 65 72 p-body force-rer
a870: 65 61 64 3a 20 66 6f 72 63 65 2d 72 65 72 65 61 ead: force-rerea
a880: 64 20 61 72 65 61 70 61 74 68 3a 20 61 72 65 61 d areapath: area
a890: 70 61 74 68 29 29 29 0a 09 28 6d 75 74 65 78 2d path)))..(mutex-
a8a0: 75 6e 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 2d unlock! *launch-
a8b0: 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 0a 09 72 setup-mutex*)..r
a8c0: 65 73 29 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e es)))..;; return
a8d0: 20 70 61 74 68 73 20 64 65 70 65 6e 64 69 6e 67 paths depending
a8e0: 20 6f 6e 20 77 68 61 74 20 69 6e 66 6f 20 69 73 on what info is
a8f0: 20 61 76 61 69 6c 61 62 6c 65 2e 0a 3b 3b 0a 28 available..;;.(
a900: 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 define (launch:g
a910: 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 et-cache-file-pa
a920: 74 68 73 20 61 72 65 61 70 61 74 68 20 74 6f 70 ths areapath top
a930: 70 61 74 68 20 74 61 72 67 65 74 20 6d 74 63 6f path target mtco
a940: 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 nfig). (let* ((
a950: 75 73 65 2d 63 61 63 68 65 20 28 63 6f 6d 6d 6f use-cache (commo
a960: 6e 3a 75 73 65 2d 63 61 63 68 65 3f 29 29 0a 20 n:use-cache?)).
a970: 20 20 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 (runname
a980: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
a990: 65 74 2d 72 75 6e 6e 61 6d 65 29 29 0a 20 20 20 et-runname)).
a9a0: 20 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 (linktree
a9b0: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b (common:get-link
a9c0: 74 72 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 tree)).
a9d0: 28 74 65 73 74 6e 61 6d 65 20 28 63 6f 6d 6d 6f (testname (commo
a9e0: 6e 3a 67 65 74 2d 66 75 6c 6c 2d 74 65 73 74 2d n:get-full-test-
a9f0: 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 name)).
aa00: 28 72 75 6e 64 69 72 20 20 20 28 69 66 20 28 61 (rundir (if (a
aa10: 6e 64 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 nd runname targe
aa20: 74 20 6c 69 6e 6b 74 72 65 65 29 0a 20 20 20 20 t linktree).
aa30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa40: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 (common:direc
aa50: 74 6f 72 79 2d 77 72 69 74 61 62 6c 65 3f 20 28 tory-writable? (
aa60: 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f conc linktree "/
aa70: 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e " target "/" run
aa80: 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 name)).
aa90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
aaa0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 65 73 )). (tes
aab0: 74 64 69 72 20 20 28 69 66 20 28 61 6e 64 20 72 tdir (if (and r
aac0: 75 6e 64 69 72 20 74 65 73 74 6e 61 6d 65 29 0a undir testname).
aad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aae0: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 64 (common:d
aaf0: 69 72 65 63 74 6f 72 79 2d 77 72 69 74 61 62 6c irectory-writabl
ab00: 65 3f 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 e? (conc rundir
ab10: 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 20 "/" testname)).
ab20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab30: 20 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 #f)).
ab40: 20 20 20 20 28 63 61 63 68 65 64 69 72 20 28 6f (cachedir (o
ab50: 72 20 74 65 73 74 64 69 72 20 72 75 6e 64 69 72 r testdir rundir
ab60: 29 29 0a 20 20 20 20 20 20 20 20 20 28 6d 74 63 )). (mtc
ab70: 61 63 68 65 66 20 28 61 6e 64 20 63 61 63 68 65 achef (and cache
ab80: 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 65 64 dir (conc cached
ab90: 69 72 20 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 ir "/" ".megates
aba0: 74 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 t.cfg-" megates
abb0: 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 t-version "-" me
abc0: 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 gatest-fossil-ha
abd0: 73 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 sh))). (
abe0: 72 63 63 61 63 68 65 66 20 28 61 6e 64 20 63 61 rccachef (and ca
abf0: 63 68 65 64 69 72 20 28 63 6f 6e 63 20 63 61 63 chedir (conc cac
ac00: 68 65 64 69 72 20 22 2f 22 20 22 2e 72 75 6e 63 hedir "/" ".runc
ac10: 6f 6e 66 69 67 73 2e 63 66 67 2d 22 20 20 6d 65 onfigs.cfg-" me
ac20: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 gatest-version "
ac30: 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 -" megatest-foss
ac40: 69 6c 2d 68 61 73 68 29 29 29 29 0a 20 20 20 20 il-hash)))).
ac50: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
ac60: 6f 20 36 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 6 *default-log
ac70: 2d 70 6f 72 74 2a 20 0a 20 20 20 20 20 20 20 20 -port* .
ac80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 72 "r
ac90: 75 6e 6e 61 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 unname=" runname
aca0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
acb0: 20 20 20 20 20 20 20 20 22 5c 6e 20 20 6c 69 6e "\n lin
acc0: 6b 74 72 65 65 3d 22 20 6c 69 6e 6b 74 72 65 65 ktree=" linktree
acd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ace0: 20 20 20 20 20 20 20 22 5c 6e 20 20 74 65 73 74 "\n test
acf0: 6e 61 6d 65 3d 22 20 74 65 73 74 6e 61 6d 65 0a name=" testname.
ad00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad10: 20 20 20 20 20 20 22 5c 6e 20 20 72 75 6e 64 69 "\n rundi
ad20: 72 3d 22 20 72 75 6e 64 69 72 20 0a 20 20 20 20 r=" rundir .
ad30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad40: 20 20 22 5c 6e 20 20 74 65 73 74 64 69 72 3d 22 "\n testdir="
ad50: 20 74 65 73 74 64 69 72 20 0a 20 20 20 20 20 20 testdir .
ad60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ad70: 22 5c 6e 20 20 63 61 63 68 65 64 69 72 3d 22 20 "\n cachedir="
ad80: 63 61 63 68 65 64 69 72 0a 20 20 20 20 20 20 20 cachedir.
ad90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
ada0: 5c 6e 20 20 6d 74 63 61 63 68 65 66 3d 22 20 6d \n mtcachef=" m
adb0: 74 63 61 63 68 65 66 0a 20 20 20 20 20 20 20 20 tcachef.
adc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 5c "\
add0: 6e 20 20 72 63 63 61 63 68 65 66 3d 22 20 72 63 n rccachef=" rc
ade0: 63 61 63 68 65 66 29 0a 20 20 20 20 28 63 6f 6e cachef). (con
adf0: 73 20 6d 74 63 61 63 68 65 66 20 72 63 63 61 63 s mtcachef rccac
ae00: 68 65 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 hef)))..(define
ae10: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f (launch:setup-bo
ae20: 64 79 20 23 21 6b 65 79 20 28 66 6f 72 63 65 2d dy #!key (force-
ae30: 72 65 72 65 61 64 20 23 66 29 20 28 61 72 65 61 reread #f) (area
ae40: 70 61 74 68 20 23 66 29 29 0a 20 20 28 69 66 20 path #f)). (if
ae50: 28 61 6e 64 20 28 65 71 3f 20 2a 63 6f 6e 66 69 (and (eq? *confi
ae60: 67 73 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 gstatus* 'fullda
ae70: 74 61 29 0a 09 20 20 20 2a 74 6f 70 70 61 74 68 ta).. *toppath
ae80: 2a 0a 09 20 20 20 28 6e 6f 74 20 66 6f 72 63 65 *.. (not force
ae90: 2d 72 65 72 65 61 64 29 29 20 3b 3b 20 6e 6f 20 -reread)) ;; no
aea0: 6e 65 65 64 20 74 6f 20 72 65 70 72 6f 63 65 73 need to reproces
aeb0: 73 0a 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 s. *toppath
aec0: 2a 20 20 20 3b 3b 20 72 65 74 75 72 6e 20 74 6f * ;; return to
aed0: 70 70 61 74 68 0a 20 20 20 20 20 20 28 6c 65 74 ppath. (let
aee0: 2a 20 28 28 75 73 65 2d 63 61 63 68 65 20 28 63 * ((use-cache (c
aef0: 6f 6d 6d 6f 6e 3a 75 73 65 2d 63 61 63 68 65 3f ommon:use-cache?
af00: 29 29 20 3b 3b 20 42 42 2d 20 75 73 65 2d 63 61 )) ;; BB- use-ca
af10: 63 68 65 20 63 68 65 63 6b 73 20 2a 63 6f 6e 66 che checks *conf
af20: 69 67 64 61 74 2a 20 66 6f 72 20 75 73 65 2d 63 igdat* for use-c
af30: 61 63 68 65 20 73 65 74 74 69 6e 67 2e 20 20 57 ache setting. W
af40: 65 20 64 6f 20 6e 6f 74 20 68 61 76 65 20 2a 63 e do not have *c
af50: 6f 6e 66 69 67 64 61 74 2a 2e 20 20 42 6f 6f 74 onfigdat*. Boot
af60: 73 74 72 61 70 70 69 6e 67 20 70 72 6f 62 6c 65 strapping proble
af70: 6d 20 68 65 72 65 2e 0a 09 20 20 20 20 20 28 74 m here... (t
af80: 6f 70 70 61 74 68 20 20 28 6f 72 20 2a 74 6f 70 oppath (or *top
af90: 70 61 74 68 2a 20 61 72 65 61 70 61 74 68 20 28 path* areapath (
afa0: 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 getenv "MT_RUN_A
afb0: 52 45 41 5f 48 4f 4d 45 22 29 29 29 20 3b 3b 20 REA_HOME"))) ;;
afc0: 70 72 65 73 65 72 76 65 20 74 6f 70 70 61 74 68 preserve toppath
afd0: 0a 09 20 20 20 20 20 28 74 61 72 67 65 74 20 20 .. (target
afe0: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
aff0: 74 2d 74 61 72 67 65 74 29 29 0a 09 20 20 20 20 t-target))..
b000: 20 28 73 65 63 74 69 6f 6e 73 20 28 69 66 20 74 (sections (if t
b010: 61 72 67 65 74 20 28 6c 69 73 74 20 22 64 65 66 arget (list "def
b020: 61 75 6c 74 22 20 74 61 72 67 65 74 29 20 23 66 ault" target) #f
b030: 29 29 20 3b 3b 20 66 6f 72 20 72 75 6e 63 6f 6e )) ;; for runcon
b040: 66 69 67 73 0a 09 20 20 20 20 20 28 6d 74 63 6f figs.. (mtco
b050: 6e 66 69 67 20 28 6f 72 20 28 61 72 67 73 3a 67 nfig (or (args:g
b060: 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 et-arg "-config"
b070: 29 20 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 ) "megatest.conf
b080: 69 67 22 29 29 20 3b 3b 20 61 6c 6c 6f 77 20 6f ig")) ;; allow o
b090: 76 65 72 72 69 64 69 6e 67 20 6d 65 67 61 74 65 verriding megate
b0a0: 73 74 2e 63 6f 6e 66 69 67 20 0a 20 20 20 20 20 st.config .
b0b0: 20 20 20 20 20 20 20 20 28 63 61 63 68 65 66 69 (cachefi
b0c0: 6c 65 73 20 28 6c 61 75 6e 63 68 3a 67 65 74 2d les (launch:get-
b0d0: 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 74 68 73 cache-file-paths
b0e0: 20 61 72 65 61 70 61 74 68 20 74 6f 70 70 61 74 areapath toppat
b0f0: 68 20 74 61 72 67 65 74 20 6d 74 63 6f 6e 66 69 h target mtconfi
b100: 67 29 29 0a 09 20 20 20 20 20 3b 3b 20 63 68 65 g)).. ;; che
b110: 63 6b 69 6e 67 20 66 6f 72 20 6e 75 6c 6c 20 63 cking for null c
b120: 61 63 68 65 66 69 6c 65 73 20 73 68 6f 75 6c 64 achefiles should
b130: 20 6e 6f 74 20 62 65 20 6e 65 63 65 73 73 61 72 not be necessar
b140: 79 2c 20 49 20 77 61 73 20 73 65 65 69 6e 67 20 y, I was seeing
b150: 65 72 72 6f 72 20 63 61 72 20 6f 66 20 27 28 29 error car of '()
b160: 2c 20 6d 69 67 68 74 20 62 65 20 61 20 63 68 69 , might be a chi
b170: 63 6b 65 6e 20 62 75 67 20 6f 72 20 61 20 72 65 cken bug or a re
b180: 64 20 68 65 72 72 69 6e 67 20 2e 2e 2e 0a 09 20 d herring .....
b190: 20 20 20 20 28 6d 74 63 61 63 68 65 66 20 20 20 (mtcachef
b1a0: 28 69 66 20 28 6e 75 6c 6c 3f 20 63 61 63 68 65 (if (null? cache
b1b0: 66 69 6c 65 73 29 0a 09 09 09 20 20 20 20 20 23 files).... #
b1c0: 66 0a 09 09 09 20 20 20 20 20 28 63 61 72 20 63 f.... (car c
b1d0: 61 63 68 65 66 69 6c 65 73 29 29 29 20 3b 3b 20 achefiles))) ;;
b1e0: 28 61 6e 64 20 63 61 63 68 65 64 69 72 20 28 63 (and cachedir (c
b1f0: 6f 6e 63 20 63 61 63 68 65 64 69 72 20 22 2f 22 onc cachedir "/"
b200: 20 22 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2d ".megatest.cfg-
b210: 22 20 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 " megatest-vers
b220: 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 ion "-" megatest
b230: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 29 29 0a -fossil-hash))).
b240: 09 20 20 20 20 20 28 72 63 63 61 63 68 65 66 20 . (rccachef
b250: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 61 63 (if (null? cac
b260: 68 65 66 69 6c 65 73 29 0a 09 09 09 20 20 20 20 hefiles)....
b270: 20 23 66 0a 09 09 09 20 20 20 20 20 28 63 64 72 #f.... (cdr
b280: 20 63 61 63 68 65 66 69 6c 65 73 29 29 29 29 20 cachefiles))))
b290: 3b 3b 20 28 61 6e 64 20 63 61 63 68 65 64 69 72 ;; (and cachedir
b2a0: 20 28 63 6f 6e 63 20 63 61 63 68 65 64 69 72 20 (conc cachedir
b2b0: 22 2f 22 20 22 2e 72 75 6e 63 6f 6e 66 69 67 73 "/" ".runconfigs
b2c0: 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 .cfg-" megatest
b2d0: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
b2e0: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
b2f0: 68 29 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 28 h))).. ;; (
b300: 63 61 6e 63 72 65 61 74 65 20 28 61 6e 64 20 63 cancreate (and c
b310: 61 63 68 65 64 69 72 20 28 63 6f 6d 6d 6f 6e 3a achedir (common:
b320: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 63 61 63 file-exists? cac
b330: 68 65 64 69 72 29 28 66 69 6c 65 2d 77 72 69 74 hedir)(file-writ
b340: 65 2d 61 63 63 65 73 73 3f 20 63 61 63 68 65 64 e-access? cached
b350: 69 72 29 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e ir) (not (common
b360: 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d 74 65 73 74 :in-running-test
b370: 3f 29 29 29 29 29 0a 09 28 73 65 74 21 20 2a 74 ?)))))..(set! *t
b380: 6f 70 70 61 74 68 2a 20 74 6f 70 70 61 74 68 29 oppath* toppath)
b390: 20 3b 3b 20 54 68 69 73 20 69 73 20 6e 65 65 64 ;; This is need
b3a0: 65 64 20 77 68 65 6e 20 77 65 20 61 72 65 20 72 ed when we are r
b3b0: 75 6e 6e 69 6e 67 20 61 73 20 61 20 74 65 73 74 unning as a test
b3c0: 20 75 73 69 6e 67 20 43 4d 44 49 4e 46 4f 20 61 using CMDINFO a
b3d0: 73 20 61 20 64 61 74 61 73 6f 75 72 63 65 0a 20 s a datasource.
b3e0: 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c ;;(BB> "l
b3f0: 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 aunch:setup-body
b400: 20 2d 2d 20 63 61 63 68 65 66 69 6c 65 73 3d 22 -- cachefiles="
b410: 63 61 63 68 65 66 69 6c 65 73 29 0a 09 28 63 6f cachefiles)..(co
b420: 6e 64 0a 09 20 3b 3b 20 69 66 20 6d 74 63 61 63 nd.. ;; if mtcac
b430: 68 65 66 20 65 78 69 73 74 73 20 6a 75 73 74 20 hef exists just
b440: 72 65 61 64 20 69 74 2c 20 68 6f 77 65 76 65 72 read it, however
b450: 20 77 65 20 6e 65 65 64 20 74 6f 20 61 73 73 75 we need to assu
b460: 6d 65 20 74 6f 70 70 61 74 68 20 69 73 20 61 76 me toppath is av
b470: 61 69 6c 61 62 6c 65 20 69 6e 20 24 4d 54 5f 52 ailable in $MT_R
b480: 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 0a 09 20 28 UN_AREA_HOME.. (
b490: 28 61 6e 64 20 28 6e 6f 74 20 66 6f 72 63 65 2d (and (not force-
b4a0: 72 65 72 65 61 64 29 0a 09 20 20 20 20 20 20 20 reread)..
b4b0: 6d 74 63 61 63 68 65 66 20 20 72 63 63 61 63 68 mtcachef rccach
b4c0: 65 66 0a 09 20 20 20 20 20 20 20 75 73 65 2d 63 ef.. use-c
b4d0: 61 63 68 65 0a 09 20 20 20 20 20 20 20 28 67 65 ache.. (ge
b4e0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
b4f0: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
b500: 52 45 41 5f 48 4f 4d 45 22 29 0a 09 20 20 20 20 REA_HOME")..
b510: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d (common:file-
b520: 65 78 69 73 74 73 3f 20 6d 74 63 61 63 68 65 66 exists? mtcachef
b530: 29 0a 09 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f ).. (commo
b540: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 n:file-exists? r
b550: 63 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 20 ccachef)).
b560: 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 6e ;;(BB> "laun
b570: 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d 2d ch:setup-body --
b580: 20 63 6f 6e 64 20 62 72 61 6e 63 68 20 31 20 2d cond branch 1 -
b590: 20 75 73 65 2d 63 61 63 68 65 22 29 0a 20 20 20 use-cache").
b5a0: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 63 6f (set! *co
b5b0: 6e 66 69 67 64 61 74 2a 20 20 20 20 28 63 6f 6e nfigdat* (con
b5c0: 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 figf:read-alist
b5d0: 6d 74 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 mtcachef)).
b5e0: 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 ;;(BB> "lau
b5f0: 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d nch:setup-body -
b600: 2d 20 31 20 73 65 74 21 20 2a 63 6f 6e 66 69 67 - 1 set! *config
b610: 64 61 74 2a 3d 22 2a 63 6f 6e 66 69 67 64 61 74 dat*="*configdat
b620: 2a 29 0a 09 20 20 28 73 65 74 21 20 2a 72 75 6e *).. (set! *run
b630: 63 6f 6e 66 69 67 64 61 74 2a 20 28 63 6f 6e 66 configdat* (conf
b640: 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 74 20 72 igf:read-alist r
b650: 63 63 61 63 68 65 66 29 29 0a 09 20 20 28 73 65 ccachef)).. (se
b660: 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 t! *configinfo*
b670: 20 20 28 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 (list *configd
b680: 61 74 2a 20 20 28 67 65 74 2d 65 6e 76 69 72 6f at* (get-enviro
b690: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
b6a0: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
b6b0: 22 29 29 29 0a 09 20 20 28 73 65 74 21 20 2a 63 "))).. (set! *c
b6c0: 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 27 66 75 onfigstatus* 'fu
b6d0: 6c 6c 64 61 74 61 29 0a 09 20 20 28 73 65 74 21 lldata).. (set!
b6e0: 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 20 20 *toppath*
b6f0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
b700: 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 -variable "MT_RU
b710: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 0a 09 N_AREA_HOME"))..
b720: 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 20 3b *toppath*).. ;
b730: 3b 20 74 68 65 72 65 20 61 72 65 20 6e 6f 20 65 ; there are no e
b740: 78 69 73 74 69 6e 67 20 63 61 63 68 65 64 20 63 xisting cached c
b750: 6f 6e 66 69 67 73 2c 20 64 6f 20 66 75 6c 6c 20 onfigs, do full
b760: 72 65 61 64 73 20 6f 66 20 74 68 65 20 63 6f 6e reads of the con
b770: 66 69 67 73 20 61 6e 64 20 63 61 63 68 65 20 74 figs and cache t
b780: 68 65 6d 0a 09 20 3b 3b 20 77 65 20 68 61 76 65 hem.. ;; we have
b790: 20 61 6c 6c 20 74 68 65 20 69 6e 66 6f 20 6e 65 all the info ne
b7a0: 65 64 65 64 20 74 6f 20 66 75 6c 6c 79 20 70 72 eded to fully pr
b7b0: 6f 63 65 73 73 20 72 75 6e 63 6f 6e 66 69 67 73 ocess runconfigs
b7c0: 20 61 6e 64 20 6d 65 67 61 74 65 73 74 2e 63 6f and megatest.co
b7d0: 6e 66 69 67 0a 09 20 28 28 61 6e 64 20 3b 3b 20 nfig.. ((and ;;
b7e0: 28 6e 6f 74 20 66 6f 72 63 65 2d 72 65 72 65 61 (not force-rerea
b7f0: 64 29 20 3b 3b 20 66 6f 72 63 65 2d 72 65 72 65 d) ;; force-rere
b800: 61 64 20 69 73 20 69 72 72 65 6c 65 76 61 6e 74 ad is irrelevant
b810: 20 69 6e 20 74 68 65 20 41 4e 44 2c 20 63 6f 75 in the AND, cou
b820: 6c 64 20 68 6f 77 65 76 65 72 20 4f 52 20 69 74 ld however OR it
b830: 3f 0a 09 20 20 20 20 20 20 20 6d 74 63 61 63 68 ?.. mtcach
b840: 65 66 0a 09 20 20 20 20 20 20 20 72 63 63 61 63 ef.. rccac
b850: 68 65 66 29 20 3b 3b 20 42 42 2d 20 77 68 79 20 hef) ;; BB- why
b860: 61 72 65 20 77 65 20 64 6f 69 6e 67 20 74 68 69 are we doing thi
b870: 73 20 77 69 74 68 6f 75 74 20 61 73 6b 69 6e 67 s without asking
b880: 20 69 66 20 63 61 63 68 69 6e 67 20 69 73 20 64 if caching is d
b890: 65 73 69 72 65 64 3f 0a 20 20 20 20 20 20 20 20 esired?.
b8a0: 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 6e 63 68 ;;(BB> "launch
b8b0: 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d 2d 20 63 :setup-body -- c
b8c0: 6f 6e 64 20 62 72 61 6e 63 68 20 32 22 29 0a 09 ond branch 2")..
b8d0: 20 20 28 6c 65 74 2a 20 28 28 66 69 72 73 74 2d (let* ((first-
b8e0: 70 61 73 73 20 20 20 20 28 66 69 6e 64 2d 61 6e pass (find-an
b8f0: 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 20 20 20 d-read-config
b900: 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 73 65 74 ;; NB// set
b910: 73 20 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f s MT_RUN_AREA_HO
b920: 4d 45 20 61 73 20 73 69 64 65 20 65 66 66 65 63 ME as side effec
b930: 74 0a 09 09 09 09 20 6d 74 63 6f 6e 66 69 67 0a t..... mtconfig.
b940: 09 09 09 09 20 65 6e 76 69 72 6f 6e 2d 70 61 74 .... environ-pat
b950: 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 t: "env-override
b960: 22 0a 09 09 09 09 20 67 69 76 65 6e 2d 74 6f 70 "..... given-top
b970: 70 61 74 68 3a 20 74 6f 70 70 61 74 68 0a 09 09 path: toppath...
b980: 09 09 20 70 61 74 68 65 6e 76 76 61 72 3a 20 22 .. pathenvvar: "
b990: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
b9a0: 22 29 29 0a 09 09 20 28 66 69 72 73 74 2d 72 75 "))... (first-ru
b9b0: 6e 64 61 74 20 20 28 6c 65 74 20 28 28 74 6f 70 ndat (let ((top
b9c0: 70 61 74 68 20 28 69 66 20 74 6f 70 70 61 74 68 path (if toppath
b9d0: 20 0a 09 09 09 09 09 09 20 20 20 74 6f 70 70 61 ....... toppa
b9e0: 74 68 0a 09 09 09 09 09 09 20 20 20 28 63 61 72 th....... (car
b9f0: 20 66 69 72 73 74 2d 70 61 73 73 29 29 29 29 0a first-pass)))).
ba00: 09 09 09 09 20 20 28 72 65 61 64 2d 63 6f 6e 66 .... (read-conf
ba10: 69 67 20 3b 3b 20 28 63 6f 6e 63 20 74 6f 70 70 ig ;; (conc topp
ba20: 61 74 68 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 ath "/runconfigs
ba30: 2e 63 6f 6e 66 69 67 22 29 20 3b 3b 20 74 68 69 .config") ;; thi
ba40: 73 20 73 68 6f 75 6c 64 20 62 65 20 63 6f 6e 76 s should be conv
ba50: 65 72 74 65 64 20 74 6f 20 72 75 6e 63 6f 6e 66 erted to runconf
ba60: 69 67 3a 72 65 61 64 20 62 75 74 20 69 74 20 69 ig:read but it i
ba70: 73 20 6e 6f 6e 2d 74 72 69 76 69 61 6c 2c 20 6c s non-trivial, l
ba80: 65 61 76 69 6e 67 20 69 74 20 66 6f 72 20 6e 6f eaving it for no
ba90: 77 2e 0a 09 09 09 09 20 20 20 28 63 6f 6e 63 20 w...... (conc
baa0: 28 69 66 20 28 73 74 72 69 6e 67 3f 20 74 6f 70 (if (string? top
bab0: 70 61 74 68 29 0a 09 09 09 09 09 20 20 20 20 20 path)......
bac0: 74 6f 70 70 61 74 68 0a 09 09 09 09 09 20 20 20 toppath......
bad0: 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 (get-environme
bae0: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f nt-variable "MT_
baf0: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 RUN_AREA_HOME"))
bb00: 0a 09 09 09 09 09 20 22 2f 72 75 6e 63 6f 6e 66 ...... "/runconf
bb10: 69 67 73 2e 63 6f 6e 66 69 67 22 29 0a 09 09 09 igs.config")....
bb20: 09 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 . *runconfigda
bb30: 74 2a 20 23 74 20 0a 09 09 09 09 20 20 20 73 65 t* #t ..... se
bb40: 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 ctions: sections
bb50: 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 )))).. (set!
bb60: 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 66 *runconfigdat* f
bb70: 69 72 73 74 2d 72 75 6e 64 61 74 29 0a 09 20 20 irst-rundat)..
bb80: 20 20 28 69 66 20 66 69 72 73 74 2d 70 61 73 73 (if first-pass
bb90: 20 20 3b 3b 20 0a 09 09 28 62 65 67 69 6e 0a 20 ;; ...(begin.
bba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbb0: 20 3b 3b 28 42 42 3e 20 22 6c 61 75 6e 63 68 3a ;;(BB> "launch:
bbc0: 73 65 74 75 70 2d 62 6f 64 79 20 2d 2d 20 5c 22 setup-body -- \"
bbd0: 66 69 72 73 74 2d 70 61 73 73 5c 22 3d 66 69 72 first-pass\"=fir
bbe0: 73 74 2d 70 61 73 73 22 29 0a 09 09 20 20 28 73 st-pass")... (s
bbf0: 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 et! *configdat*
bc00: 20 28 63 61 72 20 66 69 72 73 74 2d 70 61 73 73 (car first-pass
bc10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
bc20: 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 ;;(BB> "lau
bc30: 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d nch:setup-body -
bc40: 2d 20 32 20 73 65 74 21 20 2a 63 6f 6e 66 69 67 - 2 set! *config
bc50: 64 61 74 2a 3d 22 2a 63 6f 6e 66 69 67 64 61 74 dat*="*configdat
bc60: 2a 29 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f *)... (set! *co
bc70: 6e 66 69 67 69 6e 66 6f 2a 20 66 69 72 73 74 2d nfiginfo* first-
bc80: 70 61 73 73 29 0a 09 09 20 20 28 73 65 74 21 20 pass)... (set!
bc90: 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 28 6f 72 *toppath* (or
bca0: 20 74 6f 70 70 61 74 68 20 28 63 61 64 72 20 66 toppath (cadr f
bcb0: 69 72 73 74 2d 70 61 73 73 29 29 29 20 3b 3b 20 irst-pass))) ;;
bcc0: 75 73 65 20 74 68 65 20 67 61 74 68 65 72 65 64 use the gathered
bcd0: 20 64 61 74 61 20 75 6e 6c 65 73 73 20 61 6c 72 data unless alr
bce0: 65 61 64 79 20 68 61 76 65 20 69 74 0a 09 09 20 eady have it...
bcf0: 20 28 73 65 74 21 20 74 6f 70 70 61 74 68 20 20 (set! toppath
bd00: 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 *toppath*)..
bd10: 09 20 20 28 69 66 20 28 6e 6f 74 20 2a 74 6f 70 . (if (not *top
bd20: 70 61 74 68 2a 29 0a 09 09 20 20 20 20 20 20 28 path*)... (
bd30: 62 65 67 69 6e 0a 09 09 09 28 64 65 62 75 67 3a begin....(debug:
bd40: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
bd50: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
bd60: 20 22 79 6f 75 20 61 72 65 20 6e 6f 74 20 69 6e "you are not in
bd70: 20 61 20 6d 65 67 61 74 65 73 74 20 61 72 65 61 a megatest area
bd80: 21 22 29 0a 09 09 09 28 65 78 69 74 20 31 29 29 !")....(exit 1))
bd90: 29 0a 09 09 20 20 28 73 65 74 65 6e 76 20 22 4d )... (setenv "M
bda0: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
bdb0: 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 20 20 *toppath*)...
bdc0: 3b 3b 20 74 68 65 20 73 65 65 64 20 72 65 61 64 ;; the seed read
bdd0: 20 69 73 20 64 6f 6e 65 2c 20 6e 6f 77 20 72 65 is done, now re
bde0: 61 64 20 72 75 6e 63 6f 6e 66 69 67 73 2c 20 63 ad runconfigs, c
bdf0: 61 63 68 65 20 69 74 20 74 68 65 6e 20 72 65 61 ache it then rea
be00: 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 d megatest.confi
be10: 67 20 6f 6e 65 20 6d 6f 72 65 20 74 69 6d 65 20 g one more time
be20: 61 6e 64 20 63 61 63 68 65 20 69 74 0a 09 09 20 and cache it...
be30: 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 20 20 20 (let* ((keys
be40: 20 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b (rmt:get-k
be50: 65 79 73 29 29 0a 09 09 09 20 28 6b 65 79 2d 76 eys)).... (key-v
be60: 61 6c 73 20 20 20 20 20 28 6b 65 79 73 3a 74 61 als (keys:ta
be70: 72 67 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 rget->keyval key
be80: 73 20 74 61 72 67 65 74 29 29 0a 09 09 09 20 28 s target)).... (
be90: 6c 69 6e 6b 74 72 65 65 20 20 20 20 20 28 63 6f linktree (co
bea0: 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 mmon:get-linktre
beb0: 65 29 29 20 3b 3b 20 28 6f 72 20 28 67 65 74 65 e)) ;; (or (gete
bec0: 6e 76 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 nv "MT_LINKTREE"
bed0: 29 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a )(if *configdat*
bee0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
bef0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
bf00: 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 tup" "linktree")
bf10: 20 23 66 29 29 29 0a 09 09 09 09 09 3b 20 20 20 #f)))......;
bf20: 20 20 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 (if *configdat
bf30: 2a 0a 09 09 09 09 09 3b 20 09 20 20 20 28 63 6f *......; . (co
bf40: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
bf50: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
bf60: 20 22 6c 69 6e 6b 74 72 65 65 22 29 0a 09 09 09 "linktree")....
bf70: 09 09 3b 20 09 20 20 20 28 63 6f 6e 63 20 2a 74 ..; . (conc *t
bf80: 6f 70 70 61 74 68 2a 20 22 2f 6c 74 22 29 29 29 oppath* "/lt")))
bf90: 29 0a 09 09 09 20 28 73 65 63 6f 6e 64 2d 70 61 ).... (second-pa
bfa0: 73 73 20 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 ss (find-and-re
bfb0: 61 64 2d 63 6f 6e 66 69 67 0a 09 09 09 09 09 6d ad-config......m
bfc0: 74 63 6f 6e 66 69 67 0a 09 09 09 09 09 65 6e 76 tconfig......env
bfd0: 69 72 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d iron-patt: "env-
bfe0: 6f 76 65 72 72 69 64 65 22 0a 09 09 09 09 09 67 override"......g
bff0: 69 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 74 6f iven-toppath: to
c000: 70 70 61 74 68 0a 09 09 09 09 09 70 61 74 68 65 ppath......pathe
c010: 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 nvvar: "MT_RUN_A
c020: 52 45 41 5f 48 4f 4d 45 22 29 29 0a 09 09 09 20 REA_HOME"))....
c030: 28 72 75 6e 63 6f 6e 66 69 67 64 61 74 20 28 62 (runconfigdat (b
c040: 65 67 69 6e 20 20 20 20 20 3b 3b 20 74 68 69 73 egin ;; this
c050: 20 72 65 61 64 20 6f 66 20 74 68 65 20 72 75 6e read of the run
c060: 63 6f 6e 66 69 67 73 20 77 69 6c 6c 20 73 65 65 configs will see
c070: 20 61 6e 79 20 61 64 6a 75 73 74 6d 65 6e 74 73 any adjustments
c080: 20 6d 61 64 65 20 62 79 20 72 65 2d 72 65 61 64 made by re-read
c090: 69 6e 67 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e ing megatest.con
c0a0: 66 69 67 0a 09 09 09 09 09 20 28 66 6f 72 2d 65 fig...... (for-e
c0b0: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 29 ach (lambda (kt)
c0c0: 0a 09 09 09 09 09 09 20 20 20 20 20 28 73 65 74 ....... (set
c0d0: 65 6e 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 env (car kt) (ca
c0e0: 64 72 20 6b 74 29 29 29 0a 09 09 09 09 09 09 20 dr kt))).......
c0f0: 20 20 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 09 key-vals).....
c100: 09 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 . (read-config (
c110: 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 conc toppath "/r
c120: 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 unconfigs.config
c130: 22 29 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 ") *runconfigdat
c140: 2a 20 23 74 20 3b 3b 20 63 6f 6e 73 69 64 65 72 * #t ;; consider
c150: 20 75 73 69 6e 67 20 72 75 6e 63 6f 6e 66 69 67 using runconfig
c160: 3a 72 65 61 64 20 73 6f 6d 65 20 64 61 79 20 2e :read some day .
c170: 2e 2e 0a 09 09 09 09 09 09 20 20 20 20 20 20 73 ......... s
c180: 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e ections: section
c190: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
c1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
c1b0: 61 63 68 65 66 69 6c 65 73 20 20 20 28 6c 61 75 achefiles (lau
c1c0: 6e 63 68 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 nch:get-cache-fi
c1d0: 6c 65 2d 70 61 74 68 73 20 61 72 65 61 70 61 74 le-paths areapat
c1e0: 68 20 74 6f 70 70 61 74 68 20 74 61 72 67 65 74 h toppath target
c1f0: 20 6d 74 63 6f 6e 66 69 67 29 29 0a 20 20 20 20 mtconfig)).
c200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c210: 20 20 20 20 20 28 6d 74 63 61 63 68 65 66 20 20 (mtcachef
c220: 20 20 20 28 63 61 72 20 63 61 63 68 65 66 69 6c (car cachefil
c230: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
c240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
c250: 63 63 61 63 68 65 66 20 20 20 20 20 28 63 64 72 ccachef (cdr
c260: 20 63 61 63 68 65 66 69 6c 65 73 29 29 29 0a 20 cachefiles))).
c270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c280: 20 20 20 3b 3b 20 20 74 72 61 70 20 65 78 63 65 ;; trap exce
c290: 70 74 69 6f 6e 20 64 75 65 20 74 6f 20 73 74 61 ption due to sta
c2a0: 6c 65 20 4e 46 53 20 68 61 6e 64 6c 65 20 2d 2d le NFS handle --
c2b0: 20 45 72 72 6f 72 3a 20 28 6f 70 65 6e 2d 6f 75 Error: (open-ou
c2c0: 74 70 75 74 2d 66 69 6c 65 29 20 63 61 6e 6e 6f tput-file) canno
c2d0: 74 20 6f 70 65 6e 20 66 69 6c 65 20 2d 20 53 74 t open file - St
c2e0: 61 6c 65 20 4e 46 53 20 66 69 6c 65 20 68 61 6e ale NFS file han
c2f0: 64 6c 65 3a 20 22 2f 70 2f 66 64 6b 2f 67 77 61 dle: "/p/fdk/gwa
c300: 2f 6c 65 66 6b 6f 77 69 74 2f 6d 74 54 65 73 74 /lefkowit/mtTest
c310: 69 6e 67 2f 71 61 2f 70 72 69 6d 62 65 71 61 2f ing/qa/primbeqa/
c320: 6c 69 6e 6b 73 2f 70 31 32 32 32 2f 31 31 2f 50 links/p1222/11/P
c330: 44 4b 5f 72 31 2e 31 2e 31 2f 70 72 69 6d 2f 63 DK_r1.1.1/prim/c
c340: 6c 65 61 6e 2f 70 63 65 6c 6c 5f 74 65 73 74 67 lean/pcell_testg
c350: 65 6e 2f 2e 72 75 6e 63 6f 6e 66 69 67 73 2e 63 en/.runconfigs.c
c360: 66 67 2d 31 2e 36 34 32 37 2d 37 64 31 65 37 38 fg-1.6427-7d1e78
c370: 39 63 62 33 66 36 32 66 39 63 64 65 37 31 39 61 9cb3f62f9cde719a
c380: 34 38 36 35 62 62 35 31 62 33 63 31 37 65 61 38 4865bb51b3c17ea8
c390: 35 33 22 20 2d 20 74 69 63 6b 65 74 20 32 32 30 53" - ticket 220
c3a0: 35 34 36 33 34 32 0a 20 20 20 20 20 20 20 20 20 546342.
c3b0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 54 4f ;; TO
c3c0: 44 4f 20 2d 20 63 6f 6e 73 69 64 65 72 20 31 29 DO - consider 1)
c3d0: 20 75 73 69 6e 67 20 73 69 6d 70 6c 65 2d 6c 6f using simple-lo
c3e0: 63 6b 20 74 6f 20 62 72 61 63 6b 65 74 20 63 61 ck to bracket ca
c3f0: 63 68 65 20 77 72 69 74 65 0a 20 20 20 20 20 20 che write.
c400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
c410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c420: 20 32 29 20 63 61 63 68 65 20 69 6e 20 68 61 73 2) cache in has
c430: 68 20 6f 6e 20 73 65 72 76 65 72 2c 20 73 69 6e h on server, sin
c440: 63 65 20 6e 65 65 64 20 74 6f 20 64 6f 20 72 6d ce need to do rm
c450: 74 3a 20 61 6e 79 77 61 79 20 74 6f 20 6c 6f 63 t: anyway to loc
c460: 6b 2e 0a 0a 09 09 20 20 20 20 28 69 66 20 72 63 k..... (if rc
c470: 63 61 63 68 65 66 0a 20 20 20 20 20 20 20 20 20 cachef.
c480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c490: 63 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 common:fail-safe
c4a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c4b0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
c4c0: 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 a ().
c4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4e0: 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 (configf:write-a
c4f0: 6c 69 73 74 20 72 75 6e 63 6f 6e 66 69 67 64 61 list runconfigda
c500: 74 20 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 t rccachef)).
c510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c520: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 (conc "Cou
c530: 6c 64 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 ld not write cac
c540: 68 65 20 66 69 6c 65 20 2d 20 22 72 63 63 61 63 he file - "rccac
c550: 68 65 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 hef))).
c560: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 6d (if m
c570: 74 63 61 63 68 65 66 0a 20 20 20 20 20 20 20 20 tcachef.
c580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c590: 28 63 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 (common:fail-saf
c5a0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
c5b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
c5c0: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
c5d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c5e0: 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d (configf:write-
c5f0: 61 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 alist *configdat
c600: 2a 20 6d 74 63 61 63 68 65 66 29 29 0a 20 20 20 * mtcachef)).
c610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c620: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 (conc "Cou
c630: 6c 64 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 ld not write cac
c640: 68 65 20 66 69 6c 65 20 2d 20 22 6d 74 63 61 63 he file - "mtcac
c650: 68 65 66 29 29 29 0a 09 09 20 20 20 20 28 73 65 hef)))... (se
c660: 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 t! *runconfigdat
c670: 2a 20 72 75 6e 63 6f 6e 66 69 67 64 61 74 29 0a * runconfigdat).
c680: 09 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 .. (if (and r
c690: 63 63 61 63 68 65 66 20 6d 74 63 61 63 68 65 66 ccachef mtcachef
c6a0: 29 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 ) (set! *configs
c6b0: 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 tatus* 'fulldata
c6c0: 29 29 29 29 0a 09 09 3b 3b 20 6e 6f 20 63 6f 6e ))))...;; no con
c6d0: 66 69 67 73 20 66 6f 75 6e 64 3f 20 73 68 6f 75 figs found? shou
c6e0: 6c 64 20 6e 6f 74 20 68 61 70 70 65 6e 20 62 75 ld not happen bu
c6f0: 74 20 6c 65 74 27 73 20 74 72 79 20 74 6f 20 72 t let's try to r
c700: 65 63 6f 76 65 72 20 67 72 61 63 65 66 75 6c 6c ecover gracefull
c710: 79 2c 20 72 65 74 75 72 6e 20 61 6e 20 65 6d 70 y, return an emp
c720: 74 79 20 68 61 73 68 2d 74 61 62 6c 65 0a 09 09 ty hash-table...
c730: 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 (set! *configdat
c740: 2a 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 * (make-hash-tab
c750: 6c 65 29 29 0a 09 09 29 29 29 0a 0a 09 20 3b 3b le))...)))... ;;
c760: 20 65 6c 73 65 20 72 65 61 64 20 77 68 61 74 20 else read what
c770: 79 6f 75 20 63 61 6e 20 61 6e 64 20 73 65 74 20 you can and set
c780: 74 68 65 20 66 6c 61 67 20 61 63 63 6f 72 64 69 the flag accordi
c790: 6e 67 6c 79 0a 09 20 3b 3b 20 68 65 72 65 20 77 ngly.. ;; here w
c7a0: 65 20 64 6f 6e 27 74 20 68 61 76 65 20 65 69 74 e don't have eit
c7b0: 68 65 72 20 6d 74 63 6f 6e 66 69 67 20 6f 72 20 her mtconfig or
c7c0: 72 63 63 61 63 68 65 66 0a 09 20 28 65 6c 73 65 rccachef.. (else
c7d0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 . ;;(BB
c7e0: 3e 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d > "launch:setup-
c7f0: 62 6f 64 79 20 2d 2d 20 63 6f 6e 64 20 62 72 61 body -- cond bra
c800: 6e 63 68 20 33 20 2d 20 65 6c 73 65 22 29 0a 09 nch 3 - else")..
c810: 20 20 28 6c 65 74 2a 20 28 28 63 66 67 64 61 74 (let* ((cfgdat
c820: 20 20 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 (find-and-rea
c830: 64 2d 63 6f 6e 66 69 67 20 0a 09 09 09 20 20 20 d-config ....
c840: 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 (or (args:get-a
c850: 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 6d rg "-config") "m
c860: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 egatest.config")
c870: 0a 09 09 09 20 20 20 20 65 6e 76 69 72 6f 6e 2d .... environ-
c880: 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 patt: "env-overr
c890: 69 64 65 22 0a 09 09 09 20 20 20 20 67 69 76 65 ide".... give
c8a0: 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 65 74 2d n-toppath: (get-
c8b0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
c8c0: 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 able "MT_RUN_ARE
c8d0: 41 5f 48 4f 4d 45 22 29 0a 09 09 09 20 20 20 20 A_HOME")....
c8e0: 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 5f pathenvvar: "MT_
c8f0: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 RUN_AREA_HOME"))
c900: 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 ).. (
c910: 69 66 20 28 61 6e 64 20 63 66 67 64 61 74 20 28 if (and cfgdat (
c920: 6c 69 73 74 3f 20 63 66 67 64 61 74 29 20 28 3e list? cfgdat) (>
c930: 20 28 6c 65 6e 67 74 68 20 63 66 67 64 61 74 29 (length cfgdat)
c940: 20 30 29 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 0) (hash-table?
c950: 20 28 63 61 72 20 63 66 67 64 61 74 29 29 29 0a (car cfgdat))).
c960: 09 09 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 ..(let* ((toppat
c970: 68 20 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 h (or (get-envi
c980: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
c990: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
c9a0: 4d 45 22 29 28 63 61 64 72 20 63 66 67 64 61 74 ME")(cadr cfgdat
c9b0: 29 29 29 0a 09 09 20 20 20 20 20 20 20 28 72 64 )))... (rd
c9c0: 61 74 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e at (read-con
c9d0: 66 69 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 fig (conc toppat
c9e0: 68 20 20 3b 3b 20 63 6f 6e 76 65 72 74 20 74 68 h ;; convert th
c9f0: 69 73 20 74 6f 20 75 73 65 20 72 75 6e 63 6f 6e is to use runcon
ca00: 66 69 67 3a 72 65 61 64 21 0a 09 09 09 09 09 09 fig:read!.......
ca10: 20 20 20 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 "/runconfigs
ca20: 2e 63 6f 6e 66 69 67 22 29 20 2a 72 75 6e 63 6f .config") *runco
ca30: 6e 66 69 67 64 61 74 2a 20 23 74 20 73 65 63 74 nfigdat* #t sect
ca40: 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 ions: sections))
ca50: 29 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f 6e )... (set! *con
ca60: 66 69 67 69 6e 66 6f 2a 20 20 20 63 66 67 64 61 figinfo* cfgda
ca70: 74 29 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f t)... (set! *co
ca80: 6e 66 69 67 64 61 74 2a 20 20 20 20 28 63 61 72 nfigdat* (car
ca90: 20 63 66 67 64 61 74 29 29 0a 09 09 20 20 28 73 cfgdat))... (s
caa0: 65 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 et! *runconfigda
cab0: 74 2a 20 72 64 61 74 29 0a 09 09 20 20 28 73 65 t* rdat)... (se
cac0: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 t! *toppath*
cad0: 20 20 74 6f 70 70 61 74 68 29 0a 09 09 20 20 28 toppath)... (
cae0: 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 74 set! *configstat
caf0: 75 73 2a 20 27 70 61 72 74 69 61 6c 29 29 0a 09 us* 'partial))..
cb00: 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 .(begin... (deb
cb10: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
cb20: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
cb30: 72 74 2a 20 22 4e 6f 20 22 20 6d 74 63 6f 6e 66 rt* "No " mtconf
cb40: 69 67 20 22 20 66 69 6c 65 20 66 6f 75 6e 64 2e ig " file found.
cb50: 20 47 69 76 69 6e 67 20 75 70 2e 22 29 0a 09 09 Giving up.")...
cb60: 20 20 28 65 78 69 74 20 32 29 29 29 29 29 29 0a (exit 2)))))).
cb70: 09 3b 3b 20 43 4f 4e 44 20 65 6e 64 73 20 68 65 .;; COND ends he
cb80: 72 65 2e 0a 09 0a 09 3b 3b 20 61 64 64 69 74 69 re.....;; additi
cb90: 6f 6e 61 6c 20 68 6f 75 73 65 20 6b 65 65 70 69 onal house keepi
cba0: 6e 67 0a 09 28 6c 65 74 2a 20 28 28 6c 69 6e 6b ng..(let* ((link
cbb0: 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 tree (common:get
cbc0: 2d 6c 69 6e 6b 74 72 65 65 29 29 29 0a 09 20 20 -linktree)))..
cbd0: 28 69 66 20 6c 69 6e 6b 74 72 65 65 0a 09 20 20 (if linktree..
cbe0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 69 66 (begin...(if
cbf0: 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (not (common:fi
cc00: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 le-exists? linkt
cc10: 72 65 65 29 29 0a 09 09 20 20 20 20 28 62 65 67 ree))... (beg
cc20: 69 6e 0a 09 09 20 20 20 20 20 20 28 68 61 6e 64 in... (hand
cc30: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
cc40: 09 20 20 65 78 6e 0a 09 09 09 20 20 28 62 65 67 . exn.... (beg
cc50: 69 6e 0a 09 09 09 20 20 20 20 28 64 65 62 75 67 in.... (debug
cc60: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
cc70: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
cc80: 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 65 6e * "Something wen
cc90: 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 72 79 t wrong when try
cca0: 69 6e 67 20 74 6f 20 63 72 65 61 74 65 20 6c 69 ing to create li
ccb0: 6e 6b 74 72 65 65 20 64 69 72 20 61 74 20 22 20 nktree dir at "
ccc0: 6c 69 6e 6b 74 72 65 65 29 0a 09 09 09 20 20 20 linktree)....
ccd0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
cce0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
ccf0: 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 t* " message: "
cd00: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
cd10: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
cd20: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
cd30: 29 29 0a 09 09 09 20 20 20 20 28 65 78 69 74 20 )).... (exit
cd40: 31 29 29 0a 09 09 09 28 63 72 65 61 74 65 2d 64 1))....(create-d
cd50: 69 72 65 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 irectory linktre
cd60: 65 20 23 74 29 29 29 29 0a 09 09 28 68 61 6e 64 e #t))))...(hand
cd70: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
cd80: 20 20 20 20 65 78 6e 0a 09 09 20 20 20 20 28 62 exn... (b
cd90: 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 egin... (de
cda0: 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 bug:print-error
cdb0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
cdc0: 6f 72 74 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 ort* "Something
cdd0: 77 65 6e 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 went wrong when
cde0: 74 72 79 69 6e 67 20 74 6f 20 63 72 65 61 74 65 trying to create
cdf0: 20 6c 69 6e 6b 20 74 6f 20 6c 69 6e 6b 74 72 65 link to linktre
ce00: 65 20 61 74 20 22 20 2a 74 6f 70 70 61 74 68 2a e at " *toppath*
ce10: 29 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 )... (debug
ce20: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
ce30: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 t-log-port* " me
ce40: 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 ssage: " ((condi
ce50: 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
ce60: 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
ce70: 73 61 67 65 29 20 65 78 6e 29 29 29 0a 09 09 20 sage) exn)))...
ce80: 20 28 6c 65 74 20 28 28 74 6c 69 6e 6b 20 28 63 (let ((tlink (c
ce90: 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f onc *toppath* "/
cea0: 6c 74 22 29 29 29 0a 09 09 20 20 20 20 28 69 66 lt")))... (if
ceb0: 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (not (common:fi
cec0: 6c 65 2d 65 78 69 73 74 73 3f 20 74 6c 69 6e 6b le-exists? tlink
ced0: 29 29 0a 09 09 09 28 63 72 65 61 74 65 2d 73 79 ))....(create-sy
cee0: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 6c 69 6e 6b mbolic-link link
cef0: 74 72 65 65 20 74 6c 69 6e 6b 29 29 29 29 29 0a tree tlink))))).
cf00: 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 . (begin...
cf10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
cf20: 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
cf30: 67 2d 70 6f 72 74 2a 20 22 6c 69 6e 6b 74 72 65 g-port* "linktre
cf40: 65 20 6e 6f 74 20 64 65 66 69 6e 65 64 20 69 6e e not defined in
cf50: 20 5b 73 65 74 75 70 5d 20 73 65 63 74 69 6f 6e [setup] section
cf60: 20 6f 66 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e of megatest.con
cf70: 66 69 67 22 29 0a 09 09 29 29 29 0a 09 28 69 66 fig")...)))..(if
cf80: 20 28 61 6e 64 20 2a 74 6f 70 70 61 74 68 2a 0a (and *toppath*.
cf90: 09 09 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 .. (directory-ex
cfa0: 69 73 74 73 3f 20 2a 74 6f 70 70 61 74 68 2a 29 ists? *toppath*)
cfb0: 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 ).. (begin..
cfc0: 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 (setenv "MT
cfd0: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 _RUN_AREA_HOME"
cfe0: 2a 74 6f 70 70 61 74 68 2a 29 0a 09 20 20 20 20 *toppath*)..
cff0: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 (setenv "MT_TE
d000: 53 54 53 55 49 54 45 4e 41 4d 45 22 20 28 63 6f STSUITENAME" (co
d010: 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 mmon:get-testsui
d020: 74 65 2d 6e 61 6d 65 29 29 29 0a 09 20 20 20 20 te-name)))..
d030: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 (begin.. (d
d040: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
d050: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
d060: 70 6f 72 74 2a 20 22 66 61 69 6c 65 64 20 74 6f port* "failed to
d070: 20 66 69 6e 64 20 74 68 65 20 74 6f 70 20 70 61 find the top pa
d080: 74 68 20 74 6f 20 79 6f 75 72 20 4d 65 67 61 74 th to your Megat
d090: 65 73 74 20 61 72 65 61 2e 22 29 0a 09 20 20 20 est area.")..
d0a0: 20 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 (set! *toppat
d0b0: 68 2a 20 23 66 29 20 3b 3b 20 66 6f 72 63 65 20 h* #f) ;; force
d0c0: 69 74 20 74 6f 20 62 65 20 66 61 6c 73 65 20 73 it to be false s
d0d0: 6f 20 77 65 20 72 65 74 75 72 6e 20 23 66 0a 09 o we return #f..
d0e0: 20 20 20 20 20 20 23 66 29 29 0a 09 0a 20 20 20 #f))...
d0f0: 20 20 20 20 20 3b 3b 20 6f 6e 65 20 6d 6f 72 65 ;; one more
d100: 20 61 74 74 65 6d 70 74 20 74 6f 20 63 61 63 68 attempt to cach
d110: 65 20 74 68 65 20 63 6f 6e 66 69 67 73 20 66 6f e the configs fo
d120: 72 20 66 75 74 75 72 65 20 72 65 61 64 69 6e 67 r future reading
d130: 0a 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 . (let* (
d140: 28 63 61 63 68 65 66 69 6c 65 73 20 20 20 28 6c (cachefiles (l
d150: 61 75 6e 63 68 3a 67 65 74 2d 63 61 63 68 65 2d aunch:get-cache-
d160: 66 69 6c 65 2d 70 61 74 68 73 20 61 72 65 61 70 file-paths areap
d170: 61 74 68 20 74 6f 70 70 61 74 68 20 74 61 72 67 ath toppath targ
d180: 65 74 20 6d 74 63 6f 6e 66 69 67 29 29 0a 20 20 et mtconfig)).
d190: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 74 (mt
d1a0: 63 61 63 68 65 66 20 20 20 20 20 28 63 61 72 20 cachef (car
d1b0: 63 61 63 68 65 66 69 6c 65 73 29 29 0a 20 20 20 cachefiles)).
d1c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 63 63 (rcc
d1d0: 61 63 68 65 66 20 20 20 20 20 28 63 64 72 20 63 achef (cdr c
d1e0: 61 63 68 65 66 69 6c 65 73 29 29 29 0a 0a 20 20 achefiles)))..
d1f0: 20 20 20 20 20 20 20 20 3b 3b 20 74 72 61 70 20 ;; trap
d200: 65 78 63 65 70 74 69 6f 6e 20 64 75 65 20 74 6f exception due to
d210: 20 73 74 61 6c 65 20 4e 46 53 20 68 61 6e 64 6c stale NFS handl
d220: 65 20 2d 2d 20 45 72 72 6f 72 3a 20 28 6f 70 65 e -- Error: (ope
d230: 6e 2d 6f 75 74 70 75 74 2d 66 69 6c 65 29 20 63 n-output-file) c
d240: 61 6e 6e 6f 74 20 6f 70 65 6e 20 66 69 6c 65 20 annot open file
d250: 2d 20 53 74 61 6c 65 20 4e 46 53 20 66 69 6c 65 - Stale NFS file
d260: 20 68 61 6e 64 6c 65 3a 20 22 2f 70 2f 66 64 6b handle: "/p/fdk
d270: 2f 67 77 61 2f 6c 65 66 6b 6f 77 69 74 2f 6d 74 /gwa/lefkowit/mt
d280: 54 65 73 74 69 6e 67 2f 71 61 2f 70 72 69 6d 62 Testing/qa/primb
d290: 65 71 61 2f 6c 69 6e 6b 73 2f 70 31 32 32 32 2f eqa/links/p1222/
d2a0: 31 31 2f 50 44 4b 5f 72 31 2e 31 2e 31 2f 70 72 11/PDK_r1.1.1/pr
d2b0: 69 6d 2f 63 6c 65 61 6e 2f 70 63 65 6c 6c 5f 74 im/clean/pcell_t
d2c0: 65 73 74 67 65 6e 2f 2e 72 75 6e 63 6f 6e 66 69 estgen/.runconfi
d2d0: 67 73 2e 63 66 67 2d 31 2e 36 34 32 37 2d 37 64 gs.cfg-1.6427-7d
d2e0: 31 65 37 38 39 63 62 33 66 36 32 66 39 63 64 65 1e789cb3f62f9cde
d2f0: 37 31 39 61 34 38 36 35 62 62 35 31 62 33 63 31 719a4865bb51b3c1
d300: 37 65 61 38 35 33 22 20 2d 20 74 69 63 6b 65 74 7ea853" - ticket
d310: 20 32 32 30 35 34 36 33 34 32 0a 20 20 20 20 20 220546342.
d320: 20 20 20 20 20 3b 3b 20 54 4f 44 4f 20 2d 20 63 ;; TODO - c
d330: 6f 6e 73 69 64 65 72 20 31 29 20 75 73 69 6e 67 onsider 1) using
d340: 20 73 69 6d 70 6c 65 2d 6c 6f 63 6b 20 74 6f 20 simple-lock to
d350: 62 72 61 63 6b 65 74 20 63 61 63 68 65 20 77 72 bracket cache wr
d360: 69 74 65 0a 20 20 20 20 20 20 20 20 20 20 3b 3b ite. ;;
d370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d380: 20 32 29 20 63 61 63 68 65 20 69 6e 20 68 61 73 2) cache in has
d390: 68 20 6f 6e 20 73 65 72 76 65 72 2c 20 73 69 6e h on server, sin
d3a0: 63 65 20 6e 65 65 64 20 74 6f 20 64 6f 20 72 6d ce need to do rm
d3b0: 74 3a 20 61 6e 79 77 61 79 20 74 6f 20 6c 6f 63 t: anyway to loc
d3c0: 6b 2e 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 k.. (if
d3d0: 20 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 2a (and rccachef *
d3e0: 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 28 6e runconfigdat* (n
d3f0: 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d ot (common:file-
d400: 65 78 69 73 74 73 3f 20 72 63 63 61 63 68 65 66 exists? rccachef
d410: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
d420: 20 20 28 63 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 (common:fail-s
d430: 61 66 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 afe.
d440: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
d450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
d460: 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c configf:write-al
d470: 69 73 74 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 ist *runconfigda
d480: 74 2a 20 72 63 63 61 63 68 65 66 29 29 0a 20 20 t* rccachef)).
d490: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
d4a0: 6e 63 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 72 nc "Could not wr
d4b0: 69 74 65 20 63 61 63 68 65 20 66 69 6c 65 20 2d ite cache file -
d4c0: 20 22 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 "rccachef)).
d4d0: 20 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 ).
d4e0: 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
d4f0: 6d 74 63 61 63 68 65 66 20 2a 63 6f 6e 66 69 67 mtcachef *config
d500: 64 61 74 2a 20 20 20 20 28 6e 6f 74 20 28 63 6f dat* (not (co
d510: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
d520: 3f 20 6d 74 63 61 63 68 65 66 29 29 29 0a 20 20 ? mtcachef))).
d530: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d (com
d540: 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 mon:fail-safe.
d550: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
d560: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda ().
d570: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
d580: 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 2a 63 f:write-alist *c
d590: 6f 6e 66 69 67 64 61 74 2a 20 6d 74 63 61 63 68 onfigdat* mtcach
d5a0: 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ef)).
d5b0: 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 (conc "Could
d5c0: 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 not write cache
d5d0: 20 66 69 6c 65 20 2d 20 22 6d 74 63 61 63 68 65 file - "mtcache
d5e0: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)).
d5f0: 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 ). (i
d600: 66 20 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 f (and rccachef
d610: 6d 74 63 61 63 68 65 66 20 2a 72 75 6e 63 6f 6e mtcachef *runcon
d620: 66 69 67 64 61 74 2a 20 2a 63 6f 6e 66 69 67 64 figdat* *configd
d630: 61 74 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 at*).
d640: 20 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 (set! *config
d650: 73 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 status* 'fulldat
d660: 61 29 29 29 0a 0a 09 3b 3b 20 69 66 20 68 61 76 a)))...;; if hav
d670: 65 20 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 e -append-config
d680: 20 74 68 65 6e 20 72 65 61 64 20 61 6e 64 20 61 then read and a
d690: 70 70 65 6e 64 20 68 65 72 65 0a 09 28 6c 65 74 ppend here..(let
d6a0: 20 28 28 63 66 6e 61 6d 65 20 28 61 72 67 73 3a ((cfname (args:
d6b0: 67 65 74 2d 61 72 67 20 22 2d 61 70 70 65 6e 64 get-arg "-append
d6c0: 2d 63 6f 6e 66 69 67 22 29 29 29 0a 09 20 20 28 -config"))).. (
d6d0: 69 66 20 28 61 6e 64 20 63 66 6e 61 6d 65 0a 09 if (and cfname..
d6e0: 09 20 20 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 . (file-read-a
d6f0: 63 63 65 73 73 3f 20 63 66 6e 61 6d 65 29 29 0a ccess? cfname)).
d700: 09 20 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e . (read-con
d710: 66 69 67 20 63 66 6e 61 6d 65 20 2a 63 6f 6e 66 fig cfname *conf
d720: 69 67 64 61 74 2a 20 23 74 29 29 29 20 3b 3b 20 igdat* #t))) ;;
d730: 76 61 6c 75 65 73 20 61 72 65 20 61 64 64 65 64 values are added
d740: 20 74 6f 20 74 68 65 20 68 61 73 68 2c 20 6e 6f to the hash, no
d750: 20 6e 65 65 64 20 74 6f 20 64 6f 20 61 6e 79 74 need to do anyt
d760: 68 69 6e 67 20 73 70 65 63 69 61 6c 2e 0a 09 2a hing special...*
d770: 74 6f 70 70 61 74 68 2a 29 29 29 0a 0a 28 64 65 toppath*)))..(de
d780: 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d 64 fine (get-best-d
d790: 69 73 6b 20 63 6f 6e 66 64 61 74 20 74 65 73 74 isk confdat test
d7a0: 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 config). (let*
d7b0: 28 28 64 69 73 6b 73 20 20 20 28 6f 72 20 28 61 ((disks (or (a
d7c0: 6e 64 20 74 65 73 74 63 6f 6e 66 69 67 20 28 68 nd testconfig (h
d7d0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
d7e0: 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 fault testconfig
d7f0: 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 09 "disks" #f))...
d800: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
d810: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f e-ref/default co
d820: 6e 66 64 61 74 20 22 64 69 73 6b 73 22 20 23 66 nfdat "disks" #f
d830: 29 29 29 0a 09 20 28 6d 69 6e 73 70 61 63 65 20 ))).. (minspace
d840: 28 6c 65 74 20 28 28 6d 20 28 63 6f 6e 66 69 67 (let ((m (config
d850: 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 64 61 74 f:lookup confdat
d860: 20 22 73 65 74 75 70 22 20 22 6d 69 6e 73 70 61 "setup" "minspa
d870: 63 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 73 ce")))... (s
d880: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f tring->number (o
d890: 72 20 6d 20 22 31 30 30 30 30 22 29 29 29 29 29 r m "10000")))))
d8a0: 0a 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a . (if disks .
d8b0: 09 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f 6d .(let ((res (com
d8c0: 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 2d 77 69 74 mon:get-disk-wit
d8d0: 68 2d 6d 6f 73 74 2d 66 72 65 65 2d 73 70 61 63 h-most-free-spac
d8e0: 65 20 64 69 73 6b 73 20 6d 69 6e 73 70 61 63 65 e disks minspace
d8f0: 29 29 29 20 3b 3b 20 6d 69 6e 20 73 69 7a 65 20 ))) ;; min size
d900: 6f 66 20 31 30 30 30 2c 20 73 65 65 6d 73 20 74 of 1000, seems t
d910: 61 64 20 64 75 6d 62 0a 09 20 20 28 69 66 20 72 ad dumb.. (if r
d920: 65 73 0a 09 20 20 20 20 20 20 28 63 64 72 20 72 es.. (cdr r
d930: 65 73 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 es).. (begi
d940: 6e 0a 09 09 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a n...(if (common:
d950: 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 20 low-noise-print
d960: 32 30 20 22 4e 6f 20 76 61 6c 69 64 20 64 69 73 20 "No valid dis
d970: 6b 73 20 6f 72 20 6e 6f 20 64 69 73 6b 20 77 69 ks or no disk wi
d980: 74 68 20 65 6e 6f 75 67 68 20 73 70 61 63 65 22 th enough space"
d990: 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 )... (debug:p
d9a0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
d9b0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
d9c0: 22 4e 6f 20 76 61 6c 69 64 20 64 69 73 6b 73 20 "No valid disks
d9d0: 66 6f 75 6e 64 20 69 6e 20 6d 65 67 61 74 65 73 found in megates
d9e0: 74 2e 63 6f 6e 66 69 67 2e 20 50 6c 65 61 73 65 t.config. Please
d9f0: 20 61 64 64 20 73 6f 6d 65 20 74 6f 20 79 6f 75 add some to you
da00: 72 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 69 6f r [disks] sectio
da10: 6e 20 61 6e 64 20 65 6e 73 75 72 65 20 74 68 65 n and ensure the
da20: 20 64 69 72 65 63 74 6f 72 79 20 65 78 69 73 74 directory exist
da30: 73 20 61 6e 64 20 68 61 73 20 65 6e 6f 75 67 68 s and has enough
da40: 20 73 70 61 63 65 21 5c 6e 20 20 20 20 59 6f 75 space!\n You
da50: 20 63 61 6e 20 63 68 61 6e 67 65 20 6d 69 6e 73 can change mins
da60: 70 61 63 65 20 69 6e 20 74 68 65 20 5b 73 65 74 pace in the [set
da70: 75 70 5d 20 73 65 63 74 69 6f 6e 20 6f 66 20 6d up] section of m
da80: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 egatest.config.
da90: 43 75 72 72 65 6e 74 20 73 65 74 74 69 6e 67 20 Current setting
daa0: 69 73 3a 20 22 20 6d 69 6e 73 70 61 63 65 29 29 is: " minspace))
dab0: 0a 09 09 28 65 78 69 74 20 31 29 29 29 29 29 29 ...(exit 1))))))
dac0: 29 20 3b 3b 20 54 4f 44 4f 20 2d 20 6d 6f 76 65 ) ;; TODO - move
dad0: 20 74 68 65 20 65 78 69 74 20 74 6f 20 74 68 65 the exit to the
dae0: 20 63 61 6c 6c 69 6e 67 20 6c 6f 63 61 74 69 6f calling locatio
daf0: 6e 20 61 6e 64 20 72 65 74 75 72 6e 20 23 66 0a n and return #f.
db00: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
db10: 3a 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 2d :test-copy test-
db20: 73 72 63 2d 70 61 74 68 20 74 65 73 74 2d 70 61 src-path test-pa
db30: 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f 76 th). (let* ((ov
db40: 72 63 6d 64 20 28 6c 65 74 20 28 28 63 6d 64 20 rcmd (let ((cmd
db50: 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a (config-lookup *
db60: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
db70: 70 22 20 22 74 65 73 74 63 6f 70 79 63 6d 64 22 p" "testcopycmd"
db80: 29 29 29 0a 09 09 20 20 20 28 69 66 20 63 6d 64 )))... (if cmd
db90: 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 73 75 62 ... ;; sub
dba0: 73 74 69 74 75 74 65 20 74 68 65 20 54 45 53 54 stitute the TEST
dbb0: 5f 53 52 43 5f 50 41 54 48 20 61 6e 64 20 54 45 _SRC_PATH and TE
dbc0: 53 54 5f 54 41 52 47 5f 50 41 54 48 0a 09 09 20 ST_TARG_PATH...
dbd0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 75 (string-su
dbe0: 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f 54 bstitute "TEST_T
dbf0: 41 52 47 5f 50 41 54 48 22 20 74 65 73 74 2d 70 ARG_PATH" test-p
dc00: 61 74 68 0a 09 09 09 09 09 20 20 28 73 74 72 69 ath...... (stri
dc10: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 54 ng-substitute "T
dc20: 45 53 54 5f 53 52 43 5f 50 41 54 48 22 20 74 65 EST_SRC_PATH" te
dc30: 73 74 2d 73 72 63 2d 70 61 74 68 20 63 6d 64 20 st-src-path cmd
dc40: 23 74 29 20 23 74 29 0a 09 09 20 20 20 20 20 20 #t) #t)...
dc50: 20 23 66 29 29 29 0a 09 20 28 63 6d 64 20 20 20 #f))).. (cmd
dc60: 20 28 69 66 20 6f 76 72 63 6d 64 20 0a 09 09 20 (if ovrcmd ...
dc70: 20 20 20 20 6f 76 72 63 6d 64 0a 09 09 20 20 20 ovrcmd...
dc80: 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 20 2d (conc "rsync -
dc90: 61 76 22 20 28 69 66 20 28 64 65 62 75 67 3a 64 av" (if (debug:d
dca0: 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 22 22 20 ebug-mode 1) ""
dcb0: 22 71 22 29 20 22 20 22 20 74 65 73 74 2d 73 72 "q") " " test-sr
dcc0: 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 73 74 c-path "/ " test
dcd0: 2d 70 61 74 68 20 22 2f 22 0a 09 09 09 20 20 20 -path "/"....
dce0: 22 20 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 68 " >> " test-path
dcf0: 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 "/mt_launch.log
dd00: 20 32 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 68 2>> " test-path
dd10: 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 "/mt_launch.log
dd20: 22 29 29 29 0a 09 20 28 73 74 61 74 75 73 20 28 "))).. (status (
dd30: 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a 20 20 system cmd))).
dd40: 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 (if (not (eq?
dd50: 73 74 61 74 75 73 20 30 29 29 0a 09 28 64 65 62 status 0))..(deb
dd60: 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
dd70: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
dd80: 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 69 RROR: problem wi
dd90: 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 63 th running \"" c
dda0: 6d 64 20 22 5c 22 22 29 29 29 29 0a 0a 0a 3b 3b md "\""))))...;;
ddb0: 20 44 65 73 69 72 65 64 20 64 69 72 65 63 74 6f Desired directo
ddc0: 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b 3b ry structure:.;;
ddd0: 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d .;; <linkdir> -
dde0: 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 <target> - <tes
ddf0: 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 20 tname> -..;;
de00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de20: 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 |.;;
de30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de40: 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 20 v.;;
de50: 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 61 <rundir> - <ta
de60: 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 73 rget> - <tes
de70: 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 6d tname> -|- <item
de80: 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 20 path(s)>.;;.;;
de90: 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 65 dir stored in te
dea0: 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 3c st is:.;; .;; <
deb0: 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 linkdir> - <targ
dec0: 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e et> - <testname>
ded0: 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 [ - <itempath>
dee0: 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f 67 ].;; .;; All log
def0: 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f 75 file links shou
df00: 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 6c ld be stored rel
df10: 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f 70 ative to the top
df20: 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b 3b of link path.;;
df30: 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 2d .;; <target> -
df40: 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 <testname> [ -
df50: 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b 3b <itempath> ] .;;
df60: 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 65 .(define (create
df70: 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 2d 69 -work-area run-i
df80: 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 d run-info keyva
df90: 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d ls test-id test-
dfa0: 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d 70 61 src-path disk-pa
dfb0: 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d th testname item
dfc0: 64 61 74 20 23 21 6b 65 79 20 28 72 65 6d 74 72 dat #!key (remtr
dfd0: 69 65 73 20 32 29 29 0a 20 20 28 6c 65 74 2a 20 ies 2)). (let*
dfe0: 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 66 20 ((item-path (if
dff0: 28 73 74 72 69 6e 67 3f 20 69 74 65 6d 64 61 74 (string? itemdat
e000: 29 20 69 74 65 6d 64 61 74 20 28 69 74 65 6d 2d ) itemdat (item-
e010: 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 list->path itemd
e020: 61 74 29 29 29 20 3b 3b 20 69 66 20 70 61 73 73 at))) ;; if pass
e030: 20 69 6e 20 73 74 72 69 6e 67 20 2d 20 6a 75 73 in string - jus
e040: 74 20 75 73 65 20 69 74 0a 09 20 28 72 75 6e 6e t use it.. (runn
e050: 61 6d 65 20 20 20 28 69 66 20 28 73 74 72 69 6e ame (if (strin
e060: 67 3f 20 72 75 6e 2d 69 6e 66 6f 29 20 3b 3b 20 g? run-info) ;;
e070: 69 66 20 77 65 20 70 61 73 73 20 69 6e 20 61 20 if we pass in a
e080: 73 74 72 69 6e 67 20 61 73 20 72 75 6e 2d 69 6e string as run-in
e090: 66 6f 20 75 73 65 20 69 74 20 61 73 20 72 75 6e fo use it as run
e0a0: 2d 6e 61 6d 65 2e 0a 09 09 09 72 75 6e 2d 69 6e -name.....run-in
e0b0: 66 6f 0a 09 09 09 28 64 62 3a 67 65 74 2d 76 61 fo....(db:get-va
e0c0: 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 64 lue-by-header (d
e0d0: 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 2d 69 b:get-rows run-i
e0e0: 6e 66 6f 29 0a 09 09 09 09 09 09 28 64 62 3a 67 nfo).......(db:g
e0f0: 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 6e et-header run-in
e100: 66 6f 29 0a 09 09 09 09 09 09 22 72 75 6e 6e 61 fo)......."runna
e110: 6d 65 22 29 29 29 0a 09 20 28 63 6f 6e 74 6f 75 me"))).. (contou
e120: 72 20 20 20 23 66 29 20 3b 3b 20 4e 4f 54 20 52 r #f) ;; NOT R
e130: 45 41 44 59 20 46 4f 52 20 54 48 49 53 20 28 61 EADY FOR THIS (a
e140: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
e150: 6e 74 6f 75 72 22 29 29 0a 09 20 3b 3b 20 63 6f ntour")).. ;; co
e160: 6e 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 62 nvert back to db
e170: 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 68 : from rdb: - th
e180: 69 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 6e is is always run
e190: 20 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a 09 at server end..
e1a0: 20 28 74 61 72 67 65 74 20 20 20 28 73 74 72 69 (target (stri
e1b0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
e1c0: 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 map cadr keyvals
e1d0: 29 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 2d ) "/"))... (not-
e1e0: 69 74 65 72 61 74 65 64 20 20 28 65 71 75 61 6c iterated (equal
e1f0: 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 29 29 ? "" item-path))
e200: 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 74 73 ... ;; all tests
e210: 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 3c 72 are found at <r
e220: 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 65 undir>/test-base
e230: 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 65 or <linkdir>/te
e240: 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 74 74 st-base.. (testt
e250: 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 74 61 op-base (conc ta
e260: 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 rget "/" runname
e270: 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a "/" testname)).
e280: 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 20 20 . (test-base
e290: 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d 62 61 (conc testtop-ba
e2a0: 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 se (if not-itera
e2b0: 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d ted "" "/") item
e2c0: 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 6e 62 -path))... ;; nb
e2d0: 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 20 69 // if itempath i
e2e0: 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 69 74 s not "" then it
e2f0: 20 69 73 20 70 72 65 66 69 78 65 64 20 77 69 74 is prefixed wit
e300: 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 73 74 h "/".. (toptest
e310: 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 73 6b -path (conc disk
e320: 2d 70 61 74 68 20 28 69 66 20 63 6f 6e 74 6f 75 -path (if contou
e330: 72 20 28 63 6f 6e 63 20 22 2f 22 20 63 6f 6e 74 r (conc "/" cont
e340: 6f 75 72 29 20 22 22 29 20 22 2f 22 20 74 65 73 our) "") "/" tes
e350: 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 74 ttop-base)).. (t
e360: 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e est-path (con
e370: 63 20 64 69 73 6b 2d 70 61 74 68 20 28 69 66 20 c disk-path (if
e380: 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 20 22 2f contour (conc "/
e390: 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 29 20 22 " contour) "") "
e3a0: 2f 22 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a /" test-base))..
e3b0: 09 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 . ;; ensure this
e3c0: 20 65 78 69 73 74 73 20 66 69 72 73 74 20 61 73 exists first as
e3d0: 20 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 links to subtes
e3e0: 74 73 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 ts must be creat
e3f0: 65 64 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b ed there.. (link
e400: 74 72 65 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 tree (common:ge
e410: 74 2d 6c 69 6e 6b 74 72 65 65 29 29 0a 09 20 3b t-linktree)).. ;
e420: 3b 20 57 41 53 3a 20 28 6c 65 74 20 28 28 72 64 ; WAS: (let ((rd
e430: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
e440: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
e450: 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 up" "linktree"))
e460: 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 28 ).. ;; (
e470: 69 66 20 72 64 20 72 64 20 28 63 6f 6e 63 20 2a if rd rd (conc *
e480: 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 22 toppath* "/runs"
e490: 29 29 29 29 0a 09 20 3b 3b 20 77 68 69 63 68 20 )))).. ;; which
e4a0: 73 65 65 6d 73 20 77 72 6f 6e 67 20 2e 2e 2e 0a seems wrong ....
e4b0: 0a 09 20 28 6c 6e 6b 62 61 73 65 20 20 20 28 63 .. (lnkbase (c
e4c0: 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 28 69 66 onc linktree (if
e4d0: 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 20 22 contour (conc "
e4e0: 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 29 20 /" contour) "")
e4f0: 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 "/" target "/" r
e500: 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 unname)).. (lnkp
e510: 61 74 68 20 20 20 28 63 6f 6e 63 20 6c 6e 6b 62 ath (conc lnkb
e520: 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ase "/" testname
e530: 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 20 20 )).. (lnkpathf
e540: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 28 69 (conc lnkpath (i
e550: 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 22 f not-iterated "
e560: 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 74 68 " "/") item-path
e570: 29 29 0a 09 20 28 6c 6e 6b 74 61 72 67 65 74 20 )).. (lnktarget
e580: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
e590: 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 0a " item-path)))..
e5a0: 20 20 20 20 3b 3b 20 55 70 64 61 74 65 20 74 68 ;; Update th
e5b0: 65 20 72 75 6e 64 69 72 20 70 61 74 68 20 69 6e e rundir path in
e5c0: 20 74 68 65 20 74 65 73 74 20 72 65 63 6f 72 64 the test record
e5d0: 20 66 6f 72 20 61 6c 6c 2c 20 72 75 6e 64 69 72 for all, rundir
e5e0: 3d 70 68 79 73 69 63 61 6c 2c 20 73 68 6f 72 74 =physical, short
e5f0: 64 69 72 3d 6c 6f 67 69 63 61 6c 0a 20 20 20 20 dir=logical.
e600: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
e610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e630: 20 20 20 72 75 6e 64 69 72 20 20 20 73 68 6f 72 rundir shor
e640: 74 64 69 72 0a 20 20 20 20 28 72 6d 74 3a 67 65 tdir. (rmt:ge
e650: 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 65 73 74 neral-call 'test
e660: 2d 73 65 74 2d 72 75 6e 64 69 72 2d 73 68 6f 72 -set-rundir-shor
e670: 74 64 69 72 20 72 75 6e 2d 69 64 20 6c 6e 6b 70 tdir run-id lnkp
e680: 61 74 68 66 20 74 65 73 74 2d 70 61 74 68 20 74 athf test-path t
e690: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
e6a0: 68 20 72 75 6e 2d 69 64 29 0a 0a 20 20 20 20 28 h run-id).. (
e6b0: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
e6c0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
e6d0: 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 20 20 20 "INFO:\n
e6e0: 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b 62 61 73 lnkbase=" lnkbas
e6f0: 65 20 22 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 70 e "\n lnkp
e700: 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 20 22 5c ath=" lnkpath "\
e710: 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 74 68 3d n toptest-path=
e720: 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 22 " toptest-path "
e730: 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 61 74 68 \n test-path
e740: 3d 22 20 74 65 73 74 2d 70 61 74 68 29 0a 20 20 =" test-path).
e750: 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d (if (not (comm
e760: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
e770: 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 65 67 linktree))..(beg
e780: 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 in.. (debug:pri
e790: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
e7a0: 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 g-port* "WARNING
e7b0: 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 6e : linktree did n
e7c0: 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 74 69 ot exist! Creati
e7d0: 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 20 6c ng it now at " l
e7e0: 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 72 65 inktree).. (cre
e7f0: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 ate-directory li
e800: 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b 3b 20 nktree #t))) ;;
e810: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d (system (conc "m
e820: 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 kdir -p " linktr
e830: 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 ee)))). ;; cr
e840: 65 61 74 65 20 74 68 65 20 64 69 72 65 63 74 6f eate the directo
e850: 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 74 73 ry for the tests
e860: 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 dir links, this
e870: 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 is needed no ma
e880: 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 tter what....
e890: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
e8a0: 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 6f 72 79 common:directory
e8b0: 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 65 -exists? lnkbase
e8c0: 29 29 0a 09 20 20 20 20 20 28 6e 6f 74 20 28 63 )).. (not (c
e8d0: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
e8e0: 73 3f 20 6c 6e 6b 62 61 73 65 29 29 29 0a 09 28 s? lnkbase)))..(
e8f0: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
e900: 73 0a 09 20 65 78 6e 0a 09 20 28 62 65 67 69 6e s.. exn.. (begin
e910: 0a 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e .. (debug:prin
e920: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
e930: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 50 72 lt-log-port* "Pr
e940: 6f 62 6c 65 6d 20 63 72 65 61 74 69 6e 67 20 6c oblem creating l
e950: 69 6e 6b 74 72 65 65 20 62 61 73 65 20 61 74 20 inktree base at
e960: 22 20 6c 6e 6b 62 61 73 65 29 0a 09 20 20 20 28 " lnkbase).. (
e970: 70 72 69 6e 74 2d 65 72 72 6f 72 2d 6d 65 73 73 print-error-mess
e980: 61 67 65 20 65 78 6e 20 28 63 75 72 72 65 6e 74 age exn (current
e990: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 29 0a 09 -error-port)))..
e9a0: 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f (create-directo
e9b0: 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 29 ry lnkbase #t)))
e9c0: 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 . . ;; upd
e9d0: 61 74 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 ate the toptest
e9e0: 72 65 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 record with its
e9f0: 6c 6f 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c location rundir,
ea00: 20 63 61 63 68 65 20 74 68 65 20 70 61 74 68 0a cache the path.
ea10: 20 20 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 ;; This wass
ea20: 20 68 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 highly ineffici
ea30: 65 6e 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 ent, one db writ
ea40: 65 20 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 e for every subt
ea50: 65 73 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 est, potentially
ea60: 0a 20 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 . ;; thousand
ea70: 73 20 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 s of unnecessary
ea80: 20 75 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 updates, cache
ea90: 74 68 65 20 66 61 63 74 20 69 74 20 77 61 73 20 the fact it was
eaa0: 73 65 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 set and don't se
eab0: 74 20 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 t it . ;; aga
eac0: 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 6f 77 in. .. ;; Now
ead0: 20 63 72 65 61 74 65 20 74 68 65 20 6c 69 6e 6b create the link
eae0: 20 66 72 6f 6d 20 74 68 65 20 74 65 73 74 20 70 from the test p
eaf0: 61 74 68 20 74 6f 20 74 68 65 20 6c 69 6e 6b 20 ath to the link
eb00: 74 72 65 65 2c 20 68 6f 77 65 76 65 72 0a 20 20 tree, however.
eb10: 20 20 3b 3b 20 69 66 20 74 68 65 20 74 65 73 74 ;; if the test
eb20: 20 69 73 20 69 74 65 72 61 74 65 64 20 69 74 20 is iterated it
eb30: 69 73 20 6e 65 63 65 73 73 61 72 79 20 74 6f 20 is necessary to
eb40: 63 72 65 61 74 65 20 74 68 65 20 70 61 72 65 6e create the paren
eb50: 74 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 74 6f t path. ;; to
eb60: 20 74 68 65 20 69 74 65 72 61 74 69 6f 6e 2e 20 the iteration.
eb70: 75 73 65 20 70 61 74 68 6e 61 6d 65 2d 64 69 72 use pathname-dir
eb80: 65 63 74 6f 72 79 20 74 6f 20 74 72 69 6d 20 74 ectory to trim t
eb90: 68 65 20 70 61 74 68 20 62 79 20 6f 6e 65 0a 20 he path by one.
eba0: 20 20 20 3b 3b 20 6c 65 76 65 6c 0a 20 20 20 20 ;; level.
ebb0: 28 69 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 (if (not not-ite
ebc0: 72 61 74 65 64 29 20 3b 3b 20 69 2e 65 2e 20 69 rated) ;; i.e. i
ebd0: 74 65 72 61 74 65 64 0a 09 28 6c 65 74 20 28 28 terated..(let ((
ebe0: 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 iterated-parent
ebf0: 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 65 63 (pathname-direc
ec00: 74 6f 72 79 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 tory (conc lnkpa
ec10: 74 68 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 th "/" item-path
ec20: 29 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 )))).. (debug:p
ec30: 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 rint-info 2 *def
ec40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
ec50: 43 72 65 61 74 69 6e 67 20 69 74 65 72 61 74 65 Creating iterate
ec60: 64 20 70 61 72 65 6e 74 20 22 20 69 74 65 72 61 d parent " itera
ec70: 74 65 64 2d 70 61 72 65 6e 74 29 0a 09 20 20 28 ted-parent).. (
ec80: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
ec90: 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 20 28 62 s.. exn.. (b
eca0: 65 67 69 6e 0a 09 20 20 20 20 20 28 64 65 62 75 egin.. (debu
ecb0: 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 g:print-error 0
ecc0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
ecd0: 74 2a 20 22 20 46 61 69 6c 65 64 20 74 6f 20 63 t* " Failed to c
ece0: 72 65 61 74 65 20 64 69 72 65 63 74 6f 72 79 20 reate directory
ecf0: 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e " iterated-paren
ed00: 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 t ((condition-pr
ed10: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
ed20: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
ed30: 78 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 xn) ", exiting")
ed40: 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
ed50: 0a 09 20 20 20 28 63 72 65 61 74 65 2d 64 69 72 .. (create-dir
ed60: 65 63 74 6f 72 79 20 69 74 65 72 61 74 65 64 2d ectory iterated-
ed70: 70 61 72 65 6e 74 20 23 74 29 29 29 29 0a 0a 20 parent #t))))..
ed80: 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 (if (symbolic
ed90: 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 20 -link? lnkpath)
eda0: 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 ..(handle-except
edb0: 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 65 ions.. exn.. (be
edc0: 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 3a 70 gin.. (debug:p
edd0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
ede0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
edf0: 22 20 46 61 69 6c 65 64 20 74 6f 20 72 65 6d 6f " Failed to remo
ee00: 76 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e 6b ve symlink " lnk
ee10: 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e path ((condition
ee20: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
ee30: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
ee40: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
ee50: 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 29 g").. (exit 1)
ee60: 29 0a 09 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 ).. (delete-file
ee70: 20 6c 6e 6b 70 61 74 68 29 29 29 0a 0a 20 20 20 lnkpath)))..
ee80: 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 63 (if (not (or (c
ee90: 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
eea0: 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 s? lnkpath)... (
eeb0: 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
eec0: 6e 6b 70 61 74 68 29 29 29 0a 09 28 68 61 6e 64 nkpath)))..(hand
eed0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 le-exceptions..
eee0: 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 exn.. (begin..
eef0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
ef00: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
ef10: 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
ef20: 64 20 74 6f 20 63 72 65 61 74 65 20 73 79 6d 6c d to create syml
ef30: 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 ink " lnkpath ((
ef40: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
ef50: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
ef60: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 20 'message) exn)
ef70: 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 20 20 ", exiting")..
ef80: 20 28 65 78 69 74 20 31 29 29 0a 09 20 28 63 72 (exit 1)).. (cr
ef90: 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 eate-symbolic-li
efa0: 6e 6b 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 nk toptest-path
efb0: 6c 6e 6b 70 61 74 68 29 29 29 0a 20 20 20 20 0a lnkpath))). .
efc0: 20 20 20 20 3b 3b 20 4e 42 20 2d 20 54 68 69 73 ;; NB - This
efd0: 20 77 61 73 20 6e 6f 74 20 77 6f 72 6b 69 6e 67 was not working
efe0: 20 72 69 67 68 74 20 2d 20 73 6f 6d 65 20 74 6f right - some to
eff0: 70 20 74 65 73 74 73 20 61 72 65 20 6e 6f 74 20 p tests are not
f000: 67 65 74 74 69 6e 67 20 74 68 65 20 70 61 74 68 getting the path
f010: 20 73 65 74 21 21 21 0a 20 20 20 20 3b 3b 0a 20 set!!!. ;;.
f020: 20 20 20 3b 3b 20 44 6f 20 74 68 65 20 73 65 74 ;; Do the set
f030: 74 69 6e 67 20 6f 66 20 74 68 69 73 20 72 65 63 ting of this rec
f040: 6f 72 64 20 61 66 74 65 72 20 74 68 65 20 70 61 ord after the pa
f050: 74 68 73 20 61 72 65 20 63 72 65 61 74 65 64 20 ths are created
f060: 73 6f 20 74 68 61 74 20 74 68 65 20 73 68 6f 72 so that the shor
f070: 74 64 69 72 20 63 61 6e 20 0a 20 20 20 20 3b 3b tdir can . ;;
f080: 20 62 65 20 73 65 74 20 74 6f 20 74 68 65 20 72 be set to the r
f090: 65 61 6c 20 64 69 72 65 63 74 6f 72 79 20 6c 6f eal directory lo
f0a0: 63 61 74 69 6f 6e 2e 20 54 68 69 73 20 69 73 20 cation. This is
f0b0: 73 61 66 65 72 20 66 6f 72 20 66 75 74 75 72 65 safer for future
f0c0: 20 63 6c 65 61 6e 20 75 70 20 69 66 20 74 68 65 clean up if the
f0d0: 20 6c 69 6e 6b 0a 20 20 20 20 3b 3b 20 74 72 65 link. ;; tre
f0e0: 65 20 69 73 20 64 61 6d 61 67 65 64 20 6f 72 20 e is damaged or
f0f0: 6c 6f 73 74 2e 0a 20 20 20 20 3b 3b 20 0a 20 20 lost.. ;; .
f100: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash
f110: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
f120: 6c 74 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 lt *toptest-path
f130: 73 2a 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 s* testname #f))
f140: 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e ..(let* ((testin
f150: 66 6f 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 fo (rmt:ge
f160: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
f170: 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
f180: 29 29 20 3b 3b 20 20 72 75 6e 2d 69 64 20 74 65 )) ;; run-id te
f190: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 stname item-path
f1a0: 29 29 0a 09 20 20 20 20 20 20 20 28 63 75 72 72 )).. (curr
f1b0: 2d 74 65 73 74 2d 70 61 74 68 20 28 69 66 20 74 -test-path (if t
f1c0: 65 73 74 69 6e 66 6f 20 3b 3b 20 28 66 69 6c 65 estinfo ;; (file
f1d0: 64 62 3a 67 65 74 2d 70 61 74 68 20 2a 66 64 62 db:get-path *fdb
f1e0: 2a 0a 09 09 09 09 09 09 09 20 20 20 20 20 3b 3b *........ ;;
f1f0: 20 28 64 62 3a 67 65 74 2d 70 61 74 68 20 64 62 (db:get-path db
f200: 73 74 72 75 63 74 0a 09 09 09 09 20 20 20 3b 3b struct..... ;;
f210: 20 28 72 6d 74 3a 73 64 62 2d 71 72 79 20 27 67 (rmt:sdb-qry 'g
f220: 65 74 73 74 72 20 0a 09 09 09 09 20 20 20 28 64 etstr ..... (d
f230: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
f240: 72 20 74 65 73 74 69 6e 66 6f 29 20 3b 3b 20 29 r testinfo) ;; )
f250: 20 3b 3b 20 29 0a 09 09 09 09 20 20 20 23 66 29 ;; )..... #f)
f260: 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c )).. (hash-tabl
f270: 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d e-set! *toptest-
f280: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
f290: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a curr-test-path).
f2a0: 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 74 . ;; NB// Was t
f2b0: 68 69 73 20 66 6f 72 20 74 68 65 20 74 65 73 74 his for the test
f2c0: 20 6f 72 20 66 6f 72 20 74 68 65 20 70 61 72 65 or for the pare
f2d0: 6e 74 20 69 6e 20 61 6e 20 69 74 65 72 61 74 65 nt in an iterate
f2e0: 64 20 74 65 73 74 3f 0a 09 20 20 28 72 6d 74 3a d test?.. (rmt:
f2f0: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 65 general-call 'te
f300: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 73 68 st-set-rundir-sh
f310: 6f 72 74 64 69 72 20 72 75 6e 2d 69 64 20 6c 6e ortdir run-id ln
f320: 6b 70 61 74 68 20 0a 09 09 09 20 20 20 20 28 69 kpath .... (i
f330: 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 f (common:file-e
f340: 78 69 73 74 73 3f 20 6c 6e 6b 70 61 74 68 29 0a xists? lnkpath).
f350: 09 09 09 09 3b 3b 20 28 72 65 73 6f 6c 76 65 2d ....;; (resolve-
f360: 70 61 74 68 6e 61 6d 65 20 6c 6e 6b 70 61 74 68 pathname lnkpath
f370: 29 0a 09 09 09 09 28 63 6f 6d 6d 6f 6e 3a 6e 69 ).....(common:ni
f380: 63 65 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 ce-path lnkpath)
f390: 0a 09 09 09 09 6c 6e 6b 70 61 74 68 29 0a 09 09 .....lnkpath)...
f3a0: 09 20 20 20 20 74 65 73 74 6e 61 6d 65 20 22 22 . testname ""
f3b0: 20 72 75 6e 2d 69 64 29 0a 09 20 20 3b 3b 20 28 run-id).. ;; (
f3c0: 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c rmt:general-call
f3d0: 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 'test-set-rundi
f3e0: 72 20 72 75 6e 2d 69 64 20 6c 6e 6b 70 61 74 68 r run-id lnkpath
f3f0: 20 74 65 73 74 6e 61 6d 65 20 22 22 29 20 3b 3b testname "") ;;
f400: 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 0a 09 toptest-path)..
f410: 20 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 63 (if (or (not c
f420: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 urr-test-path)..
f430: 09 20 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f . (not (directo
f440: 72 79 2d 65 78 69 73 74 73 3f 20 74 6f 70 74 65 ry-exists? topte
f450: 73 74 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 st-path)))..
f460: 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 (begin...(debu
f470: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a g:print-info 2 *
f480: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
f490: 2a 20 22 43 72 65 61 74 69 6e 67 20 22 20 74 6f * "Creating " to
f4a0: 70 74 65 73 74 2d 70 61 74 68 20 22 20 61 6e 64 ptest-path " and
f4b0: 20 6c 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 29 link " lnkpath)
f4c0: 0a 09 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 ...(handle-excep
f4d0: 74 69 6f 6e 73 0a 09 09 20 65 78 6e 0a 09 09 20 tions... exn...
f4e0: 23 66 20 3b 3b 20 64 6f 6e 27 74 20 63 61 72 65 #f ;; don't care
f4f0: 20 74 6f 20 63 61 74 63 68 20 61 6e 64 20 64 65 to catch and de
f500: 61 6c 20 77 69 74 68 20 65 72 72 6f 72 73 20 68 al with errors h
f510: 65 72 65 20 66 6f 72 20 6e 6f 77 2e 0a 09 09 20 ere for now....
f520: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
f530: 79 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 23 y toptest-path #
f540: 74 29 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c t))...(hash-tabl
f550: 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d e-set! *toptest-
f560: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
f570: 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 29 toptest-path))))
f580: 29 0a 0a 20 20 20 20 3b 3b 20 54 68 65 20 74 6f ).. ;; The to
f590: 70 74 65 73 74 20 70 61 74 68 20 68 61 73 20 62 ptest path has b
f5a0: 65 65 6e 20 63 72 65 61 74 65 64 2c 20 74 68 65 een created, the
f5b0: 20 6c 69 6e 6b 20 74 6f 20 74 68 65 20 74 65 73 link to the tes
f5c0: 74 20 69 6e 20 74 68 65 20 6c 69 6e 6b 74 72 65 t in the linktre
f5d0: 65 20 68 61 73 0a 20 20 20 20 3b 3b 20 62 65 65 e has. ;; bee
f5e0: 6e 20 63 72 65 61 74 65 64 2e 20 4e 6f 77 2c 20 n created. Now,
f5f0: 69 66 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 if this is an it
f600: 65 72 61 74 65 64 20 74 65 73 74 20 74 68 65 20 erated test the
f610: 72 65 61 6c 20 74 65 73 74 20 64 69 72 20 6d 75 real test dir mu
f620: 73 74 20 62 65 20 63 72 65 61 74 65 64 0a 20 20 st be created.
f630: 20 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 (if (not not-i
f640: 74 65 72 61 74 65 64 29 20 3b 3b 20 74 68 69 73 terated) ;; this
f650: 20 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 is an iterated
f660: 74 65 73 74 0a 09 28 62 65 67 69 6e 20 3b 3b 20 test..(begin ;;
f670: 28 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 (let ((lnktarget
f680: 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 (conc lnkpath "
f690: 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a /" item-path))).
f6a0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
f6b0: 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
f6c0: 6f 72 74 2a 20 22 53 65 74 74 69 6e 67 20 75 70 ort* "Setting up
f6d0: 20 73 75 62 20 74 65 73 74 20 72 75 6e 20 61 72 sub test run ar
f6e0: 65 61 22 29 0a 09 20 20 28 64 65 62 75 67 3a 70 ea").. (debug:p
f6f0: 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d rint 2 *default-
f700: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 2d 20 63 72 log-port* " - cr
f710: 65 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 20 eating run area
f720: 69 6e 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a in " test-path).
f730: 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
f740: 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 tions.. exn..
f750: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 (begin.. (
f760: 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f debug:print-erro
f770: 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 r 0 *default-log
f780: 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 20 -port* " Failed
f790: 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 74 to create direct
f7a0: 6f 72 79 20 22 20 74 65 73 74 2d 70 61 74 68 20 ory " test-path
f7b0: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
f7c0: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
f7d0: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
f7e0: 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 0a 09 ) ", exiting")..
f7f0: 20 20 20 20 20 28 65 78 69 74 20 31 29 29 0a 09 (exit 1))..
f800: 20 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 (create-direc
f810: 74 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 tory test-path #
f820: 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 t)).. (debug:pr
f830: 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
f840: 6f 67 2d 70 6f 72 74 2a 20 0a 09 09 20 20 20 20 og-port* ...
f850: 20 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 " - creating
f860: 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 link from: " tes
f870: 74 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 t-path "\n"...
f880: 20 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 "
f890: 20 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c to: " l
f8a0: 6e 6b 74 61 72 67 65 74 29 0a 0a 09 20 20 3b 3b nktarget)... ;;
f8b0: 20 49 66 20 74 68 65 72 65 20 69 73 20 61 6c 72 If there is alr
f8c0: 65 61 64 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 eady a symlink d
f8d0: 65 6c 65 74 65 20 69 74 20 61 6e 64 20 72 65 63 elete it and rec
f8e0: 72 65 61 74 65 20 69 74 2e 0a 09 20 20 28 68 61 reate it... (ha
f8f0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
f900: 09 20 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 . exn.. (beg
f910: 69 6e 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a in.. (debug:
f920: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
f930: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
f940: 20 22 20 46 61 69 6c 65 64 20 74 6f 20 72 65 2d " Failed to re-
f950: 63 72 65 61 74 65 20 6c 69 6e 6b 20 22 20 6c 6e create link " ln
f960: 6b 74 61 72 67 65 74 20 28 28 63 6f 6e 64 69 74 ktarget ((condit
f970: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
f980: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
f990: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 age) exn) ", exi
f9a0: 74 69 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 ting").. (ex
f9b0: 69 74 29 29 0a 09 20 20 20 28 69 66 20 28 73 79 it)).. (if (sy
f9c0: 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b mbolic-link? lnk
f9d0: 74 61 72 67 65 74 29 20 20 20 20 20 28 64 65 6c target) (del
f9e0: 65 74 65 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 67 ete-file lnktarg
f9f0: 65 74 29 29 0a 09 20 20 20 28 69 66 20 28 6e 6f et)).. (if (no
fa00: 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 t (common:file-e
fa10: 78 69 73 74 73 3f 20 6c 6e 6b 74 61 72 67 65 74 xists? lnktarget
fa20: 29 29 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f )) (create-symbo
fa30: 6c 69 63 2d 6c 69 6e 6b 20 74 65 73 74 2d 70 61 lic-link test-pa
fa40: 74 68 20 6c 6e 6b 74 61 72 67 65 74 29 29 29 29 th lnktarget))))
fa50: 29 0a 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ).. (if (not
fa60: 28 64 69 72 65 63 74 6f 72 79 3f 20 74 65 73 74 (directory? test
fa70: 2d 70 61 74 68 29 29 0a 09 28 63 72 65 61 74 65 -path))..(create
fa80: 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 74 2d -directory test-
fa90: 70 61 74 68 20 23 74 29 29 20 3b 3b 20 74 68 69 path #t)) ;; thi
faa0: 73 20 69 73 20 61 20 68 61 63 6b 2c 20 49 20 64 s is a hack, I d
fab0: 6f 6e 27 74 20 6b 6e 6f 77 20 77 68 79 20 6f 75 on't know why ou
fac0: 74 20 6f 66 20 74 68 65 20 62 6c 75 65 20 74 68 t of the blue th
fad0: 69 73 20 70 61 74 68 20 64 6f 65 73 20 6e 6f 74 is path does not
fae0: 20 65 78 69 73 74 20 73 6f 6d 65 74 69 6d 65 73 exist sometimes
faf0: 0a 0a 20 20 20 20 28 69 66 20 28 61 6e 64 20 74 .. (if (and t
fb00: 65 73 74 2d 73 72 63 2d 70 61 74 68 20 28 64 69 est-src-path (di
fb10: 72 65 63 74 6f 72 79 3f 20 74 65 73 74 2d 70 61 rectory? test-pa
fb20: 74 68 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 th))..(begin..
fb30: 28 6c 61 75 6e 63 68 3a 74 65 73 74 2d 63 6f 70 (launch:test-cop
fb40: 79 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 y test-src-path
fb50: 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 6c test-path).. (l
fb60: 69 73 74 20 6c 6e 6b 70 61 74 68 66 20 6c 6e 6b ist lnkpathf lnk
fb70: 70 61 74 68 20 29 29 0a 09 28 69 66 20 28 61 6e path ))..(if (an
fb80: 64 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 d test-src-path
fb90: 28 3e 20 72 65 6d 74 72 69 65 73 20 30 29 29 0a (> remtries 0)).
fba0: 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 . (begin..
fbb0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
fbc0: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
fbd0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c -log-port* "Fail
fbe0: 65 64 20 74 6f 20 63 72 65 61 74 65 20 77 6f 72 ed to create wor
fbf0: 6b 20 61 72 65 61 20 61 74 20 22 20 74 65 73 74 k area at " test
fc00: 2d 70 61 74 68 20 22 20 77 69 74 68 20 6c 69 6e -path " with lin
fc10: 6b 20 61 74 20 22 20 6c 6e 6b 74 61 72 67 65 74 k at " lnktarget
fc20: 20 22 2c 20 72 65 6d 61 69 6e 69 6e 67 20 61 74 ", remaining at
fc30: 74 65 6d 70 74 73 20 22 20 72 65 6d 74 72 69 65 tempts " remtrie
fc40: 73 29 0a 09 20 20 20 20 20 20 3b 3b 20 0a 09 20 s).. ;; ..
fc50: 20 20 20 20 20 28 63 72 65 61 74 65 2d 77 6f 72 (create-wor
fc60: 6b 2d 61 72 65 61 20 72 75 6e 2d 69 64 20 72 75 k-area run-id ru
fc70: 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 n-info keyvals t
fc80: 65 73 74 2d 69 64 20 74 65 73 74 2d 73 72 63 2d est-id test-src-
fc90: 70 61 74 68 20 64 69 73 6b 2d 70 61 74 68 20 74 path disk-path t
fca0: 65 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 20 estname itemdat
fcb0: 72 65 6d 74 72 69 65 73 3a 20 28 2d 20 72 65 6d remtries: (- rem
fcc0: 74 72 69 65 73 20 31 29 29 29 0a 09 20 20 20 20 tries 1)))..
fcd0: 28 6c 69 73 74 20 23 66 20 23 66 29 29 29 29 29 (list #f #f)))))
fce0: 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 74 68 6f ..;; 1. look tho
fcf0: 75 67 68 20 64 69 73 6b 73 20 6c 69 73 74 20 66 ugh disks list f
fd00: 6f 72 20 64 69 73 6b 20 77 69 74 68 20 6d 6f 73 or disk with mos
fd10: 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e 20 63 72 t space.;; 2. cr
fd20: 65 61 74 65 20 72 75 6e 20 64 69 72 20 6f 6e 20 eate run dir on
fd30: 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 6d 65 20 disk, path name
fd40: 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c 0a 3b 3b is meaningful.;;
fd50: 20 33 2e 20 63 72 65 61 74 65 20 6c 69 6e 6b 20 3. create link
fd60: 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 74 6f 20 from run dir to
fd70: 6d 65 67 61 74 65 73 74 20 72 75 6e 73 20 61 72 megatest runs ar
fd80: 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d 6f 74 65 ea .;; 4. remote
fd90: 6c 79 20 72 75 6e 20 74 68 65 20 74 65 73 74 20 ly run the test
fda0: 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 68 6f 73 on allocated hos
fdb0: 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 t.;; - could
fdc0: 62 65 20 73 73 68 20 74 6f 20 68 6f 73 74 20 66 be ssh to host f
fdd0: 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 6c 65 20 rom hosts table
fde0: 28 75 70 64 61 74 65 20 72 65 67 75 6c 61 72 6c (update regularl
fdf0: 79 20 77 69 74 68 20 6c 6f 61 64 29 0a 3b 3b 20 y with load).;;
fe00: 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 6e 65 - could be ne
fe10: 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 20 20 28 tbatch.;; (
fe20: 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 62 20 28 launch-test db (
fe30: 63 61 64 72 20 73 74 61 74 75 73 29 20 74 65 73 cadr status) tes
fe40: 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 69 6e 65 t-conf)).(define
fe50: 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 74 65 (launch-test te
fe60: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 72 75 6e st-id run-id run
fe70: 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 72 75 -info keyvals ru
fe80: 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f 6e 66 20 nname test-conf
fe90: 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 74 2d 70 test-name test-p
fea0: 61 74 68 20 69 74 65 6d 64 61 74 20 70 61 72 61 ath itemdat para
feb0: 6d 73 29 0a 20 20 28 6d 75 74 65 78 2d 6c 6f 63 ms). (mutex-loc
fec0: 6b 21 20 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 k! *launch-setup
fed0: 2d 6d 75 74 65 78 2a 29 20 3b 3b 20 73 65 74 74 -mutex*) ;; sett
fee0: 69 6e 67 20 76 61 72 69 61 62 6c 65 73 20 61 6e ing variables an
fef0: 64 20 70 72 6f 63 65 73 73 69 6e 67 20 74 68 65 d processing the
ff00: 20 74 65 73 74 63 6f 6e 66 69 67 20 69 73 20 4e testconfig is N
ff10: 4f 54 20 74 68 72 65 61 64 2d 73 61 66 65 2c 20 OT thread-safe,
ff20: 72 65 75 73 65 20 74 68 65 20 6c 61 75 6e 63 68 reuse the launch
ff30: 2d 73 65 74 75 70 20 6d 75 74 65 78 0a 20 20 28 -setup mutex. (
ff40: 6c 65 74 2a 20 28 20 3b 3b 20 28 6c 6f 63 6b 2d let* ( ;; (lock-
ff50: 6b 65 79 20 20 20 20 20 20 20 20 28 63 6f 6e 63 key (conc
ff60: 20 22 74 65 73 74 2d 22 20 74 65 73 74 2d 69 64 "test-" test-id
ff70: 29 29 0a 09 3b 3b 20 28 67 6f 74 2d 6c 6f 63 6b ))..;; (got-lock
ff80: 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f (let loo
ff90: 70 20 28 28 6c 6f 63 6b 20 20 20 20 20 20 20 20 p ((lock
ffa0: 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 (rmt:no-sync-get
ffb0: 2d 6c 6f 63 6b 20 6c 6f 63 6b 2d 6b 65 79 29 29 -lock lock-key))
ffc0: 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 28 65 78 ..;; ... (ex
ffd0: 70 69 72 65 2d 74 69 6d 65 20 28 2b 20 28 63 75 pire-time (+ (cu
ffe0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 31 rrent-seconds) 1
fff0: 35 29 29 29 20 3b 3b 20 67 69 76 65 20 75 70 20 5))) ;; give up
10000 6f 6e 20 67 65 74 74 69 6e 67 20 74 68 65 20 6c on getting the l
10010 6f 63 6b 20 61 6e 64 20 73 74 65 61 6c 20 69 74 ock and steal it
10020 20 61 66 74 65 72 20 31 35 20 73 65 63 6f 6e 64 after 15 second
10030 73 0a 09 3b 3b 20 09 09 20 20 20 20 28 69 66 20 s..;; .. (if
10040 28 63 61 72 20 6c 6f 63 6b 29 0a 09 3b 3b 20 09 (car lock)..;; .
10050 09 09 23 74 0a 09 3b 3b 20 09 09 09 28 69 66 20 ..#t..;; ...(if
10060 28 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (> (current-seco
10070 6e 64 73 29 20 65 78 70 69 72 65 2d 74 69 6d 65 nds) expire-time
10080 29 0a 09 3b 3b 20 09 09 09 20 20 20 20 28 62 65 )..;; ... (be
10090 67 69 6e 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 gin..;; ...
100a0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
100b0 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
100c0 67 2d 70 6f 72 74 2a 20 22 54 69 6d 65 64 20 6f g-port* "Timed o
100d0 75 74 20 77 61 69 74 69 6e 67 20 66 6f 72 20 61 ut waiting for a
100e0 20 6c 6f 63 6b 20 74 6f 20 6c 61 75 6e 63 68 20 lock to launch
100f0 74 65 73 74 20 22 20 6b 65 79 76 61 6c 73 20 22 test " keyvals "
10100 20 22 20 72 75 6e 6e 61 6d 65 20 22 20 22 20 74 " runname " " t
10110 65 73 74 2d 6e 61 6d 65 20 22 20 22 20 74 65 73 est-name " " tes
10120 74 2d 70 61 74 68 29 0a 09 3b 3b 20 09 09 09 20 t-path)..;; ...
10130 20 20 20 20 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e (rmt:no-syn
10140 63 2d 64 65 6c 21 20 6c 6f 63 6b 2d 6b 65 79 29 c-del! lock-key)
10150 20 3b 3b 20 64 65 73 74 72 6f 79 20 74 68 65 20 ;; destroy the
10160 6c 6f 63 6b 0a 09 3b 3b 20 09 09 09 20 20 20 20 lock..;; ...
10170 20 20 28 6c 6f 6f 70 20 28 72 6d 74 3a 6e 6f 2d (loop (rmt:no-
10180 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c 6f sync-get-lock lo
10190 63 6b 2d 6b 65 79 29 20 65 78 70 69 72 65 2d 74 ck-key) expire-t
101a0 69 6d 65 29 29 20 3b 3b 20 0a 09 3b 3b 20 09 09 ime)) ;; ..;; ..
101b0 09 20 20 20 20 28 62 65 67 69 6e 0a 09 3b 3b 20 . (begin..;;
101c0 09 09 09 20 20 20 20 20 20 28 74 68 72 65 61 64 ... (thread
101d0 2d 73 6c 65 65 70 21 20 31 29 0a 09 3b 3b 20 09 -sleep! 1)..;; .
101e0 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 72 .. (loop (r
101f0 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c mt:no-sync-get-l
10200 6f 63 6b 20 6c 6f 63 6b 2d 6b 65 79 29 20 65 78 ock lock-key) ex
10210 70 69 72 65 2d 74 69 6d 65 29 29 29 29 29 29 0a pire-time)))))).
10220 09 20 28 69 74 65 6d 2d 70 61 74 68 20 20 20 20 . (item-path
10230 20 20 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 (item-list->p
10240 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
10250 28 63 6f 6e 74 6f 75 72 20 20 20 20 20 20 20 20 (contour
10260 20 23 66 29 29 20 3b 3b 20 4e 4f 54 20 52 45 41 #f)) ;; NOT REA
10270 44 59 20 46 4f 52 20 54 48 49 53 20 28 61 72 67 DY FOR THIS (arg
10280 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 74 s:get-arg "-cont
10290 6f 75 72 22 29 29 29 0a 20 20 20 20 28 6c 65 74 our"))). (let
102a0 20 6c 6f 6f 70 20 28 28 64 65 6c 74 61 20 20 20 loop ((delta
102b0 20 20 20 20 20 28 2d 20 28 63 75 72 72 65 6e 74 (- (current
102c0 2d 73 65 63 6f 6e 64 73 29 20 2a 6c 61 73 74 2d -seconds) *last-
102d0 6c 61 75 6e 63 68 2a 29 29 0a 09 20 20 20 20 20 launch*))..
102e0 20 20 28 6c 61 75 6e 63 68 2d 64 65 6c 61 79 20 (launch-delay
102f0 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d (configf:lookup-
10300 6e 75 6d 62 65 72 20 2a 63 6f 6e 66 69 67 64 61 number *configda
10310 74 2a 20 22 73 65 74 75 70 22 20 22 6c 61 75 6e t* "setup" "laun
10320 63 68 2d 64 65 6c 61 79 22 20 64 65 66 61 75 6c ch-delay" defaul
10330 74 3a 20 31 29 29 29 0a 20 20 20 20 20 20 28 69 t: 1))). (i
10340 66 20 28 3e 20 6c 61 75 6e 63 68 2d 64 65 6c 61 f (> launch-dela
10350 79 20 64 65 6c 74 61 29 0a 09 20 20 28 62 65 67 y delta).. (beg
10360 69 6e 0a 09 20 20 20 20 28 69 66 20 28 63 6f 6d in.. (if (com
10370 6d 6f 6e 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 mon:low-noise-pr
10380 69 6e 74 20 31 32 30 30 20 22 74 65 73 74 20 6c int 1200 "test l
10390 61 75 6e 63 68 20 64 65 6c 61 79 22 29 20 3b 3b aunch delay") ;;
103a0 20 65 76 65 72 79 20 74 77 6f 20 68 6f 75 72 73 every two hours
103b0 20 6f 72 20 73 6f 20 72 65 6d 69 6e 64 20 74 68 or so remind th
103c0 65 20 75 73 65 72 20 61 62 6f 75 74 20 6c 61 75 e user about lau
103d0 6e 63 68 20 64 65 6c 61 79 2e 0a 09 09 28 64 65 nch delay....(de
103e0 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
103f0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
10400 72 74 2a 20 22 4e 4f 54 45 3a 20 74 65 73 74 20 rt* "NOTE: test
10410 6c 61 75 6e 63 68 65 73 20 61 72 65 20 64 65 6c launches are del
10420 61 79 65 64 20 62 79 20 22 20 6c 61 75 6e 63 68 ayed by " launch
10430 2d 64 65 6c 61 79 20 22 20 73 65 63 6f 6e 64 73 -delay " seconds
10440 2e 20 53 65 65 20 6d 65 67 61 74 65 73 74 2e 63 . See megatest.c
10450 6f 6e 66 69 67 20 6c 61 75 6e 63 68 2d 64 65 6c onfig launch-del
10460 61 79 20 73 65 74 74 69 6e 67 20 74 6f 20 61 64 ay setting to ad
10470 6a 75 73 74 2e 22 29 29 20 3b 3b 20 6c 61 75 6e just.")) ;; laun
10480 63 68 20 6f 66 20 22 20 74 65 73 74 2d 6e 61 6d ch of " test-nam
10490 65 20 22 20 66 6f 72 20 22 20 28 2d 20 6c 61 75 e " for " (- lau
104a0 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 29 nch-delay delta)
104b0 20 22 20 73 65 63 6f 6e 64 73 22 29 29 0a 09 20 " seconds"))..
104c0 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
104d0 21 20 28 2d 20 6c 61 75 6e 63 68 2d 64 65 6c 61 ! (- launch-dela
104e0 79 20 64 65 6c 74 61 29 29 0a 09 20 20 20 20 28 y delta)).. (
104f0 6c 6f 6f 70 20 28 2d 20 28 63 75 72 72 65 6e 74 loop (- (current
10500 2d 73 65 63 6f 6e 64 73 29 20 2a 6c 61 73 74 2d -seconds) *last-
10510 6c 61 75 6e 63 68 2a 29 20 6c 61 75 6e 63 68 2d launch*) launch-
10520 64 65 6c 61 79 29 29 29 29 0a 20 20 20 20 28 63 delay)))). (c
10530 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
10540 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 28 *toppath*). (
10550 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
10560 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 ;; consolidate t
10570 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 his code with th
10580 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 e code in megate
10590 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 st.scm for "-exe
105a0 63 75 74 65 22 2c 20 2a 6d 61 79 62 65 2a 20 2d cute", *maybe* -
105b0 20 74 68 65 20 6c 6f 6e 67 65 72 20 74 68 65 79 the longer they
105c0 20 61 72 65 20 73 65 74 20 74 68 65 20 6c 6f 6e are set the lon
105d0 67 65 72 20 65 61 63 68 20 6c 61 75 6e 63 68 20 ger each launch
105e0 74 61 6b 65 73 20 28 6d 75 73 74 20 62 65 20 6e takes (must be n
105f0 6f 6e 2d 6f 76 65 72 6c 61 70 70 69 6e 67 20 77 on-overlapping w
10600 69 74 68 20 74 68 65 20 76 61 72 73 29 0a 20 20 ith the vars).
10610 20 20 20 28 61 70 70 65 6e 64 0a 20 20 20 20 20 (append.
10620 20 28 6c 69 73 74 0a 20 20 20 20 20 20 20 28 6c (list. (l
10630 69 73 74 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ist "MT_RUN_AREA
10640 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a _HOME" *toppath*
10650 29 0a 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 ). (list "
10660 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 MT_TEST_NAME" te
10670 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 st-name).
10680 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d (list "MT_RUNNAM
10690 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 20 20 E" runname).
106a0 20 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 (list "MT_I
106b0 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d 2d 70 TEMPATH" item-p
106c0 61 74 68 29 0a 20 20 20 20 20 20 20 28 6c 69 73 ath). (lis
106d0 74 20 22 4d 54 5f 43 4f 4e 54 4f 55 52 22 20 20 t "MT_CONTOUR"
106e0 20 63 6f 6e 74 6f 75 72 29 0a 20 20 20 20 20 20 contour).
106f0 20 29 0a 20 20 20 20 20 20 69 74 65 6d 64 61 74 ). itemdat
10700 29 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 )). (let* ((t
10710 72 65 67 69 73 74 72 79 20 20 20 20 20 20 20 28 registry (
10720 74 65 73 74 73 3a 67 65 74 2d 61 6c 6c 29 29 20 tests:get-all))
10730 3b 3b 20 74 68 69 72 64 20 70 61 72 61 6d 20 28 ;; third param (
10740 62 65 6c 6f 77 29 20 69 73 20 73 79 73 74 65 6d below) is system
10750 2d 61 6c 6c 6f 77 65 64 0a 20 20 20 20 20 20 20 -allowed.
10760 20 20 20 20 3b 3b 20 66 6f 72 20 74 63 6f 6e 66 ;; for tconf
10770 69 67 2c 20 77 68 79 20 64 6f 20 77 65 20 61 6c ig, why do we al
10780 6c 6f 77 20 66 61 6c 6c 62 61 63 6b 20 74 6f 20 low fallback to
10790 74 65 73 74 2d 63 6f 6e 66 3f 0a 09 20 20 20 28 test-conf?.. (
107a0 74 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 tconfig
107b0 28 6f 72 20 28 74 65 73 74 73 3a 67 65 74 2d 74 (or (tests:get-t
107c0 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e estconfig test-n
107d0 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 74 72 ame item-path tr
107e0 65 67 69 73 74 72 79 20 23 74 20 66 6f 72 63 65 egistry #t force
107f0 2d 63 72 65 61 74 65 3a 20 23 74 29 0a 09 09 09 -create: #t)....
10800 09 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 .(begin.
10810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10820 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
10830 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
10840 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
10850 4e 49 4e 47 3a 20 66 61 6c 6c 69 6e 67 20 62 61 NING: falling ba
10860 63 6b 20 74 6f 20 70 72 65 2d 63 61 6c 63 75 6c ck to pre-calcul
10870 61 74 65 64 20 74 65 73 74 63 6f 6e 66 69 67 2e ated testconfig.
10880 20 54 68 69 73 20 69 73 20 6c 69 6b 65 6c 79 20 This is likely
10890 6e 6f 74 20 64 65 73 69 72 65 64 2e 22 29 0a 20 not desired.").
108a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
108b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
108c0 20 74 65 73 74 2d 63 6f 6e 66 29 29 29 20 3b 3b test-conf))) ;;
108d0 20 66 6f 72 63 65 20 72 65 2d 72 65 61 64 20 6e force re-read n
108e0 6f 77 20 74 68 61 74 20 61 6c 6c 20 76 61 72 73 ow that all vars
108f0 20 61 72 65 20 73 65 74 0a 09 20 20 20 28 75 73 are set.. (us
10900 65 73 68 65 6c 6c 20 20 20 20 20 20 20 20 28 6c eshell (l
10910 65 74 20 28 28 75 73 68 20 28 63 6f 6e 66 69 67 et ((ush (config
10920 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
10930 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
10940 20 20 20 22 75 73 65 73 68 65 6c 6c 22 29 29 29 "useshell")))
10950 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 75 73 .... (if us
10960 68 20 0a 09 09 09 09 20 20 28 69 66 20 28 65 71 h ..... (if (eq
10970 75 61 6c 3f 20 75 73 68 20 22 6e 6f 22 29 20 3b ual? ush "no") ;
10980 3b 20 6d 75 73 74 20 75 73 65 20 22 6e 6f 22 20 ; must use "no"
10990 74 6f 20 4e 4f 54 20 75 73 65 20 73 68 65 6c 6c to NOT use shell
109a0 0a 09 09 09 09 20 20 20 20 20 20 23 66 0a 09 09 ..... #f...
109b0 09 09 20 20 20 20 20 20 75 73 68 29 0a 09 09 09 .. ush)....
109c0 09 20 20 23 74 29 29 29 20 20 20 20 20 3b 3b 20 . #t))) ;;
109d0 64 65 66 61 75 6c 74 20 69 73 20 79 65 73 0a 09 default is yes..
109e0 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 20 20 (runscript
109f0 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b (config-look
10a00 75 70 20 74 63 6f 6e 66 69 67 20 20 20 22 73 65 up tconfig "se
10a10 74 75 70 22 20 20 20 20 20 20 20 20 22 72 75 6e tup" "run
10a20 73 63 72 69 70 74 22 29 29 0a 09 20 20 20 28 65 script")).. (e
10a30 7a 73 74 65 70 73 20 20 20 20 20 20 20 20 20 28 zsteps (
10a40 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 2d > (length (hash-
10a50 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
10a60 74 20 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 t tconfig "ezste
10a70 70 73 22 20 27 28 29 29 29 20 30 29 29 20 3b 3b ps" '())) 0)) ;;
10a80 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 6c 6c 20 don't send all
10a90 74 68 65 20 73 74 65 70 73 2c 20 63 6f 75 6c 64 the steps, could
10aa0 20 62 65 20 62 69 67 0a 09 20 20 20 3b 3b 20 28 be big.. ;; (
10ab0 64 69 73 6b 73 70 61 63 65 20 20 20 20 20 20 20 diskspace
10ac0 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 (config-lookup t
10ad0 63 6f 6e 66 69 67 20 20 20 22 72 65 71 75 69 72 config "requir
10ae0 65 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 61 ements" "diskspa
10af0 63 65 22 29 29 0a 09 20 20 20 3b 3b 20 28 6d 65 ce")).. ;; (me
10b00 6d 6f 72 79 20 20 20 20 20 20 20 20 20 20 28 63 mory (c
10b10 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 63 6f onfig-lookup tco
10b20 6e 66 69 67 20 20 20 22 72 65 71 75 69 72 65 6d nfig "requirem
10b30 65 6e 74 73 22 20 22 6d 65 6d 6f 72 79 22 29 29 ents" "memory"))
10b40 0a 09 20 20 20 3b 3b 20 28 68 6f 73 74 73 20 20 .. ;; (hosts
10b50 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
10b60 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 -lookup *configd
10b70 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
10b80 20 20 20 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 "workhosts"))
10b90 20 3b 3b 20 49 27 6d 20 70 72 65 74 74 79 20 73 ;; I'm pretty s
10ba0 75 72 65 20 74 68 69 73 20 77 61 73 20 6e 65 76 ure this was nev
10bb0 65 72 20 63 6f 6d 70 6c 65 74 65 64 0a 09 20 20 er completed..
10bc0 20 28 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 (remote-megates
10bd0 74 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 t (config-lookup
10be0 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
10bf0 74 75 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 tup" "executable
10c00 22 29 29 0a 09 20 20 20 28 72 75 6e 2d 74 69 6d ")).. (run-tim
10c10 65 2d 6c 69 6d 69 74 20 20 28 6f 72 20 28 63 6f e-limit (or (co
10c20 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 74 63 nfigf:lookup tc
10c30 6f 6e 66 69 67 20 20 20 22 72 65 71 75 69 72 65 onfig "require
10c40 6d 65 6e 74 73 22 20 22 72 75 6e 74 69 6d 65 6c ments" "runtimel
10c50 69 6d 22 29 0a 09 09 09 09 28 63 6f 6e 66 69 67 im").....(config
10c60 66 3a 6c 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 f:lookup *confi
10c70 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 72 gdat* "setup" "r
10c80 75 6e 74 69 6d 65 6c 69 6d 22 29 29 29 0a 09 20 untimelim")))..
10c90 20 20 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 ;; FIXME SOMED
10ca0 41 59 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 AY: not good how
10cb0 20 74 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 this is so obtu
10cc0 73 65 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 se, this hack is
10cd0 20 74 6f 20 0a 09 20 20 20 3b 3b 20 20 20 20 20 to .. ;;
10ce0 20 20 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 allow
10cf0 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 running from da
10d00 73 68 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 shboard. Extract
10d10 20 74 68 65 20 70 61 74 68 0a 09 20 20 20 3b 3b the path.. ;;
10d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10d30 66 72 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 from the called
10d40 6d 65 67 61 74 65 73 74 20 61 6e 64 20 63 6f 6e megatest and con
10d50 76 65 72 74 20 64 61 73 68 62 6f 61 72 64 0a 09 vert dashboard..
10d60 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
10d70 20 20 09 20 20 6f 72 20 64 62 6f 61 72 64 20 74 . or dboard t
10d80 6f 20 6d 65 67 61 74 65 73 74 0a 09 20 20 20 28 o megatest.. (
10d90 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 local-megatest
10da0 28 6c 65 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 (let* ((lm (car
10db0 20 28 61 72 67 76 29 29 29 0a 09 09 09 09 20 20 (argv))).....
10dc0 20 28 64 69 72 20 28 70 61 74 68 6e 61 6d 65 2d (dir (pathname-
10dd0 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 29 0a 09 directory lm))..
10de0 09 09 09 20 20 20 28 65 78 65 20 28 70 61 74 68 ... (exe (path
10df0 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 65 63 name-strip-direc
10e00 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 20 20 tory lm)))....
10e10 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 (conc (if di
10e20 72 20 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 r (conc dir "/")
10e30 20 22 22 29 0a 09 09 09 09 20 20 20 20 28 63 61 "")..... (ca
10e40 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 se (string->symb
10e50 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 20 20 20 ol exe).....
10e60 20 20 28 28 64 62 6f 61 72 64 29 20 20 20 20 22 ((dboard) "
10e70 2e 2e 2f 6d 65 67 61 74 65 73 74 22 29 0a 09 09 ../megatest")...
10e80 09 09 20 20 20 20 20 20 28 28 6d 74 65 73 74 29 .. ((mtest)
10e90 20 20 20 20 20 22 2e 2e 2f 6d 65 67 61 74 65 73 "../megates
10ea0 74 22 29 0a 09 09 09 09 20 20 20 20 20 20 28 28 t")..... ((
10eb0 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 67 61 dashboard) "mega
10ec0 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 20 test").....
10ed0 20 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a (else exe))))).
10ee0 09 20 20 20 28 6c 61 75 6e 63 68 65 72 20 20 20 . (launcher
10ef0 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (common:get
10f00 2d 6c 61 75 6e 63 68 65 72 20 2a 63 6f 6e 66 69 -launcher *confi
10f10 67 64 61 74 2a 20 74 65 73 74 2d 6e 61 6d 65 20 gdat* test-name
10f20 69 74 65 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 item-path)) ;; (
10f30 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 config-lookup *c
10f40 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f onfigdat* "jobto
10f50 6f 6c 73 22 20 20 20 20 20 22 6c 61 75 6e 63 68 ols" "launch
10f60 65 72 22 29 29 0a 09 20 20 20 28 74 65 73 74 2d er")).. (test-
10f70 73 69 67 20 20 20 20 20 20 20 20 28 63 6f 6e 63 sig (conc
10f80 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
10f90 74 73 75 69 74 65 2d 6e 61 6d 65 29 20 22 3a 22 tsuite-name) ":"
10fa0 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a 22 20 69 test-name ":" i
10fb0 74 65 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 69 tem-path)) ;; (i
10fc0 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 tem-list->path i
10fd0 74 65 6d 64 61 74 29 29 29 20 3b 3b 20 74 65 73 temdat))) ;; tes
10fe0 74 2d 70 61 74 68 20 69 73 20 74 68 65 20 66 75 t-path is the fu
10ff0 6c 6c 20 70 61 74 68 20 69 6e 63 6c 75 64 69 6e ll path includin
11000 67 20 74 68 65 20 69 74 65 6d 2d 70 61 74 68 0a g the item-path.
11010 09 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 20 . (work-area
11020 20 20 20 20 20 23 66 29 0a 09 20 20 20 28 74 6f #f).. (to
11030 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 ptest-work-area
11040 23 66 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 61 #f) ;; for itera
11050 74 65 64 20 74 65 73 74 73 20 74 68 65 20 74 6f ted tests the to
11060 70 20 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 20 p test contains
11070 64 61 74 61 20 72 65 6c 65 76 61 6e 74 20 66 6f data relevant fo
11080 72 20 61 6c 6c 0a 09 20 20 20 28 64 69 73 6b 70 r all.. (diskp
11090 61 74 68 20 20 20 23 66 29 0a 09 20 20 20 28 63 ath #f).. (c
110a0 6d 64 70 61 72 6d 73 20 20 20 23 66 29 0a 09 20 mdparms #f)..
110b0 20 20 28 66 75 6c 6c 63 6d 64 20 20 20 20 23 66 (fullcmd #f
110c0 29 20 3b 3b 20 28 64 65 66 69 6e 65 20 61 20 28 ) ;; (define a (
110d0 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 with-output-to-s
110e0 74 72 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 tring (lambda ()
110f0 28 77 72 69 74 65 20 78 29 29 29 29 0a 09 20 20 (write x))))..
11100 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 (mt-bindir-path
11110 20 23 66 29 0a 09 20 20 20 28 74 65 73 74 69 6e #f).. (testin
11120 66 6f 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 fo (rmt:get-te
11130 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 st-info-by-id ru
11140 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 n-id test-id))..
11150 20 20 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 (mt_target (
11160 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
11170 73 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 se (map cadr key
11180 76 61 6c 73 29 20 22 2f 22 29 29 0a 09 20 20 20 vals) "/"))..
11190 28 64 65 62 75 67 2d 70 61 72 61 6d 20 28 61 70 (debug-param (ap
111a0 70 65 6e 64 20 28 69 66 20 28 61 72 67 73 3a 67 pend (if (args:g
111b0 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 et-arg "-debug")
111c0 20 20 28 6c 69 73 74 20 22 2d 64 65 62 75 67 22 (list "-debug"
111d0 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
111e0 2d 64 65 62 75 67 22 29 29 20 27 28 29 29 0a 09 -debug")) '())..
111f0 09 09 09 28 69 66 20 28 61 72 67 73 3a 67 65 74 ...(if (args:get
11200 2d 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 -arg "-logging")
11210 28 6c 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 (list "-logging"
11220 29 20 27 28 29 29 29 29 29 0a 20 20 20 20 20 20 ) '())))).
11230 3b 3b 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 ;; (if hosts (se
11240 74 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 t! hosts (string
11250 2d 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a -split hosts))).
11260 20 20 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 ;; set the
11270 20 6d 65 67 61 74 65 73 74 20 74 6f 20 62 65 20 megatest to be
11280 63 61 6c 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 called on the re
11290 6d 6f 74 65 20 68 6f 73 74 0a 20 20 20 20 20 20 mote host.
112a0 28 69 66 20 28 6e 6f 74 20 72 65 6d 6f 74 65 2d (if (not remote-
112b0 6d 65 67 61 74 65 73 74 29 28 73 65 74 21 20 72 megatest)(set! r
112c0 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 6c emote-megatest l
112d0 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 29 20 ocal-megatest))
112e0 3b 3b 20 22 6d 65 67 61 74 65 73 74 22 29 29 0a ;; "megatest")).
112f0 20 20 20 20 20 20 28 73 65 74 21 20 6d 74 2d 62 (set! mt-b
11300 69 6e 64 69 72 2d 70 61 74 68 20 28 70 61 74 68 indir-path (path
11310 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 72 name-directory r
11320 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 29 emote-megatest))
11330 0a 20 20 20 20 20 20 28 69 66 20 6c 61 75 6e 63 . (if launc
11340 68 65 72 20 28 73 65 74 21 20 6c 61 75 6e 63 68 her (set! launch
11350 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 er (string-split
11360 20 6c 61 75 6e 63 68 65 72 29 29 29 0a 20 20 20 launcher))).
11370 20 20 20 3b 3b 20 73 65 74 20 75 70 20 74 68 65 ;; set up the
11380 20 72 75 6e 20 77 6f 72 6b 20 61 72 65 61 20 66 run work area f
11390 6f 72 20 74 68 69 73 20 74 65 73 74 0a 20 20 20 or this test.
113a0 20 20 20 28 69 66 20 28 61 6e 64 20 28 61 72 67 (if (and (arg
113b0 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 72 65 63 s:get-arg "-prec
113c0 6c 65 61 6e 22 29 20 3b 3b 20 75 73 65 72 20 68 lean") ;; user h
113d0 61 73 20 72 65 71 75 65 73 74 65 64 20 74 6f 20 as requested to
113e0 70 72 65 63 6c 65 61 6e 20 66 6f 72 20 74 68 69 preclean for thi
113f0 73 20 72 75 6e 0a 09 20 20 20 20 20 20 20 28 6e s run.. (n
11400 6f 74 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 ot (member (db:t
11410 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 est-get-rundir t
11420 65 73 74 69 6e 66 6f 29 28 6c 69 73 74 20 22 6e estinfo)(list "n
11430 2f 61 22 20 22 2f 74 6d 70 2f 62 61 64 6e 61 6d /a" "/tmp/badnam
11440 65 22 29 29 29 29 20 3b 3b 20 6e 2f 61 20 69 73 e")))) ;; n/a is
11450 20 61 20 70 6c 61 63 65 68 6f 6c 64 65 72 20 61 a placeholder a
11460 6e 64 20 74 68 75 73 20 6e 6f 74 20 61 20 72 65 nd thus not a re
11470 61 64 20 64 69 72 0a 09 20 20 28 62 65 67 69 6e ad dir.. (begin
11480 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 .. (debug:pri
11490 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
114a0 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 61 74 lt-log-port* "at
114b0 74 65 6d 70 74 69 6e 67 20 74 6f 20 70 72 65 63 tempting to prec
114c0 6c 65 61 6e 20 64 69 72 65 63 74 6f 72 79 20 22 lean directory "
114d0 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
114e0 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 20 22 ndir testinfo) "
114f0 20 66 6f 72 20 74 65 73 74 20 22 20 74 65 73 74 for test " test
11500 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 -name "/" item-p
11510 61 74 68 29 0a 09 20 20 20 20 28 72 75 6e 73 3a ath).. (runs:
11520 72 65 6d 6f 76 65 2d 74 65 73 74 2d 64 69 72 65 remove-test-dire
11530 63 74 6f 72 79 20 74 65 73 74 69 6e 66 6f 20 27 ctory testinfo '
11540 72 65 6d 6f 76 65 2d 64 61 74 61 2d 6f 6e 6c 79 remove-data-only
11550 29 29 29 20 3b 3b 20 72 65 6d 6f 76 65 20 64 61 ))) ;; remove da
11560 74 61 20 6f 6e 6c 79 2c 20 64 6f 20 6e 6f 74 20 ta only, do not
11570 70 65 72 74 75 72 62 20 74 68 65 20 72 65 63 6f perturb the reco
11580 72 64 0a 20 20 20 20 20 20 0a 20 20 20 20 20 20 rd. .
11590 3b 3b 20 70 72 65 76 65 6e 74 20 6f 76 65 72 6c ;; prevent overl
115a0 61 70 70 69 6e 67 20 61 63 74 69 6f 6e 73 20 2d apping actions -
115b0 20 73 65 74 20 74 6f 20 4c 41 55 4e 43 48 45 44 set to LAUNCHED
115c0 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 6f 73 as early as pos
115d0 73 69 62 6c 65 0a 20 20 20 20 20 20 3b 3b 0a 20 sible. ;;.
115e0 20 20 20 20 20 3b 3b 20 74 68 65 20 66 6f 6c 6c ;; the foll
115f0 6f 77 69 6e 67 20 63 61 6c 6c 20 68 61 6e 64 6c owing call handl
11600 65 73 20 77 61 69 76 65 72 20 70 72 6f 70 6f 67 es waiver propog
11610 61 74 69 6f 6e 2e 20 63 61 6e 6e 6f 74 20 79 65 ation. cannot ye
11620 74 20 63 6f 6e 64 65 6e 73 65 20 69 6e 74 6f 20 t condense into
11630 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 61 69 roll-up-pass-fai
11640 6c 0a 20 20 20 20 20 20 28 74 65 73 74 73 3a 74 l. (tests:t
11650 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
11660 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 run-id test-id "
11670 4c 41 55 4e 43 48 45 44 22 20 22 6e 2f 61 22 20 LAUNCHED" "n/a"
11680 23 66 20 23 66 29 20 3b 3b 20 28 69 66 20 6c 61 #f #f) ;; (if la
11690 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 6c 61 75 unch-results lau
116a0 6e 63 68 2d 72 65 73 75 6c 74 73 20 22 46 41 49 nch-results "FAI
116b0 4c 45 44 22 29 29 0a 20 20 20 20 20 20 28 72 6d LED")). (rm
116c0 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t:set-state-stat
116d0 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 us-and-roll-up-i
116e0 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 tems run-id test
116f0 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
11700 23 66 20 22 4c 41 55 4e 43 48 45 44 22 20 23 66 #f "LAUNCHED" #f
11710 29 0a 20 20 20 20 20 20 3b 3b 20 28 70 70 20 28 ). ;; (pp (
11720 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c 69 73 hash-table->alis
11730 74 20 74 63 6f 6e 66 69 67 29 29 0a 20 20 20 20 t tconfig)).
11740 20 20 28 73 65 74 21 20 64 69 73 6b 70 61 74 68 (set! diskpath
11750 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 (get-best-disk
11760 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 63 6f 6e *configdat* tcon
11770 66 69 67 29 29 0a 20 20 20 20 20 20 28 69 66 20 fig)). (if
11780 64 69 73 6b 70 61 74 68 0a 09 20 20 28 6c 65 74 diskpath.. (let
11790 20 28 28 64 61 74 20 20 28 63 72 65 61 74 65 2d ((dat (create-
117a0 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 2d 69 64 work-area run-id
117b0 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c run-info keyval
117c0 73 20 74 65 73 74 2d 69 64 20 74 65 73 74 2d 70 s test-id test-p
117d0 61 74 68 20 64 69 73 6b 70 61 74 68 20 74 65 73 ath diskpath tes
117e0 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat))
117f0 29 0a 09 20 20 20 20 28 73 65 74 21 20 77 6f 72 ).. (set! wor
11800 6b 2d 61 72 65 61 20 28 63 61 72 20 64 61 74 29 k-area (car dat)
11810 29 0a 09 20 20 20 20 28 73 65 74 21 20 74 6f 70 ).. (set! top
11820 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 28 test-work-area (
11830 63 61 64 72 20 64 61 74 29 29 0a 09 20 20 20 20 cadr dat))..
11840 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
11850 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
11860 2d 70 6f 72 74 2a 20 22 55 73 69 6e 67 20 77 6f -port* "Using wo
11870 72 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 rk area " work-a
11880 72 65 61 29 29 0a 09 20 20 28 62 65 67 69 6e 0a rea)).. (begin.
11890 09 20 20 20 20 28 73 65 74 21 20 77 6f 72 6b 2d . (set! work-
118a0 61 72 65 61 20 28 63 6f 6e 63 20 74 65 73 74 2d area (conc test-
118b0 70 61 74 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 path "/tmp_run")
118c0 29 0a 09 20 20 20 20 28 63 72 65 61 74 65 2d 64 ).. (create-d
118d0 69 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 irectory work-ar
118e0 65 61 20 23 74 29 0a 09 20 20 20 20 28 64 65 62 ea #t).. (deb
118f0 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
11900 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
11910 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 ARNING: No disk
11920 77 6f 72 6b 20 61 72 65 61 20 73 70 65 63 69 66 work area specif
11930 69 65 64 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e ied - running in
11940 20 74 68 65 20 74 65 73 74 20 64 69 72 65 63 74 the test direct
11950 6f 72 79 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 ory under tmp_ru
11960 6e 22 29 29 29 0a 20 20 20 20 20 20 28 73 65 74 n"))). (set
11970 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 73 65 ! cmdparms (base
11980 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 64:base64-encode
11990 20 0a 09 09 20 20 20 20 20 20 28 7a 33 3a 65 6e ... (z3:en
119a0 63 6f 64 65 2d 62 75 66 66 65 72 20 0a 09 09 20 code-buffer ...
119b0 20 20 20 20 20 20 28 77 69 74 68 2d 6f 75 74 70 (with-outp
119c0 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 09 09 09 ut-to-string....
119d0 20 28 6c 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 (lambda () ;; (
119e0 6c 69 73 74 20 27 68 6f 73 74 73 20 20 20 20 20 list 'hosts
119f0 68 6f 73 74 73 29 0a 09 09 09 20 20 20 28 77 72 hosts).... (wr
11a00 69 74 65 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ite (list (list
11a10 27 74 65 73 74 70 61 74 68 20 20 74 65 73 74 2d 'testpath test-
11a20 70 61 74 68 29 0a 09 09 09 09 09 3b 3b 20 28 6c path)......;; (l
11a30 69 73 74 20 27 74 72 61 6e 73 70 6f 72 74 20 28 ist 'transport (
11a40 63 6f 6e 63 20 2a 74 72 61 6e 73 70 6f 72 74 2d conc *transport-
11a50 74 79 70 65 2a 29 29 0a 09 09 09 09 09 3b 3b 20 type*))......;;
11a60 28 6c 69 73 74 20 27 73 65 72 76 65 72 69 6e 66 (list 'serverinf
11a70 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f 2a 29 0a *server-info*).
11a80 09 09 09 09 09 28 6c 69 73 74 20 27 68 6f 6d 65 .....(list 'home
11a90 68 6f 73 74 20 20 28 6c 65 74 2a 20 28 28 68 68 host (let* ((hh
11aa0 64 61 74 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d dat (common:get-
11ab0 68 6f 6d 65 68 6f 73 74 29 29 29 0a 09 09 09 09 homehost))).....
11ac0 09 09 09 20 20 20 28 69 66 20 68 68 64 61 74 0a ... (if hhdat.
11ad0 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 ....... (c
11ae0 61 72 20 68 68 64 61 74 29 0a 09 09 09 09 09 09 ar hhdat).......
11af0 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 . #f)))...
11b00 09 09 09 28 6c 69 73 74 20 27 73 65 72 76 65 72 ...(list 'server
11b10 75 72 6c 20 28 69 66 20 2a 72 75 6e 72 65 6d 6f url (if *runremo
11b20 74 65 2a 0a 09 09 09 09 09 09 09 20 20 20 20 20 te*........
11b30 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 (remote-server-u
11b40 72 6c 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a rl *runremote*).
11b50 09 09 09 09 09 09 09 20 20 20 20 20 23 66 29 29 ....... #f))
11b60 20 3b 3b 0a 09 09 09 09 09 28 6c 69 73 74 20 27 ;;......(list '
11b70 61 72 65 61 6e 61 6d 65 20 20 28 63 6f 6d 6d 6f areaname (commo
11b80 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d n:get-testsuite-
11b90 6e 61 6d 65 29 29 0a 09 09 09 09 09 28 6c 69 73 name))......(lis
11ba0 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f t 'toppath *to
11bb0 70 70 61 74 68 2a 29 0a 09 09 09 09 09 28 6c 69 ppath*)......(li
11bc0 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 77 6f st 'work-area wo
11bd0 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 09 28 6c rk-area)......(l
11be0 69 73 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 74 ist 'test-name t
11bf0 65 73 74 2d 6e 61 6d 65 29 20 0a 09 09 09 09 09 est-name) ......
11c00 28 6c 69 73 74 20 27 72 75 6e 73 63 72 69 70 74 (list 'runscript
11c10 20 72 75 6e 73 63 72 69 70 74 29 20 0a 09 09 09 runscript) ....
11c20 09 09 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 ..(list 'run-id
11c30 20 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 run-id )...
11c40 09 09 09 28 6c 69 73 74 20 27 74 65 73 74 2d 69 ...(list 'test-i
11c50 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 0a 09 d test-id )..
11c60 09 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 69 74 ....;; (list 'it
11c70 65 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 em-path item-pat
11c80 68 20 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 h )......(list '
11c90 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 64 61 itemdat itemda
11ca0 74 20 20 29 0a 09 09 09 09 09 28 6c 69 73 74 20 t )......(list
11cb0 27 6d 65 67 61 74 65 73 74 20 20 72 65 6d 6f 74 'megatest remot
11cc0 65 2d 6d 65 67 61 74 65 73 74 29 0a 09 09 09 09 e-megatest).....
11cd0 09 28 6c 69 73 74 20 27 65 7a 73 74 65 70 73 20 .(list 'ezsteps
11ce0 20 20 65 7a 73 74 65 70 73 29 20 0a 09 09 09 09 ezsteps) .....
11cf0 09 28 6c 69 73 74 20 27 74 61 72 67 65 74 20 20 .(list 'target
11d00 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 mt_target)....
11d10 09 09 28 6c 69 73 74 20 27 63 6f 6e 74 6f 75 72 ..(list 'contour
11d20 20 20 20 63 6f 6e 74 6f 75 72 29 0a 09 09 09 09 contour).....
11d30 09 28 6c 69 73 74 20 27 72 75 6e 74 6c 69 6d 20 .(list 'runtlim
11d40 20 20 28 69 66 20 72 75 6e 2d 74 69 6d 65 2d 6c (if run-time-l
11d50 69 6d 69 74 20 28 63 6f 6d 6d 6f 6e 3a 68 6d 73 imit (common:hms
11d60 2d 73 74 72 69 6e 67 2d 3e 73 65 63 6f 6e 64 73 -string->seconds
11d70 20 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 29 run-time-limit)
11d80 20 23 66 29 29 0a 09 09 09 09 09 28 6c 69 73 74 #f))......(list
11d90 20 27 65 6e 76 2d 6f 76 72 64 20 20 28 68 61 73 'env-ovrd (has
11da0 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
11db0 75 6c 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 ult *configdat*
11dc0 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 20 27 "env-override" '
11dd0 28 29 29 29 20 0a 09 09 09 09 09 28 6c 69 73 74 ())) ......(list
11de0 20 27 73 65 74 2d 76 61 72 73 20 20 28 69 66 20 'set-vars (if
11df0 70 61 72 61 6d 73 20 28 68 61 73 68 2d 74 61 62 params (hash-tab
11e00 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 70 le-ref/default p
11e10 61 72 61 6d 73 20 22 2d 73 65 74 76 61 72 73 22 arams "-setvars"
11e20 20 23 66 29 29 29 0a 09 09 09 09 09 28 6c 69 73 #f)))......(lis
11e30 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e t 'runname run
11e40 6e 61 6d 65 29 0a 09 09 09 09 09 28 6c 69 73 74 name)......(list
11e50 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 'mt-bindir-path
11e60 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 mt-bindir-path)
11e70 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 0a 20 ))))))). .
11e80 20 20 20 20 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 ;; clean ou
11e90 74 20 73 74 65 70 20 72 65 63 6f 72 64 73 20 66 t step records f
11ea0 72 6f 6d 20 70 72 65 76 69 6f 75 73 20 72 75 6e rom previous run
11eb0 20 69 66 20 74 68 65 79 20 65 78 69 73 74 0a 20 if they exist.
11ec0 20 20 20 20 20 3b 3b 20 28 72 6d 74 3a 64 65 6c ;; (rmt:del
11ed0 65 74 65 2d 74 65 73 74 2d 73 74 65 70 2d 72 65 ete-test-step-re
11ee0 63 6f 72 64 73 20 72 75 6e 2d 69 64 20 74 65 73 cords run-id tes
11ef0 74 2d 69 64 29 0a 20 20 20 20 20 20 3b 3b 20 69 t-id). ;; i
11f00 66 20 74 68 65 20 64 69 72 20 64 6f 65 73 20 6e f the dir does n
11f10 6f 74 20 65 78 69 73 74 20 77 65 20 6d 61 79 20 ot exist we may
11f20 68 61 76 65 20 61 20 69 74 65 6d 70 61 74 68 20 have a itempath
11f30 77 68 65 72 65 20 69 6e 64 69 76 69 64 75 61 6c where individual
11f40 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 61 variables are a
11f50 20 70 61 74 68 2c 20 6c 61 75 6e 63 68 20 61 6e path, launch an
11f60 79 77 61 79 0a 20 20 20 20 20 20 28 69 66 20 28 yway. (if (
11f70 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
11f80 74 73 3f 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 ts? work-area)..
11f90 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
11fa0 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 29 20 ory work-area))
11fb0 3b 3b 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 ;; so that log f
11fc0 69 6c 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 iles from the la
11fd0 75 6e 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e unch process don
11fe0 27 74 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 't clutter the t
11ff0 65 73 74 20 64 69 72 0a 20 20 20 20 20 20 28 63 est dir. (c
12000 6f 6e 64 0a 20 20 20 20 20 20 20 3b 3b 20 28 28 ond. ;; ((
12010 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 68 6f 73 and launcher hos
12020 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 65 20 75 ts) ;; must be u
12030 73 69 6e 67 20 73 73 68 20 68 6f 73 74 6e 61 6d sing ssh hostnam
12040 65 0a 20 20 20 20 20 20 20 3b 3b 20 20 20 20 28 e. ;; (
12050 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
12060 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 pend launcher (c
12070 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 ar hosts)(list r
12080 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 22 emote-megatest "
12090 2d 6d 22 20 74 65 73 74 2d 73 69 67 20 22 2d 65 -m" test-sig "-e
120a0 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
120b0 29 20 64 65 62 75 67 2d 70 61 72 61 6d 29 29 29 ) debug-param)))
120c0 0a 20 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 . ;; (set!
120d0 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
120e0 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 68 launcher (car h
120f0 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 osts)(list remot
12100 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d e-megatest test-
12110 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 sig "-execute" c
12120 6d 64 70 61 72 6d 73 29 29 29 29 0a 20 20 20 20 mdparms)))).
12130 20 20 20 28 6c 61 75 6e 63 68 65 72 0a 09 28 73 (launcher..(s
12140 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
12150 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 end launcher (li
12160 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
12170 73 74 20 22 2d 6d 22 20 74 65 73 74 2d 73 69 67 st "-m" test-sig
12180 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
12190 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
121a0 6d 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 m))). ;; (
121b0 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
121c0 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 6c pend launcher (l
121d0 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 ist remote-megat
121e0 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 est test-sig "-e
121f0 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
12200 29 29 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 )))). (els
12210 65 0a 09 28 69 66 20 28 6e 6f 74 20 75 73 65 73 e..(if (not uses
12220 68 65 6c 6c 29 28 64 65 62 75 67 3a 70 72 69 6e hell)(debug:prin
12230 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
12240 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
12250 20 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 68 internal launch
12260 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 ing will not wor
12270 6b 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 5c k well without \
12280 22 75 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 20 "useshell yes\"
12290 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c in your [jobtool
122a0 73 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a 09 28 s] section"))..(
122b0 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
122c0 70 65 6e 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 pend (list remot
122d0 65 2d 6d 65 67 61 74 65 73 74 20 22 2d 6d 22 20 e-megatest "-m"
122e0 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 test-sig "-execu
122f0 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 te" cmdparms) de
12300 62 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 20 bug-param (list
12310 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 (if useshell "&"
12320 20 22 22 29 29 29 29 29 29 0a 20 20 20 20 20 20 "")))))).
12330 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
12340 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
12350 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
12360 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
12370 72 6d 73 20 28 69 66 20 75 73 65 73 68 65 6c 6c rms (if useshell
12380 20 22 26 22 20 22 22 29 29 29 29 29 0a 20 20 20 "&" ""))))).
12390 20 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 (if (args:get
123a0 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 28 73 -arg "-xterm")(s
123b0 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 et! fullcmd (app
123c0 65 6e 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 end fullcmd (lis
123d0 74 20 22 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 t "-xterm")))).
123e0 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
123f0 74 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 1 *default-log
12400 2d 70 6f 72 74 2a 20 22 4c 61 75 6e 63 68 69 6e -port* "Launchin
12410 67 20 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 g " work-area).
12420 20 20 20 20 20 3b 3b 20 73 65 74 20 70 72 65 2d ;; set pre-
12430 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 20 launch-env-vars
12440 62 65 66 6f 72 65 20 6c 61 75 6e 63 68 69 6e 67 before launching
12450 2c 20 6b 65 65 70 20 74 68 65 20 76 61 72 73 20 , keep the vars
12460 69 6e 20 70 72 65 76 76 61 6c 73 20 61 6e 64 20 in prevvals and
12470 70 75 74 20 74 68 65 20 65 6e 76 69 6f 6e 6d 65 put the envionme
12480 6e 74 20 62 61 63 6b 20 77 68 65 6e 20 64 6f 6e nt back when don
12490 65 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 e. (debug:p
124a0 72 69 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d rint 4 *default-
124b0 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 75 6c 6c 63 log-port* "fullc
124c0 6d 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a 20 md: " fullcmd).
124d0 20 20 20 20 20 28 73 65 74 21 20 2a 6c 61 73 74 (set! *last
124e0 2d 6c 61 75 6e 63 68 2a 20 28 63 75 72 72 65 6e -launch* (curren
124f0 74 2d 73 65 63 6f 6e 64 73 29 29 20 3b 3b 20 61 t-seconds)) ;; a
12500 6c 6c 20 74 68 61 74 20 6a 75 6e 6b 20 61 62 6f ll that junk abo
12510 76 65 20 74 61 6b 65 73 20 74 69 6d 65 2c 20 73 ve takes time, s
12520 65 74 20 74 68 69 73 20 61 73 20 6c 61 74 65 20 et this as late
12530 61 73 20 70 6f 73 73 69 62 6c 65 2e 0a 20 20 20 as possible..
12540 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f (let* ((commo
12550 6e 70 72 65 76 76 61 6c 73 20 28 61 6c 69 73 74 nprevvals (alist
12560 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 ->env-vars....
12570 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
12580 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e ref/default *con
12590 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 figdat* "env-ove
125a0 72 72 69 64 65 22 20 27 28 29 29 29 29 0a 09 20 rride" '())))..
125b0 20 20 20 20 28 6d 69 73 63 70 72 65 76 76 61 6c (miscprevval
125c0 73 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d s (alist->env-
125d0 76 61 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 vars ;; consolid
125e0 61 74 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 ate this code wi
125f0 74 68 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d th the code in m
12600 65 67 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 egatest.scm for
12610 22 2d 65 78 65 63 75 74 65 22 0a 09 09 09 20 20 "-execute"....
12620 20 20 20 20 28 61 70 70 65 6e 64 20 28 6c 69 73 (append (lis
12630 74 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 t (list "MT_TEST
12640 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 6b 2d 61 _RUN_DIR" work-a
12650 72 65 61 29 0a 09 09 09 09 09 20 20 20 20 28 6c rea)...... (l
12660 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d ist "MT_TEST_NAM
12670 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a 09 09 E" test-name)...
12680 09 09 09 20 20 20 20 28 6c 69 73 74 20 22 4d 54 ... (list "MT
12690 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e _ITEM_INFO" (con
126a0 63 20 69 74 65 6d 64 61 74 29 29 20 0a 09 09 09 c itemdat)) ....
126b0 09 09 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f .. (list "MT_
126c0 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 6e 6e 61 RUNNAME" runna
126d0 6d 65 29 0a 09 09 09 09 09 20 20 20 20 28 6c 69 me)...... (li
126e0 73 74 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 st "MT_TARGET"
126f0 20 20 6d 74 5f 74 61 72 67 65 74 29 0a 09 09 09 mt_target)....
12700 09 09 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f .. (list "MT_
12710 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d 2d ITEMPATH" item-
12720 70 61 74 68 29 0a 09 09 09 09 09 20 20 20 20 29 path)...... )
12730 0a 09 09 09 09 20 20 20 20 20 20 69 74 65 6d 64 ..... itemd
12740 61 74 29 29 29 0a 09 20 20 20 20 20 28 74 65 73 at))).. (tes
12750 74 70 72 65 76 76 61 6c 73 20 20 20 28 61 6c 69 tprevvals (ali
12760 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 st->env-vars....
12770 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
12780 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 63 e-ref/default tc
12790 6f 6e 66 69 67 20 22 70 72 65 2d 6c 61 75 6e 63 onfig "pre-launc
127a0 68 2d 65 6e 76 2d 6f 76 65 72 72 69 64 65 73 22 h-env-overrides"
127b0 20 27 28 29 29 29 29 0a 09 20 20 20 20 20 3b 3b '()))).. ;;
127c0 20 4c 61 75 6e 63 68 77 61 69 74 20 64 65 66 61 Launchwait defa
127d0 75 6c 74 73 20 74 6f 20 74 72 75 65 2c 20 6d 75 ults to true, mu
127e0 73 74 20 6f 76 65 72 72 69 64 65 20 69 74 20 74 st override it t
127f0 6f 20 74 75 72 6e 20 6f 66 66 20 77 61 69 74 0a o turn off wait.
12800 09 20 20 20 20 20 28 6c 61 75 6e 63 68 77 61 69 . (launchwai
12810 74 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c t (if (equal
12820 3f 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 ? (configf:looku
12830 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
12840 65 74 75 70 22 20 22 6c 61 75 6e 63 68 77 61 69 etup" "launchwai
12850 74 22 29 20 22 6e 6f 22 29 20 23 66 20 23 74 29 t") "no") #f #t)
12860 29 0a 09 20 20 20 20 20 28 6c 61 75 6e 63 68 2d ).. (launch-
12870 72 65 73 75 6c 74 73 20 28 61 70 70 6c 79 20 28 results (apply (
12880 69 66 20 6c 61 75 6e 63 68 77 61 69 74 0a 09 09 if launchwait...
12890 09 09 09 70 72 6f 63 65 73 73 3a 63 6d 64 2d 72 ...process:cmd-r
128a0 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 72 2d 3e un-with-stderr->
128b0 6c 69 73 74 0a 09 09 09 09 09 70 72 6f 63 65 73 list......proces
128c0 73 2d 72 75 6e 29 0a 09 09 09 09 20 20 20 20 28 s-run)..... (
128d0 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 if useshell.....
128e0 09 28 6c 65 74 20 28 28 63 6d 64 73 74 72 20 28 .(let ((cmdstr (
128f0 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12900 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 29 se fullcmd " "))
12910 29 0a 09 09 09 09 09 20 20 28 69 66 20 6c 61 75 )...... (if lau
12920 6e 63 68 77 61 69 74 0a 09 09 09 09 09 20 20 20 nchwait......
12930 20 20 20 63 6d 64 73 74 72 0a 09 09 09 09 09 20 cmdstr......
12940 20 20 20 20 20 28 63 6f 6e 63 20 63 6d 64 73 74 (conc cmdst
12950 72 20 22 20 3e 3e 20 6d 74 5f 6c 61 75 6e 63 68 r " >> mt_launch
12960 2e 6c 6f 67 20 32 3e 26 31 20 26 22 29 29 29 0a .log 2>&1 &"))).
12970 09 09 09 09 09 28 63 61 72 20 66 75 6c 6c 63 6d .....(car fullcm
12980 64 29 29 0a 09 09 09 09 20 20 20 20 28 69 66 20 d))..... (if
12990 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 09 27 28 useshell......'(
129a0 29 0a 09 09 09 09 09 28 63 64 72 20 66 75 6c 6c )......(cdr full
129b0 63 6d 64 29 29 29 29 29 0a 20 20 20 20 20 20 20 cmd))))).
129c0 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
129d0 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 *launch-setup-mu
129e0 74 65 78 2a 29 20 3b 3b 20 79 65 73 2c 20 72 65 tex*) ;; yes, re
129f0 61 6c 6c 79 20 73 68 6f 75 6c 64 20 6d 75 74 65 ally should mute
12a00 78 20 61 6c 6c 20 74 68 65 20 77 61 79 20 74 6f x all the way to
12a10 20 68 65 72 65 2e 20 4e 65 65 64 20 74 6f 20 70 here. Need to p
12a20 75 74 20 74 68 69 73 20 65 6e 74 69 72 65 20 70 ut this entire p
12a30 72 6f 63 65 73 73 20 69 6e 74 6f 20 61 20 66 6f rocess into a fo
12a40 72 6b 2e 0a 09 3b 3b 20 28 72 6d 74 3a 6e 6f 2d rk...;; (rmt:no-
12a50 73 79 6e 63 2d 64 65 6c 21 20 6c 6f 63 6b 2d 6b sync-del! lock-k
12a60 65 79 29 20 20 20 20 20 20 20 20 20 3b 3b 20 72 ey) ;; r
12a70 65 6c 65 61 73 65 20 74 68 65 20 6c 6f 63 6b 20 elease the lock
12a80 66 6f 72 20 73 74 61 72 74 69 6e 67 20 74 68 69 for starting thi
12a90 73 20 74 65 73 74 0a 09 28 69 66 20 28 6e 6f 74 s test..(if (not
12aa0 20 6c 61 75 6e 63 68 77 61 69 74 29 20 3b 3b 20 launchwait) ;;
12ab0 67 69 76 65 20 74 68 65 20 4f 53 20 61 20 6c 69 give the OS a li
12ac0 74 74 6c 65 20 74 69 6d 65 20 74 6f 20 61 6c 6c ttle time to all
12ad0 6f 77 20 74 68 65 20 70 72 6f 63 65 73 73 20 74 ow the process t
12ae0 6f 20 73 74 61 72 74 0a 09 20 20 20 20 28 74 68 o start.. (th
12af0 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 read-sleep! 0.01
12b00 29 29 0a 09 28 77 69 74 68 2d 6f 75 74 70 75 74 ))..(with-output
12b10 2d 74 6f 2d 66 69 6c 65 20 22 6d 74 5f 6c 61 75 -to-file "mt_lau
12b20 6e 63 68 2e 6c 6f 67 22 0a 09 20 20 28 6c 61 6d nch.log".. (lam
12b30 62 64 61 20 28 29 0a 09 20 20 20 20 28 70 72 69 bda ().. (pri
12b40 6e 74 20 22 4c 41 55 4e 43 48 43 4d 44 3a 20 22 nt "LAUNCHCMD: "
12b50 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
12b60 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 erse fullcmd " "
12b70 29 29 0a 09 20 20 20 20 28 69 66 20 28 6c 69 73 )).. (if (lis
12b80 74 3f 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 t? launch-result
12b90 73 29 0a 09 09 28 61 70 70 6c 79 20 70 72 69 6e s)...(apply prin
12ba0 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 t launch-results
12bb0 29 0a 09 09 28 70 72 69 6e 74 20 22 4e 4f 54 45 )...(print "NOTE
12bc0 3a 20 6c 61 75 6e 63 68 65 64 20 5c 22 22 20 66 : launched \"" f
12bd0 75 6c 6c 63 6d 64 20 22 5c 22 5c 6e 20 20 62 75 ullcmd "\"\n bu
12be0 74 20 64 69 64 20 6e 6f 74 20 77 61 69 74 20 66 t did not wait f
12bf0 6f 72 20 69 74 20 74 6f 20 70 72 6f 63 65 65 64 or it to proceed
12c00 2e 20 41 64 64 20 74 68 65 20 66 6f 6c 6c 6f 77 . Add the follow
12c10 69 6e 67 20 74 6f 20 6d 65 67 61 74 65 73 74 2e ing to megatest.
12c20 63 6f 6e 66 69 67 20 5c 6e 5b 73 65 74 75 70 5d config \n[setup]
12c30 5c 6e 6c 61 75 6e 63 68 77 61 69 74 20 79 65 73 \nlaunchwait yes
12c40 5c 6e 20 20 69 66 20 79 6f 75 20 68 61 76 65 20 \n if you have
12c50 70 72 6f 62 6c 65 6d 73 20 77 69 74 68 20 74 68 problems with th
12c60 69 73 22 29 29 0a 09 20 20 20 20 23 3a 61 70 70 is")).. #:app
12c70 65 6e 64 29 29 0a 09 28 64 65 62 75 67 3a 70 72 end))..(debug:pr
12c80 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
12c90 6f 67 2d 70 6f 72 74 2a 20 22 4c 61 75 6e 63 68 og-port* "Launch
12ca0 69 6e 67 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 ing completed, u
12cb0 70 64 61 74 69 6e 67 20 64 62 22 29 0a 09 28 64 pdating db")..(d
12cc0 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
12cd0 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
12ce0 22 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a "Launch results:
12cf0 20 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 " launch-result
12d00 73 29 0a 09 28 69 66 20 28 6e 6f 74 20 6c 61 75 s)..(if (not lau
12d10 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 nch-results)..
12d20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
12d30 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 46 (print "ERROR: F
12d40 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 22 20 28 ailed to run " (
12d50 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
12d60 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 29 20 se fullcmd " ")
12d70 22 2c 20 65 78 69 74 69 6e 67 20 6e 6f 77 22 29 ", exiting now")
12d80 0a 09 20 20 20 20 20 20 3b 3b 20 28 73 71 6c 69 .. ;; (sqli
12d90 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
12da0 29 0a 09 20 20 20 20 20 20 3b 3b 20 67 6f 6f 64 ).. ;; good
12db0 20 6f 6c 65 20 22 65 78 69 74 22 20 73 65 65 6d ole "exit" seem
12dc0 73 20 6e 6f 74 20 74 6f 20 77 6f 72 6b 0a 09 20 s not to work..
12dd0 20 20 20 20 20 3b 3b 20 28 5f 65 78 69 74 20 39 ;; (_exit 9
12de0 29 0a 09 20 20 20 20 20 20 3b 3b 20 62 75 74 20 ).. ;; but
12df0 74 68 69 73 20 68 61 63 6b 20 77 69 6c 6c 20 77 this hack will w
12e00 6f 72 6b 21 20 54 68 61 6e 6b 73 20 67 6f 20 74 ork! Thanks go t
12e10 6f 20 41 6c 61 6e 20 50 6f 73 74 20 6f 66 20 74 o Alan Post of t
12e20 68 65 20 43 68 69 63 6b 65 6e 20 65 6d 61 69 6c he Chicken email
12e30 20 6c 69 73 74 0a 09 20 20 20 20 20 20 3b 3b 20 list.. ;;
12e40 4e 42 2f 2f 20 49 73 20 74 68 69 73 20 73 74 69 NB// Is this sti
12e50 6c 6c 20 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c ll needed? Shoul
12e60 64 20 62 65 20 73 61 66 65 20 74 6f 20 67 6f 20 d be safe to go
12e70 62 61 63 6b 20 74 6f 20 22 65 78 69 74 22 20 6e back to "exit" n
12e80 6f 77 3f 0a 09 20 20 20 20 20 20 28 70 72 6f 63 ow?.. (proc
12e90 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 72 72 ess-signal (curr
12ea0 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 29 20 ent-process-id)
12eb0 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 09 20 20 signal/kill)..
12ec0 20 20 20 20 29 29 0a 09 28 61 6c 69 73 74 2d 3e ))..(alist->
12ed0 65 6e 76 2d 76 61 72 73 20 6d 69 73 63 70 72 65 env-vars miscpre
12ee0 76 76 61 6c 73 29 0a 09 28 61 6c 69 73 74 2d 3e vvals)..(alist->
12ef0 65 6e 76 2d 76 61 72 73 20 74 65 73 74 70 72 65 env-vars testpre
12f00 76 76 61 6c 73 29 0a 09 28 61 6c 69 73 74 2d 3e vvals)..(alist->
12f10 65 6e 76 2d 76 61 72 73 20 63 6f 6d 6d 6f 6e 70 env-vars commonp
12f20 72 65 76 76 61 6c 73 29 0a 09 6c 61 75 6e 63 68 revvals)..launch
12f30 2d 72 65 73 75 6c 74 73 29 29 0a 20 20 20 20 28 -results)). (
12f40 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
12f50 20 2a 74 6f 70 70 61 74 68 2a 29 29 29 0a 0a 3b *toppath*)))..;
12f60 3b 20 72 65 63 6f 76 65 72 20 61 20 74 65 73 74 ; recover a test
12f70 20 77 68 65 72 65 20 74 68 65 20 74 6f 70 20 63 where the top c
12f80 6f 6e 74 72 6f 6c 6c 69 6e 67 20 6d 74 65 73 74 ontrolling mtest
12f90 20 6d 61 79 20 68 61 76 65 20 64 69 65 64 0a 3b may have died.;
12fa0 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ;.(define (launc
12fb0 68 3a 72 65 63 6f 76 65 72 2d 74 65 73 74 20 72 h:recover-test r
12fc0 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 un-id test-id).
12fd0 20 3b 3b 20 74 68 69 73 20 66 75 6e 63 74 69 6f ;; this functio
12fe0 6e 20 69 73 20 63 61 6c 6c 65 64 20 6f 6e 20 74 n is called on t
12ff0 68 65 20 74 65 73 74 20 72 75 6e 20 68 6f 73 74 he test run host
13000 20 76 69 61 20 73 73 68 0a 20 20 3b 3b 0a 20 20 via ssh. ;;.
13010 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 61 74 20 74 68 ;; 1. look at th
13020 65 20 70 72 6f 63 65 73 73 20 66 72 6f 6d 20 70 e process from p
13030 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 69 73 20 id. ;; - is
13040 69 74 20 6f 77 6e 65 64 20 62 79 20 63 61 6c 6c it owned by call
13050 69 6e 67 20 75 73 65 72 0a 20 20 3b 3b 20 20 20 ing user. ;;
13060 20 2d 20 69 74 20 69 74 27 73 20 72 75 6e 20 64 - it it's run d
13070 69 72 65 63 74 6f 72 79 20 63 6f 72 72 65 63 74 irectory correct
13080 20 66 6f 72 20 74 68 65 20 74 65 73 74 0a 20 20 for the test.
13090 3b 3b 20 20 20 20 2d 20 69 73 20 74 68 65 72 65 ;; - is there
130a0 20 61 20 63 6f 6e 74 72 6f 6c 6c 69 6e 67 20 6d a controlling m
130b0 74 65 73 74 20 28 6d 61 79 62 65 20 73 74 75 63 test (maybe stuc
130c0 6b 29 0a 20 20 3b 3b 20 32 2e 20 69 66 20 72 65 k). ;; 2. if re
130d0 63 6f 76 65 72 79 20 69 73 20 6e 65 65 64 65 64 covery is needed
130e0 20 77 61 74 63 68 20 70 69 64 0a 20 20 3b 3b 20 watch pid. ;;
130f0 20 20 20 2d 20 77 68 65 6e 20 69 74 20 65 78 69 - when it exi
13100 74 73 20 74 61 6b 65 20 74 68 65 20 65 78 69 74 ts take the exit
13110 20 63 6f 64 65 20 61 6e 64 20 64 6f 20 74 68 65 code and do the
13120 20 6e 65 65 64 66 75 6c 0a 20 20 3b 3b 0a 20 20 needful. ;;.
13130 28 6c 65 74 2a 20 28 28 70 69 64 20 28 72 6d 74 (let* ((pid (rmt
13140 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 :test-get-top-pr
13150 6f 63 65 73 73 2d 69 64 20 72 75 6e 2d 69 64 20 ocess-id run-id
13160 74 65 73 74 2d 69 64 29 29 0a 09 20 28 70 73 72 test-id)).. (psr
13170 65 73 20 28 77 69 74 68 2d 69 6e 70 75 74 2d 66 es (with-input-f
13180 72 6f 6d 2d 70 69 70 65 0a 09 09 20 28 63 6f 6e rom-pipe... (con
13190 63 20 22 70 73 20 2d 46 20 2d 75 20 22 20 28 63 c "ps -F -u " (c
131a0 75 72 72 65 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 urrent-user-name
131b0 29 20 22 20 7c 20 67 72 65 70 20 2d 45 20 27 22 ) " | grep -E '"
131c0 20 70 69 64 20 22 20 27 20 7c 20 67 72 65 70 20 pid " ' | grep
131d0 2d 76 20 27 67 72 65 70 20 2d 45 20 22 20 70 69 -v 'grep -E " pi
131e0 64 20 22 27 22 29 0a 09 09 20 28 6c 61 6d 62 64 d "'")... (lambd
131f0 61 20 28 29 0a 09 09 20 20 20 28 72 65 61 64 2d a ()... (read-
13200 6c 69 6e 65 29 29 29 29 0a 09 20 28 72 75 6e 64 line)))).. (rund
13210 69 72 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 ir (if (string?
13220 70 73 72 65 73 29 20 3b 3b 20 72 65 61 6c 20 70 psres) ;; real p
13230 72 6f 63 65 73 73 20 6f 77 6e 65 64 20 62 79 20 rocess owned by
13240 75 73 65 72 0a 09 09 20 20 20 20 20 28 72 65 61 user... (rea
13250 64 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 d-symbolic-link
13260 28 63 6f 6e 63 20 22 2f 70 72 6f 63 2f 22 20 70 (conc "/proc/" p
13270 69 64 20 22 2f 63 77 64 22 29 29 0a 09 09 20 20 id "/cwd"))...
13280 20 20 20 23 66 29 29 29 0a 20 20 20 20 3b 3b 20 #f))). ;;
13290 6e 6f 77 20 77 61 69 74 20 6f 6e 20 74 68 61 74 now wait on that
132a0 20 70 72 6f 63 65 73 73 20 69 66 20 61 6c 6c 20 process if all
132b0 69 73 20 63 6f 72 72 65 63 74 0a 20 20 20 20 3b is correct. ;
132c0 3b 20 70 65 72 69 6f 64 69 63 61 6c 6c 79 20 75 ; periodically u
132d0 70 64 61 74 65 20 74 68 65 20 64 62 20 77 69 74 pdate the db wit
132e0 68 20 72 75 6e 74 69 6d 65 0a 20 20 20 20 3b 3b h runtime. ;;
132f0 20 77 68 65 6e 20 74 68 65 20 70 72 6f 63 65 73 when the proces
13300 73 20 65 78 69 74 73 20 6c 6f 6f 6b 20 61 74 20 s exits look at
13310 74 68 65 20 64 62 2c 20 69 66 20 73 74 69 6c 6c the db, if still
13320 20 52 55 4e 4e 49 4e 47 20 61 66 74 65 72 20 31 RUNNING after 1
13330 30 20 73 65 63 6f 6e 64 73 20 73 65 74 0a 20 20 0 seconds set.
13340 20 20 3b 3b 20 73 74 61 74 65 2f 73 74 61 74 75 ;; state/statu
13350 73 20 61 70 70 72 6f 70 72 69 61 74 65 6c 79 0a s appropriately.
13360 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 61 69 (process-wai
13370 74 20 70 69 64 29 29 29 0a t pid))).