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 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d 3d 3d 3d nses/>...;;=====
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0340: 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 74 61 =.;; launch a ta
0350: 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 20 6f sk - this runs o
0360: 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 69 6e n the originatin
0370: 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 74 68 g host, tests th
0380: 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b 3d 3d emselves.;;.;;==
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 0a 0a 28 64 65 63 6c 61 72 65 20 28 ====..(declare (
03e0: 75 6e 69 74 20 6c 61 75 6e 63 68 29 29 0a 28 64 unit launch)).(d
03f0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 73 75 62 eclare (uses sub
0400: 72 75 6e 29 29 0a 28 64 65 63 6c 61 72 65 20 28 run)).(declare (
0410: 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 uses common)).(d
0420: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 65 62 eclare (uses deb
0430: 75 67 70 72 69 6e 74 29 29 0a 28 64 65 63 6c 61 ugprint)).(decla
0440: 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 6d re (uses commonm
0450: 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 od)).(declare (u
0460: 73 65 73 20 63 6f 6e 66 69 67 66 29 29 0a 28 64 ses configf)).(d
0470: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 eclare (uses db)
0480: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0490: 20 72 6d 74 6d 6f 64 29 29 0a 28 64 65 63 6c 61 rmtmod)).(decla
04a0: 72 65 20 28 75 73 65 73 20 65 7a 73 74 65 70 73 re (uses ezsteps
04b0: 29 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 )).;; (declare (
04c0: 75 73 65 73 20 64 62 6d 6f 64 29 29 0a 28 64 65 uses dbmod)).(de
04d0: 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 66 69 clare (uses dbfi
04e0: 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 le)).(declare (u
04f0: 73 65 73 20 6d 74 61 72 67 73 29 29 0a 0a 28 75 ses mtargs))..(u
0500: 73 65 20 72 65 67 65 78 20 72 65 67 65 78 2d 63 se regex regex-c
0510: 61 73 65 20 62 61 73 65 36 34 20 73 71 6c 69 74 ase base64 sqlit
0520: 65 33 20 73 72 66 69 2d 31 38 20 64 69 72 65 63 e3 srfi-18 direc
0530: 74 6f 72 79 2d 75 74 69 6c 73 20 70 6f 73 69 78 tory-utils posix
0540: 20 70 6f 73 69 78 2d 65 78 74 72 61 73 20 7a 33 posix-extras z3
0550: 0a 20 20 20 20 20 63 61 6c 6c 2d 77 69 74 68 2d . call-with-
0560: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
0570: 61 62 6c 65 73 20 63 73 76 20 68 6f 73 74 69 6e ables csv hostin
0580: 66 6f 20 0a 20 20 20 20 20 74 79 70 65 64 2d 72 fo . typed-r
0590: 65 63 6f 72 64 73 20 70 61 74 68 6e 61 6d 65 2d ecords pathname-
05a0: 65 78 70 61 6e 64 20 6d 61 74 63 68 61 62 6c 65 expand matchable
05b0: 29 0a 0a 28 69 6d 70 6f 72 74 20 28 70 72 65 66 )..(import (pref
05c0: 69 78 20 62 61 73 65 36 34 20 62 61 73 65 36 34 ix base64 base64
05d0: 3a 29 0a 09 28 70 72 65 66 69 78 20 73 71 6c 69 :)..(prefix sqli
05e0: 74 65 33 20 73 71 6c 69 74 65 33 3a 29 0a 09 28 te3 sqlite3:)..(
05f0: 70 72 65 66 69 78 20 6d 74 61 72 67 73 20 61 72 prefix mtargs ar
0600: 67 73 3a 29 0a 29 0a 0a 28 69 6e 63 6c 75 64 65 gs:).)..(include
0610: 20 22 63 6f 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 "common_records
0620: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
0630: 22 6b 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d "key_records.scm
0640: 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f ").(include "db_
0650: 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 records.scm").(i
0660: 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 nclude "megatest
0670: 2d 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d -fossil-hash.scm
0680: 22 29 0a 0a 28 69 6d 70 6f 72 74 20 63 6f 6d 6d ")..(import comm
0690: 6f 6e 6d 6f 64 0a 09 72 6d 74 6d 6f 64 0a 09 64 onmod..rmtmod..d
06a0: 65 62 75 67 70 72 69 6e 74 0a 09 3b 3b 20 64 62 ebugprint..;; db
06b0: 6d 6f 64 0a 09 64 62 66 69 6c 65 29 0a 0a 3b 3b mod..dbfile)..;;
06c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 65 70 ======.;; ezstep
0710: 73 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d s.;;============
0720: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 65 ==========..;; e
0760: 7a 73 74 65 70 73 20 77 65 72 65 20 67 6f 69 6e zsteps were goin
0770: 67 20 74 6f 20 62 65 20 63 6f 64 65 64 20 61 73 g to be coded as
0780: 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 5b 2c 70 72 .;; stepname[,pr
0790: 65 64 73 74 65 70 31 2c 70 72 65 64 73 74 65 70 edstep1,predstep
07a0: 32 20 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d 66 69 2 ...] [{VAR1=fi
07b0: 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 rst,second,third
07c0: 7d 5d 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 65 78 }] command to ex
07d0: 65 63 75 74 65 0a 3b 3b 20 20 20 42 55 54 0a 3b ecute.;; BUT.;
07e0: 3b 20 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 74 65 ; now are.;; ste
07f0: 70 6e 61 6d 65 20 7b 56 41 52 3d 66 69 72 73 74 pname {VAR=first
0800: 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 20 2e 2e ,second,third ..
0810: 2e 7d 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 0a 3b .} command ....;
0820: 3b 20 77 68 65 72 65 20 74 68 65 20 7b 56 41 52 ; where the {VAR
0830: 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 =first,second,th
0840: 69 72 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 74 69 ird ...} is opti
0850: 6f 6e 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 6e 20 onal...;; given
0860: 61 6e 20 65 78 69 74 20 63 6f 64 65 20 61 6e 64 an exit code and
0870: 20 77 68 65 74 68 65 72 20 6f 72 20 6e 6f 74 20 whether or not
0880: 6c 6f 67 70 72 6f 20 77 61 73 20 75 73 65 64 20 logpro was used
0890: 63 61 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 41 44 calculate OK/BAD
08a0: 0a 3b 3b 20 72 65 74 75 72 6e 20 23 74 20 69 66 .;; return #t if
08b0: 20 77 65 20 61 72 65 20 6f 6b 2c 20 23 66 20 6f we are ok, #f o
08c0: 74 68 65 72 77 69 73 65 0a 28 64 65 66 69 6e 65 therwise.(define
08d0: 20 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 (steprun-good?
08e0: 6c 6f 67 70 72 6f 20 65 78 69 74 63 6f 64 65 20 logpro exitcode
08f0: 73 74 65 70 70 61 72 6d 73 29 0a 20 20 28 6f 72 stepparms). (or
0900: 20 28 65 71 3f 20 65 78 69 74 63 6f 64 65 20 30 (eq? exitcode 0
0910: 29 0a 20 20 20 20 20 20 28 61 6e 64 20 6c 6f 67 ). (and log
0920: 70 72 6f 20 20 28 6d 65 6d 62 65 72 20 65 78 69 pro (member exi
0930: 74 63 6f 64 65 20 27 28 20 32 20 34 20 36 29 29 tcode '( 2 4 6))
0940: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
0950: 70 61 72 61 6d 73 20 28 61 6c 69 73 74 2d 72 65 params (alist-re
0960: 66 20 27 70 61 72 61 6d 73 20 73 74 65 70 70 61 f 'params steppa
0970: 72 6d 73 29 29 20 3b 3b 20 67 65 74 20 74 68 65 rms)) ;; get the
0980: 20 70 61 72 61 6d 73 20 73 65 63 74 69 6f 6e 0a params section.
0990: 09 20 20 20 20 20 28 6b 65 65 70 2d 67 6f 69 6e . (keep-goin
09a0: 67 20 28 69 66 20 70 61 72 61 6d 73 0a 09 09 09 g (if params....
09b0: 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 (alist-ref
09c0: 22 6b 65 65 70 2d 67 6f 69 6e 67 22 20 70 61 72 "keep-going" par
09d0: 61 6d 73 20 65 71 75 61 6c 3f 29 0a 09 09 09 20 ams equal?)....
09e0: 20 20 20 20 23 66 29 29 29 0a 09 28 64 65 62 75 #f)))..(debu
09f0: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
0a00: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6b 65 lt-log-port* "ke
0a10: 65 70 2d 67 6f 69 6e 67 3d 22 20 6b 65 65 70 2d ep-going=" keep-
0a20: 67 6f 69 6e 67 29 0a 09 28 61 6e 64 20 6b 65 65 going)..(and kee
0a30: 70 2d 67 6f 69 6e 67 20 28 65 71 75 61 6c 3f 20 p-going (equal?
0a40: 28 63 61 72 20 6b 65 65 70 2d 67 6f 69 6e 67 29 (car keep-going)
0a50: 20 22 79 65 73 22 29 29 29 29 29 0a 0a 3b 3b 20 "yes")))))..;;
0a60: 69 66 20 68 61 6e 64 65 64 20 61 20 73 74 72 69 if handed a stri
0a70: 6e 67 2c 20 70 72 6f 63 65 73 73 20 69 74 2c 20 ng, process it,
0a80: 65 6c 73 65 20 6c 6f 6f 6b 20 66 6f 72 20 4d 54 else look for MT
0a90: 5f 43 4d 44 49 4e 46 4f 0a 28 64 65 66 69 6e 65 _CMDINFO.(define
0aa0: 20 28 6c 61 75 6e 63 68 3a 67 65 74 2d 63 6d 64 (launch:get-cmd
0ab0: 69 6e 66 6f 2d 61 73 73 6f 63 2d 6c 69 73 74 20 info-assoc-list
0ac0: 23 21 6b 65 79 20 28 65 6e 63 6f 64 65 64 2d 63 #!key (encoded-c
0ad0: 6d 64 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 md #f)). (let (
0ae0: 28 65 6e 63 63 6d 64 20 28 69 66 20 65 6e 63 6f (enccmd (if enco
0af0: 64 65 64 2d 63 6d 64 20 65 6e 63 6f 64 65 64 2d ded-cmd encoded-
0b00: 63 6d 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f cmd (getenv "MT_
0b10: 43 4d 44 49 4e 46 4f 22 29 29 29 29 0a 20 20 20 CMDINFO")))).
0b20: 20 28 69 66 20 65 6e 63 63 6d 64 0a 09 28 63 6f (if enccmd..(co
0b30: 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 mmon:read-encode
0b40: 64 2d 73 74 72 69 6e 67 20 65 6e 63 63 6d 64 29 d-string enccmd)
0b50: 0a 09 27 28 29 29 29 29 0a 0a 3b 3b 20 20 20 20 ..'())))..;;
0b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b70: 20 20 20 30 20 20 20 20 20 20 20 20 20 20 20 31 0 1
0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 32 20 2
0b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 33 0a 28 3.(
0ba0: 64 65 66 73 74 72 75 63 74 20 6c 61 75 6e 63 68 defstruct launch
0bb0: 3a 65 69 6e 66 20 28 70 69 64 20 23 74 29 28 65 :einf (pid #t)(e
0bc0: 78 69 74 2d 73 74 61 74 75 73 20 23 74 29 28 65 xit-status #t)(e
0bd0: 78 69 74 2d 63 6f 64 65 20 23 74 29 28 72 6f 6c xit-code #t)(rol
0be0: 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 0a 0a lup-status 0))..
0bf0: 3b 3b 20 72 65 74 75 72 6e 20 28 63 6f 6e 63 20 ;; return (conc
0c00: 73 74 61 74 75 73 20 22 3a 20 22 20 63 6f 6d 6d status ": " comm
0c10: 65 6e 74 29 20 66 72 6f 6d 20 74 68 65 20 66 69 ent) from the fi
0c20: 6e 61 6c 20 73 65 63 74 69 6f 6e 20 73 6f 20 74 nal section so t
0c30: 68 61 74 0a 3b 3b 20 20 20 74 68 65 20 63 6f 6d hat.;; the com
0c40: 6d 65 6e 74 20 63 61 6e 20 62 65 20 73 65 74 20 ment can be set
0c50: 69 6e 20 74 68 65 20 73 74 65 70 20 72 65 63 6f in the step reco
0c60: 72 64 20 69 6e 20 6c 61 75 6e 63 68 2e 73 63 6d rd in launch.scm
0c70: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 .;;.(define (lau
0c80: 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d nch:load-logpro-
0c90: 64 61 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d dat run-id test-
0ca0: 69 64 20 73 74 65 70 6e 61 6d 65 29 0a 20 20 28 id stepname). (
0cb0: 6c 65 74 20 28 28 63 6e 61 6d 65 20 28 63 6f 6e let ((cname (con
0cc0: 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 74 c stepname ".dat
0cd0: 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 63 6f "))). (if (co
0ce0: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
0cf0: 3f 20 63 6e 61 6d 65 29 0a 09 28 6c 65 74 2a 20 ? cname)..(let*
0d00: 28 28 64 61 74 20 20 28 72 65 61 64 2d 63 6f 6e ((dat (read-con
0d10: 66 69 67 20 63 6e 61 6d 65 20 23 66 20 23 66 29 fig cname #f #f)
0d20: 29 0a 09 20 20 20 20 20 20 20 28 63 73 76 72 20 ).. (csvr
0d30: 28 64 62 3a 6c 6f 67 70 72 6f 2d 64 61 74 2d 3e (db:logpro-dat->
0d40: 63 73 76 20 64 61 74 20 73 74 65 70 6e 61 6d 65 csv dat stepname
0d50: 29 29 0a 09 20 20 20 20 20 20 20 28 63 73 76 74 )).. (csvt
0d60: 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 (let-values (((
0d70: 66 6d 74 2d 63 65 6c 6c 20 66 6d 74 2d 72 65 63 fmt-cell fmt-rec
0d80: 6f 72 64 20 66 6d 74 2d 63 73 76 29 20 28 6d 61 ord fmt-csv) (ma
0d90: 6b 65 2d 66 6f 72 6d 61 74 20 22 2c 22 29 29 29 ke-format ",")))
0da0: 0a 09 09 20 20 20 20 20 20 20 28 66 6d 74 2d 63 ... (fmt-c
0db0: 73 76 20 28 6d 61 70 20 6c 69 73 74 2d 3e 63 73 sv (map list->cs
0dc0: 76 2d 72 65 63 6f 72 64 20 63 73 76 72 29 29 29 v-record csvr)))
0dd0: 29 0a 09 20 20 20 20 20 20 20 28 73 74 61 74 75 ).. (statu
0de0: 73 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 s (configf:looku
0df0: 70 20 64 61 74 20 22 66 69 6e 61 6c 22 20 22 65 p dat "final" "e
0e00: 78 69 74 2d 73 74 61 74 75 73 22 29 29 0a 09 20 xit-status"))..
0e10: 20 20 20 20 20 20 28 6d 73 67 20 20 20 20 20 28 (msg (
0e20: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 configf:lookup d
0e30: 61 74 20 22 66 69 6e 61 6c 22 20 22 6d 65 73 73 at "final" "mess
0e40: 61 67 65 22 29 29 29 0a 20 20 20 20 20 20 20 20 age"))).
0e50: 20 20 28 69 66 20 63 73 76 74 20 20 3b 3b 20 74 (if csvt ;; t
0e60: 68 69 73 20 69 66 20 62 6c 6f 63 6b 65 64 20 73 his if blocked s
0e70: 74 61 63 6b 20 64 75 6d 70 20 63 61 75 73 65 64 tack dump caused
0e80: 20 62 79 20 2e 64 61 74 20 66 69 6c 65 20 66 72 by .dat file fr
0e90: 6f 6d 20 6c 6f 67 70 72 6f 20 62 65 69 6e 67 20 om logpro being
0ea0: 30 2d 62 79 74 65 2e 20 20 66 69 78 65 64 20 62 0-byte. fixed b
0eb0: 79 20 75 70 67 72 61 64 69 6e 67 20 6c 6f 67 70 y upgrading logp
0ec0: 72 6f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ro.
0ed0: 20 28 72 6d 74 3a 63 73 76 2d 3e 74 65 73 74 2d (rmt:csv->test-
0ee0: 64 61 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 data run-id test
0ef0: 2d 69 64 20 63 73 76 74 29 0a 09 20 20 20 20 20 -id csvt)..
0f00: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
0f10: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
0f20: 74 2a 20 22 45 52 52 4f 52 3a 20 6e 6f 20 63 73 t* "ERROR: no cs
0f30: 76 64 61 74 20 65 78 69 73 74 73 20 66 6f 72 20 vdat exists for
0f40: 72 75 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 run-id: " run-id
0f50: 20 22 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 " test-id: " te
0f60: 73 74 2d 69 64 20 22 20 73 74 65 70 6e 61 6d 65 st-id " stepname
0f70: 3a 20 22 20 73 74 65 70 6e 61 6d 65 20 22 2c 20 : " stepname ",
0f80: 63 68 65 63 6b 20 74 68 61 74 20 6c 6f 67 70 72 check that logpr
0f90: 6f 20 76 65 72 73 69 6f 6e 20 69 73 20 31 2e 31 o version is 1.1
0fa0: 35 20 6f 72 20 6e 65 77 65 72 22 29 29 0a 09 20 5 or newer"))..
0fb0: 20 3b 3b 20 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
0fc0: 74 2d 69 6e 66 6f 20 31 33 20 2a 64 65 66 61 75 t-info 13 *defau
0fd0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 72 lt-log-port* "Er
0fe0: 72 6f 72 3a 20 72 75 6e 2d 69 64 2f 74 65 73 74 ror: run-id/test
0ff0: 2d 69 64 2f 73 74 65 70 6e 61 6d 65 3d 22 72 75 -id/stepname="ru
1000: 6e 2d 69 64 22 2f 22 74 65 73 74 2d 69 64 22 2f n-id"/"test-id"/
1010: 22 73 74 65 70 6e 61 6d 65 22 20 3d 3e 20 62 61 "stepname" => ba
1020: 64 20 63 73 76 72 3d 22 63 73 76 72 29 0a 09 20 d csvr="csvr)..
1030: 20 3b 3b 20 20 29 0a 09 20 20 28 63 6f 6e 64 0a ;; ).. (cond.
1040: 09 20 20 20 28 28 65 71 75 61 6c 3f 20 73 74 61 . ((equal? sta
1050: 74 75 73 20 22 50 41 53 53 22 29 20 22 50 41 53 tus "PASS") "PAS
1060: 53 22 29 20 3b 3b 20 73 6b 69 70 20 74 68 65 20 S") ;; skip the
1070: 6d 65 73 73 61 67 65 20 70 61 72 74 20 69 66 20 message part if
1080: 73 74 61 74 75 73 20 69 73 20 70 61 73 73 0a 09 status is pass..
1090: 20 20 20 28 73 74 61 74 75 73 20 28 63 6f 6e 63 (status (conc
10a0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
10b0: 20 64 61 74 20 22 66 69 6e 61 6c 22 20 22 65 78 dat "final" "ex
10c0: 69 74 2d 73 74 61 74 75 73 22 29 20 22 3a 20 22 it-status") ": "
10d0: 20 28 69 66 20 6d 73 67 20 6d 73 67 20 22 6e 6f (if msg msg "no
10e0: 20 6d 65 73 73 61 67 65 22 29 29 29 0a 09 20 20 message")))..
10f0: 20 28 65 6c 73 65 20 23 66 29 29 29 0a 09 23 66 (else #f)))..#f
1100: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 )))..(define (la
1110: 75 6e 63 68 3a 6d 61 6e 61 67 65 2d 73 74 65 70 unch:manage-step
1120: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
1130: 20 69 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 item-path fullr
1140: 75 6e 73 63 72 69 70 74 20 65 7a 73 74 65 70 73 unscript ezsteps
1150: 20 73 75 62 72 75 6e 20 74 65 73 74 2d 6e 61 6d subrun test-nam
1160: 65 20 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 e tconfigreg exi
1170: 74 2d 69 6e 66 6f 20 6d 29 0a 20 20 3b 3b 20 28 t-info m). ;; (
1180: 6c 65 74 2d 76 61 6c 75 65 73 0a 20 20 3b 3b 20 let-values. ;;
1190: 20 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 (((pid exit-sta
11a0: 74 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 20 tus exit-code).
11b0: 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 ;; (run-n-wa
11c0: 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 it fullrunscript
11d0: 29 29 29 0a 20 20 3b 3b 20 28 74 65 73 74 73 3a ))). ;; (tests:
11e0: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
11f0: 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e test-id "RUNNIN
1200: 47 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 0a G" "n/a" #f #f).
1210: 20 20 3b 3b 20 53 69 6e 63 65 20 77 65 20 73 68 ;; Since we sh
1220: 6f 75 6c 64 20 68 61 76 65 20 61 20 63 6c 65 61 ould have a clea
1230: 6e 20 73 6c 61 74 65 20 61 74 20 74 68 69 73 20 n slate at this
1240: 74 69 6d 65 20 74 68 65 72 65 20 69 73 20 6e 6f time there is no
1250: 20 6e 65 65 64 20 74 6f 20 64 6f 20 0a 20 20 3b need to do . ;
1260: 3b 20 61 6e 79 20 6f 66 20 74 68 65 20 6f 74 68 ; any of the oth
1270: 65 72 20 73 74 75 66 66 20 74 68 61 74 20 74 65 er stuff that te
1280: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
1290: 74 75 73 21 20 64 6f 65 73 2e 20 4c 65 74 27 73 tus! does. Let's
12a0: 20 6a 75 73 74 20 0a 20 20 3b 3b 20 66 6f 72 63 just . ;; forc
12b0: 65 20 52 55 4e 4e 49 4e 47 2f 6e 2f 61 0a 0a 20 e RUNNING/n/a..
12c0: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
12d0: 70 21 20 30 2e 33 29 0a 20 20 3b 3b 20 28 74 65 p! 0.3). ;; (te
12e0: 73 74 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 sts:test-force-s
12f0: 74 61 74 65 2d 73 74 61 74 75 73 21 20 72 75 6e tate-status! run
1300: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 52 55 4e -id test-id "RUN
1310: 4e 49 4e 47 22 20 22 6e 2f 61 22 29 0a 20 20 28 NING" "n/a"). (
1320: 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 rmt:set-state-st
1330: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
1340: 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 -items run-id te
1350: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
1360: 68 20 22 52 55 4e 4e 49 4e 47 22 20 23 66 20 23 h "RUNNING" #f #
1370: 66 29 20 0a 20 20 3b 3b 20 28 74 68 72 65 61 64 f) . ;; (thread
1380: 2d 73 6c 65 65 70 21 20 30 2e 33 29 20 3b 3b 20 -sleep! 0.3) ;;
1390: 4e 46 53 20 73 6c 6f 77 6e 65 73 73 20 68 61 73 NFS slowness has
13a0: 20 63 61 75 73 65 64 20 67 72 69 65 66 20 68 65 caused grief he
13b0: 72 65 0a 0a 20 20 3b 3b 20 69 66 20 74 68 65 72 re.. ;; if ther
13c0: 65 20 69 73 20 61 20 72 75 6e 73 63 72 69 70 74 e is a runscript
13d0: 20 64 6f 20 69 74 20 66 69 72 73 74 0a 20 20 28 do it first. (
13e0: 69 66 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 if fullrunscript
13f0: 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 . (let ((pi
1400: 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 d (process-run f
1410: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a ullrunscript))).
1420: 09 28 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 .(rmt:test-set-t
1430: 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 op-process-pid r
1440: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 un-id test-id pi
1450: 64 29 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 d)..(let loop ((
1460: 69 20 30 29 29 0a 09 20 20 28 6c 65 74 2d 76 61 i 0)).. (let-va
1470: 6c 75 65 73 0a 09 20 20 20 28 28 28 70 69 64 2d lues.. (((pid-
1480: 76 61 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 val exit-status
1490: 65 78 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 exit-code) (proc
14a0: 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 ess-wait pid #t)
14b0: 29 29 0a 09 20 20 20 28 6d 75 74 65 78 2d 6c 6f )).. (mutex-lo
14c0: 63 6b 21 20 6d 29 0a 09 20 20 20 28 6c 61 75 6e ck! m).. (laun
14d0: 63 68 3a 65 69 6e 66 2d 70 69 64 2d 73 65 74 21 ch:einf-pid-set!
14e0: 20 20 20 20 20 20 20 20 20 20 20 65 78 69 74 2d exit-
14f0: 69 6e 66 6f 20 20 70 69 64 29 20 20 20 20 20 20 info pid)
1500: 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 ;; (vector-se
1510: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 t! exit-info 0 p
1520: 69 64 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 3a id).. (launch:
1530: 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 einf-exit-status
1540: 2d 73 65 74 21 20 20 20 65 78 69 74 2d 69 6e 66 -set! exit-inf
1550: 6f 20 20 65 78 69 74 2d 73 74 61 74 75 73 29 20 o exit-status)
1560: 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 ;; (vector-set!
1570: 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 exit-info 1 exit
1580: 2d 73 74 61 74 75 73 29 0a 09 20 20 20 28 6c 61 -status).. (la
1590: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 unch:einf-exit-c
15a0: 6f 64 65 2d 73 65 74 21 20 20 20 20 20 65 78 69 ode-set! exi
15b0: 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d 63 6f 64 t-info exit-cod
15c0: 65 29 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d e) ;; (vector-
15d0: 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 set! exit-info 2
15e0: 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 20 20 20 exit-code)..
15f0: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
1600: 6c 75 70 2d 73 74 61 74 75 73 2d 73 65 74 21 20 lup-status-set!
1610: 65 78 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d exit-info exit-
1620: 63 6f 64 65 29 20 20 20 3b 3b 20 28 76 65 63 74 code) ;; (vect
1630: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
1640: 6f 20 33 20 65 78 69 74 2d 63 6f 64 65 29 20 20 o 3 exit-code)
1650: 3b 3b 20 72 6f 6c 6c 75 70 20 73 74 61 74 75 73 ;; rollup status
1660: 0a 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f .. (mutex-unlo
1670: 63 6b 21 20 6d 29 0a 09 20 20 20 28 69 66 20 28 ck! m).. (if (
1680: 65 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 eq? pid-val 0)..
1690: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 (begin...
16a0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
16b0: 32 29 0a 09 09 20 28 6c 6f 6f 70 20 28 2b 20 69 2)... (loop (+ i
16c0: 20 31 29 29 29 0a 09 20 20 20 20 20 20 20 29 29 1))).. ))
16d0: 29 29 29 0a 20 20 3b 3b 20 74 68 65 6e 2c 20 69 ))). ;; then, i
16e0: 66 20 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 f runscript ran
16f0: 6f 6b 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 ok (or did not g
1700: 65 74 20 63 61 6c 6c 65 64 29 0a 20 20 3b 3b 20 et called). ;;
1710: 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 do all the ezste
1720: 70 73 20 28 69 66 20 61 6e 79 29 0a 20 20 28 69 ps (if any). (i
1730: 66 20 28 6f 72 20 65 7a 73 74 65 70 73 20 73 75 f (or ezsteps su
1740: 62 72 75 6e 29 0a 20 20 20 20 20 20 28 6c 65 74 brun). (let
1750: 2a 20 28 28 74 65 73 74 2d 72 75 6e 2d 64 69 72 * ((test-run-dir
1760: 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 (tests:get-test
1770: 2d 70 61 74 68 2d 66 72 6f 6d 2d 65 6e 76 69 72 -path-from-envir
1780: 6f 6e 6d 65 6e 74 29 29 0a 20 20 20 20 20 20 20 onment)).
1790: 20 20 20 20 20 20 28 74 65 73 74 63 6f 6e 66 69 (testconfi
17a0: 67 20 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 g ;; (read-confi
17b0: 67 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 g (conc work-are
17c0: 61 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 a "/testconfig")
17d0: 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 #f #t environ-p
17e0: 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 att: "pre-launch
17f0: 2d 65 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b 20 -env-vars")) ;;
1800: 46 49 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f FIXME??? is allo
1810: 77 2d 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 65 w-system ok here
1820: 3f 0a 09 20 20 20 20 20 20 3b 3b 20 4e 4f 54 45 ?.. ;; NOTE
1830: 3a 20 69 74 20 69 73 20 74 65 6d 70 74 69 6e 67 : it is tempting
1840: 20 74 6f 20 74 75 72 6e 20 6f 66 66 20 66 6f 72 to turn off for
1850: 63 65 2d 63 72 65 61 74 65 20 6f 66 20 74 65 73 ce-create of tes
1860: 74 63 6f 6e 66 69 67 20 62 75 74 20 64 79 6e 61 tconfig but dyna
1870: 6d 69 63 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 mic.. ;;
1880: 20 20 20 20 65 7a 73 74 65 70 20 6e 61 6d 65 73 ezstep names
1890: 20 6e 65 65 64 20 61 20 66 75 6c 6c 20 72 65 2d need a full re-
18a0: 65 76 61 6c 20 68 65 72 65 2e 0a 09 20 20 20 20 eval here...
18b0: 20 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 (tests:get-tes
18c0: 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 6d tconfig test-nam
18d0: 65 20 69 74 65 6d 2d 70 61 74 68 20 74 63 6f 6e e item-path tcon
18e0: 66 69 67 72 65 67 20 23 74 20 66 6f 72 63 65 2d figreg #t force-
18f0: 63 72 65 61 74 65 3a 20 23 74 29 29 20 3b 3b 20 create: #t)) ;;
1900: 27 72 65 74 75 72 6e 2d 70 72 6f 63 73 29 29 29 'return-procs)))
1910: 0a 09 20 20 20 20 20 28 65 7a 73 74 65 70 73 6c .. (ezstepsl
1920: 73 74 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 st (if (hash-tab
1930: 6c 65 3f 20 74 65 73 74 63 6f 6e 66 69 67 29 0a le? testconfig).
1940: 09 09 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 ... (hash-ta
1950: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
1960: 74 65 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 testconfig "ezst
1970: 65 70 73 22 20 27 28 29 29 0a 09 09 09 20 20 20 eps" '())....
1980: 20 20 23 66 29 29 29 0a 09 28 69 66 20 74 65 73 #f)))..(if tes
1990: 74 63 6f 6e 66 69 67 0a 09 20 20 20 20 28 68 61 tconfig.. (ha
19a0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
19b0: 65 73 74 63 6f 6e 66 69 67 73 2a 20 74 65 73 74 estconfigs* test
19c0: 2d 6e 61 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 -name testconfig
19d0: 29 20 3b 3b 20 63 61 63 68 65 64 20 66 6f 72 20 ) ;; cached for
19e0: 6c 61 7a 79 20 72 65 61 64 73 20 6c 61 74 65 72 lazy reads later
19f0: 20 2e 2e 2e 0a 09 20 20 20 20 28 62 65 67 69 6e ..... (begin
1a00: 0a 09 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a .. (launch:
1a10: 73 65 74 75 70 29 0a 09 20 20 20 20 20 20 28 64 setup).. (d
1a20: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
1a30: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1a40: 22 57 41 52 4e 49 4e 47 3a 20 6e 6f 20 74 65 73 "WARNING: no tes
1a50: 74 63 6f 6e 66 69 67 20 66 6f 75 6e 64 20 66 6f tconfig found fo
1a60: 72 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 r " test-name "
1a70: 69 6e 20 73 65 61 72 63 68 20 70 61 74 68 3a 5c in search path:\
1a80: 6e 20 20 22 0a 09 09 09 20 20 20 28 73 74 72 69 n ".... (stri
1a90: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
1aa0: 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 73 2d tests:get-tests-
1ab0: 73 65 61 72 63 68 2d 70 61 74 68 20 2a 63 6f 6e search-path *con
1ac0: 66 69 67 64 61 74 2a 29 20 22 5c 6e 20 20 22 29 figdat*) "\n ")
1ad0: 29 29 29 0a 09 3b 3b 20 61 66 74 65 72 20 61 6c )))..;; after al
1ae0: 6c 20 74 68 61 74 2c 20 73 74 69 6c 6c 20 6e 6f l that, still no
1af0: 20 74 65 73 74 63 6f 6e 66 69 67 3f 20 54 69 6d testconfig? Tim
1b00: 65 20 74 6f 20 61 62 6f 72 74 0a 09 28 69 66 20 e to abort..(if
1b10: 28 6e 6f 74 20 74 65 73 74 63 6f 6e 66 69 67 29 (not testconfig)
1b20: 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 .. (begin..
1b30: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
1b40: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
1b50: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 t-log-port* "Fai
1b60: 6c 65 64 20 74 6f 20 72 65 73 6f 6c 76 65 20 6d led to resolve m
1b70: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 egatest.config,
1b80: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 runconfigs.confi
1b90: 67 20 61 6e 64 20 74 65 73 74 63 6f 6e 66 69 67 g and testconfig
1ba0: 20 69 73 73 75 65 73 2e 20 47 69 76 69 6e 67 20 issues. Giving
1bb0: 75 70 20 6e 6f 77 22 29 0a 09 20 20 20 20 20 20 up now")..
1bc0: 28 65 78 69 74 20 31 29 29 29 0a 0a 09 3b 3b 20 (exit 1)))...;;
1bd0: 63 72 65 61 74 65 20 61 20 70 72 6f 63 20 66 6f create a proc fo
1be0: 72 20 74 68 65 20 73 75 62 72 75 6e 20 69 66 20 r the subrun if
1bf0: 72 65 71 75 65 73 74 65 64 2c 20 73 61 76 65 20 requested, save
1c00: 74 68 61 74 20 70 72 6f 63 20 69 6e 20 74 68 65 that proc in the
1c10: 20 65 7a 73 74 65 70 73 20 74 61 62 6c 65 20 61 ezsteps table a
1c20: 73 20 74 68 65 20 6c 61 73 74 20 65 6e 74 72 79 s the last entry
1c30: 0a 09 3b 3b 20 31 2e 20 67 65 74 20 73 65 63 74 ..;; 1. get sect
1c40: 69 6f 6e 20 5b 72 75 6e 61 72 75 6e 5d 0a 09 3b ion [runarun]..;
1c50: 3b 20 32 2e 20 75 6e 73 65 74 20 4d 54 5f 2a 20 ; 2. unset MT_*
1c60: 76 61 72 73 0a 09 3b 3b 20 33 2e 20 66 69 78 20 vars..;; 3. fix
1c70: 74 61 72 67 65 74 0a 09 3b 3b 20 34 2e 20 66 69 target..;; 4. fi
1c80: 78 20 72 75 6e 6e 61 6d 65 0a 09 3b 3b 20 35 2e x runname..;; 5.
1c90: 20 66 69 78 20 74 65 73 74 70 61 74 74 20 6f 72 fix testpatt or
1ca0: 20 63 61 6c 63 75 6c 61 74 65 20 69 74 20 66 72 calculate it fr
1cb0: 6f 6d 20 63 6f 6e 74 6f 75 72 0a 09 3b 3b 20 36 om contour..;; 6
1cc0: 2e 20 6c 61 75 6e 63 68 20 74 68 65 20 72 75 6e . launch the run
1cd0: 0a 09 3b 3b 20 37 2e 20 72 6f 6c 6c 20 75 70 20 ..;; 7. roll up
1ce0: 74 68 65 20 72 75 6e 20 72 65 73 75 6c 74 20 61 the run result a
1cf0: 6e 64 20 6f 72 20 72 6f 6c 6c 20 75 70 20 74 68 nd or roll up th
1d00: 65 20 6c 6f 67 70 72 6f 20 70 72 6f 63 65 73 73 e logpro process
1d10: 65 64 20 72 65 73 75 6c 74 0a 09 28 77 68 65 6e ed result..(when
1d20: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
1d30: 20 74 65 73 74 63 6f 6e 66 69 67 20 22 73 75 62 testconfig "sub
1d40: 72 75 6e 22 20 22 72 75 6e 77 61 69 74 22 29 20 run" "runwait")
1d50: 3b 3b 20 77 65 20 75 73 65 20 72 75 6e 77 61 69 ;; we use runwai
1d60: 74 20 61 73 20 74 68 65 20 66 6c 61 67 20 74 68 t as the flag th
1d70: 61 74 20 61 20 73 75 62 72 75 6e 20 69 73 20 72 at a subrun is r
1d80: 65 71 75 65 73 74 65 64 0a 20 20 20 20 20 20 20 equested.
1d90: 20 20 20 20 20 28 73 75 62 72 75 6e 3a 69 6e 69 (subrun:ini
1da0: 74 69 61 6c 69 7a 65 2d 74 6f 70 72 75 6e 2d 74 tialize-toprun-t
1db0: 65 73 74 20 74 65 73 74 63 6f 6e 66 69 67 20 74 est testconfig t
1dc0: 65 73 74 2d 72 75 6e 2d 64 69 72 29 0a 09 20 20 est-run-dir)..
1dd0: 20 20 28 6c 65 74 2a 20 28 28 6d 74 2d 63 6d 64 (let* ((mt-cmd
1de0: 20 28 73 75 62 72 75 6e 3a 6c 61 75 6e 63 68 2d (subrun:launch-
1df0: 63 6d 64 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 cmd test-run-dir
1e00: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
1e10: 20 74 65 73 74 63 6f 6e 66 69 67 20 22 73 75 62 testconfig "sub
1e20: 72 75 6e 22 20 22 72 75 6e 77 61 69 74 22 29 29 run" "runwait"))
1e30: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1e40: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
1e50: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
1e60: 67 2d 70 6f 72 74 2a 20 22 53 75 62 72 75 6e 20 g-port* "Subrun
1e70: 63 6f 6d 6d 61 6e 64 20 69 73 20 5c 22 22 20 6d command is \"" m
1e80: 74 2d 63 6d 64 20 22 5c 22 22 29 0a 20 20 20 20 t-cmd "\"").
1e90: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
1ea0: 65 7a 73 74 65 70 73 20 23 74 29 20 3b 3b 20 73 ezsteps #t) ;; s
1eb0: 65 74 20 74 68 65 20 6e 65 65 64 65 64 20 66 6c et the needed fl
1ec0: 61 67 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 ag.. (set!
1ed0: 65 7a 73 74 65 70 73 6c 73 74 0a 20 20 20 20 20 ezstepslst.
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1ef0: 61 70 70 65 6e 64 20 28 6f 72 20 65 7a 73 74 65 append (or ezste
1f00: 70 73 6c 73 74 20 27 28 29 29 0a 20 20 20 20 20 pslst '()).
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f20: 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 6c 69 (list (li
1f30: 73 74 20 22 73 75 62 72 75 6e 22 20 28 63 6f 6e st "subrun" (con
1f40: 63 20 22 7b 73 75 62 72 75 6e 3d 74 72 75 65 7d c "{subrun=true}
1f50: 20 22 20 6d 74 2d 63 6d 64 29 29 29 29 29 29 29 " mt-cmd)))))))
1f60: 0a 0a 09 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 ...;; process th
1f70: 65 20 65 7a 73 74 65 70 73 0a 09 28 69 66 20 65 e ezsteps..(if e
1f80: 7a 73 74 65 70 73 0a 09 20 20 20 20 28 6c 65 74 zsteps.. (let
1f90: 2a 20 28 28 61 6c 6c 2d 73 74 65 70 73 2d 64 61 * ((all-steps-da
1fa0: 74 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 t (make-hash-tab
1fb0: 6c 65 29 29 29 20 3b 3b 20 6b 65 65 70 20 61 6c le))) ;; keep al
1fc0: 6c 20 74 68 65 20 69 6e 66 6f 20 61 72 6f 75 6e l the info aroun
1fd0: 64 20 61 73 20 73 74 65 70 6e 61 6d 65 20 3d 3d d as stepname ==
1fe0: 3e 20 61 6c 69 73 74 3b 20 77 68 65 72 65 20 20 > alist; where
1ff0: 27 70 61 72 61 6d 73 20 69 73 20 74 68 65 20 70 'params is the p
2000: 61 72 61 6d 73 20 6c 69 73 74 20 28 61 64 64 20 arams list (add
2010: 6f 74 68 65 72 20 73 74 75 66 66 20 61 73 20 6e other stuff as n
2020: 65 65 64 65 64 29 0a 09 20 20 20 20 20 20 28 69 eeded).. (i
2030: 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 f (not (common:f
2040: 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a ile-exists? ".ez
2050: 73 74 65 70 73 22 29 29 28 63 72 65 61 74 65 2d steps"))(create-
2060: 64 69 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 directory ".ezst
2070: 65 70 73 22 29 29 0a 09 20 20 20 20 20 20 3b 3b eps")).. ;;
2080: 20 69 66 20 65 7a 73 74 65 70 73 20 77 61 73 20 if ezsteps was
2090: 64 65 66 69 6e 65 64 20 74 68 65 6e 20 77 65 20 defined then we
20a0: 61 72 65 20 73 75 72 65 20 74 6f 20 68 61 76 65 are sure to have
20b0: 20 61 74 20 6c 65 61 73 74 20 6f 6e 65 20 73 74 at least one st
20c0: 65 70 20 62 75 74 20 63 68 65 63 6b 20 61 6e 79 ep but check any
20d0: 77 61 79 0a 09 20 20 20 20 20 20 28 69 66 20 28 way.. (if (
20e0: 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 not (> (length e
20f0: 7a 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 zstepslst) 0))..
2100: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
2110: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
2120: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 7a 73 74 -log-port* "ezst
2130: 65 70 73 20 64 65 66 69 6e 65 64 20 62 75 74 20 eps defined but
2140: 65 7a 73 74 65 70 73 6c 73 74 20 69 73 20 7a 65 ezstepslst is ze
2150: 72 6f 20 6c 65 6e 67 74 68 22 29 0a 20 20 20 20 ro length").
2160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
2170: 65 74 20 28 28 61 6c 6c 2d 73 74 65 70 2d 6e 61 et ((all-step-na
2180: 6d 65 73 20 28 6d 61 70 20 63 61 72 20 65 7a 73 mes (map car ezs
2190: 74 65 70 73 6c 73 74 29 29 0a 20 20 20 20 20 20 tepslst)).
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b0: 20 20 28 73 74 61 74 75 73 2d 66 69 6c 65 20 28 (status-file (
21c0: 66 69 6c 65 2d 6f 70 65 6e 20 22 65 7a 73 74 65 file-open "ezste
21d0: 70 73 2e 73 74 61 74 75 73 22 20 28 2b 20 6f 70 ps.status" (+ op
21e0: 65 6e 2f 61 70 70 65 6e 64 20 6f 70 65 6e 2f 77 en/append open/w
21f0: 72 6f 6e 6c 79 20 6f 70 65 6e 2f 63 72 65 61 74 ronly open/creat
2200: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
2210: 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 09 09 )...
2220: 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 53 (setenv "MT_S
2230: 54 45 50 5f 4e 41 4d 45 53 22 20 28 73 74 72 69 TEP_NAMES" (stri
2240: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 ng-intersperse a
2250: 6c 6c 2d 73 74 65 70 2d 6e 61 6d 65 73 20 22 20 ll-step-names "
2260: 22 29 29 0a 09 09 20 20 20 28 6c 65 74 20 6c 6f "))... (let lo
2270: 6f 70 20 28 28 65 7a 73 74 65 70 20 28 63 61 72 op ((ezstep (car
2280: 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 ezstepslst))...
2290: 09 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 . (tal (c
22a0: 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a dr ezstepslst)).
22b0: 09 09 09 20 20 20 20 20 28 70 72 65 76 73 74 65 ... (prevste
22c0: 70 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 p #f)).
22d0: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
22e0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
22f0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2300: 2a 20 22 50 72 6f 63 65 73 73 69 6e 67 20 65 7a * "Processing ez
2310: 73 74 65 70 20 5c 22 22 20 28 73 74 72 69 6e 67 step \"" (string
2320: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 65 7a 73 -intersperse ezs
2330: 74 65 70 20 22 20 22 29 20 22 5c 22 22 29 0a 09 tep " ") "\"")..
2340: 09 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 . ;; check ex
2350: 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d it-info (vector-
2360: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
2370: 0a 09 09 20 20 20 20 28 69 66 20 28 6c 61 75 6e ... (if (laun
2380: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 ch:einf-exit-sta
2390: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 3b tus exit-info) ;
23a0: 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 ; (vector-ref ex
23b0: 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 28 6c it-info 1)....(l
23c0: 65 74 2a 20 28 28 6c 6f 67 70 72 6f 2d 75 73 65 et* ((logpro-use
23d0: 64 20 28 65 7a 73 74 65 70 73 3a 72 75 6e 73 74 d (ezsteps:runst
23e0: 65 70 20 65 7a 73 74 65 70 20 72 75 6e 2d 69 64 ep ezstep run-id
23f0: 20 74 65 73 74 2d 69 64 20 65 78 69 74 2d 69 6e test-id exit-in
2400: 66 6f 20 6d 20 74 61 6c 20 74 65 73 74 63 6f 6e fo m tal testcon
2410: 66 69 67 20 61 6c 6c 2d 73 74 65 70 73 2d 64 61 fig all-steps-da
2420: 74 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 73 t)).... (s
2430: 74 65 70 6e 61 6d 65 20 20 20 20 28 63 61 72 20 tepname (car
2440: 65 7a 73 74 65 70 29 29 0a 09 09 09 20 20 20 20 ezstep))....
2450: 20 20 20 28 73 74 65 70 70 61 72 6d 73 20 20 20 (stepparms
2460: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 (hash-table-ref
2470: 61 6c 6c 2d 73 74 65 70 73 2d 64 61 74 20 73 74 all-steps-dat st
2480: 65 70 6e 61 6d 65 29 29 29 0a 09 09 09 20 20 28 epname))).... (
2490: 73 65 74 65 6e 76 20 22 4d 54 5f 53 54 45 50 5f setenv "MT_STEP_
24a0: 4e 41 4d 45 22 20 73 74 65 70 6e 61 6d 65 29 0a NAME" stepname).
24b0: 09 09 09 20 20 28 70 70 20 28 68 61 73 68 2d 74 ... (pp (hash-t
24c0: 61 62 6c 65 2d 3e 61 6c 69 73 74 20 61 6c 6c 2d able->alist all-
24d0: 73 74 65 70 73 2d 64 61 74 29 29 0a 09 09 09 20 steps-dat))....
24e0: 20 3b 3b 20 69 66 20 6c 6f 67 70 72 6f 2d 75 73 ;; if logpro-us
24f0: 65 64 20 72 65 61 64 20 69 6e 20 74 68 65 20 73 ed read in the s
2500: 74 65 70 6e 61 6d 65 2e 64 61 74 20 66 69 6c 65 tepname.dat file
2510: 0a 09 09 09 20 20 28 69 66 20 28 61 6e 64 20 6c .... (if (and l
2520: 6f 67 70 72 6f 2d 75 73 65 64 20 28 63 6f 6d 6d ogpro-used (comm
2530: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
2540: 28 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 (conc stepname "
2550: 2e 64 61 74 22 29 29 29 0a 09 09 09 20 20 20 20 .dat")))....
2560: 20 20 28 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c (launch:load-l
2570: 6f 67 70 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 ogpro-dat run-id
2580: 20 74 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d test-id stepnam
2590: 65 29 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 e))..
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
25b0: 66 69 6c 65 2d 77 72 69 74 65 20 73 74 61 74 75 file-write statu
25c0: 73 2d 66 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 s-file (conc ste
25d0: 70 6e 61 6d 65 20 22 20 22 20 28 6c 61 75 6e 63 pname " " (launc
25e0: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 h:einf-exit-code
25f0: 20 65 78 69 74 2d 69 6e 66 6f 29 20 22 5c 6e 22 exit-info) "\n"
2600: 29 29 0a 0a 09 09 09 20 20 28 69 66 20 28 73 74 ))..... (if (st
2610: 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 70 eprun-good? logp
2620: 72 6f 2d 75 73 65 64 20 28 6c 61 75 6e 63 68 3a ro-used (launch:
2630: 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 einf-exit-code e
2640: 78 69 74 2d 69 6e 66 6f 29 20 73 74 65 70 70 61 xit-info) steppa
2650: 72 6d 73 29 0a 09 09 09 20 20 20 20 20 20 28 69 rms).... (i
2660: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 f (not (null? ta
2670: 6c 29 29 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 l))..... (loop
2680: 28 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 74 (car tal) (cdr t
2690: 61 6c 29 20 73 74 65 70 6e 61 6d 65 29 29 0a 09 al) stepname))..
26a0: 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
26b0: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
26c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
26d0: 4e 47 3a 20 73 74 65 70 20 22 20 28 63 61 72 20 NG: step " (car
26e0: 65 7a 73 74 65 70 29 20 22 20 66 61 69 6c 65 64 ezstep) " failed
26f0: 2e 20 53 74 6f 70 70 69 6e 67 22 29 29 29 0a 09 . Stopping")))..
2700: 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 ..(debug:print 0
2710: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
2720: 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 rt* "WARNING: a
2730: 70 72 69 6f 72 20 73 74 65 70 20 66 61 69 6c 65 prior step faile
2740: 64 2c 20 73 74 6f 70 70 69 6e 67 20 61 74 20 22 d, stopping at "
2750: 20 65 7a 73 74 65 70 29 29 29 0a 20 20 20 20 20 ezstep))).
2760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2770: 20 20 20 28 66 69 6c 65 2d 63 6c 6f 73 65 20 73 (file-close s
2780: 74 61 74 75 73 2d 66 69 6c 65 29 0a 20 20 20 20 tatus-file).
2790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27a0: 20 20 20 20 29 0a 0a 20 20 20 20 20 20 20 20 20 )..
27b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
27c0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
27d0: 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a launch:monitor-j
27e0: 6f 62 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ob run-id test-i
27f0: 64 20 69 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c d item-path full
2800: 72 75 6e 73 63 72 69 70 74 20 65 7a 73 74 65 70 runscript ezstep
2810: 73 20 74 65 73 74 2d 6e 61 6d 65 20 74 63 6f 6e s test-name tcon
2820: 66 69 67 72 65 67 20 65 78 69 74 2d 69 6e 66 6f figreg exit-info
2830: 20 6d 20 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e m work-area run
2840: 74 6c 69 6d 20 6d 69 73 63 2d 66 6c 61 67 73 29 tlim misc-flags)
2850: 0a 20 20 28 6c 65 74 2a 20 28 28 75 70 64 61 74 . (let* ((updat
2860: 65 2d 70 65 72 69 6f 64 20 28 73 74 72 69 6e 67 e-period (string
2870: 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 28 63 6f ->number (or (co
2880: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
2890: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
28a0: 20 22 74 65 73 74 2d 73 74 61 74 73 2d 75 70 64 "test-stats-upd
28b0: 61 74 65 2d 70 65 72 69 6f 64 22 29 20 22 36 30 ate-period") "60
28c0: 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 "))). (s
28d0: 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 tart-seconds (cu
28e0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a rrent-seconds)).
28f0: 09 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 . (calc-minutes
2900: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 20 (lambda ()....
2910: 20 28 69 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 (inexact->exact
2920: 20 0a 09 09 09 20 20 20 28 72 6f 75 6e 64 20 0a .... (round .
2930: 09 09 09 20 20 20 20 28 2d 20 0a 09 09 09 20 20 ... (- ....
2940: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
2950: 6e 64 73 29 20 0a 09 09 09 20 20 20 20 20 73 74 nds) .... st
2960: 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 art-seconds)))))
2970: 0a 09 20 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 .. (kill-tries 0
2980: 29 29 0a 20 20 20 20 3b 3b 20 28 74 65 73 74 73 )). ;; (tests
2990: 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 :set-full-meta-i
29a0: 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 nfo #f test-id r
29b0: 75 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e 75 un-id (calc-minu
29c0: 74 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 29 0a tes) work-area).
29d0: 20 20 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 ;; (tests:se
29e0: 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f t-full-meta-info
29f0: 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 test-id run-id
2a00: 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 (calc-minutes) w
2a10: 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 28 74 ork-area). (t
2a20: 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 ests:set-full-me
2a30: 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d ta-info #f test-
2a40: 69 64 20 72 75 6e 2d 69 64 20 28 63 61 6c 63 2d id run-id (calc-
2a50: 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b 2d 61 72 minutes) work-ar
2a60: 65 61 20 31 30 29 0a 0a 20 20 20 20 28 6c 65 74 ea 10).. (let
2a70: 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 loop ((minutes
2a80: 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 (calc-minutes)
2a90: 29 0a 09 20 20 20 20 20 20 20 28 63 70 75 2d 6c ).. (cpu-l
2aa0: 6f 61 64 20 20 28 61 6c 69 73 74 2d 72 65 66 20 oad (alist-ref
2ab0: 27 61 64 6a 2d 63 6f 72 65 2d 6c 6f 61 64 20 28 'adj-core-load (
2ac0: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6e 6f 72 6d 61 common:get-norma
2ad0: 6c 69 7a 65 64 2d 63 70 75 2d 6c 6f 61 64 20 23 lized-cpu-load #
2ae0: 66 29 29 29 0a 09 20 20 20 20 20 20 20 28 64 69 f))).. (di
2af0: 73 6b 2d 66 72 65 65 20 28 67 65 74 2d 64 66 20 sk-free (get-df
2b00: 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f (current-directo
2b10: 72 79 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ry))).
2b20: 20 20 20 20 20 28 6c 61 73 74 2d 73 79 6e 63 20 (last-sync
2b30: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
2b40: 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 63 6f ))). ;; (co
2b50: 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c mmon:telemetry-l
2b60: 6f 67 20 22 7a 6f 6d 62 69 65 22 20 28 63 6f 6e og "zombie" (con
2b70: 63 20 22 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f c "launch:monito
2b80: 72 2d 6a 6f 62 20 2d 20 74 6f 70 20 6f 66 20 6c r-job - top of l
2b90: 6f 6f 70 20 65 6e 63 6f 75 6e 74 65 72 65 64 20 oop encountered
2ba0: 61 74 20 22 28 63 75 72 72 65 6e 74 2d 73 65 63 at "(current-sec
2bb0: 6f 6e 64 73 29 22 20 77 69 74 68 20 6c 61 73 74 onds)" with last
2bc0: 2d 73 79 6e 63 3d 22 6c 61 73 74 2d 73 79 6e 63 -sync="last-sync
2bd0: 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 )). (let* (
2be0: 28 6f 76 65 72 2d 74 69 6d 65 20 20 20 20 20 28 (over-time (
2bf0: 3e 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e > (current-secon
2c00: 64 73 29 20 28 2b 20 6c 61 73 74 2d 73 79 6e 63 ds) (+ last-sync
2c10: 20 75 70 64 61 74 65 2d 70 65 72 69 6f 64 29 29 update-period))
2c20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
2c30: 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 20 28 6c new-cpu-load (l
2c40: 65 74 2a 20 28 28 6c 6f 61 64 20 20 28 61 6c 69 et* ((load (ali
2c50: 73 74 2d 72 65 66 20 27 61 64 6a 2d 63 6f 72 65 st-ref 'adj-core
2c60: 2d 6c 6f 61 64 20 28 63 6f 6d 6d 6f 6e 3a 67 65 -load (common:ge
2c70: 74 2d 6e 6f 72 6d 61 6c 69 7a 65 64 2d 63 70 75 t-normalized-cpu
2c80: 2d 6c 6f 61 64 20 23 66 29 29 29 0a 20 20 20 20 -load #f))).
2c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2cb0: 64 65 6c 74 61 20 28 61 62 73 20 28 2d 20 6c 6f delta (abs (- lo
2cc0: 61 64 20 63 70 75 2d 6c 6f 61 64 29 29 29 29 0a ad cpu-load)))).
2cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
2cf0: 66 20 28 3e 20 64 65 6c 74 61 20 30 2e 31 29 20 f (> delta 0.1)
2d00: 3b 3b 20 64 6f 6e 27 74 20 62 6f 74 68 65 72 20 ;; don't bother
2d10: 75 70 64 61 74 69 6e 67 20 77 69 74 68 20 73 6d updating with sm
2d20: 61 6c 6c 20 63 68 61 6e 67 65 73 0a 20 20 20 20 all changes.
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f lo
2d50: 61 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ad.
2d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d70: 20 20 20 20 20 23 66 29 29 29 0a 20 20 20 20 20 #f))).
2d80: 20 20 20 20 20 20 20 20 28 6e 65 77 2d 64 69 73 (new-dis
2d90: 6b 2d 66 72 65 65 20 28 6c 65 74 2a 20 28 28 64 k-free (let* ((d
2da0: 66 20 20 20 20 28 69 66 20 6f 76 65 72 2d 74 69 f (if over-ti
2db0: 6d 65 20 3b 3b 20 6f 6e 6c 79 20 67 65 74 20 64 me ;; only get d
2dc0: 66 20 65 76 65 72 79 20 33 30 20 73 65 63 6f 6e f every 30 secon
2dd0: 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ds.
2de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e00: 20 28 67 65 74 2d 64 66 20 28 63 75 72 72 65 6e (get-df (curren
2e10: 74 2d 64 69 72 65 63 74 6f 72 79 29 29 0a 20 20 t-directory)).
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e40: 20 20 20 20 20 20 20 20 20 20 20 20 64 69 73 6b disk
2e50: 2d 66 72 65 65 29 29 0a 20 20 20 20 20 20 20 20 -free)).
2e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e70: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 6c 74 (delt
2e80: 61 20 28 61 62 73 20 28 2d 20 64 66 20 64 69 73 a (abs (- df dis
2e90: 6b 2d 66 72 65 65 29 29 29 29 0a 20 20 20 20 20 k-free)))).
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2eb0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
2ec0: 64 20 28 3e 20 64 66 20 30 29 0a 20 20 20 20 20 d (> df 0).
2ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ef0: 20 20 28 3e 20 28 2f 20 64 65 6c 74 61 20 64 66 (> (/ delta df
2f00: 29 20 30 2e 31 29 29 20 3b 3b 20 28 3e 20 64 65 ) 0.1)) ;; (> de
2f10: 6c 74 61 20 32 30 30 29 20 3b 3b 20 69 67 6e 6f lta 200) ;; igno
2f20: 72 65 20 63 68 61 6e 67 65 73 20 75 6e 64 65 72 re changes under
2f30: 20 32 30 30 20 4d 65 67 0a 20 20 20 20 20 20 20 200 Meg.
2f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f50: 20 20 20 20 20 20 20 20 20 20 20 64 66 0a 20 20 df.
2f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f80: 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f))).
2f90: 20 20 20 28 64 6f 2d 73 79 6e 63 20 20 20 20 20 (do-sync
2fa0: 20 20 28 6f 72 20 6e 65 77 2d 63 70 75 2d 6c 6f (or new-cpu-lo
2fb0: 61 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 ad new-disk-free
2fc0: 20 6f 76 65 72 2d 74 69 6d 65 29 29 0a 0a 20 20 over-time))..
2fd0: 20 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 (test
2fe0: 2d 69 6e 66 6f 20 20 20 28 72 6d 74 3a 67 65 74 -info (rmt:get
2ff0: 2d 74 65 73 74 2d 73 74 61 74 65 2d 73 74 61 74 -test-state-stat
3000: 75 73 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 us-by-id run-id
3010: 74 65 73 74 2d 69 64 29 29 0a 20 20 20 20 20 20 test-id)).
3020: 20 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 (state
3030: 20 20 20 20 28 63 61 72 20 74 65 73 74 2d 69 6e (car test-in
3040: 66 6f 29 29 3b 3b 20 28 64 62 3a 74 65 73 74 2d fo));; (db:test-
3050: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 get-state test-i
3060: 6e 66 6f 29 29 0a 20 20 20 20 20 20 20 20 20 20 nfo)).
3070: 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 20 (status
3080: 28 63 64 72 20 74 65 73 74 2d 69 6e 66 6f 29 29 (cdr test-info))
3090: 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d ;; (db:test-get-
30a0: 73 74 61 74 75 73 20 74 65 73 74 2d 69 6e 66 6f status test-info
30b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
30c0: 28 6b 69 6c 6c 2d 72 65 61 73 6f 6e 20 20 22 6e (kill-reason "n
30d0: 6f 20 6b 69 6c 6c 20 72 65 61 73 6f 6e 20 73 70 o kill reason sp
30e0: 65 63 69 66 69 65 64 22 29 0a 20 20 20 20 20 20 ecified").
30f0: 20 20 20 20 20 20 20 28 6b 69 6c 6c 2d 6a 6f 62 (kill-job
3100: 3f 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 ? #f)).
3110: 20 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c ;; (common:tel
3120: 65 6d 65 74 72 79 2d 6c 6f 67 20 22 7a 6f 6d 62 emetry-log "zomb
3130: 69 65 22 20 28 63 6f 6e 63 20 22 6c 61 75 6e 63 ie" (conc "launc
3140: 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 2d 20 h:monitor-job -
3150: 64 65 63 69 73 69 6f 6e 20 74 69 6d 65 20 65 6e decision time en
3160: 63 6f 75 6e 74 65 72 65 64 20 61 74 20 22 28 63 countered at "(c
3170: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 22 urrent-seconds)"
3180: 20 77 69 74 68 20 6c 61 73 74 2d 73 79 6e 63 3d with last-sync=
3190: 22 6c 61 73 74 2d 73 79 6e 63 22 20 64 6f 2d 73 "last-sync" do-s
31a0: 79 6e 63 3d 22 64 6f 2d 73 79 6e 63 22 20 6f 76 ync="do-sync" ov
31b0: 65 72 2d 74 69 6d 65 3d 22 6f 76 65 72 2d 74 69 er-time="over-ti
31c0: 6d 65 22 20 75 70 64 61 74 65 2d 70 65 72 69 6f me" update-perio
31d0: 64 3d 22 75 70 64 61 74 65 2d 70 65 72 69 6f 64 d="update-period
31e0: 29 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 64 )). (cond
31f0: 0a 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 . ((test
3200: 2d 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 -get-kill-reques
3210: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
3220: 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 ). (set
3230: 21 20 6b 69 6c 6c 2d 72 65 61 73 6f 6e 20 22 4b ! kill-reason "K
3240: 49 4c 4c 49 4e 47 20 54 45 53 54 20 73 69 6e 63 ILLING TEST sinc
3250: 65 20 72 65 63 65 69 76 65 64 20 6b 69 6c 6c 20 e received kill
3260: 72 65 71 75 65 73 74 20 28 4b 49 4c 4c 52 45 51 request (KILLREQ
3270: 29 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 )"). (s
3280: 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 74 et! kill-job? #t
3290: 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 61 6e )). ((an
32a0: 64 20 72 75 6e 74 6c 69 6d 20 28 3e 20 28 2d 20 d runtlim (> (-
32b0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
32c0: 29 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 ) start-seconds)
32d0: 20 72 75 6e 74 6c 69 6d 29 29 0a 20 20 20 20 20 runtlim)).
32e0: 20 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d (set! kill-
32f0: 72 65 61 73 6f 6e 20 28 63 6f 6e 63 20 22 4b 49 reason (conc "KI
3300: 4c 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 54 LLING TEST DUE T
3310: 4f 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 O TIME LIMIT EXC
3320: 45 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 EEDED! Runtime="
3330: 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (- (current-sec
3340: 6f 6e 64 73 29 20 73 74 61 72 74 2d 73 65 63 6f onds) start-seco
3350: 6e 64 73 29 20 22 20 73 65 63 6f 6e 64 73 2c 20 nds) " seconds,
3360: 6c 69 6d 69 74 3d 22 20 72 75 6e 74 6c 69 6d 29 limit=" runtlim)
3370: 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 ). (set
3380: 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 74 29 29 ! kill-job? #t))
3390: 0a 20 20 20 20 20 20 20 20 20 28 28 65 71 75 61 . ((equa
33a0: 6c 3f 20 73 74 61 74 75 73 20 22 44 45 41 44 22 l? status "DEAD"
33b0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 65 73 ). (tes
33c0: 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 72 61 ts:update-centra
33d0: 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d l-meta-info run-
33e0: 69 64 20 74 65 73 74 2d 69 64 20 6e 65 77 2d 63 id test-id new-c
33f0: 70 75 2d 6c 6f 61 64 20 6e 65 77 2d 64 69 73 6b pu-load new-disk
3400: 2d 66 72 65 65 20 28 63 61 6c 63 2d 6d 69 6e 75 -free (calc-minu
3410: 74 65 73 29 20 23 66 20 23 66 29 0a 20 20 20 20 tes) #f #f).
3420: 20 20 20 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 (rmt:set-s
3430: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
3440: 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 roll-up-items ru
3450: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 27 66 6f n-id test-id 'fo
3460: 6f 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 o "RUNNING" "n/a
3470: 22 20 22 77 61 73 20 6d 61 72 6b 65 64 20 64 65 " "was marked de
3480: 61 64 3b 20 72 65 61 6c 6c 79 20 73 74 69 6c 6c ad; really still
3490: 20 72 75 6e 6e 69 6e 67 2e 22 29 0a 20 20 20 20 running.").
34a0: 20 20 20 20 20 20 3b 3b 28 73 65 74 21 20 6b 69 ;;(set! ki
34b0: 6c 6c 2d 72 65 61 73 6f 6e 20 22 4b 49 4c 4c 49 ll-reason "KILLI
34c0: 4e 47 20 54 45 53 54 20 62 65 63 61 75 73 65 20 NG TEST because
34d0: 69 74 20 77 61 73 20 6d 61 72 6b 65 64 20 61 73 it was marked as
34e0: 20 44 45 41 44 20 62 79 20 6c 61 75 6e 63 68 3a DEAD by launch:
34f0: 68 61 6e 64 6c 65 2d 7a 6f 6d 62 69 65 2d 74 65 handle-zombie-te
3500: 73 74 73 20 28 6d 69 67 68 74 20 69 6e 64 69 63 sts (might indic
3510: 61 74 65 20 72 65 61 6c 6c 79 20 6f 76 65 72 6c ate really overl
3520: 6f 61 64 65 64 20 73 65 72 76 65 72 20 6f 72 20 oaded server or
3530: 65 6c 73 65 20 6f 76 65 72 7a 65 61 6c 6f 75 73 else overzealous
3540: 20 73 65 74 75 70 2e 64 65 61 64 74 69 6d 65 29 setup.deadtime)
3550: 22 29 20 3b 3b 20 4d 41 52 4b 20 52 55 4e 4e 49 ") ;; MARK RUNNI
3560: 4e 47 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 NG. (se
3570: 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 66 29 t! kill-job? #f)
3580: 29 29 0a 0a 20 20 20 20 20 20 20 20 28 64 65 62 )).. (deb
3590: 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 ug:print 4 *defa
35a0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 ult-log-port* "c
35b0: 70 75 3a 20 22 20 6e 65 77 2d 63 70 75 2d 6c 6f pu: " new-cpu-lo
35c0: 61 64 20 22 20 64 69 73 6b 3a 20 22 20 6e 65 77 ad " disk: " new
35d0: 2d 64 69 73 6b 2d 66 72 65 65 20 22 20 6c 61 73 -disk-free " las
35e0: 74 2d 73 79 6e 63 3a 20 22 20 6c 61 73 74 2d 73 t-sync: " last-s
35f0: 79 6e 63 20 22 20 64 6f 2d 73 79 6e 63 3a 20 22 ync " do-sync: "
3600: 20 64 6f 2d 73 79 6e 63 29 0a 20 20 20 20 20 20 do-sync).
3610: 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f (if (common:lo
3620: 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 20 36 30 w-noise-print 60
3630: 30 20 22 72 75 6e 20 7a 6f 6d 62 69 65 22 29 20 0 "run zombie")
3640: 3b 3b 20 65 76 65 72 79 20 66 69 76 65 20 6d 69 ;; every five mi
3650: 6e 75 74 65 73 20 69 73 20 70 6c 65 6e 74 79 0a nutes is plenty.
3660: 09 20 20 20 20 28 6c 61 75 6e 63 68 3a 68 61 6e . (launch:han
3670: 64 6c 65 2d 7a 6f 6d 62 69 65 2d 74 65 73 74 73 dle-zombie-tests
3680: 20 72 75 6e 2d 69 64 29 29 0a 20 20 20 20 20 20 run-id)).
3690: 20 20 28 77 68 65 6e 20 64 6f 2d 73 79 6e 63 0a (when do-sync.
36a0: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 77 69 74 ;;(wit
36b0: 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 h-output-to-file
36c0: 20 28 63 6f 6e 63 20 28 67 65 74 65 6e 76 20 22 (conc (getenv "
36d0: 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 MT_TEST_RUN_DIR"
36e0: 29 20 22 2f 6c 61 73 74 2d 6c 6f 61 64 69 6e 66 ) "/last-loadinf
36f0: 6f 2e 6c 6f 67 22 20 23 3a 61 70 70 65 6e 64 29 o.log" #:append)
3700: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 28 . ;; (
3710: 6c 61 6d 62 64 61 20 28 29 20 28 70 70 20 28 6c lambda () (pp (l
3720: 69 73 74 20 28 63 75 72 72 65 6e 74 2d 73 65 63 ist (current-sec
3730: 6f 6e 64 73 29 20 6e 65 77 2d 63 70 75 2d 6c 6f onds) new-cpu-lo
3740: 61 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 ad new-disk-free
3750: 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 (calc-minutes))
3760: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b ))). ;;
3770: 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 6d 65 74 (common:telemet
3780: 72 79 2d 6c 6f 67 20 22 7a 6f 6d 62 69 65 22 20 ry-log "zombie"
3790: 28 63 6f 6e 63 20 20 22 6c 61 75 6e 63 68 3a 6d (conc "launch:m
37a0: 6f 6e 69 74 6f 72 2d 6a 6f 62 20 2d 20 64 6f 73 onitor-job - dos
37b0: 79 6e 63 20 73 74 61 72 74 65 64 20 61 74 20 22 ync started at "
37c0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
37d0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 ))). (t
37e0: 65 73 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 ests:update-cent
37f0: 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 ral-meta-info ru
3800: 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 6e 65 77 n-id test-id new
3810: 2d 63 70 75 2d 6c 6f 61 64 20 6e 65 77 2d 64 69 -cpu-load new-di
3820: 73 6b 2d 66 72 65 65 20 28 63 61 6c 63 2d 6d 69 sk-free (calc-mi
3830: 6e 75 74 65 73 29 20 23 66 20 23 66 29 0a 20 20 nutes) #f #f).
3840: 20 20 20 20 20 20 20 20 3b 3b 20 28 63 6f 6d 6d ;; (comm
3850: 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 on:telemetry-log
3860: 20 22 7a 6f 6d 62 69 65 22 20 28 63 6f 6e 63 20 "zombie" (conc
3870: 22 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f 72 2d "launch:monitor-
3880: 6a 6f 62 20 2d 20 64 6f 73 79 6e 63 20 66 69 6e job - dosync fin
3890: 69 73 68 65 64 20 61 74 20 22 28 63 75 72 72 65 ished at "(curre
38a0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 09 20 nt-seconds)))..
38b0: 20 29 0a 20 20 20 20 20 20 20 20 0a 09 28 69 66 ). ..(if
38c0: 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 0a 09 20 20 20 kill-job? ..
38d0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
38e0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
38f0: 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
3900: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 70 72 lt-log-port* "pr
3910: 6f 63 65 65 64 69 6e 67 20 74 6f 20 6b 69 6c 6c oceeding to kill
3920: 20 74 65 73 74 3a 20 22 6b 69 6c 6c 2d 72 65 61 test: "kill-rea
3930: 73 6f 6e 29 0a 09 20 20 20 20 20 20 28 6d 75 74 son).. (mut
3940: 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 ex-lock! m)..
3950: 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 54 68 65 20 ;; NOTE: The
3960: 70 69 64 20 63 61 6e 20 63 68 61 6e 67 65 20 61 pid can change a
3970: 73 20 64 69 66 66 65 72 65 6e 74 20 73 74 65 70 s different step
3980: 73 20 61 72 65 20 72 75 6e 2e 20 44 6f 20 77 65 s are run. Do we
3990: 20 6e 65 65 64 20 68 61 6e 64 73 68 61 6b 69 6e need handshakin
39a0: 67 20 62 65 74 77 65 65 6e 20 74 68 69 73 0a 09 g between this..
39b0: 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 73 ;; s
39c0: 65 63 74 69 6f 6e 20 61 6e 64 20 74 68 65 20 72 ection and the r
39d0: 75 6e 69 74 20 73 65 63 74 69 6f 6e 3f 20 4f 72 unit section? Or
39e0: 20 61 64 64 20 61 20 6c 6f 6f 70 20 74 68 61 74 add a loop that
39f0: 20 74 72 69 65 73 20 74 68 72 65 65 20 74 69 6d tries three tim
3a00: 65 73 20 77 69 74 68 20 61 20 31 2f 34 20 73 65 es with a 1/4 se
3a10: 63 6f 6e 64 0a 09 20 20 20 20 20 20 3b 3b 20 20 cond.. ;;
3a20: 20 20 20 20 20 62 65 74 77 65 65 6e 20 74 72 69 between tri
3a30: 65 73 3f 0a 09 20 20 20 20 20 20 28 6c 65 74 2a es?.. (let*
3a40: 20 28 28 70 69 64 31 20 28 6c 61 75 6e 63 68 3a ((pid1 (launch:
3a50: 65 69 6e 66 2d 70 69 64 20 65 78 69 74 2d 69 6e einf-pid exit-in
3a60: 66 6f 29 29 20 3b 3b 20 28 76 65 63 74 6f 72 2d fo)) ;; (vector-
3a70: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 ref exit-info 0)
3a80: 29 0a 09 09 20 20 20 20 20 28 70 69 64 32 20 28 )... (pid2 (
3a90: 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 rmt:test-get-top
3aa0: 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e -process-pid run
3ab0: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 09 -id test-id))...
3ac0: 20 20 20 20 20 28 70 69 64 73 20 28 64 65 6c 65 (pids (dele
3ad0: 74 65 2d 64 75 70 6c 69 63 61 74 65 73 20 28 66 te-duplicates (f
3ae0: 69 6c 74 65 72 20 6e 75 6d 62 65 72 3f 20 28 6c ilter number? (l
3af0: 69 73 74 20 70 69 64 31 20 70 69 64 32 29 29 29 ist pid1 pid2)))
3b00: 29 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 28 6e ))...(if (not (n
3b10: 75 6c 6c 3f 20 70 69 64 73 29 29 0a 09 09 20 20 ull? pids))...
3b20: 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 (begin...
3b30: 20 28 66 6f 72 2d 65 61 63 68 0a 09 09 20 20 20 (for-each...
3b40: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 70 69 64 (lambda (pid
3b50: 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 78 ).... (handle-ex
3b60: 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 65 78 ceptions.... ex
3b70: 6e 0a 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 n.... (begin...
3b80: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3b90: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
3ba0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 6e 61 t-log-port* "Una
3bb0: 62 6c 65 20 74 6f 20 6b 69 6c 6c 20 70 72 6f 63 ble to kill proc
3bc0: 65 73 73 20 77 69 74 68 20 70 69 64 20 22 20 70 ess with pid " p
3bd0: 69 64 20 22 2c 20 70 6f 73 73 69 62 6c 79 20 61 id ", possibly a
3be0: 6c 72 65 61 64 79 20 6b 69 6c 6c 65 64 2e 22 29 lready killed.")
3bf0: 0a 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 .... (debug:p
3c00: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
3c10: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 log-port* " mess
3c20: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
3c30: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
3c40: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
3c50: 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 6e 3d ge) exn) ", exn=
3c60: 22 20 65 78 6e 29 29 0a 09 09 09 20 20 28 64 65 " exn)).... (de
3c70: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
3c80: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
3c90: 57 41 52 4e 49 4e 47 3a 20 52 65 71 75 65 73 74 WARNING: Request
3ca0: 20 72 65 63 65 69 76 65 64 20 74 6f 20 6b 69 6c received to kil
3cb0: 6c 20 6a 6f 62 20 22 20 70 69 64 29 20 3b 3b 20 l job " pid) ;;
3cc0: 20 22 20 28 61 74 74 65 6d 70 74 20 23 20 22 20 " (attempt # "
3cd0: 6b 69 6c 6c 2d 74 72 69 65 73 20 22 29 22 29 0a kill-tries ")").
3ce0: 09 09 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ... (debug:prin
3cf0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
3d00: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 69 67 t-log-port* "Sig
3d10: 6e 61 6c 20 6d 61 73 6b 3d 22 20 28 73 69 67 6e nal mask=" (sign
3d20: 61 6c 2d 6d 61 73 6b 29 29 0a 09 09 09 20 20 3b al-mask)).... ;
3d30: 3b 20 28 69 66 20 28 70 72 6f 63 65 73 73 3a 61 ; (if (process:a
3d40: 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 20 20 live? pid)....
3d50: 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ;; (begin...
3d60: 09 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 . (map (lambda
3d70: 28 70 69 64 2d 6e 75 6d 29 0a 09 09 09 09 20 28 (pid-num)..... (
3d80: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 process-signal p
3d90: 69 64 2d 6e 75 6d 20 73 69 67 6e 61 6c 2f 74 65 id-num signal/te
3da0: 72 6d 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 rm)).... (
3db0: 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 62 2d process:get-sub-
3dc0: 70 69 64 73 20 70 69 64 29 29 0a 09 09 09 20 20 pids pid))....
3dd0: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 35 (thread-sleep! 5
3de0: 29 0a 09 09 09 20 20 3b 3b 20 28 69 66 20 28 70 ).... ;; (if (p
3df0: 72 6f 63 65 73 73 3a 70 72 6f 63 65 73 73 2d 61 rocess:process-a
3e00: 6c 69 76 65 3f 20 70 69 64 29 0a 09 09 09 20 20 live? pid)....
3e10: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 69 (map (lambda (pi
3e20: 64 2d 6e 75 6d 29 0a 09 09 09 09 20 28 68 61 6e d-num)..... (han
3e30: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
3e40: 09 09 09 20 20 20 20 20 65 78 6e 0a 09 09 09 09 ... exn.....
3e50: 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 (begin.....
3e60: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
3e70: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
3e80: 6f 72 74 2a 20 22 20 2e 2e 2e 2e 20 68 61 64 20 ort* " .... had
3e90: 74 72 6f 75 62 6c 65 20 73 65 6e 64 69 6e 67 20 trouble sending
3ea0: 6b 69 6c 6c 20 74 6f 20 22 20 70 69 64 2d 6e 75 kill to " pid-nu
3eb0: 6d 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a m ", exn=" exn).
3ec0: 09 09 09 09 20 20 20 20 20 23 66 29 0a 09 09 09 .... #f)....
3ed0: 09 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 . (process-sig
3ee0: 6e 61 6c 20 70 69 64 2d 6e 75 6d 20 73 69 67 6e nal pid-num sign
3ef0: 61 6c 2f 6b 69 6c 6c 29 29 29 0a 09 09 09 20 20 al/kill)))....
3f00: 20 20 20 20 20 28 70 72 6f 63 65 73 73 3a 67 65 (process:ge
3f10: 74 2d 73 75 62 2d 70 69 64 73 20 70 69 64 29 29 t-sub-pids pid))
3f20: 29 29 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 20 ))... ;;
3f30: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
3f40: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
3f50: 6f 67 2d 70 6f 72 74 2a 20 22 6e 6f 74 20 6b 69 og-port* "not ki
3f60: 6c 6c 69 6e 67 20 70 72 6f 63 65 73 73 20 22 20 lling process "
3f70: 70 69 64 20 22 20 61 73 20 69 74 20 69 73 20 6e pid " as it is n
3f80: 6f 74 20 61 6c 69 76 65 22 29 29 29 29 0a 09 09 ot alive"))))...
3f90: 20 20 20 20 20 20 20 70 69 64 73 29 0a 20 20 20 pids).
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fb0: 20 20 20 3b 3b 20 42 42 3a 20 71 75 65 73 74 69 ;; BB: questi
3fc0: 6f 6e 20 74 6f 20 4d 61 74 74 20 2d 2d 20 64 6f on to Matt -- do
3fd0: 65 73 20 74 68 65 20 74 65 73 74 73 3a 74 65 73 es the tests:tes
3fe0: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 20 t-state-status!
3ff0: 65 6e 63 6f 6d 70 61 73 73 20 72 6f 6c 6c 75 70 encompass rollup
4000: 20 74 6f 20 74 6f 70 6c 65 76 65 6c 3f 20 20 49 to toplevel? I
4010: 66 20 6e 6f 74 2c 20 73 68 6f 75 6c 64 20 69 74 f not, should it
4020: 3f 0a 09 09 20 20 20 20 20 20 28 74 65 73 74 73 ?... (tests
4030: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
4040: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
4050: 20 22 4b 49 4c 4c 45 44 22 20 20 22 4b 49 4c 4c "KILLED" "KILL
4060: 45 44 22 20 28 63 6f 6e 63 20 28 61 72 67 73 3a ED" (conc (args:
4070: 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 22 20 22 get-arg "-m")" "
4080: 6b 69 6c 6c 2d 72 65 61 73 6f 6e 29 20 23 66 29 kill-reason) #f)
4090: 29 20 3b 3b 20 42 42 20 41 44 44 45 44 20 6b 69 ) ;; BB ADDED ki
40a0: 6c 6c 2d 72 65 61 73 6f 6e 20 2d 2d 20 63 6f 6e ll-reason -- con
40b0: 66 69 72 6d 20 4f 4b 20 77 69 74 68 20 4d 61 74 firm OK with Mat
40c0: 74 0a 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 t... (begin..
40d0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
40e0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
40f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4100: 4e 6f 74 68 69 6e 67 20 74 6f 20 6b 69 6c 6c 2c Nothing to kill,
4110: 20 70 69 64 31 3d 22 20 70 69 64 31 20 22 2c 20 pid1=" pid1 ",
4120: 70 69 64 32 3d 22 20 70 69 64 32 29 0a 09 09 20 pid2=" pid2)...
4130: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
4140: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
4150: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 4b 49 4c -id test-id "KIL
4160: 4c 45 44 22 20 20 22 46 41 49 4c 45 44 20 54 4f LED" "FAILED TO
4170: 20 4b 49 4c 4c 22 20 28 63 6f 6e 63 20 28 61 72 KILL" (conc (ar
4180: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 gs:get-arg "-m")
4190: 22 20 22 6b 69 6c 6c 2d 72 65 61 73 6f 6e 29 20 " "kill-reason)
41a0: 23 66 29 20 3b 3b 20 42 42 20 41 44 44 45 44 20 #f) ;; BB ADDED
41b0: 6b 69 6c 6c 2d 72 65 61 73 6f 6e 20 2d 2d 20 63 kill-reason -- c
41c0: 6f 6e 66 69 72 6d 20 4f 4b 20 77 69 74 68 20 4d onfirm OK with M
41d0: 61 74 74 0a 09 09 20 20 20 20 20 20 29 29 29 0a att... ))).
41e0: 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d 75 6e . (mutex-un
41f0: 6c 6f 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 lock! m)..
4200: 3b 3b 20 6e 6f 20 70 6f 69 6e 74 20 69 6e 20 73 ;; no point in s
4210: 74 69 63 6b 69 6e 67 20 61 72 6f 75 6e 64 2e 20 ticking around.
4220: 45 78 69 74 20 6e 6f 77 2e 20 42 75 74 20 72 75 Exit now. But ru
4230: 6e 20 65 6e 64 20 6f 66 20 72 75 6e 20 62 65 66 n end of run bef
4240: 6f 72 65 20 65 78 69 74 69 6e 67 3f 0a 20 20 20 ore exiting?.
4250: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 75 6e (laun
4260: 63 68 3a 65 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 ch:end-of-run-ch
4270: 65 63 6b 20 72 75 6e 2d 69 64 29 0a 09 20 20 20 eck run-id)..
4280: 20 20 20 28 65 78 69 74 29 29 29 0a 09 28 69 66 (exit)))..(if
4290: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
42a0: 2f 64 65 66 61 75 6c 74 20 6d 69 73 63 2d 66 6c /default misc-fl
42b0: 61 67 73 20 27 6b 65 65 70 2d 67 6f 69 6e 67 20 ags 'keep-going
42c0: 23 66 29 0a 09 20 20 20 20 28 62 65 67 69 6e 0a #f).. (begin.
42d0: 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 . (thread-s
42e0: 6c 65 65 70 21 20 33 29 20 3b 3b 20 28 2b 20 33 leep! 3) ;; (+ 3
42f0: 20 28 72 61 6e 64 6f 6d 20 36 29 29 29 20 3b 3b (random 6))) ;;
4300: 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 65 72 add some jitter
4310: 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 6f 6d to the call hom
4320: 65 20 74 69 6d 65 20 74 6f 20 73 70 72 65 61 64 e time to spread
4330: 20 6f 75 74 20 74 68 65 20 64 62 20 61 63 63 65 out the db acce
4340: 73 73 65 73 0a 09 20 20 20 20 20 20 28 69 66 20 sses.. (if
4350: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
4360: 64 65 66 61 75 6c 74 20 6d 69 73 63 2d 66 6c 61 default misc-fla
4370: 67 73 20 27 6b 65 65 70 2d 67 6f 69 6e 67 20 23 gs 'keep-going #
4380: 66 29 20 20 3b 3b 20 6b 65 65 70 20 6f 72 69 67 f) ;; keep orig
4390: 69 6e 61 6c 73 20 66 6f 72 20 63 70 75 2d 6c 6f inals for cpu-lo
43a0: 61 64 20 61 6e 64 20 64 69 73 6b 2d 66 72 65 65 ad and disk-free
43b0: 20 75 6e 6c 65 73 73 20 74 68 65 79 20 63 68 61 unless they cha
43c0: 6e 67 65 20 6d 6f 72 65 20 74 68 61 6e 20 74 68 nge more than th
43d0: 65 20 61 6c 6c 6f 77 65 64 20 64 65 6c 74 61 0a e allowed delta.
43e0: 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 6c 63 2d .. (loop (calc-
43f0: 6d 69 6e 75 74 65 73 29 0a 20 20 20 20 20 20 20 minutes).
4400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4410: 20 28 6f 72 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 (or new-cpu-loa
4420: 64 20 63 70 75 2d 6c 6f 61 64 29 0a 20 20 20 20 d cpu-load).
4430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4440: 20 20 20 20 28 6f 72 20 6e 65 77 2d 64 69 73 6b (or new-disk
4450: 2d 66 72 65 65 20 64 69 73 6b 2d 66 72 65 65 29 -free disk-free)
4460: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4470: 20 20 20 20 20 20 20 20 20 28 69 66 20 64 6f 2d (if do-
4480: 73 79 6e 63 20 28 63 75 72 72 65 6e 74 2d 73 65 sync (current-se
4490: 63 6f 6e 64 73 29 20 6c 61 73 74 2d 73 79 6e 63 conds) last-sync
44a0: 29 29 29 29 29 29 29 0a 20 20 20 20 28 74 65 73 ))))))). (tes
44b0: 74 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 72 61 ts:update-centra
44c0: 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d l-meta-info run-
44d0: 69 64 20 74 65 73 74 2d 69 64 20 28 67 65 74 2d id test-id (get-
44e0: 63 70 75 2d 6c 6f 61 64 29 20 28 67 65 74 2d 64 cpu-load) (get-d
44f0: 66 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 63 f (current-direc
4500: 74 6f 72 79 29 29 28 63 61 6c 63 2d 6d 69 6e 75 tory))(calc-minu
4510: 74 65 73 29 20 23 66 20 23 66 29 29 29 20 3b 3b tes) #f #f))) ;;
4520: 20 4e 4f 54 45 3a 20 43 68 65 63 6b 69 6e 67 20 NOTE: Checking
4530: 74 77 69 63 65 20 66 6f 72 20 6b 65 65 70 2d 67 twice for keep-g
4540: 6f 69 6e 67 20 69 73 20 69 6e 74 65 6e 74 69 6f oing is intentio
4550: 6e 61 6c 0a 0a 0a 28 64 65 66 69 6e 65 20 28 6c nal...(define (l
4560: 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 65 6e aunch:execute en
4570: 63 6f 64 65 64 2d 63 6d 64 29 0a 20 20 28 6c 65 coded-cmd). (le
4580: 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 20 20 t* ((cmdinfo
4590: 28 63 6f 6d 6d 6f 6e 3a 72 65 61 64 2d 65 6e 63 (common:read-enc
45a0: 6f 64 65 64 2d 73 74 72 69 6e 67 20 65 6e 63 6f oded-string enco
45b0: 64 65 64 2d 63 6d 64 29 29 0a 09 20 28 74 63 6f ded-cmd)).. (tco
45c0: 6e 66 69 67 72 65 67 20 23 66 29 29 0a 20 20 20 nfigreg #f)).
45d0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 (setenv "MT_CMD
45e0: 49 4e 46 4f 22 20 65 6e 63 6f 64 65 64 2d 63 6d INFO" encoded-cm
45f0: 64 29 0a 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 d). ;;(bb-che
4600: 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 ck-path msg: "la
4610: 75 6e 63 68 3a 65 78 65 63 75 74 65 20 69 6e 63 unch:execute inc
4620: 6f 6d 69 6e 67 22 29 0a 20 20 20 20 28 69 66 20 oming"). (if
4630: 28 6c 69 73 74 3f 20 63 6d 64 69 6e 66 6f 29 20 (list? cmdinfo)
4640: 3b 3b 20 28 28 74 65 73 74 70 61 74 68 20 2f 74 ;; ((testpath /t
4650: 6d 70 2f 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a 7a mp/mrwellan/jazz
4660: 6d 69 6e 64 2f 73 72 63 2f 65 78 61 6d 70 6c 65 mind/src/example
4670: 5f 72 75 6e 2f 74 65 73 74 73 2f 73 71 6c 69 74 _run/tests/sqlit
4680: 65 73 70 65 65 64 29 0a 09 3b 3b 20 28 74 65 73 espeed)..;; (tes
4690: 74 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 t-name sqlitespe
46a0: 65 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 ed) (runscript r
46b0: 75 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 unscript.rb) (db
46c0: 2d 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 -host localhost)
46d0: 20 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c (run-id 1))..(l
46e0: 65 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 et* ((testpath
46f0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4700: 74 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 testpath cmdinf
4710: 6f 29 29 20 20 3b 3b 20 74 65 73 74 70 61 74 68 o)) ;; testpath
4720: 20 69 73 20 74 68 65 20 74 65 73 74 20 73 70 65 is the test spe
4730: 63 20 61 72 65 61 0a 09 20 20 20 20 20 20 20 28 c area.. (
4740: 74 6f 70 2d 70 61 74 68 20 20 28 61 73 73 6f 63 top-path (assoc
4750: 2f 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 /default 'toppat
4760: 68 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 h cmdinfo))..
4770: 20 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 (work-area
4780: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4790: 27 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 'work-area cmdin
47a0: 66 6f 29 29 20 20 3b 3b 20 77 6f 72 6b 2d 61 72 fo)) ;; work-ar
47b0: 65 61 20 69 73 20 74 68 65 20 74 65 73 74 20 72 ea is the test r
47c0: 75 6e 20 61 72 65 61 0a 09 20 20 20 20 20 20 20 un area..
47d0: 28 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f (test-name (asso
47e0: 63 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d c/default 'test-
47f0: 6e 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 name cmdinfo))..
4800: 20 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 (runscrip
4810: 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 t (assoc/default
4820: 20 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 'runscript cmdi
4830: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 65 nfo)).. (e
4840: 7a 73 74 65 70 73 20 20 20 28 61 73 73 6f 63 2f zsteps (assoc/
4850: 64 65 66 61 75 6c 74 20 27 65 7a 73 74 65 70 73 default 'ezsteps
4860: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
4870: 20 20 20 20 20 28 73 75 62 72 75 6e 20 20 20 20 (subrun
4880: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4890: 73 75 62 72 75 6e 20 20 20 20 63 6d 64 69 6e 66 subrun cmdinf
48a0: 6f 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 o)).. ;; (
48b0: 72 75 6e 72 65 6d 6f 74 65 20 28 61 73 73 6f 63 runremote (assoc
48c0: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 72 65 6d /default 'runrem
48d0: 6f 74 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ote cmdinfo))..
48e0: 20 20 20 20 20 20 3b 3b 20 28 74 72 61 6e 73 70 ;; (transp
48f0: 6f 72 74 20 28 61 73 73 6f 63 2f 64 65 66 61 75 ort (assoc/defau
4900: 6c 74 20 27 74 72 61 6e 73 70 6f 72 74 20 63 6d lt 'transport cm
4910: 64 69 6e 66 6f 29 29 20 20 3b 3b 20 6e 6f 74 20 dinfo)) ;; not
4920: 75 73 65 64 0a 09 20 20 20 20 20 20 20 3b 3b 20 used.. ;;
4930: 28 73 65 72 76 65 72 69 6e 66 20 28 61 73 73 6f (serverinf (asso
4940: 63 2f 64 65 66 61 75 6c 74 20 27 73 65 72 76 65 c/default 'serve
4950: 72 69 6e 66 20 63 6d 64 69 6e 66 6f 29 29 0a 09 rinf cmdinfo))..
4960: 20 20 20 20 20 20 20 3b 3b 20 28 70 6f 72 74 20 ;; (port
4970: 20 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 (assoc/defa
4980: 75 6c 74 20 27 70 6f 72 74 20 20 20 20 20 20 63 ult 'port c
4990: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
49a0: 20 28 73 65 72 76 65 72 75 72 6c 20 28 61 73 73 (serverurl (ass
49b0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 73 65 72 76 oc/default 'serv
49c0: 65 72 75 72 6c 20 63 6d 64 69 6e 66 6f 29 29 0a erurl cmdinfo)).
49d0: 09 20 20 20 20 20 20 20 28 68 6f 6d 65 68 6f 73 . (homehos
49e0: 74 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c t (assoc/defaul
49f0: 74 20 27 68 6f 6d 65 68 6f 73 74 20 20 63 6d 64 t 'homehost cmd
4a00: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
4a10: 72 75 6e 2d 69 64 20 20 20 20 28 61 73 73 6f 63 run-id (assoc
4a20: 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 2d 69 64 /default 'run-id
4a30: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
4a40: 20 20 20 20 20 20 28 74 65 73 74 2d 69 64 20 20 (test-id
4a50: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4a60: 27 74 65 73 74 2d 69 64 20 20 20 63 6d 64 69 6e 'test-id cmdin
4a70: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 61 fo)).. (ta
4a80: 72 67 65 74 20 20 20 20 28 61 73 73 6f 63 2f 64 rget (assoc/d
4a90: 65 66 61 75 6c 74 20 27 74 61 72 67 65 74 20 20 efault 'target
4aa0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
4ab0: 20 20 20 20 28 61 72 65 61 6e 61 6d 65 20 20 28 (areaname (
4ac0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 61 assoc/default 'a
4ad0: 72 65 61 6e 61 6d 65 20 20 63 6d 64 69 6e 66 6f reaname cmdinfo
4ae0: 29 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d )).. (item
4af0: 64 61 74 20 20 20 28 61 73 73 6f 63 2f 64 65 66 dat (assoc/def
4b00: 61 75 6c 74 20 27 69 74 65 6d 64 61 74 20 20 20 ault 'itemdat
4b10: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
4b20: 20 20 28 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 (env-ovrd (as
4b30: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 soc/default 'env
4b40: 2d 6f 76 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 -ovrd cmdinfo))
4b50: 0a 09 20 20 20 20 20 20 20 28 73 65 74 2d 76 61 .. (set-va
4b60: 72 73 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 rs (assoc/defau
4b70: 6c 74 20 27 73 65 74 2d 76 61 72 73 20 20 63 6d lt 'set-vars cm
4b80: 64 69 6e 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f dinfo)) ;; pre-o
4b90: 76 65 72 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 verrides from -s
4ba0: 65 74 76 61 72 0a 09 20 20 20 20 20 20 20 28 72 etvar.. (r
4bb0: 75 6e 6e 61 6d 65 20 20 20 28 61 73 73 6f 63 2f unname (assoc/
4bc0: 64 65 66 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 default 'runname
4bd0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
4be0: 20 20 20 20 20 28 6d 65 67 61 74 65 73 74 20 20 (megatest
4bf0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4c00: 6d 65 67 61 74 65 73 74 20 20 63 6d 64 69 6e 66 megatest cmdinf
4c10: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
4c20: 74 6c 69 6d 20 20 20 28 61 73 73 6f 63 2f 64 65 tlim (assoc/de
4c30: 66 61 75 6c 74 20 27 72 75 6e 74 6c 69 6d 20 20 fault 'runtlim
4c40: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
4c50: 20 20 20 28 63 6f 6e 74 6f 75 72 20 20 20 28 61 (contour (a
4c60: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 63 6f ssoc/default 'co
4c70: 6e 74 6f 75 72 20 20 20 63 6d 64 69 6e 66 6f 29 ntour cmdinfo)
4c80: 29 0a 09 20 20 20 20 20 20 20 28 69 74 65 6d 2d ).. (item-
4c90: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
4ca0: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
4cb0: 09 20 20 20 20 20 20 20 28 6d 74 2d 62 69 6e 64 . (mt-bind
4cc0: 69 72 2d 70 61 74 68 20 28 61 73 73 6f 63 2f 64 ir-path (assoc/d
4cd0: 65 66 61 75 6c 74 20 27 6d 74 2d 62 69 6e 64 69 efault 'mt-bindi
4ce0: 72 2d 70 61 74 68 20 63 6d 64 69 6e 66 6f 29 29 r-path cmdinfo))
4cf0: 0a 09 20 20 20 20 20 20 20 28 6b 65 79 73 20 20 .. (keys
4d00: 20 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 #f)..
4d10: 28 6b 65 79 76 61 6c 73 20 20 20 23 66 29 0a 09 (keyvals #f)..
4d20: 20 20 20 20 20 20 20 28 66 75 6c 6c 72 75 6e 73 (fullruns
4d30: 63 72 69 70 74 20 28 69 66 20 28 6e 6f 74 20 72 cript (if (not r
4d40: 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 unscript).
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d60: 20 20 20 20 20 20 20 20 20 20 20 20 23 66 0a 20 #f.
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d90: 20 28 69 66 20 28 73 75 62 73 74 72 69 6e 67 2d (if (substring-
4da0: 69 6e 64 65 78 20 22 2f 22 20 72 75 6e 73 63 72 index "/" runscr
4db0: 69 70 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ipt).
4dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dd0: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
4de0: 72 69 70 74 20 3b 3b 20 75 73 65 20 75 6e 61 64 ript ;; use unad
4df0: 75 6c 74 65 72 65 64 20 69 66 20 63 6f 6e 74 61 ultered if conta
4e00: 69 6e 73 20 73 6c 61 73 68 65 73 0a 20 20 20 20 ins slashes.
4e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e30: 20 20 28 6c 65 74 20 28 28 66 75 6c 6c 6e 20 28 (let ((fulln (
4e40: 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 22 conc work-area "
4e50: 2f 22 20 72 75 6e 73 63 72 69 70 74 29 29 29 0a /" runscript))).
4e60: 09 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e80: 20 20 20 28 69 66 20 28 61 6e 64 20 28 63 6f 6d (if (and (com
4e90: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
4ea0: 20 66 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 fulln).
4eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ed0: 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 (file
4ee0: 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f -execute-access?
4ef0: 20 66 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 fulln)).
4f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f20: 20 20 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 fulln.
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f50: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
4f60: 72 69 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 ript))))) ;; ass
4f70: 75 6d 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 ume it is on the
4f80: 20 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 path.
4f90: 20 20 20 20 20 28 63 68 65 63 6b 2d 77 6f 72 6b (check-work
4fa0: 2d 61 72 65 61 20 20 20 20 20 20 20 20 20 20 20 -area
4fb0: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
4fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fe0: 20 20 20 20 20 20 20 3b 3b 20 4e 46 53 20 6d 69 ;; NFS mi
4ff0: 67 68 74 20 6e 6f 74 20 68 61 76 65 20 70 72 6f ght not have pro
5000: 70 61 67 61 74 65 64 20 74 68 65 20 64 69 72 65 pagated the dire
5010: 63 74 6f 72 79 20 6d 65 74 61 20 64 61 74 61 20 ctory meta data
5020: 74 6f 20 74 68 65 20 72 75 6e 20 68 6f 73 74 20 to the run host
5030: 2d 20 67 69 76 65 20 69 74 20 74 69 6d 65 20 69 - give it time i
5040: 66 20 6e 65 65 64 65 64 0a 20 20 20 20 20 20 20 f needed.
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5070: 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 (let loop (
5080: 28 63 6f 75 6e 74 20 30 29 29 0a 20 20 20 20 20 (count 0)).
5090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50b0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 (if (or
50c0: 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 6f (common:directo
50d0: 72 79 2d 65 78 69 73 74 73 3f 20 77 6f 72 6b 2d ry-exists? work-
50e0: 61 72 65 61 29 0a 20 20 20 20 20 20 20 20 20 20 area).
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5110: 20 20 20 20 20 20 20 20 20 20 20 20 28 3e 20 63 (> c
5120: 6f 75 6e 74 20 31 30 29 29 0a 20 20 20 20 20 20 ount 10)).
5130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5150: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 (cha
5160: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
5170: 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 20 20 20 rk-area).
5180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51a0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
51b0: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
51c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51e0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
51f0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
5200: 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 4e g-port* "INFO: N
5210: 6f 74 20 73 74 61 72 74 69 6e 67 20 6a 6f 62 20 ot starting job
5220: 79 65 74 20 2d 20 64 69 72 65 63 74 6f 72 79 20 yet - directory
5230: 22 20 77 6f 72 6b 2d 61 72 65 61 20 22 20 6e 6f " work-area " no
5240: 74 20 66 6f 75 6e 64 22 29 0a 20 20 20 20 20 20 t found").
5250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 (t
5280: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 hread-sleep! 10)
5290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
52a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52c0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 2b 20 63 6f (loop (+ co
52d0: 75 6e 74 20 31 29 29 29 29 29 0a 0a 20 20 20 20 unt 1)))))..
52e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5300: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
5310: 20 28 73 74 72 69 6e 67 3d 3f 20 20 28 63 6f 6d (string=? (com
5320: 6d 6f 6e 3a 72 65 61 6c 2d 70 61 74 68 20 77 6f mon:real-path wo
5330: 72 6b 2d 61 72 65 61 29 28 63 6f 6d 6d 6f 6e 3a rk-area)(common:
5340: 72 65 61 6c 2d 70 61 74 68 20 28 63 75 72 72 65 real-path (curre
5350: 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 29 29 29 nt-directory))))
5360: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5390: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
53a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53c0: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
53d0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
53e0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 0a 20 20 20 20 t-log-port*.
53f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5420: 20 20 20 20 20 20 20 20 20 20 20 22 49 4e 46 4f "INFO
5430: 3a 20 77 65 20 61 72 65 20 65 78 70 65 63 74 69 : we are expecti
5440: 6e 67 20 74 6f 20 62 65 20 69 6e 20 64 69 72 65 ng to be in dire
5450: 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
5460: 61 20 22 5c 6e 22 0a 20 20 20 20 20 20 20 20 20 a "\n".
5470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
54a0: 20 20 20 20 20 20 22 20 20 20 20 20 62 75 74 20 " but
54b0: 77 65 20 61 72 65 20 61 63 74 75 61 6c 6c 79 20 we are actually
54c0: 69 6e 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 in the directory
54d0: 20 22 20 28 63 75 72 72 65 6e 74 2d 64 69 72 65 " (current-dire
54e0: 63 74 6f 72 79 29 20 22 5c 6e 22 0a 20 20 20 20 ctory) "\n".
54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5520: 20 20 20 20 20 20 20 20 20 20 20 22 20 20 20 20 "
5530: 20 64 6f 69 6e 67 20 61 6e 6f 74 68 65 72 20 63 doing another c
5540: 68 61 6e 67 65 20 64 69 72 2e 22 29 0a 20 20 20 hange dir.").
5550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5580: 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 change-directory
5590: 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 20 20 work-area))).
55a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55c0: 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 20 20 .
55d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55f0: 20 20 20 20 20 20 20 3b 3b 20 73 70 6f 74 20 63 ;; spot c
5600: 68 65 63 6b 20 74 68 61 74 20 74 68 65 20 66 69 heck that the fi
5610: 6c 65 73 20 69 6e 20 74 65 73 74 70 61 74 68 20 les in testpath
5620: 61 72 65 20 61 76 61 69 6c 61 62 6c 65 2e 20 54 are available. T
5630: 6f 6f 20 6f 66 74 65 6e 20 4e 46 53 20 64 65 6c oo often NFS del
5640: 61 79 73 20 63 61 75 73 65 20 70 72 6f 62 6c 65 ays cause proble
5650: 6d 73 20 68 65 72 65 2e 0a 20 20 20 20 20 20 20 ms here..
5660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5680: 20 20 20 20 20 28 6c 65 74 20 28 28 66 69 6c 65 (let ((file
5690: 73 20 20 20 20 20 20 28 67 6c 6f 62 20 28 63 6f s (glob (co
56a0: 6e 63 20 74 65 73 74 70 61 74 68 20 22 2f 2a 22 nc testpath "/*"
56b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56e0: 20 20 20 20 20 20 28 62 61 64 2d 66 69 6c 65 73 (bad-files
56f0: 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 '())).
5700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5720: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 (for-each.
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
5760: 61 6d 62 64 61 20 28 66 75 6c 6c 6e 61 6d 65 29 ambda (fullname)
5770: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57a0: 20 20 28 6c 65 74 2a 20 28 28 66 6e 61 6d 65 20 (let* ((fname
57b0: 28 70 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d (pathname-strip-
57c0: 64 69 72 65 63 74 6f 72 79 20 66 75 6c 6c 6e 61 directory fullna
57d0: 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 me)).
57e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5800: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 (ta
5810: 72 67 6e 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 rgn (conc work-a
5820: 72 65 61 20 22 2f 22 20 66 6e 61 6d 65 29 29 29 rea "/" fname)))
5830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5860: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 66 69 (if (not (fi
5870: 6c 65 2d 65 78 69 73 74 73 3f 20 74 61 72 67 6e le-exists? targn
5880: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58b0: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
58c0: 62 61 64 2d 66 69 6c 65 73 20 28 63 6f 6e 73 20 bad-files (cons
58d0: 66 6e 61 6d 65 20 62 61 64 2d 66 69 6c 65 73 29 fname bad-files)
58e0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
58f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5910: 20 20 20 20 66 69 6c 65 73 29 0a 20 20 20 20 20 files).
5920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5940: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f (if (no
5950: 74 20 28 6e 75 6c 6c 3f 20 62 61 64 2d 66 69 6c t (null? bad-fil
5960: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
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 20 20 20 20 20 20 20 20 20
5990: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 (begin.
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
59e0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
59f0: 72 74 2a 20 22 49 4e 46 4f 3a 20 74 65 73 74 20 rt* "INFO: test
5a00: 64 61 74 61 20 66 72 6f 6d 20 22 20 74 65 73 74 data from " test
5a10: 70 61 74 68 20 22 20 6e 6f 74 20 63 6f 70 69 65 path " not copie
5a20: 64 20 70 72 6f 70 65 72 6c 79 20 6f 72 20 66 69 d properly or fi
5a30: 6c 65 73 79 73 74 65 6d 20 70 72 6f 62 6c 65 6d lesystem problem
5a40: 73 20 63 61 75 73 69 6e 67 20 64 61 74 61 20 74 s causing data t
5a50: 6f 20 6e 6f 74 20 62 65 20 66 6f 75 6e 64 2e 20 o not be found.
5a60: 52 65 2d 72 75 6e 6e 69 6e 67 20 74 68 65 20 63 Re-running the c
5a70: 6f 70 79 20 63 6f 6d 6d 61 6e 64 2e 22 29 0a 20 opy command.").
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ab0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5ac0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
5ad0: 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 6d 69 73 73 ort* "INFO: miss
5ae0: 69 6e 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 22 ing files from "
5af0: 20 77 6f 72 6b 2d 61 72 65 61 20 22 3a 20 22 20 work-area ": "
5b00: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
5b10: 72 73 65 20 62 61 64 2d 66 69 6c 65 73 20 22 2c rse bad-files ",
5b20: 20 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ")).
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 20 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 (launch
5b60: 3a 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 70 :test-copy testp
5b70: 61 74 68 20 77 6f 72 6b 2d 61 72 65 61 29 29 29 ath work-area)))
5b80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
5bb0: 20 6f 6e 65 20 6d 6f 72 65 20 74 69 6d 65 2c 20 one more time,
5bc0: 63 68 61 6e 67 65 20 74 6f 20 74 68 65 20 77 6f change to the wo
5bd0: 72 6b 2d 61 72 65 61 20 64 69 72 65 63 74 6f 72 rk-area director
5be0: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
5bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
5c10: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
5c20: 77 6f 72 6b 2d 61 72 65 61 29 29 29 0a 09 20 20 work-area)))..
5c30: 20 20 20 20 20 29 20 3b 3b 20 6c 65 74 2a 0a 0a ) ;; let*..
5c40: 09 20 20 28 69 66 20 63 6f 6e 74 6f 75 72 20 28 . (if contour (
5c50: 73 65 74 65 6e 76 20 22 4d 54 5f 43 4f 4e 54 4f setenv "MT_CONTO
5c60: 55 52 22 20 63 6f 6e 74 6f 75 72 29 29 0a 09 20 UR" contour))..
5c70: 20 0a 09 20 20 3b 3b 20 69 6d 6d 65 64 69 61 74 .. ;; immediat
5c80: 65 64 20 73 65 74 20 73 6f 6d 65 20 6b 65 79 20 ed set some key
5c90: 76 61 72 69 61 62 6c 65 73 20 66 72 6f 6d 20 43 variables from C
5ca0: 4d 44 49 4e 46 4f 20 64 61 74 61 2c 20 79 65 73 MDINFO data, yes
5cb0: 2c 20 74 68 65 73 65 20 77 69 6c 6c 20 62 65 20 , these will be
5cc0: 73 65 74 20 61 67 61 69 6e 20 62 65 6c 6f 77 20 set again below
5cd0: 2e 2e 2e 0a 09 20 20 3b 3b 0a 09 20 20 28 73 65 ..... ;;.. (se
5ce0: 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 53 55 49 tenv "MT_TESTSUI
5cf0: 54 45 4e 41 4d 45 22 20 61 72 65 61 6e 61 6d 65 TENAME" areaname
5d00: 29 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d 54 ).. (setenv "MT
5d10: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 _RUN_AREA_HOME"
5d20: 74 6f 70 2d 70 61 74 68 29 0a 09 20 20 28 73 65 top-path).. (se
5d30: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 74 6f 70 t! *toppath* top
5d40: 2d 70 61 74 68 29 0a 20 20 20 20 20 20 20 20 20 -path).
5d50: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
5d60: 72 79 20 2a 74 6f 70 70 61 74 68 2a 29 20 3b 3b ry *toppath*) ;;
5d70: 20 74 65 6d 70 6f 72 61 72 69 6c 79 20 73 77 69 temporarily swi
5d80: 74 63 68 20 74 6f 20 74 68 65 20 72 75 6e 20 61 tch to the run a
5d90: 72 65 61 20 68 6f 6d 65 0a 09 20 20 28 73 65 74 rea home.. (set
5da0: 65 6e 76 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e env "MT_TEST_RUN
5db0: 5f 44 49 52 22 20 20 77 6f 72 6b 2d 61 72 65 61 _DIR" work-area
5dc0: 29 0a 0a 09 20 20 28 6c 61 75 6e 63 68 3a 73 65 )... (launch:se
5dd0: 74 75 70 29 20 3b 3b 20 73 68 6f 75 6c 64 20 62 tup) ;; should b
5de0: 65 20 70 72 6f 70 65 72 6c 79 20 69 6e 20 74 68 e properly in th
5df0: 65 20 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 20 e run area home
5e00: 6e 6f 77 0a 0a 09 20 20 28 69 66 20 63 6f 6e 74 now... (if cont
5e10: 6f 75 72 20 28 73 65 74 65 6e 76 20 22 4d 54 5f our (setenv "MT_
5e20: 43 4f 4e 54 4f 55 52 22 20 63 6f 6e 74 6f 75 72 CONTOUR" contour
5e30: 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 69 6d 6d )).. .. ;; imm
5e40: 65 64 69 61 74 65 64 20 73 65 74 20 73 6f 6d 65 ediated set some
5e50: 20 6b 65 79 20 76 61 72 69 61 62 6c 65 73 20 66 key variables f
5e60: 72 6f 6d 20 43 4d 44 49 4e 46 4f 20 64 61 74 61 rom CMDINFO data
5e70: 2c 20 79 65 73 2c 20 74 68 65 73 65 20 77 69 6c , yes, these wil
5e80: 6c 20 62 65 20 73 65 74 20 61 67 61 69 6e 20 62 l be set again b
5e90: 65 6c 6f 77 20 2e 2e 2e 0a 09 20 20 3b 3b 0a 09 elow ..... ;;..
5ea0: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 (setenv "MT_TE
5eb0: 53 54 53 55 49 54 45 4e 41 4d 45 22 20 61 72 65 STSUITENAME" are
5ec0: 61 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e aname).. (seten
5ed0: 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 v "MT_RUN_AREA_H
5ee0: 4f 4d 45 22 20 74 6f 70 2d 70 61 74 68 29 0a 09 OME" top-path)..
5ef0: 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 (set! *toppath
5f00: 2a 20 74 6f 70 2d 70 61 74 68 29 0a 20 20 20 20 * top-path).
5f10: 20 20 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 (change-di
5f20: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
5f30: 2a 29 20 3b 3b 20 74 65 6d 70 6f 72 61 72 69 6c *) ;; temporaril
5f40: 79 20 73 77 69 74 63 68 20 74 6f 20 74 68 65 20 y switch to the
5f50: 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 0a 09 20 run area home..
5f60: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 (setenv "MT_TES
5f70: 54 5f 52 55 4e 5f 44 49 52 22 20 20 77 6f 72 6b T_RUN_DIR" work
5f80: 2d 61 72 65 61 29 0a 0a 09 20 20 28 6c 61 75 6e -area)... (laun
5f90: 63 68 3a 73 65 74 75 70 29 20 3b 3b 20 73 68 6f ch:setup) ;; sho
5fa0: 75 6c 64 20 62 65 20 70 72 6f 70 65 72 6c 79 20 uld be properly
5fb0: 69 6e 20 74 68 65 20 72 75 6e 20 61 72 65 61 20 in the run area
5fc0: 68 6f 6d 65 20 6e 6f 77 0a 20 20 20 20 20 20 20 home now.
5fd0: 20 20 20 0a 09 20 20 28 73 65 74 21 20 74 63 6f .. (set! tco
5fe0: 6e 66 69 67 72 65 67 20 28 74 65 73 74 73 3a 67 nfigreg (tests:g
5ff0: 65 74 2d 61 6c 6c 29 29 20 3b 3b 20 6d 61 70 70 et-all)) ;; mapp
6000: 69 6e 67 20 6f 66 20 74 65 73 74 6e 61 6d 65 20 ing of testname
6010: 3d 3e 20 74 65 73 74 20 73 6f 75 72 63 65 20 70 => test source p
6020: 61 74 68 0a 09 20 20 28 6c 65 74 20 28 28 73 69 ath.. (let ((si
6030: 67 68 61 6e 64 20 28 6c 61 6d 62 64 61 20 28 73 ghand (lambda (s
6040: 69 67 6e 75 6d 29 0a 09 09 09 20 20 20 3b 3b 20 ignum).... ;;
6050: 28 73 69 67 6e 61 6c 2d 6d 61 73 6b 21 20 73 69 (signal-mask! si
6060: 67 6e 75 6d 29 20 3b 3b 20 74 6f 20 6d 61 73 6b gnum) ;; to mask
6070: 20 6f 72 20 6e 6f 74 3f 20 73 65 65 6d 73 20 74 or not? seems t
6080: 6f 20 63 61 75 73 65 20 69 73 73 75 65 73 20 69 o cause issues i
6090: 6e 20 65 78 69 74 69 6e 67 0a 09 09 09 20 20 20 n exiting....
60a0: 28 69 66 20 28 65 71 3f 20 73 69 67 6e 75 6d 20 (if (eq? signum
60b0: 73 69 67 6e 61 6c 2f 73 74 6f 70 29 0a 09 09 09 signal/stop)....
60c0: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
60d0: 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
60e0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
60f0: 61 74 74 65 6d 70 74 20 74 6f 20 53 54 4f 50 20 attempt to STOP
6100: 70 72 6f 63 65 73 73 2e 20 45 78 69 74 69 6e 67 process. Exiting
6110: 2e 22 29 29 0a 09 09 09 20 20 20 28 73 65 74 21 .")).... (set!
6120: 20 2a 74 69 6d 65 2d 74 6f 2d 65 78 69 74 2a 20 *time-to-exit*
6130: 23 74 29 0a 09 09 09 20 20 20 28 64 65 62 75 67 #t).... (debug
6140: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
6150: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 65 63 t-log-port* "Rec
6160: 65 69 76 65 64 20 73 69 67 6e 61 6c 20 22 20 73 eived signal " s
6170: 69 67 6e 75 6d 20 22 2c 20 63 6c 65 61 6e 69 6e ignum ", cleanin
6180: 67 20 75 70 20 62 65 66 6f 72 65 20 65 78 69 74 g up before exit
6190: 20 28 73 65 74 20 74 68 69 73 20 74 65 73 74 20 (set this test
61a0: 74 6f 20 43 4f 4d 50 4c 45 54 45 44 2f 41 42 4f to COMPLETED/ABO
61b0: 52 54 29 20 2e 20 50 6c 65 61 73 65 20 77 61 69 RT) . Please wai
61c0: 74 2e 2e 2e 22 29 0a 09 09 09 20 20 20 28 6c 65 t...").... (le
61d0: 74 20 28 28 74 68 31 20 28 6d 61 6b 65 2d 74 68 t ((th1 (make-th
61e0: 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a read (lambda ().
61f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6220: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
6230: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
6240: 2d 70 6f 72 74 2a 20 22 73 65 74 20 74 65 73 74 -port* "set test
6250: 20 74 6f 20 43 4f 4d 50 4c 45 54 45 44 2f 41 42 to COMPLETED/AB
6260: 4f 52 54 20 62 65 67 69 6e 2e 22 29 0a 09 09 09 ORT begin.")....
6270: 09 09 09 20 20 20 20 20 28 72 6d 74 3a 74 65 73 ... (rmt:tes
6280: 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t-set-state-stat
6290: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
62a0: 64 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 41 d "COMPLETED" "A
62b0: 42 4f 52 54 22 20 22 72 65 63 65 69 76 65 64 20 BORT" "received
62c0: 6b 69 6c 6c 20 73 69 67 6e 61 6c 22 29 0a 20 20 kill signal").
62d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6300: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6310: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6320: 6f 72 74 2a 20 22 73 65 74 20 74 65 73 74 20 74 ort* "set test t
6330: 6f 20 43 4f 4d 50 4c 45 54 45 44 2f 41 42 4f 52 o COMPLETED/ABOR
6340: 54 20 63 6f 6d 70 6c 65 74 65 2e 22 29 0a 09 09 T complete.")...
6350: 09 09 09 09 20 20 20 20 20 28 64 65 62 75 67 3a .... (debug:
6360: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
6370: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4b 69 6c 6c -log-port* "Kill
6380: 65 64 20 62 79 20 73 69 67 6e 61 6c 20 22 20 73 ed by signal " s
6390: 69 67 6e 75 6d 20 22 2e 20 45 78 69 74 69 6e 67 ignum ". Exiting
63a0: 22 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 65 ")....... (e
63b0: 78 69 74 20 31 29 29 29 29 0a 09 09 09 09 20 28 xit 1))))..... (
63c0: 74 68 32 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 th2 (make-thread
63d0: 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 09 (lambda ().....
63e0: 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 .. (thread-s
63f0: 6c 65 65 70 21 20 32 30 29 0a 09 09 09 09 09 09 leep! 20).......
6400: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
6410: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
6420: 2d 70 6f 72 74 2a 20 22 44 6f 6e 65 22 29 0a 09 -port* "Done")..
6430: 09 09 09 09 09 20 20 20 20 20 28 65 78 69 74 20 ..... (exit
6440: 34 29 29 29 29 29 0a 09 09 09 20 20 20 20 20 28 4))))).... (
6450: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
6460: 32 29 0a 09 09 09 20 20 20 20 20 28 74 68 72 65 2).... (thre
6470: 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 09 ad-start! th1)..
6480: 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d 6a .. (thread-j
6490: 6f 69 6e 21 20 74 68 32 29 29 29 29 29 0a 09 20 oin! th2)))))..
64a0: 20 20 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 (set-signal-h
64b0: 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 69 andler! signal/i
64c0: 6e 74 20 73 69 67 68 61 6e 64 29 0a 09 20 20 20 nt sighand)..
64d0: 20 28 73 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e (set-signal-han
64e0: 64 6c 65 72 21 20 73 69 67 6e 61 6c 2f 74 65 72 dler! signal/ter
64f0: 6d 20 73 69 67 68 61 6e 64 29 0a 09 20 20 20 20 m sighand)..
6500: 29 20 3b 3b 20 28 73 65 74 2d 73 69 67 6e 61 6c ) ;; (set-signal
6510: 2d 68 61 6e 64 6c 65 72 21 20 73 69 67 6e 61 6c -handler! signal
6520: 2f 73 74 6f 70 20 73 69 67 68 61 6e 64 29 0a 09 /stop sighand)..
6530: 20 20 0a 09 20 20 3b 3b 20 44 6f 20 6e 6f 74 20 .. ;; Do not
6540: 72 75 6e 20 74 68 65 20 74 65 73 74 20 69 66 20 run the test if
6550: 69 74 20 69 73 20 52 45 4d 4f 56 49 4e 47 2c 20 it is REMOVING,
6560: 52 55 4e 4e 49 4e 47 2c 20 4b 49 4c 4c 52 45 51 RUNNING, KILLREQ
6570: 20 6f 72 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 or REMOTEHOSTST
6580: 41 52 54 2c 0a 09 20 20 3b 3b 20 4d 61 72 6b 20 ART,.. ;; Mark
6590: 74 68 65 20 74 65 73 74 20 61 73 20 52 45 4d 4f the test as REMO
65a0: 54 45 48 4f 53 54 53 54 41 52 54 20 2a 49 4d 4d TEHOSTSTART *IMM
65b0: 45 44 49 41 54 45 4c 59 2a 0a 09 20 20 3b 3b 0a EDIATELY*.. ;;.
65c0: 09 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d . (let* ((test-
65d0: 69 6e 66 6f 20 28 6c 65 74 20 6c 6f 6f 70 20 28 info (let loop (
65e0: 28 74 72 69 65 73 20 30 29 29 0a 09 09 09 20 20 (tries 0))....
65f0: 20 20 20 20 28 6c 65 74 20 28 28 74 69 6e 66 6f (let ((tinfo
6600: 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 (rmt:get-test-i
6610: 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 nfo-by-id run-id
6620: 20 74 65 73 74 2d 69 64 29 29 29 0a 09 09 09 09 test-id))).....
6630: 28 69 66 20 74 69 6e 66 6f 0a 09 09 09 09 20 20 (if tinfo.....
6640: 20 20 74 69 6e 66 6f 0a 09 09 09 09 20 20 20 20 tinfo.....
6650: 28 69 66 20 28 3e 20 74 72 69 65 73 20 35 29 0a (if (> tries 5).
6660: 09 09 09 09 09 23 66 0a 09 09 09 09 09 28 62 65 .....#f......(be
6670: 67 69 6e 0a 09 09 09 09 09 20 20 28 74 68 72 65 gin...... (thre
6680: 61 64 2d 73 6c 65 65 70 21 20 28 2b 20 31 20 28 ad-sleep! (+ 1 (
6690: 2a 20 74 72 69 65 73 20 31 30 29 29 29 0a 09 09 * tries 10)))...
66a0: 09 09 09 20 20 28 6c 6f 6f 70 20 28 2b 20 74 72 ... (loop (+ tr
66b0: 69 65 73 20 31 29 29 29 29 29 29 29 29 0a 09 09 ies 1))))))))...
66c0: 20 28 74 65 73 74 2d 68 6f 73 74 20 28 69 66 20 (test-host (if
66d0: 74 65 73 74 2d 69 6e 66 6f 0a 09 09 09 09 28 64 test-info.....(d
66e0: 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f 73 74 20 b:test-get-host
66f0: 20 20 20 20 20 20 20 74 65 73 74 2d 69 6e 66 6f test-info
6700: 29 0a 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ).....(begin....
6710: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
6720: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6730: 6f 72 74 2a 20 22 45 52 52 4f 52 3a 20 66 61 69 ort* "ERROR: fai
6740: 6c 65 64 20 74 6f 20 66 69 6e 64 20 61 20 72 65 led to find a re
6750: 63 6f 72 64 20 66 6f 72 20 74 65 73 74 2d 69 64 cord for test-id
6760: 20 22 20 74 65 73 74 2d 69 64 20 22 2c 20 65 78 " test-id ", ex
6770: 69 74 69 6e 67 2e 22 29 0a 09 09 09 09 20 20 28 iting.")..... (
6780: 65 78 69 74 29 29 29 29 0a 09 09 20 28 74 65 73 exit))))... (tes
6790: 74 2d 70 69 64 20 20 28 64 62 3a 74 65 73 74 2d t-pid (db:test-
67a0: 67 65 74 2d 70 72 6f 63 65 73 73 5f 69 64 20 20 get-process_id
67b0: 74 65 73 74 2d 69 6e 66 6f 29 29 29 0a 09 20 20 test-info)))..
67c0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
67d0: 20 20 20 20 20 3b 3b 20 2d 6d 72 77 2d 20 49 27 ;; -mrw- I'
67e0: 6d 20 72 65 6d 6f 76 69 6e 67 20 4b 49 4c 4c 52 m removing KILLR
67f0: 45 51 20 66 72 6f 6d 20 74 68 69 73 20 6c 69 73 EQ from this lis
6800: 74 20 73 6f 20 74 68 61 74 20 61 20 74 65 73 74 t so that a test
6810: 20 69 6e 20 4b 49 4c 4c 52 45 51 20 73 74 61 74 in KILLREQ stat
6820: 65 20 69 73 20 74 72 65 61 74 65 64 20 61 73 20 e is treated as
6830: 61 20 22 64 6f 20 6e 6f 74 20 72 75 6e 22 20 66 a "do not run" f
6840: 6c 61 67 2e 0a 09 20 20 20 20 20 28 28 6d 65 6d lag... ((mem
6850: 62 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ber (db:test-get
6860: 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f -state test-info
6870: 29 20 27 28 22 49 4e 43 4f 4d 50 4c 45 54 45 22 ) '("INCOMPLETE"
6880: 20 22 4b 49 4c 4c 45 44 22 20 22 55 4e 4b 4e 4f "KILLED" "UNKNO
6890: 57 4e 22 20 22 53 54 55 43 4b 22 29 29 20 3b 3b WN" "STUCK")) ;;
68a0: 20 70 72 69 6f 72 20 72 75 6e 20 6f 66 20 74 68 prior run of th
68b0: 69 73 20 74 65 73 74 20 64 69 64 6e 27 74 20 63 is test didn't c
68c0: 6f 6d 70 6c 65 74 65 2c 20 67 6f 20 61 68 65 61 omplete, go ahea
68d0: 64 20 61 6e 64 20 74 72 79 20 74 6f 20 72 65 72 d and try to rer
68e0: 75 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 un.. (debug
68f0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
6900: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 t-log-port* "INF
6910: 4f 3a 20 74 65 73 74 20 69 73 20 49 4e 43 4f 4d O: test is INCOM
6920: 50 4c 45 54 45 20 6f 72 20 4b 49 4c 4c 45 44 2c PLETE or KILLED,
6930: 20 74 72 65 61 74 20 74 68 69 73 20 65 78 65 63 treat this exec
6940: 75 74 65 20 63 61 6c 6c 20 61 73 20 61 20 72 65 ute call as a re
6950: 72 75 6e 20 72 65 71 75 65 73 74 22 29 0a 09 20 run request")..
6960: 20 20 20 20 20 3b 3b 20 28 74 65 73 74 73 3a 74 ;; (tests:t
6970: 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 65 2d est-force-state-
6980: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
6990: 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f est-id "REMOTEHO
69a0: 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 29 0a STSTART" "n/a").
69b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
69c0: 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c rmt:general-call
69d0: 20 27 73 65 74 2d 74 65 73 74 2d 73 74 61 72 74 'set-test-start
69e0: 2d 74 69 6d 65 20 72 75 6e 2d 69 64 20 74 65 73 -time run-id tes
69f0: 74 2d 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 t-id).
6a00: 20 20 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 65 (rmt:test-se
6a10: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 t-state-status r
6a20: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 22 52 un-id test-id "R
6a30: 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 20 EMOTEHOSTSTART"
6a40: 22 6e 2f 61 22 20 23 66 29 0a 09 20 20 20 20 20 "n/a" #f)..
6a50: 20 29 20 3b 3b 20 70 72 69 6d 65 20 69 74 20 66 ) ;; prime it f
6a60: 6f 72 20 72 75 6e 6e 69 6e 67 0a 09 20 20 20 20 or running..
6a70: 20 28 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 ((member (db:te
6a80: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 st-get-state tes
6a90: 74 2d 69 6e 66 6f 29 20 27 28 22 52 55 4e 4e 49 t-info) '("RUNNI
6aa0: 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 NG" "REMOTEHOSTS
6ab0: 54 41 52 54 22 29 29 0a 09 20 20 20 20 20 20 28 TART")).. (
6ac0: 69 66 20 28 70 72 6f 63 65 73 73 3a 61 6c 69 76 if (process:aliv
6ad0: 65 2d 6f 6e 2d 68 6f 73 74 3f 20 74 65 73 74 2d e-on-host? test-
6ae0: 68 6f 73 74 20 74 65 73 74 2d 70 69 64 29 0a 09 host test-pid)..
6af0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
6b00: 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 error 0 *default
6b10: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 -log-port* "test
6b20: 20 73 74 61 74 65 20 69 73 20 22 20 20 28 64 62 state is " (db
6b30: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
6b40: 74 65 73 74 2d 69 6e 66 6f 29 20 22 20 61 6e 64 test-info) " and
6b50: 20 70 72 6f 63 65 73 73 20 22 20 74 65 73 74 2d process " test-
6b60: 70 69 64 20 22 20 69 73 20 73 74 69 6c 6c 20 72 pid " is still r
6b70: 75 6e 6e 69 6e 67 20 6f 6e 20 68 6f 73 74 20 22 unning on host "
6b80: 20 74 65 73 74 2d 68 6f 73 74 20 22 2c 20 63 61 test-host ", ca
6b90: 6e 6e 6f 74 20 70 72 6f 63 65 65 64 22 29 0a 09 nnot proceed")..
6ba0: 09 20 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 . (exit 1)))..
6bb0: 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 64 62 ((member (db
6bc0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
6bd0: 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 43 4f test-info) '("CO
6be0: 4d 50 4c 45 54 45 44 22 29 29 20 20 3b 3b 20 77 MPLETED")) ;; w
6bf0: 65 20 64 6f 20 4e 4f 54 20 77 61 6e 74 20 74 6f e do NOT want to
6c00: 20 72 65 2d 72 75 6e 20 43 4f 4d 50 4c 45 54 45 re-run COMPLETE
6c10: 44 20 6a 6f 62 73 2e 20 4d 61 72 6b 20 61 73 20 D jobs. Mark as
6c20: 4e 4f 54 5f 53 54 41 52 54 45 44 20 74 6f 20 72 NOT_STARTED to r
6c30: 75 6e 21 0a 09 20 20 20 20 20 20 28 64 65 62 75 un!.. (debu
6c40: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
6c50: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 74 65 lt-log-port* "te
6c60: 73 74 20 73 74 61 74 65 20 69 73 20 22 20 28 64 st state is " (d
6c70: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
6c80: 20 74 65 73 74 2d 69 6e 66 6f 29 20 22 2c 20 63 test-info) ", c
6c90: 61 6e 6e 6f 74 20 70 72 6f 63 65 65 64 22 29 0a annot proceed").
6ca0: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
6cb0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
6cc0: 6f 67 2d 70 6f 72 74 2a 20 22 65 78 69 74 69 6e og-port* "exitin
6cd0: 67 20 77 69 74 68 20 73 74 61 74 75 73 20 31 22 g with status 1"
6ce0: 29 0a 09 20 20 20 20 20 20 28 65 78 69 74 20 31 ).. (exit 1
6cf0: 29 29 0a 09 20 20 20 20 20 28 28 6e 6f 74 20 28 )).. ((not (
6d00: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
6d10: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 get-state test-i
6d20: 6e 66 6f 29 20 27 28 22 52 45 4d 4f 56 49 4e 47 nfo) '("REMOVING
6d30: 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 " "REMOTEHOSTSTA
6d40: 52 54 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 4b RT" "RUNNING" "K
6d50: 49 4c 4c 52 45 51 22 29 29 29 0a 09 20 20 20 20 ILLREQ")))..
6d60: 20 20 3b 3b 20 28 74 65 73 74 73 3a 74 65 73 74 ;; (tests:test
6d70: 2d 66 6f 72 63 65 2d 73 74 61 74 65 2d 73 74 61 -force-state-sta
6d80: 74 75 73 21 20 72 75 6e 2d 69 64 20 74 65 73 74 tus! run-id test
6d90: 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 -id "REMOTEHOSTS
6da0: 54 41 52 54 22 20 22 6e 2f 61 22 29 0a 20 20 20 TART" "n/a").
6db0: 20 20 20 20 20 20 20 20 20 20 20 28 72 6d 74 3a (rmt:
6dc0: 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 73 65 general-call 'se
6dd0: 74 2d 74 65 73 74 2d 73 74 61 72 74 2d 74 69 6d t-test-start-tim
6de0: 65 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 e run-id test-id
6df0: 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 65 ).. (rmt:te
6e00: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
6e10: 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d tus run-id test-
6e20: 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 id "REMOTEHOSTST
6e30: 41 52 54 22 20 22 6e 2f 61 22 20 23 66 29 29 0a ART" "n/a" #f)).
6e40: 09 20 20 20 20 20 28 65 6c 73 65 20 3b 3b 20 28 . (else ;; (
6e50: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
6e60: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 get-state test-i
6e70: 6e 66 6f 29 20 27 28 22 52 45 4d 4f 56 49 4e 47 nfo) '("REMOVING
6e80: 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 " "REMOTEHOSTSTA
6e90: 52 54 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 4b RT" "RUNNING" "K
6ea0: 49 4c 4c 52 45 51 22 29 29 0a 09 20 20 20 20 20 ILLREQ"))..
6eb0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
6ec0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
6ed0: 74 2a 20 22 74 65 73 74 20 73 74 61 74 65 20 69 t* "test state i
6ee0: 73 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 s " (db:test-get
6ef0: 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f -state test-info
6f00: 29 20 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f 63 ) ", cannot proc
6f10: 65 65 64 22 29 0a 09 20 20 20 20 20 20 28 64 65 eed").. (de
6f20: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
6f30: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6f40: 65 78 69 74 69 6e 67 20 77 69 74 68 20 73 74 61 exiting with sta
6f50: 74 75 73 20 31 22 29 0a 09 20 20 20 20 20 20 28 tus 1").. (
6f60: 65 78 69 74 20 31 29 29 29 29 0a 0a 20 20 20 20 exit 1))))..
6f70: 20 20 20 20 20 20 3b 3b 20 63 6c 65 61 6e 75 70 ;; cleanup
6f80: 20 70 72 69 6f 72 20 65 78 65 63 75 74 69 6f 6e prior execution
6f90: 27 73 20 73 74 65 70 73 0a 20 20 20 20 20 20 20 's steps.
6fa0: 20 20 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d 73 (rmt:delete-s
6fb0: 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 21 20 72 teps-for-test! r
6fc0: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 20 un-id test-id).
6fd0: 20 20 20 20 20 20 20 20 20 0a 09 20 20 28 64 65 .. (de
6fe0: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
6ff0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
7000: 45 78 65 63 75 74 69 6e 67 20 22 20 74 65 73 74 Executing " test
7010: 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 74 -name " (id: " t
7020: 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 28 est-id ") on " (
7030: 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 0a get-host-name)).
7040: 09 20 20 28 73 65 74 21 20 6b 65 79 73 20 20 20 . (set! keys
7050: 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 (rmt:get-key
7060: 73 29 29 0a 09 20 20 3b 3b 20 28 72 75 6e 73 3a s)).. ;; (runs:
7070: 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 set-megatest-env
7080: 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 69 6e 6b -vars run-id ink
7090: 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b 65 79 76 eys: keys inkeyv
70a0: 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 20 3b 3b als: keyvals) ;;
70b0: 20 74 68 65 73 65 20 6d 61 79 20 62 65 20 6e 65 these may be ne
70c0: 65 64 65 64 20 62 79 20 74 68 65 20 6c 61 75 6e eded by the laun
70d0: 63 68 69 6e 67 20 70 72 6f 63 65 73 73 0a 09 20 ching process..
70e0: 20 3b 3b 20 6f 6e 65 20 6f 66 20 74 68 65 73 65 ;; one of these
70f0: 20 69 73 20 64 65 66 75 6e 63 74 2f 72 65 64 75 is defunct/redu
7100: 6e 64 61 6e 74 20 2e 2e 2e 0a 09 20 20 28 69 66 ndant ..... (if
7110: 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 65 (not (launch:se
7120: 74 75 70 20 66 6f 72 63 65 2d 72 65 72 65 61 64 tup force-reread
7130: 3a 20 23 74 29 29 0a 09 20 20 20 20 20 20 28 62 : #t)).. (b
7140: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
7150: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
7160: 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 64 og-port* "Failed
7170: 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 69 to setup, exiti
7180: 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 71 6c 69 ng") ...;; (sqli
7190: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 te3:finalize! db
71a0: 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a )...;; (sqlite3:
71b0: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
71c0: 09 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 20 .(exit 1))).
71d0: 20 20 20 20 20 20 3b 3b 20 76 61 6c 69 64 61 74 ;; validat
71e0: 65 20 74 68 61 74 20 74 68 65 20 74 65 73 74 20 e that the test
71f0: 72 75 6e 20 61 72 65 61 20 69 73 20 61 76 61 69 run area is avai
7200: 6c 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 20 lable.
7210: 28 63 68 65 63 6b 2d 77 6f 72 6b 2d 61 72 65 61 (check-work-area
7220: 29 0a 20 20 20 20 20 20 20 20 20 20 0a 20 20 20 ). .
7230: 20 20 20 20 20 20 20 3b 3b 20 73 74 69 6c 6c 20 ;; still
7240: 6e 65 65 64 20 74 6f 20 67 6f 20 62 61 63 6b 20 need to go back
7250: 74 6f 20 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 to run area home
7260: 20 66 6f 72 20 6e 65 78 74 20 63 6f 75 70 6c 65 for next couple
7270: 20 73 74 65 70 73 0a 09 20 20 28 63 68 61 6e 67 steps.. (chang
7280: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
7290: 70 61 74 68 2a 29 20 0a 0a 09 20 20 3b 3b 20 4e path*) ... ;; N
72a0: 4f 54 45 3a 20 43 75 72 72 65 6e 74 20 6f 72 64 OTE: Current ord
72b0: 65 72 20 69 73 20 74 6f 20 70 72 6f 63 65 73 73 er is to process
72c0: 20 72 75 6e 63 6f 6e 66 69 67 73 20 2a 62 65 66 runconfigs *bef
72d0: 6f 72 65 2a 20 73 65 74 74 69 6e 67 20 74 68 65 ore* setting the
72e0: 20 4d 54 5f 20 76 61 72 73 2e 20 54 68 69 73 20 MT_ vars. This
72f0: 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 73 65 65 .. ;; see
7300: 6d 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 62 75 74 ms non-ideal but
7310: 20 63 6f 75 6c 64 20 77 65 6c 6c 20 62 72 65 61 could well brea
7320: 6b 20 73 74 75 66 66 0a 09 20 20 3b 3b 20 20 20 k stuff.. ;;
7330: 20 42 55 47 3f 20 42 55 47 3f 20 42 55 47 3f 0a BUG? BUG? BUG?.
7340: 09 20 20 0a 09 20 20 28 6c 65 74 20 28 28 72 63 . .. (let ((rc
7350: 6f 6e 66 69 67 20 28 66 75 6c 6c 2d 72 75 6e 63 onfig (full-runc
7360: 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 20 3b 3b onfigs-read)) ;;
7370: 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 (read-config (c
7380: 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 2a 20 22 onc *toppath* "
7390: 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 /runconfigs.conf
73a0: 69 67 22 29 20 23 66 20 23 74 20 73 65 63 74 69 ig") #f #t secti
73b0: 6f 6e 73 3a 20 28 6c 69 73 74 20 22 64 65 66 61 ons: (list "defa
73c0: 75 6c 74 22 20 74 61 72 67 65 74 29 29 29 29 0a ult" target)))).
73d0: 09 09 28 77 63 6f 6e 66 69 67 20 28 72 65 61 64 ..(wconfig (read
73e0: 2d 63 6f 6e 66 69 67 20 22 77 61 69 76 65 72 73 -config "waivers
73f0: 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 20 73 .config" #f #t s
7400: 65 63 74 69 6f 6e 73 3a 20 60 28 20 22 64 65 66 ections: `( "def
7410: 61 75 6c 74 22 20 2c 74 61 72 67 65 74 20 29 29 ault" ,target ))
7420: 29 29 20 3b 3b 20 72 65 61 64 20 74 68 65 20 77 )) ;; read the w
7430: 61 69 76 65 72 73 20 63 6f 6e 66 69 67 20 69 66 aivers config if
7440: 20 69 74 20 65 78 69 73 74 73 0a 09 20 20 20 20 it exists..
7450: 3b 3b 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 65 ;; (setup-env-de
7460: 66 61 75 6c 74 73 20 28 63 6f 6e 63 20 2a 74 6f faults (conc *to
7470: 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e 66 ppath* "/runconf
7480: 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 72 75 6e igs.config") run
7490: 2d 69 64 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 -id (make-hash-t
74a0: 61 62 6c 65 29 20 6b 65 79 76 61 6c 73 20 74 61 able) keyvals ta
74b0: 72 67 65 74 29 0a 09 20 20 20 20 3b 3b 20 28 73 rget).. ;; (s
74c0: 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 61 et-run-config-va
74d0: 72 73 20 72 75 6e 2d 69 64 20 6b 65 79 76 61 6c rs run-id keyval
74e0: 73 20 74 61 72 67 65 74 29 20 3b 3b 20 28 64 62 s target) ;; (db
74f0: 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 20 72 :get-target db r
7500: 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 3b 3b 20 un-id)).. ;;
7510: 4e 6f 77 20 68 61 76 65 20 72 75 6e 63 6f 6e 66 Now have runconf
7520: 69 67 73 20 64 61 74 61 20 6c 6f 61 64 65 64 2c igs data loaded,
7530: 20 73 65 74 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 set environment
7540: 20 76 61 72 73 0a 09 20 20 20 20 28 66 6f 72 2d vars.. (for-
7550: 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 6d 62 each.. (lamb
7560: 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 09 20 20 da (section)..
7570: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 (for-each..
7580: 09 28 6c 61 6d 62 64 61 20 28 76 61 72 76 61 6c .(lambda (varval
7590: 29 0a 09 09 20 20 28 6c 65 74 20 28 28 76 61 72 )... (let ((var
75a0: 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 0a 09 (car varval))..
75b0: 09 09 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 ..(val (cadr var
75c0: 76 61 6c 29 29 29 0a 09 09 20 20 20 20 28 69 66 val)))... (if
75d0: 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 76 (and (string? v
75e0: 61 72 29 28 73 74 72 69 6e 67 3f 20 76 61 6c 29 ar)(string? val)
75f0: 29 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 20 )....(begin....
7600: 20 28 73 61 66 65 2d 73 65 74 65 6e 76 20 76 61 (safe-setenv va
7610: 72 20 28 63 6f 6e 66 69 67 66 3a 65 76 61 6c 2d r (configf:eval-
7620: 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 6f string-in-enviro
7630: 6e 6d 65 6e 74 20 76 61 6c 29 29 29 20 3b 3b 20 nment val))) ;;
7640: 76 61 6c 29 0a 09 09 09 28 64 65 62 75 67 3a 70 val)....(debug:p
7650: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
7660: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
7670: 22 62 61 64 20 76 61 72 69 61 62 6c 65 20 73 70 "bad variable sp
7680: 65 63 2c 20 22 20 76 61 72 20 22 3d 22 20 76 61 ec, " var "=" va
7690: 6c 29 29 29 29 0a 09 09 28 63 6f 6e 66 69 67 66 l))))...(configf
76a0: 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 72 63 6f :get-section rco
76b0: 6e 66 69 67 20 73 65 63 74 69 6f 6e 29 29 29 0a nfig section))).
76c0: 09 20 20 20 20 20 28 6c 69 73 74 20 22 64 65 66 . (list "def
76d0: 61 75 6c 74 22 20 74 61 72 67 65 74 29 29 29 0a ault" target))).
76e0: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d ;;(bb-
76f0: 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 check-path msg:
7700: 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 "launch:execute
7710: 70 6f 73 74 20 62 6c 6f 63 6b 20 31 22 29 0a 0a post block 1")..
7720: 09 20 20 3b 3b 20 4e 46 53 20 6d 69 67 68 74 20 . ;; NFS might
7730: 6e 6f 74 20 68 61 76 65 20 70 72 6f 70 61 67 61 not have propaga
7740: 74 65 64 20 74 68 65 20 64 69 72 65 63 74 6f 72 ted the director
7750: 79 20 6d 65 74 61 20 64 61 74 61 20 74 6f 20 74 y meta data to t
7760: 68 65 20 72 75 6e 20 68 6f 73 74 20 2d 20 67 69 he run host - gi
7770: 76 65 20 69 74 20 74 69 6d 65 20 69 66 20 6e 65 ve it time if ne
7780: 65 64 65 64 0a 09 20 20 28 6c 65 74 20 6c 6f 6f eded.. (let loo
7790: 70 20 28 28 63 6f 75 6e 74 20 30 29 29 0a 09 20 p ((count 0))..
77a0: 20 20 20 28 69 66 20 28 6f 72 20 28 63 6f 6d 6d (if (or (comm
77b0: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
77c0: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 20 20 20 work-area)...
77d0: 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a 09 (> count 10))..
77e0: 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f .(change-directo
77f0: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 ry work-area)...
7800: 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 (begin... (debu
7810: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
7820: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
7830: 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e 67 FO: Not starting
7840: 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 72 65 63 job yet - direc
7850: 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 tory " work-area
7860: 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 09 " not found")..
7870: 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 . (thread-sleep
7880: 21 20 31 30 29 0a 09 09 20 20 28 6c 6f 6f 70 20 ! 10)... (loop
7890: 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 29 0a (+ count 1))))).
78a0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6e 6f . ;; no
78b0: 77 20 77 65 20 63 61 6e 20 73 77 69 74 63 68 20 w we can switch
78c0: 74 6f 20 74 68 65 20 77 6f 72 6b 2d 61 72 65 61 to the work-area
78d0: 3f 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 61 ?. (cha
78e0: 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 6f nge-directory wo
78f0: 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 20 20 20 rk-area).
7900: 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 ;;(bb-check-p
7910: 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 ath msg: "launch
7920: 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c :execute post bl
7930: 6f 63 6b 20 31 2e 35 22 29 0a 09 20 20 3b 3b 20 ock 1.5").. ;;
7940: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
7950: 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 20 y work-area) ..
7960: 20 28 73 65 74 21 20 6b 65 79 76 61 6c 73 20 20 (set! keyvals
7970: 20 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e (keys:target->
7980: 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 keyval keys targ
7990: 65 74 29 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 et)).. ;; apply
79a0: 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 pre-overrides b
79b0: 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 efore other vari
79c0: 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f ables. The pre-o
79d0: 76 65 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 verride vars mus
79e0: 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 t not.. ;; clob
79f0: 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d bers things from
7a00: 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f the official so
7a10: 75 72 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 urces such as me
7a20: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e gatest.config an
7a30: 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e d runconfigs.con
7a40: 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 fig.. (if (stri
7a50: 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 ng? set-vars)..
7a60: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 (let ((varp
7a70: 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c airs (string-spl
7a80: 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 it set-vars ",")
7a90: 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e ))...(debug:prin
7aa0: 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 4 *default-log
7ab0: 2d 70 6f 72 74 2a 20 22 76 61 72 70 61 69 72 73 -port* "varpairs
7ac0: 3a 20 22 20 76 61 72 70 61 69 72 73 29 0a 09 09 : " varpairs)...
7ad0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 61 (map (lambda (va
7ae0: 72 70 61 69 72 29 0a 09 09 20 20 20 20 20 20 20 rpair)...
7af0: 28 6c 65 74 20 28 28 76 61 72 76 61 6c 20 28 73 (let ((varval (s
7b00: 74 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 70 tring-split varp
7b10: 61 69 72 20 22 3d 22 29 29 29 0a 09 09 09 20 28 air "="))).... (
7b20: 69 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 20 if (eq? (length
7b30: 76 61 72 76 61 6c 29 20 32 29 0a 09 09 09 20 20 varval) 2)....
7b40: 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 (let ((var (c
7b50: 61 72 20 76 61 72 76 61 6c 29 29 0a 09 09 09 09 ar varval)).....
7b60: 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 61 (val (cadr va
7b70: 72 76 61 6c 29 29 29 0a 09 09 09 20 20 20 20 20 rval)))....
7b80: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
7b90: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
7ba0: 72 74 2a 20 22 41 64 64 69 6e 67 20 70 72 65 2d rt* "Adding pre-
7bb0: 76 61 72 2f 76 61 6c 20 22 20 76 61 72 20 22 20 var/val " var "
7bc0: 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 74 68 65 = " val " to the
7bd0: 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a 09 environment")..
7be0: 09 09 20 20 20 20 20 20 20 28 73 65 74 65 6e 76 .. (setenv
7bf0: 20 76 61 72 20 76 61 6c 29 29 29 29 29 0a 09 09 var val)))))...
7c00: 20 20 20 20 20 76 61 72 70 61 69 72 73 29 29 29 varpairs)))
7c10: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 . ;;(bb
7c20: 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a -check-path msg:
7c30: 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 "launch:execute
7c40: 20 70 6f 73 74 20 62 6c 6f 63 6b 20 32 22 29 0a post block 2").
7c50: 09 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 . (for-each..
7c60: 20 28 6c 61 6d 62 64 61 20 28 76 61 72 76 61 6c (lambda (varval
7c70: 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 76 ).. (let ((v
7c80: 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 ar (car varval))
7c90: 0a 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 ... (val (cadr
7ca0: 20 76 61 72 76 61 6c 29 29 29 0a 09 20 20 20 20 varval)))..
7cb0: 20 20 20 28 69 66 20 76 61 6c 0a 09 09 20 20 20 (if val...
7cc0: 28 73 65 74 65 6e 76 20 76 61 72 20 76 61 6c 29 (setenv var val)
7cd0: 0a 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 20 ... (begin...
7ce0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
7cf0: 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c -error 0 *defaul
7d00: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 71 t-log-port* "req
7d10: 75 69 72 65 64 20 76 61 72 69 61 62 6c 65 20 22 uired variable "
7d20: 20 76 61 72 20 22 20 64 6f 65 73 20 6e 6f 74 20 var " does not
7d30: 68 61 76 65 20 61 20 76 61 6c 69 64 20 76 61 6c have a valid val
7d40: 75 65 2e 20 45 78 69 74 69 6e 67 22 29 0a 09 09 ue. Exiting")...
7d50: 20 20 20 20 20 28 65 78 69 74 29 29 29 29 29 0a (exit))))).
7d60: 09 20 20 20 20 20 28 6c 69 73 74 20 0a 09 20 20 . (list ..
7d70: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 54 (list "MT_T
7d80: 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f 72 EST_RUN_DIR" wor
7d90: 6b 2d 61 72 65 61 29 0a 09 20 20 20 20 20 20 28 k-area).. (
7da0: 6c 69 73 74 20 20 22 4d 54 5f 54 45 53 54 5f 4e list "MT_TEST_N
7db0: 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 0a AME" test-name).
7dc0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
7dd0: 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 6f T_ITEM_INFO" (co
7de0: 6e 63 20 69 74 65 6d 64 61 74 29 29 0a 09 20 20 nc itemdat))..
7df0: 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 49 (list "MT_I
7e00: 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d 2d 70 TEMPATH" item-p
7e10: 61 74 68 29 0a 09 20 20 20 20 20 20 28 6c 69 73 ath).. (lis
7e20: 74 20 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 t "MT_RUNNAME"
7e30: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 20 runname)..
7e40: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 4d 45 47 (list "MT_MEG
7e50: 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 ATEST" megatest
7e60: 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 ).. (list
7e70: 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 74 "MT_TARGET" t
7e80: 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 6c arget).. (l
7e90: 69 73 74 20 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 ist "MT_LINKTRE
7ea0: 45 22 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d E" (common:get-
7eb0: 6c 69 6e 6b 74 72 65 65 29 29 20 3b 3b 20 28 63 linktree)) ;; (c
7ec0: 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
7ed0: 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
7ee0: 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 0a 09 " "linktree"))..
7ef0: 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 (list "MT
7f00: 5f 54 45 53 54 53 55 49 54 45 4e 41 4d 45 22 20 _TESTSUITENAME"
7f10: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 (common:get-test
7f20: 73 75 69 74 65 2d 6e 61 6d 65 29 29 29 29 0a 20 suite-name)))).
7f30: 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 ;;(bb-c
7f40: 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 heck-path msg: "
7f50: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 launch:execute p
7f60: 6f 73 74 20 62 6c 6f 63 6b 20 33 22 29 0a 0a 09 ost block 3")...
7f70: 20 20 28 6c 65 74 20 28 28 74 6d 70 70 61 74 68 (let ((tmppath
7f80: 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 29 (getenv "PATH")
7f90: 29 29 0a 09 20 20 20 20 28 69 66 20 28 73 74 72 )).. (if (str
7fa0: 69 6e 67 2d 73 65 61 72 63 68 20 74 6d 70 70 61 ing-search tmppa
7fb0: 74 68 20 22 20 22 29 0a 09 09 28 64 65 62 75 67 th " ")...(debug
7fc0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
7fd0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 t-log-port* "WAR
7fe0: 4e 49 4e 47 3a 20 73 70 61 63 65 73 20 69 6e 20 NING: spaces in
7ff0: 50 41 54 48 20 61 72 65 20 6e 6f 74 20 73 75 70 PATH are not sup
8000: 70 6f 72 74 65 64 2e 22 29 29 0a 09 20 20 20 20 ported."))..
8010: 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 (if mt-bindir-pa
8020: 74 68 20 28 73 65 74 65 6e 76 20 22 50 41 54 48 th (setenv "PATH
8030: 22 20 28 63 6f 6e 63 20 74 6d 70 70 61 74 68 22 " (conc tmppath"
8040: 3a 22 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 :"mt-bindir-path
8050: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b )))). ;
8060: 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 ;(bb-check-path
8070: 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 msg: "launch:exe
8080: 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 6b 20 cute post block
8090: 34 22 29 0a 09 20 20 3b 3b 20 28 63 68 61 6e 67 4").. ;; (chang
80a0: 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 2d e-directory top-
80b0: 70 61 74 68 29 0a 09 20 20 3b 3b 20 43 61 6e 20 path).. ;; Can
80c0: 73 65 74 75 70 20 61 73 20 63 6c 69 65 6e 74 20 setup as client
80d0: 66 6f 72 20 73 65 72 76 65 72 20 6d 6f 64 65 20 for server mode
80e0: 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c 69 65 6e now.. ;; (clien
80f0: 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 0a 09 20 t:setup)... ..
8100: 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 ;; environment
8110: 6f 76 65 72 72 69 64 65 73 20 61 72 65 20 64 6f overrides are do
8120: 6e 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 20 ne *before* the
8130: 72 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 63 remaining critic
8140: 61 6c 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 61 al envars... (a
8150: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 65 list->env-vars e
8160: 6e 76 2d 6f 76 72 64 29 0a 20 20 20 20 20 20 20 nv-ovrd).
8170: 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 ;;(bb-check-p
8180: 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 ath msg: "launch
8190: 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c :execute post bl
81a0: 6f 63 6b 20 34 31 22 29 0a 09 20 20 28 72 75 6e ock 41").. (run
81b0: 73 3a 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 s:set-megatest-e
81c0: 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 69 nv-vars run-id i
81d0: 6e 6b 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b 65 nkeys: keys inke
81e0: 79 76 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 0a yvals: keyvals).
81f0: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d ;;(bb-
8200: 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 check-path msg:
8210: 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 "launch:execute
8220: 70 6f 73 74 20 62 6c 6f 63 6b 20 34 32 22 29 0a post block 42").
8230: 09 20 20 28 73 65 74 2d 69 74 65 6d 2d 65 6e 76 . (set-item-env
8240: 2d 76 61 72 73 20 69 74 65 6d 64 61 74 29 0a 20 -vars itemdat).
8250: 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 ;;(bb-c
8260: 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 heck-path msg: "
8270: 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 70 launch:execute p
8280: 6f 73 74 20 62 6c 6f 63 6b 20 34 33 22 29 0a 20 ost block 43").
8290: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
82a0: 62 6c 61 63 6b 6c 69 73 74 20 28 63 6f 6e 66 69 blacklist (confi
82b0: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
82c0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 62 gdat* "setup" "b
82d0: 6c 61 63 6b 6c 69 73 74 76 61 72 73 22 29 29 29 lacklistvars")))
82e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 . (if
82f0: 20 62 6c 61 63 6b 6c 69 73 74 0a 09 09 28 6c 65 blacklist...(le
8300: 74 20 28 28 76 61 72 73 20 28 73 74 72 69 6e 67 t ((vars (string
8310: 2d 73 70 6c 69 74 20 62 6c 61 63 6b 6c 69 73 74 -split blacklist
8320: 29 29 29 0a 09 09 20 20 28 73 61 76 65 2d 65 6e )))... (save-en
8330: 76 69 72 6f 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c vironment-as-fil
8340: 65 73 20 22 6d 65 67 61 74 65 73 74 22 20 69 67 es "megatest" ig
8350: 6e 6f 72 65 76 61 72 73 3a 20 76 61 72 73 29 0a norevars: vars).
8360: 09 09 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c .. (for-each (l
8370: 61 6d 62 64 61 20 28 76 61 72 29 0a 09 09 09 20 ambda (var)....
8380: 20 20 20 20 20 28 75 6e 73 65 74 65 6e 76 20 76 (unsetenv v
8390: 61 72 29 29 0a 09 09 09 20 20 20 20 76 61 72 73 ar)).... vars
83a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
83b0: 20 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f 6e (save-environ
83c0: 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 6d ment-as-files "m
83d0: 65 67 61 74 65 73 74 22 29 29 29 0a 20 20 20 20 egatest"))).
83e0: 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 ;;(bb-chec
83f0: 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 k-path msg: "lau
8400: 6e 63 68 3a 65 78 65 63 75 74 65 20 70 6f 73 74 nch:execute post
8410: 20 62 6c 6f 63 6b 20 34 34 22 29 0a 09 20 20 3b block 44").. ;
8420: 3b 20 6f 70 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 ; open-run-close
8430: 20 6e 6f 74 20 6e 65 65 64 65 64 20 66 6f 72 20 not needed for
8440: 74 65 73 74 2d 73 65 74 2d 6d 65 74 61 2d 69 6e test-set-meta-in
8450: 66 6f 0a 09 20 20 3b 3b 20 28 74 65 73 74 73 3a fo.. ;; (tests:
8460: 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e set-full-meta-in
8470: 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 fo #f test-id ru
8480: 6e 2d 69 64 20 30 20 77 6f 72 6b 2d 61 72 65 61 n-id 0 work-area
8490: 29 0a 09 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 ).. ;; (tests:s
84a0: 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 et-full-meta-inf
84b0: 6f 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 o test-id run-id
84c0: 20 30 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 0 work-area)..
84d0: 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c (tests:set-full
84e0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 -meta-info #f te
84f0: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 30 20 77 st-id run-id 0 w
8500: 6f 72 6b 2d 61 72 65 61 20 31 30 29 0a 0a 09 20 ork-area 10)...
8510: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
8520: 70 21 20 30 2e 33 29 20 3b 3b 20 4e 46 53 20 73 p! 0.3) ;; NFS s
8530: 6c 6f 77 6e 65 73 73 20 68 61 73 20 63 61 75 73 lowness has caus
8540: 65 64 20 67 72 69 65 66 20 68 65 72 65 0a 0a 09 ed grief here...
8550: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
8560: 61 72 67 20 22 2d 78 74 65 72 6d 22 29 0a 09 20 arg "-xterm")..
8570: 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 72 (set! fullr
8580: 75 6e 73 63 72 69 70 74 20 22 78 74 65 72 6d 22 unscript "xterm"
8590: 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 61 6e ).. (if (an
85a0: 64 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 d fullrunscript
85b0: 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f ... (commo
85c0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 n:file-exists? f
85d0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 0a 09 09 ullrunscript)...
85e0: 20 20 20 20 20 20 20 28 6e 6f 74 20 28 66 69 6c (not (fil
85f0: 65 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 e-execute-access
8600: 3f 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 ? fullrunscript)
8610: 29 29 0a 09 09 20 20 28 73 79 73 74 65 6d 20 28 ))... (system (
8620: 63 6f 6e 63 20 22 63 68 6d 6f 64 20 75 67 2b 78 conc "chmod ug+x
8630: 20 22 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 " fullrunscript
8640: 29 29 29 29 0a 0a 09 20 20 3b 3b 20 57 65 20 61 ))))... ;; We a
8650: 72 65 20 61 62 6f 75 74 20 74 6f 20 61 63 74 75 re about to actu
8660: 61 6c 6c 79 20 6b 69 63 6b 20 6f 66 66 20 74 68 ally kick off th
8670: 65 20 74 65 73 74 0a 09 20 20 3b 3b 20 73 6f 20 e test.. ;; so
8680: 74 68 69 73 20 69 73 20 61 20 67 6f 6f 64 20 70 this is a good p
8690: 6c 61 63 65 20 74 6f 20 72 65 6d 6f 76 65 20 74 lace to remove t
86a0: 68 65 20 72 65 63 6f 72 64 73 20 66 6f 72 20 0a he records for .
86b0: 09 20 20 3b 3b 20 61 6e 79 20 70 72 65 76 69 6f . ;; any previo
86c0: 75 73 20 72 75 6e 73 0a 09 20 20 3b 3b 20 28 64 us runs.. ;; (d
86d0: 62 3a 74 65 73 74 2d 72 65 6d 6f 76 65 2d 73 74 b:test-remove-st
86e0: 65 70 73 20 64 62 20 72 75 6e 2d 69 64 20 74 65 eps db run-id te
86f0: 73 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a stname itemdat).
8700: 09 20 20 3b 3b 20 6e 6f 77 20 69 73 20 61 6c 73 . ;; now is als
8710: 6f 20 61 20 67 6f 6f 64 20 74 69 6d 65 20 74 6f o a good time to
8720: 20 77 72 69 74 65 20 74 68 65 20 2e 74 65 73 74 write the .test
8730: 63 6f 6e 66 69 67 20 66 69 6c 65 0a 09 20 20 28 config file.. (
8740: 6c 65 74 2a 20 28 28 74 63 6f 6e 66 69 67 2d 66 let* ((tconfig-f
8750: 6e 61 6d 65 20 20 20 28 63 6f 6e 63 20 77 6f 72 name (conc wor
8760: 6b 2d 61 72 65 61 20 22 2f 2e 74 65 73 74 63 6f k-area "/.testco
8770: 6e 66 69 67 22 29 29 0a 09 09 20 28 74 63 6f 6e nfig"))... (tcon
8780: 66 69 67 2d 74 6d 70 66 69 6c 65 20 28 63 6f 6e fig-tmpfile (con
8790: 63 20 74 63 6f 6e 66 69 67 2d 66 6e 61 6d 65 20 c tconfig-fname
87a0: 22 2e 74 6d 70 22 29 29 0a 09 09 20 28 74 63 6f ".tmp"))... (tco
87b0: 6e 66 69 67 20 20 20 20 20 20 20 20 20 28 74 65 nfig (te
87c0: 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 sts:get-testconf
87d0: 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 ig test-name ite
87e0: 6d 2d 70 61 74 68 20 74 63 6f 6e 66 69 67 72 65 m-path tconfigre
87f0: 67 20 23 74 20 66 6f 72 63 65 2d 63 72 65 61 74 g #t force-creat
8800: 65 3a 20 23 74 29 29 20 3b 3b 20 27 72 65 74 75 e: #t)) ;; 'retu
8810: 72 6e 2d 70 72 6f 63 73 29 29 29 0a 09 09 20 28 rn-procs)))... (
8820: 73 63 72 69 70 74 73 20 28 63 6f 6e 66 69 67 66 scripts (configf
8830: 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 74 63 6f :get-section tco
8840: 6e 66 69 67 20 22 73 63 72 69 70 74 73 22 29 29 nfig "scripts"))
8850: 29 0a 09 20 20 20 20 3b 3b 20 63 72 65 61 74 65 ).. ;; create
8860: 20 2e 74 65 73 74 63 6f 6e 66 69 67 20 66 69 6c .testconfig fil
8870: 65 0a 09 20 20 20 20 28 63 6f 6e 66 69 67 66 3a e.. (configf:
8880: 77 72 69 74 65 2d 61 6c 69 73 74 20 74 63 6f 6e write-alist tcon
8890: 66 69 67 20 74 63 6f 6e 66 69 67 2d 74 6d 70 66 fig tconfig-tmpf
88a0: 69 6c 65 29 0a 09 20 20 20 20 28 66 69 6c 65 2d ile).. (file-
88b0: 6d 6f 76 65 20 74 63 6f 6e 66 69 67 2d 74 6d 70 move tconfig-tmp
88c0: 66 69 6c 65 20 74 63 6f 6e 66 69 67 2d 66 6e 61 file tconfig-fna
88d0: 6d 65 20 23 74 29 0a 09 20 20 20 20 28 64 65 6c me #t).. (del
88e0: 65 74 65 2d 66 69 6c 65 2a 20 22 2e 66 69 6e 61 ete-file* ".fina
88f0: 6c 2d 73 74 61 74 75 73 22 29 0a 0a 09 20 20 20 l-status")...
8900: 20 3b 3b 20 65 78 74 72 61 63 74 20 73 63 72 69 ;; extract scri
8910: 70 74 73 20 66 72 6f 6d 20 74 65 73 74 63 6f 6e pts from testcon
8920: 66 69 67 20 61 6e 64 20 77 72 69 74 65 20 74 68 fig and write th
8930: 65 6d 20 74 6f 20 66 69 6c 65 73 20 69 6e 20 74 em to files in t
8940: 65 73 74 20 72 75 6e 20 64 69 72 0a 09 20 20 20 est run dir..
8950: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 (for-each..
8960: 20 28 6c 61 6d 62 64 61 20 28 73 63 72 69 70 74 (lambda (script
8970: 64 61 74 29 0a 09 20 20 20 20 20 20 20 28 6d 61 dat).. (ma
8980: 74 63 68 20 73 63 72 69 70 74 64 61 74 0a 09 09 tch scriptdat...
8990: 20 20 20 20 20 20 28 28 6e 61 6d 65 20 63 6f 6e ((name con
89a0: 74 65 6e 74 29 0a 09 09 20 20 20 20 20 20 20 28 tent)... (
89b0: 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 with-output-to-f
89c0: 69 6c 65 20 6e 61 6d 65 0a 09 09 09 20 28 6c 61 ile name.... (la
89d0: 6d 62 64 61 20 28 29 0a 09 09 09 20 20 20 28 70 mbda ().... (p
89e0: 72 69 6e 74 20 63 6f 6e 74 65 6e 74 29 0a 09 09 rint content)...
89f0: 09 20 20 20 28 63 68 61 6e 67 65 2d 66 69 6c 65 . (change-file
8a00: 2d 6d 6f 64 65 20 6e 61 6d 65 20 28 62 69 74 77 -mode name (bitw
8a10: 69 73 65 2d 69 6f 72 20 70 65 72 6d 2f 69 72 77 ise-ior perm/irw
8a20: 78 67 20 70 65 72 6d 2f 69 72 77 78 75 29 29 29 xg perm/irwxu)))
8a30: 29 29 0a 09 09 20 20 20 20 20 20 28 65 6c 73 65 ))... (else
8a40: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
8a50: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 49 :print-info 0 "I
8a60: 6e 76 61 6c 69 64 20 73 63 72 69 70 74 20 64 65 nvalid script de
8a70: 66 69 6e 69 74 6f 6e 20 66 6f 75 6e 64 20 69 6e finiton found in
8a80: 20 5b 73 63 72 69 70 74 73 5d 20 73 65 63 74 69 [scripts] secti
8a90: 6f 6e 20 6f 66 20 74 65 73 74 63 6f 6e 66 69 67 on of testconfig
8aa0: 2e 20 5c 22 22 20 73 63 72 69 70 74 64 61 74 20 . \"" scriptdat
8ab0: 22 5c 22 22 29 29 29 29 0a 09 20 20 20 20 20 73 "\"")))).. s
8ac0: 63 72 69 70 74 73 29 29 0a 09 20 20 3b 3b 0a 0a cripts)).. ;;..
8ad0: 09 20 20 28 6c 65 74 2a 20 28 28 6d 20 20 20 20 . (let* ((m
8ae0: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d 75 (make-mu
8af0: 74 65 78 29 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a tex))... (kill-j
8b00: 6f 62 3f 20 20 20 20 23 66 29 0a 09 09 20 28 65 ob? #f)... (e
8b10: 78 69 74 2d 69 6e 66 6f 20 20 20 20 28 6d 61 6b xit-info (mak
8b20: 65 2d 6c 61 75 6e 63 68 3a 65 69 6e 66 20 70 69 e-launch:einf pi
8b30: 64 3a 20 23 74 20 65 78 69 74 2d 73 74 61 74 75 d: #t exit-statu
8b40: 73 3a 20 23 74 20 65 78 69 74 2d 63 6f 64 65 3a s: #t exit-code:
8b50: 20 23 74 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 #t rollup-statu
8b60: 73 3a 20 30 29 29 20 3b 3b 20 70 69 64 20 65 78 s: 0)) ;; pid ex
8b70: 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 it-status exit-c
8b80: 6f 64 65 20 28 69 2e 65 2e 20 70 72 6f 63 65 73 ode (i.e. proces
8b90: 73 20 77 61 73 20 73 75 63 63 65 73 73 66 75 6c s was successful
8ba0: 6c 79 20 72 75 6e 29 20 72 6f 6c 6c 75 70 2d 73 ly run) rollup-s
8bb0: 74 61 74 75 73 0a 09 09 20 28 6a 6f 62 2d 74 68 tatus... (job-th
8bc0: 72 65 61 64 20 20 20 23 66 29 0a 09 09 20 3b 3b read #f)... ;;
8bd0: 20 28 6b 65 65 70 2d 67 6f 69 6e 67 20 20 20 23 (keep-going #
8be0: 74 29 0a 09 09 20 28 6d 69 73 63 2d 66 6c 61 67 t)... (misc-flag
8bf0: 73 20 20 20 28 6c 65 74 20 28 28 68 74 20 28 6d s (let ((ht (m
8c00: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
8c10: 29 0a 09 09 09 09 20 28 68 61 73 68 2d 74 61 62 )..... (hash-tab
8c20: 6c 65 2d 73 65 74 21 20 68 74 20 27 6b 65 65 70 le-set! ht 'keep
8c30: 2d 67 6f 69 6e 67 20 23 74 29 0a 09 09 09 09 20 -going #t).....
8c40: 68 74 29 29 0a 09 09 20 28 72 75 6e 69 74 20 20 ht))... (runit
8c50: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
8c60: 0a 09 09 09 09 20 28 6c 61 75 6e 63 68 3a 6d 61 ..... (launch:ma
8c70: 6e 61 67 65 2d 73 74 65 70 73 20 72 75 6e 2d 69 nage-steps run-i
8c80: 64 20 74 65 73 74 2d 69 64 20 69 74 65 6d 2d 70 d test-id item-p
8c90: 61 74 68 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ath fullrunscrip
8ca0: 74 20 65 7a 73 74 65 70 73 20 73 75 62 72 75 6e t ezsteps subrun
8cb0: 20 74 65 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 test-name tconf
8cc0: 69 67 72 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 igreg exit-info
8cd0: 6d 29 29 29 0a 09 09 20 28 6d 6f 6e 69 74 6f 72 m)))... (monitor
8ce0: 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 28 29 job (lambda ()
8cf0: 0a 09 09 09 09 20 28 6c 61 75 6e 63 68 3a 6d 6f ..... (launch:mo
8d00: 6e 69 74 6f 72 2d 6a 6f 62 20 20 72 75 6e 2d 69 nitor-job run-i
8d10: 64 20 74 65 73 74 2d 69 64 20 69 74 65 6d 2d 70 d test-id item-p
8d20: 61 74 68 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 ath fullrunscrip
8d30: 74 20 65 7a 73 74 65 70 73 20 74 65 73 74 2d 6e t ezsteps test-n
8d40: 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 67 20 65 ame tconfigreg e
8d50: 78 69 74 2d 69 6e 66 6f 20 6d 20 77 6f 72 6b 2d xit-info m work-
8d60: 61 72 65 61 20 72 75 6e 74 6c 69 6d 20 6d 69 73 area runtlim mis
8d70: 63 2d 66 6c 61 67 73 29 29 29 0a 09 09 20 28 74 c-flags)))... (t
8d80: 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b h1 (mak
8d90: 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 e-thread monitor
8da0: 6a 6f 62 20 22 6d 6f 6e 69 74 6f 72 20 6a 6f 62 job "monitor job
8db0: 22 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 20 "))... (th2
8dc0: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
8dd0: 64 20 72 75 6e 69 74 20 22 72 75 6e 20 6a 6f 62 d runit "run job
8de0: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
8df0: 20 20 20 20 20 28 74 63 6f 6e 66 69 67 20 20 20 (tconfig
8e00: 20 20 20 20 20 20 28 74 65 73 74 73 3a 67 65 74 (tests:get
8e10: 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 74 -testconfig test
8e20: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
8e30: 74 63 6f 6e 66 69 67 72 65 67 20 23 74 29 29 0a tconfigreg #t)).
8e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e50: 20 28 70 72 6f 70 61 67 61 74 65 2d 65 78 69 74 (propagate-exit
8e60: 2d 63 6f 64 65 20 28 63 6f 6e 66 69 67 66 3a 6c -code (configf:l
8e70: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
8e80: 2a 20 22 73 65 74 75 70 22 20 22 70 72 6f 70 61 * "setup" "propa
8e90: 67 61 74 65 2d 65 78 69 74 2d 63 6f 64 65 22 29 gate-exit-code")
8ea0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8eb0: 20 20 20 28 70 72 6f 70 61 67 61 74 65 2d 73 74 (propagate-st
8ec0: 61 74 75 73 2d 6c 69 73 74 20 27 28 22 46 41 49 atus-list '("FAI
8ed0: 4c 22 20 22 4b 49 4c 4c 45 44 22 20 22 41 42 4f L" "KILLED" "ABO
8ee0: 52 54 22 20 22 44 45 41 44 22 20 22 43 48 45 43 RT" "DEAD" "CHEC
8ef0: 4b 22 20 22 53 4b 49 50 22 20 22 57 41 49 56 45 K" "SKIP" "WAIVE
8f00: 44 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 D")).
8f10: 20 20 20 20 20 20 28 74 65 73 74 2d 73 74 61 74 (test-stat
8f20: 75 73 20 22 6e 6f 74 20 73 65 74 22 29 0a 20 20 us "not set").
8f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
8f40: 0a 09 20 20 20 20 28 73 65 74 21 20 6a 6f 62 2d .. (set! job-
8f50: 74 68 72 65 61 64 20 74 68 32 29 0a 09 20 20 20 thread th2)..
8f60: 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 (thread-start!
8f70: 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 61 th1).. (threa
8f80: 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a 09 20 d-start! th2)..
8f90: 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 (thread-join!
8fa0: 20 74 68 32 29 0a 09 20 20 20 20 28 64 65 62 75 th2).. (debu
8fb0: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
8fc0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
8fd0: 2a 20 22 4d 65 67 61 74 65 73 74 20 65 78 65 63 * "Megatest exec
8fe0: 75 74 65 20 6f 66 20 74 65 73 74 20 22 20 74 65 ute of test " te
8ff0: 73 74 2d 6e 61 6d 65 20 22 2c 20 69 74 65 6d 20 st-name ", item
9000: 70 61 74 68 20 22 20 69 74 65 6d 2d 70 61 74 68 path " item-path
9010: 20 22 20 63 6f 6d 70 6c 65 74 65 2e 20 4e 6f 74 " complete. Not
9020: 69 66 79 69 6e 67 20 74 68 65 20 64 62 20 2e 2e ifying the db ..
9030: 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 .").
9040: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
9050: 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 2 *default-log
9060: 2d 70 6f 72 74 2a 20 22 65 78 69 74 2d 69 6e 66 -port* "exit-inf
9070: 6f 20 3d 20 22 20 65 78 69 74 2d 69 6e 66 6f 29 o = " exit-info)
9080: 0a 09 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c .. (hash-tabl
9090: 65 2d 73 65 74 21 20 6d 69 73 63 2d 66 6c 61 67 e-set! misc-flag
90a0: 73 20 27 6b 65 65 70 2d 67 6f 69 6e 67 20 23 66 s 'keep-going #f
90b0: 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 6a ).. (thread-j
90c0: 6f 69 6e 21 20 74 68 31 29 0a 09 20 20 20 20 28 oin! th1).. (
90d0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 thread-sleep! 1)
90e0: 20 20 20 20 20 20 20 3b 3b 20 67 69 76 62 65 20 ;; givbe
90f0: 74 68 72 65 61 64 20 74 68 31 20 61 20 63 68 61 thread th1 a cha
9100: 6e 63 65 20 74 6f 20 62 65 20 64 6f 6e 65 20 54 nce to be done T
9110: 4f 44 4f 3a 20 56 65 72 69 66 79 20 74 68 69 73 ODO: Verify this
9120: 20 69 73 20 6e 65 65 64 65 64 2e 20 41 74 20 30 is needed. At 0
9130: 2e 31 20 49 20 77 61 73 20 67 65 74 74 69 6e 67 .1 I was getting
9140: 20 66 61 69 6c 20 74 6f 20 73 74 6f 70 2c 20 69 fail to stop, i
9150: 6e 63 72 65 61 73 65 64 20 74 6f 20 74 6f 74 61 ncreased to tota
9160: 6c 20 6f 66 20 31 2e 31 20 73 65 63 2e 0a 09 20 l of 1.1 sec...
9170: 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 (mutex-lock!
9180: 6d 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 m).. (let* ((
9190: 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d item-path (item-
91a0: 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 list->path itemd
91b0: 61 74 29 29 0a 09 09 20 20 20 3b 3b 20 6f 6e 6c at))... ;; onl
91c0: 79 20 73 74 61 74 65 20 61 6e 64 20 73 74 61 74 y state and stat
91d0: 75 73 20 6e 65 65 64 65 64 20 2d 20 75 73 65 20 us needed - use
91e0: 6c 61 7a 79 20 72 6f 75 74 69 6e 65 0a 09 09 20 lazy routine...
91f0: 20 20 28 74 65 73 74 69 6e 66 6f 20 20 28 72 6d (testinfo (rm
9200: 74 3a 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 t:get-testinfo-s
9210: 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d tate-status run-
9220: 69 64 20 74 65 73 74 2d 69 64 29 29 29 0a 09 20 id test-id)))..
9230: 20 20 20 20 20 3b 3b 20 41 6d 20 49 20 63 6f 6d ;; Am I com
9240: 70 6c 65 74 65 64 3f 0a 09 20 20 20 20 20 20 28 pleted?.. (
9250: 69 66 20 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 if (member (db:t
9260: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 est-get-state te
9270: 73 74 69 6e 66 6f 29 20 27 28 22 52 45 4d 4f 54 stinfo) '("REMOT
9280: 45 48 4f 53 54 53 54 41 52 54 22 20 22 52 55 4e EHOSTSTART" "RUN
9290: 4e 49 4e 47 22 29 29 0a 20 20 20 20 20 20 20 20 NING")).
92a0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
92b0: 6e 65 77 2d 73 74 61 74 65 20 20 28 69 66 20 6b new-state (if k
92c0: 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 ill-job? "KILLED
92d0: 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 0a " "COMPLETED")).
92e0: 09 09 20 20 20 20 20 20 20 20 28 6e 65 77 2d 73 .. (new-s
92f0: 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 tatus (cond.....
9300: 20 20 20 20 20 28 28 6e 6f 74 20 28 6c 61 75 6e ((not (laun
9310: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 ch:einf-exit-sta
9320: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 tus exit-info))
9330: 22 46 41 49 4c 22 29 20 3b 3b 20 6a 6f 62 20 66 "FAIL") ;; job f
9340: 61 69 6c 65 64 20 74 6f 20 72 75 6e 20 2e 2e 2e ailed to run ...
9350: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
9360: 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 20 20 t-info 1).....
9370: 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 68 ((eq? (launch
9380: 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 :einf-rollup-sta
9390: 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 30 tus exit-info) 0
93a0: 29 20 20 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 ) ;; (vector
93b0: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 -ref exit-info 3
93c0: 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 69 )..... ;; i
93d0: 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 74 f the current st
93e0: 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 65 atus is AUTO the
93f0: 6e 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 63 n defer to the c
9400: 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 20 alculated value
9410: 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 73 (i.e. leave this
9420: 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 20 20 AUTO).....
9430: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 64 62 (if (equal? (db
9440: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 73 :test-get-status
9450: 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 54 4f testinfo) "AUTO
9460: 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 53 22 ") "AUTO" "PASS"
9470: 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 ))..... ((eq
9480: 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 ? (launch:einf-r
9490: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 ollup-status exi
94a0: 74 2d 69 6e 66 6f 29 20 31 29 20 22 46 41 49 4c t-info) 1) "FAIL
94b0: 22 29 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 ") ;; (vector-r
94c0: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 0a ef exit-info 3).
94d0: 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 .... ((eq? (
94e0: 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c launch:einf-roll
94f0: 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 up-status exit-i
9500: 6e 66 6f 29 20 32 29 09 20 20 20 20 20 3b 3b 09 nfo) 2). ;;.
9510: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
9520: 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 20 20 20 -info 3).....
9530: 20 20 20 3b 3b 20 69 66 20 74 68 65 20 63 75 72 ;; if the cur
9540: 72 65 6e 74 20 73 74 61 74 75 73 20 69 73 20 41 rent status is A
9550: 55 54 4f 20 74 68 65 20 64 65 66 65 72 20 74 6f UTO the defer to
9560: 20 74 68 65 20 63 61 6c 63 75 6c 61 74 65 64 20 the calculated
9570: 76 61 6c 75 65 20 62 75 74 20 71 75 61 6c 69 66 value but qualif
9580: 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 74 68 69 y (i.e. make thi
9590: 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a 09 09 09 s AUTO-WARN)....
95a0: 09 20 20 20 20 20 20 28 69 66 20 28 65 71 75 61 . (if (equa
95b0: 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d l? (db:test-get-
95c0: 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f 29 status testinfo)
95d0: 20 22 41 55 54 4f 22 29 20 22 41 55 54 4f 2d 57 "AUTO") "AUTO-W
95e0: 41 52 4e 22 20 22 57 41 52 4e 22 29 29 0a 09 09 ARN" "WARN"))...
95f0: 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 .. ((eq? (la
9600: 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 unch:einf-rollup
9610: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 -status exit-inf
9620: 6f 29 20 33 29 20 22 43 48 45 43 4b 22 29 0a 09 o) 3) "CHECK")..
9630: 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c ... ((eq? (l
9640: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
9650: 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e p-status exit-in
9660: 66 6f 29 20 34 29 20 22 57 41 49 56 45 44 22 29 fo) 4) "WAIVED")
9670: 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 ..... ((eq?
9680: 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c (launch:einf-rol
9690: 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d lup-status exit-
96a0: 69 6e 66 6f 29 20 35 29 20 22 41 42 4f 52 54 22 info) 5) "ABORT"
96b0: 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 3f )..... ((eq?
96c0: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f (launch:einf-ro
96d0: 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 69 74 llup-status exit
96e0: 2d 69 6e 66 6f 29 20 36 29 20 22 53 4b 49 50 22 -info) 6) "SKIP"
96f0: 29 0a 09 09 09 09 20 20 20 20 20 28 65 6c 73 65 )..... (else
9700: 20 22 46 41 49 4c 22 29 29 29 0a 20 20 20 20 20 "FAIL"))).
9710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9720: 20 20 20 29 20 3b 3b 20 28 64 62 3a 74 65 73 74 ) ;; (db:test
9730: 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 -get-status test
9740: 69 6e 66 6f 29 29 29 0a 09 09 20 20 20 20 28 64 info)))... (d
9750: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
9760: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
9770: 6f 72 74 2a 20 22 54 65 73 74 20 65 78 69 74 65 ort* "Test exite
9780: 64 20 69 6e 20 73 74 61 74 65 3d 22 20 28 64 62 d in state=" (db
9790: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
97a0: 74 65 73 74 69 6e 66 6f 29 20 22 2c 20 73 65 74 testinfo) ", set
97b0: 74 69 6e 67 20 73 74 61 74 65 2f 73 74 61 74 75 ting state/statu
97c0: 73 20 62 61 73 65 64 20 6f 6e 20 65 78 69 74 20 s based on exit
97d0: 63 6f 64 65 20 6f 66 20 22 20 28 6c 61 75 6e 63 code of " (launc
97e0: 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 h:einf-exit-stat
97f0: 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 22 20 us exit-info) "
9800: 61 6e 64 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 and rollup-statu
9810: 73 20 6f 66 20 22 20 28 6c 61 75 6e 63 68 3a 65 s of " (launch:e
9820: 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 inf-rollup-statu
9830: 73 20 65 78 69 74 2d 69 6e 66 6f 29 29 0a 20 20 s exit-info)).
9840: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9850: 20 20 20 20 20 20 3b 3b 20 4c 65 61 76 65 20 61 ;; Leave a
9860: 20 2e 66 69 6e 61 6c 2d 73 74 61 74 75 73 20 66 .final-status f
9870: 69 6c 65 20 66 6f 72 20 65 61 63 68 20 73 75 62 ile for each sub
9880: 2d 74 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 -test.
9890: 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 73 (tests
98a0: 3a 73 61 76 65 2d 66 69 6e 61 6c 2d 73 74 61 74 :save-final-stat
98b0: 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 us run-id test-i
98c0: 64 29 0a 0a 09 09 20 20 20 20 28 74 65 73 74 73 d).... (tests
98d0: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
98e0: 21 20 72 75 6e 2d 69 64 20 0a 09 09 09 09 09 20 ! run-id ......
98f0: 20 20 20 74 65 73 74 2d 69 64 20 0a 09 09 09 09 test-id .....
9900: 09 20 20 20 20 6e 65 77 2d 73 74 61 74 65 0a 09 . new-state..
9910: 09 09 09 09 20 20 20 20 6e 65 77 2d 73 74 61 74 .... new-stat
9920: 75 73 0a 09 09 09 09 09 20 20 20 20 28 61 72 67 us...... (arg
9930: 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d 22 29 20 s:get-arg "-m")
9940: 23 66 29 0a 09 09 20 20 20 20 3b 3b 20 6e 65 65 #f)... ;; nee
9950: 64 20 74 6f 20 75 70 64 61 74 65 20 74 68 65 20 d to update the
9960: 74 6f 70 20 74 65 73 74 20 72 65 63 6f 72 64 20 top test record
9970: 69 66 20 50 41 53 53 20 6f 72 20 46 41 49 4c 20 if PASS or FAIL
9980: 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 73 75 and this is a su
9990: 62 74 65 73 74 0a 09 09 20 20 20 20 3b 3b 20 4e btest... ;; N
99a0: 4f 20 4e 45 45 44 20 54 4f 20 43 41 4c 4c 20 73 O NEED TO CALL s
99b0: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
99c0: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
99d0: 73 20 48 45 52 45 2c 20 54 48 49 53 20 49 53 20 s HERE, THIS IS
99e0: 44 4f 4e 45 20 49 4e 20 73 65 74 2d 73 74 61 74 DONE IN set-stat
99f0: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
9a00: 6c 2d 75 70 2d 69 74 65 6d 73 20 63 61 6c 6c 65 l-up-items calle
9a10: 64 20 62 79 20 74 65 73 74 73 3a 74 65 73 74 2d d by tests:test-
9a20: 73 65 74 2d 73 74 61 74 75 73 21 0a 09 09 20 29 set-status!... )
9a30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 . )
9a40: 0a 0a 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 .... ;; for
9a50: 20 61 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 automated creat
9a60: 69 6f 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 ion of the rollu
9a70: 70 20 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 p html file this
9a80: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
9a90: 2e 2e 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
9aa0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d not (equal? item
9ab0: 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 -path ""))... (
9ac0: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
9ad0: 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 items run-id tes
9ae0: 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 t-id test-name #
9af0: 66 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 42 55 f)).. ;; BU
9b00: 47 20 77 61 73 20 74 68 69 73 20 6d 65 61 6e 74 G was this meant
9b10: 20 74 6f 20 62 65 20 74 68 65 20 61 6e 74 65 63 to be the antec
9b20: 6e 74 20 6f 66 20 74 68 65 20 69 66 20 61 62 6f nt of the if abo
9b30: 76 65 3f 0a 09 20 20 20 20 20 20 3b 3b 20 42 55 ve?.. ;; BU
9b40: 47 20 77 61 73 20 74 68 69 73 20 6d 65 61 6e 74 G was this meant
9b50: 20 74 6f 20 62 65 20 74 68 65 20 61 6e 74 65 63 to be the antec
9b60: 6e 74 20 6f 66 20 74 68 65 20 69 66 20 61 62 6f nt of the if abo
9b70: 76 65 3f 0a 09 20 20 20 20 20 20 28 74 65 73 74 ve?.. (test
9b80: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 s:summarize-test
9b90: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
9ba0: 20 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 ;; don't force
9bb0: 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 - just update i
9bc0: 66 20 6e 6f 0a 20 20 20 20 20 20 20 20 20 20 20 f no.
9bd0: 20 20 20 3b 3b 20 4c 65 61 76 65 20 61 20 2e 66 ;; Leave a .f
9be0: 69 6e 61 6c 2d 73 74 61 74 75 73 20 66 69 6c 65 inal-status file
9bf0: 20 66 6f 72 20 74 68 65 20 74 6f 70 20 6c 65 76 for the top lev
9c00: 65 6c 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 el test.
9c10: 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 61 76 (tests:sav
9c20: 65 2d 66 69 6e 61 6c 2d 73 74 61 74 75 73 20 72 e-final-status r
9c30: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
9c40: 20 20 20 20 20 20 28 72 6d 74 3a 75 70 64 61 74 (rmt:updat
9c50: 65 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 6e 2d e-run-stats run-
9c60: 69 64 20 28 72 6d 74 3a 67 65 74 2d 72 61 77 2d id (rmt:get-raw-
9c70: 72 75 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 run-stats run-id
9c80: 29 29 29 20 3b 3b 20 65 6e 64 20 6f 66 20 6c 65 ))) ;; end of le
9c90: 74 2a 0a 0a 09 20 20 20 20 28 6d 75 74 65 78 2d t*... (mutex-
9ca0: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 20 20 20 20 20 unlock! m).
9cb0: 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 (launch:e
9cc0: 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 65 63 6b 20 nd-of-run-check
9cd0: 72 75 6e 2d 69 64 20 29 0a 09 20 20 20 20 28 64 run-id ).. (d
9ce0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
9cf0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9d00: 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e "Output from run
9d10: 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 ning " fullrunsc
9d20: 72 69 70 74 20 22 2c 20 70 69 64 20 22 20 28 6c ript ", pid " (l
9d30: 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 20 65 aunch:einf-pid e
9d40: 78 69 74 2d 69 6e 66 6f 29 20 22 20 69 6e 20 77 xit-info) " in w
9d50: 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 20 ork area " ....
9d60: 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d work-area ":\n==
9d70: 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 ==\n exit code "
9d80: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 (launch:einf-ex
9d90: 69 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 it-code exit-inf
9da0: 6f 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 o) "\n" "====\n"
9db0: 29 0a 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 )...
9dc0: 28 73 65 74 21 20 74 65 73 74 2d 73 74 61 74 75 (set! test-statu
9dd0: 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 s (db:test-get-s
9de0: 74 61 74 75 73 20 28 72 6d 74 3a 67 65 74 2d 74 tatus (rmt:get-t
9df0: 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 estinfo-state-st
9e00: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
9e10: 2d 69 64 29 29 29 0a 0a 20 20 20 20 20 20 20 20 -id)))..
9e20: 20 20 20 20 3b 3b 20 49 66 20 74 68 65 20 70 72 ;; If the pr
9e30: 6f 70 61 67 61 74 65 2d 65 78 69 74 2d 63 6f 64 opagate-exit-cod
9e40: 65 20 6f 70 74 69 6f 6e 20 68 61 73 20 62 65 65 e option has bee
9e50: 6e 20 73 65 74 20 69 6e 20 74 68 65 20 6d 65 67 n set in the meg
9e60: 61 74 65 73 74 20 63 6f 6e 66 69 67 2c 20 61 6e atest config, an
9e70: 64 20 74 68 65 20 74 65 73 74 20 73 74 61 74 75 d the test statu
9e80: 73 20 6d 61 74 63 68 65 73 20 74 68 65 20 6c 69 s matches the li
9e90: 73 74 2c 20 73 65 74 20 74 68 65 20 65 78 69 74 st, set the exit
9ea0: 20 63 6f 64 65 20 74 6f 20 31 2e 0a 0a 20 20 20 code to 1...
9eb0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
9ec0: 64 20 70 72 6f 70 61 67 61 74 65 2d 65 78 69 74 d propagate-exit
9ed0: 2d 63 6f 64 65 20 28 73 74 72 69 6e 67 3d 3f 20 -code (string=?
9ee0: 70 72 6f 70 61 67 61 74 65 2d 65 78 69 74 2d 63 propagate-exit-c
9ef0: 6f 64 65 20 22 79 65 73 22 29 20 28 6d 65 6d 62 ode "yes") (memb
9f00: 65 72 20 74 65 73 74 2d 73 74 61 74 75 73 20 70 er test-status p
9f10: 72 6f 70 61 67 61 74 65 2d 73 74 61 74 75 73 2d ropagate-status-
9f20: 6c 69 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 list)).
9f30: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
9f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
9f50: 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
9f60: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9f70: 53 65 74 74 69 6e 67 20 65 78 69 74 20 73 74 61 Setting exit sta
9f80: 74 75 73 20 74 6f 20 31 20 62 65 63 61 75 73 65 tus to 1 because
9f90: 20 6f 66 20 74 65 73 74 20 73 74 61 74 75 73 20 of test status
9fa0: 6f 66 20 22 20 74 65 73 74 2d 73 74 61 74 75 73 of " test-status
9fb0: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
9fc0: 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c (set! *global
9fd0: 65 78 69 74 73 74 61 74 75 73 2a 20 31 29 0a 20 exitstatus* 1).
9fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 0a ).
9ff0: 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 0a 09 )...
a000: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
a010: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 unch:einf-exit-s
a020: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
a030: 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 0a )...(exit 4)))).
a040: 20 20 20 20 20 20 20 20 29 29 29 0a 0a 3b 3b 20 )))..;;
a050: 53 70 65 63 20 66 6f 72 20 45 6e 64 20 6f 66 20 Spec for End of
a060: 74 65 73 74 0a 3b 3b 20 41 74 20 65 6e 64 20 6f test.;; At end o
a070: 66 20 65 61 63 68 20 74 65 73 74 20 63 61 6c 6c f each test call
a080: 2c 20 61 66 74 65 72 20 6d 61 72 6b 69 6e 67 20 , after marking
a090: 73 65 6c 66 20 61 73 20 43 4f 4d 50 4c 45 54 45 self as COMPLETE
a0a0: 44 20 64 6f 20 72 75 6e 2d 73 74 61 74 65 2d 73 D do run-state-s
a0b0: 74 61 74 75 73 2d 72 6f 6c 6c 75 70 0a 3b 3b 20 tatus-rollup.;;
a0c0: 41 74 20 74 72 61 6e 73 69 74 69 6f 6e 20 74 6f At transition to
a0d0: 20 72 75 6e 20 43 4f 4d 50 4c 45 54 45 44 2f 58 run COMPLETED/X
a0e0: 20 64 6f 20 68 6f 6f 6b 73 0a 3b 3b 20 44 65 66 do hooks.;; Def
a0f0: 69 6e 69 74 69 6f 6e 3a 20 74 65 73 74 5f 64 65 inition: test_de
a100: 61 64 20 69 66 20 65 76 65 6e 74 5f 74 69 6d 65 ad if event_time
a110: 20 2b 20 64 75 72 61 74 69 6f 6e 20 2b 20 31 20 + duration + 1
a120: 6d 69 6e 75 74 65 3f 20 3c 20 63 75 72 72 65 6e minute? < curren
a130: 74 5f 74 69 6d 65 20 41 4e 44 0a 3b 3b 20 77 65 t_time AND.;; we
a140: 20 63 61 6e 20 70 72 6f 76 65 20 74 68 65 20 70 can prove the p
a150: 72 6f 63 65 73 73 20 69 73 20 6e 6f 74 20 61 6c rocess is not al
a160: 69 76 65 20 28 73 73 68 20 68 6f 73 74 20 70 73 ive (ssh host ps
a170: 74 72 65 65 20 2d 41 20 70 69 64 29 0a 3b 3b 20 tree -A pid).;;
a180: 69 66 20 64 65 61 64 20 73 61 66 65 20 74 6f 20 if dead safe to
a190: 6d 61 72 6b 20 74 68 65 20 74 65 73 74 20 61 73 mark the test as
a1a0: 20 6b 69 6c 6c 65 64 20 69 6e 20 74 68 65 20 64 killed in the d
a1b0: 62 0a 3b 3b 20 53 74 61 74 65 2f 73 74 61 74 75 b.;; State/statu
a1c0: 73 20 74 61 62 6c 65 0a 3b 3b 20 6e 65 77 0a 3b s table.;; new.;
a1d0: 3b 20 31 30 30 25 20 43 4f 4d 50 4c 45 54 45 44 ; 100% COMPLETED
a1e0: 2f 20 28 50 41 53 53 2c 46 41 49 4c 2c 41 42 4f / (PASS,FAIL,ABO
a1f0: 52 54 20 65 74 63 2e 29 20 3d 3d 3e 20 43 4f 4d RT etc.) ==> COM
a200: 50 4c 45 54 45 44 20 2f 20 58 20 77 68 65 72 65 PLETED / X where
a210: 20 58 20 69 73 20 73 61 6d 65 20 61 73 20 69 74 X is same as it
a220: 65 6d 69 7a 65 64 20 72 6f 6c 6c 75 70 0a 3b 3b emized rollup.;;
a230: 20 3e 20 33 20 52 55 4e 4e 49 4e 47 20 77 69 74 > 3 RUNNING wit
a240: 68 20 6e 6f 74 20 74 65 73 74 5f 64 65 61 64 20 h not test_dead
a250: 64 6f 20 6e 6f 74 68 69 6e 67 20 28 72 75 6e 20 do nothing (run
a260: 73 68 6f 75 6c 64 20 61 6c 72 65 61 64 79 20 62 should already b
a270: 65 20 52 55 4e 4e 49 4e 47 2f 20 6e 61 0a 3b 3b e RUNNING/ na.;;
a280: 20 3e 20 30 20 52 55 4e 4e 49 4e 47 20 61 6e 64 > 0 RUNNING and
a290: 20 74 65 73 74 5f 64 65 61 64 20 74 68 65 6e 20 test_dead then
a2a0: 73 65 6e 64 20 4b 49 4c 4c 52 45 51 20 3d 3d 3e send KILLREQ ==>
a2b0: 20 43 4f 4d 50 4c 45 54 45 44 0a 3b 3b 20 30 20 COMPLETED.;; 0
a2c0: 52 55 4e 4e 49 4e 47 20 3d 3d 3e 20 74 68 69 73 RUNNING ==> this
a2d0: 20 69 73 20 61 63 74 75 61 6c 6c 79 20 74 68 65 is actually the
a2e0: 20 66 69 72 73 74 20 63 6f 6e 64 69 74 69 6f 6e first condition
a2f0: 2c 20 73 68 6f 75 6c 64 20 6e 6f 74 20 67 65 74 , should not get
a300: 20 68 65 72 65 0a 28 64 65 66 69 6e 65 20 2a 6c here.(define *l
a310: 61 73 74 2d 72 6f 6c 6c 75 70 2a 20 30 29 0a 28 ast-rollup* 0).(
a320: 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 65 define (launch:e
a330: 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 65 63 6b 20 nd-of-run-check
a340: 72 75 6e 2d 69 64 20 29 0a 20 20 20 20 28 6c 65 run-id ). (le
a350: 74 2a 20 28 28 6e 6f 74 2d 63 6f 6d 70 6c 65 74 t* ((not-complet
a360: 65 64 2d 63 6e 74 20 28 72 6d 74 3a 67 65 74 2d ed-cnt (rmt:get-
a370: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e not-completed-cn
a380: 74 20 72 75 6e 2d 69 64 29 29 20 20 0a 20 20 20 t run-id)) .
a390: 20 20 20 20 20 20 20 20 28 72 75 6e 6e 69 6e 67 (running
a3a0: 2d 63 6e 74 20 20 20 20 20 20 20 28 72 6d 74 3a -cnt (rmt:
a3b0: 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 73 2d get-count-tests-
a3c0: 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 6e 2d running-for-run-
a3d0: 69 64 20 72 75 6e 2d 69 64 29 29 0a 20 20 20 20 id run-id)).
a3e0: 20 20 20 20 20 20 20 28 61 6c 6c 2d 74 65 73 74 (all-test
a3f0: 2d 6c 61 75 6e 63 68 65 64 20 28 72 6d 74 3a 67 -launched (rmt:g
a400: 65 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 6c 75 et-var (conc "lu
a410: 6e 63 68 2d 63 6f 6d 70 6c 65 74 65 2d 22 20 72 nch-complete-" r
a420: 75 6e 2d 69 64 29 29 29 0a 09 20 20 20 28 63 75 un-id))).. (cu
a430: 72 72 65 6e 74 2d 73 74 61 74 65 2d 73 74 61 74 rrent-state-stat
a440: 75 73 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e 2d us (rmt:get-run-
a450: 73 74 61 74 65 2d 73 74 61 74 75 73 20 72 75 6e state-status run
a460: 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 -id)).
a470: 20 28 63 75 72 72 65 6e 74 2d 73 74 61 74 65 20 (current-state
a480: 20 20 20 20 20 20 20 28 63 61 72 20 63 75 72 72 (car curr
a490: 65 6e 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 ent-state-status
a4a0: 29 29 20 20 3b 3b 20 28 72 6d 74 3a 67 65 74 2d )) ;; (rmt:get-
a4b0: 72 75 6e 2d 73 74 61 74 65 20 72 75 6e 2d 69 64 run-state run-id
a4c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 )). (c
a4d0: 75 72 72 65 6e 74 2d 73 74 61 74 75 73 20 20 20 urrent-status
a4e0: 20 20 20 20 28 63 64 72 20 63 75 72 72 65 6e 74 (cdr current
a4f0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 29 29 29 -state-status)))
a500: 20 3b 3b 20 28 72 6d 74 3a 67 65 74 2d 72 75 6e ;; (rmt:get-run
a510: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 29 29 -status run-id))
a520: 29 0a 20 20 20 20 20 20 3b 3b 67 65 74 2d 76 61 ). ;;get-va
a530: 72 73 20 72 75 6e 2d 69 64 20 74 6f 20 71 75 65 rs run-id to que
a540: 72 79 20 6d 65 74 61 64 61 74 61 20 74 61 62 6c ry metadata tabl
a550: 65 20 74 6f 20 63 68 65 63 6b 20 69 66 20 61 6c e to check if al
a560: 6c 20 63 6f 6d 70 6c 65 74 65 64 2e 20 69 66 20 l completed. if
a570: 61 6c 6c 2d 74 65 73 74 2d 6c 61 75 6e 63 68 65 all-test-launche
a580: 64 20 3d 20 79 65 73 20 74 68 65 6e 20 6f 6e 6c d = yes then onl
a590: 79 20 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d y not-completed-
a5a0: 63 6e 74 20 3d 20 30 20 6d 65 61 6e 73 20 65 76 cnt = 0 means ev
a5b0: 65 72 79 74 69 6e 67 20 69 73 20 63 6f 6d 70 6c eryting is compl
a5c0: 65 74 65 64 20 69 66 20 6e 6f 20 65 6e 74 72 79 eted if no entry
a5d0: 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 74 61 found in the ta
a5e0: 62 6c 65 20 64 6f 20 6e 6f 74 68 69 6e 67 20 0a ble do nothing .
a5f0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
a600: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
a610: 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 6e 67 g-port* "Running
a620: 20 74 65 73 74 20 63 6e 74 20 3a 22 20 72 75 6e test cnt :" run
a630: 6e 69 6e 67 2d 63 6e 74 29 0a 20 20 20 20 20 20 ning-cnt).
a640: 3b 3b 0a 20 20 20 20 20 20 3b 3b 20 54 4f 44 4f ;;. ;; TODO
a650: 3a 20 61 64 64 20 61 20 66 69 6e 61 6c 20 72 6f : add a final ro
a660: 6c 6c 75 70 20 77 68 65 6e 20 72 75 6e 20 69 73 llup when run is
a670: 20 64 6f 6e 65 20 28 69 66 20 74 68 65 72 65 20 done (if there
a680: 69 73 6e 27 74 20 6f 6e 65 20 61 6c 72 65 61 64 isn't one alread
a690: 79 29 0a 20 20 20 20 20 20 3b 3b 0a 20 20 20 20 y). ;;.
a6a0: 20 20 28 69 66 20 28 6f 72 20 28 3c 20 72 75 6e (if (or (< run
a6b0: 6e 69 6e 67 2d 63 6e 74 20 33 29 20 20 20 20 20 ning-cnt 3)
a6c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a6d0: 20 20 20 20 20 20 20 20 20 3b 3b 20 68 61 76 65 ;; have
a6e0: 20 6f 6e 6c 79 20 66 65 77 20 72 75 6e 6e 69 6e only few runnin
a6f0: 67 0a 09 20 20 20 20 20 20 28 3e 20 28 2d 20 28 g.. (> (- (
a700: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
a710: 20 2a 6c 61 73 74 2d 72 6f 6c 6c 75 70 2a 29 20 *last-rollup*)
a720: 31 30 29 29 20 20 20 20 3b 3b 20 6f 72 20 68 61 10)) ;; or ha
a730: 76 65 6e 27 74 20 72 6f 6c 6c 65 64 20 75 70 20 ven't rolled up
a740: 69 6e 20 70 61 73 74 20 74 65 6e 20 73 65 63 6f in past ten seco
a750: 6e 64 73 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 nds.. (begin..
a760: 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 (rmt:set-stat
a770: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
a780: 6c 2d 75 70 2d 72 75 6e 20 20 72 75 6e 2d 69 64 l-up-run run-id
a790: 20 63 75 72 72 65 6e 74 2d 73 74 61 74 65 20 63 current-state c
a7a0: 75 72 72 65 6e 74 2d 73 74 61 74 75 73 29 0a 09 urrent-status)..
a7b0: 20 20 20 20 28 73 65 74 21 20 2a 6c 61 73 74 2d (set! *last-
a7c0: 72 6f 6c 6c 75 70 2a 20 28 63 75 72 72 65 6e 74 rollup* (current
a7d0: 2d 73 65 63 6f 6e 64 73 29 29 29 29 0a 20 20 20 -seconds)))).
a7e0: 20 20 28 72 75 6e 73 3a 75 70 64 61 74 65 2d 6a (runs:update-j
a7f0: 75 6e 69 74 2d 74 65 73 74 2d 72 65 70 6f 72 74 unit-test-report
a800: 65 72 2d 78 6d 6c 20 72 75 6e 2d 69 64 29 20 0a er-xml run-id) .
a810: 20 20 20 20 20 28 63 6f 6e 64 20 0a 20 20 20 20 (cond .
a820: 20 20 20 28 28 61 6e 64 20 61 6c 6c 2d 74 65 73 ((and all-tes
a830: 74 2d 6c 61 75 6e 63 68 65 64 20 28 65 71 3f 20 t-launched (eq?
a840: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e not-completed-cn
a850: 74 20 30 29 20 28 65 71 75 61 6c 3f 20 61 6c 6c t 0) (equal? all
a860: 2d 74 65 73 74 2d 6c 61 75 6e 63 68 65 64 20 22 -test-launched "
a870: 79 65 73 22 20 29 29 0a 20 20 20 20 20 20 20 20 yes" )).
a880: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
a890: 20 28 65 71 75 61 6c 3f 20 28 72 6d 74 3a 67 65 (equal? (rmt:ge
a8a0: 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 65 6e 64 t-var (conc "end
a8b0: 2d 6f 66 2d 72 75 6e 2d 22 20 72 75 6e 2d 69 64 -of-run-" run-id
a8c0: 29 29 20 22 6e 6f 22 29 20 28 63 6f 6d 6d 6f 6e )) "no") (common
a8d0: 3a 73 69 6d 70 6c 65 2d 6c 6f 63 6b 20 28 63 6f :simple-lock (co
a8e0: 6e 63 20 22 65 6e 64 4f 66 52 75 6e 22 20 72 75 nc "endOfRun" ru
a8f0: 6e 2d 69 64 29 29 29 0a 20 20 20 20 20 20 20 20 n-id))).
a900: 20 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 (begin.
a910: 20 20 20 20 20 20 20 20 20 20 09 28 64 65 62 75 .(debu
a920: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
a930: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6c 6f lt-log-port* "lo
a940: 6f 6b 20 66 6f 72 20 20 70 6f 73 74 20 68 6f 6f ok for post hoo
a950: 6b 2e 20 63 75 72 72 73 65 63 6f 6e 64 73 3a 20 k. currseconds:
a960: 22 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e " (current-secon
a970: 64 73 29 20 22 20 45 4f 52 20 22 20 28 72 6d 74 ds) " EOR " (rmt
a980: 3a 67 65 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 :get-var (conc "
a990: 65 6e 64 2d 6f 66 2d 72 75 6e 2d 22 20 72 75 6e end-of-run-" run
a9a0: 2d 69 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 -id))).
a9b0: 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 (debug:pr
a9c0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
a9d0: 6f 67 2d 70 6f 72 74 2a 20 22 45 6e 64 20 6f 66 og-port* "End of
a9e0: 20 52 75 6e 20 44 65 74 65 63 74 65 64 2e 22 29 Run Detected.")
a9f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aa00: 20 28 72 6d 74 3a 73 65 74 2d 76 61 72 20 28 63 (rmt:set-var (c
aa10: 6f 6e 63 20 22 65 6e 64 2d 6f 66 2d 72 75 6e 2d onc "end-of-run-
aa20: 22 20 72 75 6e 2d 69 64 29 20 22 79 65 73 22 29 " run-id) "yes")
aa30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aa40: 20 3b 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ;(thread-sleep!
aa50: 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 20 09 10). .
aa60: 28 72 75 6e 73 3a 72 75 6e 2d 70 6f 73 74 2d 68 (runs:run-post-h
aa70: 6f 6f 6b 20 72 75 6e 2d 69 64 29 0a 20 20 20 20 ook run-id).
aa80: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
aa90: 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 ug:print 4 *defa
aaa0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 ult-log-port* "c
aab0: 75 72 72 73 65 63 6f 6e 64 73 3a 20 22 20 28 63 urrseconds: " (c
aac0: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 22 urrent-seconds)"
aad0: 20 65 6f 72 3a 20 22 20 28 72 6d 74 3a 67 65 74 eor: " (rmt:get
aae0: 2d 76 61 72 20 28 63 6f 6e 63 20 22 65 6e 64 2d -var (conc "end-
aaf0: 6f 66 2d 72 75 6e 2d 22 20 72 75 6e 2d 69 64 29 of-run-" run-id)
ab00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
ab10: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c (common:simpl
ab20: 65 2d 75 6e 6c 6f 63 6b 20 28 63 6f 6e 63 20 22 e-unlock (conc "
ab30: 65 6e 64 4f 66 52 75 6e 22 20 72 75 6e 2d 69 64 endOfRun" run-id
ab40: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
ab50: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
ab60: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
ab70: 2d 70 6f 72 74 2a 20 22 45 6e 64 20 6f 66 20 52 -port* "End of R
ab80: 75 6e 20 44 65 74 65 63 74 65 64 20 62 75 74 20 un Detected but
ab90: 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 70 6f 73 74 not running post
aba0: 20 68 6f 6f 6b 2e 20 54 68 69 73 20 73 68 6f 75 hook. This shou
abb0: 6c 64 20 68 61 70 70 65 6e 20 77 68 65 6e 20 65 ld happen when e
abc0: 6f 72 20 69 73 20 73 65 74 20 74 6f 20 79 65 73 or is set to yes
abd0: 2e 20 54 68 69 73 20 77 69 6c 6c 20 68 61 70 70 . This will happ
abe0: 65 6e 20 6f 6e 6c 79 20 77 68 65 6e 20 32 20 74 en only when 2 t
abf0: 65 73 74 73 20 65 78 69 74 20 61 74 20 73 6d 61 ests exit at sma
ac00: 65 20 74 69 6d 65 2e 20 65 6f 72 3d 20 22 20 28 e time. eor= " (
ac10: 72 6d 74 3a 67 65 74 2d 76 61 72 20 28 63 6f 6e rmt:get-var (con
ac20: 63 20 22 65 6e 64 2d 6f 66 2d 72 75 6e 2d 22 20 c "end-of-run-"
ac30: 72 75 6e 2d 69 64 29 29 29 29 29 0a 20 20 20 20 run-id))))).
ac40: 20 20 20 20 28 28 3e 20 72 75 6e 6e 69 6e 67 2d ((> running-
ac50: 63 6e 74 20 33 29 20 0a 20 20 20 20 20 20 20 20 cnt 3) .
ac60: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
ac70: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
ac80: 6f 72 74 2a 20 22 54 68 65 72 65 20 61 72 65 20 ort* "There are
ac90: 22 20 72 75 6e 6e 69 6e 67 2d 63 6e 74 20 22 20 " running-cnt "
aca0: 74 65 73 74 73 20 72 75 6e 6e 69 6e 67 2e 22 20 tests running."
acb0: 29 29 0a 20 20 20 20 20 20 20 20 28 28 3e 20 72 )). ((> r
acc0: 75 6e 6e 69 6e 67 2d 63 6e 74 20 30 29 0a 20 20 unning-cnt 0).
acd0: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
ace0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
acf0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 75 6e t-log-port* "run
ad00: 6e 69 6e 67 20 63 6e 74 20 3e 20 30 20 62 75 74 ning cnt > 0 but
ad10: 20 3c 3d 20 33 20 6b 69 6c 6c 2d 72 75 6e 6e 69 <= 3 kill-runni
ad20: 6e 67 2d 74 65 73 74 73 2d 69 66 2d 64 65 61 64 ng-tests-if-dead
ad30: 22 20 29 0a 20 20 20 09 09 09 09 20 20 28 6c 65 " ). .... (le
ad40: 74 20 28 28 6b 69 6c 6c 2d 63 6e 74 20 28 6c 61 t ((kill-cnt (la
ad50: 75 6e 63 68 3a 6b 69 6c 6c 2d 74 65 73 74 73 2d unch:kill-tests-
ad60: 69 66 2d 64 65 61 64 20 72 75 6e 2d 69 64 29 29 if-dead run-id))
ad70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 09 09 09 ). ...
ad80: 28 69 66 20 28 61 6e 64 20 61 6c 6c 2d 74 65 73 (if (and all-tes
ad90: 74 2d 6c 61 75 6e 63 68 65 64 20 20 28 65 71 75 t-launched (equ
ada0: 61 6c 3f 20 61 6c 6c 2d 74 65 73 74 2d 6c 61 75 al? all-test-lau
adb0: 6e 63 68 65 64 20 22 79 65 73 22 29 20 28 65 71 nched "yes") (eq
adc0: 3f 20 6b 69 6c 6c 2d 63 6e 74 20 72 75 6e 6e 69 ? kill-cnt runni
add0: 6e 67 2d 63 6e 74 29 29 0a 20 20 20 20 20 20 20 ng-cnt)).
ade0: 20 20 20 20 09 09 09 09 09 28 6c 61 75 6e 63 68 .....(launch
adf0: 3a 65 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 65 63 :end-of-run-chec
ae00: 6b 20 72 75 6e 2d 69 64 29 29 29 29 20 3b 3b 74 k run-id)))) ;;t
ae10: 6f 64 6f 0a 20 20 20 20 20 20 20 20 28 65 6c 73 odo. (els
ae20: 65 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 e (debug:print
ae30: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
ae40: 6f 72 74 2a 20 22 53 68 6f 75 6c 64 20 69 74 20 ort* "Should it
ae50: 67 65 74 20 68 65 72 65 3f 3f 20 4d 61 79 20 62 get here?? May b
ae60: 65 20 65 76 65 72 79 74 68 69 6e 67 20 69 73 20 e everything is
ae70: 6e 6f 74 20 6c 61 75 6e 63 68 65 64 20 79 65 74 not launched yet
ae80: 2e 20 52 75 6e 6e 69 6e 67 20 74 65 73 74 20 63 . Running test c
ae90: 6e 74 3a 22 20 72 75 6e 6e 69 6e 67 2d 63 6e 74 nt:" running-cnt
aea0: 20 22 20 4e 6f 74 20 63 6f 6d 70 6c 65 74 65 64 " Not completed
aeb0: 20 74 65 73 74 20 63 6e 74 3a 22 20 6e 6f 74 2d test cnt:" not-
aec0: 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 29 0a 20 completed-cnt).
aed0: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
aee0: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 74 65 not-completed-te
aef0: 73 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 sts (rmt:get-tes
af00: 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e 2d 69 ts-for-run run-i
af10: 64 20 22 25 22 20 60 28 22 4e 4f 54 5f 53 54 41 d "%" `("NOT_STA
af20: 52 54 45 44 22 20 22 52 55 4e 4e 49 4e 47 22 20 RTED" "RUNNING"
af30: 22 4c 41 55 4e 43 48 45 44 22 20 22 52 45 4d 4f "LAUNCHED" "REMO
af40: 54 45 48 4f 53 54 53 54 41 52 54 22 29 20 60 28 TEHOSTSTART") `(
af50: 29 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 ) #f #f #f #f #f
af60: 20 23 66 20 23 66 20 23 66 29 29 29 0a 20 20 20 #f #f #f))).
af70: 20 20 20 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 (if (> (leng
af80: 74 68 20 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 th not-completed
af90: 2d 74 65 73 74 73 29 20 30 29 20 0a 20 20 20 20 -tests) 0) .
afa0: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 (let loop
afb0: 20 28 28 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 ((running-test
afc0: 28 63 61 72 20 6e 6f 74 2d 63 6f 6d 70 6c 65 74 (car not-complet
afd0: 65 64 2d 74 65 73 74 73 29 29 0a 09 09 09 20 20 ed-tests))....
afe0: 20 20 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 (tal (cdr
aff0: 6e 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 74 65 not-completed-te
b000: 73 74 73 29 29 29 0a 09 09 20 20 20 20 20 20 20 sts)))...
b010: 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d (let* ((test-nam
b020: 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 e (vector-ref ru
b030: 6e 6e 69 6e 67 2d 74 65 73 74 20 32 29 29 0a 20 nning-test 2)).
b040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b050: 28 69 74 65 6d 2d 70 61 74 68 20 28 76 65 63 74 (item-path (vect
b060: 6f 72 2d 72 65 66 20 72 75 6e 6e 69 6e 67 2d 74 or-ref running-t
b070: 65 73 74 20 31 31 29 29 29 0a 09 09 09 20 20 20 est 11)))....
b080: 20 20 20 20 09 28 64 65 62 75 67 3a 70 72 69 6e .(debug:prin
b090: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
b0a0: 2d 70 6f 72 74 2a 20 22 74 65 73 74 20 22 20 74 -port* "test " t
b0b0: 65 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 est-name "/" ite
b0c0: 6d 2d 70 61 74 68 20 22 20 6e 6f 74 20 63 6f 6d m-path " not com
b0d0: 70 6c 65 74 65 64 22 29 0a 20 20 20 20 20 20 20 pleted").
b0e0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
b0f0: 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 0a 09 09 20 (null? tal))...
b100: 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 (loop (car tal)
b110: 20 28 63 64 72 20 74 61 6c 29 29 29 29 29 29 29 (cdr tal)))))))
b120: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c ))))..(define (l
b130: 61 75 6e 63 68 3a 6b 69 6c 6c 2d 74 65 73 74 73 aunch:kill-tests
b140: 2d 69 66 2d 64 65 61 64 20 72 75 6e 2d 69 64 29 -if-dead run-id)
b150: 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 6e 69 . (let* ((runni
b160: 6e 67 2d 74 65 73 74 73 20 28 72 6d 74 3a 67 65 ng-tests (rmt:ge
b170: 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 t-tests-for-run
b180: 72 75 6e 2d 69 64 20 22 25 22 20 60 28 22 52 55 run-id "%" `("RU
b190: 4e 4e 49 4e 47 22 20 22 4c 41 55 4e 43 48 45 44 NNING" "LAUNCHED
b1a0: 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 " "REMOTEHOSTSTA
b1b0: 52 54 22 29 20 60 28 29 20 23 66 20 23 66 20 23 RT") `() #f #f #
b1c0: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
b1d0: 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 ))). (let
b1e0: 6c 6f 6f 70 20 28 28 72 75 6e 6e 69 6e 67 2d 74 loop ((running-t
b1f0: 65 73 74 20 28 63 61 72 20 72 75 6e 6e 69 6e 67 est (car running
b200: 2d 74 65 73 74 73 29 29 0a 09 09 09 20 20 20 20 -tests))....
b210: 20 28 74 61 6c 20 20 20 20 28 63 64 72 20 72 75 (tal (cdr ru
b220: 6e 6e 69 6e 67 2d 74 65 73 74 73 29 29 0a 09 09 nning-tests))...
b230: 09 20 20 20 20 20 28 6b 69 6c 6c 2d 63 6e 74 20 . (kill-cnt
b240: 30 29 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 0))... (le
b250: 74 2a 20 28 28 74 65 73 74 2d 6e 61 6d 65 20 28 t* ((test-name (
b260: 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 6e 69 vector-ref runni
b270: 6e 67 2d 74 65 73 74 20 32 29 29 0a 20 20 20 20 ng-test 2)).
b280: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 74 (it
b290: 65 6d 2d 70 61 74 68 20 28 76 65 63 74 6f 72 2d em-path (vector-
b2a0: 72 65 66 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 ref running-test
b2b0: 20 31 31 29 29 0a 09 09 20 28 74 65 73 74 2d 69 11))... (test-i
b2c0: 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 d (vector-ref ru
b2d0: 6e 6e 69 6e 67 2d 74 65 73 74 20 30 29 29 0a 20 nning-test 0)).
b2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2f0: 28 68 6f 73 74 20 28 76 65 63 74 6f 72 2d 72 65 (host (vector-re
b300: 66 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 36 f running-test 6
b310: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b320: 20 20 20 20 28 70 69 64 20 20 28 72 6d 74 3a 74 (pid (rmt:t
b330: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
b340: 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 ess-pid run-id t
b350: 65 73 74 2d 69 64 29 29 20 20 20 0a 20 20 20 20 est-id)) .
b360: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 76 (ev
b370: 65 6e 74 2d 74 69 6d 65 20 28 76 65 63 74 6f 72 ent-time (vector
b380: 2d 72 65 66 20 72 75 6e 6e 69 6e 67 2d 74 65 73 -ref running-tes
b390: 74 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 t 5)).
b3a0: 20 20 20 20 20 20 20 28 64 75 72 61 74 69 6f 6e (duration
b3b0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 72 75 6e (vector-ref run
b3c0: 6e 69 6e 67 2d 74 65 73 74 20 31 32 29 29 0a 20 ning-test 12)).
b3d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3e0: 28 66 6c 61 67 20 30 29 20 20 20 0a 20 20 20 20 (flag 0) .
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 75 (cu
b400: 72 72 2d 74 69 6d 65 20 28 63 75 72 72 65 6e 74 rr-time (current
b410: 2d 73 65 63 6f 6e 64 73 29 29 29 0a 20 20 20 20 -seconds))).
b420: 20 20 20 28 69 66 20 28 61 6e 64 20 28 3c 20 28 (if (and (< (
b430: 2b 20 65 76 65 6e 74 2d 74 69 6d 65 20 64 75 72 + event-time dur
b440: 61 74 69 6f 6e 20 36 30 30 29 20 63 75 72 72 2d ation 600) curr-
b450: 74 69 6d 65 29 20 28 6e 6f 74 20 28 63 6f 6d 6d time) (not (comm
b460: 6f 6e 6d 6f 64 3a 69 73 2d 74 65 73 74 2d 61 6c onmod:is-test-al
b470: 69 76 65 20 68 6f 73 74 20 70 69 64 29 29 29 20 ive host pid)))
b480: 3b 3b 74 65 73 74 20 68 61 73 20 6e 6f 74 20 75 ;;test has not u
b490: 70 64 61 74 65 64 20 64 75 72 61 74 69 6f 6e 20 pdated duration
b4a0: 69 6e 20 6c 61 73 74 20 31 30 20 6d 69 6e 20 74 in last 10 min t
b4b0: 68 65 6e 20 6c 69 6b 65 6c 79 20 69 74 73 20 6e hen likely its n
b4c0: 6f 74 20 72 75 6e 6e 69 6e 67 20 62 75 74 20 63 ot running but c
b4d0: 6f 6e 66 69 72 6d 20 62 65 66 6f 72 65 20 6d 61 onfirm before ma
b4e0: 72 6b 69 6e 67 20 69 74 20 61 73 20 6b 69 6c 6c rking it as kill
b4f0: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 28 62 ed. (b
b500: 65 67 69 6e 20 20 20 20 0a 09 09 09 20 20 20 20 egin ....
b510: 20 20 20 09 28 64 65 62 75 67 3a 70 72 69 6e 74 .(debug:print
b520: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
b530: 70 6f 72 74 2a 20 22 74 65 73 74 20 22 20 74 65 port* "test " te
b540: 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d st-name "/" item
b550: 2d 70 61 74 68 20 22 20 6e 65 65 64 73 20 74 6f -path " needs to
b560: 20 62 65 20 6b 69 6c 6c 65 64 22 29 0a 20 20 20 be killed").
b570: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
b580: 20 66 6c 61 67 20 31 29 20 0a 20 20 20 20 20 20 flag 1) .
b590: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 73 65 74 (rmt:set
b5a0: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e -state-status-an
b5b0: 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 d-roll-up-items
b5c0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 run-id test-name
b5d0: 20 69 74 65 6d 2d 70 61 74 68 20 22 4b 49 4c 4c item-path "KILL
b5e0: 52 45 51 22 20 22 6e 2f 61 22 20 23 66 29 29 29 REQ" "n/a" #f)))
b5f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b600: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
b610: 74 61 6c 29 29 0a 09 09 09 09 20 20 28 6c 6f 6f tal))..... (loo
b620: 70 20 28 63 61 72 20 74 61 6c 29 20 28 63 64 72 p (car tal) (cdr
b630: 20 74 61 6c 29 20 28 2b 20 6b 69 6c 6c 2d 63 6e tal) (+ kill-cn
b640: 74 20 66 6c 61 67 29 29 0a 20 20 20 20 20 20 20 t flag)).
b650: 20 20 20 20 20 20 20 20 20 20 28 2b 20 6b 69 6c (+ kil
b660: 6c 2d 63 6e 74 20 66 6c 61 67 29 29 29 29 29 29 l-cnt flag))))))
b670: 0a 0a 3b 3b 20 44 4f 20 4e 4f 54 20 55 53 45 20 ..;; DO NOT USE
b680: 2d 20 63 61 63 68 69 6e 67 20 6f 66 20 63 6f 6e - caching of con
b690: 66 69 67 73 20 69 73 20 68 61 6e 64 6c 65 64 20 figs is handled
b6a0: 69 6e 20 6c 61 75 6e 63 68 3a 73 65 74 75 70 20 in launch:setup
b6b0: 6e 6f 77 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 now..;;.(define
b6c0: 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d 63 6f (launch:cache-co
b6d0: 6e 66 69 67 29 0a 20 20 3b 3b 20 69 66 20 77 65 nfig). ;; if we
b6e0: 20 68 61 76 65 20 61 20 6c 69 6e 6b 74 72 65 65 have a linktree
b6f0: 20 61 6e 64 20 2d 72 75 6e 74 65 73 74 73 20 61 and -runtests a
b700: 6e 64 20 2d 74 61 72 67 65 74 20 61 6e 64 20 74 nd -target and t
b710: 68 65 20 64 69 72 65 63 74 6f 72 79 20 65 78 69 he directory exi
b720: 73 74 73 20 64 75 6d 70 20 74 68 65 20 63 6f 6e sts dump the con
b730: 66 69 67 0a 20 20 3b 3b 20 74 6f 20 6d 65 67 61 fig. ;; to mega
b740: 74 65 73 74 2d 28 63 75 72 72 65 6e 74 2d 73 65 test-(current-se
b750: 63 6f 6e 64 73 29 2e 63 66 67 20 61 6e 64 20 73 conds).cfg and s
b760: 79 6d 6c 69 6e 6b 20 69 74 20 74 6f 20 6d 65 67 ymlink it to meg
b770: 61 74 65 73 74 2e 63 66 67 0a 20 20 28 69 66 20 atest.cfg. (if
b780: 28 61 6e 64 20 2a 63 6f 6e 66 69 67 64 61 74 2a (and *configdat*
b790: 20 0a 09 20 20 20 28 6f 72 20 28 61 72 67 73 3a .. (or (args:
b7a0: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 29 0a get-arg "-run").
b7b0: 09 20 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 . (args:ge
b7c0: 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 74 73 t-arg "-runtests
b7d0: 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 ").. (args
b7e0: 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 63 75 :get-arg "-execu
b7f0: 74 65 22 29 29 29 0a 20 20 20 20 20 20 28 6c 65 te"))). (le
b800: 74 2a 20 28 28 6c 69 6e 6b 74 72 65 65 20 28 63 t* ((linktree (c
b810: 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 ommon:get-linktr
b820: 65 65 29 29 20 3b 3b 20 28 67 65 74 2d 65 6e 76 ee)) ;; (get-env
b830: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
b840: 65 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 e "MT_LINKTREE")
b850: 29 0a 09 20 20 20 20 20 28 74 61 72 67 65 74 20 ).. (target
b860: 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 (common:args-g
b870: 65 74 2d 74 61 72 67 65 74 20 65 78 69 74 2d 69 et-target exit-i
b880: 66 2d 62 61 64 3a 20 23 74 29 29 0a 09 20 20 20 f-bad: #t))..
b890: 20 20 28 72 75 6e 6e 61 6d 65 20 20 28 6f 72 20 (runname (or
b8a0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
b8b0: 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 20 runname")....
b8c0: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 3a (args:get-arg ":
b8d0: 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 20 20 runname")....
b8e0: 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 4e (getenv "MT_RUNN
b8f0: 41 4d 45 22 29 29 29 0a 09 20 20 20 20 20 28 66 AME"))).. (f
b900: 75 6c 6c 64 69 72 20 20 28 63 6f 6e 63 20 6c 69 ulldir (conc li
b910: 6e 6b 74 72 65 65 20 22 2f 22 0a 09 09 09 20 20 nktree "/"....
b920: 20 20 20 74 61 72 67 65 74 20 22 2f 22 0a 09 09 target "/"...
b930: 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 29 29 29 . runname)))
b940: 0a 09 28 69 66 20 28 61 6e 64 20 6c 69 6e 6b 74 ..(if (and linkt
b950: 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 ree (common:file
b960: 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 72 65 -exists? linktre
b970: 65 29 29 20 3b 3b 20 63 61 6e 27 74 20 70 72 6f e)) ;; can't pro
b980: 63 65 65 64 20 77 69 74 68 6f 75 74 20 6c 69 6e ceed without lin
b990: 6b 74 72 65 65 0a 09 20 20 20 20 28 62 65 67 69 ktree.. (begi
b9a0: 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a n.. (debug:
b9b0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
b9c0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
b9d0: 22 48 61 76 65 20 2d 72 75 6e 20 77 69 74 68 20 "Have -run with
b9e0: 74 61 72 67 65 74 3d 22 20 74 61 72 67 65 74 20 target=" target
b9f0: 22 2c 20 72 75 6e 6e 61 6d 65 3d 22 20 72 75 6e ", runname=" run
ba00: 6e 61 6d 65 20 22 2c 20 66 75 6c 6c 64 69 72 3d name ", fulldir=
ba10: 22 20 66 75 6c 6c 64 69 72 20 22 2c 20 74 65 73 " fulldir ", tes
ba20: 74 70 61 74 74 3d 22 20 28 6f 72 20 28 61 72 67 tpatt=" (or (arg
ba30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 73 74 s:get-arg "-test
ba40: 70 61 74 74 22 29 20 22 25 22 29 29 0a 09 20 20 patt") "%"))..
ba50: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f (if (not (co
ba60: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
ba70: 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 20 20 ? fulldir))...
ba80: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
ba90: 79 20 66 75 6c 6c 64 69 72 20 23 74 29 29 20 3b y fulldir #t)) ;
baa0: 3b 20 6e 65 65 64 20 74 6f 20 70 72 6f 74 65 63 ; need to protec
bab0: 74 20 77 69 74 68 20 65 78 63 65 70 74 69 6f 6e t with exception
bac0: 20 68 61 6e 64 6c 65 72 20 0a 09 20 20 20 20 20 handler ..
bad0: 20 28 69 66 20 28 61 6e 64 20 74 61 72 67 65 74 (if (and target
bae0: 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e 61 6d ... runnam
baf0: 65 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6d 6d e... (comm
bb00: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
bb10: 66 75 6c 6c 64 69 72 29 29 0a 09 09 20 20 28 6c fulldir))... (l
bb20: 65 74 20 28 28 74 6d 70 66 69 6c 65 20 20 28 63 et ((tmpfile (c
bb30: 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 2f 2e 6d onc fulldir "/.m
bb40: 65 67 61 74 65 73 74 2e 63 66 67 2e 22 20 28 63 egatest.cfg." (c
bb50: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
bb60: 29 0a 09 09 09 28 74 61 72 67 66 69 6c 65 20 28 )....(targfile (
bb70: 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 2f 2e conc fulldir "/.
bb80: 6d 65 67 61 74 65 73 74 2e 63 66 67 2d 22 20 20 megatest.cfg-"
bb90: 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e megatest-version
bba0: 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d 66 6f "-" megatest-fo
bbb0: 73 73 69 6c 2d 68 61 73 68 29 29 0a 09 09 09 28 ssil-hash))....(
bbc0: 72 63 6f 6e 66 69 67 20 20 28 63 6f 6e 63 20 66 rconfig (conc f
bbd0: 75 6c 6c 64 69 72 20 22 2f 2e 72 75 6e 63 6f 6e ulldir "/.runcon
bbe0: 66 69 67 2e 22 20 6d 65 67 61 74 65 73 74 2d 76 fig." megatest-v
bbf0: 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 ersion "-" megat
bc00: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 est-fossil-hash)
bc10: 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 63 6f ))... (if (co
bc20: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
bc30: 3f 20 72 63 6f 6e 66 69 67 29 20 3b 3b 20 6f 6e ? rconfig) ;; on
bc40: 6c 79 20 63 61 63 68 65 20 6d 65 67 61 74 65 73 ly cache megates
bc50: 74 2e 63 6f 6e 66 69 67 20 41 46 54 45 52 20 72 t.config AFTER r
bc60: 75 6e 63 6f 6e 66 69 67 73 20 68 61 73 20 62 65 unconfigs has be
bc70: 65 6e 20 63 61 63 68 65 64 0a 09 09 09 28 62 65 en cached....(be
bc80: 67 69 6e 0a 09 09 09 20 20 28 64 65 62 75 67 3a gin.... (debug:
bc90: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
bca0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
bcb0: 22 43 61 63 68 69 6e 67 20 6d 65 67 61 74 65 73 "Caching megates
bcc0: 74 2e 63 6f 6e 66 69 67 20 69 6e 20 22 20 74 6d t.config in " tm
bcd0: 70 66 69 6c 65 29 0a 20 20 20 20 20 20 20 20 20 pfile).
bce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcf0: 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f (if (not (commo
bd00: 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d 74 65 73 n:in-running-tes
bd10: 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t?)).
bd20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd30: 20 20 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 (configf:writ
bd40: 65 2d 61 6c 69 73 74 20 2a 63 6f 6e 66 69 67 64 e-alist *configd
bd50: 61 74 2a 20 74 6d 70 66 69 6c 65 29 29 0a 09 09 at* tmpfile))...
bd60: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
bd70: 20 22 6c 6e 20 2d 73 66 20 22 20 74 6d 70 66 69 "ln -sf " tmpfi
bd80: 6c 65 20 22 20 22 20 74 61 72 67 66 69 6c 65 29 le " " targfile)
bd90: 29 29 29 0a 09 09 20 20 20 20 29 29 29 0a 09 20 )))... )))..
bda0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d (debug:print-
bdb0: 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c 74 2d info 1 *default-
bdc0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 6c 69 log-port* "No li
bdd0: 6e 6b 74 72 65 65 20 79 65 74 2c 20 6e 6f 20 63 nktree yet, no c
bde0: 61 63 68 69 6e 67 20 63 6f 6e 66 69 67 73 2e 22 aching configs."
bdf0: 29 29 29 29 29 0a 0a 0a 3b 3b 20 67 61 74 68 65 )))))...;; gathe
be00: 72 20 61 76 61 69 6c 61 62 6c 65 20 69 6e 66 6f r available info
be10: 72 6d 61 74 69 6f 6e 2c 20 69 66 20 6c 65 67 69 rmation, if legi
be20: 74 20 72 65 61 64 20 63 6f 6e 66 69 67 73 20 69 t read configs i
be30: 6e 20 74 68 69 73 20 6f 72 64 65 72 3a 0a 3b 3b n this order:.;;
be40: 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 63 61 .;; if have ca
be50: 63 68 65 3b 0a 3b 3b 20 20 20 20 20 20 72 65 61 che;.;; rea
be60: 64 20 69 74 20 61 20 72 65 74 75 72 6e 20 69 74 d it a return it
be70: 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 20 20 .;; else.;;
be80: 20 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 megatest.confi
be90: 67 20 20 20 20 20 28 64 6f 20 6e 6f 74 20 63 61 g (do not ca
bea0: 63 68 65 29 0a 3b 3b 20 20 20 20 20 72 75 6e 63 che).;; runc
beb0: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 20 20 onfigs.config
bec0: 28 63 61 63 68 65 20 69 66 20 61 6c 6c 20 76 61 (cache if all va
bed0: 72 73 20 61 76 61 69 6c 29 0a 3b 3b 20 20 20 20 rs avail).;;
bee0: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
bef0: 20 20 20 20 20 28 63 61 63 68 65 20 69 66 20 61 (cache if a
bf00: 6c 6c 20 76 61 72 73 20 61 76 61 69 6c 29 0a 3b ll vars avail).;
bf10: 3b 20 20 20 72 65 74 75 72 6e 73 3a 0a 3b 3b 20 ; returns:.;;
bf20: 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 0a 3b 3b *toppath*.;;
bf30: 20 20 20 73 69 64 65 20 65 66 66 65 63 74 73 3a side effects:
bf40: 0a 3b 3b 20 20 20 20 20 73 65 74 73 3b 20 2a 63 .;; sets; *c
bf50: 6f 6e 66 69 67 64 61 74 2a 20 20 20 20 28 6d 65 onfigdat* (me
bf60: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 69 6e gatest.config in
bf70: 66 6f 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 fo).;;
bf80: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 *runconfigdat*
bf90: 28 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 (runconfigs.conf
bfa0: 69 67 20 69 6e 66 6f 29 0a 3b 3b 20 20 20 20 20 ig info).;;
bfb0: 20 20 20 20 20 20 2a 63 6f 6e 66 69 67 73 74 61 *configsta
bfc0: 74 75 73 2a 20 28 73 74 61 74 75 73 20 6f 66 20 tus* (status of
bfd0: 74 68 65 20 72 65 61 64 20 64 61 74 61 29 0a 3b the read data).;
bfe0: 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ;.(define (launc
bff0: 68 3a 73 65 74 75 70 20 23 21 6b 65 79 20 28 66 h:setup #!key (f
c000: 6f 72 63 65 2d 72 65 72 65 61 64 20 23 66 29 20 orce-reread #f)
c010: 28 61 72 65 61 70 61 74 68 20 23 66 29 29 0a 20 (areapath #f)).
c020: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 6c (mutex-lock! *l
c030: 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 74 65 aunch-setup-mute
c040: 78 2a 29 0a 20 20 3b 3b 20 74 68 69 73 20 73 74 x*). ;; this st
c050: 6f 70 73 20 74 68 65 20 74 72 61 69 6e 20 71 75 ops the train qu
c060: 69 63 6b 6c 79 20 66 6f 72 20 6e 65 77 20 70 72 ickly for new pr
c070: 6f 63 65 73 73 65 73 0a 20 20 28 69 66 20 28 61 ocesses. (if (a
c080: 6e 64 20 2a 74 6f 70 70 61 74 68 2a 0a 09 20 20 nd *toppath*..
c090: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 (file-exists? (
c0a0: 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 22 2f conc *toppath*"/
c0b0: 73 74 6f 70 2d 74 68 65 2d 74 72 61 69 6e 22 29 stop-the-train")
c0c0: 29 29 0a 20 20 20 20 20 20 28 62 65 67 69 6e 0a )). (begin.
c0d0: 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 .(debug:print 0
c0e0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
c0f0: 74 2a 20 22 45 52 52 4f 52 3a 20 66 6f 75 6e 64 t* "ERROR: found
c100: 20 66 69 6c 65 20 22 2a 74 6f 70 70 61 74 68 2a file "*toppath*
c110: 22 2f 73 74 6f 70 2d 74 68 65 2d 74 72 61 69 6e "/stop-the-train
c120: 2c 20 65 78 69 74 69 6e 67 20 69 6d 6d 65 64 69 , exiting immedi
c130: 61 74 65 6c 79 22 29 0a 09 28 65 78 69 74 20 31 ately")..(exit 1
c140: 29 29 29 0a 20 20 28 69 66 20 28 61 6e 64 20 2a ))). (if (and *
c150: 74 6f 70 70 61 74 68 2a 0a 09 20 20 20 28 65 71 toppath*.. (eq
c160: 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a ? *configstatus*
c170: 20 27 66 75 6c 6c 64 61 74 61 29 20 28 6e 6f 74 'fulldata) (not
c180: 20 66 6f 72 63 65 2d 72 65 72 65 61 64 29 29 20 force-reread))
c190: 3b 3b 20 67 6f 74 20 69 74 20 61 6c 6c 0a 20 20 ;; got it all.
c1a0: 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 65 62 (begin..(deb
c1b0: 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 61 ug:print 2 *defa
c1c0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e ult-log-port* "N
c1d0: 4f 54 45 3a 20 73 6b 69 70 70 69 6e 67 20 6c 61 OTE: skipping la
c1e0: 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 unch:setup-body
c1f0: 63 61 6c 6c 20 73 69 6e 63 65 20 77 65 20 68 61 call since we ha
c200: 76 65 20 66 75 6c 6c 64 61 74 61 22 29 0a 09 28 ve fulldata")..(
c210: 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 6c mutex-unlock! *l
c220: 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 74 65 aunch-setup-mute
c230: 78 2a 29 0a 09 2a 74 6f 70 70 61 74 68 2a 29 0a x*)..*toppath*).
c240: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
c250: 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 (launch:setup-b
c260: 6f 64 79 20 66 6f 72 63 65 2d 72 65 72 65 61 64 ody force-reread
c270: 3a 20 66 6f 72 63 65 2d 72 65 72 65 61 64 20 61 : force-reread a
c280: 72 65 61 70 61 74 68 3a 20 61 72 65 61 70 61 74 reapath: areapat
c290: 68 29 29 29 0a 09 28 6d 75 74 65 78 2d 75 6e 6c h)))..(mutex-unl
c2a0: 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 2d 73 65 74 ock! *launch-set
c2b0: 75 70 2d 6d 75 74 65 78 2a 29 0a 09 72 65 73 29 up-mutex*)..res)
c2c0: 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 70 61 ))..;; return pa
c2d0: 74 68 73 20 64 65 70 65 6e 64 69 6e 67 20 6f 6e ths depending on
c2e0: 20 77 68 61 74 20 69 6e 66 6f 20 69 73 20 61 76 what info is av
c2f0: 61 69 6c 61 62 6c 65 2e 0a 3b 3b 0a 28 64 65 66 ailable..;;.(def
c300: 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 74 2d ine (launch:get-
c310: 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 74 68 73 cache-file-paths
c320: 20 61 72 65 61 70 61 74 68 20 74 6f 70 70 61 74 areapath toppat
c330: 68 20 74 61 72 67 65 74 20 6d 74 63 6f 6e 66 69 h target mtconfi
c340: 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 75 73 65 g). (let* ((use
c350: 2d 63 61 63 68 65 20 28 63 6f 6d 6d 6f 6e 3a 75 -cache (common:u
c360: 73 65 2d 63 61 63 68 65 3f 29 29 0a 20 20 20 20 se-cache?)).
c370: 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 28 (runname (
c380: 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 74 2d common:args-get-
c390: 72 75 6e 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 runname)).
c3a0: 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 28 63 6f (linktree (co
c3b0: 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 mmon:get-linktre
c3c0: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 65 e)). (te
c3d0: 73 74 6e 61 6d 65 20 28 63 6f 6d 6d 6f 6e 3a 67 stname (common:g
c3e0: 65 74 2d 66 75 6c 6c 2d 74 65 73 74 2d 6e 61 6d et-full-test-nam
c3f0: 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 75 e)). (ru
c400: 6e 64 69 72 20 20 20 28 69 66 20 28 61 6e 64 20 ndir (if (and
c410: 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 20 6c runname target l
c420: 69 6e 6b 74 72 65 65 29 0a 20 20 20 20 20 20 20 inktree).
c430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c440: 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 6f 72 (common:director
c450: 79 2d 77 72 69 74 61 62 6c 65 3f 20 28 63 6f 6e y-writable? (con
c460: 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 c linktree "/" t
c470: 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d arget "/" runnam
c480: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
c490: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 0a #f)).
c4a0: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 64 69 (testdi
c4b0: 72 20 20 28 69 66 20 28 61 6e 64 20 72 75 6e 64 r (if (and rund
c4c0: 69 72 20 74 65 73 74 6e 61 6d 65 29 0a 20 20 20 ir testname).
c4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4e0: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 (common:dire
c4f0: 63 74 6f 72 79 2d 77 72 69 74 61 62 6c 65 3f 20 ctory-writable?
c500: 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 2f 22 (conc rundir "/"
c510: 20 74 65 73 74 6e 61 6d 65 29 29 0a 20 20 20 20 testname)).
c520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c530: 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 #f)).
c540: 20 28 63 61 63 68 65 64 69 72 20 28 6f 72 20 74 (cachedir (or t
c550: 65 73 74 64 69 72 20 72 75 6e 64 69 72 29 29 0a estdir rundir)).
c560: 20 20 20 20 20 20 20 20 20 28 6d 74 63 61 63 68 (mtcach
c570: 65 66 20 28 61 6e 64 20 63 61 63 68 65 64 69 72 ef (and cachedir
c580: 20 28 63 6f 6e 63 20 63 61 63 68 65 64 69 72 20 (conc cachedir
c590: 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 74 2e 63 "/" ".megatest.c
c5a0: 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 2d 76 fg-" megatest-v
c5b0: 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 ersion "-" megat
c5c0: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 est-fossil-hash)
c5d0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 63 63 )). (rcc
c5e0: 61 63 68 65 66 20 28 61 6e 64 20 63 61 63 68 65 achef (and cache
c5f0: 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 65 64 dir (conc cached
c600: 69 72 20 22 2f 22 20 22 2e 72 75 6e 63 6f 6e 66 ir "/" ".runconf
c610: 69 67 73 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 igs.cfg-" megat
c620: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 est-version "-"
c630: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
c640: 68 61 73 68 29 29 29 29 0a 20 20 20 20 28 64 65 hash)))). (de
c650: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 36 bug:print-info 6
c660: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
c670: 72 74 2a 20 0a 20 20 20 20 20 20 20 20 20 20 20 rt* .
c680: 20 20 20 20 20 20 20 20 20 20 20 22 72 75 6e 6e "runn
c690: 61 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 20 0a 20 ame=" runname .
c6a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c6b0: 20 20 20 20 20 22 5c 6e 20 20 6c 69 6e 6b 74 72 "\n linktr
c6c0: 65 65 3d 22 20 6c 69 6e 6b 74 72 65 65 0a 20 20 ee=" linktree.
c6d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c6e0: 20 20 20 20 22 5c 6e 20 20 74 65 73 74 6e 61 6d "\n testnam
c6f0: 65 3d 22 20 74 65 73 74 6e 61 6d 65 0a 20 20 20 e=" testname.
c700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c710: 20 20 20 22 5c 6e 20 20 72 75 6e 64 69 72 3d 22 "\n rundir="
c720: 20 72 75 6e 64 69 72 20 0a 20 20 20 20 20 20 20 rundir .
c730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
c740: 5c 6e 20 20 74 65 73 74 64 69 72 3d 22 20 74 65 \n testdir=" te
c750: 73 74 64 69 72 20 0a 20 20 20 20 20 20 20 20 20 stdir .
c760: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 5c 6e "\n
c770: 20 20 63 61 63 68 65 64 69 72 3d 22 20 63 61 63 cachedir=" cac
c780: 68 65 64 69 72 0a 20 20 20 20 20 20 20 20 20 20 hedir.
c790: 20 20 20 20 20 20 20 20 20 20 20 20 22 5c 6e 20 "\n
c7a0: 20 6d 74 63 61 63 68 65 66 3d 22 20 6d 74 63 61 mtcachef=" mtca
c7b0: 63 68 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 chef.
c7c0: 20 20 20 20 20 20 20 20 20 20 20 22 5c 6e 20 20 "\n
c7d0: 72 63 63 61 63 68 65 66 3d 22 20 72 63 63 61 63 rccachef=" rccac
c7e0: 68 65 66 29 0a 20 20 20 20 28 63 6f 6e 73 20 6d hef). (cons m
c7f0: 74 63 61 63 68 65 66 20 72 63 63 61 63 68 65 66 tcachef rccachef
c800: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 )))..(define (la
c810: 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 unch:setup-body
c820: 23 21 6b 65 79 20 28 66 6f 72 63 65 2d 72 65 72 #!key (force-rer
c830: 65 61 64 20 23 66 29 20 28 61 72 65 61 70 61 74 ead #f) (areapat
c840: 68 20 23 66 29 29 0a 20 20 28 69 66 20 28 61 6e h #f)). (if (an
c850: 64 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 d (eq? *configst
c860: 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 atus* 'fulldata)
c870: 0a 09 20 20 20 2a 74 6f 70 70 61 74 68 2a 0a 09 .. *toppath*..
c880: 20 20 20 28 6e 6f 74 20 66 6f 72 63 65 2d 72 65 (not force-re
c890: 72 65 61 64 29 29 20 3b 3b 20 6e 6f 20 6e 65 65 read)) ;; no nee
c8a0: 64 20 74 6f 20 72 65 70 72 6f 63 65 73 73 0a 20 d to reprocess.
c8b0: 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 20 20 *toppath*
c8c0: 20 3b 3b 20 72 65 74 75 72 6e 20 74 6f 70 70 61 ;; return toppa
c8d0: 74 68 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 th. (let* (
c8e0: 28 75 73 65 2d 63 61 63 68 65 20 28 63 6f 6d 6d (use-cache (comm
c8f0: 6f 6e 3a 75 73 65 2d 63 61 63 68 65 3f 29 29 20 on:use-cache?))
c900: 3b 3b 20 42 42 2d 20 75 73 65 2d 63 61 63 68 65 ;; BB- use-cache
c910: 20 63 68 65 63 6b 73 20 2a 63 6f 6e 66 69 67 64 checks *configd
c920: 61 74 2a 20 66 6f 72 20 75 73 65 2d 63 61 63 68 at* for use-cach
c930: 65 20 73 65 74 74 69 6e 67 2e 20 20 57 65 20 64 e setting. We d
c940: 6f 20 6e 6f 74 20 68 61 76 65 20 2a 63 6f 6e 66 o not have *conf
c950: 69 67 64 61 74 2a 2e 20 20 42 6f 6f 74 73 74 72 igdat*. Bootstr
c960: 61 70 70 69 6e 67 20 70 72 6f 62 6c 65 6d 20 68 apping problem h
c970: 65 72 65 2e 0a 09 20 20 20 20 20 28 74 6f 70 70 ere... (topp
c980: 61 74 68 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 ath (common:get
c990: 2d 74 6f 70 70 61 74 68 20 61 72 65 61 70 61 74 -toppath areapat
c9a0: 68 29 29 0a 09 20 20 20 20 20 28 74 61 72 67 65 h)).. (targe
c9b0: 74 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 t (common:args
c9c0: 2d 67 65 74 2d 74 61 72 67 65 74 29 29 0a 09 20 -get-target))..
c9d0: 20 20 20 20 28 73 65 63 74 69 6f 6e 73 20 28 69 (sections (i
c9e0: 66 20 74 61 72 67 65 74 20 28 6c 69 73 74 20 22 f target (list "
c9f0: 64 65 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 default" target)
ca00: 20 23 66 29 29 20 3b 3b 20 66 6f 72 20 72 75 6e #f)) ;; for run
ca10: 63 6f 6e 66 69 67 73 0a 09 20 20 20 20 20 28 6d configs.. (m
ca20: 74 63 6f 6e 66 69 67 20 28 6f 72 20 28 61 72 67 tconfig (or (arg
ca30: 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f 6e 66 s:get-arg "-conf
ca40: 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 2e 63 ig") "megatest.c
ca50: 6f 6e 66 69 67 22 29 29 20 3b 3b 20 61 6c 6c 6f onfig")) ;; allo
ca60: 77 20 6f 76 65 72 72 69 64 69 6e 67 20 6d 65 67 w overriding meg
ca70: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 0a 20 20 atest.config .
ca80: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 63 68 (cach
ca90: 65 66 69 6c 65 73 20 28 6c 61 75 6e 63 68 3a 67 efiles (launch:g
caa0: 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 et-cache-file-pa
cab0: 74 68 73 20 61 72 65 61 70 61 74 68 20 74 6f 70 ths areapath top
cac0: 70 61 74 68 20 74 61 72 67 65 74 20 6d 74 63 6f path target mtco
cad0: 6e 66 69 67 29 29 0a 09 20 20 20 20 20 3b 3b 20 nfig)).. ;;
cae0: 63 68 65 63 6b 69 6e 67 20 66 6f 72 20 6e 75 6c checking for nul
caf0: 6c 20 63 61 63 68 65 66 69 6c 65 73 20 73 68 6f l cachefiles sho
cb00: 75 6c 64 20 6e 6f 74 20 62 65 20 6e 65 63 65 73 uld not be neces
cb10: 73 61 72 79 2c 20 49 20 77 61 73 20 73 65 65 69 sary, I was seei
cb20: 6e 67 20 65 72 72 6f 72 20 63 61 72 20 6f 66 20 ng error car of
cb30: 27 28 29 2c 20 6d 69 67 68 74 20 62 65 20 61 20 '(), might be a
cb40: 63 68 69 63 6b 65 6e 20 62 75 67 20 6f 72 20 61 chicken bug or a
cb50: 20 72 65 64 20 68 65 72 72 69 6e 67 20 2e 2e 2e red herring ...
cb60: 0a 09 20 20 20 20 20 28 6d 74 63 61 63 68 65 66 .. (mtcachef
cb70: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 63 61 (if (null? ca
cb80: 63 68 65 66 69 6c 65 73 29 0a 09 09 09 20 20 20 chefiles)....
cb90: 20 20 23 66 0a 09 09 09 20 20 20 20 20 28 63 61 #f.... (ca
cba0: 72 20 63 61 63 68 65 66 69 6c 65 73 29 29 29 20 r cachefiles)))
cbb0: 3b 3b 20 28 61 6e 64 20 63 61 63 68 65 64 69 72 ;; (and cachedir
cbc0: 20 28 63 6f 6e 63 20 63 61 63 68 65 64 69 72 20 (conc cachedir
cbd0: 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 74 2e 63 "/" ".megatest.c
cbe0: 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 2d 76 fg-" megatest-v
cbf0: 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 61 74 ersion "-" megat
cc00: 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 29 est-fossil-hash)
cc10: 29 29 0a 09 20 20 20 20 20 28 72 63 63 61 63 68 )).. (rccach
cc20: 65 66 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ef (if (null?
cc30: 63 61 63 68 65 66 69 6c 65 73 29 0a 09 09 09 20 cachefiles)....
cc40: 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 28 #f.... (
cc50: 63 64 72 20 63 61 63 68 65 66 69 6c 65 73 29 29 cdr cachefiles))
cc60: 29 29 20 3b 3b 20 28 61 6e 64 20 63 61 63 68 65 )) ;; (and cache
cc70: 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 65 64 dir (conc cached
cc80: 69 72 20 22 2f 22 20 22 2e 72 75 6e 63 6f 6e 66 ir "/" ".runconf
cc90: 69 67 73 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 igs.cfg-" megat
cca0: 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 est-version "-"
ccb0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
ccc0: 68 61 73 68 29 29 29 0a 09 20 20 20 20 20 20 3b hash))).. ;
ccd0: 3b 20 28 63 61 6e 63 72 65 61 74 65 20 28 61 6e ; (cancreate (an
cce0: 64 20 63 61 63 68 65 64 69 72 20 28 63 6f 6d 6d d cachedir (comm
ccf0: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
cd00: 63 61 63 68 65 64 69 72 29 28 66 69 6c 65 2d 77 cachedir)(file-w
cd10: 72 69 74 65 2d 61 63 63 65 73 73 3f 20 63 61 63 rite-access? cac
cd20: 68 65 64 69 72 29 20 28 6e 6f 74 20 28 63 6f 6d hedir) (not (com
cd30: 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d 74 mon:in-running-t
cd40: 65 73 74 3f 29 29 29 29 29 0a 09 28 73 65 74 21 est?)))))..(set!
cd50: 20 2a 74 6f 70 70 61 74 68 2a 20 74 6f 70 70 61 *toppath* toppa
cd60: 74 68 29 20 3b 3b 20 54 68 69 73 20 69 73 20 6e th) ;; This is n
cd70: 65 65 64 65 64 20 77 68 65 6e 20 77 65 20 61 72 eeded when we ar
cd80: 65 20 72 75 6e 6e 69 6e 67 20 61 73 20 61 20 74 e running as a t
cd90: 65 73 74 20 75 73 69 6e 67 20 43 4d 44 49 4e 46 est using CMDINF
cda0: 4f 20 61 73 20 61 20 64 61 74 61 73 6f 75 72 63 O as a datasourc
cdb0: 65 0a 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e e. ;;(BB>
cdc0: 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 "launch:setup-b
cdd0: 6f 64 79 20 2d 2d 20 63 61 63 68 65 66 69 6c 65 ody -- cachefile
cde0: 73 3d 22 63 61 63 68 65 66 69 6c 65 73 29 0a 09 s="cachefiles)..
cdf0: 28 63 6f 6e 64 0a 09 20 3b 3b 20 69 66 20 6d 74 (cond.. ;; if mt
ce00: 63 61 63 68 65 66 20 65 78 69 73 74 73 20 6a 75 cachef exists ju
ce10: 73 74 20 72 65 61 64 20 69 74 2c 20 68 6f 77 65 st read it, howe
ce20: 76 65 72 20 77 65 20 6e 65 65 64 20 74 6f 20 61 ver we need to a
ce30: 73 73 75 6d 65 20 74 6f 70 70 61 74 68 20 69 73 ssume toppath is
ce40: 20 61 76 61 69 6c 61 62 6c 65 20 69 6e 20 24 4d available in $M
ce50: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 0a T_RUN_AREA_HOME.
ce60: 09 20 28 28 61 6e 64 20 28 6e 6f 74 20 66 6f 72 . ((and (not for
ce70: 63 65 2d 72 65 72 65 61 64 29 0a 09 20 20 20 20 ce-reread)..
ce80: 20 20 20 6d 74 63 61 63 68 65 66 20 20 72 63 63 mtcachef rcc
ce90: 61 63 68 65 66 0a 09 20 20 20 20 20 20 20 75 73 achef.. us
cea0: 65 2d 63 61 63 68 65 0a 09 20 20 20 20 20 20 20 e-cache..
ceb0: 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 (get-environment
cec0: 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 -variable "MT_RU
ced0: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 0a 09 20 N_AREA_HOME")..
cee0: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (common:fi
cef0: 6c 65 2d 65 78 69 73 74 73 3f 20 6d 74 63 61 63 le-exists? mtcac
cf00: 68 65 66 29 0a 09 20 20 20 20 20 20 20 28 63 6f hef).. (co
cf10: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
cf20: 3f 20 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 ? rccachef)).
cf30: 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c ;;(BB> "l
cf40: 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 aunch:setup-body
cf50: 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e 63 68 20 -- cond branch
cf60: 31 20 2d 20 75 73 65 2d 63 61 63 68 65 22 29 0a 1 - use-cache").
cf70: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
cf80: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 20 20 28 *configdat* (
cf90: 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 configf:read-ali
cfa0: 73 74 20 6d 74 63 61 63 68 65 66 29 29 0a 20 20 st mtcachef)).
cfb0: 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 ;;(BB> "
cfc0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 launch:setup-bod
cfd0: 79 20 2d 2d 20 31 20 73 65 74 21 20 2a 63 6f 6e y -- 1 set! *con
cfe0: 66 69 67 64 61 74 2a 3d 22 2a 63 6f 6e 66 69 67 figdat*="*config
cff0: 64 61 74 2a 29 0a 09 20 20 28 73 65 74 21 20 2a dat*).. (set! *
d000: 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 28 63 runconfigdat* (c
d010: 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c 69 73 onfigf:read-alis
d020: 74 20 72 63 63 61 63 68 65 66 29 29 0a 09 20 20 t rccachef))..
d030: 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 6e 66 (set! *configinf
d040: 6f 2a 20 20 20 28 6c 69 73 74 20 2a 63 6f 6e 66 o* (list *conf
d050: 69 67 64 61 74 2a 20 20 28 67 65 74 2d 65 6e 76 igdat* (get-env
d060: 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c ironment-variabl
d070: 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 e "MT_RUN_AREA_H
d080: 4f 4d 45 22 29 29 29 0a 09 20 20 28 73 65 74 21 OME"))).. (set!
d090: 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 *configstatus*
d0a0: 27 66 75 6c 6c 64 61 74 61 29 0a 09 20 20 28 73 'fulldata).. (s
d0b0: 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 et! *toppath*
d0c0: 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d (get-environm
d0d0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
d0e0: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
d0f0: 29 0a 09 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a ).. *toppath*).
d100: 09 20 3b 3b 20 74 68 65 72 65 20 61 72 65 20 6e . ;; there are n
d110: 6f 20 65 78 69 73 74 69 6e 67 20 63 61 63 68 65 o existing cache
d120: 64 20 63 6f 6e 66 69 67 73 2c 20 64 6f 20 66 75 d configs, do fu
d130: 6c 6c 20 72 65 61 64 73 20 6f 66 20 74 68 65 20 ll reads of the
d140: 63 6f 6e 66 69 67 73 20 61 6e 64 20 63 61 63 68 configs and cach
d150: 65 20 74 68 65 6d 0a 09 20 3b 3b 20 77 65 20 68 e them.. ;; we h
d160: 61 76 65 20 61 6c 6c 20 74 68 65 20 69 6e 66 6f ave all the info
d170: 20 6e 65 65 64 65 64 20 74 6f 20 66 75 6c 6c 79 needed to fully
d180: 20 70 72 6f 63 65 73 73 20 72 75 6e 63 6f 6e 66 process runconf
d190: 69 67 73 20 61 6e 64 20 6d 65 67 61 74 65 73 74 igs and megatest
d1a0: 2e 63 6f 6e 66 69 67 0a 09 20 28 28 61 6e 64 20 .config.. ((and
d1b0: 3b 3b 20 28 6e 6f 74 20 66 6f 72 63 65 2d 72 65 ;; (not force-re
d1c0: 72 65 61 64 29 20 3b 3b 20 66 6f 72 63 65 2d 72 read) ;; force-r
d1d0: 65 72 65 61 64 20 69 73 20 69 72 72 65 6c 65 76 eread is irrelev
d1e0: 61 6e 74 20 69 6e 20 74 68 65 20 41 4e 44 2c 20 ant in the AND,
d1f0: 63 6f 75 6c 64 20 68 6f 77 65 76 65 72 20 4f 52 could however OR
d200: 20 69 74 3f 0a 09 20 20 20 20 20 20 20 6d 74 63 it?.. mtc
d210: 61 63 68 65 66 0a 09 20 20 20 20 20 20 20 72 63 achef.. rc
d220: 63 61 63 68 65 66 29 20 3b 3b 20 42 42 2d 20 77 cachef) ;; BB- w
d230: 68 79 20 61 72 65 20 77 65 20 64 6f 69 6e 67 20 hy are we doing
d240: 74 68 69 73 20 77 69 74 68 6f 75 74 20 61 73 6b this without ask
d250: 69 6e 67 20 69 66 20 63 61 63 68 69 6e 67 20 69 ing if caching i
d260: 73 20 64 65 73 69 72 65 64 3f 0a 20 20 20 20 20 s desired?.
d270: 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 ;;(BB> "lau
d280: 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d nch:setup-body -
d290: 2d 20 63 6f 6e 64 20 62 72 61 6e 63 68 20 32 22 - cond branch 2"
d2a0: 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 66 69 72 ).. (let* ((fir
d2b0: 73 74 2d 70 61 73 73 20 20 20 20 28 66 69 6e 64 st-pass (find
d2c0: 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 67 -and-read-config
d2d0: 20 20 20 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 ;; NB//
d2e0: 73 65 74 73 20 4d 54 5f 52 55 4e 5f 41 52 45 41 sets MT_RUN_AREA
d2f0: 5f 48 4f 4d 45 20 61 73 20 73 69 64 65 20 65 66 _HOME as side ef
d300: 66 65 63 74 0a 09 09 09 09 20 6d 74 63 6f 6e 66 fect..... mtconf
d310: 69 67 0a 09 09 09 09 20 65 6e 76 69 72 6f 6e 2d ig..... environ-
d320: 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 patt: "env-overr
d330: 69 64 65 22 0a 09 09 09 09 20 67 69 76 65 6e 2d ide"..... given-
d340: 74 6f 70 70 61 74 68 3a 20 74 6f 70 70 61 74 68 toppath: toppath
d350: 0a 09 09 09 09 20 70 61 74 68 65 6e 76 76 61 72 ..... pathenvvar
d360: 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 : "MT_RUN_AREA_H
d370: 4f 4d 45 22 29 29 0a 09 09 20 28 66 69 72 73 74 OME"))... (first
d380: 2d 72 75 6e 64 61 74 20 20 28 6c 65 74 20 28 28 -rundat (let ((
d390: 74 6f 70 70 61 74 68 20 28 69 66 20 74 6f 70 70 toppath (if topp
d3a0: 61 74 68 20 0a 09 09 09 09 09 09 20 20 20 74 6f ath ....... to
d3b0: 70 70 61 74 68 0a 09 09 09 09 09 09 20 20 20 28 ppath....... (
d3c0: 63 61 72 20 66 69 72 73 74 2d 70 61 73 73 29 29 car first-pass))
d3d0: 29 29 0a 09 09 09 09 20 20 28 72 65 61 64 2d 63 ))..... (read-c
d3e0: 6f 6e 66 69 67 20 3b 3b 20 28 63 6f 6e 63 20 74 onfig ;; (conc t
d3f0: 6f 70 70 61 74 68 20 22 2f 72 75 6e 63 6f 6e 66 oppath "/runconf
d400: 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 3b 3b 20 igs.config") ;;
d410: 74 68 69 73 20 73 68 6f 75 6c 64 20 62 65 20 63 this should be c
d420: 6f 6e 76 65 72 74 65 64 20 74 6f 20 72 75 6e 63 onverted to runc
d430: 6f 6e 66 69 67 3a 72 65 61 64 20 62 75 74 20 69 onfig:read but i
d440: 74 20 69 73 20 6e 6f 6e 2d 74 72 69 76 69 61 6c t is non-trivial
d450: 2c 20 6c 65 61 76 69 6e 67 20 69 74 20 66 6f 72 , leaving it for
d460: 20 6e 6f 77 2e 0a 09 09 09 09 20 20 20 28 63 6f now...... (co
d470: 6e 63 20 28 69 66 20 28 73 74 72 69 6e 67 3f 20 nc (if (string?
d480: 74 6f 70 70 61 74 68 29 0a 09 09 09 09 09 20 20 toppath)......
d490: 20 20 20 74 6f 70 70 61 74 68 0a 09 09 09 09 09 toppath......
d4a0: 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f (get-enviro
d4b0: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
d4c0: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
d4d0: 22 29 29 0a 09 09 09 09 09 20 22 2f 72 75 6e 63 "))...... "/runc
d4e0: 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 0a onfigs.config").
d4f0: 09 09 09 09 20 20 20 2a 72 75 6e 63 6f 6e 66 69 .... *runconfi
d500: 67 64 61 74 2a 20 23 74 20 0a 09 09 09 09 20 20 gdat* #t .....
d510: 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 74 69 sections: secti
d520: 6f 6e 73 29 29 29 29 0a 09 20 20 20 20 28 73 65 ons)))).. (se
d530: 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 t! *runconfigdat
d540: 2a 20 66 69 72 73 74 2d 72 75 6e 64 61 74 29 0a * first-rundat).
d550: 09 20 20 20 20 28 69 66 20 66 69 72 73 74 2d 70 . (if first-p
d560: 61 73 73 20 20 3b 3b 20 0a 09 09 28 62 65 67 69 ass ;; ...(begi
d570: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
d580: 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 75 6e ;;(BB> "laun
d590: 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 2d 2d ch:setup-body --
d5a0: 20 5c 22 66 69 72 73 74 2d 70 61 73 73 5c 22 3d \"first-pass\"=
d5b0: 66 69 72 73 74 2d 70 61 73 73 22 29 0a 09 09 20 first-pass")...
d5c0: 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 (set! *configda
d5d0: 74 2a 20 20 28 63 61 72 20 66 69 72 73 74 2d 70 t* (car first-p
d5e0: 61 73 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ass)).
d5f0: 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 ;;(BB> "
d600: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 launch:setup-bod
d610: 79 20 2d 2d 20 32 20 73 65 74 21 20 2a 63 6f 6e y -- 2 set! *con
d620: 66 69 67 64 61 74 2a 3d 22 2a 63 6f 6e 66 69 67 figdat*="*config
d630: 64 61 74 2a 29 0a 09 09 20 20 28 73 65 74 21 20 dat*)... (set!
d640: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 66 69 72 *configinfo* fir
d650: 73 74 2d 70 61 73 73 29 0a 09 09 20 20 28 73 65 st-pass)... (se
d660: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 t! *toppath*
d670: 28 6f 72 20 74 6f 70 70 61 74 68 20 28 63 61 64 (or toppath (cad
d680: 72 20 66 69 72 73 74 2d 70 61 73 73 29 29 29 20 r first-pass)))
d690: 3b 3b 20 75 73 65 20 74 68 65 20 67 61 74 68 65 ;; use the gathe
d6a0: 72 65 64 20 64 61 74 61 20 75 6e 6c 65 73 73 20 red data unless
d6b0: 61 6c 72 65 61 64 79 20 68 61 76 65 20 69 74 0a already have it.
d6c0: 09 09 20 20 28 73 65 74 21 20 74 6f 70 70 61 74 .. (set! toppat
d6d0: 68 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a h *toppath*
d6e0: 29 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 20 2a )... (if (not *
d6f0: 74 6f 70 70 61 74 68 2a 29 0a 09 09 20 20 20 20 toppath*)...
d700: 20 20 28 62 65 67 69 6e 0a 09 09 09 28 64 65 62 (begin....(deb
d710: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
d720: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
d730: 72 74 2a 20 22 79 6f 75 20 61 72 65 20 6e 6f 74 rt* "you are not
d740: 20 69 6e 20 61 20 6d 65 67 61 74 65 73 74 20 61 in a megatest a
d750: 72 65 61 21 22 29 0a 09 09 09 28 65 78 69 74 20 rea!")....(exit
d760: 31 29 29 29 0a 09 09 20 20 28 73 65 74 65 6e 76 1)))... (setenv
d770: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
d780: 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 ME" *toppath*)..
d790: 09 20 20 3b 3b 20 74 68 65 20 73 65 65 64 20 72 . ;; the seed r
d7a0: 65 61 64 20 69 73 20 64 6f 6e 65 2c 20 6e 6f 77 ead is done, now
d7b0: 20 72 65 61 64 20 72 75 6e 63 6f 6e 66 69 67 73 read runconfigs
d7c0: 2c 20 63 61 63 68 65 20 69 74 20 74 68 65 6e 20 , cache it then
d7d0: 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e 63 6f read megatest.co
d7e0: 6e 66 69 67 20 6f 6e 65 20 6d 6f 72 65 20 74 69 nfig one more ti
d7f0: 6d 65 20 61 6e 64 20 63 61 63 68 65 20 69 74 0a me and cache it.
d800: 09 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 79 73 .. (let* ((keys
d810: 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e (common
d820: 3a 6c 69 73 74 2d 6f 72 2d 6e 75 6c 6c 20 28 72 :list-or-null (r
d830: 6d 74 3a 67 65 74 2d 6b 65 79 73 29 0a 09 09 09 mt:get-keys)....
d840: 09 09 09 09 20 20 20 20 6d 65 73 73 61 67 65 3a .... message:
d850: 20 22 46 61 69 6c 65 64 20 74 6f 20 72 65 74 72 "Failed to retr
d860: 69 65 76 65 20 6b 65 79 73 20 69 6e 20 6c 61 75 ieve keys in lau
d870: 6e 63 68 2e 73 63 6d 2e 20 50 6c 65 61 73 65 20 nch.scm. Please
d880: 72 65 70 6f 72 74 20 74 68 69 73 20 74 6f 20 74 report this to t
d890: 68 65 20 64 65 76 65 6c 6f 70 65 72 73 2e 22 29 he developers.")
d8a0: 29 0a 09 09 09 20 28 6b 65 79 2d 76 61 6c 73 20 ).... (key-vals
d8b0: 20 20 20 20 28 6b 65 79 73 3a 74 61 72 67 65 74 (keys:target
d8c0: 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 ->keyval keys ta
d8d0: 72 67 65 74 29 29 0a 09 09 09 20 28 6c 69 6e 6b rget)).... (link
d8e0: 74 72 65 65 20 20 20 20 20 28 63 6f 6d 6d 6f 6e tree (common
d8f0: 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 20 :get-linktree))
d900: 3b 3b 20 28 6f 72 20 28 67 65 74 65 6e 76 20 22 ;; (or (getenv "
d910: 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 69 66 MT_LINKTREE")(if
d920: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 28 63 6f *configdat* (co
d930: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
d940: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
d950: 20 22 6c 69 6e 6b 74 72 65 65 22 29 20 23 66 29 "linktree") #f)
d960: 29 29 0a 09 09 09 09 09 3b 20 20 20 20 20 28 69 ))......; (i
d970: 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a 0a 09 09 f *configdat*...
d980: 09 09 09 3b 20 09 20 20 20 28 63 6f 6e 66 69 67 ...; . (config
d990: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
d9a0: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 69 dat* "setup" "li
d9b0: 6e 6b 74 72 65 65 22 29 0a 09 09 09 09 09 3b 20 nktree")......;
d9c0: 09 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 . (conc *toppa
d9d0: 74 68 2a 20 22 2f 6c 74 22 29 29 29 29 0a 09 09 th* "/lt"))))...
d9e0: 09 20 28 73 65 63 6f 6e 64 2d 70 61 73 73 20 20 . (second-pass
d9f0: 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 (find-and-read-c
da00: 6f 6e 66 69 67 0a 09 09 09 09 09 6d 74 63 6f 6e onfig......mtcon
da10: 66 69 67 0a 09 09 09 09 09 65 6e 76 69 72 6f 6e fig......environ
da20: 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 -patt: "env-over
da30: 72 69 64 65 22 0a 09 09 09 09 09 67 69 76 65 6e ride"......given
da40: 2d 74 6f 70 70 61 74 68 3a 20 74 6f 70 70 61 74 -toppath: toppat
da50: 68 0a 09 09 09 09 09 70 61 74 68 65 6e 76 76 61 h......pathenvva
da60: 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f r: "MT_RUN_AREA_
da70: 48 4f 4d 45 22 29 29 0a 09 09 09 20 28 72 75 6e HOME")).... (run
da80: 63 6f 6e 66 69 67 64 61 74 20 28 62 65 67 69 6e configdat (begin
da90: 20 20 20 20 20 3b 3b 20 74 68 69 73 20 72 65 61 ;; this rea
daa0: 64 20 6f 66 20 74 68 65 20 72 75 6e 63 6f 6e 66 d of the runconf
dab0: 69 67 73 20 77 69 6c 6c 20 73 65 65 20 61 6e 79 igs will see any
dac0: 20 61 64 6a 75 73 74 6d 65 6e 74 73 20 6d 61 64 adjustments mad
dad0: 65 20 62 79 20 72 65 2d 72 65 61 64 69 6e 67 20 e by re-reading
dae0: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 0a megatest.config.
daf0: 09 09 09 09 09 20 28 66 6f 72 2d 65 61 63 68 20 ..... (for-each
db00: 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a 09 09 09 (lambda (kt)....
db10: 09 09 09 20 20 20 20 20 28 73 65 74 65 6e 76 20 ... (setenv
db20: 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 20 6b (car kt) (cadr k
db30: 74 29 29 29 0a 09 09 09 09 09 09 20 20 20 6b 65 t)))....... ke
db40: 79 2d 76 61 6c 73 29 0a 09 09 09 09 09 20 28 72 y-vals)...... (r
db50: 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f 6e 63 ead-config (conc
db60: 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e 63 6f toppath "/runco
db70: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 2a nfigs.config") *
db80: 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 23 74 runconfigdat* #t
db90: 20 3b 3b 20 63 6f 6e 73 69 64 65 72 20 75 73 69 ;; consider usi
dba0: 6e 67 20 72 75 6e 63 6f 6e 66 69 67 3a 72 65 61 ng runconfig:rea
dbb0: 64 20 73 6f 6d 65 20 64 61 79 20 2e 2e 2e 0a 09 d some day .....
dbc0: 09 09 09 09 09 20 20 20 20 20 20 73 65 63 74 69 ..... secti
dbd0: 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 ons: sections)))
dbe0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dbf0: 20 20 20 20 20 20 20 20 20 20 28 63 61 63 68 65 (cache
dc00: 66 69 6c 65 73 20 20 20 28 6c 61 75 6e 63 68 3a files (launch:
dc10: 67 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d 70 get-cache-file-p
dc20: 61 74 68 73 20 61 72 65 61 70 61 74 68 20 74 6f aths areapath to
dc30: 70 70 61 74 68 20 74 61 72 67 65 74 20 6d 74 63 ppath target mtc
dc40: 6f 6e 66 69 67 29 29 0a 20 20 20 20 20 20 20 20 onfig)).
dc50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dc60: 20 28 6d 74 63 61 63 68 65 66 20 20 20 20 20 28 (mtcachef (
dc70: 63 61 72 20 63 61 63 68 65 66 69 6c 65 73 29 29 car cachefiles))
dc80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
dc90: 20 20 20 20 20 20 20 20 20 20 28 72 63 63 61 63 (rccac
dca0: 68 65 66 20 20 20 20 20 28 63 64 72 20 63 61 63 hef (cdr cac
dcb0: 68 65 66 69 6c 65 73 29 29 29 0a 20 20 20 20 20 hefiles))).
dcc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
dcd0: 3b 20 20 74 72 61 70 20 65 78 63 65 70 74 69 6f ; trap exceptio
dce0: 6e 20 64 75 65 20 74 6f 20 73 74 61 6c 65 20 4e n due to stale N
dcf0: 46 53 20 68 61 6e 64 6c 65 20 2d 2d 20 45 72 72 FS handle -- Err
dd00: 6f 72 3a 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 or: (open-output
dd10: 2d 66 69 6c 65 29 20 63 61 6e 6e 6f 74 20 6f 70 -file) cannot op
dd20: 65 6e 20 66 69 6c 65 20 2d 20 53 74 61 6c 65 20 en file - Stale
dd30: 4e 46 53 20 66 69 6c 65 20 68 61 6e 64 6c 65 3a NFS file handle:
dd40: 20 22 2f 70 2f 66 64 6b 2f 67 77 61 2f 6c 65 66 "/p/fdk/gwa/lef
dd50: 6b 6f 77 69 74 2f 6d 74 54 65 73 74 69 6e 67 2f kowit/mtTesting/
dd60: 71 61 2f 70 72 69 6d 62 65 71 61 2f 6c 69 6e 6b qa/primbeqa/link
dd70: 73 2f 70 31 32 32 32 2f 31 31 2f 50 44 4b 5f 72 s/p1222/11/PDK_r
dd80: 31 2e 31 2e 31 2f 70 72 69 6d 2f 63 6c 65 61 6e 1.1.1/prim/clean
dd90: 2f 70 63 65 6c 6c 5f 74 65 73 74 67 65 6e 2f 2e /pcell_testgen/.
dda0: 72 75 6e 63 6f 6e 66 69 67 73 2e 63 66 67 2d 31 runconfigs.cfg-1
ddb0: 2e 36 34 32 37 2d 37 64 31 65 37 38 39 63 62 33 .6427-7d1e789cb3
ddc0: 66 36 32 66 39 63 64 65 37 31 39 61 34 38 36 35 f62f9cde719a4865
ddd0: 62 62 35 31 62 33 63 31 37 65 61 38 35 33 22 20 bb51b3c17ea853"
dde0: 2d 20 74 69 63 6b 65 74 20 32 32 30 35 34 36 33 - ticket 2205463
ddf0: 34 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 42.
de00: 20 20 20 20 20 20 20 3b 3b 20 54 4f 44 4f 20 2d ;; TODO -
de10: 20 63 6f 6e 73 69 64 65 72 20 31 29 20 75 73 69 consider 1) usi
de20: 6e 67 20 73 69 6d 70 6c 65 2d 6c 6f 63 6b 20 74 ng simple-lock t
de30: 6f 20 62 72 61 63 6b 65 74 20 63 61 63 68 65 20 o bracket cache
de40: 77 72 69 74 65 0a 20 20 20 20 20 20 20 20 20 20 write.
de50: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
de60: 20 20 20 20 20 20 20 20 20 20 20 20 20 32 29 20 2)
de70: 63 61 63 68 65 20 69 6e 20 68 61 73 68 20 6f 6e cache in hash on
de80: 20 73 65 72 76 65 72 2c 20 73 69 6e 63 65 20 6e server, since n
de90: 65 65 64 20 74 6f 20 64 6f 20 72 6d 74 3a 20 61 eed to do rmt: a
dea0: 6e 79 77 61 79 20 74 6f 20 6c 6f 63 6b 2e 0a 0a nyway to lock...
deb0: 09 09 20 20 20 20 28 69 66 20 72 63 63 61 63 68 .. (if rccach
dec0: 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ef.
ded0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
dee0: 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 20 on:fail-safe.
def0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df00: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 (lambda ()
df10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
df20: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
df30: 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 74 figf:write-alist
df40: 20 72 75 6e 63 6f 6e 66 69 67 64 61 74 20 72 63 runconfigdat rc
df50: 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 20 20 cachef)).
df60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
df70: 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 20 6e (conc "Could n
df80: 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 20 66 ot write cache f
df90: 69 6c 65 20 2d 20 22 72 63 63 61 63 68 65 66 29 ile - "rccachef)
dfa0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
dfb0: 20 20 20 20 20 20 20 28 69 66 20 6d 74 63 61 63 (if mtcac
dfc0: 68 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 hef.
dfd0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d (com
dfe0: 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 mon:fail-safe.
dff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e000: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
e010: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
e020: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
e030: 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 nfigf:write-alis
e040: 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 6d 74 t *configdat* mt
e050: 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 20 20 cachef)).
e060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e070: 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 20 6e (conc "Could n
e080: 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 20 66 ot write cache f
e090: 69 6c 65 20 2d 20 22 6d 74 63 61 63 68 65 66 29 ile - "mtcachef)
e0a0: 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 20 2a ))... (set! *
e0b0: 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 72 75 runconfigdat* ru
e0c0: 6e 63 6f 6e 66 69 67 64 61 74 29 0a 09 09 20 20 nconfigdat)...
e0d0: 20 20 28 69 66 20 28 61 6e 64 20 72 63 63 61 63 (if (and rccac
e0e0: 68 65 66 20 6d 74 63 61 63 68 65 66 29 20 28 73 hef mtcachef) (s
e0f0: 65 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 et! *configstatu
e100: 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 29 29 29 s* 'fulldata))))
e110: 0a 09 09 3b 3b 20 6e 6f 20 63 6f 6e 66 69 67 73 ...;; no configs
e120: 20 66 6f 75 6e 64 3f 20 73 68 6f 75 6c 64 20 6e found? should n
e130: 6f 74 20 68 61 70 70 65 6e 20 62 75 74 20 6c 65 ot happen but le
e140: 74 27 73 20 74 72 79 20 74 6f 20 72 65 63 6f 76 t's try to recov
e150: 65 72 20 67 72 61 63 65 66 75 6c 6c 79 2c 20 72 er gracefully, r
e160: 65 74 75 72 6e 20 61 6e 20 65 6d 70 74 79 20 68 eturn an empty h
e170: 61 73 68 2d 74 61 62 6c 65 0a 09 09 28 73 65 74 ash-table...(set
e180: 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 28 6d ! *configdat* (m
e190: 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 ake-hash-table))
e1a0: 0a 09 09 29 29 29 0a 0a 09 20 3b 3b 20 65 6c 73 ...)))... ;; els
e1b0: 65 20 72 65 61 64 20 77 68 61 74 20 79 6f 75 20 e read what you
e1c0: 63 61 6e 20 61 6e 64 20 73 65 74 20 74 68 65 20 can and set the
e1d0: 66 6c 61 67 20 61 63 63 6f 72 64 69 6e 67 6c 79 flag accordingly
e1e0: 0a 09 20 3b 3b 20 68 65 72 65 20 77 65 20 64 6f .. ;; here we do
e1f0: 6e 27 74 20 68 61 76 65 20 65 69 74 68 65 72 20 n't have either
e200: 6d 74 63 6f 6e 66 69 67 20 6f 72 20 72 63 63 61 mtconfig or rcca
e210: 63 68 65 66 0a 09 20 28 65 6c 73 65 0a 20 20 20 chef.. (else.
e220: 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c ;;(BB> "l
e230: 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 aunch:setup-body
e240: 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e 63 68 20 -- cond branch
e250: 33 20 2d 20 65 6c 73 65 22 29 0a 09 20 20 28 6c 3 - else").. (l
e260: 65 74 2a 20 28 28 63 66 67 64 61 74 20 20 20 28 et* ((cfgdat (
e270: 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f find-and-read-co
e280: 6e 66 69 67 20 0a 09 09 09 20 20 20 20 28 6f 72 nfig .... (or
e290: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
e2a0: 2d 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 61 74 -config") "megat
e2b0: 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 09 09 est.config")....
e2c0: 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 74 74 environ-patt
e2d0: 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 65 22 : "env-override"
e2e0: 0a 09 09 09 20 20 20 20 67 69 76 65 6e 2d 74 6f .... given-to
e2f0: 70 70 61 74 68 3a 20 28 67 65 74 2d 65 6e 76 69 ppath: (get-envi
e300: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
e310: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
e320: 4d 45 22 29 0a 09 09 09 20 20 20 20 70 61 74 68 ME").... path
e330: 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f envvar: "MT_RUN_
e340: 41 52 45 41 5f 48 4f 4d 45 22 29 29 29 0a 0a 20 AREA_HOME")))..
e350: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
e360: 61 6e 64 20 63 66 67 64 61 74 20 28 6c 69 73 74 and cfgdat (list
e370: 3f 20 63 66 67 64 61 74 29 20 28 3e 20 28 6c 65 ? cfgdat) (> (le
e380: 6e 67 74 68 20 63 66 67 64 61 74 29 20 30 29 20 ngth cfgdat) 0)
e390: 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 28 63 61 (hash-table? (ca
e3a0: 72 20 63 66 67 64 61 74 29 29 29 0a 09 09 28 6c r cfgdat)))...(l
e3b0: 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 20 28 et* ((toppath (
e3c0: 6f 72 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d or (get-environm
e3d0: 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 ent-variable "MT
e3e0: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
e3f0: 28 63 61 64 72 20 63 66 67 64 61 74 29 29 29 0a (cadr cfgdat))).
e400: 09 09 20 20 20 20 20 20 20 28 72 64 61 74 20 20 .. (rdat
e410: 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 (read-config
e420: 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 20 3b (conc toppath ;
e430: 3b 20 63 6f 6e 76 65 72 74 20 74 68 69 73 20 74 ; convert this t
e440: 6f 20 75 73 65 20 72 75 6e 63 6f 6e 66 69 67 3a o use runconfig:
e450: 72 65 61 64 21 0a 09 09 09 09 09 09 20 20 20 20 read!.......
e460: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
e470: 66 69 67 22 29 20 2a 72 75 6e 63 6f 6e 66 69 67 fig") *runconfig
e480: 64 61 74 2a 20 23 74 20 73 65 63 74 69 6f 6e 73 dat* #t sections
e490: 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 0a 09 09 : sections)))...
e4a0: 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 (set! *configi
e4b0: 6e 66 6f 2a 20 20 20 63 66 67 64 61 74 29 0a 09 nfo* cfgdat)..
e4c0: 09 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 . (set! *config
e4d0: 64 61 74 2a 20 20 20 20 28 63 61 72 20 63 66 67 dat* (car cfg
e4e0: 64 61 74 29 29 0a 09 09 20 20 28 73 65 74 21 20 dat))... (set!
e4f0: 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 72 *runconfigdat* r
e500: 64 61 74 29 0a 09 09 20 20 28 73 65 74 21 20 2a dat)... (set! *
e510: 74 6f 70 70 61 74 68 2a 20 20 20 20 20 20 74 6f toppath* to
e520: 70 70 61 74 68 29 0a 09 09 20 20 28 73 65 74 21 ppath)... (set!
e530: 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 2a 20 *configstatus*
e540: 27 70 61 72 74 69 61 6c 29 29 0a 09 09 28 62 65 'partial))...(be
e550: 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 3a 70 gin... (debug:p
e560: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
e570: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
e580: 22 4e 6f 20 22 20 6d 74 63 6f 6e 66 69 67 20 22 "No " mtconfig "
e590: 20 66 69 6c 65 20 66 6f 75 6e 64 2e 20 47 69 76 file found. Giv
e5a0: 69 6e 67 20 75 70 2e 22 29 0a 09 09 20 20 28 65 ing up.")... (e
e5b0: 78 69 74 20 32 29 29 29 29 29 29 0a 09 3b 3b 20 xit 2))))))..;;
e5c0: 43 4f 4e 44 20 65 6e 64 73 20 68 65 72 65 2e 0a COND ends here..
e5d0: 09 0a 09 3b 3b 20 61 64 64 69 74 69 6f 6e 61 6c ...;; additional
e5e0: 20 68 6f 75 73 65 20 6b 65 65 70 69 6e 67 0a 09 house keeping..
e5f0: 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 74 72 65 65 (let* ((linktree
e600: 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 (or (common:get
e610: 2d 6c 69 6e 6b 74 72 65 65 29 0a 09 09 09 20 20 -linktree)....
e620: 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 (conc *toppat
e630: 68 2a 20 22 2f 6c 74 22 29 29 29 29 0a 09 20 20 h* "/lt"))))..
e640: 28 69 66 20 6c 69 6e 6b 74 72 65 65 0a 09 20 20 (if linktree..
e650: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 69 66 (begin...(if
e660: 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (not (common:fi
e670: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 le-exists? linkt
e680: 72 65 65 29 29 0a 09 09 20 20 20 20 28 62 65 67 ree))... (beg
e690: 69 6e 0a 09 09 20 20 20 20 20 20 28 68 61 6e 64 in... (hand
e6a0: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
e6b0: 09 20 20 65 78 6e 0a 09 09 09 20 20 28 62 65 67 . exn.... (beg
e6c0: 69 6e 0a 09 09 09 20 20 20 20 28 64 65 62 75 67 in.... (debug
e6d0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
e6e0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
e6f0: 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 65 6e * "Something wen
e700: 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 72 79 t wrong when try
e710: 69 6e 67 20 74 6f 20 63 72 65 61 74 65 20 6c 69 ing to create li
e720: 6e 6b 74 72 65 65 20 64 69 72 20 61 74 20 22 20 nktree dir at "
e730: 6c 69 6e 6b 74 72 65 65 29 0a 09 09 09 20 20 20 linktree)....
e740: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
e750: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
e760: 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 20 t* " message: "
e770: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
e780: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
e790: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
e7a0: 29 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a ) ", exn=" exn).
e7b0: 09 09 09 20 20 20 20 28 65 78 69 74 20 31 29 29 ... (exit 1))
e7c0: 0a 09 09 09 28 63 72 65 61 74 65 2d 64 69 72 65 ....(create-dire
e7d0: 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 20 23 ctory linktree #
e7e0: 74 29 29 29 29 0a 09 09 28 68 61 6e 64 6c 65 2d t))))...(handle-
e7f0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 20 20 exceptions...
e800: 20 65 78 6e 0a 09 09 20 20 20 20 28 62 65 67 69 exn... (begi
e810: 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 n... (debug
e820: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
e830: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
e840: 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 65 6e * "Something wen
e850: 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 72 79 t wrong when try
e860: 69 6e 67 20 74 6f 20 63 72 65 61 74 65 20 6c 69 ing to create li
e870: 6e 6b 20 74 6f 20 6c 69 6e 6b 74 72 65 65 20 61 nk to linktree a
e880: 74 20 22 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 t " *toppath*)..
e890: 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
e8a0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
e8b0: 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 73 61 og-port* " messa
e8c0: 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 6f ge: " ((conditio
e8d0: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
e8e0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
e8f0: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 6e 3d 22 e) exn) ", exn="
e900: 20 65 78 6e 29 29 0a 09 09 20 20 28 6c 65 74 20 exn))... (let
e910: 28 28 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 2a 74 ((tlink (conc *t
e920: 6f 70 70 61 74 68 2a 20 22 2f 6c 74 22 29 29 29 oppath* "/lt")))
e930: 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ... (if (not
e940: 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 (common:file-exi
e950: 73 74 73 3f 20 74 6c 69 6e 6b 29 29 0a 09 09 09 sts? tlink))....
e960: 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 (create-symbolic
e970: 2d 6c 69 6e 6b 20 6c 69 6e 6b 74 72 65 65 20 74 -link linktree t
e980: 6c 69 6e 6b 29 29 29 29 29 0a 09 20 20 20 20 20 link)))))..
e990: 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 (begin...(debug
e9a0: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
e9b0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
e9c0: 2a 20 22 6c 69 6e 6b 74 72 65 65 20 6e 6f 74 20 * "linktree not
e9d0: 64 65 66 69 6e 65 64 20 69 6e 20 5b 73 65 74 75 defined in [setu
e9e0: 70 5d 20 73 65 63 74 69 6f 6e 20 6f 66 20 6d 65 p] section of me
e9f0: 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a gatest.config").
ea00: 09 09 29 29 29 0a 09 28 69 66 20 28 61 6e 64 20 ..)))..(if (and
ea10: 2a 74 6f 70 70 61 74 68 2a 0a 09 09 20 28 64 69 *toppath*... (di
ea20: 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 rectory-exists?
ea30: 2a 74 6f 70 70 61 74 68 2a 29 29 0a 09 20 20 20 *toppath*))..
ea40: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
ea50: 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 setenv "MT_RUN_A
ea60: 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 REA_HOME" *toppa
ea70: 74 68 2a 29 0a 09 20 20 20 20 20 20 28 73 65 74 th*).. (set
ea80: 65 6e 76 20 22 4d 54 5f 54 45 53 54 53 55 49 54 env "MT_TESTSUIT
ea90: 45 4e 41 4d 45 22 20 28 63 6f 6d 6d 6f 6e 3a 67 ENAME" (common:g
eaa0: 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d et-testsuite-nam
eab0: 65 29 29 29 0a 09 20 20 20 20 28 62 65 67 69 6e e))).. (begin
eac0: 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 .. (debug:p
ead0: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
eae0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
eaf0: 22 66 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 "failed to find
eb00: 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 the top path to
eb10: 79 6f 75 72 20 4d 65 67 61 74 65 73 74 20 61 72 your Megatest ar
eb20: 65 61 2e 22 29 0a 09 20 20 20 20 20 20 28 73 65 ea.").. (se
eb30: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 23 66 29 t! *toppath* #f)
eb40: 20 3b 3b 20 66 6f 72 63 65 20 69 74 20 74 6f 20 ;; force it to
eb50: 62 65 20 66 61 6c 73 65 20 73 6f 20 77 65 20 72 be false so we r
eb60: 65 74 75 72 6e 20 23 66 0a 09 20 20 20 20 20 20 eturn #f..
eb70: 23 66 29 29 0a 0a 09 3b 3b 20 6e 65 65 64 65 64 #f))...;; needed
eb80: 20 62 79 20 76 61 72 69 6f 75 73 20 74 72 61 6e by various tran
eb90: 73 70 6f 72 74 20 61 6e 64 20 64 62 20 6d 6f 64 sport and db mod
eba0: 75 6c 65 73 0a 09 28 64 62 66 69 6c 65 3a 74 65 ules..(dbfile:te
ebb0: 73 74 73 75 69 74 65 2d 6e 61 6d 65 20 28 63 6f stsuite-name (co
ebc0: 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 mmon:get-testsui
ebd0: 74 65 2d 6e 61 6d 65 29 29 20 3b 3b 20 28 67 65 te-name)) ;; (ge
ebe0: 74 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 t-testsuite-name
ebf0: 20 2a 74 6f 70 70 61 74 68 2a 20 2a 63 6f 6e 66 *toppath* *conf
ec00: 69 67 64 61 74 2a 29 29 0a 0a 20 20 20 20 20 20 igdat*))..
ec10: 20 20 3b 3b 20 6f 6e 65 20 6d 6f 72 65 20 61 74 ;; one more at
ec20: 74 65 6d 70 74 20 74 6f 20 63 61 63 68 65 20 74 tempt to cache t
ec30: 68 65 20 63 6f 6e 66 69 67 73 20 66 6f 72 20 66 he configs for f
ec40: 75 74 75 72 65 20 72 65 61 64 69 6e 67 0a 20 20 uture reading.
ec50: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 61 (let* ((ca
ec60: 63 68 65 66 69 6c 65 73 20 20 20 28 6c 61 75 6e chefiles (laun
ec70: 63 68 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 6c ch:get-cache-fil
ec80: 65 2d 70 61 74 68 73 20 61 72 65 61 70 61 74 68 e-paths areapath
ec90: 20 74 6f 70 70 61 74 68 20 74 61 72 67 65 74 20 toppath target
eca0: 6d 74 63 6f 6e 66 69 67 29 29 0a 20 20 20 20 20 mtconfig)).
ecb0: 20 20 20 20 20 20 20 20 20 20 28 6d 74 63 61 63 (mtcac
ecc0: 68 65 66 20 20 20 20 20 28 63 61 72 20 63 61 63 hef (car cac
ecd0: 68 65 66 69 6c 65 73 29 29 0a 20 20 20 20 20 20 hefiles)).
ece0: 20 20 20 20 20 20 20 20 20 28 72 63 63 61 63 68 (rccach
ecf0: 65 66 20 20 20 20 20 28 63 64 72 20 63 61 63 68 ef (cdr cach
ed00: 65 66 69 6c 65 73 29 29 29 0a 0a 20 20 20 20 20 efiles)))..
ed10: 20 20 20 20 20 3b 3b 20 74 72 61 70 20 65 78 63 ;; trap exc
ed20: 65 70 74 69 6f 6e 20 64 75 65 20 74 6f 20 73 74 eption due to st
ed30: 61 6c 65 20 4e 46 53 20 68 61 6e 64 6c 65 20 2d ale NFS handle -
ed40: 2d 20 45 72 72 6f 72 3a 20 28 6f 70 65 6e 2d 6f - Error: (open-o
ed50: 75 74 70 75 74 2d 66 69 6c 65 29 20 63 61 6e 6e utput-file) cann
ed60: 6f 74 20 6f 70 65 6e 20 66 69 6c 65 20 2d 20 53 ot open file - S
ed70: 74 61 6c 65 20 4e 46 53 20 66 69 6c 65 20 68 61 tale NFS file ha
ed80: 6e 64 6c 65 3a 20 22 2e 2e 2e 73 6f 6d 65 70 61 ndle: "...somepa
ed90: 74 68 2e 2e 2e 2f 2e 72 75 6e 63 6f 6e 66 69 67 th.../.runconfig
eda0: 73 2e 63 66 67 2d 31 2e 36 34 32 37 2d 37 64 31 s.cfg-1.6427-7d1
edb0: 65 37 38 39 63 62 33 66 36 32 66 39 63 64 65 37 e789cb3f62f9cde7
edc0: 31 39 61 34 38 36 35 62 62 35 31 62 33 63 31 37 19a4865bb51b3c17
edd0: 65 61 38 35 33 22 20 2d 20 74 69 63 6b 65 74 20 ea853" - ticket
ede0: 32 32 30 35 34 36 33 34 32 0a 20 20 20 20 20 20 220546342.
edf0: 20 20 20 20 3b 3b 20 54 4f 44 4f 20 2d 20 63 6f ;; TODO - co
ee00: 6e 73 69 64 65 72 20 31 29 20 75 73 69 6e 67 20 nsider 1) using
ee10: 73 69 6d 70 6c 65 2d 6c 6f 63 6b 20 74 6f 20 62 simple-lock to b
ee20: 72 61 63 6b 65 74 20 63 61 63 68 65 20 77 72 69 racket cache wri
ee30: 74 65 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 te. ;;
ee40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ee50: 32 29 20 63 61 63 68 65 20 69 6e 20 68 61 73 68 2) cache in hash
ee60: 20 6f 6e 20 73 65 72 76 65 72 2c 20 73 69 6e 63 on server, sinc
ee70: 65 20 6e 65 65 64 20 74 6f 20 64 6f 20 72 6d 74 e need to do rmt
ee80: 3a 20 61 6e 79 77 61 79 20 74 6f 20 6c 6f 63 6b : anyway to lock
ee90: 2e 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 .. (if
eea0: 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 2a 72 (and rccachef *r
eeb0: 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 28 6e 6f unconfigdat* (no
eec0: 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 t (common:file-e
eed0: 78 69 73 74 73 3f 20 72 63 63 61 63 68 65 66 29 xists? rccachef)
eee0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
eef0: 20 28 63 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 (common:fail-sa
ef00: 66 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 fe.
ef10: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
ef20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
ef30: 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 onfigf:write-ali
ef40: 73 74 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 st *runconfigdat
ef50: 2a 20 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 * rccachef)).
ef60: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
ef70: 63 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 72 69 c "Could not wri
ef80: 74 65 20 63 61 63 68 65 20 66 69 6c 65 20 2d 20 te cache file -
ef90: 22 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 20 "rccachef)).
efa0: 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 ).
efb0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 6d (if (and m
efc0: 74 63 61 63 68 65 66 20 2a 63 6f 6e 66 69 67 64 tcachef *configd
efd0: 61 74 2a 20 20 20 20 28 6e 6f 74 20 28 63 6f 6d at* (not (com
efe0: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
eff0: 20 6d 74 63 61 63 68 65 66 29 29 29 0a 20 20 20 mtcachef))).
f000: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d (comm
f010: 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 20 on:fail-safe.
f020: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
f030: 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 bda ().
f040: 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 (configf
f050: 3a 77 72 69 74 65 2d 61 6c 69 73 74 20 2a 63 6f :write-alist *co
f060: 6e 66 69 67 64 61 74 2a 20 6d 74 63 61 63 68 65 nfigdat* mtcache
f070: 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)).
f080: 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 20 (conc "Could
f090: 6e 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 20 not write cache
f0a0: 66 69 6c 65 20 2d 20 22 6d 74 63 61 63 68 65 66 file - "mtcachef
f0b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
f0c0: 20 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
f0d0: 20 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 6d (and rccachef m
f0e0: 74 63 61 63 68 65 66 20 2a 72 75 6e 63 6f 6e 66 tcachef *runconf
f0f0: 69 67 64 61 74 2a 20 2a 63 6f 6e 66 69 67 64 61 igdat* *configda
f100: 74 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t*).
f110: 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 (set! *configs
f120: 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 tatus* 'fulldata
f130: 29 29 29 0a 0a 09 3b 3b 20 69 66 20 68 61 76 65 )))...;; if have
f140: 20 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 20 -append-config
f150: 74 68 65 6e 20 72 65 61 64 20 61 6e 64 20 61 70 then read and ap
f160: 70 65 6e 64 20 68 65 72 65 0a 09 28 6c 65 74 20 pend here..(let
f170: 28 28 63 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 ((cfname (args:g
f180: 65 74 2d 61 72 67 20 22 2d 61 70 70 65 6e 64 2d et-arg "-append-
f190: 63 6f 6e 66 69 67 22 29 29 29 0a 09 20 20 28 69 config"))).. (i
f1a0: 66 20 28 61 6e 64 20 63 66 6e 61 6d 65 0a 09 09 f (and cfname...
f1b0: 20 20 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 (file-read-ac
f1c0: 63 65 73 73 3f 20 63 66 6e 61 6d 65 29 29 0a 09 cess? cfname))..
f1d0: 20 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 (read-conf
f1e0: 69 67 20 63 66 6e 61 6d 65 20 2a 63 6f 6e 66 69 ig cfname *confi
f1f0: 67 64 61 74 2a 20 23 74 29 29 29 20 3b 3b 20 76 gdat* #t))) ;; v
f200: 61 6c 75 65 73 20 61 72 65 20 61 64 64 65 64 20 alues are added
f210: 74 6f 20 74 68 65 20 68 61 73 68 2c 20 6e 6f 20 to the hash, no
f220: 6e 65 65 64 20 74 6f 20 64 6f 20 61 6e 79 74 68 need to do anyth
f230: 69 6e 67 20 73 70 65 63 69 61 6c 2e 0a 0a 09 3b ing special....;
f240: 3b 20 68 61 76 65 20 63 6f 6e 66 69 67 20 61 74 ; have config at
f250: 20 74 68 69 73 20 74 69 6d 65 2c 20 74 68 69 73 this time, this
f260: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
f270: 20 74 6f 20 73 65 74 20 70 61 72 61 6d 73 20 62 to set params b
f280: 61 73 65 64 20 6f 6e 20 63 6f 6e 66 69 67 20 66 ased on config f
f290: 69 6c 65 20 73 65 74 74 69 6e 67 73 0a 09 28 6c ile settings..(l
f2a0: 65 74 2a 20 20 28 28 64 62 6d 6f 64 65 20 20 20 et* ((dbmode
f2b0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
f2c0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
f2d0: 75 70 22 20 22 64 62 63 61 63 68 65 2d 6d 6f 64 up" "dbcache-mod
f2e0: 65 22 29 29 0a 09 09 28 73 79 6e 63 6d 6f 64 65 e"))...(syncmode
f2f0: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
f300: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
f310: 74 75 70 22 20 22 73 79 6e 63 2d 6d 6f 64 65 22 tup" "sync-mode"
f320: 29 29 0a 09 09 28 73 72 76 64 65 62 75 67 20 28 ))...(srvdebug (
f330: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
f340: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 72 76 configdat* "serv
f350: 65 72 22 20 22 64 65 62 75 67 2d 70 61 72 61 6d er" "debug-param
f360: 65 74 65 72 22 29 29 29 0a 09 20 20 28 69 66 20 eter"))).. (if
f370: 64 62 6d 6f 64 65 0a 09 20 20 20 20 20 20 28 62 dbmode.. (b
f380: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
f390: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
f3a0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4f ult-log-port* "O
f3b0: 76 65 72 72 69 64 69 6e 67 20 64 62 6d 6f 64 65 verriding dbmode
f3c0: 20 74 6f 20 22 64 62 6d 6f 64 65 29 0a 09 09 28 to "dbmode)...(
f3d0: 64 62 63 61 63 68 65 2d 6d 6f 64 65 20 28 73 74 dbcache-mode (st
f3e0: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 64 62 6d ring->symbol dbm
f3f0: 6f 64 65 29 29 29 29 0a 09 20 20 28 69 66 20 73 ode)))).. (if s
f400: 79 6e 63 6d 6f 64 65 0a 09 20 20 20 20 20 20 28 yncmode.. (
f410: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
f420: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
f430: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
f440: 4f 76 65 72 72 69 64 69 6e 67 20 73 79 6e 63 6d Overriding syncm
f450: 6f 64 65 20 74 6f 20 22 73 79 6e 63 6d 6f 64 65 ode to "syncmode
f460: 29 0a 09 09 28 64 62 66 69 6c 65 3a 73 79 6e 63 )...(dbfile:sync
f470: 2d 6d 65 74 68 6f 64 20 28 73 74 72 69 6e 67 2d -method (string-
f480: 3e 73 79 6d 62 6f 6c 20 73 79 6e 63 6d 6f 64 65 >symbol syncmode
f490: 29 29 29 29 0a 09 20 20 28 69 66 20 73 72 76 64 )))).. (if srvd
f4a0: 65 62 75 67 0a 09 20 20 20 20 20 20 28 62 65 67 ebug.. (beg
f4b0: 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e in...(debug:prin
f4c0: 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c t-info 0 *defaul
f4d0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4f 76 65 t-log-port* "Ove
f4e0: 72 72 69 64 69 6e 67 20 73 65 72 76 65 72 20 64 rriding server d
f4f0: 65 62 75 67 20 70 61 72 61 6d 65 74 65 72 20 74 ebug parameter t
f500: 6f 20 22 73 72 76 64 65 62 75 67 29 0a 09 09 28 o "srvdebug)...(
f510: 74 74 2d 73 65 72 76 65 72 2d 70 72 6f 66 69 6c tt-server-profil
f520: 65 2d 73 74 72 69 6e 67 20 73 72 76 64 65 62 75 e-string srvdebu
f530: 67 29 29 29 0a 09 20 20 29 0a 09 09 0a 09 2a 74 g))).. ).....*t
f540: 6f 70 70 61 74 68 2a 29 29 29 0a 0a 0a 28 64 65 oppath*)))...(de
f550: 66 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d 64 fine (get-best-d
f560: 69 73 6b 20 63 6f 6e 66 64 61 74 20 74 65 73 74 isk confdat test
f570: 63 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 config). (let*
f580: 28 28 64 69 73 6b 73 20 20 20 28 6f 72 20 28 61 ((disks (or (a
f590: 6e 64 20 74 65 73 74 63 6f 6e 66 69 67 20 28 68 nd testconfig (h
f5a0: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
f5b0: 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 fault testconfig
f5c0: 20 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 09 "disks" #f))...
f5d0: 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c (hash-tabl
f5e0: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f e-ref/default co
f5f0: 6e 66 64 61 74 20 22 64 69 73 6b 73 22 20 23 66 nfdat "disks" #f
f600: 29 29 29 0a 09 20 28 6d 69 6e 73 70 61 63 65 20 ))).. (minspace
f610: 28 6c 65 74 20 28 28 6d 20 28 63 6f 6e 66 69 67 (let ((m (config
f620: 66 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 64 61 74 f:lookup confdat
f630: 20 22 73 65 74 75 70 22 20 22 6d 69 6e 73 70 61 "setup" "minspa
f640: 63 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 73 ce")))... (s
f650: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f tring->number (o
f660: 72 20 6d 20 22 31 30 30 30 30 22 29 29 29 29 29 r m "10000")))))
f670: 0a 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a . (if disks .
f680: 09 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f 6d .(let ((res (com
f690: 6d 6f 6e 3a 67 65 74 2d 64 69 73 6b 2d 77 69 74 mon:get-disk-wit
f6a0: 68 2d 6d 6f 73 74 2d 66 72 65 65 2d 73 70 61 63 h-most-free-spac
f6b0: 65 20 64 69 73 6b 73 20 6d 69 6e 73 70 61 63 65 e disks minspace
f6c0: 29 29 29 0a 09 20 20 28 69 66 20 72 65 73 0a 09 ))).. (if res..
f6d0: 20 20 20 20 20 20 28 63 64 72 20 72 65 73 29 0a (cdr res).
f6e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
f6f0: 20 65 6c 73 65 20 69 66 20 6e 6f 20 76 61 6c 69 else if no vali
f700: 64 20 64 69 73 6b 73 2e 2e 2e 0a 09 20 20 20 20 d disks.....
f710: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
f720: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
f730: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
f740: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
f750: 49 4e 47 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 ING: No valid di
f760: 73 6b 73 20 6f 72 20 6e 6f 20 64 69 73 6b 20 77 sks or no disk w
f770: 69 74 68 20 65 6e 6f 75 67 68 20 73 70 61 63 65 ith enough space
f780: 20 66 6f 75 6e 64 20 66 72 6f 6d 20 22 20 64 69 found from " di
f790: 73 6b 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 sks).
f7a0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
f7b0: 64 69 73 6b 73 29 0a 20 20 20 20 20 20 20 20 20 disks).
f7c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
f7d0: 73 20 31 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 s 1 (conc *toppa
f7e0: 74 68 2a 20 22 2f 72 75 6e 73 22 29 29 0a 0a 20 th* "/runs"))..
f7f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f800: 20 20 20 20 3b 3b 20 65 6c 73 65 20 74 72 79 20 ;; else try
f810: 74 6f 20 63 72 65 61 74 65 20 74 68 65 20 64 69 to create the di
f820: 72 65 63 74 6f 72 69 65 73 20 61 6e 79 77 61 79 rectories anyway
f830: 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
f840: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 (let ((pa
f850: 74 68 73 20 28 73 6f 72 74 20 64 69 73 6b 73 20 ths (sort disks
f860: 28 6c 61 6d 62 64 61 20 28 78 20 79 29 20 28 3e (lambda (x y) (>
f870: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
f880: 28 63 61 64 72 20 78 29 29 20 28 73 74 72 69 6e (cadr x)) (strin
f890: 67 2d 6c 65 6e 67 74 68 20 28 63 61 64 72 20 79 g-length (cadr y
f8a0: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
f8b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
f8c0: 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 61 64 20 let loop ((head
f8d0: 28 63 61 72 20 70 61 74 68 73 29 29 20 28 74 61 (car paths)) (ta
f8e0: 69 6c 20 28 63 64 72 20 70 61 74 68 73 29 29 29 il (cdr paths)))
f8f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
f900: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
f910: 28 72 65 73 75 6c 74 20 28 68 61 6e 64 6c 65 2d (result (handle-
f920: 65 78 63 65 70 74 69 6f 6e 73 20 65 78 6e 0a 09 exceptions exn..
f930: 09 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 .... (begin.....
f940: 09 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
f950: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
f960: 70 6f 72 74 2a 20 22 66 61 69 6c 65 64 20 74 6f port* "failed to
f970: 20 63 72 65 61 74 65 20 64 69 72 20 22 20 28 63 create dir " (c
f980: 61 64 72 20 68 65 61 64 29 20 22 2c 20 65 78 6e adr head) ", exn
f990: 3d 22 20 65 78 6e 29 0a 09 09 09 09 09 20 20 20 =" exn)......
f9a0: 23 66 29 0a 09 09 09 09 09 20 28 63 72 65 61 74 #f)...... (creat
f9b0: 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 61 64 e-directory (cad
f9c0: 72 20 68 65 61 64 29 20 23 74 29 29 29 29 0a 20 r head) #t)))).
f9d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f9e0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 72 65 (if re
f9f0: 73 75 6c 74 0a 20 20 20 20 20 20 20 20 20 20 20 sult.
fa00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa10: 20 20 20 20 72 65 73 75 6c 74 0a 20 20 20 20 20 result.
fa20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa30: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
fa40: 75 6c 6c 3f 20 74 61 69 6c 29 0a 20 20 20 20 20 ull? tail).
fa50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
fa70: 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 egin.
fa80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa90: 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 (debug
faa0: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
fab0: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 69 t-log-port* "Usi
fac0: 6e 67 20 74 6f 70 70 61 74 68 2f 72 75 6e 73 22 ng toppath/runs"
fad0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
fae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
faf0: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f (conc *to
fb00: 70 70 61 74 68 2a 20 22 2f 72 75 6e 73 22 29 0a ppath* "/runs").
fb10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb30: 20 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 ).
fb40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb50: 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 (loop (c
fb60: 61 72 20 74 61 69 6c 29 20 28 63 64 72 20 74 61 ar tail) (cdr ta
fb70: 69 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 il)))))).
fb80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 0a ).
fb90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fba0: 29 20 3b 3b 20 69 66 20 6e 75 6c 6c 3f 20 64 69 ) ;; if null? di
fbb0: 73 6b 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 sks.
fbc0: 20 20 29 20 3b 3b 20 69 66 20 6e 6f 74 20 72 65 ) ;; if not re
fbd0: 73 0a 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 s. ).
fbe0: 20 20 20 20 20 20 29 0a 09 3b 3b 20 6e 6f 20 64 )..;; no d
fbf0: 69 73 6b 73 20 64 65 66 69 6e 69 74 69 6f 6e 20 isks definition
fc00: 2d 20 75 73 65 20 74 6f 70 70 61 74 68 2f 72 75 - use toppath/ru
fc10: 6e 73 2c 20 66 61 6c 6c 20 62 61 63 6b 20 74 6f ns, fall back to
fc20: 20 63 75 72 72 64 69 72 2f 72 75 6e 73 0a 09 28 currdir/runs..(
fc30: 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 let* ((toppath (
fc40: 6f 72 20 2a 74 6f 70 70 61 74 68 2a 0a 09 09 09 or *toppath*....
fc50: 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d (common:get-
fc60: 74 6f 70 70 61 74 68 20 2a 74 6f 70 70 61 74 68 toppath *toppath
fc70: 2a 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e *).... (begin
fc80: 0a 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 .... (debug
fc90: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
fca0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
fcb0: 2a 20 22 43 72 65 61 74 69 6e 67 20 72 75 6e 73 * "Creating runs
fcc0: 20 64 69 72 20 69 6e 20 63 75 72 72 65 6e 74 20 dir in current
fcd0: 64 69 72 65 63 74 6f 72 79 2c 20 74 68 69 73 20 directory, this
fce0: 69 73 20 70 72 6f 62 61 62 6c 79 20 6e 6f 74 20 is probably not
fcf0: 77 68 61 74 20 79 6f 75 20 77 61 6e 74 65 64 2e what you wanted.
fd00: 20 50 6c 65 61 73 65 20 63 68 65 63 6b 20 79 6f Please check yo
fd10: 75 72 20 73 65 74 75 70 2e 22 29 0a 09 09 09 20 ur setup.")....
fd20: 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 (current-di
fd30: 72 65 63 74 6f 72 79 29 29 29 29 0a 09 20 20 20 rectory))))..
fd40: 20 20 20 20 28 72 75 6e 73 64 69 72 20 28 63 6f (runsdir (co
fd50: 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e nc toppath "/run
fd60: 73 22 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f s"))).. (if (no
fd70: 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 t (file-exists?
fd80: 72 75 6e 73 64 69 72 29 29 28 63 72 65 61 74 65 runsdir))(create
fd90: 2d 64 69 72 65 63 74 6f 72 79 20 72 75 6e 73 64 -directory runsd
fda0: 69 72 29 29 0a 09 20 20 72 75 6e 73 64 69 72 29 ir)).. runsdir)
fdb0: 0a 09 29 29 29 20 3b 3b 20 74 68 65 20 63 6f 64 ..))) ;; the cod
fdc0: 65 20 63 72 65 61 74 65 73 20 74 68 65 20 6e 65 e creates the ne
fdd0: 63 65 73 73 61 72 79 20 64 69 72 65 63 74 6f 72 cessary director
fde0: 69 65 73 20 69 66 20 69 74 20 64 6f 65 73 20 6e ies if it does n
fdf0: 6f 74 20 65 78 69 73 74 20 61 6e 64 20 72 65 74 ot exist and ret
fe00: 75 72 6e 73 20 74 68 65 20 70 61 74 68 2e 0a 0a urns the path...
fe10: 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ..(define (launc
fe20: 68 3a 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 h:test-copy test
fe30: 2d 73 72 63 2d 70 61 74 68 20 74 65 73 74 2d 70 -src-path test-p
fe40: 61 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f ath). (let* ((o
fe50: 76 72 63 6d 64 20 28 6c 65 74 20 28 28 63 6d 64 vrcmd (let ((cmd
fe60: 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
fe70: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
fe80: 74 75 70 22 20 22 74 65 73 74 63 6f 70 79 63 6d tup" "testcopycm
fe90: 64 22 29 29 29 0a 09 09 20 20 20 28 69 66 20 63 d")))... (if c
fea0: 6d 64 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 73 md... ;; s
feb0: 75 62 73 74 69 74 75 74 65 20 74 68 65 20 54 45 ubstitute the TE
fec0: 53 54 5f 53 52 43 5f 50 41 54 48 20 61 6e 64 20 ST_SRC_PATH and
fed0: 54 45 53 54 5f 54 41 52 47 5f 50 41 54 48 0a 09 TEST_TARG_PATH..
fee0: 09 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d . (string-
fef0: 73 75 62 73 74 69 74 75 74 65 20 22 54 45 53 54 substitute "TEST
ff00: 5f 54 41 52 47 5f 50 41 54 48 22 20 74 65 73 74 _TARG_PATH" test
ff10: 2d 70 61 74 68 0a 09 09 09 09 09 20 20 28 73 74 -path...... (st
ff20: 72 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 ring-substitute
ff30: 22 54 45 53 54 5f 53 52 43 5f 50 41 54 48 22 20 "TEST_SRC_PATH"
ff40: 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 63 6d test-src-path cm
ff50: 64 20 23 74 29 20 23 74 29 0a 09 09 20 20 20 20 d #t) #t)...
ff60: 20 20 20 23 66 29 29 29 0a 09 20 28 63 6d 64 20 #f))).. (cmd
ff70: 20 20 20 28 69 66 20 6f 76 72 63 6d 64 20 0a 09 (if ovrcmd ..
ff80: 09 20 20 20 20 20 6f 76 72 63 6d 64 0a 09 09 20 . ovrcmd...
ff90: 20 20 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 (conc "rsync
ffa0: 20 2d 61 76 22 20 28 69 66 20 28 64 65 62 75 67 -av" (if (debug
ffb0: 3a 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 22 :debug-mode 1) "
ffc0: 22 20 22 71 22 29 20 22 20 22 20 74 65 73 74 2d " "q") " " test-
ffd0: 73 72 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 src-path "/ " te
ffe0: 73 74 2d 70 61 74 68 20 22 2f 22 0a 09 09 09 20 st-path "/"....
fff0: 20 20 22 20 3e 3e 20 22 20 74 65 73 74 2d 70 61 " >> " test-pa
10000 74 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c th "/mt_launch.l
10010 6f 67 20 32 3e 3e 20 22 20 74 65 73 74 2d 70 61 og 2>> " test-pa
10020 74 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c th "/mt_launch.l
10030 6f 67 22 29 29 29 0a 09 20 28 73 74 61 74 75 73 og"))).. (status
10040 20 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a (system cmd))).
10050 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 (if (not (eq
10060 3f 20 73 74 61 74 75 73 20 30 29 29 0a 09 28 64 ? status 0))..(d
10070 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
10080 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
10090 22 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 "ERROR: problem
100a0 77 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 with running \""
100b0 20 63 6d 64 20 22 5c 22 22 29 29 29 29 0a 0a 0a cmd "\""))))...
100c0 3b 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 63 ;; Desired direc
100d0 74 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a tory structure:.
100e0 3b 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e ;;.;; <linkdir>
100f0 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 - <target> - <t
10100 65 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 estname> -..;;
10110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10130 20 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 |.;;
10140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10150 20 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b v.;;
10160 20 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c <rundir> - <
10170 74 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 target> - <t
10180 65 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 estname> -|- <it
10190 65 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b empath(s)>.;;.;;
101a0 20 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 dir stored in
101b0 74 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 test is:.;; .;;
101c0 20 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 <linkdir> - <ta
101d0 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d rget> - <testnam
101e0 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 e> [ - <itempath
101f0 3e 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c > ].;; .;; All l
10200 6f 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 og file links sh
10210 6f 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 ould be stored r
10220 65 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 elative to the t
10230 6f 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a op of link path.
10240 3b 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e ;; .;; <target>
10250 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 - <testname> [
10260 2d 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a - <itempath> ] .
10270 3b 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 ;;.(define (crea
10280 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e te-work-area run
10290 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 -id run-info key
102a0 76 61 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 vals test-id tes
102b0 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d t-src-path disk-
102c0 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 path testname it
102d0 65 6d 64 61 74 20 23 21 6b 65 79 20 28 72 65 6d emdat #!key (rem
102e0 74 72 69 65 73 20 32 29 29 0a 20 20 28 6c 65 74 tries 2)). (let
102f0 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 * ((item-path (i
10300 66 20 28 73 74 72 69 6e 67 3f 20 69 74 65 6d 64 f (string? itemd
10310 61 74 29 20 69 74 65 6d 64 61 74 20 28 69 74 65 at) itemdat (ite
10320 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
10330 6d 64 61 74 29 29 29 20 3b 3b 20 69 66 20 70 61 mdat))) ;; if pa
10340 73 73 20 69 6e 20 73 74 72 69 6e 67 20 2d 20 6a ss in string - j
10350 75 73 74 20 75 73 65 20 69 74 0a 09 20 28 72 75 ust use it.. (ru
10360 6e 6e 61 6d 65 20 20 20 28 69 66 20 28 73 74 72 nname (if (str
10370 69 6e 67 3f 20 72 75 6e 2d 69 6e 66 6f 29 20 3b ing? run-info) ;
10380 3b 20 69 66 20 77 65 20 70 61 73 73 20 69 6e 20 ; if we pass in
10390 61 20 73 74 72 69 6e 67 20 61 73 20 72 75 6e 2d a string as run-
103a0 69 6e 66 6f 20 75 73 65 20 69 74 20 61 73 20 72 info use it as r
103b0 75 6e 2d 6e 61 6d 65 2e 0a 09 09 09 72 75 6e 2d un-name.....run-
103c0 69 6e 66 6f 0a 09 09 09 28 64 62 3a 67 65 74 2d info....(db:get-
103d0 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 value-by-header
103e0 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e (db:get-rows run
103f0 2d 69 6e 66 6f 29 0a 09 09 09 09 09 09 28 64 62 -info).......(db
10400 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d :get-header run-
10410 69 6e 66 6f 29 0a 09 09 09 09 09 09 22 72 75 6e info)......."run
10420 6e 61 6d 65 22 29 29 29 0a 09 20 28 63 6f 6e 74 name"))).. (cont
10430 6f 75 72 20 20 20 23 66 29 20 3b 3b 20 4e 4f 54 our #f) ;; NOT
10440 20 52 45 41 44 59 20 46 4f 52 20 54 48 49 53 20 READY FOR THIS
10450 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
10460 63 6f 6e 74 6f 75 72 22 29 29 0a 09 20 3b 3b 20 contour")).. ;;
10470 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 6f 20 convert back to
10480 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 db: from rdb: -
10490 74 68 69 73 20 69 73 20 61 6c 77 61 79 73 20 72 this is always r
104a0 75 6e 20 61 74 20 73 65 72 76 65 72 20 65 6e 64 un at server end
104b0 0a 09 20 28 74 61 72 67 65 74 20 20 20 28 73 74 .. (target (st
104c0 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
104d0 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 (map cadr keyva
104e0 6c 73 29 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f ls) "/"))... (no
104f0 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 71 75 t-iterated (equ
10500 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 al? "" item-path
10510 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 ))... ;; all tes
10520 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 ts are found at
10530 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 <rundir>/test-ba
10540 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f se or <linkdir>/
10550 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 test-base.. (tes
10560 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 ttop-base (conc
10570 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 target "/" runna
10580 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 me "/" testname)
10590 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 ).. (test-base
105a0 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d (conc testtop-
105b0 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 base (if not-ite
105c0 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 rated "" "/") it
105d0 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 em-path))... ;;
105e0 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 nb// if itempath
105f0 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 is not "" then
10600 69 74 20 69 73 20 70 72 65 66 69 78 65 64 20 77 it is prefixed w
10610 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 ith "/".. (topte
10620 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 st-path (conc di
10630 73 6b 2d 70 61 74 68 20 28 69 66 20 63 6f 6e 74 sk-path (if cont
10640 6f 75 72 20 28 63 6f 6e 63 20 22 2f 22 20 63 6f our (conc "/" co
10650 6e 74 6f 75 72 29 20 22 22 29 20 22 2f 22 20 74 ntour) "") "/" t
10660 65 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 esttop-base))..
10670 28 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 (test-path (c
10680 6f 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 28 69 onc disk-path (i
10690 66 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 20 f contour (conc
106a0 22 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 29 "/" contour) "")
106b0 20 22 2f 22 20 74 65 73 74 2d 62 61 73 65 29 29 "/" test-base))
106c0 0a 0a 09 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 ... ;; ensure th
106d0 69 73 20 65 78 69 73 74 73 20 66 69 72 73 74 20 is exists first
106e0 61 73 20 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 as links to subt
106f0 65 73 74 73 20 6d 75 73 74 20 62 65 20 63 72 65 ests must be cre
10700 61 74 65 64 20 74 68 65 72 65 0a 09 20 28 6c 69 ated there.. (li
10710 6e 6b 74 72 65 65 20 20 28 63 6f 6d 6d 6f 6e 3a nktree (common:
10720 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 0a 09 get-linktree))..
10730 20 3b 3b 20 57 41 53 3a 20 28 6c 65 74 20 28 28 ;; WAS: (let ((
10740 72 64 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b rd (configf:look
10750 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
10760 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 setup" "linktree
10770 22 29 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 "))).. ;;
10780 20 20 28 69 66 20 72 64 20 72 64 20 28 63 6f 6e (if rd rd (con
10790 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 c *toppath* "/ru
107a0 6e 73 22 29 29 29 29 0a 09 20 3b 3b 20 77 68 69 ns")))).. ;; whi
107b0 63 68 20 73 65 65 6d 73 20 77 72 6f 6e 67 20 2e ch seems wrong .
107c0 2e 2e 0a 0a 09 20 28 6c 6e 6b 62 61 73 65 20 20 ..... (lnkbase
107d0 20 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 (conc linktree
107e0 28 69 66 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e (if contour (con
107f0 63 20 22 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 c "/" contour) "
10800 22 29 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f ") "/" target "/
10810 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c " runname)).. (l
10820 6e 6b 70 61 74 68 20 20 20 28 63 6f 6e 63 20 6c nkpath (conc l
10830 6e 6b 62 61 73 65 20 22 2f 22 20 74 65 73 74 6e nkbase "/" testn
10840 61 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 ame)).. (lnkpath
10850 66 20 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 f (conc lnkpath
10860 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 (if not-iterate
10870 64 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 d "" "/") item-p
10880 61 74 68 29 29 0a 09 20 28 6c 6e 6b 74 61 72 67 ath)).. (lnktarg
10890 65 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 et (conc lnkpath
108a0 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 "/" item-path))
108b0 29 0a 0a 20 20 20 20 3b 3b 20 55 70 64 61 74 65 ).. ;; Update
108c0 20 74 68 65 20 72 75 6e 64 69 72 20 70 61 74 68 the rundir path
108d0 20 69 6e 20 74 68 65 20 74 65 73 74 20 72 65 63 in the test rec
108e0 6f 72 64 20 66 6f 72 20 61 6c 6c 2c 20 72 75 6e ord for all, run
108f0 64 69 72 3d 70 68 79 73 69 63 61 6c 2c 20 73 68 dir=physical, sh
10900 6f 72 74 64 69 72 3d 6c 6f 67 69 63 61 6c 0a 20 ortdir=logical.
10910 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
10920 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10940 20 20 20 20 20 20 72 75 6e 64 69 72 20 20 20 73 rundir s
10950 68 6f 72 74 64 69 72 0a 20 20 20 20 28 72 6d 74 hortdir. (rmt
10960 3a 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 :general-call 't
10970 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 73 est-set-rundir-s
10980 68 6f 72 74 64 69 72 20 72 75 6e 2d 69 64 20 6c hortdir run-id l
10990 6e 6b 70 61 74 68 66 20 74 65 73 74 2d 70 61 74 nkpathf test-pat
109a0 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d h testname item-
109b0 70 61 74 68 20 72 75 6e 2d 69 64 29 0a 0a 20 20 path run-id)..
109c0 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
109d0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
109e0 72 74 2a 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 rt* "INFO:\n
109f0 20 20 20 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b lnkbase=" lnk
10a00 62 61 73 65 20 22 5c 6e 20 20 20 20 20 20 20 6c base "\n l
10a10 6e 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 nkpath=" lnkpath
10a20 20 22 5c 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 "\n toptest-pa
10a30 74 68 3d 22 20 74 6f 70 74 65 73 74 2d 70 61 74 th=" toptest-pat
10a40 68 20 22 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 h "\n test-p
10a50 61 74 68 3d 22 20 74 65 73 74 2d 70 61 74 68 29 ath=" test-path)
10a60 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 . (if (not (c
10a70 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
10a80 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 s? linktree))..(
10a90 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
10aa0 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
10ab0 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
10ac0 49 4e 47 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 ING: linktree di
10ad0 64 20 6e 6f 74 20 65 78 69 73 74 21 20 43 72 65 d not exist! Cre
10ae0 61 74 69 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 ating it now at
10af0 22 20 6c 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 " linktree).. (
10b00 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
10b10 20 6c 69 6e 6b 74 72 65 65 20 23 74 29 29 29 20 linktree #t)))
10b20 3b 3b 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 ;; (system (conc
10b30 20 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e "mkdir -p " lin
10b40 6b 74 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b ktree)))). ;;
10b50 20 63 72 65 61 74 65 20 74 68 65 20 64 69 72 65 create the dire
10b60 63 74 6f 72 79 20 66 6f 72 20 74 68 65 20 74 65 ctory for the te
10b70 73 74 73 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 sts dir links, t
10b80 68 69 73 20 69 73 20 6e 65 65 64 65 64 20 6e 6f his is needed no
10b90 20 6d 61 74 74 65 72 20 77 68 61 74 2e 2e 2e 20 matter what...
10ba0 74 72 79 20 75 70 20 74 6f 20 74 68 72 65 65 20 try up to three
10bb0 74 69 6d 65 73 0a 20 20 20 20 28 6c 65 74 20 6c times. (let l
10bc0 6f 6f 70 20 28 28 64 6f 6e 65 20 33 29 29 20 0a oop ((done 3)) .
10bd0 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 75 63 (let ((suc
10be0 63 65 73 73 20 28 69 66 20 28 61 6e 64 20 28 6e cess (if (and (n
10bf0 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 ot (common:direc
10c00 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b tory-exists? lnk
10c10 62 61 73 65 29 29 0a 09 09 09 20 20 20 20 20 20 base))....
10c20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c (not (common:fil
10c30 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 e-exists? lnkbas
10c40 65 29 29 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 e))).... (handle
10c50 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 -exceptions....
10c60 20 65 78 6e 0a 09 09 09 20 20 28 62 65 67 69 6e exn.... (begin
10c70 0a 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 .... (debug:p
10c80 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
10c90 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
10ca0 22 50 72 6f 62 6c 65 6d 20 63 72 65 61 74 69 6e "Problem creatin
10cb0 67 20 6c 69 6e 6b 74 72 65 65 20 62 61 73 65 20 g linktree base
10cc0 61 74 20 22 20 6c 6e 6b 62 61 73 65 20 22 2c 20 at " lnkbase ",
10cd0 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 20 20 exn=" exn)....
10ce0 20 20 28 70 72 69 6e 74 2d 65 72 72 6f 72 2d 6d (print-error-m
10cf0 65 73 73 61 67 65 20 65 78 6e 20 28 63 75 72 72 essage exn (curr
10d00 65 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 ent-error-port))
10d10 0a 09 09 09 20 20 20 20 23 74 29 0a 09 09 09 20 .... #t)....
10d20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f (create-directo
10d30 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 0a 09 ry lnkbase #t)..
10d40 09 09 20 20 23 66 29 29 29 29 0a 09 28 69 66 20 .. #f))))..(if
10d50 28 61 6e 64 20 28 6e 6f 74 20 73 75 63 63 65 73 (and (not succes
10d60 73 29 28 3e 20 64 6f 6e 65 20 30 29 29 0a 09 20 s)(> done 0))..
10d70 20 20 20 28 6c 6f 6f 70 20 28 2d 20 64 6f 6e 65 (loop (- done
10d80 20 31 29 29 29 29 29 0a 20 20 20 20 0a 20 20 20 1))))). .
10d90 20 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 74 ;; update the t
10da0 6f 70 74 65 73 74 20 72 65 63 6f 72 64 20 77 69 optest record wi
10db0 74 68 20 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 th its location
10dc0 72 75 6e 64 69 72 2c 20 63 61 63 68 65 20 74 68 rundir, cache th
10dd0 65 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 e path. ;; Th
10de0 69 73 20 77 61 73 73 20 68 69 67 68 6c 79 20 69 is wass highly i
10df0 6e 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 nefficient, one
10e00 64 62 20 77 72 69 74 65 20 66 6f 72 20 65 76 65 db write for eve
10e10 72 79 20 73 75 62 74 65 73 74 2c 20 70 6f 74 65 ry subtest, pote
10e20 6e 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 ntially. ;; t
10e30 68 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 housands of unne
10e40 63 65 73 73 61 72 79 20 75 70 64 61 74 65 73 2c cessary updates,
10e50 20 63 61 63 68 65 20 74 68 65 20 66 61 63 74 20 cache the fact
10e60 69 74 20 77 61 73 20 73 65 74 20 61 6e 64 20 64 it was set and d
10e70 6f 6e 27 74 20 73 65 74 20 69 74 20 0a 20 20 20 on't set it .
10e80 20 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 ;; again. ..
10e90 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 74 ;; Now create t
10ea0 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 he link from the
10eb0 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 68 test path to th
10ec0 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 e link tree, how
10ed0 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 ever. ;; if t
10ee0 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 61 he test is itera
10ef0 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 73 ted it is necess
10f00 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 68 ary to create th
10f10 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 20 e parent path.
10f20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 72 ;; to the iter
10f30 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e ation. use pathn
10f40 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f ame-directory to
10f50 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 62 trim the path b
10f60 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 y one. ;; lev
10f70 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 el. (if (not
10f80 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b not-iterated) ;;
10f90 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a 09 i.e. iterated..
10fa0 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 2d (let ((iterated-
10fb0 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 6d parent (pathnam
10fc0 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f 6e e-directory (con
10fd0 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 c lnkpath "/" it
10fe0 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 28 em-path)))).. (
10ff0 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
11000 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
11010 70 6f 72 74 2a 20 22 43 72 65 61 74 69 6e 67 20 port* "Creating
11020 69 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 iterated parent
11030 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e " iterated-paren
11040 74 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 t).. (handle-ex
11050 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e ceptions.. exn
11060 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 .. (begin..
11070 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
11080 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
11090 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c log-port* " Fail
110a0 65 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 ed to create dir
110b0 65 63 74 6f 72 79 20 22 20 69 74 65 72 61 74 65 ectory " iterate
110c0 64 2d 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 69 d-parent ((condi
110d0 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 tion-property-ac
110e0 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 cessor 'exn 'mes
110f0 73 61 67 65 29 20 65 78 6e 29 0a 09 09 09 09 22 sage) exn)....."
11100 2c 20 63 6f 6e 74 69 6e 75 69 6e 67 20 62 75 74 , continuing but
11110 20 6c 69 6e 6b 20 74 72 65 65 20 6d 61 79 20 62 link tree may b
11120 65 20 63 6f 72 72 75 70 74 65 64 2c 20 65 78 6e e corrupted, exn
11130 3d 22 20 65 78 6e 29 0a 09 20 20 20 20 20 23 3b =" exn).. #;
11140 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 28 63 (exit 1)).. (c
11150 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
11160 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 iterated-parent
11170 23 74 29 29 29 29 0a 0a 20 20 20 20 28 69 66 20 #t)))).. (if
11180 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 (symbolic-link?
11190 6c 6e 6b 70 61 74 68 29 20 0a 09 28 68 61 6e 64 lnkpath) ..(hand
111a0 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 le-exceptions..
111b0 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 exn.. (begin..
111c0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
111d0 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
111e0 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
111f0 64 20 74 6f 20 72 65 6d 6f 76 65 20 73 79 6d 6c d to remove syml
11200 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 ink " lnkpath ((
11210 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
11220 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
11230 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 0a 'message) exn).
11240 09 09 09 20 20 20 20 20 20 22 2c 20 63 6f 6e 74 ... ", cont
11250 69 6e 75 69 6e 67 20 62 75 74 20 6c 69 6e 6b 20 inuing but link
11260 74 72 65 65 20 6d 61 79 20 62 65 20 63 6f 72 72 tree may be corr
11270 75 70 74 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e upted. exn=" exn
11280 29 0a 09 20 20 20 23 3b 28 65 78 69 74 20 31 29 ).. #;(exit 1)
11290 29 0a 09 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 ).. (delete-file
112a0 20 6c 6e 6b 70 61 74 68 29 29 29 0a 0a 20 20 20 lnkpath)))..
112b0 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 63 (if (not (or (c
112c0 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 ommon:file-exist
112d0 73 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 s? lnkpath)... (
112e0 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
112f0 6e 6b 70 61 74 68 29 29 29 0a 09 28 68 61 6e 64 nkpath)))..(hand
11300 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 le-exceptions..
11310 65 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 exn.. (begin..
11320 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
11330 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
11340 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
11350 64 20 74 6f 20 63 72 65 61 74 65 20 73 79 6d 6c d to create syml
11360 69 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 ink " lnkpath ((
11370 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
11380 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
11390 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 0a 'message) exn).
113a0 09 09 09 20 20 20 20 20 20 22 2c 20 63 6f 6e 74 ... ", cont
113b0 69 6e 75 69 6e 67 20 62 75 74 20 6c 69 6e 6b 20 inuing but link
113c0 74 72 65 65 20 6d 61 79 20 62 65 20 63 6f 72 72 tree may be corr
113d0 75 70 74 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e upted. exn=" exn
113e0 29 0a 09 20 20 20 23 3b 28 65 78 69 74 20 31 29 ).. #;(exit 1)
113f0 29 0a 09 20 28 63 72 65 61 74 65 2d 73 79 6d 62 ).. (create-symb
11400 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 olic-link toptes
11410 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 t-path lnkpath))
11420 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 4e 42 ). . ;; NB
11430 20 2d 20 54 68 69 73 20 77 61 73 20 6e 6f 74 20 - This was not
11440 77 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 working right -
11450 73 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 20 61 some top tests a
11460 72 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 re not getting t
11470 68 65 20 70 61 74 68 20 73 65 74 21 21 21 0a 20 he path set!!!.
11480 20 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 44 6f 20 ;;. ;; Do
11490 74 68 65 20 73 65 74 74 69 6e 67 20 6f 66 20 74 the setting of t
114a0 68 69 73 20 72 65 63 6f 72 64 20 61 66 74 65 72 his record after
114b0 20 74 68 65 20 70 61 74 68 73 20 61 72 65 20 63 the paths are c
114c0 72 65 61 74 65 64 20 73 6f 20 74 68 61 74 20 74 reated so that t
114d0 68 65 20 73 68 6f 72 74 64 69 72 20 63 61 6e 20 he shortdir can
114e0 0a 20 20 20 20 3b 3b 20 62 65 20 73 65 74 20 74 . ;; be set t
114f0 6f 20 74 68 65 20 72 65 61 6c 20 64 69 72 65 63 o the real direc
11500 74 6f 72 79 20 6c 6f 63 61 74 69 6f 6e 2e 20 54 tory location. T
11510 68 69 73 20 69 73 20 73 61 66 65 72 20 66 6f 72 his is safer for
11520 20 66 75 74 75 72 65 20 63 6c 65 61 6e 20 75 70 future clean up
11530 20 69 66 20 74 68 65 20 6c 69 6e 6b 0a 20 20 20 if the link.
11540 20 3b 3b 20 74 72 65 65 20 69 73 20 64 61 6d 61 ;; tree is dama
11550 67 65 64 20 6f 72 20 6c 6f 73 74 2e 0a 20 20 20 ged or lost..
11560 20 3b 3b 20 0a 20 20 20 20 28 69 66 20 28 6e 6f ;; . (if (no
11570 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 t (hash-table-re
11580 66 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 f/default *topte
11590 73 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 st-paths* testna
115a0 6d 65 20 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 me #f))..(let* (
115b0 28 74 65 73 74 69 6e 66 6f 20 20 20 20 20 20 20 (testinfo
115c0 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e (rmt:get-test-in
115d0 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 fo-by-id run-id
115e0 74 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 test-id)) ;; ru
115f0 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 n-id testname it
11600 65 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 20 em-path))..
11610 20 20 28 63 75 72 72 2d 74 65 73 74 2d 70 61 74 (curr-test-pat
11620 68 20 28 69 66 20 74 65 73 74 69 6e 66 6f 20 3b h (if testinfo ;
11630 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 ; (filedb:get-pa
11640 74 68 20 2a 66 64 62 2a 0a 09 09 09 09 09 09 09 th *fdb*........
11650 20 20 20 20 20 3b 3b 20 28 64 62 3a 67 65 74 2d ;; (db:get-
11660 70 61 74 68 20 64 62 73 74 72 75 63 74 0a 09 09 path dbstruct...
11670 09 09 20 20 20 3b 3b 20 28 72 6d 74 3a 73 64 62 .. ;; (rmt:sdb
11680 2d 71 72 79 20 27 67 65 74 73 74 72 20 0a 09 09 -qry 'getstr ...
11690 09 09 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 .. (db:test-ge
116a0 74 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 t-rundir testinf
116b0 6f 29 20 3b 3b 20 29 20 3b 3b 20 29 0a 09 09 09 o) ;; ) ;; )....
116c0 09 20 20 20 23 66 29 29 29 0a 09 20 20 28 68 61 . #f))).. (ha
116d0 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 sh-table-set! *t
116e0 6f 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 optest-paths* te
116f0 73 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 74 stname curr-test
11700 2d 70 61 74 68 29 0a 09 20 20 3b 3b 20 4e 42 2f -path).. ;; NB/
11710 2f 20 57 61 73 20 74 68 69 73 20 66 6f 72 20 74 / Was this for t
11720 68 65 20 74 65 73 74 20 6f 72 20 66 6f 72 20 74 he test or for t
11730 68 65 20 70 61 72 65 6e 74 20 69 6e 20 61 6e 20 he parent in an
11740 69 74 65 72 61 74 65 64 20 74 65 73 74 3f 0a 09 iterated test?..
11750 20 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 (rmt:general-c
11760 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d 72 75 all 'test-set-ru
11770 6e 64 69 72 2d 73 68 6f 72 74 64 69 72 20 72 75 ndir-shortdir ru
11780 6e 2d 69 64 20 6c 6e 6b 70 61 74 68 20 0a 09 09 n-id lnkpath ...
11790 09 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e . (if (common
117a0 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e :file-exists? ln
117b0 6b 70 61 74 68 29 0a 09 09 09 09 3b 3b 20 28 72 kpath).....;; (r
117c0 65 73 6f 6c 76 65 2d 70 61 74 68 6e 61 6d 65 20 esolve-pathname
117d0 6c 6e 6b 70 61 74 68 29 0a 09 09 09 09 28 63 6f lnkpath).....(co
117e0 6d 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 6c mmon:nice-path l
117f0 6e 6b 70 61 74 68 29 0a 09 09 09 09 6c 6e 6b 70 nkpath).....lnkp
11800 61 74 68 29 0a 09 09 09 20 20 20 20 74 65 73 74 ath).... test
11810 6e 61 6d 65 20 22 22 20 72 75 6e 2d 69 64 29 0a name "" run-id).
11820 09 20 20 3b 3b 20 28 72 6d 74 3a 67 65 6e 65 72 . ;; (rmt:gener
11830 61 6c 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 al-call 'test-se
11840 74 2d 72 75 6e 64 69 72 20 72 75 6e 2d 69 64 20 t-rundir run-id
11850 6c 6e 6b 70 61 74 68 20 74 65 73 74 6e 61 6d 65 lnkpath testname
11860 20 22 22 29 20 3b 3b 20 74 6f 70 74 65 73 74 2d "") ;; toptest-
11870 70 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f 72 path).. (if (or
11880 20 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 2d (not curr-test-
11890 70 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 28 path)... (not (
118a0 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
118b0 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 ? toptest-path))
118c0 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ).. (begin.
118d0 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
118e0 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
118f0 6f 67 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 69 og-port* "Creati
11900 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 ng " toptest-pat
11910 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c h " and link " l
11920 6e 6b 70 61 74 68 29 0a 09 09 28 68 61 6e 64 6c nkpath)...(handl
11930 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 e-exceptions...
11940 20 20 20 65 78 6e 0a 09 09 20 20 28 69 66 20 28 exn... (if (
11950 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
11960 3f 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 20 ? toptest-path)
11970 3b 3b 20 69 74 20 77 61 73 20 6c 69 6b 65 6c 79 ;; it was likely
11980 20 63 72 65 61 74 65 64 20 69 6e 20 70 61 72 61 created in para
11990 6c 6c 65 6c 0a 09 09 20 20 20 20 20 20 23 74 0a llel... #t.
119a0 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
119b0 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ..(debug:print-i
119c0 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
119d0 6f 67 2d 70 6f 72 74 2a 20 22 66 61 69 6c 65 64 og-port* "failed
119e0 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 to create direc
119f0 74 6f 72 79 20 22 20 74 6f 70 74 65 73 74 2d 70 tory " toptest-p
11a00 61 74 68 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e ath ", exn=" exn
11a10 29 0a 09 09 09 23 66 29 29 0a 09 09 20 28 63 72 )....#f))... (cr
11a20 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 eate-directory t
11a30 6f 70 74 65 73 74 2d 70 61 74 68 20 23 74 29 29 optest-path #t))
11a40 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 ...(hash-table-s
11a50 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 et! *toptest-pat
11a60 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 hs* testname top
11a70 74 65 73 74 2d 70 61 74 68 29 29 29 29 29 0a 0a test-path)))))..
11a80 20 20 20 20 3b 3b 20 54 68 65 20 74 6f 70 74 65 ;; The topte
11a90 73 74 20 70 61 74 68 20 68 61 73 20 62 65 65 6e st path has been
11aa0 20 63 72 65 61 74 65 64 2c 20 74 68 65 20 6c 69 created, the li
11ab0 6e 6b 20 74 6f 20 74 68 65 20 74 65 73 74 20 69 nk to the test i
11ac0 6e 20 74 68 65 20 6c 69 6e 6b 74 72 65 65 20 68 n the linktree h
11ad0 61 73 0a 20 20 20 20 3b 3b 20 62 65 65 6e 20 63 as. ;; been c
11ae0 72 65 61 74 65 64 2e 20 4e 6f 77 2c 20 69 66 20 reated. Now, if
11af0 74 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 61 this is an itera
11b00 74 65 64 20 74 65 73 74 20 74 68 65 20 72 65 61 ted test the rea
11b10 6c 20 74 65 73 74 20 64 69 72 20 6d 75 73 74 20 l test dir must
11b20 62 65 20 63 72 65 61 74 65 64 0a 20 20 20 20 28 be created. (
11b30 69 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 65 72 if (not not-iter
11b40 61 74 65 64 29 20 3b 3b 20 74 68 69 73 20 69 73 ated) ;; this is
11b50 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 an iterated tes
11b60 74 0a 09 28 62 65 67 69 6e 20 3b 3b 20 28 6c 65 t..(begin ;; (le
11b70 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 63 t ((lnktarget (c
11b80 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 onc lnkpath "/"
11b90 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 item-path)))..
11ba0 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a (debug:print 2 *
11bb0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11bc0 2a 20 22 53 65 74 74 69 6e 67 20 75 70 20 73 75 * "Setting up su
11bd0 62 20 74 65 73 74 20 72 75 6e 20 61 72 65 61 22 b test run area"
11be0 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e ).. (debug:prin
11bf0 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 2 *default-log
11c00 2d 70 6f 72 74 2a 20 22 20 2d 20 63 72 65 61 74 -port* " - creat
11c10 69 6e 67 20 72 75 6e 20 61 72 65 61 20 69 6e 20 ing run area in
11c20 22 20 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 " test-path)..
11c30 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
11c40 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 20 28 ns.. exn.. (
11c50 69 66 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 if (directory-ex
11c60 69 73 74 73 3f 20 74 65 73 74 2d 70 61 74 68 29 ists? test-path)
11c70 0a 09 20 20 20 20 20 20 20 23 74 0a 09 20 20 20 .. #t..
11c80 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 28 64 (begin... (d
11c90 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
11ca0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
11cb0 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 20 74 port* " Failed t
11cc0 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 74 6f o create directo
11cd0 72 79 20 22 20 74 65 73 74 2d 70 61 74 68 20 28 ry " test-path (
11ce0 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
11cf0 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
11d00 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
11d10 0a 09 09 09 09 20 20 20 20 22 2c 20 65 78 69 74 ..... ", exit
11d20 69 6e 67 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a ing, exn=" exn).
11d30 09 09 20 28 65 78 69 74 20 31 29 29 29 0a 09 20 .. (exit 1)))..
11d40 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
11d50 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 ory test-path #t
11d60 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 )).. (debug:pri
11d70 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
11d80 67 2d 70 6f 72 74 2a 20 0a 09 09 20 20 20 20 20 g-port* ...
11d90 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c " - creating l
11da0 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 ink from: " test
11db0 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 -path "\n"...
11dc0 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 20 "
11dd0 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e to: " ln
11de0 6b 74 61 72 67 65 74 29 0a 0a 09 20 20 3b 3b 20 ktarget)... ;;
11df0 49 66 20 74 68 65 72 65 20 69 73 20 61 6c 72 65 If there is alre
11e00 61 64 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 ady a symlink de
11e10 6c 65 74 65 20 69 74 20 61 6e 64 20 72 65 63 72 lete it and recr
11e20 65 61 74 65 20 69 74 2e 0a 09 20 20 28 68 61 6e eate it... (han
11e30 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
11e40 20 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 exn.. (begi
11e50 6e 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 n.. (debug:p
11e60 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
11e70 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
11e80 22 20 46 61 69 6c 65 64 20 74 6f 20 72 65 2d 63 " Failed to re-c
11e90 72 65 61 74 65 20 6c 69 6e 6b 20 22 20 6c 6e 6b reate link " lnk
11ea0 74 61 72 67 65 74 20 28 28 63 6f 6e 64 69 74 69 target ((conditi
11eb0 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
11ec0 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
11ed0 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 ge) exn) ", exit
11ee0 69 6e 67 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a ing, exn=" exn).
11ef0 09 20 20 20 20 20 28 65 78 69 74 29 29 0a 09 20 . (exit))..
11f00 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d (if (symbolic-
11f10 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 72 67 65 74 29 link? lnktarget)
11f20 20 20 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c (delete-fil
11f30 65 20 6c 6e 6b 74 61 72 67 65 74 29 29 0a 09 20 e lnktarget))..
11f40 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d (if (not (comm
11f50 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
11f60 6c 6e 6b 74 61 72 67 65 74 29 29 20 28 63 72 65 lnktarget)) (cre
11f70 61 74 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e ate-symbolic-lin
11f80 6b 20 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 k test-path lnkt
11f90 61 72 67 65 74 29 29 29 29 29 0a 0a 20 20 20 20 arget)))))..
11fa0 28 69 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 (if (not (direct
11fb0 6f 72 79 3f 20 74 65 73 74 2d 70 61 74 68 29 29 ory? test-path))
11fc0 0a 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ..(create-direct
11fd0 6f 72 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 ory test-path #t
11fe0 29 29 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 )) ;; this is a
11ff0 68 61 63 6b 2c 20 49 20 64 6f 6e 27 74 20 6b 6e hack, I don't kn
12000 6f 77 20 77 68 79 20 6f 75 74 20 6f 66 20 74 68 ow why out of th
12010 65 20 62 6c 75 65 20 74 68 69 73 20 70 61 74 68 e blue this path
12020 20 64 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 20 does not exist
12030 73 6f 6d 65 74 69 6d 65 73 0a 0a 20 20 20 20 28 sometimes.. (
12040 69 66 20 28 61 6e 64 20 74 65 73 74 2d 73 72 63 if (and test-src
12050 2d 70 61 74 68 20 28 64 69 72 65 63 74 6f 72 79 -path (directory
12060 3f 20 74 65 73 74 2d 70 61 74 68 29 29 0a 09 28 ? test-path))..(
12070 62 65 67 69 6e 0a 09 20 20 28 6c 61 75 6e 63 68 begin.. (launch
12080 3a 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 2d :test-copy test-
12090 73 72 63 2d 70 61 74 68 20 74 65 73 74 2d 70 61 src-path test-pa
120a0 74 68 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e 6b th).. (list lnk
120b0 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 29 pathf lnkpath ))
120c0 0a 09 28 69 66 20 28 61 6e 64 20 74 65 73 74 2d ..(if (and test-
120d0 73 72 63 2d 70 61 74 68 20 28 3e 20 72 65 6d 74 src-path (> remt
120e0 72 69 65 73 20 30 29 29 0a 09 20 20 20 20 28 62 ries 0)).. (b
120f0 65 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 egin.. (deb
12100 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
12110 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
12120 72 74 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 rt* "Failed to c
12130 72 65 61 74 65 20 77 6f 72 6b 20 61 72 65 61 20 reate work area
12140 61 74 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 at " test-path "
12150 20 77 69 74 68 20 6c 69 6e 6b 20 61 74 20 22 20 with link at "
12160 6c 6e 6b 74 61 72 67 65 74 20 22 2c 20 72 65 6d lnktarget ", rem
12170 61 69 6e 69 6e 67 20 61 74 74 65 6d 70 74 73 20 aining attempts
12180 22 20 72 65 6d 74 72 69 65 73 29 0a 09 20 20 20 " remtries)..
12190 20 20 20 3b 3b 20 0a 09 20 20 20 20 20 20 28 63 ;; .. (c
121a0 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 reate-work-area
121b0 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 run-id run-info
121c0 6b 65 79 76 61 6c 73 20 74 65 73 74 2d 69 64 20 keyvals test-id
121d0 74 65 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 test-src-path di
121e0 73 6b 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 sk-path testname
121f0 20 69 74 65 6d 64 61 74 20 72 65 6d 74 72 69 65 itemdat remtrie
12200 73 3a 20 28 2d 20 72 65 6d 74 72 69 65 73 20 31 s: (- remtries 1
12210 29 29 29 0a 09 20 20 20 20 28 6c 69 73 74 20 23 ))).. (list #
12220 66 20 23 66 29 29 29 29 29 0a 0a 0a 28 64 65 66 f #f)))))...(def
12230 69 6e 65 20 28 6c 61 75 6e 63 68 3a 68 61 6e 64 ine (launch:hand
12240 6c 65 2d 7a 6f 6d 62 69 65 2d 74 65 73 74 73 20 le-zombie-tests
12250 72 75 6e 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 run-id). (let*
12260 28 28 6b 65 79 20 28 63 6f 6e 63 20 22 7a 6f 6d ((key (conc "zom
12270 62 69 65 73 63 61 6e 2d 72 75 6e 69 64 2d 22 72 biescan-runid-"r
12280 75 6e 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 un-id)).
12290 20 28 6e 6f 77 20 28 63 75 72 72 65 6e 74 2d 73 (now (current-s
122a0 65 63 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 econds)).
122b0 20 20 28 74 68 72 65 73 68 6f 6c 64 20 28 2d 20 (threshold (-
122c0 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
122d0 29 20 20 28 2a 20 32 20 28 6f 72 20 28 63 6f 6e ) (* 2 (or (con
122e0 66 69 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 figf:lookup-numb
122f0 65 72 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 er *configdat* "
12300 73 65 74 75 70 22 20 22 64 65 61 64 74 69 6d 65 setup" "deadtime
12310 22 29 20 31 32 30 29 29 29 29 0a 20 20 20 20 20 ") 120)))).
12320 20 20 20 20 28 76 61 6c 20 28 72 6d 74 3a 67 65 (val (rmt:ge
12330 74 2d 76 61 72 20 6b 65 79 29 29 0a 20 20 20 20 t-var key)).
12340 20 20 20 20 20 28 64 6f 2d 73 63 61 6e 3f 0a 20 (do-scan?.
12350 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
12360 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ((not
12370 76 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 val).
12380 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 #t).
12390 28 28 3c 20 76 61 6c 20 74 68 72 65 73 68 6f 6c ((< val threshol
123a0 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 d). #
123b0 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 t). (e
123c0 6c 73 65 20 23 66 29 29 29 29 0a 20 20 20 20 28 lse #f)))). (
123d0 77 68 65 6e 20 64 6f 2d 73 63 61 6e 3f 0a 20 20 when do-scan?.
123e0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
123f0 20 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 1 *default-log-
12400 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 73 65 61 port* "INFO: sea
12410 72 63 68 20 61 6e 64 20 6d 61 72 6b 20 7a 6f 6d rch and mark zom
12420 62 69 65 20 74 65 73 74 73 22 29 0a 20 20 20 20 bie tests").
12430 20 20 28 72 6d 74 3a 73 65 74 2d 76 61 72 20 6b (rmt:set-var k
12440 65 79 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f ey (current-seco
12450 6e 64 73 29 29 0a 20 20 20 20 20 20 28 72 6d 74 nds)). (rmt
12460 3a 66 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 :find-and-mark-i
12470 6e 63 6f 6d 70 6c 65 74 65 20 72 75 6e 2d 69 64 ncomplete run-id
12480 20 23 66 29 29 29 29 0a 0a 0a 0a 0a 0a 3b 3b 20 #f))))......;;
12490 31 2e 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 1. look though d
124a0 69 73 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 69 isks list for di
124b0 73 6b 20 77 69 74 68 20 6d 6f 73 74 20 73 70 61 sk with most spa
124c0 63 65 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 ce.;; 2. create
124d0 72 75 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c run dir on disk,
124e0 20 70 61 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 path name is me
124f0 61 6e 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 aningful.;; 3. c
12500 72 65 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 reate link from
12510 72 75 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 74 run dir to megat
12520 65 73 74 20 72 75 6e 73 20 61 72 65 61 20 0a 3b est runs area .;
12530 3b 20 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 ; 4. remotely ru
12540 6e 20 74 68 65 20 74 65 73 74 20 6f 6e 20 61 6c n the test on al
12550 6c 6f 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 located host.;;
12560 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 - could be ss
12570 68 20 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 h to host from h
12580 6f 73 74 73 20 74 61 62 6c 65 20 28 75 70 64 61 osts table (upda
12590 74 65 20 72 65 67 75 6c 61 72 6c 79 20 77 69 74 te regularly wit
125a0 68 20 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 h load).;; -
125b0 63 6f 75 6c 64 20 62 65 20 6e 65 74 62 61 74 63 could be netbatc
125c0 68 0a 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 h.;; (launc
125d0 68 2d 74 65 73 74 20 64 62 20 28 63 61 64 72 20 h-test db (cadr
125e0 73 74 61 74 75 73 29 20 74 65 73 74 2d 63 6f 6e status) test-con
125f0 66 29 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 f)).(define (lau
12600 6e 63 68 2d 74 65 73 74 20 74 65 73 74 2d 69 64 nch-test test-id
12610 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f run-id run-info
12620 20 6b 65 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 keyvals runname
12630 20 74 65 73 74 2d 63 6f 6e 66 20 74 65 73 74 2d test-conf test-
12640 6e 61 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 name test-path i
12650 74 65 6d 64 61 74 20 70 61 72 61 6d 73 29 0a 20 temdat params).
12660 20 28 61 73 73 65 72 74 20 72 75 6e 6e 61 6d 65 (assert runname
12670 20 22 46 41 54 41 4c 3a 20 6c 61 75 6e 63 68 2d "FATAL: launch-
12680 74 65 73 74 20 63 61 6c 6c 65 64 20 77 69 74 68 test called with
12690 20 6e 6f 20 72 75 6e 6e 61 6d 65 22 29 0a 20 20 no runname").
126a0 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 6c 61 (mutex-lock! *la
126b0 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 74 65 78 unch-setup-mutex
126c0 2a 29 20 3b 3b 20 73 65 74 74 69 6e 67 20 76 61 *) ;; setting va
126d0 72 69 61 62 6c 65 73 20 61 6e 64 20 70 72 6f 63 riables and proc
126e0 65 73 73 69 6e 67 20 74 68 65 20 74 65 73 74 63 essing the testc
126f0 6f 6e 66 69 67 20 69 73 20 4e 4f 54 20 74 68 72 onfig is NOT thr
12700 65 61 64 2d 73 61 66 65 2c 20 72 65 75 73 65 20 ead-safe, reuse
12710 74 68 65 20 6c 61 75 6e 63 68 2d 73 65 74 75 70 the launch-setup
12720 20 6d 75 74 65 78 0a 20 20 28 6c 65 74 2a 20 28 mutex. (let* (
12730 20 3b 3b 20 28 6c 6f 63 6b 2d 6b 65 79 20 20 20 ;; (lock-key
12740 20 20 20 20 20 28 63 6f 6e 63 20 22 74 65 73 74 (conc "test
12750 2d 22 20 74 65 73 74 2d 69 64 29 29 0a 09 3b 3b -" test-id))..;;
12760 20 28 67 6f 74 2d 6c 6f 63 6b 20 20 20 20 20 20 (got-lock
12770 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 6f (let loop ((lo
12780 63 6b 20 20 20 20 20 20 20 20 28 72 6d 74 3a 6e ck (rmt:n
12790 6f 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 o-sync-get-lock
127a0 6c 6f 63 6b 2d 6b 65 79 29 29 0a 09 3b 3b 20 09 lock-key))..;; .
127b0 09 09 20 20 20 20 20 28 65 78 70 69 72 65 2d 74 .. (expire-t
127c0 69 6d 65 20 28 2b 20 28 63 75 72 72 65 6e 74 2d ime (+ (current-
127d0 73 65 63 6f 6e 64 73 29 20 31 35 29 29 29 20 3b seconds) 15))) ;
127e0 3b 20 67 69 76 65 20 75 70 20 6f 6e 20 67 65 74 ; give up on get
127f0 74 69 6e 67 20 74 68 65 20 6c 6f 63 6b 20 61 6e ting the lock an
12800 64 20 73 74 65 61 6c 20 69 74 20 61 66 74 65 72 d steal it after
12810 20 31 35 20 73 65 63 6f 6e 64 73 0a 09 3b 3b 20 15 seconds..;;
12820 09 09 20 20 20 20 28 69 66 20 28 63 61 72 20 6c .. (if (car l
12830 6f 63 6b 29 0a 09 3b 3b 20 09 09 09 23 74 0a 09 ock)..;; ...#t..
12840 3b 3b 20 09 09 09 28 69 66 20 28 3e 20 28 63 75 ;; ...(if (> (cu
12850 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 65 rrent-seconds) e
12860 78 70 69 72 65 2d 74 69 6d 65 29 0a 09 3b 3b 20 xpire-time)..;;
12870 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 3b ... (begin..;
12880 3b 20 09 09 09 20 20 20 20 20 20 28 64 65 62 75 ; ... (debu
12890 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
128a0 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
128b0 2a 20 22 54 69 6d 65 64 20 6f 75 74 20 77 61 69 * "Timed out wai
128c0 74 69 6e 67 20 66 6f 72 20 61 20 6c 6f 63 6b 20 ting for a lock
128d0 74 6f 20 6c 61 75 6e 63 68 20 74 65 73 74 20 22 to launch test "
128e0 20 6b 65 79 76 61 6c 73 20 22 20 22 20 72 75 6e keyvals " " run
128f0 6e 61 6d 65 20 22 20 22 20 74 65 73 74 2d 6e 61 name " " test-na
12900 6d 65 20 22 20 22 20 74 65 73 74 2d 70 61 74 68 me " " test-path
12910 29 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 20 28 )..;; ... (
12920 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 rmt:no-sync-del!
12930 20 6c 6f 63 6b 2d 6b 65 79 29 20 3b 3b 20 64 65 lock-key) ;; de
12940 73 74 72 6f 79 20 74 68 65 20 6c 6f 63 6b 0a 09 stroy the lock..
12950 3b 3b 20 09 09 09 20 20 20 20 20 20 28 6c 6f 6f ;; ... (loo
12960 70 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 p (rmt:no-sync-g
12970 65 74 2d 6c 6f 63 6b 20 6c 6f 63 6b 2d 6b 65 79 et-lock lock-key
12980 29 20 65 78 70 69 72 65 2d 74 69 6d 65 29 29 20 ) expire-time))
12990 3b 3b 20 0a 09 3b 3b 20 09 09 09 20 20 20 20 28 ;; ..;; ... (
129a0 62 65 67 69 6e 0a 09 3b 3b 20 09 09 09 20 20 20 begin..;; ...
129b0 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
129c0 21 20 31 29 0a 09 3b 3b 20 09 09 09 20 20 20 20 ! 1)..;; ...
129d0 20 20 28 6c 6f 6f 70 20 28 72 6d 74 3a 6e 6f 2d (loop (rmt:no-
129e0 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c 6f sync-get-lock lo
129f0 63 6b 2d 6b 65 79 29 20 65 78 70 69 72 65 2d 74 ck-key) expire-t
12a00 69 6d 65 29 29 29 29 29 29 0a 09 20 28 69 74 65 ime)))))).. (ite
12a10 6d 2d 70 61 74 68 20 20 20 20 20 20 20 28 69 74 m-path (it
12a20 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 em-list->path it
12a30 65 6d 64 61 74 29 29 0a 09 20 28 63 6f 6e 74 6f emdat)).. (conto
12a40 75 72 20 20 20 20 20 20 20 20 20 23 66 29 29 20 ur #f))
12a50 3b 3b 20 4e 4f 54 20 52 45 41 44 59 20 46 4f 52 ;; NOT READY FOR
12a60 20 54 48 49 53 20 28 61 72 67 73 3a 67 65 74 2d THIS (args:get-
12a70 61 72 67 20 22 2d 63 6f 6e 74 6f 75 72 22 29 29 arg "-contour"))
12a80 29 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 ). (let loop
12a90 28 28 64 65 6c 74 61 20 20 20 20 20 20 20 20 28 ((delta (
12aa0 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e - (current-secon
12ab0 64 73 29 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 ds) *last-launch
12ac0 2a 29 29 0a 09 20 20 20 20 20 20 20 28 6c 61 75 *)).. (lau
12ad0 6e 63 68 2d 64 65 6c 61 79 20 28 63 6f 6e 66 69 nch-delay (confi
12ae0 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 gf:lookup-number
12af0 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
12b00 74 75 70 22 20 22 6c 61 75 6e 63 68 2d 64 65 6c tup" "launch-del
12b10 61 79 22 20 64 65 66 61 75 6c 74 3a 20 30 29 29 ay" default: 0))
12b20 29 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 6c ). (if (> l
12b30 61 75 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 aunch-delay delt
12b40 61 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 a).. (begin..
12b50 20 20 3b 3b 20 28 69 66 20 28 63 6f 6d 6d 6f 6e ;; (if (common
12b60 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 :low-noise-print
12b70 20 31 32 30 30 20 22 74 65 73 74 20 6c 61 75 6e 1200 "test laun
12b80 63 68 20 64 65 6c 61 79 22 29 20 3b 3b 20 65 76 ch delay") ;; ev
12b90 65 72 79 20 74 77 6f 20 68 6f 75 72 73 20 6f 72 ery two hours or
12ba0 20 73 6f 20 72 65 6d 69 6e 64 20 74 68 65 20 75 so remind the u
12bb0 73 65 72 20 61 62 6f 75 74 20 6c 61 75 6e 63 68 ser about launch
12bc0 20 64 65 6c 61 79 2e 0a 09 3b 3b 09 28 64 65 62 delay...;;.(deb
12bd0 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
12be0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
12bf0 74 2a 20 22 4e 4f 54 45 3a 20 74 65 73 74 20 6c t* "NOTE: test l
12c00 61 75 6e 63 68 65 73 20 61 72 65 20 64 65 6c 61 aunches are dela
12c10 79 65 64 20 62 79 20 22 20 6c 61 75 6e 63 68 2d yed by " launch-
12c20 64 65 6c 61 79 20 22 20 73 65 63 6f 6e 64 73 2e delay " seconds.
12c30 20 53 65 65 20 6d 65 67 61 74 65 73 74 2e 63 6f See megatest.co
12c40 6e 66 69 67 20 6c 61 75 6e 63 68 2d 64 65 6c 61 nfig launch-dela
12c50 79 20 73 65 74 74 69 6e 67 20 74 6f 20 61 64 6a y setting to adj
12c60 75 73 74 2e 22 29 29 20 3b 3b 20 6c 61 75 6e 63 ust.")) ;; launc
12c70 68 20 6f 66 20 22 20 74 65 73 74 2d 6e 61 6d 65 h of " test-name
12c80 20 22 20 66 6f 72 20 22 20 28 2d 20 6c 61 75 6e " for " (- laun
12c90 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 29 20 ch-delay delta)
12ca0 22 20 73 65 63 6f 6e 64 73 22 29 29 0a 09 20 20 " seconds"))..
12cb0 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
12cc0 20 28 2d 20 6c 61 75 6e 63 68 2d 64 65 6c 61 79 (- launch-delay
12cd0 20 64 65 6c 74 61 29 29 0a 09 20 20 20 20 28 6c delta)).. (l
12ce0 6f 6f 70 20 28 2d 20 28 63 75 72 72 65 6e 74 2d oop (- (current-
12cf0 73 65 63 6f 6e 64 73 29 20 2a 6c 61 73 74 2d 6c seconds) *last-l
12d00 61 75 6e 63 68 2a 29 20 6c 61 75 6e 63 68 2d 64 aunch*) launch-d
12d10 65 6c 61 79 29 29 29 29 0a 20 20 20 20 28 63 68 elay)))). (ch
12d20 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a ange-directory *
12d30 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 28 61 toppath*). (a
12d40 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 3b list->env-vars ;
12d50 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 74 68 ; consolidate th
12d60 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 68 65 is code with the
12d70 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 65 73 code in megates
12d80 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 65 63 t.scm for "-exec
12d90 75 74 65 22 2c 20 2a 6d 61 79 62 65 2a 20 2d 20 ute", *maybe* -
12da0 74 68 65 20 6c 6f 6e 67 65 72 20 74 68 65 79 20 the longer they
12db0 61 72 65 20 73 65 74 20 74 68 65 20 6c 6f 6e 67 are set the long
12dc0 65 72 20 65 61 63 68 20 6c 61 75 6e 63 68 20 74 er each launch t
12dd0 61 6b 65 73 20 28 6d 75 73 74 20 62 65 20 6e 6f akes (must be no
12de0 6e 2d 6f 76 65 72 6c 61 70 70 69 6e 67 20 77 69 n-overlapping wi
12df0 74 68 20 74 68 65 20 76 61 72 73 29 0a 20 20 20 th the vars).
12e00 20 20 28 61 70 70 65 6e 64 0a 20 20 20 20 20 20 (append.
12e10 28 6c 69 73 74 0a 20 20 20 20 20 20 20 28 6c 69 (list. (li
12e20 73 74 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f st "MT_RUN_AREA_
12e30 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 HOME" *toppath*)
12e40 0a 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 4d . (list "M
12e50 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes
12e60 74 2d 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 28 t-name). (
12e70 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 list "MT_RUNNAME
12e80 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 " runname).
12e90 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 (list "MT_IT
12ea0 45 4d 50 41 54 48 22 20 20 69 74 65 6d 2d 70 61 EMPATH" item-pa
12eb0 74 68 29 0a 20 20 20 20 20 20 20 28 6c 69 73 74 th). (list
12ec0 20 22 4d 54 5f 43 4f 4e 54 4f 55 52 22 20 20 20 "MT_CONTOUR"
12ed0 63 6f 6e 74 6f 75 72 29 0a 20 20 20 20 20 20 20 contour).
12ee0 29 0a 20 20 20 20 20 20 69 74 65 6d 64 61 74 29 ). itemdat)
12ef0 29 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 74 72 ). (let* ((tr
12f00 65 67 69 73 74 72 79 20 20 20 20 20 20 20 28 74 egistry (t
12f10 65 73 74 73 3a 67 65 74 2d 61 6c 6c 29 29 20 3b ests:get-all)) ;
12f20 3b 20 74 68 69 72 64 20 70 61 72 61 6d 20 28 62 ; third param (b
12f30 65 6c 6f 77 29 20 69 73 20 73 79 73 74 65 6d 2d elow) is system-
12f40 61 6c 6c 6f 77 65 64 0a 20 20 20 20 20 20 20 20 allowed.
12f50 20 20 20 3b 3b 20 66 6f 72 20 74 63 6f 6e 66 69 ;; for tconfi
12f60 67 2c 20 77 68 79 20 64 6f 20 77 65 20 61 6c 6c g, why do we all
12f70 6f 77 20 66 61 6c 6c 62 61 63 6b 20 74 6f 20 74 ow fallback to t
12f80 65 73 74 2d 63 6f 6e 66 3f 0a 09 20 20 20 28 74 est-conf?.. (t
12f90 63 6f 6e 66 69 67 20 20 20 20 20 20 20 20 20 28 config (
12fa0 6f 72 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 or (tests:get-te
12fb0 73 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 stconfig test-na
12fc0 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 74 72 65 me item-path tre
12fd0 67 69 73 74 72 79 20 23 74 20 66 6f 72 63 65 2d gistry #t force-
12fe0 63 72 65 61 74 65 3a 20 23 74 29 0a 09 09 09 09 create: #t).....
12ff0 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
13000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13010 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
13020 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
13030 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
13040 49 4e 47 3a 20 66 61 6c 6c 69 6e 67 20 62 61 63 ING: falling bac
13050 6b 20 74 6f 20 70 72 65 2d 63 61 6c 63 75 6c 61 k to pre-calcula
13060 74 65 64 20 74 65 73 74 63 6f 6e 66 69 67 2e 20 ted testconfig.
13070 54 68 69 73 20 69 73 20 6c 69 6b 65 6c 79 20 6e This is likely n
13080 6f 74 20 64 65 73 69 72 65 64 2e 22 29 0a 20 20 ot desired.").
13090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
130a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
130b0 74 65 73 74 2d 63 6f 6e 66 29 29 29 20 3b 3b 20 test-conf))) ;;
130c0 66 6f 72 63 65 20 72 65 2d 72 65 61 64 20 6e 6f force re-read no
130d0 77 20 74 68 61 74 20 61 6c 6c 20 76 61 72 73 20 w that all vars
130e0 61 72 65 20 73 65 74 0a 09 20 20 20 28 75 73 65 are set.. (use
130f0 73 68 65 6c 6c 20 20 20 20 20 20 20 20 28 6c 65 shell (le
13100 74 20 28 28 75 73 68 20 28 63 6f 6e 66 69 67 66 t ((ush (configf
13110 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
13120 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 at* "jobtools"
13130 20 20 20 22 75 73 65 73 68 65 6c 6c 22 29 29 29 "useshell")))
13140 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 75 73 .... (if us
13150 68 20 0a 09 09 09 09 20 20 28 69 66 20 28 65 71 h ..... (if (eq
13160 75 61 6c 3f 20 75 73 68 20 22 6e 6f 22 29 20 3b ual? ush "no") ;
13170 3b 20 6d 75 73 74 20 75 73 65 20 22 6e 6f 22 20 ; must use "no"
13180 74 6f 20 4e 4f 54 20 75 73 65 20 73 68 65 6c 6c to NOT use shell
13190 0a 09 09 09 09 20 20 20 20 20 20 23 66 0a 09 09 ..... #f...
131a0 09 09 20 20 20 20 20 20 75 73 68 29 0a 09 09 09 .. ush)....
131b0 09 20 20 23 74 29 29 29 20 20 20 20 20 3b 3b 20 . #t))) ;;
131c0 64 65 66 61 75 6c 74 20 69 73 20 79 65 73 0a 09 default is yes..
131d0 20 20 20 28 72 75 6e 73 63 72 69 70 74 20 20 20 (runscript
131e0 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (configf:loo
131f0 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 20 22 73 kup tconfig "s
13200 65 74 75 70 22 20 20 20 20 20 20 20 20 22 72 75 etup" "ru
13210 6e 73 63 72 69 70 74 22 29 29 0a 09 20 20 20 28 nscript")).. (
13220 65 7a 73 74 65 70 73 20 20 20 20 20 20 20 20 20 ezsteps
13230 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 (> (length (hash
13240 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
13250 6c 74 20 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 lt tconfig "ezst
13260 65 70 73 22 20 27 28 29 29 29 20 30 29 29 20 3b eps" '())) 0)) ;
13270 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 6c 6c ; don't send all
13280 20 74 68 65 20 73 74 65 70 73 2c 20 63 6f 75 6c the steps, coul
13290 64 20 62 65 20 62 69 67 2c 20 6a 75 73 74 20 73 d be big, just s
132a0 65 6e 64 20 61 20 66 6c 61 67 0a 09 20 20 20 28 end a flag.. (
132b0 73 75 62 72 75 6e 20 20 20 20 20 20 20 20 20 20 subrun
132c0 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 (> (length (hash
132d0 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
132e0 6c 74 20 74 63 6f 6e 66 69 67 20 22 73 75 62 72 lt tconfig "subr
132f0 75 6e 22 20 20 27 28 29 29 29 20 30 29 29 20 3b un" '())) 0)) ;
13300 3b 20 73 65 6e 64 20 61 20 66 6c 61 67 20 74 6f ; send a flag to
13310 20 70 72 6f 63 65 73 73 20 61 20 73 75 62 72 75 process a subru
13320 6e 0a 09 20 20 20 3b 3b 20 28 64 69 73 6b 73 70 n.. ;; (disksp
13330 61 63 65 20 20 20 20 20 20 20 28 63 6f 6e 66 69 ace (confi
13340 67 66 3a 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 gf:lookup tconfi
13350 67 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 g "requirement
13360 73 22 20 22 64 69 73 6b 73 70 61 63 65 22 29 29 s" "diskspace"))
13370 0a 09 20 20 20 3b 3b 20 28 6d 65 6d 6f 72 79 20 .. ;; (memory
13380 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
13390 66 3a 6c 6f 6f 6b 75 70 20 74 63 6f 6e 66 69 67 f:lookup tconfig
133a0 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
133b0 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 20 20 " "memory"))..
133c0 20 3b 3b 20 28 68 6f 73 74 73 20 20 20 20 20 20 ;; (hosts
133d0 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (configf:lo
133e0 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a okup *configdat*
133f0 20 22 6a 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 "jobtools"
13400 22 77 6f 72 6b 68 6f 73 74 73 22 29 29 20 3b 3b "workhosts")) ;;
13410 20 49 27 6d 20 70 72 65 74 74 79 20 73 75 72 65 I'm pretty sure
13420 20 74 68 69 73 20 77 61 73 20 6e 65 76 65 72 20 this was never
13430 63 6f 6d 70 6c 65 74 65 64 0a 09 20 20 20 28 72 completed.. (r
13440 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 28 emote-megatest (
13450 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
13460 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
13470 70 22 20 22 65 78 65 63 75 74 61 62 6c 65 22 29 p" "executable")
13480 29 0a 09 20 20 20 28 72 75 6e 2d 74 69 6d 65 2d ).. (run-time-
13490 6c 69 6d 69 74 20 20 28 6f 72 20 28 63 6f 6e 66 limit (or (conf
134a0 69 67 66 3a 6c 6f 6f 6b 75 70 20 20 74 63 6f 6e igf:lookup tcon
134b0 66 69 67 20 20 20 22 72 65 71 75 69 72 65 6d 65 fig "requireme
134c0 6e 74 73 22 20 22 72 75 6e 74 69 6d 65 6c 69 6d nts" "runtimelim
134d0 22 29 0a 09 09 09 09 28 63 6f 6e 66 69 67 66 3a ").....(configf:
134e0 6c 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 67 64 lookup *configd
134f0 61 74 2a 20 22 73 65 74 75 70 22 20 22 72 75 6e at* "setup" "run
13500 74 69 6d 65 6c 69 6d 22 29 29 29 0a 09 20 20 20 timelim")))..
13510 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 ;; FIXME SOMEDAY
13520 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 20 74 : not good how t
13530 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 73 65 his is so obtuse
13540 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 20 74 , this hack is t
13550 6f 20 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 o .. ;;
13560 20 20 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 allow r
13570 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 unning from dash
13580 62 6f 61 72 64 2e 20 45 78 74 72 61 63 74 20 74 board. Extract t
13590 68 65 20 70 61 74 68 0a 09 20 20 20 3b 3b 20 20 he path.. ;;
135a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 72 fr
135b0 6f 6d 20 74 68 65 20 63 61 6c 6c 65 64 20 6d 65 om the called me
135c0 67 61 74 65 73 74 20 61 6e 64 20 63 6f 6e 76 65 gatest and conve
135d0 72 74 20 64 61 73 68 62 6f 61 72 64 0a 09 20 20 rt dashboard..
135e0 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
135f0 09 20 20 6f 72 20 64 62 6f 61 72 64 20 74 6f 20 . or dboard to
13600 6d 65 67 61 74 65 73 74 0a 09 20 20 20 28 6c 6f megatest.. (lo
13610 63 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 28 63 cal-megatest (c
13620 6f 6d 6d 6f 6e 3a 66 69 6e 64 2d 6c 6f 63 61 6c ommon:find-local
13630 2d 6d 65 67 61 74 65 73 74 29 29 0a 09 20 20 20 -megatest))..
13640 23 3b 28 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 #;(local-megates
13650 74 20 20 28 6c 65 74 2a 20 28 28 6c 6d 20 20 28 t (let* ((lm (
13660 63 61 72 20 28 61 72 67 76 29 29 29 0a 09 09 09 car (argv)))....
13670 09 20 20 20 28 64 69 72 20 28 70 61 74 68 6e 61 . (dir (pathna
13680 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 me-directory lm)
13690 29 0a 09 09 09 09 20 20 20 28 65 78 65 20 28 70 )..... (exe (p
136a0 61 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 athname-strip-di
136b0 72 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 rectory lm)))...
136c0 09 20 20 20 20 20 20 28 63 6f 6e 63 20 28 69 66 . (conc (if
136d0 20 64 69 72 20 28 63 6f 6e 63 20 64 69 72 20 22 dir (conc dir "
136e0 2f 22 29 20 22 22 29 0a 09 09 09 09 20 20 20 20 /") "").....
136f0 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
13700 79 6d 62 6f 6c 20 65 78 65 29 0a 09 09 09 09 20 ymbol exe).....
13710 20 20 20 20 20 28 28 64 62 6f 61 72 64 29 20 20 ((dboard)
13720 20 20 22 2e 2e 2f 6d 65 67 61 74 65 73 74 22 29 "../megatest")
13730 0a 09 09 09 09 20 20 20 20 20 20 28 28 6d 74 65 ..... ((mte
13740 73 74 29 20 20 20 20 20 22 2e 2e 2f 6d 65 67 61 st) "../mega
13750 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 20 test").....
13760 20 28 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d ((dashboard) "m
13770 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 egatest").....
13780 20 20 20 20 28 65 6c 73 65 20 65 78 65 29 29 29 (else exe)))
13790 29 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 65 72 )).. (launcher
137a0 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a (common:
137b0 67 65 74 2d 6c 61 75 6e 63 68 65 72 20 2a 63 6f get-launcher *co
137c0 6e 66 69 67 64 61 74 2a 20 74 65 73 74 2d 6e 61 nfigdat* test-na
137d0 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 20 3b me item-path)) ;
137e0 3b 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 ; (configf:looku
137f0 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
13800 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 6c 61 obtools" "la
13810 75 6e 63 68 65 72 22 29 29 0a 09 20 20 20 28 74 uncher")).. (t
13820 65 73 74 2d 73 69 67 20 20 20 20 20 20 20 20 28 est-sig (
13830 63 6f 6e 63 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 conc (common:get
13840 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 -testsuite-name)
13850 20 22 3a 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 ":" test-name "
13860 3a 22 20 69 74 65 6d 2d 70 61 74 68 29 29 20 3b :" item-path)) ;
13870 3b 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 ; (item-list->pa
13880 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b th itemdat))) ;;
13890 20 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 test-path is th
138a0 65 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c e full path incl
138b0 75 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 uding the item-p
138c0 61 74 68 0a 09 20 20 20 28 77 6f 72 6b 2d 61 72 ath.. (work-ar
138d0 65 61 20 20 20 20 20 20 20 23 66 29 0a 09 20 20 ea #f)..
138e0 20 28 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 (toptest-work-a
138f0 72 65 61 20 23 66 29 20 3b 3b 20 66 6f 72 20 69 rea #f) ;; for i
13900 74 65 72 61 74 65 64 20 74 65 73 74 73 20 74 68 terated tests th
13910 65 20 74 6f 70 20 74 65 73 74 20 63 6f 6e 74 61 e top test conta
13920 69 6e 73 20 64 61 74 61 20 72 65 6c 65 76 61 6e ins data relevan
13930 74 20 66 6f 72 20 61 6c 6c 0a 09 20 20 20 28 64 t for all.. (d
13940 69 73 6b 70 61 74 68 20 20 20 23 66 29 0a 09 20 iskpath #f)..
13950 20 20 28 63 6d 64 70 61 72 6d 73 20 20 20 23 66 (cmdparms #f
13960 29 0a 09 20 20 20 28 66 75 6c 6c 63 6d 64 20 20 ).. (fullcmd
13970 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e 65 #f) ;; (define
13980 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d a (with-output-
13990 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 to-string (lambd
139a0 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 29 a ()(write x))))
139b0 0a 09 20 20 20 28 6d 74 2d 62 69 6e 64 69 72 2d .. (mt-bindir-
139c0 70 61 74 68 20 23 66 29 0a 09 20 20 20 28 74 65 path #f).. (te
139d0 73 74 69 6e 66 6f 20 20 20 28 72 6d 74 3a 67 65 stinfo (rmt:ge
139e0 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
139f0 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
13a00 29 29 0a 09 20 20 20 28 6d 74 5f 74 61 72 67 65 )).. (mt_targe
13a10 74 20 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 t (string-inter
13a20 73 70 65 72 73 65 20 28 6d 61 70 20 63 61 64 72 sperse (map cadr
13a30 20 6b 65 79 76 61 6c 73 29 20 22 2f 22 29 29 0a keyvals) "/")).
13a40 09 20 20 20 28 64 65 62 75 67 2d 70 61 72 61 6d . (debug-param
13a50 20 28 61 70 70 65 6e 64 20 28 69 66 20 28 61 72 (append (if (ar
13a60 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 gs:get-arg "-deb
13a70 75 67 22 29 20 20 28 6c 69 73 74 20 22 2d 64 65 ug") (list "-de
13a80 62 75 67 22 20 28 61 72 67 73 3a 67 65 74 2d 61 bug" (args:get-a
13a90 72 67 20 22 2d 64 65 62 75 67 22 29 29 20 27 28 rg "-debug")) '(
13aa0 29 29 0a 09 09 09 09 28 69 66 20 28 61 72 67 73 )).....(if (args
13ab0 3a 67 65 74 2d 61 72 67 20 22 2d 6c 6f 67 67 69 :get-arg "-loggi
13ac0 6e 67 22 29 28 6c 69 73 74 20 22 2d 6c 6f 67 67 ng")(list "-logg
13ad0 69 6e 67 22 29 20 27 28 29 29 0a 09 09 09 09 28 ing") '()).....(
13ae0 69 66 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b if (configf:look
13af0 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 up *configdat* "
13b00 6d 69 73 63 22 20 22 70 72 6f 66 69 6c 65 73 77 misc" "profilesw
13b10 22 29 0a 09 09 09 09 20 20 20 20 28 6c 69 73 74 ")..... (list
13b20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 (configf:lookup
13b30 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6d 69 *configdat* "mi
13b40 73 63 22 20 22 70 72 6f 66 69 6c 65 73 77 22 29 sc" "profilesw")
13b50 29 0a 09 09 09 09 20 20 20 20 27 28 29 29 29 29 )..... '())))
13b60 29 0a 20 20 20 20 20 20 3b 3b 20 28 69 66 20 68 ). ;; (if h
13b70 6f 73 74 73 20 28 73 65 74 21 20 68 6f 73 74 73 osts (set! hosts
13b80 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 68 (string-split h
13b90 6f 73 74 73 29 29 29 0a 20 20 20 20 20 20 3b 3b osts))). ;;
13ba0 20 73 65 74 20 74 68 65 20 6d 65 67 61 74 65 73 set the megates
13bb0 74 20 74 6f 20 62 65 20 63 61 6c 6c 65 64 20 6f t to be called o
13bc0 6e 20 74 68 65 20 72 65 6d 6f 74 65 20 68 6f 73 n the remote hos
13bd0 74 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 t. (if (not
13be0 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
13bf0 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d 6d 65 )(set! remote-me
13c00 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d 65 67 gatest local-meg
13c10 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 67 61 atest)) ;; "mega
13c20 74 65 73 74 22 29 29 0a 20 20 20 20 20 20 28 73 test")). (s
13c30 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 et! mt-bindir-pa
13c40 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 th (pathname-dir
13c50 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 ectory remote-me
13c60 67 61 74 65 73 74 29 29 0a 20 20 20 20 20 20 28 gatest)). (
13c70 69 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 if launcher (set
13c80 21 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 ! launcher (stri
13c90 6e 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 ng-split launche
13ca0 72 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 73 65 r))). ;; se
13cb0 74 20 75 70 20 74 68 65 20 72 75 6e 20 77 6f 72 t up the run wor
13cc0 6b 20 61 72 65 61 20 66 6f 72 20 74 68 69 73 20 k area for this
13cd0 74 65 73 74 0a 20 20 20 20 20 20 28 69 66 20 28 test. (if (
13ce0 61 6e 64 20 28 61 72 67 73 3a 67 65 74 2d 61 72 and (args:get-ar
13cf0 67 20 22 2d 70 72 65 63 6c 65 61 6e 22 29 20 3b g "-preclean") ;
13d00 3b 20 75 73 65 72 20 68 61 73 20 72 65 71 75 65 ; user has reque
13d10 73 74 65 64 20 74 6f 20 70 72 65 63 6c 65 61 6e sted to preclean
13d20 20 66 6f 72 20 74 68 69 73 20 72 75 6e 0a 09 20 for this run..
13d30 20 20 20 20 20 20 28 6e 6f 74 20 28 6d 65 6d 62 (not (memb
13d40 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d er (db:test-get-
13d50 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 rundir testinfo)
13d60 28 6c 69 73 74 20 22 6e 2f 61 22 20 22 2f 74 6d (list "n/a" "/tm
13d70 70 2f 62 61 64 6e 61 6d 65 22 29 29 29 29 20 3b p/badname")))) ;
13d80 3b 20 6e 2f 61 20 69 73 20 61 20 70 6c 61 63 65 ; n/a is a place
13d90 68 6f 6c 64 65 72 20 61 6e 64 20 74 68 75 73 20 holder and thus
13da0 6e 6f 74 20 61 20 72 65 61 64 20 64 69 72 0a 09 not a read dir..
13db0 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 64 (begin.. (d
13dc0 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
13dd0 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
13de0 6f 72 74 2a 20 22 61 74 74 65 6d 70 74 69 6e 67 ort* "attempting
13df0 20 74 6f 20 70 72 65 63 6c 65 61 6e 20 64 69 72 to preclean dir
13e00 65 63 74 6f 72 79 20 22 20 28 64 62 3a 74 65 73 ectory " (db:tes
13e10 74 2d 67 65 74 2d 72 75 6e 64 69 72 20 74 65 73 t-get-rundir tes
13e20 74 69 6e 66 6f 29 20 22 20 66 6f 72 20 74 65 73 tinfo) " for tes
13e30 74 20 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 2f t " test-name "/
13e40 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 09 20 20 " item-path)..
13e50 20 20 28 72 75 6e 73 3a 72 65 6d 6f 76 65 2d 74 (runs:remove-t
13e60 65 73 74 2d 64 69 72 65 63 74 6f 72 79 20 74 65 est-directory te
13e70 73 74 69 6e 66 6f 20 27 72 65 6d 6f 76 65 2d 64 stinfo 'remove-d
13e80 61 74 61 2d 6f 6e 6c 79 29 29 29 20 3b 3b 20 72 ata-only))) ;; r
13e90 65 6d 6f 76 65 20 64 61 74 61 20 6f 6e 6c 79 2c emove data only,
13ea0 20 64 6f 20 6e 6f 74 20 70 65 72 74 75 72 62 20 do not perturb
13eb0 74 68 65 20 72 65 63 6f 72 64 0a 20 20 20 20 20 the record.
13ec0 20 0a 20 20 20 20 20 20 3b 3b 20 70 72 65 76 65 . ;; preve
13ed0 6e 74 20 6f 76 65 72 6c 61 70 70 69 6e 67 20 61 nt overlapping a
13ee0 63 74 69 6f 6e 73 20 2d 20 73 65 74 20 74 6f 20 ctions - set to
13ef0 4c 41 55 4e 43 48 45 44 20 61 73 20 65 61 72 6c LAUNCHED as earl
13f00 79 20 61 73 20 70 6f 73 73 69 62 6c 65 0a 20 20 y as possible.
13f10 20 20 20 20 3b 3b 0a 20 20 20 20 20 20 3b 3b 20 ;;. ;;
13f20 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 61 the following ca
13f30 6c 6c 20 68 61 6e 64 6c 65 73 20 77 61 69 76 65 ll handles waive
13f40 72 20 70 72 6f 70 6f 67 61 74 69 6f 6e 2e 20 63 r propogation. c
13f50 61 6e 6e 6f 74 20 79 65 74 20 63 6f 6e 64 65 6e annot yet conden
13f60 73 65 20 69 6e 74 6f 20 72 6f 6c 6c 2d 75 70 2d se into roll-up-
13f70 70 61 73 73 2d 66 61 69 6c 0a 20 20 20 20 20 20 pass-fail.
13f80 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
13f90 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
13fa0 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 48 45 44 est-id "LAUNCHED
13fb0 22 20 22 6e 2f 61 22 20 23 66 20 23 66 29 20 3b " "n/a" #f #f) ;
13fc0 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 65 73 ; (if launch-res
13fd0 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 73 75 ults launch-resu
13fe0 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 0a 20 lts "FAILED")).
13ff0 20 20 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 (rmt:set-st
14000 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
14010 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e oll-up-items run
14020 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
14030 65 6d 2d 70 61 74 68 20 23 66 20 22 4c 41 55 4e em-path #f "LAUN
14040 43 48 45 44 22 20 23 66 29 0a 20 20 20 20 20 20 CHED" #f).
14050 3b 3b 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 ;; (pp (hash-tab
14060 6c 65 2d 3e 61 6c 69 73 74 20 74 63 6f 6e 66 69 le->alist tconfi
14070 67 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 g)). (set!
14080 64 69 73 6b 70 61 74 68 20 28 67 65 74 2d 62 65 diskpath (get-be
14090 73 74 2d 64 69 73 6b 20 2a 63 6f 6e 66 69 67 64 st-disk *configd
140a0 61 74 2a 20 74 63 6f 6e 66 69 67 29 29 0a 20 20 at* tconfig)).
140b0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
140c0 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
140d0 70 6f 72 74 2a 20 22 62 65 73 74 20 64 69 73 6b port* "best disk
140e0 20 70 61 74 68 20 3d 20 22 20 64 69 73 6b 70 61 path = " diskpa
140f0 74 68 29 0a 20 20 20 20 20 20 28 69 66 20 64 69 th). (if di
14100 73 6b 70 61 74 68 0a 09 20 20 28 6c 65 74 20 28 skpath.. (let (
14110 28 64 61 74 20 28 63 72 65 61 74 65 2d 77 6f 72 (dat (create-wor
14120 6b 2d 61 72 65 61 20 72 75 6e 2d 69 64 20 72 75 k-area run-id ru
14130 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 n-info keyvals t
14140 65 73 74 2d 69 64 20 74 65 73 74 2d 70 61 74 68 est-id test-path
14150 20 64 69 73 6b 70 61 74 68 20 74 65 73 74 2d 6e diskpath test-n
14160 61 6d 65 20 69 74 65 6d 64 61 74 29 29 29 0a 09 ame itemdat)))..
14170 20 20 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 (set! work-a
14180 72 65 61 20 28 63 61 72 20 64 61 74 29 29 0a 09 rea (car dat))..
14190 20 20 20 20 28 73 65 74 21 20 74 6f 70 74 65 73 (set! toptes
141a0 74 2d 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 64 t-work-area (cad
141b0 72 20 64 61 74 29 29 0a 09 20 20 20 20 28 64 65 r dat)).. (de
141c0 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
141d0 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
141e0 72 74 2a 20 22 55 73 69 6e 67 20 77 6f 72 6b 20 rt* "Using work
141f0 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 65 61 area " work-area
14200 29 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 )).. (begin..
14210 20 20 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 (set! work-are
14220 61 20 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 a (conc test-pat
14230 68 20 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 h "/tmp_run"))..
14240 20 20 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 (create-dire
14250 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 20 ctory work-area
14260 23 74 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a #t).. (debug:
14270 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
14280 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
14290 49 4e 47 3a 20 4e 6f 20 64 69 73 6b 20 77 6f 72 ING: No disk wor
142a0 6b 20 61 72 65 61 20 73 70 65 63 69 66 69 65 64 k area specified
142b0 20 2d 20 72 75 6e 6e 69 6e 67 20 69 6e 20 74 68 - running in th
142c0 65 20 74 65 73 74 20 64 69 72 65 63 74 6f 72 79 e test directory
142d0 20 75 6e 64 65 72 20 74 6d 70 5f 72 75 6e 22 29 under tmp_run")
142e0 29 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 63 )). (set! c
142f0 6d 64 70 61 72 6d 73 20 28 62 61 73 65 36 34 3a mdparms (base64:
14300 62 61 73 65 36 34 2d 65 6e 63 6f 64 65 20 0a 09 base64-encode ..
14310 09 20 20 20 20 20 20 28 7a 33 3a 65 6e 63 6f 64 . (z3:encod
14320 65 2d 62 75 66 66 65 72 20 0a 09 09 20 20 20 20 e-buffer ...
14330 20 20 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d (with-output-
14340 74 6f 2d 73 74 72 69 6e 67 0a 09 09 09 20 28 6c to-string.... (l
14350 61 6d 62 64 61 20 28 29 20 3b 3b 20 28 6c 69 73 ambda () ;; (lis
14360 74 20 27 68 6f 73 74 73 20 20 20 20 20 68 6f 73 t 'hosts hos
14370 74 73 29 0a 09 09 09 20 20 20 28 77 72 69 74 65 ts).... (write
14380 20 28 6c 69 73 74 20 28 6c 69 73 74 20 27 74 65 (list (list 'te
14390 73 74 70 61 74 68 20 20 74 65 73 74 2d 70 61 74 stpath test-pat
143a0 68 29 0a 09 09 09 09 09 3b 3b 20 28 6c 69 73 74 h)......;; (list
143b0 20 27 74 72 61 6e 73 70 6f 72 74 20 28 63 6f 6e 'transport (con
143c0 63 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 79 70 c *transport-typ
143d0 65 2a 29 29 0a 09 09 09 09 09 3b 3b 20 28 6c 69 e*))......;; (li
143e0 73 74 20 27 73 65 72 76 65 72 69 6e 66 20 2a 73 st 'serverinf *s
143f0 65 72 76 65 72 2d 69 6e 66 6f 2a 29 0a 09 09 09 erver-info*)....
14400 09 09 23 3b 28 6c 69 73 74 20 27 68 6f 6d 65 68 ..#;(list 'homeh
14410 6f 73 74 20 20 28 6c 65 74 2a 20 28 28 68 68 64 ost (let* ((hhd
14420 61 74 20 28 73 65 72 76 65 72 3a 67 65 74 2d 68 at (server:get-h
14430 6f 6d 65 68 6f 73 74 29 29 29 0a 09 09 09 09 09 omehost)))......
14440 09 09 20 20 20 28 69 66 20 68 68 64 61 74 0a 09 .. (if hhdat..
14450 09 09 09 09 09 09 20 20 20 20 20 20 20 28 63 61 ...... (ca
14460 72 20 68 68 64 61 74 29 0a 09 09 09 09 09 09 09 r hhdat)........
14470 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 09 #f)))....
14480 09 09 23 3b 28 6c 69 73 74 20 27 73 65 72 76 65 ..#;(list 'serve
14490 72 75 72 6c 20 28 69 66 20 2a 72 75 6e 72 65 6d rurl (if *runrem
144a0 6f 74 65 2a 20 3b 3b 20 77 6f 75 6c 64 20 6c 69 ote* ;; would li
144b0 6b 65 20 74 6f 20 61 64 64 20 74 68 69 73 20 62 ke to add this b
144c0 61 63 6b 20 2e 2e 2e 20 57 4f 52 4b 20 4e 45 45 ack ... WORK NEE
144d0 44 45 44 0a 09 09 09 09 09 09 09 20 20 20 20 20 DED........
144e0 28 72 65 6d 6f 74 65 2d 73 65 72 76 65 72 2d 75 (remote-server-u
144f0 72 6c 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 29 0a rl *runremote*).
14500 09 09 09 09 09 09 09 20 20 20 20 20 23 66 29 29 ....... #f))
14510 20 3b 3b 0a 09 09 09 09 09 28 6c 69 73 74 20 27 ;;......(list '
14520 61 72 65 61 6e 61 6d 65 20 20 28 63 6f 6d 6d 6f areaname (commo
14530 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d n:get-testsuite-
14540 6e 61 6d 65 29 29 0a 09 09 09 09 09 28 6c 69 73 name))......(lis
14550 74 20 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f t 'toppath *to
14560 70 70 61 74 68 2a 29 0a 09 09 09 09 09 28 6c 69 ppath*)......(li
14570 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 77 6f st 'work-area wo
14580 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 09 28 6c rk-area)......(l
14590 69 73 74 20 27 74 65 73 74 2d 6e 61 6d 65 20 74 ist 'test-name t
145a0 65 73 74 2d 6e 61 6d 65 29 20 0a 09 09 09 09 09 est-name) ......
145b0 28 6c 69 73 74 20 27 72 75 6e 73 63 72 69 70 74 (list 'runscript
145c0 20 72 75 6e 73 63 72 69 70 74 29 20 0a 09 09 09 runscript) ....
145d0 09 09 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 ..(list 'run-id
145e0 20 20 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 run-id )...
145f0 09 09 09 28 6c 69 73 74 20 27 74 65 73 74 2d 69 ...(list 'test-i
14600 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 0a 09 d test-id )..
14610 09 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 69 74 ....;; (list 'it
14620 65 6d 2d 70 61 74 68 20 69 74 65 6d 2d 70 61 74 em-path item-pat
14630 68 20 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 h )......(list '
14640 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 64 61 itemdat itemda
14650 74 20 20 29 0a 09 09 09 09 09 28 6c 69 73 74 20 t )......(list
14660 27 6d 65 67 61 74 65 73 74 20 20 72 65 6d 6f 74 'megatest remot
14670 65 2d 6d 65 67 61 74 65 73 74 29 0a 09 09 09 09 e-megatest).....
14680 09 28 6c 69 73 74 20 27 65 7a 73 74 65 70 73 20 .(list 'ezsteps
14690 20 20 65 7a 73 74 65 70 73 29 0a 09 09 09 09 09 ezsteps)......
146a0 28 6c 69 73 74 20 27 73 75 62 72 75 6e 20 20 20 (list 'subrun
146b0 20 73 75 62 72 75 6e 29 0a 09 09 09 09 09 28 6c subrun)......(l
146c0 69 73 74 20 27 74 61 72 67 65 74 20 20 20 20 6d ist 'target m
146d0 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 09 28 t_target)......(
146e0 6c 69 73 74 20 27 63 6f 6e 74 6f 75 72 20 20 20 list 'contour
146f0 63 6f 6e 74 6f 75 72 29 0a 09 09 09 09 09 28 6c contour)......(l
14700 69 73 74 20 27 72 75 6e 74 6c 69 6d 20 20 20 28 ist 'runtlim (
14710 69 66 20 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 if run-time-limi
14720 74 20 28 63 6f 6d 6d 6f 6e 3a 68 6d 73 2d 73 74 t (common:hms-st
14730 72 69 6e 67 2d 3e 73 65 63 6f 6e 64 73 20 72 75 ring->seconds ru
14740 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 29 20 23 66 n-time-limit) #f
14750 29 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 65 ))......(list 'e
14760 6e 76 2d 6f 76 72 64 20 20 28 68 61 73 68 2d 74 nv-ovrd (hash-t
14770 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
14780 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e *configdat* "en
14790 76 2d 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 v-override" '())
147a0 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 27 73 ) ......(list 's
147b0 65 74 2d 76 61 72 73 20 20 28 69 66 20 70 61 72 et-vars (if par
147c0 61 6d 73 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ams (hash-table-
147d0 72 65 66 2f 64 65 66 61 75 6c 74 20 70 61 72 61 ref/default para
147e0 6d 73 20 22 2d 73 65 74 76 61 72 73 22 20 23 66 ms "-setvars" #f
147f0 29 29 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 )))......(list '
14800 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 6d runname runnam
14810 65 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 6d e)......(list 'm
14820 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 6d 74 t-bindir-path mt
14830 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 29 -bindir-path))))
14840 29 29 29 29 0a 0a 20 20 20 20 20 20 20 20 28 73 )))).. (s
14850 65 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 etenv "MT_CMDINF
14860 4f 22 20 63 6d 64 70 61 72 6d 73 29 20 20 3b 3b O" cmdparms) ;;
14870 20 73 65 74 74 69 6e 67 20 74 68 69 73 20 66 6f setting this fo
14880 72 20 75 73 65 20 69 6e 20 6e 62 6c 61 75 6e 63 r use in nblaunc
14890 68 65 72 0a 20 20 20 20 20 20 0a 20 20 20 20 20 her. .
148a0 20 3b 3b 20 63 6c 65 61 6e 20 6f 75 74 20 73 74 ;; clean out st
148b0 65 70 20 72 65 63 6f 72 64 73 20 66 72 6f 6d 20 ep records from
148c0 70 72 65 76 69 6f 75 73 20 72 75 6e 20 69 66 20 previous run if
148d0 74 68 65 79 20 65 78 69 73 74 0a 20 20 20 20 20 they exist.
148e0 20 3b 3b 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d ;; (rmt:delete-
148f0 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 test-step-record
14900 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
14910 29 0a 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 ). ;; if th
14920 65 20 64 69 72 20 64 6f 65 73 20 6e 6f 74 20 65 e dir does not e
14930 78 69 73 74 20 77 65 20 6d 61 79 20 68 61 76 65 xist we may have
14940 20 61 20 69 74 65 6d 70 61 74 68 20 77 68 65 72 a itempath wher
14950 65 20 69 6e 64 69 76 69 64 75 61 6c 20 76 61 72 e individual var
14960 69 61 62 6c 65 73 20 61 72 65 20 61 20 70 61 74 iables are a pat
14970 68 2c 20 6c 61 75 6e 63 68 20 61 6e 79 77 61 79 h, launch anyway
14980 0a 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d . (if (comm
14990 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
149a0 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 63 work-area).. (c
149b0 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
149c0 77 6f 72 6b 2d 61 72 65 61 29 29 20 3b 3b 20 73 work-area)) ;; s
149d0 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c 65 73 o that log files
149e0 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e 63 68 from the launch
149f0 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 20 63 process don't c
14a00 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 74 20 lutter the test
14a10 64 69 72 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a dir. (cond.
14a20 20 20 20 20 20 20 20 3b 3b 20 28 28 61 6e 64 20 ;; ((and
14a30 6c 61 75 6e 63 68 65 72 20 68 6f 73 74 73 29 20 launcher hosts)
14a40 3b 3b 20 6d 75 73 74 20 62 65 20 75 73 69 6e 67 ;; must be using
14a50 20 73 73 68 20 68 6f 73 74 6e 61 6d 65 0a 20 20 ssh hostname.
14a60 20 20 20 20 20 3b 3b 20 20 20 20 28 73 65 74 21 ;; (set!
14a70 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
14a80 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 68 launcher (car h
14a90 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 osts)(list remot
14aa0 65 2d 6d 65 67 61 74 65 73 74 20 22 2d 6d 22 20 e-megatest "-m"
14ab0 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 test-sig "-execu
14ac0 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 65 te" cmdparms) de
14ad0 62 75 67 2d 70 61 72 61 6d 29 29 29 0a 20 20 20 bug-param))).
14ae0 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c ;; (set! ful
14af0 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
14b00 6e 63 68 65 72 20 28 63 61 72 20 68 6f 73 74 73 ncher (car hosts
14b10 29 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 )(list remote-me
14b20 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
14b30 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
14b40 72 6d 73 29 29 29 29 0a 20 20 20 20 20 20 20 28 rms)))). (
14b50 6c 61 75 6e 63 68 65 72 0a 09 28 73 65 74 21 20 launcher..(set!
14b60 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 fullcmd (append
14b70 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 20 72 launcher (list r
14b80 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 22 emote-megatest "
14b90 2d 6d 22 20 74 65 73 74 2d 73 69 67 20 22 2d 65 -m" test-sig "-e
14ba0 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
14bb0 29 20 64 65 62 75 67 2d 70 61 72 61 6d 29 29 29 ) debug-param)))
14bc0 0a 20 20 20 20 20 20 20 3b 3b 20 28 73 65 74 21 . ;; (set!
14bd0 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
14be0 20 6c 61 75 6e 63 68 65 72 20 28 6c 69 73 74 20 launcher (list
14bf0 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 remote-megatest
14c00 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 test-sig "-execu
14c10 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 te" cmdparms))))
14c20 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 09 28 . (else..(
14c30 69 66 20 28 6e 6f 74 20 75 73 65 73 68 65 6c 6c if (not useshell
14c40 29 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 )(debug:print 0
14c50 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
14c60 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 69 6e 74 t* "WARNING: int
14c70 65 72 6e 61 6c 20 6c 61 75 6e 63 68 69 6e 67 20 ernal launching
14c80 77 69 6c 6c 20 6e 6f 74 20 77 6f 72 6b 20 77 65 will not work we
14c90 6c 6c 20 77 69 74 68 6f 75 74 20 5c 22 75 73 65 ll without \"use
14ca0 73 68 65 6c 6c 20 79 65 73 5c 22 20 69 6e 20 79 shell yes\" in y
14cb0 6f 75 72 20 5b 6a 6f 62 74 6f 6f 6c 73 5d 20 73 our [jobtools] s
14cc0 65 63 74 69 6f 6e 22 29 29 0a 09 28 73 65 74 21 ection"))..(set!
14cd0 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
14ce0 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
14cf0 67 61 74 65 73 74 20 22 2d 6d 22 20 74 65 73 74 gatest "-m" test
14d00 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
14d10 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
14d20 70 61 72 61 6d 20 28 6c 69 73 74 20 28 69 66 20 param (list (if
14d30 75 73 65 73 68 65 6c 6c 20 22 26 22 20 22 22 29 useshell "&" "")
14d40 29 29 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 28 ))))). ;; (
14d50 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 6c 69 set! fullcmd (li
14d60 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
14d70 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 st test-sig "-ex
14d80 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 20 ecute" cmdparms
14d90 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 22 (if useshell "&"
14da0 20 22 22 29 29 29 29 29 0a 20 20 20 20 20 20 28 ""))))). (
14db0 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
14dc0 20 22 2d 78 74 65 72 6d 22 29 28 73 65 74 21 20 "-xterm")(set!
14dd0 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 fullcmd (append
14de0 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 2d fullcmd (list "-
14df0 78 74 65 72 6d 22 29 29 29 29 0a 20 20 20 20 20 xterm")))).
14e00 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
14e10 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
14e20 74 2a 20 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 t* "Launching "
14e30 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 20 work-area).
14e40 20 3b 3b 20 73 65 74 20 70 72 65 2d 6c 61 75 6e ;; set pre-laun
14e50 63 68 2d 65 6e 76 2d 76 61 72 73 20 62 65 66 6f ch-env-vars befo
14e60 72 65 20 6c 61 75 6e 63 68 69 6e 67 2c 20 6b 65 re launching, ke
14e70 65 70 20 74 68 65 20 76 61 72 73 20 69 6e 20 70 ep the vars in p
14e80 72 65 76 76 61 6c 73 20 61 6e 64 20 70 75 74 20 revvals and put
14e90 74 68 65 20 65 6e 76 69 6f 6e 6d 65 6e 74 20 62 the envionment b
14ea0 61 63 6b 20 77 68 65 6e 20 64 6f 6e 65 0a 20 20 ack when done.
14eb0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
14ec0 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 4 *default-log-
14ed0 70 6f 72 74 2a 20 22 66 75 6c 6c 63 6d 64 3a 20 port* "fullcmd:
14ee0 22 20 66 75 6c 6c 63 6d 64 29 0a 20 20 20 20 20 " fullcmd).
14ef0 20 28 73 65 74 21 20 2a 6c 61 73 74 2d 6c 61 75 (set! *last-lau
14f00 6e 63 68 2a 20 28 63 75 72 72 65 6e 74 2d 73 65 nch* (current-se
14f10 63 6f 6e 64 73 29 29 20 3b 3b 20 61 6c 6c 20 74 conds)) ;; all t
14f20 68 61 74 20 6a 75 6e 6b 20 61 62 6f 76 65 20 74 hat junk above t
14f30 61 6b 65 73 20 74 69 6d 65 2c 20 73 65 74 20 74 akes time, set t
14f40 68 69 73 20 61 73 20 6c 61 74 65 20 61 73 20 70 his as late as p
14f50 6f 73 73 69 62 6c 65 2e 0a 20 20 20 20 20 20 28 ossible.. (
14f60 6c 65 74 2a 20 28 28 63 6f 6d 6d 6f 6e 70 72 65 let* ((commonpre
14f70 76 76 61 6c 73 20 28 61 6c 69 73 74 2d 3e 65 6e vvals (alist->en
14f80 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 20 20 v-vars....
14f90 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
14fa0 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 64 default *configd
14fb0 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 at* "env-overrid
14fc0 65 22 20 27 28 29 29 29 29 0a 09 20 20 20 20 20 e" '())))..
14fd0 28 6d 69 73 63 70 72 65 76 76 61 6c 73 20 20 20 (miscprevvals
14fe0 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
14ff0 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 20 ;; consolidate
15000 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 74 this code with t
15010 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 74 he code in megat
15020 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 78 est.scm for "-ex
15030 65 63 75 74 65 22 0a 09 09 09 20 20 20 20 20 20 ecute"....
15040 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 6c (append (list (l
15050 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e ist "MT_TEST_RUN
15060 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
15070 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 ...... (list
15080 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
15090 65 73 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 est-name)......
150a0 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 (list "MT_ITE
150b0 4d 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 M_INFO" (conc it
150c0 65 6d 64 61 74 29 29 20 0a 09 09 09 09 09 20 20 emdat)) ......
150d0 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e 4e (list "MT_RUNN
150e0 41 4d 45 22 20 20 20 72 75 6e 6e 61 6d 65 29 0a AME" runname).
150f0 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 22 ..... (list "
15100 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 6d 74 MT_TARGET" mt
15110 5f 74 61 72 67 65 74 29 0a 09 09 09 09 09 20 20 _target)......
15120 20 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d (list "MT_ITEM
15130 50 41 54 48 22 20 20 69 74 65 6d 2d 70 61 74 68 PATH" item-path
15140 29 0a 09 09 09 09 09 20 20 20 20 29 0a 09 09 09 )...... )....
15150 09 20 20 20 20 20 20 69 74 65 6d 64 61 74 29 29 . itemdat))
15160 29 0a 09 20 20 20 20 20 28 74 65 73 74 70 72 65 ).. (testpre
15170 76 76 61 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e vvals (alist->
15180 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 20 20 20 env-vars....
15190 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
151a0 66 2f 64 65 66 61 75 6c 74 20 74 63 6f 6e 66 69 f/default tconfi
151b0 67 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e g "pre-launch-en
151c0 76 2d 6f 76 65 72 72 69 64 65 73 22 20 27 28 29 v-overrides" '()
151d0 29 29 29 0a 09 20 20 20 20 20 3b 3b 20 4c 61 75 ))).. ;; Lau
151e0 6e 63 68 77 61 69 74 20 64 65 66 61 75 6c 74 73 nchwait defaults
151f0 20 74 6f 20 74 72 75 65 2c 20 6d 75 73 74 20 6f to true, must o
15200 76 65 72 72 69 64 65 20 69 74 20 74 6f 20 74 75 verride it to tu
15210 72 6e 20 6f 66 66 20 77 61 69 74 0a 09 20 20 20 rn off wait..
15220 20 20 28 6c 61 75 6e 63 68 77 61 69 74 20 20 20 (launchwait
15230 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 63 (if (equal? (c
15240 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 onfigf:lookup *c
15250 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
15260 22 20 22 6c 61 75 6e 63 68 77 61 69 74 22 29 20 " "launchwait")
15270 22 6e 6f 22 29 20 23 66 20 23 74 29 29 0a 09 20 "no") #f #t))..
15280 20 20 20 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 (launch-resu
15290 6c 74 73 2d 70 72 65 76 20 28 61 70 70 6c 79 20 lts-prev (apply
152a0 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 20 3b (if launchwait ;
152b0 3b 20 42 42 3a 20 54 4f 44 4f 3a 20 72 65 66 61 ; BB: TODO: refa
152c0 63 74 6f 72 20 74 68 69 73 20 74 6f 20 65 78 61 ctor this to exa
152d0 6d 69 6e 65 20 72 65 74 75 72 6e 20 63 6f 64 65 mine return code
152e0 20 6f 66 20 6c 61 75 6e 63 68 65 72 2c 20 69 66 of launcher, if
152f0 20 6e 6f 6e 7a 65 72 6f 2c 20 73 65 74 20 73 74 nonzero, set st
15300 61 74 65 20 74 6f 20 6c 61 75 6e 63 68 20 66 61 ate to launch fa
15310 69 6c 65 64 2e 0a 09 09 09 09 09 20 20 20 20 20 iled.......
15320 70 72 6f 63 65 73 73 3a 63 6d 64 2d 72 75 6e 2d process:cmd-run-
15330 77 69 74 68 2d 73 74 64 65 72 72 2d 61 6e 64 2d with-stderr-and-
15340 65 78 69 74 63 6f 64 65 2d 3e 6c 69 73 74 0a 09 exitcode->list..
15350 09 09 09 09 20 20 20 20 20 70 72 6f 63 65 73 73 .... process
15360 2d 72 75 6e 29 0a 09 09 09 09 09 20 28 69 66 20 -run)...... (if
15370 75 73 65 73 68 65 6c 6c 0a 09 09 09 09 09 20 20 useshell......
15380 20 20 20 28 6c 65 74 20 28 28 63 6d 64 73 74 72 (let ((cmdstr
15390 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
153a0 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 erse fullcmd " "
153b0 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 )))......
153c0 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 0a 09 (if launchwait..
153d0 09 09 09 09 09 20 20 20 63 6d 64 73 74 72 0a 09 ..... cmdstr..
153e0 09 09 09 09 09 20 20 20 28 63 6f 6e 63 20 63 6d ..... (conc cm
153f0 64 73 74 72 20 22 20 3e 3e 20 6d 74 5f 6c 61 75 dstr " >> mt_lau
15400 6e 63 68 2e 6c 6f 67 20 32 3e 26 31 20 26 22 29 nch.log 2>&1 &")
15410 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 63 61 ))...... (ca
15420 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 r fullcmd)).....
15430 09 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 . (if useshell..
15440 09 09 09 09 20 20 20 20 20 27 28 29 0a 09 09 09 .... '()....
15450 09 09 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c .. (cdr full
15460 63 6d 64 29 29 29 29 0a 20 20 20 20 20 20 20 20 cmd)))).
15470 20 20 20 20 20 28 73 75 63 63 65 73 73 20 20 20 (success
15480 20 20 20 20 20 28 69 66 20 6c 61 75 6e 63 68 77 (if launchw
15490 61 69 74 20 28 65 71 75 61 6c 3f 20 30 20 28 63 ait (equal? 0 (c
154a0 61 64 72 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c adr launch-resul
154b0 74 73 2d 70 72 65 76 29 29 20 23 74 29 29 0a 20 ts-prev)) #t)).
154c0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 75 (lau
154d0 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 69 66 20 nch-results (if
154e0 6c 61 75 6e 63 68 77 61 69 74 20 28 63 61 72 20 launchwait (car
154f0 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 2d 70 launch-results-p
15500 72 65 76 29 20 6c 61 75 6e 63 68 2d 72 65 73 75 rev) launch-resu
15510 6c 74 73 2d 70 72 65 76 29 29 29 0a 20 20 20 20 lts-prev))).
15520 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 75 63 (if (not suc
15530 63 65 73 73 29 0a 20 20 20 20 20 20 20 20 20 20 cess).
15540 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 (tests:test-se
15550 74 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 t-status! run-id
15560 20 74 65 73 74 2d 69 64 20 22 43 4f 4d 50 4c 45 test-id "COMPLE
15570 54 45 44 22 20 22 44 45 41 44 22 20 22 6c 61 75 TED" "DEAD" "lau
15580 6e 63 68 65 72 20 66 61 69 6c 65 64 3b 20 65 78 ncher failed; ex
15590 69 74 65 64 20 6e 6f 6e 2d 7a 65 72 6f 3b 20 63 ited non-zero; c
155a0 68 65 63 6b 20 6d 74 5f 6c 61 75 6e 63 68 2e 6c heck mt_launch.l
155b0 6f 67 22 20 23 66 29 29 20 3b 3b 20 28 69 66 20 og" #f)) ;; (if
155c0 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 6c launch-results l
155d0 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 22 46 aunch-results "F
155e0 41 49 4c 45 44 22 29 29 0a 20 20 20 20 20 20 20 AILED")).
155f0 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
15600 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 *launch-setup-mu
15610 74 65 78 2a 29 20 3b 3b 20 79 65 73 2c 20 72 65 tex*) ;; yes, re
15620 61 6c 6c 79 20 73 68 6f 75 6c 64 20 6d 75 74 65 ally should mute
15630 78 20 61 6c 6c 20 74 68 65 20 77 61 79 20 74 6f x all the way to
15640 20 68 65 72 65 2e 20 4e 65 65 64 20 74 6f 20 70 here. Need to p
15650 75 74 20 74 68 69 73 20 65 6e 74 69 72 65 20 70 ut this entire p
15660 72 6f 63 65 73 73 20 69 6e 74 6f 20 61 20 66 6f rocess into a fo
15670 72 6b 2e 0a 09 3b 3b 20 28 72 6d 74 3a 6e 6f 2d rk...;; (rmt:no-
15680 73 79 6e 63 2d 64 65 6c 21 20 6c 6f 63 6b 2d 6b sync-del! lock-k
15690 65 79 29 20 20 20 20 20 20 20 20 20 3b 3b 20 72 ey) ;; r
156a0 65 6c 65 61 73 65 20 74 68 65 20 6c 6f 63 6b 20 elease the lock
156b0 66 6f 72 20 73 74 61 72 74 69 6e 67 20 74 68 69 for starting thi
156c0 73 20 74 65 73 74 0a 09 28 69 66 20 28 6e 6f 74 s test..(if (not
156d0 20 6c 61 75 6e 63 68 77 61 69 74 29 20 3b 3b 20 launchwait) ;;
156e0 67 69 76 65 20 74 68 65 20 4f 53 20 61 20 6c 69 give the OS a li
156f0 74 74 6c 65 20 74 69 6d 65 20 74 6f 20 61 6c 6c ttle time to all
15700 6f 77 20 74 68 65 20 70 72 6f 63 65 73 73 20 74 ow the process t
15710 6f 20 73 74 61 72 74 0a 09 20 20 20 20 28 74 68 o start.. (th
15720 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 30 31 read-sleep! 0.01
15730 29 29 0a 09 28 77 69 74 68 2d 6f 75 74 70 75 74 ))..(with-output
15740 2d 74 6f 2d 66 69 6c 65 20 22 6d 74 5f 6c 61 75 -to-file "mt_lau
15750 6e 63 68 2e 6c 6f 67 22 0a 09 20 20 28 6c 61 6d nch.log".. (lam
15760 62 64 61 20 28 29 0a 09 20 20 20 20 28 70 72 69 bda ().. (pri
15770 6e 74 20 22 4c 41 55 4e 43 48 43 4d 44 3a 20 22 nt "LAUNCHCMD: "
15780 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
15790 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 20 22 erse fullcmd " "
157a0 29 29 0a 09 20 20 20 20 28 69 66 20 28 6c 69 73 )).. (if (lis
157b0 74 3f 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 t? launch-result
157c0 73 29 0a 09 09 28 61 70 70 6c 79 20 70 72 69 6e s)...(apply prin
157d0 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 t launch-results
157e0 29 0a 09 09 28 70 72 69 6e 74 20 22 4e 4f 54 45 )...(print "NOTE
157f0 3a 20 6c 61 75 6e 63 68 65 64 20 5c 22 22 20 66 : launched \"" f
15800 75 6c 6c 63 6d 64 20 22 5c 22 5c 6e 20 20 62 75 ullcmd "\"\n bu
15810 74 20 64 69 64 20 6e 6f 74 20 77 61 69 74 20 66 t did not wait f
15820 6f 72 20 69 74 20 74 6f 20 70 72 6f 63 65 65 64 or it to proceed
15830 2e 20 41 64 64 20 74 68 65 20 66 6f 6c 6c 6f 77 . Add the follow
15840 69 6e 67 20 74 6f 20 6d 65 67 61 74 65 73 74 2e ing to megatest.
15850 63 6f 6e 66 69 67 20 5c 6e 5b 73 65 74 75 70 5d config \n[setup]
15860 5c 6e 6c 61 75 6e 63 68 77 61 69 74 20 79 65 73 \nlaunchwait yes
15870 5c 6e 20 20 69 66 20 79 6f 75 20 68 61 76 65 20 \n if you have
15880 70 72 6f 62 6c 65 6d 73 20 77 69 74 68 20 74 68 problems with th
15890 69 73 22 29 29 0a 09 20 20 20 20 23 3a 61 70 70 is")).. #:app
158a0 65 6e 64 29 29 0a 09 28 64 65 62 75 67 3a 70 72 end))..(debug:pr
158b0 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
158c0 6f 67 2d 70 6f 72 74 2a 20 22 4c 61 75 6e 63 68 og-port* "Launch
158d0 69 6e 67 20 63 6f 6d 70 6c 65 74 65 64 2c 20 75 ing completed, u
158e0 70 64 61 74 69 6e 67 20 64 62 22 29 0a 09 28 64 pdating db")..(d
158f0 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
15900 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
15910 22 4c 61 75 6e 63 68 20 72 65 73 75 6c 74 73 3a "Launch results:
15920 20 22 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 " launch-result
15930 73 29 0a 09 28 69 66 20 28 6e 6f 74 20 6c 61 75 s)..(if (not lau
15940 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 nch-results)..
15950 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 (begin..
15960 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
15970 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
15980 2a 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 * "ERROR: Failed
15990 20 74 6f 20 72 75 6e 20 22 20 28 73 74 72 69 6e to run " (strin
159a0 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 g-intersperse fu
159b0 6c 6c 63 6d 64 20 22 20 22 29 20 22 2c 20 65 78 llcmd " ") ", ex
159c0 69 74 69 6e 67 20 6e 6f 77 22 29 0a 09 20 20 20 iting now")..
159d0 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 ;; (sqlite3:f
159e0 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 inalize! db)..
159f0 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 ;; good ole
15a00 22 65 78 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 "exit" seems not
15a10 20 74 6f 20 77 6f 72 6b 0a 09 20 20 20 20 20 20 to work..
15a20 3b 3b 20 28 5f 65 78 69 74 20 39 29 0a 09 20 20 ;; (_exit 9)..
15a30 20 20 20 20 3b 3b 20 62 75 74 20 74 68 69 73 20 ;; but this
15a40 68 61 63 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 hack will work!
15a50 54 68 61 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 Thanks go to Ala
15a60 6e 20 50 6f 73 74 20 6f 66 20 74 68 65 20 43 68 n Post of the Ch
15a70 69 63 6b 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 icken email list
15a80 0a 09 20 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 .. ;; NB//
15a90 49 73 20 74 68 69 73 20 73 74 69 6c 6c 20 6e 65 Is this still ne
15aa0 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 62 65 20 eded? Should be
15ab0 73 61 66 65 20 74 6f 20 67 6f 20 62 61 63 6b 20 safe to go back
15ac0 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 3f 0a 09 to "exit" now?..
15ad0 20 20 20 20 20 20 28 70 72 6f 63 65 73 73 2d 73 (process-s
15ae0 69 67 6e 61 6c 20 28 63 75 72 72 65 6e 74 2d 70 ignal (current-p
15af0 72 6f 63 65 73 73 2d 69 64 29 20 73 69 67 6e 61 rocess-id) signa
15b00 6c 2f 6b 69 6c 6c 29 0a 09 20 20 20 20 20 20 29 l/kill).. )
15b10 29 0a 09 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 )..(alist->env-v
15b20 61 72 73 20 6d 69 73 63 70 72 65 76 76 61 6c 73 ars miscprevvals
15b30 29 0a 09 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 )..(alist->env-v
15b40 61 72 73 20 74 65 73 74 70 72 65 76 76 61 6c 73 ars testprevvals
15b50 29 0a 09 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 )..(alist->env-v
15b60 61 72 73 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 ars commonprevva
15b70 6c 73 29 0a 09 6c 61 75 6e 63 68 2d 72 65 73 75 ls)..launch-resu
15b80 6c 74 73 29 29 0a 20 20 20 20 28 63 68 61 6e 67 lts)). (chang
15b90 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
15ba0 70 61 74 68 2a 29 0a 20 20 20 20 28 74 68 72 65 path*). (thre
15bb0 61 64 2d 73 6c 65 65 70 21 20 28 63 6f 6e 66 69 ad-sleep! (confi
15bc0 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 gf:lookup-number
15bd0 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
15be0 74 75 70 22 20 22 69 6e 74 65 72 2d 74 65 73 74 tup" "inter-test
15bf0 2d 64 65 6c 61 79 22 20 64 65 66 61 75 6c 74 3a -delay" default:
15c00 20 30 2e 30 29 29 29 29 0a 0a 3b 3b 20 72 65 63 0.0))))..;; rec
15c10 6f 76 65 72 20 61 20 74 65 73 74 20 77 68 65 72 over a test wher
15c20 65 20 74 68 65 20 74 6f 70 20 63 6f 6e 74 72 6f e the top contro
15c30 6c 6c 69 6e 67 20 6d 74 65 73 74 20 6d 61 79 20 lling mtest may
15c40 68 61 76 65 20 64 69 65 64 0a 3b 3b 0a 28 64 65 have died.;;.(de
15c50 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 72 65 63 fine (launch:rec
15c60 6f 76 65 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 over-test run-id
15c70 20 74 65 73 74 2d 69 64 29 0a 20 20 3b 3b 20 74 test-id). ;; t
15c80 68 69 73 20 66 75 6e 63 74 69 6f 6e 20 69 73 20 his function is
15c90 63 61 6c 6c 65 64 20 6f 6e 20 74 68 65 20 74 65 called on the te
15ca0 73 74 20 72 75 6e 20 68 6f 73 74 20 76 69 61 20 st run host via
15cb0 73 73 68 0a 20 20 3b 3b 0a 20 20 3b 3b 20 31 2e ssh. ;;. ;; 1.
15cc0 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 70 72 6f look at the pro
15cd0 63 65 73 73 20 66 72 6f 6d 20 70 69 64 0a 20 20 cess from pid.
15ce0 3b 3b 20 20 20 20 2d 20 69 73 20 69 74 20 6f 77 ;; - is it ow
15cf0 6e 65 64 20 62 79 20 63 61 6c 6c 69 6e 67 20 75 ned by calling u
15d00 73 65 72 0a 20 20 3b 3b 20 20 20 20 2d 20 69 74 ser. ;; - it
15d10 20 69 74 27 73 20 72 75 6e 20 64 69 72 65 63 74 it's run direct
15d20 6f 72 79 20 63 6f 72 72 65 63 74 20 66 6f 72 20 ory correct for
15d30 74 68 65 20 74 65 73 74 0a 20 20 3b 3b 20 20 20 the test. ;;
15d40 20 2d 20 69 73 20 74 68 65 72 65 20 61 20 63 6f - is there a co
15d50 6e 74 72 6f 6c 6c 69 6e 67 20 6d 74 65 73 74 20 ntrolling mtest
15d60 28 6d 61 79 62 65 20 73 74 75 63 6b 29 0a 20 20 (maybe stuck).
15d70 3b 3b 20 32 2e 20 69 66 20 72 65 63 6f 76 65 72 ;; 2. if recover
15d80 79 20 69 73 20 6e 65 65 64 65 64 20 77 61 74 63 y is needed watc
15d90 68 20 70 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 h pid. ;; -
15da0 77 68 65 6e 20 69 74 20 65 78 69 74 73 20 74 61 when it exits ta
15db0 6b 65 20 74 68 65 20 65 78 69 74 20 63 6f 64 65 ke the exit code
15dc0 20 61 6e 64 20 64 6f 20 74 68 65 20 6e 65 65 64 and do the need
15dd0 66 75 6c 0a 20 20 3b 3b 0a 20 20 28 6c 65 74 2a ful. ;;. (let*
15de0 20 28 28 70 69 64 20 28 72 6d 74 3a 74 65 73 74 ((pid (rmt:test
15df0 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 -get-top-process
15e00 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 -pid run-id test
15e10 2d 69 64 29 29 0a 09 20 28 70 73 72 65 73 20 28 -id)).. (psres (
15e20 77 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d with-input-from-
15e30 70 69 70 65 0a 09 09 20 28 63 6f 6e 63 20 22 70 pipe... (conc "p
15e40 73 20 2d 46 20 2d 75 20 22 20 28 63 75 72 72 65 s -F -u " (curre
15e50 6e 74 2d 75 73 65 72 2d 6e 61 6d 65 29 20 22 20 nt-user-name) "
15e60 7c 20 67 72 65 70 20 2d 45 20 27 22 20 70 69 64 | grep -E '" pid
15e70 20 22 20 27 20 7c 20 67 72 65 70 20 2d 76 20 27 " ' | grep -v '
15e80 67 72 65 70 20 2d 45 20 22 20 70 69 64 20 22 27 grep -E " pid "'
15e90 22 29 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 29 ")... (lambda ()
15ea0 0a 09 09 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 ... (read-line
15eb0 29 29 29 29 0a 09 20 28 72 75 6e 64 69 72 20 28 )))).. (rundir (
15ec0 69 66 20 28 73 74 72 69 6e 67 3f 20 70 73 72 65 if (string? psre
15ed0 73 29 20 3b 3b 20 72 65 61 6c 20 70 72 6f 63 65 s) ;; real proce
15ee0 73 73 20 6f 77 6e 65 64 20 62 79 20 75 73 65 72 ss owned by user
15ef0 0a 09 09 20 20 20 20 20 28 72 65 61 64 2d 73 79 ... (read-sy
15f00 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 28 63 6f 6e mbolic-link (con
15f10 63 20 22 2f 70 72 6f 63 2f 22 20 70 69 64 20 22 c "/proc/" pid "
15f20 2f 63 77 64 22 29 29 0a 09 09 20 20 20 20 20 23 /cwd"))... #
15f30 66 29 29 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 f))). ;; now
15f40 77 61 69 74 20 6f 6e 20 74 68 61 74 20 70 72 6f wait on that pro
15f50 63 65 73 73 20 69 66 20 61 6c 6c 20 69 73 20 63 cess if all is c
15f60 6f 72 72 65 63 74 0a 20 20 20 20 3b 3b 20 70 65 orrect. ;; pe
15f70 72 69 6f 64 69 63 61 6c 6c 79 20 75 70 64 61 74 riodically updat
15f80 65 20 74 68 65 20 64 62 20 77 69 74 68 20 72 75 e the db with ru
15f90 6e 74 69 6d 65 0a 20 20 20 20 3b 3b 20 77 68 65 ntime. ;; whe
15fa0 6e 20 74 68 65 20 70 72 6f 63 65 73 73 20 65 78 n the process ex
15fb0 69 74 73 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 its look at the
15fc0 64 62 2c 20 69 66 20 73 74 69 6c 6c 20 52 55 4e db, if still RUN
15fd0 4e 49 4e 47 20 61 66 74 65 72 20 31 30 20 73 65 NING after 10 se
15fe0 63 6f 6e 64 73 20 73 65 74 0a 20 20 20 20 3b 3b conds set. ;;
15ff0 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 61 70 state/status ap
16000 70 72 6f 70 72 69 61 74 65 6c 79 0a 20 20 20 20 propriately.
16010 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 (process-wait pi
16020 64 29 29 29 0a d))).