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 75 73 65 20 72 65 67 65 78 ====..(use regex
03e0: 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 73 65 regex-case base
03f0: 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 69 2d 64 sqlite3 srfi-
0400: 31 38 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 18 directory-uti
0410: 6c 73 20 70 6f 73 69 78 2d 65 78 74 72 61 73 20 ls posix-extras
0420: 7a 33 0a 20 20 20 20 20 63 61 6c 6c 2d 77 69 74 z3. call-wit
0430: 68 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 h-environment-va
0440: 72 69 61 62 6c 65 73 20 63 73 76 29 0a 28 75 73 riables csv).(us
0450: 65 20 74 79 70 65 64 2d 72 65 63 6f 72 64 73 20 e typed-records
0460: 70 61 74 68 6e 61 6d 65 2d 65 78 70 61 6e 64 20 pathname-expand
0470: 6d 61 74 63 68 61 62 6c 65 29 0a 0a 28 69 6d 70 matchable)..(imp
0480: 6f 72 74 20 28 70 72 65 66 69 78 20 62 61 73 65 ort (prefix base
0490: 36 34 20 62 61 73 65 36 34 3a 29 29 0a 28 69 6d 64 base64:)).(im
04a0: 70 6f 72 74 20 28 70 72 65 66 69 78 20 73 71 6c port (prefix sql
04b0: 69 74 65 33 20 73 71 6c 69 74 65 33 3a 29 29 0a ite3 sqlite3:)).
04c0: 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 74 20 .(declare (unit
04d0: 6c 61 75 6e 63 68 29 29 0a 28 64 65 63 6c 61 72 launch)).(declar
04e0: 65 20 28 75 73 65 73 20 73 75 62 72 75 6e 29 29 e (uses subrun))
04f0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
0500: 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 common)).(declar
0510: 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 66 29 e (uses configf)
0520: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0530: 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 20 28 db)).(declare (
0540: 75 73 65 73 20 65 7a 73 74 65 70 73 29 29 0a 0a uses ezsteps))..
0550: 28 69 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e (include "common
0560: 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 _records.scm").(
0570: 69 6e 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 include "key_rec
0580: 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c ords.scm").(incl
0590: 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e ude "db_records.
05a0: 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 scm").(include "
05b0: 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d megatest-fossil-
05c0: 68 61 73 68 2e 73 63 6d 22 29 0a 0a 3b 3b 3d 3d hash.scm")..;;==
05d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0610: 3d 3d 3d 3d 0a 3b 3b 20 65 7a 73 74 65 70 73 0a ====.;; ezsteps.
0620: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0660: 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 65 7a 73 ========..;; ezs
0670: 74 65 70 73 20 77 65 72 65 20 67 6f 69 6e 67 20 teps were going
0680: 74 6f 20 62 65 20 63 6f 64 65 64 20 61 73 0a 3b to be coded as.;
0690: 3b 20 73 74 65 70 6e 61 6d 65 5b 2c 70 72 65 64 ; stepname[,pred
06a0: 73 74 65 70 31 2c 70 72 65 64 73 74 65 70 32 20 step1,predstep2
06b0: 2e 2e 2e 5d 20 5b 7b 56 41 52 31 3d 66 69 72 73 ...] [{VAR1=firs
06c0: 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 64 7d 5d t,second,third}]
06d0: 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 65 78 65 63 command to exec
06e0: 75 74 65 0a 3b 3b 20 20 20 42 55 54 0a 3b 3b 20 ute.;; BUT.;;
06f0: 6e 6f 77 20 61 72 65 0a 3b 3b 20 73 74 65 70 6e now are.;; stepn
0700: 61 6d 65 20 7b 56 41 52 3d 66 69 72 73 74 2c 73 ame {VAR=first,s
0710: 65 63 6f 6e 64 2c 74 68 69 72 64 20 2e 2e 2e 7d econd,third ...}
0720: 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 0a 3b 3b 20 command ....;;
0730: 77 68 65 72 65 20 74 68 65 20 7b 56 41 52 3d 66 where the {VAR=f
0740: 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 68 69 72 irst,second,thir
0750: 64 20 2e 2e 2e 7d 20 69 73 20 6f 70 74 69 6f 6e d ...} is option
0760: 61 6c 2e 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6e al...;; given an
0770: 20 65 78 69 74 20 63 6f 64 65 20 61 6e 64 20 77 exit code and w
0780: 68 65 74 68 65 72 20 6f 72 20 6e 6f 74 20 6c 6f hether or not lo
0790: 67 70 72 6f 20 77 61 73 20 75 73 65 64 20 63 61 gpro was used ca
07a0: 6c 63 75 6c 61 74 65 20 4f 4b 2f 42 41 44 0a 3b lculate OK/BAD.;
07b0: 3b 20 72 65 74 75 72 6e 20 23 74 20 69 66 20 77 ; return #t if w
07c0: 65 20 61 72 65 20 6f 6b 2c 20 23 66 20 6f 74 68 e are ok, #f oth
07d0: 65 72 77 69 73 65 0a 28 64 65 66 69 6e 65 20 28 erwise.(define (
07e0: 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f steprun-good? lo
07f0: 67 70 72 6f 20 65 78 69 74 63 6f 64 65 20 73 74 gpro exitcode st
0800: 65 70 70 61 72 6d 73 29 0a 20 20 28 6f 72 20 28 epparms). (or (
0810: 65 71 3f 20 65 78 69 74 63 6f 64 65 20 30 29 0a eq? exitcode 0).
0820: 20 20 20 20 20 20 28 61 6e 64 20 6c 6f 67 70 72 (and logpr
0830: 6f 20 20 28 6d 65 6d 62 65 72 20 65 78 69 74 63 o (member exitc
0840: 6f 64 65 20 27 28 20 32 20 34 20 36 29 29 29 0a ode '( 2 4 6))).
0850: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 61 (let* ((pa
0860: 72 61 6d 73 20 28 61 6c 69 73 74 2d 72 65 66 20 rams (alist-ref
0870: 27 70 61 72 61 6d 73 20 73 74 65 70 70 61 72 6d 'params stepparm
0880: 73 29 29 20 3b 3b 20 67 65 74 20 74 68 65 20 70 s)) ;; get the p
0890: 61 72 61 6d 73 20 73 65 63 74 69 6f 6e 0a 09 20 arams section..
08a0: 20 20 20 20 28 6b 65 65 70 2d 67 6f 69 6e 67 20 (keep-going
08b0: 28 69 66 20 70 61 72 61 6d 73 0a 09 09 09 20 20 (if params....
08c0: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 6b (alist-ref "k
08d0: 65 65 70 2d 67 6f 69 6e 67 22 20 70 61 72 61 6d eep-going" param
08e0: 73 20 65 71 75 61 6c 3f 29 0a 09 09 09 20 20 20 s equal?)....
08f0: 20 20 23 66 29 29 29 0a 09 28 64 65 62 75 67 3a #f)))..(debug:
0900: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
0910: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6b 65 65 70 -log-port* "keep
0920: 2d 67 6f 69 6e 67 3d 22 20 6b 65 65 70 2d 67 6f -going=" keep-go
0930: 69 6e 67 29 0a 09 28 61 6e 64 20 6b 65 65 70 2d ing)..(and keep-
0940: 67 6f 69 6e 67 20 28 65 71 75 61 6c 3f 20 28 63 going (equal? (c
0950: 61 72 20 6b 65 65 70 2d 67 6f 69 6e 67 29 20 22 ar keep-going) "
0960: 79 65 73 22 29 29 29 29 29 0a 0a 3b 3b 20 69 66 yes")))))..;; if
0970: 20 68 61 6e 64 65 64 20 61 20 73 74 72 69 6e 67 handed a string
0980: 2c 20 70 72 6f 63 65 73 73 20 69 74 2c 20 65 6c , process it, el
0990: 73 65 20 6c 6f 6f 6b 20 66 6f 72 20 4d 54 5f 43 se look for MT_C
09a0: 4d 44 49 4e 46 4f 0a 28 64 65 66 69 6e 65 20 28 MDINFO.(define (
09b0: 6c 61 75 6e 63 68 3a 67 65 74 2d 63 6d 64 69 6e launch:get-cmdin
09c0: 66 6f 2d 61 73 73 6f 63 2d 6c 69 73 74 20 23 21 fo-assoc-list #!
09d0: 6b 65 79 20 28 65 6e 63 6f 64 65 64 2d 63 6d 64 key (encoded-cmd
09e0: 20 23 66 29 29 0a 20 20 28 6c 65 74 20 28 28 65 #f)). (let ((e
09f0: 6e 63 63 6d 64 20 28 69 66 20 65 6e 63 6f 64 65 nccmd (if encode
0a00: 64 2d 63 6d 64 20 65 6e 63 6f 64 65 64 2d 63 6d d-cmd encoded-cm
0a10: 64 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 43 4d d (getenv "MT_CM
0a20: 44 49 4e 46 4f 22 29 29 29 29 0a 20 20 20 20 28 DINFO")))). (
0a30: 69 66 20 65 6e 63 63 6d 64 0a 09 28 63 6f 6d 6d if enccmd..(comm
0a40: 6f 6e 3a 72 65 61 64 2d 65 6e 63 6f 64 65 64 2d on:read-encoded-
0a50: 73 74 72 69 6e 67 20 65 6e 63 63 6d 64 29 0a 09 string enccmd)..
0a60: 27 28 29 29 29 29 0a 0a 3b 3b 20 20 20 20 20 20 '())))..;;
0a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a80: 20 30 20 20 20 20 20 20 20 20 20 20 20 31 20 20 0 1
0a90: 20 20 20 20 20 20 20 20 20 20 20 20 32 20 20 20 2
0aa0: 20 20 20 20 20 20 20 20 20 20 20 33 0a 28 64 65 3.(de
0ab0: 66 73 74 72 75 63 74 20 6c 61 75 6e 63 68 3a 65 fstruct launch:e
0ac0: 69 6e 66 20 28 70 69 64 20 23 74 29 28 65 78 69 inf (pid #t)(exi
0ad0: 74 2d 73 74 61 74 75 73 20 23 74 29 28 65 78 69 t-status #t)(exi
0ae0: 74 2d 63 6f 64 65 20 23 74 29 28 72 6f 6c 6c 75 t-code #t)(rollu
0af0: 70 2d 73 74 61 74 75 73 20 30 29 29 0a 0a 3b 3b p-status 0))..;;
0b00: 20 72 65 74 75 72 6e 20 28 63 6f 6e 63 20 73 74 return (conc st
0b10: 61 74 75 73 20 22 3a 20 22 20 63 6f 6d 6d 65 6e atus ": " commen
0b20: 74 29 20 66 72 6f 6d 20 74 68 65 20 66 69 6e 61 t) from the fina
0b30: 6c 20 73 65 63 74 69 6f 6e 20 73 6f 20 74 68 61 l section so tha
0b40: 74 0a 3b 3b 20 20 20 74 68 65 20 63 6f 6d 6d 65 t.;; the comme
0b50: 6e 74 20 63 61 6e 20 62 65 20 73 65 74 20 69 6e nt can be set in
0b60: 20 74 68 65 20 73 74 65 70 20 72 65 63 6f 72 64 the step record
0b70: 20 69 6e 20 6c 61 75 6e 63 68 2e 73 63 6d 0a 3b in launch.scm.;
0b80: 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ;.(define (launc
0b90: 68 3a 6c 6f 61 64 2d 6c 6f 67 70 72 6f 2d 64 61 h:load-logpro-da
0ba0: 74 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 t run-id test-id
0bb0: 20 73 74 65 70 6e 61 6d 65 29 0a 20 20 28 6c 65 stepname). (le
0bc0: 74 20 28 28 63 6e 61 6d 65 20 28 63 6f 6e 63 20 t ((cname (conc
0bd0: 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 74 22 29 stepname ".dat")
0be0: 29 29 0a 20 20 20 20 28 69 66 20 28 63 6f 6d 6d )). (if (comm
0bf0: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
0c00: 63 6e 61 6d 65 29 0a 09 28 6c 65 74 2a 20 28 28 cname)..(let* ((
0c10: 64 61 74 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 dat (read-confi
0c20: 67 20 63 6e 61 6d 65 20 23 66 20 23 66 29 29 0a g cname #f #f)).
0c30: 09 20 20 20 20 20 20 20 28 63 73 76 72 20 28 64 . (csvr (d
0c40: 62 3a 6c 6f 67 70 72 6f 2d 64 61 74 2d 3e 63 73 b:logpro-dat->cs
0c50: 76 20 64 61 74 20 73 74 65 70 6e 61 6d 65 29 29 v dat stepname))
0c60: 0a 09 20 20 20 20 20 20 20 28 63 73 76 74 20 28 .. (csvt (
0c70: 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 66 6d let-values (((fm
0c80: 74 2d 63 65 6c 6c 20 66 6d 74 2d 72 65 63 6f 72 t-cell fmt-recor
0c90: 64 20 66 6d 74 2d 63 73 76 29 20 28 6d 61 6b 65 d fmt-csv) (make
0ca0: 2d 66 6f 72 6d 61 74 20 22 2c 22 29 29 29 0a 09 -format ",")))..
0cb0: 09 20 20 20 20 20 20 20 28 66 6d 74 2d 63 73 76 . (fmt-csv
0cc0: 20 28 6d 61 70 20 6c 69 73 74 2d 3e 63 73 76 2d (map list->csv-
0cd0: 72 65 63 6f 72 64 20 63 73 76 72 29 29 29 29 0a record csvr)))).
0ce0: 09 20 20 20 20 20 20 20 28 73 74 61 74 75 73 20 . (status
0cf0: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
0d00: 64 61 74 20 22 66 69 6e 61 6c 22 20 22 65 78 69 dat "final" "exi
0d10: 74 2d 73 74 61 74 75 73 22 29 29 0a 09 20 20 20 t-status"))..
0d20: 20 20 20 20 28 6d 73 67 20 20 20 20 20 28 63 6f (msg (co
0d30: 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 61 74 nfigf:lookup dat
0d40: 20 22 66 69 6e 61 6c 22 20 22 6d 65 73 73 61 67 "final" "messag
0d50: 65 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 e"))).
0d60: 28 69 66 20 63 73 76 74 20 20 3b 3b 20 74 68 69 (if csvt ;; thi
0d70: 73 20 69 66 20 62 6c 6f 63 6b 65 64 20 73 74 61 s if blocked sta
0d80: 63 6b 20 64 75 6d 70 20 63 61 75 73 65 64 20 62 ck dump caused b
0d90: 79 20 2e 64 61 74 20 66 69 6c 65 20 66 72 6f 6d y .dat file from
0da0: 20 6c 6f 67 70 72 6f 20 62 65 69 6e 67 20 30 2d logpro being 0-
0db0: 62 79 74 65 2e 20 20 66 69 78 65 64 20 62 79 20 byte. fixed by
0dc0: 75 70 67 72 61 64 69 6e 67 20 6c 6f 67 70 72 6f upgrading logpro
0dd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
0de0: 72 6d 74 3a 63 73 76 2d 3e 74 65 73 74 2d 64 61 rmt:csv->test-da
0df0: 74 61 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 ta run-id test-i
0e00: 64 20 63 73 76 74 29 0a 09 20 20 20 20 20 20 28 d csvt).. (
0e10: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
0e20: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
0e30: 20 22 45 52 52 4f 52 3a 20 6e 6f 20 63 73 76 64 "ERROR: no csvd
0e40: 61 74 20 65 78 69 73 74 73 20 66 6f 72 20 72 75 at exists for ru
0e50: 6e 2d 69 64 3a 20 22 20 72 75 6e 2d 69 64 20 22 n-id: " run-id "
0e60: 20 74 65 73 74 2d 69 64 3a 20 22 20 74 65 73 74 test-id: " test
0e70: 2d 69 64 20 22 20 73 74 65 70 6e 61 6d 65 3a 20 -id " stepname:
0e80: 22 20 73 74 65 70 6e 61 6d 65 20 22 2c 20 63 68 " stepname ", ch
0e90: 65 63 6b 20 74 68 61 74 20 6c 6f 67 70 72 6f 20 eck that logpro
0ea0: 76 65 72 73 69 6f 6e 20 69 73 20 31 2e 31 35 20 version is 1.15
0eb0: 6f 72 20 6e 65 77 65 72 22 29 29 0a 09 20 20 3b or newer")).. ;
0ec0: 3b 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d ; (debug:print-
0ed0: 69 6e 66 6f 20 31 33 20 2a 64 65 66 61 75 6c 74 info 13 *default
0ee0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 72 72 6f -log-port* "Erro
0ef0: 72 3a 20 72 75 6e 2d 69 64 2f 74 65 73 74 2d 69 r: run-id/test-i
0f00: 64 2f 73 74 65 70 6e 61 6d 65 3d 22 72 75 6e 2d d/stepname="run-
0f10: 69 64 22 2f 22 74 65 73 74 2d 69 64 22 2f 22 73 id"/"test-id"/"s
0f20: 74 65 70 6e 61 6d 65 22 20 3d 3e 20 62 61 64 20 tepname" => bad
0f30: 63 73 76 72 3d 22 63 73 76 72 29 0a 09 20 20 3b csvr="csvr).. ;
0f40: 3b 20 20 29 0a 09 20 20 28 63 6f 6e 64 0a 09 20 ; ).. (cond..
0f50: 20 20 28 28 65 71 75 61 6c 3f 20 73 74 61 74 75 ((equal? statu
0f60: 73 20 22 50 41 53 53 22 29 20 22 50 41 53 53 22 s "PASS") "PASS"
0f70: 29 20 3b 3b 20 73 6b 69 70 20 74 68 65 20 6d 65 ) ;; skip the me
0f80: 73 73 61 67 65 20 70 61 72 74 20 69 66 20 73 74 ssage part if st
0f90: 61 74 75 73 20 69 73 20 70 61 73 73 0a 09 20 20 atus is pass..
0fa0: 20 28 73 74 61 74 75 73 20 28 63 6f 6e 63 20 28 (status (conc (
0fb0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 64 configf:lookup d
0fc0: 61 74 20 22 66 69 6e 61 6c 22 20 22 65 78 69 74 at "final" "exit
0fd0: 2d 73 74 61 74 75 73 22 29 20 22 3a 20 22 20 28 -status") ": " (
0fe0: 69 66 20 6d 73 67 20 6d 73 67 20 22 6e 6f 20 6d if msg msg "no m
0ff0: 65 73 73 61 67 65 22 29 29 29 0a 09 20 20 20 28 essage"))).. (
1000: 65 6c 73 65 20 23 66 29 29 29 0a 09 23 66 29 29 else #f)))..#f))
1010: 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e )..(define (laun
1020: 63 68 3a 6d 61 6e 61 67 65 2d 73 74 65 70 73 20 ch:manage-steps
1030: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 run-id test-id i
1040: 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e tem-path fullrun
1050: 73 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 73 script ezsteps s
1060: 75 62 72 75 6e 20 74 65 73 74 2d 6e 61 6d 65 20 ubrun test-name
1070: 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 2d tconfigreg exit-
1080: 69 6e 66 6f 20 6d 29 0a 20 20 3b 3b 20 28 6c 65 info m). ;; (le
1090: 74 2d 76 61 6c 75 65 73 0a 20 20 3b 3b 20 20 28 t-values. ;; (
10a0: 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 75 ((pid exit-statu
10b0: 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 20 20 3b s exit-code). ;
10c0: 3b 20 20 20 20 28 72 75 6e 2d 6e 2d 77 61 69 74 ; (run-n-wait
10d0: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 fullrunscript))
10e0: 29 0a 20 20 3b 3b 20 28 74 65 73 74 73 3a 74 65 ). ;; (tests:te
10f0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
1100: 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e 47 22 est-id "RUNNING"
1110: 20 22 6e 2f 61 22 20 23 66 20 23 66 29 0a 20 20 "n/a" #f #f).
1120: 3b 3b 20 53 69 6e 63 65 20 77 65 20 73 68 6f 75 ;; Since we shou
1130: 6c 64 20 68 61 76 65 20 61 20 63 6c 65 61 6e 20 ld have a clean
1140: 73 6c 61 74 65 20 61 74 20 74 68 69 73 20 74 69 slate at this ti
1150: 6d 65 20 74 68 65 72 65 20 69 73 20 6e 6f 20 6e me there is no n
1160: 65 65 64 20 74 6f 20 64 6f 20 0a 20 20 3b 3b 20 eed to do . ;;
1170: 61 6e 79 20 6f 66 20 74 68 65 20 6f 74 68 65 72 any of the other
1180: 20 73 74 75 66 66 20 74 68 61 74 20 74 65 73 74 stuff that test
1190: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
11a0: 73 21 20 64 6f 65 73 2e 20 4c 65 74 27 73 20 6a s! does. Let's j
11b0: 75 73 74 20 0a 20 20 3b 3b 20 66 6f 72 63 65 20 ust . ;; force
11c0: 52 55 4e 4e 49 4e 47 2f 6e 2f 61 0a 0a 20 20 3b RUNNING/n/a.. ;
11d0: 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 ; (thread-sleep!
11e0: 20 30 2e 33 29 0a 20 20 3b 3b 20 28 74 65 73 74 0.3). ;; (test
11f0: 73 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 s:test-force-sta
1200: 74 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 te-status! run-i
1210: 64 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 d test-id "RUNNI
1220: 4e 47 22 20 22 6e 2f 61 22 29 0a 20 20 28 72 6d NG" "n/a"). (rm
1230: 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 t:set-state-stat
1240: 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 us-and-roll-up-i
1250: 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 tems run-id test
1260: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
1270: 22 52 55 4e 4e 49 4e 47 22 20 23 66 20 23 66 29 "RUNNING" #f #f)
1280: 20 0a 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 . ;; (thread-s
1290: 6c 65 65 70 21 20 30 2e 33 29 20 3b 3b 20 4e 46 leep! 0.3) ;; NF
12a0: 53 20 73 6c 6f 77 6e 65 73 73 20 68 61 73 20 63 S slowness has c
12b0: 61 75 73 65 64 20 67 72 69 65 66 20 68 65 72 65 aused grief here
12c0: 0a 0a 20 20 3b 3b 20 69 66 20 74 68 65 72 65 20 .. ;; if there
12d0: 69 73 20 61 20 72 75 6e 73 63 72 69 70 74 20 64 is a runscript d
12e0: 6f 20 69 74 20 66 69 72 73 74 0a 20 20 28 69 66 o it first. (if
12f0: 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 20 fullrunscript.
1300: 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 64 20 (let ((pid
1310: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 75 6c (process-run ful
1320: 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 28 lrunscript)))..(
1330: 72 6d 74 3a 74 65 73 74 2d 73 65 74 2d 74 6f 70 rmt:test-set-top
1340: 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e -process-pid run
1350: 2d 69 64 20 74 65 73 74 2d 69 64 20 70 69 64 29 -id test-id pid)
1360: 0a 09 28 6c 65 74 20 6c 6f 6f 70 20 28 28 69 20 ..(let loop ((i
1370: 30 29 29 0a 09 20 20 28 6c 65 74 2d 76 61 6c 75 0)).. (let-valu
1380: 65 73 0a 09 20 20 20 28 28 28 70 69 64 2d 76 61 es.. (((pid-va
1390: 6c 20 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 l exit-status ex
13a0: 69 74 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 it-code) (proces
13b0: 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 29 s-wait pid #t)))
13c0: 0a 09 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b .. (mutex-lock
13d0: 21 20 6d 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 ! m).. (launch
13e0: 3a 65 69 6e 66 2d 70 69 64 2d 73 65 74 21 20 20 :einf-pid-set!
13f0: 20 20 20 20 20 20 20 20 20 65 78 69 74 2d 69 6e exit-in
1400: 66 6f 20 20 70 69 64 29 20 20 20 20 20 20 20 20 fo pid)
1410: 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 74 21 ;; (vector-set!
1420: 20 65 78 69 74 2d 69 6e 66 6f 20 30 20 70 69 64 exit-info 0 pid
1430: 29 0a 09 20 20 20 28 6c 61 75 6e 63 68 3a 65 69 ).. (launch:ei
1440: 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 2d 73 nf-exit-status-s
1450: 65 74 21 20 20 20 65 78 69 74 2d 69 6e 66 6f 20 et! exit-info
1460: 20 65 78 69 74 2d 73 74 61 74 75 73 29 20 3b 3b exit-status) ;;
1470: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 (vector-set! ex
1480: 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 it-info 1 exit-s
1490: 74 61 74 75 73 29 0a 09 20 20 20 28 6c 61 75 6e tatus).. (laun
14a0: 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 63 6f 64 ch:einf-exit-cod
14b0: 65 2d 73 65 74 21 20 20 20 20 20 65 78 69 74 2d e-set! exit-
14c0: 69 6e 66 6f 20 20 65 78 69 74 2d 63 6f 64 65 29 info exit-code)
14d0: 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 73 65 ;; (vector-se
14e0: 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 t! exit-info 2 e
14f0: 78 69 74 2d 63 6f 64 65 29 0a 09 20 20 20 28 6c xit-code).. (l
1500: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
1510: 70 2d 73 74 61 74 75 73 2d 73 65 74 21 20 65 78 p-status-set! ex
1520: 69 74 2d 69 6e 66 6f 20 20 65 78 69 74 2d 63 6f it-info exit-co
1530: 64 65 29 20 20 20 3b 3b 20 28 76 65 63 74 6f 72 de) ;; (vector
1540: 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 6f 20 -set! exit-info
1550: 33 20 65 78 69 74 2d 63 6f 64 65 29 20 20 3b 3b 3 exit-code) ;;
1560: 20 72 6f 6c 6c 75 70 20 73 74 61 74 75 73 0a 09 rollup status..
1570: 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b (mutex-unlock
1580: 21 20 6d 29 0a 09 20 20 20 28 69 66 20 28 65 71 ! m).. (if (eq
1590: 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 20 20 ? pid-val 0)..
15a0: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 20 28 (begin... (
15b0: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 29 thread-sleep! 2)
15c0: 0a 09 09 20 28 6c 6f 6f 70 20 28 2b 20 69 20 31 ... (loop (+ i 1
15d0: 29 29 29 0a 09 20 20 20 20 20 20 20 29 29 29 29 ))).. ))))
15e0: 29 0a 20 20 3b 3b 20 74 68 65 6e 2c 20 69 66 20 ). ;; then, if
15f0: 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 6f 6b runscript ran ok
1600: 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 65 74 (or did not get
1610: 20 63 61 6c 6c 65 64 29 0a 20 20 3b 3b 20 64 6f called). ;; do
1620: 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 65 70 73 all the ezsteps
1630: 20 28 69 66 20 61 6e 79 29 0a 20 20 28 69 66 20 (if any). (if
1640: 28 6f 72 20 65 7a 73 74 65 70 73 20 73 75 62 72 (or ezsteps subr
1650: 75 6e 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 un). (let*
1660: 28 28 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 28 ((test-run-dir (
1670: 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 2d 70 tests:get-test-p
1680: 61 74 68 2d 66 72 6f 6d 2d 65 6e 76 69 72 6f 6e ath-from-environ
1690: 6d 65 6e 74 29 29 0a 20 20 20 20 20 20 20 20 20 ment)).
16a0: 20 20 20 20 28 74 65 73 74 63 6f 6e 66 69 67 20 (testconfig
16b0: 3b 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 ;; (read-config
16c0: 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 65 61 20 (conc work-area
16d0: 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 20 23 "/testconfig") #
16e0: 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 61 74 f #t environ-pat
16f0: 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 2d 65 t: "pre-launch-e
1700: 6e 76 2d 76 61 72 73 22 29 29 20 3b 3b 20 46 49 nv-vars")) ;; FI
1710: 58 4d 45 3f 3f 3f 20 69 73 20 61 6c 6c 6f 77 2d XME??? is allow-
1720: 73 79 73 74 65 6d 20 6f 6b 20 68 65 72 65 3f 0a system ok here?.
1730: 09 20 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 . ;; NOTE:
1740: 69 74 20 69 73 20 74 65 6d 70 74 69 6e 67 20 74 it is tempting t
1750: 6f 20 74 75 72 6e 20 6f 66 66 20 66 6f 72 63 65 o turn off force
1760: 2d 63 72 65 61 74 65 20 6f 66 20 74 65 73 74 63 -create of testc
1770: 6f 6e 66 69 67 20 62 75 74 20 64 79 6e 61 6d 69 onfig but dynami
1780: 63 0a 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 c.. ;;
1790: 20 20 65 7a 73 74 65 70 20 6e 61 6d 65 73 20 6e ezstep names n
17a0: 65 65 64 20 61 20 66 75 6c 6c 20 72 65 2d 65 76 eed a full re-ev
17b0: 61 6c 20 68 65 72 65 2e 0a 09 20 20 20 20 20 20 al here...
17c0: 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 74 63 (tests:get-testc
17d0: 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 onfig test-name
17e0: 69 74 65 6d 2d 70 61 74 68 20 74 63 6f 6e 66 69 item-path tconfi
17f0: 67 72 65 67 20 23 74 20 66 6f 72 63 65 2d 63 72 greg #t force-cr
1800: 65 61 74 65 3a 20 23 74 29 29 20 3b 3b 20 27 72 eate: #t)) ;; 'r
1810: 65 74 75 72 6e 2d 70 72 6f 63 73 29 29 29 0a 09 eturn-procs)))..
1820: 20 20 20 20 20 28 65 7a 73 74 65 70 73 6c 73 74 (ezstepslst
1830: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
1840: 3f 20 74 65 73 74 63 6f 6e 66 69 67 29 0a 09 09 ? testconfig)...
1850: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
1860: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 65 e-ref/default te
1870: 73 74 63 6f 6e 66 69 67 20 22 65 7a 73 74 65 70 stconfig "ezstep
1880: 73 22 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 s" '())....
1890: 23 66 29 29 29 0a 09 28 69 66 20 74 65 73 74 63 #f)))..(if testc
18a0: 6f 6e 66 69 67 0a 09 20 20 20 20 28 68 61 73 68 onfig.. (hash
18b0: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 -table-set! *tes
18c0: 74 63 6f 6e 66 69 67 73 2a 20 74 65 73 74 2d 6e tconfigs* test-n
18d0: 61 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 29 20 ame testconfig)
18e0: 3b 3b 20 63 61 63 68 65 64 20 66 6f 72 20 6c 61 ;; cached for la
18f0: 7a 79 20 72 65 61 64 73 20 6c 61 74 65 72 20 2e zy reads later .
1900: 2e 2e 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 .... (begin..
1910: 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 73 65 (launch:se
1920: 74 75 70 29 0a 09 20 20 20 20 20 20 28 64 65 62 tup).. (deb
1930: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
1940: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 ult-log-port* "W
1950: 41 52 4e 49 4e 47 3a 20 6e 6f 20 74 65 73 74 63 ARNING: no testc
1960: 6f 6e 66 69 67 20 66 6f 75 6e 64 20 66 6f 72 20 onfig found for
1970: 22 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 69 6e " test-name " in
1980: 20 73 65 61 72 63 68 20 70 61 74 68 3a 5c 6e 20 search path:\n
1990: 20 22 0a 09 09 09 20 20 20 28 73 74 72 69 6e 67 ".... (string
19a0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 74 65 -intersperse (te
19b0: 73 74 73 3a 67 65 74 2d 74 65 73 74 73 2d 73 65 sts:get-tests-se
19c0: 61 72 63 68 2d 70 61 74 68 20 2a 63 6f 6e 66 69 arch-path *confi
19d0: 67 64 61 74 2a 29 20 22 5c 6e 20 20 22 29 29 29 gdat*) "\n ")))
19e0: 29 0a 09 3b 3b 20 61 66 74 65 72 20 61 6c 6c 20 )..;; after all
19f0: 74 68 61 74 2c 20 73 74 69 6c 6c 20 6e 6f 20 74 that, still no t
1a00: 65 73 74 63 6f 6e 66 69 67 3f 20 54 69 6d 65 20 estconfig? Time
1a10: 74 6f 20 61 62 6f 72 74 0a 09 28 69 66 20 28 6e to abort..(if (n
1a20: 6f 74 20 74 65 73 74 63 6f 6e 66 69 67 29 0a 09 ot testconfig)..
1a30: 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 (begin..
1a40: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
1a50: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
1a60: 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
1a70: 64 20 74 6f 20 72 65 73 6f 6c 76 65 20 6d 65 67 d to resolve meg
1a80: 61 74 65 73 74 2e 63 6f 6e 66 69 67 2c 20 72 75 atest.config, ru
1a90: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 nconfigs.config
1aa0: 61 6e 64 20 74 65 73 74 63 6f 6e 66 69 67 20 69 and testconfig i
1ab0: 73 73 75 65 73 2e 20 47 69 76 69 6e 67 20 75 70 ssues. Giving up
1ac0: 20 6e 6f 77 22 29 0a 09 20 20 20 20 20 20 28 65 now").. (e
1ad0: 78 69 74 20 31 29 29 29 0a 0a 09 3b 3b 20 63 72 xit 1)))...;; cr
1ae0: 65 61 74 65 20 61 20 70 72 6f 63 20 66 6f 72 20 eate a proc for
1af0: 74 68 65 20 73 75 62 72 75 6e 20 69 66 20 72 65 the subrun if re
1b00: 71 75 65 73 74 65 64 2c 20 73 61 76 65 20 74 68 quested, save th
1b10: 61 74 20 70 72 6f 63 20 69 6e 20 74 68 65 20 65 at proc in the e
1b20: 7a 73 74 65 70 73 20 74 61 62 6c 65 20 61 73 20 zsteps table as
1b30: 74 68 65 20 6c 61 73 74 20 65 6e 74 72 79 0a 09 the last entry..
1b40: 3b 3b 20 31 2e 20 67 65 74 20 73 65 63 74 69 6f ;; 1. get sectio
1b50: 6e 20 5b 72 75 6e 61 72 75 6e 5d 0a 09 3b 3b 20 n [runarun]..;;
1b60: 32 2e 20 75 6e 73 65 74 20 4d 54 5f 2a 20 76 61 2. unset MT_* va
1b70: 72 73 0a 09 3b 3b 20 33 2e 20 66 69 78 20 74 61 rs..;; 3. fix ta
1b80: 72 67 65 74 0a 09 3b 3b 20 34 2e 20 66 69 78 20 rget..;; 4. fix
1b90: 72 75 6e 6e 61 6d 65 0a 09 3b 3b 20 35 2e 20 66 runname..;; 5. f
1ba0: 69 78 20 74 65 73 74 70 61 74 74 20 6f 72 20 63 ix testpatt or c
1bb0: 61 6c 63 75 6c 61 74 65 20 69 74 20 66 72 6f 6d alculate it from
1bc0: 20 63 6f 6e 74 6f 75 72 0a 09 3b 3b 20 36 2e 20 contour..;; 6.
1bd0: 6c 61 75 6e 63 68 20 74 68 65 20 72 75 6e 0a 09 launch the run..
1be0: 3b 3b 20 37 2e 20 72 6f 6c 6c 20 75 70 20 74 68 ;; 7. roll up th
1bf0: 65 20 72 75 6e 20 72 65 73 75 6c 74 20 61 6e 64 e run result and
1c00: 20 6f 72 20 72 6f 6c 6c 20 75 70 20 74 68 65 20 or roll up the
1c10: 6c 6f 67 70 72 6f 20 70 72 6f 63 65 73 73 65 64 logpro processed
1c20: 20 72 65 73 75 6c 74 0a 09 28 77 68 65 6e 20 28 result..(when (
1c30: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 configf:lookup t
1c40: 65 73 74 63 6f 6e 66 69 67 20 22 73 75 62 72 75 estconfig "subru
1c50: 6e 22 20 22 72 75 6e 77 61 69 74 22 29 20 3b 3b n" "runwait") ;;
1c60: 20 77 65 20 75 73 65 20 72 75 6e 77 61 69 74 20 we use runwait
1c70: 61 73 20 74 68 65 20 66 6c 61 67 20 74 68 61 74 as the flag that
1c80: 20 61 20 73 75 62 72 75 6e 20 69 73 20 72 65 71 a subrun is req
1c90: 75 65 73 74 65 64 0a 20 20 20 20 20 20 20 20 20 uested.
1ca0: 20 20 20 28 73 75 62 72 75 6e 3a 69 6e 69 74 69 (subrun:initi
1cb0: 61 6c 69 7a 65 2d 74 6f 70 72 75 6e 2d 74 65 73 alize-toprun-tes
1cc0: 74 20 74 65 73 74 63 6f 6e 66 69 67 20 74 65 73 t testconfig tes
1cd0: 74 2d 72 75 6e 2d 64 69 72 29 0a 09 20 20 20 20 t-run-dir)..
1ce0: 28 6c 65 74 2a 20 28 28 6d 74 2d 63 6d 64 20 28 (let* ((mt-cmd (
1cf0: 73 75 62 72 75 6e 3a 6c 61 75 6e 63 68 2d 63 6d subrun:launch-cm
1d00: 64 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 28 d test-run-dir (
1d10: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 configf:lookup t
1d20: 65 73 74 63 6f 6e 66 69 67 20 22 73 75 62 72 75 estconfig "subru
1d30: 6e 22 20 22 72 75 6e 77 61 69 74 22 29 29 29 29 n" "runwait"))))
1d40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
1d50: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
1d60: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
1d70: 70 6f 72 74 2a 20 22 53 75 62 72 75 6e 20 63 6f port* "Subrun co
1d80: 6d 6d 61 6e 64 20 69 73 20 5c 22 22 20 6d 74 2d mmand is \"" mt-
1d90: 63 6d 64 20 22 5c 22 22 29 0a 20 20 20 20 20 20 cmd "\"").
1da0: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 65 7a (set! ez
1db0: 73 74 65 70 73 20 23 74 29 20 3b 3b 20 73 65 74 steps #t) ;; set
1dc0: 20 74 68 65 20 6e 65 65 64 65 64 20 66 6c 61 67 the needed flag
1dd0: 0a 09 20 20 20 20 20 20 28 73 65 74 21 20 65 7a .. (set! ez
1de0: 73 74 65 70 73 6c 73 74 0a 20 20 20 20 20 20 20 stepslst.
1df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
1e00: 70 65 6e 64 20 28 6f 72 20 65 7a 73 74 65 70 73 pend (or ezsteps
1e10: 6c 73 74 20 27 28 29 29 0a 20 20 20 20 20 20 20 lst '()).
1e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e30: 20 20 20 20 20 28 6c 69 73 74 20 28 6c 69 73 74 (list (list
1e40: 20 22 73 75 62 72 75 6e 22 20 28 63 6f 6e 63 20 "subrun" (conc
1e50: 22 7b 73 75 62 72 75 6e 3d 74 72 75 65 7d 20 22 "{subrun=true} "
1e60: 20 6d 74 2d 63 6d 64 29 29 29 29 29 29 29 0a 0a mt-cmd)))))))..
1e70: 09 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 65 20 .;; process the
1e80: 65 7a 73 74 65 70 73 0a 09 28 69 66 20 65 7a 73 ezsteps..(if ezs
1e90: 74 65 70 73 0a 09 20 20 20 20 28 6c 65 74 2a 20 teps.. (let*
1ea0: 28 28 61 6c 6c 2d 73 74 65 70 73 2d 64 61 74 20 ((all-steps-dat
1eb0: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
1ec0: 29 29 29 20 3b 3b 20 6b 65 65 70 20 61 6c 6c 20 ))) ;; keep all
1ed0: 74 68 65 20 69 6e 66 6f 20 61 72 6f 75 6e 64 20 the info around
1ee0: 61 73 20 73 74 65 70 6e 61 6d 65 20 3d 3d 3e 20 as stepname ==>
1ef0: 61 6c 69 73 74 3b 20 77 68 65 72 65 20 20 27 70 alist; where 'p
1f00: 61 72 61 6d 73 20 69 73 20 74 68 65 20 70 61 72 arams is the par
1f10: 61 6d 73 20 6c 69 73 74 20 28 61 64 64 20 6f 74 ams list (add ot
1f20: 68 65 72 20 73 74 75 66 66 20 61 73 20 6e 65 65 her stuff as nee
1f30: 64 65 64 29 0a 09 20 20 20 20 20 20 28 69 66 20 ded).. (if
1f40: 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c (not (common:fil
1f50: 65 2d 65 78 69 73 74 73 3f 20 22 2e 65 7a 73 74 e-exists? ".ezst
1f60: 65 70 73 22 29 29 28 63 72 65 61 74 65 2d 64 69 eps"))(create-di
1f70: 72 65 63 74 6f 72 79 20 22 2e 65 7a 73 74 65 70 rectory ".ezstep
1f80: 73 22 29 29 0a 09 20 20 20 20 20 20 3b 3b 20 69 s")).. ;; i
1f90: 66 20 65 7a 73 74 65 70 73 20 77 61 73 20 64 65 f ezsteps was de
1fa0: 66 69 6e 65 64 20 74 68 65 6e 20 77 65 20 61 72 fined then we ar
1fb0: 65 20 73 75 72 65 20 74 6f 20 68 61 76 65 20 61 e sure to have a
1fc0: 74 20 6c 65 61 73 74 20 6f 6e 65 20 73 74 65 70 t least one step
1fd0: 20 62 75 74 20 63 68 65 63 6b 20 61 6e 79 77 61 but check anywa
1fe0: 79 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f y.. (if (no
1ff0: 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 65 7a 73 t (> (length ezs
2000: 74 65 70 73 6c 73 74 29 20 30 29 29 0a 09 09 20 tepslst) 0))...
2010: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
2020: 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
2030: 6f 67 2d 70 6f 72 74 2a 20 22 65 7a 73 74 65 70 og-port* "ezstep
2040: 73 20 64 65 66 69 6e 65 64 20 62 75 74 20 65 7a s defined but ez
2050: 73 74 65 70 73 6c 73 74 20 69 73 20 7a 65 72 6f stepslst is zero
2060: 20 6c 65 6e 67 74 68 22 29 0a 20 20 20 20 20 20 length").
2070: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
2080: 20 28 28 61 6c 6c 2d 73 74 65 70 2d 6e 61 6d 65 ((all-step-name
2090: 73 20 28 6d 61 70 20 63 61 72 20 65 7a 73 74 65 s (map car ezste
20a0: 70 73 6c 73 74 29 29 0a 20 20 20 20 20 20 20 20 pslst)).
20b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20c0: 28 73 74 61 74 75 73 2d 66 69 6c 65 20 28 66 69 (status-file (fi
20d0: 6c 65 2d 6f 70 65 6e 20 22 65 7a 73 74 65 70 73 le-open "ezsteps
20e0: 2e 73 74 61 74 75 73 22 20 28 2b 20 6f 70 65 6e .status" (+ open
20f0: 2f 61 70 70 65 6e 64 20 6f 70 65 6e 2f 77 72 6f /append open/wro
2100: 6e 6c 79 20 6f 70 65 6e 2f 63 72 65 61 74 29 29 nly open/creat))
2110: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2120: 20 20 20 20 20 20 20 20 20 20 29 0a 09 09 20 20 )...
2130: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 53 54 45 (setenv "MT_STE
2140: 50 5f 4e 41 4d 45 53 22 20 28 73 74 72 69 6e 67 P_NAMES" (string
2150: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 61 6c 6c -intersperse all
2160: 2d 73 74 65 70 2d 6e 61 6d 65 73 20 22 20 22 29 -step-names " ")
2170: 29 0a 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 )... (let loop
2180: 20 28 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 ((ezstep (car e
2190: 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 20 zstepslst))....
21a0: 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 64 72 (tal (cdr
21b0: 20 65 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 ezstepslst))...
21c0: 09 20 20 20 20 20 28 70 72 65 76 73 74 65 70 20 . (prevstep
21d0: 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f)).
21e0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
21f0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
2200: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
2210: 22 50 72 6f 63 65 73 73 69 6e 67 20 65 7a 73 74 "Processing ezst
2220: 65 70 20 5c 22 22 20 28 73 74 72 69 6e 67 2d 69 ep \"" (string-i
2230: 6e 74 65 72 73 70 65 72 73 65 20 65 7a 73 74 65 ntersperse ezste
2240: 70 20 22 20 22 29 20 22 5c 22 22 29 0a 09 09 20 p " ") "\"")...
2250: 20 20 20 3b 3b 20 63 68 65 63 6b 20 65 78 69 74 ;; check exit
2260: 2d 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 -info (vector-re
2270: 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 f exit-info 1)..
2280: 09 20 20 20 20 28 69 66 20 28 6c 61 75 6e 63 68 . (if (launch
2290: 3a 65 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 :einf-exit-statu
22a0: 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 3b 3b 20 s exit-info) ;;
22b0: 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 (vector-ref exit
22c0: 2d 69 6e 66 6f 20 31 29 0a 09 09 09 28 6c 65 74 -info 1)....(let
22d0: 2a 20 28 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 * ((logpro-used
22e0: 28 6c 61 75 6e 63 68 3a 72 75 6e 73 74 65 70 20 (launch:runstep
22f0: 65 7a 73 74 65 70 20 72 75 6e 2d 69 64 20 74 65 ezstep run-id te
2300: 73 74 2d 69 64 20 65 78 69 74 2d 69 6e 66 6f 20 st-id exit-info
2310: 6d 20 74 61 6c 20 74 65 73 74 63 6f 6e 66 69 67 m tal testconfig
2320: 20 61 6c 6c 2d 73 74 65 70 73 2d 64 61 74 29 29 all-steps-dat))
2330: 0a 09 09 09 20 20 20 20 20 20 20 28 73 74 65 70 .... (step
2340: 6e 61 6d 65 20 20 20 20 28 63 61 72 20 65 7a 73 name (car ezs
2350: 74 65 70 29 29 0a 09 09 09 20 20 20 20 20 20 20 tep))....
2360: 28 73 74 65 70 70 61 72 6d 73 20 20 20 28 68 61 (stepparms (ha
2370: 73 68 2d 74 61 62 6c 65 2d 72 65 66 20 61 6c 6c sh-table-ref all
2380: 2d 73 74 65 70 73 2d 64 61 74 20 73 74 65 70 6e -steps-dat stepn
2390: 61 6d 65 29 29 29 0a 09 09 09 20 20 28 73 65 74 ame))).... (set
23a0: 65 6e 76 20 22 4d 54 5f 53 54 45 50 5f 4e 41 4d env "MT_STEP_NAM
23b0: 45 22 20 73 74 65 70 6e 61 6d 65 29 0a 09 09 09 E" stepname)....
23c0: 20 20 28 70 70 20 28 68 61 73 68 2d 74 61 62 6c (pp (hash-tabl
23d0: 65 2d 3e 61 6c 69 73 74 20 61 6c 6c 2d 73 74 65 e->alist all-ste
23e0: 70 73 2d 64 61 74 29 29 0a 09 09 09 20 20 3b 3b ps-dat)).... ;;
23f0: 20 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 if logpro-used
2400: 72 65 61 64 20 69 6e 20 74 68 65 20 73 74 65 70 read in the step
2410: 6e 61 6d 65 2e 64 61 74 20 66 69 6c 65 0a 09 09 name.dat file...
2420: 09 20 20 28 69 66 20 28 61 6e 64 20 6c 6f 67 70 . (if (and logp
2430: 72 6f 2d 75 73 65 64 20 28 63 6f 6d 6d 6f 6e 3a ro-used (common:
2440: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f file-exists? (co
2450: 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 64 61 nc stepname ".da
2460: 74 22 29 29 29 0a 09 09 09 20 20 20 20 20 20 28 t"))).... (
2470: 6c 61 75 6e 63 68 3a 6c 6f 61 64 2d 6c 6f 67 70 launch:load-logp
2480: 72 6f 2d 64 61 74 20 72 75 6e 2d 69 64 20 74 65 ro-dat run-id te
2490: 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 29 29 st-id stepname))
24a0: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
24b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c (fil
24c0: 65 2d 77 72 69 74 65 20 73 74 61 74 75 73 2d 66 e-write status-f
24d0: 69 6c 65 20 28 63 6f 6e 63 20 73 74 65 70 6e 61 ile (conc stepna
24e0: 6d 65 20 22 20 22 20 28 6c 61 75 6e 63 68 3a 65 me " " (launch:e
24f0: 69 6e 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 inf-exit-code ex
2500: 69 74 2d 69 6e 66 6f 29 20 22 5c 6e 22 29 29 0a it-info) "\n")).
2510: 0a 09 09 09 20 20 28 69 66 20 28 73 74 65 70 72 .... (if (stepr
2520: 75 6e 2d 67 6f 6f 64 3f 20 6c 6f 67 70 72 6f 2d un-good? logpro-
2530: 75 73 65 64 20 28 6c 61 75 6e 63 68 3a 65 69 6e used (launch:ein
2540: 66 2d 65 78 69 74 2d 63 6f 64 65 20 65 78 69 74 f-exit-code exit
2550: 2d 69 6e 66 6f 29 20 73 74 65 70 70 61 72 6d 73 -info) stepparms
2560: 29 0a 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ).... (if (
2570: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
2580: 0a 09 09 09 09 20 20 28 6c 6f 6f 70 20 28 63 61 ..... (loop (ca
2590: 72 20 74 61 6c 29 20 28 63 64 72 20 74 61 6c 29 r tal) (cdr tal)
25a0: 20 73 74 65 70 6e 61 6d 65 29 29 0a 09 09 09 20 stepname))....
25b0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
25c0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
25d0: 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a -port* "WARNING:
25e0: 20 73 74 65 70 20 22 20 28 63 61 72 20 65 7a 73 step " (car ezs
25f0: 74 65 70 29 20 22 20 66 61 69 6c 65 64 2e 20 53 tep) " failed. S
2600: 74 6f 70 70 69 6e 67 22 29 29 29 0a 09 09 09 28 topping")))....(
2610: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
2620: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
2630: 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 "WARNING: a pri
2640: 6f 72 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 or step failed,
2650: 73 74 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a stopping at " ez
2660: 73 74 65 70 29 29 29 0a 20 20 20 20 20 20 20 20 step))).
2670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2680: 28 66 69 6c 65 2d 63 6c 6f 73 65 20 73 74 61 74 (file-close stat
2690: 75 73 2d 66 69 6c 65 29 0a 20 20 20 20 20 20 20 us-file).
26a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26b0: 20 29 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 )..
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 29 29 29 29 ))))
26d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 ))..(define (lau
26e0: 6e 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 nch:monitor-job
26f0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 69 run-id test-id i
2700: 74 65 6d 2d 70 61 74 68 20 66 75 6c 6c 72 75 6e tem-path fullrun
2710: 73 63 72 69 70 74 20 65 7a 73 74 65 70 73 20 74 script ezsteps t
2720: 65 73 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 est-name tconfig
2730: 72 65 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 20 reg exit-info m
2740: 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 74 6c 69 work-area runtli
2750: 6d 20 6d 69 73 63 2d 66 6c 61 67 73 29 0a 20 20 m misc-flags).
2760: 28 6c 65 74 2a 20 28 28 75 70 64 61 74 65 2d 70 (let* ((update-p
2770: 65 72 69 6f 64 20 28 73 74 72 69 6e 67 2d 3e 6e eriod (string->n
2780: 75 6d 62 65 72 20 28 6f 72 20 28 63 6f 6e 66 69 umber (or (confi
2790: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
27a0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 74 gdat* "setup" "t
27b0: 65 73 74 2d 73 74 61 74 73 2d 75 70 64 61 74 65 est-stats-update
27c0: 2d 70 65 72 69 6f 64 22 29 20 22 33 30 22 29 29 -period") "30"))
27d0: 29 0a 20 20 20 20 20 20 20 20 20 28 73 74 61 72 ). (star
27e0: 74 2d 73 65 63 6f 6e 64 73 20 28 63 75 72 72 65 t-seconds (curre
27f0: 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 20 28 nt-seconds)).. (
2800: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 20 20 28 6c calc-minutes (l
2810: 61 6d 62 64 61 20 28 29 0a 09 09 09 20 20 28 69 ambda ().... (i
2820: 6e 65 78 61 63 74 2d 3e 65 78 61 63 74 20 0a 09 nexact->exact ..
2830: 09 09 20 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 .. (round ....
2840: 20 20 20 20 28 2d 20 0a 09 09 09 20 20 20 20 20 (- ....
2850: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
2860: 29 20 0a 09 09 09 20 20 20 20 20 73 74 61 72 74 ) .... start
2870: 2d 73 65 63 6f 6e 64 73 29 29 29 29 29 0a 09 20 -seconds)))))..
2880: 28 6b 69 6c 6c 2d 74 72 69 65 73 20 30 29 29 0a (kill-tries 0)).
2890: 20 20 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 ;; (tests:se
28a0: 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f t-full-meta-info
28b0: 20 23 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d #f test-id run-
28c0: 69 64 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 id (calc-minutes
28d0: 29 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 ) work-area).
28e0: 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d 66 ;; (tests:set-f
28f0: 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 65 ull-meta-info te
2900: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 st-id run-id (ca
2910: 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b lc-minutes) work
2920: 2d 61 72 65 61 29 0a 20 20 20 20 28 74 65 73 74 -area). (test
2930: 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 61 2d s:set-full-meta-
2940: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
2950: 72 75 6e 2d 69 64 20 28 63 61 6c 63 2d 6d 69 6e run-id (calc-min
2960: 75 74 65 73 29 20 77 6f 72 6b 2d 61 72 65 61 20 utes) work-area
2970: 31 30 29 0a 0a 20 20 20 20 28 6c 65 74 20 6c 6f 10).. (let lo
2980: 6f 70 20 28 28 6d 69 6e 75 74 65 73 20 20 20 28 op ((minutes (
2990: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 0a 09 calc-minutes))..
29a0: 20 20 20 20 20 20 20 28 63 70 75 2d 6c 6f 61 64 (cpu-load
29b0: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 27 61 64 (alist-ref 'ad
29c0: 6a 2d 63 6f 72 65 2d 6c 6f 61 64 20 28 63 6f 6d j-core-load (com
29d0: 6d 6f 6e 3a 67 65 74 2d 6e 6f 72 6d 61 6c 69 7a mon:get-normaliz
29e0: 65 64 2d 63 70 75 2d 6c 6f 61 64 20 23 66 29 29 ed-cpu-load #f))
29f0: 29 0a 09 20 20 20 20 20 20 20 28 64 69 73 6b 2d ).. (disk-
2a00: 66 72 65 65 20 28 67 65 74 2d 64 66 20 28 63 75 free (get-df (cu
2a10: 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 79 29 rrent-directory)
2a20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2a30: 20 20 28 6c 61 73 74 2d 73 79 6e 63 20 28 63 75 (last-sync (cu
2a40: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 rrent-seconds)))
2a50: 0a 20 20 20 20 20 20 3b 3b 20 28 63 6f 6d 6d 6f . ;; (commo
2a60: 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 n:telemetry-log
2a70: 22 7a 6f 6d 62 69 65 22 20 28 63 6f 6e 63 20 22 "zombie" (conc "
2a80: 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a launch:monitor-j
2a90: 6f 62 20 2d 20 74 6f 70 20 6f 66 20 6c 6f 6f 70 ob - top of loop
2aa0: 20 65 6e 63 6f 75 6e 74 65 72 65 64 20 61 74 20 encountered at
2ab0: 22 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 "(current-second
2ac0: 73 29 22 20 77 69 74 68 20 6c 61 73 74 2d 73 79 s)" with last-sy
2ad0: 6e 63 3d 22 6c 61 73 74 2d 73 79 6e 63 29 29 0a nc="last-sync)).
2ae0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6f 76 (let* ((ov
2af0: 65 72 2d 74 69 6d 65 20 20 20 20 20 28 3e 20 28 er-time (> (
2b00: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
2b10: 20 28 2b 20 6c 61 73 74 2d 73 79 6e 63 20 75 70 (+ last-sync up
2b20: 64 61 74 65 2d 70 65 72 69 6f 64 29 29 29 0a 20 date-period))).
2b30: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 (new
2b40: 2d 63 70 75 2d 6c 6f 61 64 20 20 28 6c 65 74 2a -cpu-load (let*
2b50: 20 28 28 6c 6f 61 64 20 20 28 61 6c 69 73 74 2d ((load (alist-
2b60: 72 65 66 20 27 61 64 6a 2d 63 6f 72 65 2d 6c 6f ref 'adj-core-lo
2b70: 61 64 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6e ad (common:get-n
2b80: 6f 72 6d 61 6c 69 7a 65 64 2d 63 70 75 2d 6c 6f ormalized-cpu-lo
2b90: 61 64 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 ad #f))).
2ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 6c (del
2bc0: 74 61 20 28 61 62 73 20 28 2d 20 6c 6f 61 64 20 ta (abs (- load
2bd0: 63 70 75 2d 6c 6f 61 64 29 29 29 29 0a 20 20 20 cpu-load)))).
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bf0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
2c00: 3e 20 64 65 6c 74 61 20 30 2e 31 29 20 3b 3b 20 > delta 0.1) ;;
2c10: 64 6f 6e 27 74 20 62 6f 74 68 65 72 20 75 70 64 don't bother upd
2c20: 61 74 69 6e 67 20 77 69 74 68 20 73 6d 61 6c 6c ating with small
2c30: 20 63 68 61 6e 67 65 73 0a 20 20 20 20 20 20 20 changes.
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c50: 20 20 20 20 20 20 20 20 20 20 20 6c 6f 61 64 0a load.
2c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c80: 20 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 #f))).
2c90: 20 20 20 20 20 28 6e 65 77 2d 64 69 73 6b 2d 66 (new-disk-f
2ca0: 72 65 65 20 28 6c 65 74 2a 20 28 28 64 66 20 20 ree (let* ((df
2cb0: 20 20 28 69 66 20 6f 76 65 72 2d 74 69 6d 65 20 (if over-time
2cc0: 3b 3b 20 6f 6e 6c 79 20 67 65 74 20 64 66 20 65 ;; only get df e
2cd0: 76 65 72 79 20 33 30 20 73 65 63 6f 6e 64 73 0a very 30 seconds.
2ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 (g
2d10: 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d 64 et-df (current-d
2d20: 69 72 65 63 74 6f 72 79 29 29 0a 20 20 20 20 20 irectory)).
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 20 20
2d50: 20 20 20 20 20 20 20 20 20 64 69 73 6b 2d 66 72 disk-fr
2d60: 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ee)).
2d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d80: 20 20 20 20 20 20 20 20 28 64 65 6c 74 61 20 28 (delta (
2d90: 61 62 73 20 28 2d 20 64 66 20 64 69 73 6b 2d 66 abs (- df disk-f
2da0: 72 65 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 ree)))).
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
2dd0: 3e 20 64 66 20 30 29 0a 20 20 20 20 20 20 20 20 > df 0).
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 28 (
2e00: 3e 20 28 2f 20 64 65 6c 74 61 20 64 66 29 20 30 > (/ delta df) 0
2e10: 2e 31 29 29 20 3b 3b 20 28 3e 20 64 65 6c 74 61 .1)) ;; (> delta
2e20: 20 32 30 30 29 20 3b 3b 20 69 67 6e 6f 72 65 20 200) ;; ignore
2e30: 63 68 61 6e 67 65 73 20 75 6e 64 65 72 20 32 30 changes under 20
2e40: 30 20 4d 65 67 0a 20 20 20 20 20 20 20 20 20 20 0 Meg.
2e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e60: 20 20 20 20 20 20 20 20 64 66 0a 20 20 20 20 20 df.
2e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
2e90: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2ea0: 28 64 6f 2d 73 79 6e 63 20 20 20 20 20 20 20 28 (do-sync (
2eb0: 6f 72 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 or new-cpu-load
2ec0: 6e 65 77 2d 64 69 73 6b 2d 66 72 65 65 20 6f 76 new-disk-free ov
2ed0: 65 72 2d 74 69 6d 65 29 29 0a 0a 20 20 20 20 20 er-time))..
2ee0: 20 20 20 20 20 20 20 20 28 74 65 73 74 2d 69 6e (test-in
2ef0: 66 6f 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 fo (rmt:get-te
2f00: 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 st-info-by-id ru
2f10: 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 29 0a 20 n-id test-id)).
2f20: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
2f30: 74 65 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 te (db:tes
2f40: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test
2f50: 2d 69 6e 66 6f 29 29 0a 20 20 20 20 20 20 20 20 -info)).
2f60: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 (status
2f70: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
2f80: 74 61 74 75 73 20 74 65 73 74 2d 69 6e 66 6f 29 tatus test-info)
2f90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
2fa0: 6b 69 6c 6c 2d 72 65 61 73 6f 6e 20 20 22 6e 6f kill-reason "no
2fb0: 20 6b 69 6c 6c 20 72 65 61 73 6f 6e 20 73 70 65 kill reason spe
2fc0: 63 69 66 69 65 64 22 29 0a 20 20 20 20 20 20 20 cified").
2fd0: 20 20 20 20 20 20 28 6b 69 6c 6c 2d 6a 6f 62 3f (kill-job?
2fe0: 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 20 #f)).
2ff0: 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 74 65 6c 65 ;; (common:tele
3000: 6d 65 74 72 79 2d 6c 6f 67 20 22 7a 6f 6d 62 69 metry-log "zombi
3010: 65 22 20 28 63 6f 6e 63 20 22 6c 61 75 6e 63 68 e" (conc "launch
3020: 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 2d 20 64 :monitor-job - d
3030: 65 63 69 73 69 6f 6e 20 74 69 6d 65 20 65 6e 63 ecision time enc
3040: 6f 75 6e 74 65 72 65 64 20 61 74 20 22 28 63 75 ountered at "(cu
3050: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 22 20 rrent-seconds)"
3060: 77 69 74 68 20 6c 61 73 74 2d 73 79 6e 63 3d 22 with last-sync="
3070: 6c 61 73 74 2d 73 79 6e 63 22 20 64 6f 2d 73 79 last-sync" do-sy
3080: 6e 63 3d 22 64 6f 2d 73 79 6e 63 22 20 6f 76 65 nc="do-sync" ove
3090: 72 2d 74 69 6d 65 3d 22 6f 76 65 72 2d 74 69 6d r-time="over-tim
30a0: 65 22 20 75 70 64 61 74 65 2d 70 65 72 69 6f 64 e" update-period
30b0: 3d 22 75 70 64 61 74 65 2d 70 65 72 69 6f 64 29 ="update-period)
30c0: 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a ). (cond.
30d0: 20 20 20 20 20 20 20 20 20 28 28 74 65 73 74 2d ((test-
30e0: 67 65 74 2d 6b 69 6c 6c 2d 72 65 71 75 65 73 74 get-kill-request
30f0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
3100: 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 . (set!
3110: 20 6b 69 6c 6c 2d 72 65 61 73 6f 6e 20 22 4b 49 kill-reason "KI
3120: 4c 4c 49 4e 47 20 54 45 53 54 20 73 69 6e 63 65 LLING TEST since
3130: 20 72 65 63 65 69 76 65 64 20 6b 69 6c 6c 20 72 received kill r
3140: 65 71 75 65 73 74 20 28 4b 49 4c 4c 52 45 51 29 equest (KILLREQ)
3150: 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 "). (se
3160: 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 74 29 t! kill-job? #t)
3170: 29 0a 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 ). ((and
3180: 20 72 75 6e 74 6c 69 6d 20 28 3e 20 28 2d 20 28 runtlim (> (- (
3190: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
31a0: 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 20 start-seconds)
31b0: 72 75 6e 74 6c 69 6d 29 29 0a 20 20 20 20 20 20 runtlim)).
31c0: 20 20 20 20 28 73 65 74 21 20 6b 69 6c 6c 2d 72 (set! kill-r
31d0: 65 61 73 6f 6e 20 28 63 6f 6e 63 20 22 4b 49 4c eason (conc "KIL
31e0: 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 54 4f LING TEST DUE TO
31f0: 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 45 TIME LIMIT EXCE
3200: 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 20 EDED! Runtime="
3210: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
3220: 6e 64 73 29 20 73 74 61 72 74 2d 73 65 63 6f 6e nds) start-secon
3230: 64 73 29 20 22 20 73 65 63 6f 6e 64 73 2c 20 6c ds) " seconds, l
3240: 69 6d 69 74 3d 22 20 72 75 6e 74 6c 69 6d 29 29 imit=" runtlim))
3250: 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 . (set!
3260: 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 74 29 29 0a kill-job? #t)).
3270: 20 20 20 20 20 20 20 20 20 28 28 65 71 75 61 6c ((equal
3280: 3f 20 73 74 61 74 75 73 20 22 44 45 41 44 22 29 ? status "DEAD")
3290: 0a 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 . (test
32a0: 73 3a 75 70 64 61 74 65 2d 63 65 6e 74 72 61 6c s:update-central
32b0: 2d 6d 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d 69 -meta-info run-i
32c0: 64 20 74 65 73 74 2d 69 64 20 6e 65 77 2d 63 70 d test-id new-cp
32d0: 75 2d 6c 6f 61 64 20 6e 65 77 2d 64 69 73 6b 2d u-load new-disk-
32e0: 66 72 65 65 20 28 63 61 6c 63 2d 6d 69 6e 75 74 free (calc-minut
32f0: 65 73 29 20 23 66 20 23 66 29 0a 20 20 20 20 20 es) #f #f).
3300: 20 20 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 (rmt:set-st
3310: 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 ate-status-and-r
3320: 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e oll-up-items run
3330: 2d 69 64 20 74 65 73 74 2d 69 64 20 27 66 6f 6f -id test-id 'foo
3340: 20 22 52 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 "RUNNING" "n/a"
3350: 20 22 77 61 73 20 6d 61 72 6b 65 64 20 64 65 61 "was marked dea
3360: 64 3b 20 72 65 61 6c 6c 79 20 73 74 69 6c 6c 20 d; really still
3370: 72 75 6e 6e 69 6e 67 2e 22 29 0a 20 20 20 20 20 running.").
3380: 20 20 20 20 20 3b 3b 28 73 65 74 21 20 6b 69 6c ;;(set! kil
3390: 6c 2d 72 65 61 73 6f 6e 20 22 4b 49 4c 4c 49 4e l-reason "KILLIN
33a0: 47 20 54 45 53 54 20 62 65 63 61 75 73 65 20 69 G TEST because i
33b0: 74 20 77 61 73 20 6d 61 72 6b 65 64 20 61 73 20 t was marked as
33c0: 44 45 41 44 20 62 79 20 6c 61 75 6e 63 68 3a 68 DEAD by launch:h
33d0: 61 6e 64 6c 65 2d 7a 6f 6d 62 69 65 2d 74 65 73 andle-zombie-tes
33e0: 74 73 20 28 6d 69 67 68 74 20 69 6e 64 69 63 61 ts (might indica
33f0: 74 65 20 72 65 61 6c 6c 79 20 6f 76 65 72 6c 6f te really overlo
3400: 61 64 65 64 20 73 65 72 76 65 72 20 6f 72 20 65 aded server or e
3410: 6c 73 65 20 6f 76 65 72 7a 65 61 6c 6f 75 73 20 lse overzealous
3420: 73 65 74 75 70 2e 64 65 61 64 74 69 6d 65 29 22 setup.deadtime)"
3430: 29 20 3b 3b 20 4d 41 52 4b 20 52 55 4e 4e 49 4e ) ;; MARK RUNNIN
3440: 47 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 G. (set
3450: 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 23 66 29 29 ! kill-job? #f))
3460: 29 0a 0a 20 20 20 20 20 20 20 20 28 64 65 62 75 ).. (debu
3470: 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 75 g:print 4 *defau
3480: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 63 70 lt-log-port* "cp
3490: 75 3a 20 22 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 u: " new-cpu-loa
34a0: 64 20 22 20 64 69 73 6b 3a 20 22 20 6e 65 77 2d d " disk: " new-
34b0: 64 69 73 6b 2d 66 72 65 65 20 22 20 6c 61 73 74 disk-free " last
34c0: 2d 73 79 6e 63 3a 20 22 20 6c 61 73 74 2d 73 79 -sync: " last-sy
34d0: 6e 63 20 22 20 64 6f 2d 73 79 6e 63 3a 20 22 20 nc " do-sync: "
34e0: 64 6f 2d 73 79 6e 63 29 0a 20 20 20 20 20 20 20 do-sync).
34f0: 20 28 6c 61 75 6e 63 68 3a 68 61 6e 64 6c 65 2d (launch:handle-
3500: 7a 6f 6d 62 69 65 2d 74 65 73 74 73 20 72 75 6e zombie-tests run
3510: 2d 69 64 29 0a 20 20 20 20 20 20 20 20 28 77 68 -id). (wh
3520: 65 6e 20 64 6f 2d 73 79 6e 63 0a 20 20 20 20 20 en do-sync.
3530: 20 20 20 20 20 3b 3b 28 77 69 74 68 2d 6f 75 74 ;;(with-out
3540: 70 75 74 2d 74 6f 2d 66 69 6c 65 20 28 63 6f 6e put-to-file (con
3550: 63 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 54 45 c (getenv "MT_TE
3560: 53 54 5f 52 55 4e 5f 44 49 52 22 29 20 22 2f 6c ST_RUN_DIR") "/l
3570: 61 73 74 2d 6c 6f 61 64 69 6e 66 6f 2e 6c 6f 67 ast-loadinfo.log
3580: 22 20 23 3a 61 70 70 65 6e 64 29 0a 20 20 20 20 " #:append).
3590: 20 20 20 20 20 20 3b 3b 20 20 28 6c 61 6d 62 64 ;; (lambd
35a0: 61 20 28 29 20 28 70 70 20 28 6c 69 73 74 20 28 a () (pp (list (
35b0: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
35c0: 20 6e 65 77 2d 63 70 75 2d 6c 6f 61 64 20 6e 65 new-cpu-load ne
35d0: 77 2d 64 69 73 6b 2d 66 72 65 65 20 28 63 61 6c w-disk-free (cal
35e0: 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 29 0a 20 c-minutes))))).
35f0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 63 6f 6d ;; (com
3600: 6d 6f 6e 3a 74 65 6c 65 6d 65 74 72 79 2d 6c 6f mon:telemetry-lo
3610: 67 20 22 7a 6f 6d 62 69 65 22 20 28 63 6f 6e 63 g "zombie" (conc
3620: 20 20 22 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f "launch:monito
3630: 72 2d 6a 6f 62 20 2d 20 64 6f 73 79 6e 63 20 73 r-job - dosync s
3640: 74 61 72 74 65 64 20 61 74 20 22 28 63 75 72 72 tarted at "(curr
3650: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 0a 20 ent-seconds))).
3660: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 73 3a (tests:
3670: 75 70 64 61 74 65 2d 63 65 6e 74 72 61 6c 2d 6d update-central-m
3680: 65 74 61 2d 69 6e 66 6f 20 72 75 6e 2d 69 64 20 eta-info run-id
3690: 74 65 73 74 2d 69 64 20 6e 65 77 2d 63 70 75 2d test-id new-cpu-
36a0: 6c 6f 61 64 20 6e 65 77 2d 64 69 73 6b 2d 66 72 load new-disk-fr
36b0: 65 65 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 ee (calc-minutes
36c0: 29 20 23 66 20 23 66 29 0a 20 20 20 20 20 20 20 ) #f #f).
36d0: 20 20 20 3b 3b 20 28 63 6f 6d 6d 6f 6e 3a 74 65 ;; (common:te
36e0: 6c 65 6d 65 74 72 79 2d 6c 6f 67 20 22 7a 6f 6d lemetry-log "zom
36f0: 62 69 65 22 20 28 63 6f 6e 63 20 22 6c 61 75 6e bie" (conc "laun
3700: 63 68 3a 6d 6f 6e 69 74 6f 72 2d 6a 6f 62 20 2d ch:monitor-job -
3710: 20 64 6f 73 79 6e 63 20 66 69 6e 69 73 68 65 64 dosync finished
3720: 20 61 74 20 22 28 63 75 72 72 65 6e 74 2d 73 65 at "(current-se
3730: 63 6f 6e 64 73 29 29 29 0a 09 20 20 29 0a 20 20 conds))).. ).
3740: 20 20 20 20 20 20 0a 09 28 69 66 20 6b 69 6c 6c ..(if kill
3750: 2d 6a 6f 62 3f 20 0a 09 20 20 20 20 28 62 65 67 -job? .. (beg
3760: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
3770: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
3780: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
3790: 67 2d 70 6f 72 74 2a 20 22 70 72 6f 63 65 65 64 g-port* "proceed
37a0: 69 6e 67 20 74 6f 20 6b 69 6c 6c 20 74 65 73 74 ing to kill test
37b0: 3a 20 22 6b 69 6c 6c 2d 72 65 61 73 6f 6e 29 0a : "kill-reason).
37c0: 09 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f . (mutex-lo
37d0: 63 6b 21 20 6d 29 0a 09 20 20 20 20 20 20 3b 3b ck! m).. ;;
37e0: 20 4e 4f 54 45 3a 20 54 68 65 20 70 69 64 20 63 NOTE: The pid c
37f0: 61 6e 20 63 68 61 6e 67 65 20 61 73 20 64 69 66 an change as dif
3800: 66 65 72 65 6e 74 20 73 74 65 70 73 20 61 72 65 ferent steps are
3810: 20 72 75 6e 2e 20 44 6f 20 77 65 20 6e 65 65 64 run. Do we need
3820: 20 68 61 6e 64 73 68 61 6b 69 6e 67 20 62 65 74 handshaking bet
3830: 77 65 65 6e 20 74 68 69 73 0a 09 20 20 20 20 20 ween this..
3840: 20 3b 3b 20 20 20 20 20 20 20 73 65 63 74 69 6f ;; sectio
3850: 6e 20 61 6e 64 20 74 68 65 20 72 75 6e 69 74 20 n and the runit
3860: 73 65 63 74 69 6f 6e 3f 20 4f 72 20 61 64 64 20 section? Or add
3870: 61 20 6c 6f 6f 70 20 74 68 61 74 20 74 72 69 65 a loop that trie
3880: 73 20 74 68 72 65 65 20 74 69 6d 65 73 20 77 69 s three times wi
3890: 74 68 20 61 20 31 2f 34 20 73 65 63 6f 6e 64 0a th a 1/4 second.
38a0: 09 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 . ;;
38b0: 62 65 74 77 65 65 6e 20 74 72 69 65 73 3f 0a 09 between tries?..
38c0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 70 69 (let* ((pi
38d0: 64 31 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d d1 (launch:einf-
38e0: 70 69 64 20 65 78 69 74 2d 69 6e 66 6f 29 29 20 pid exit-info))
38f0: 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 ;; (vector-ref e
3900: 78 69 74 2d 69 6e 66 6f 20 30 29 29 0a 09 09 20 xit-info 0))...
3910: 20 20 20 20 28 70 69 64 32 20 28 72 6d 74 3a 74 (pid2 (rmt:t
3920: 65 73 74 2d 67 65 74 2d 74 6f 70 2d 70 72 6f 63 est-get-top-proc
3930: 65 73 73 2d 70 69 64 20 72 75 6e 2d 69 64 20 74 ess-pid run-id t
3940: 65 73 74 2d 69 64 29 29 0a 09 09 20 20 20 20 20 est-id))...
3950: 28 70 69 64 73 20 28 64 65 6c 65 74 65 2d 64 75 (pids (delete-du
3960: 70 6c 69 63 61 74 65 73 20 28 66 69 6c 74 65 72 plicates (filter
3970: 20 6e 75 6d 62 65 72 3f 20 28 6c 69 73 74 20 70 number? (list p
3980: 69 64 31 20 70 69 64 32 29 29 29 29 29 0a 09 09 id1 pid2)))))...
3990: 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 (if (not (null?
39a0: 70 69 64 73 29 29 0a 09 09 20 20 20 20 28 62 65 pids))... (be
39b0: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 66 6f 72 gin... (for
39c0: 2d 65 61 63 68 0a 09 09 20 20 20 20 20 20 20 28 -each... (
39d0: 6c 61 6d 62 64 61 20 28 70 69 64 29 0a 09 09 09 lambda (pid)....
39e0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
39f0: 6f 6e 73 0a 09 09 09 20 20 65 78 6e 0a 09 09 09 ons.... exn....
3a00: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 (begin....
3a10: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3a20: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
3a30: 2d 70 6f 72 74 2a 20 22 55 6e 61 62 6c 65 20 74 -port* "Unable t
3a40: 6f 20 6b 69 6c 6c 20 70 72 6f 63 65 73 73 20 77 o kill process w
3a50: 69 74 68 20 70 69 64 20 22 20 70 69 64 20 22 2c ith pid " pid ",
3a60: 20 70 6f 73 73 69 62 6c 79 20 61 6c 72 65 61 64 possibly alread
3a70: 79 20 6b 69 6c 6c 65 64 2e 22 29 0a 09 09 09 20 y killed.")....
3a80: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
3a90: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
3aa0: 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 ort* " message:
3ab0: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
3ac0: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
3ad0: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
3ae0: 78 6e 29 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e xn) ", exn=" exn
3af0: 29 29 0a 09 09 09 20 20 28 64 65 62 75 67 3a 70 )).... (debug:p
3b00: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
3b10: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
3b20: 4e 47 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 NG: Request rece
3b30: 69 76 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 ived to kill job
3b40: 20 22 20 70 69 64 29 20 3b 3b 20 20 22 20 28 61 " pid) ;; " (a
3b50: 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d ttempt # " kill-
3b60: 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 20 20 tries ")")....
3b70: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
3b80: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
3b90: 2d 70 6f 72 74 2a 20 22 53 69 67 6e 61 6c 20 6d -port* "Signal m
3ba0: 61 73 6b 3d 22 20 28 73 69 67 6e 61 6c 2d 6d 61 ask=" (signal-ma
3bb0: 73 6b 29 29 0a 09 09 09 20 20 3b 3b 20 28 69 66 sk)).... ;; (if
3bc0: 20 28 70 72 6f 63 65 73 73 3a 61 6c 69 76 65 3f (process:alive?
3bd0: 20 70 69 64 29 0a 09 09 09 20 20 3b 3b 20 20 20 pid).... ;;
3be0: 20 20 28 62 65 67 69 6e 0a 09 09 09 20 20 28 6d (begin.... (m
3bf0: 61 70 20 28 6c 61 6d 62 64 61 20 28 70 69 64 2d ap (lambda (pid-
3c00: 6e 75 6d 29 0a 09 09 09 09 20 28 70 72 6f 63 65 num)..... (proce
3c10: 73 73 2d 73 69 67 6e 61 6c 20 70 69 64 2d 6e 75 ss-signal pid-nu
3c20: 6d 20 73 69 67 6e 61 6c 2f 74 65 72 6d 29 29 0a m signal/term)).
3c30: 09 09 09 20 20 20 20 20 20 20 28 70 72 6f 63 65 ... (proce
3c40: 73 73 3a 67 65 74 2d 73 75 62 2d 70 69 64 73 20 ss:get-sub-pids
3c50: 70 69 64 29 29 0a 09 09 09 20 20 28 74 68 72 65 pid)).... (thre
3c60: 61 64 2d 73 6c 65 65 70 21 20 35 29 0a 09 09 09 ad-sleep! 5)....
3c70: 20 20 3b 3b 20 28 69 66 20 28 70 72 6f 63 65 73 ;; (if (proces
3c80: 73 3a 70 72 6f 63 65 73 73 2d 61 6c 69 76 65 3f s:process-alive?
3c90: 20 70 69 64 29 0a 09 09 09 20 20 28 6d 61 70 20 pid).... (map
3ca0: 28 6c 61 6d 62 64 61 20 28 70 69 64 2d 6e 75 6d (lambda (pid-num
3cb0: 29 0a 09 09 09 09 20 28 68 61 6e 64 6c 65 2d 65 )..... (handle-e
3cc0: 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 09 20 20 xceptions.....
3cd0: 20 20 20 65 78 6e 0a 09 09 09 09 20 20 20 28 62 exn..... (b
3ce0: 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 28 64 egin..... (d
3cf0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
3d00: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
3d10: 22 20 2e 2e 2e 2e 20 68 61 64 20 74 72 6f 75 62 " .... had troub
3d20: 6c 65 20 73 65 6e 64 69 6e 67 20 6b 69 6c 6c 20 le sending kill
3d30: 74 6f 20 22 20 70 69 64 2d 6e 75 6d 20 22 2c 20 to " pid-num ",
3d40: 65 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 09 20 exn=" exn).....
3d50: 20 20 20 20 23 66 29 0a 09 09 09 09 20 20 20 28 #f)..... (
3d60: 70 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 70 process-signal p
3d70: 69 64 2d 6e 75 6d 20 73 69 67 6e 61 6c 2f 6b 69 id-num signal/ki
3d80: 6c 6c 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 ll)))....
3d90: 28 70 72 6f 63 65 73 73 3a 67 65 74 2d 73 75 62 (process:get-sub
3da0: 2d 70 69 64 73 20 70 69 64 29 29 29 29 0a 09 09 -pids pid))))...
3db0: 20 20 20 20 20 20 20 3b 3b 20 20 20 20 28 64 65 ;; (de
3dc0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 bug:print-info 0
3dd0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
3de0: 72 74 2a 20 22 6e 6f 74 20 6b 69 6c 6c 69 6e 67 rt* "not killing
3df0: 20 70 72 6f 63 65 73 73 20 22 20 70 69 64 20 22 process " pid "
3e00: 20 61 73 20 69 74 20 69 73 20 6e 6f 74 20 61 6c as it is not al
3e10: 69 76 65 22 29 29 29 29 0a 09 09 20 20 20 20 20 ive"))))...
3e20: 20 20 70 69 64 73 29 0a 20 20 20 20 20 20 20 20 pids).
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
3e40: 20 42 42 3a 20 71 75 65 73 74 69 6f 6e 20 74 6f BB: question to
3e50: 20 4d 61 74 74 20 2d 2d 20 64 6f 65 73 20 74 68 Matt -- does th
3e60: 65 20 74 65 73 74 73 3a 74 65 73 74 2d 73 74 61 e tests:test-sta
3e70: 74 65 2d 73 74 61 74 75 73 21 20 65 6e 63 6f 6d te-status! encom
3e80: 70 61 73 73 20 72 6f 6c 6c 75 70 20 74 6f 20 74 pass rollup to t
3e90: 6f 70 6c 65 76 65 6c 3f 20 20 49 66 20 6e 6f 74 oplevel? If not
3ea0: 2c 20 73 68 6f 75 6c 64 20 69 74 3f 0a 09 09 20 , should it?...
3eb0: 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 (tests:test
3ec0: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 6e -set-status! run
3ed0: 2d 69 64 20 74 65 73 74 2d 69 64 20 22 4b 49 4c -id test-id "KIL
3ee0: 4c 45 44 22 20 20 22 4b 49 4c 4c 45 44 22 20 28 LED" "KILLED" (
3ef0: 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 74 2d 61 conc (args:get-a
3f00: 72 67 20 22 2d 6d 22 29 22 20 22 6b 69 6c 6c 2d rg "-m")" "kill-
3f10: 72 65 61 73 6f 6e 29 20 23 66 29 29 20 3b 3b 20 reason) #f)) ;;
3f20: 42 42 20 41 44 44 45 44 20 6b 69 6c 6c 2d 72 65 BB ADDED kill-re
3f30: 61 73 6f 6e 20 2d 2d 20 63 6f 6e 66 69 72 6d 20 ason -- confirm
3f40: 4f 4b 20 77 69 74 68 20 4d 61 74 74 0a 09 09 20 OK with Matt...
3f50: 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 20 (begin...
3f60: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 (debug:print-e
3f70: 72 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d rror 0 *default-
3f80: 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 74 68 69 log-port* "Nothi
3f90: 6e 67 20 74 6f 20 6b 69 6c 6c 2c 20 70 69 64 31 ng to kill, pid1
3fa0: 3d 22 20 70 69 64 31 20 22 2c 20 70 69 64 32 3d =" pid1 ", pid2=
3fb0: 22 20 70 69 64 32 29 0a 09 09 20 20 20 20 20 20 " pid2)...
3fc0: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
3fd0: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
3fe0: 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 est-id "KILLED"
3ff0: 20 22 46 41 49 4c 45 44 20 54 4f 20 4b 49 4c 4c "FAILED TO KILL
4000: 22 20 28 63 6f 6e 63 20 28 61 72 67 73 3a 67 65 " (conc (args:ge
4010: 74 2d 61 72 67 20 22 2d 6d 22 29 22 20 22 6b 69 t-arg "-m")" "ki
4020: 6c 6c 2d 72 65 61 73 6f 6e 29 20 23 66 29 20 3b ll-reason) #f) ;
4030: 3b 20 42 42 20 41 44 44 45 44 20 6b 69 6c 6c 2d ; BB ADDED kill-
4040: 72 65 61 73 6f 6e 20 2d 2d 20 63 6f 6e 66 69 72 reason -- confir
4050: 6d 20 4f 4b 20 77 69 74 68 20 4d 61 74 74 0a 09 m OK with Matt..
4060: 09 20 20 20 20 20 20 29 29 29 0a 09 20 20 20 20 . )))..
4070: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
4080: 20 6d 29 0a 09 20 20 20 20 20 20 3b 3b 20 6e 6f m).. ;; no
4090: 20 70 6f 69 6e 74 20 69 6e 20 73 74 69 63 6b 69 point in sticki
40a0: 6e 67 20 61 72 6f 75 6e 64 2e 20 45 78 69 74 20 ng around. Exit
40b0: 6e 6f 77 2e 20 42 75 74 20 72 75 6e 20 65 6e 64 now. But run end
40c0: 20 6f 66 20 72 75 6e 20 62 65 66 6f 72 65 20 65 of run before e
40d0: 78 69 74 69 6e 67 3f 0a 20 20 20 20 20 20 20 20 xiting?.
40e0: 28 6c 61 75 6e 63 68 3a 65 6e 64 2d 6f 66 2d 72 (launch:end-of-r
40f0: 75 6e 2d 63 68 65 63 6b 20 72 75 6e 2d 69 64 29 un-check run-id)
4100: 0a 09 20 20 20 20 20 20 28 65 78 69 74 29 29 29 .. (exit)))
4110: 0a 09 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c ..(if (hash-tabl
4120: 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 e-ref/default mi
4130: 73 63 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 sc-flags 'keep-g
4140: 6f 69 6e 67 20 23 66 29 0a 09 20 20 20 20 28 62 oing #f).. (b
4150: 65 67 69 6e 0a 09 20 20 20 20 20 20 28 74 68 72 egin.. (thr
4160: 65 61 64 2d 73 6c 65 65 70 21 20 33 29 20 3b 3b ead-sleep! 3) ;;
4170: 20 28 2b 20 33 20 28 72 61 6e 64 6f 6d 20 36 29 (+ 3 (random 6)
4180: 29 29 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a )) ;; add some j
4190: 69 74 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c itter to the cal
41a0: 6c 20 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 l home time to s
41b0: 70 72 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 pread out the db
41c0: 20 61 63 63 65 73 73 65 73 0a 09 20 20 20 20 20 accesses..
41d0: 20 28 69 66 20 28 68 61 73 68 2d 74 61 62 6c 65 (if (hash-table
41e0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6d 69 73 -ref/default mis
41f0: 63 2d 66 6c 61 67 73 20 27 6b 65 65 70 2d 67 6f c-flags 'keep-go
4200: 69 6e 67 20 23 66 29 20 20 3b 3b 20 6b 65 65 70 ing #f) ;; keep
4210: 20 6f 72 69 67 69 6e 61 6c 73 20 66 6f 72 20 63 originals for c
4220: 70 75 2d 6c 6f 61 64 20 61 6e 64 20 64 69 73 6b pu-load and disk
4230: 2d 66 72 65 65 20 75 6e 6c 65 73 73 20 74 68 65 -free unless the
4240: 79 20 63 68 61 6e 67 65 20 6d 6f 72 65 20 74 68 y change more th
4250: 61 6e 20 74 68 65 20 61 6c 6c 6f 77 65 64 20 64 an the allowed d
4260: 65 6c 74 61 0a 09 09 20 20 28 6c 6f 6f 70 20 28 elta... (loop (
4270: 63 61 6c 63 2d 6d 69 6e 75 74 65 73 29 0a 20 20 calc-minutes).
4280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4290: 20 20 20 20 20 20 28 6f 72 20 6e 65 77 2d 63 70 (or new-cp
42a0: 75 2d 6c 6f 61 64 20 63 70 75 2d 6c 6f 61 64 29 u-load cpu-load)
42b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
42c0: 20 20 20 20 20 20 20 20 20 28 6f 72 20 6e 65 77 (or new
42d0: 2d 64 69 73 6b 2d 66 72 65 65 20 64 69 73 6b 2d -disk-free disk-
42e0: 66 72 65 65 29 0a 20 20 20 20 20 20 20 20 20 20 free).
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
4300: 66 20 64 6f 2d 73 79 6e 63 20 28 63 75 72 72 65 f do-sync (curre
4310: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 6c 61 73 74 nt-seconds) last
4320: 2d 73 79 6e 63 29 29 29 29 29 29 29 0a 20 20 20 -sync))))))).
4330: 20 28 74 65 73 74 73 3a 75 70 64 61 74 65 2d 63 (tests:update-c
4340: 65 6e 74 72 61 6c 2d 6d 65 74 61 2d 69 6e 66 6f entral-meta-info
4350: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
4360: 28 67 65 74 2d 63 70 75 2d 6c 6f 61 64 29 20 28 (get-cpu-load) (
4370: 67 65 74 2d 64 66 20 28 63 75 72 72 65 6e 74 2d get-df (current-
4380: 64 69 72 65 63 74 6f 72 79 29 29 28 63 61 6c 63 directory))(calc
4390: 2d 6d 69 6e 75 74 65 73 29 20 23 66 20 23 66 29 -minutes) #f #f)
43a0: 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 43 68 65 63 )) ;; NOTE: Chec
43b0: 6b 69 6e 67 20 74 77 69 63 65 20 66 6f 72 20 6b king twice for k
43c0: 65 65 70 2d 67 6f 69 6e 67 20 69 73 20 69 6e 74 eep-going is int
43d0: 65 6e 74 69 6f 6e 61 6c 0a 0a 0a 28 64 65 66 69 entional...(defi
43e0: 6e 65 20 28 6c 61 75 6e 63 68 3a 65 78 65 63 75 ne (launch:execu
43f0: 74 65 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a te encoded-cmd).
4400: 20 20 28 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 (let* ((cmdinf
4410: 6f 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 o (common:rea
4420: 64 2d 65 6e 63 6f 64 65 64 2d 73 74 72 69 6e 67 d-encoded-string
4430: 20 65 6e 63 6f 64 65 64 2d 63 6d 64 29 29 0a 09 encoded-cmd))..
4440: 20 28 74 63 6f 6e 66 69 67 72 65 67 20 23 66 29 (tconfigreg #f)
4450: 29 0a 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d ). (setenv "M
4460: 54 5f 43 4d 44 49 4e 46 4f 22 20 65 6e 63 6f 64 T_CMDINFO" encod
4470: 65 64 2d 63 6d 64 29 0a 20 20 20 20 3b 3b 28 62 ed-cmd). ;;(b
4480: 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 b-check-path msg
4490: 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 : "launch:execut
44a0: 65 20 69 6e 63 6f 6d 69 6e 67 22 29 0a 20 20 20 e incoming").
44b0: 20 28 69 66 20 28 6c 69 73 74 3f 20 63 6d 64 69 (if (list? cmdi
44c0: 6e 66 6f 29 20 3b 3b 20 28 28 74 65 73 74 70 61 nfo) ;; ((testpa
44d0: 74 68 20 2f 74 6d 70 2f 6d 72 77 65 6c 6c 61 6e th /tmp/mrwellan
44e0: 2f 6a 61 7a 7a 6d 69 6e 64 2f 73 72 63 2f 65 78 /jazzmind/src/ex
44f0: 61 6d 70 6c 65 5f 72 75 6e 2f 74 65 73 74 73 2f ample_run/tests/
4500: 73 71 6c 69 74 65 73 70 65 65 64 29 0a 09 3b 3b sqlitespeed)..;;
4510: 20 28 74 65 73 74 2d 6e 61 6d 65 20 73 71 6c 69 (test-name sqli
4520: 74 65 73 70 65 65 64 29 20 28 72 75 6e 73 63 72 tespeed) (runscr
4530: 69 70 74 20 72 75 6e 73 63 72 69 70 74 2e 72 62 ipt runscript.rb
4540: 29 20 28 64 62 2d 68 6f 73 74 20 6c 6f 63 61 6c ) (db-host local
4550: 68 6f 73 74 29 20 28 72 75 6e 2d 69 64 20 31 29 host) (run-id 1)
4560: 29 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 70 )..(let* ((testp
4570: 61 74 68 20 20 28 61 73 73 6f 63 2f 64 65 66 61 ath (assoc/defa
4580: 75 6c 74 20 27 74 65 73 74 70 61 74 68 20 20 63 ult 'testpath c
4590: 6d 64 69 6e 66 6f 29 29 20 20 3b 3b 20 74 65 73 mdinfo)) ;; tes
45a0: 74 70 61 74 68 20 69 73 20 74 68 65 20 74 65 73 tpath is the tes
45b0: 74 20 73 70 65 63 20 61 72 65 61 0a 09 20 20 20 t spec area..
45c0: 20 20 20 20 28 74 6f 70 2d 70 61 74 68 20 20 28 (top-path (
45d0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
45e0: 6f 70 70 61 74 68 20 20 20 63 6d 64 69 6e 66 6f oppath cmdinfo
45f0: 29 29 0a 09 20 20 20 20 20 20 20 28 77 6f 72 6b )).. (work
4600: 2d 61 72 65 61 20 28 61 73 73 6f 63 2f 64 65 66 -area (assoc/def
4610: 61 75 6c 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 ault 'work-area
4620: 63 6d 64 69 6e 66 6f 29 29 20 20 3b 3b 20 77 6f cmdinfo)) ;; wo
4630: 72 6b 2d 61 72 65 61 20 69 73 20 74 68 65 20 74 rk-area is the t
4640: 65 73 74 20 72 75 6e 20 61 72 65 61 0a 09 20 20 est run area..
4650: 20 20 20 20 20 28 74 65 73 74 2d 6e 61 6d 65 20 (test-name
4660: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
4670: 74 65 73 74 2d 6e 61 6d 65 20 63 6d 64 69 6e 66 test-name cmdinf
4680: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 72 75 6e o)).. (run
4690: 73 63 72 69 70 74 20 28 61 73 73 6f 63 2f 64 65 script (assoc/de
46a0: 66 61 75 6c 74 20 27 72 75 6e 73 63 72 69 70 74 fault 'runscript
46b0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
46c0: 20 20 20 28 65 7a 73 74 65 70 73 20 20 20 28 61 (ezsteps (a
46d0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 65 7a ssoc/default 'ez
46e0: 73 74 65 70 73 20 20 20 63 6d 64 69 6e 66 6f 29 steps cmdinfo)
46f0: 29 0a 09 20 20 20 20 20 20 20 28 73 75 62 72 75 ).. (subru
4700: 6e 20 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 n (assoc/defa
4710: 75 6c 74 20 27 73 75 62 72 75 6e 20 20 20 20 63 ult 'subrun c
4720: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
4730: 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 65 20 28 ;; (runremote (
4740: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
4750: 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 6e 66 6f unremote cmdinfo
4760: 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 74 )).. ;; (t
4770: 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
4780: 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
4790: 72 74 20 63 6d 64 69 6e 66 6f 29 29 20 20 3b 3b rt cmdinfo)) ;;
47a0: 20 6e 6f 74 20 75 73 65 64 0a 09 20 20 20 20 20 not used..
47b0: 20 20 3b 3b 20 28 73 65 72 76 65 72 69 6e 66 20 ;; (serverinf
47c0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
47d0: 73 65 72 76 65 72 69 6e 66 20 63 6d 64 69 6e 66 serverinf cmdinf
47e0: 6f 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 o)).. ;; (
47f0: 70 6f 72 74 20 20 20 20 20 20 28 61 73 73 6f 63 port (assoc
4800: 2f 64 65 66 61 75 6c 74 20 27 70 6f 72 74 20 20 /default 'port
4810: 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 cmdinfo))..
4820: 20 20 20 20 20 20 28 73 65 72 76 65 72 75 72 6c (serverurl
4830: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
4840: 27 73 65 72 76 65 72 75 72 6c 20 63 6d 64 69 6e 'serverurl cmdin
4850: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 68 6f fo)).. (ho
4860: 6d 65 68 6f 73 74 20 20 28 61 73 73 6f 63 2f 64 mehost (assoc/d
4870: 65 66 61 75 6c 74 20 27 68 6f 6d 65 68 6f 73 74 efault 'homehost
4880: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
4890: 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 (run-id (
48a0: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 assoc/default 'r
48b0: 75 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f un-id cmdinfo
48c0: 29 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 )).. (test
48d0: 2d 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 -id (assoc/def
48e0: 61 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 ault 'test-id
48f0: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
4900: 20 20 28 74 61 72 67 65 74 20 20 20 20 28 61 73 (target (as
4910: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 72 soc/default 'tar
4920: 67 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 get cmdinfo))
4930: 0a 09 20 20 20 20 20 20 20 28 61 72 65 61 6e 61 .. (areana
4940: 6d 65 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 me (assoc/defau
4950: 6c 74 20 27 61 72 65 61 6e 61 6d 65 20 20 63 6d lt 'areaname cm
4960: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
4970: 28 69 74 65 6d 64 61 74 20 20 20 28 61 73 73 6f (itemdat (asso
4980: 63 2f 64 65 66 61 75 6c 74 20 27 69 74 65 6d 64 c/default 'itemd
4990: 61 74 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 at cmdinfo))..
49a0: 20 20 20 20 20 20 20 28 65 6e 76 2d 6f 76 72 64 (env-ovrd
49b0: 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 (assoc/default
49c0: 20 27 65 6e 76 2d 6f 76 72 64 20 20 63 6d 64 69 'env-ovrd cmdi
49d0: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 73 nfo)).. (s
49e0: 65 74 2d 76 61 72 73 20 20 28 61 73 73 6f 63 2f et-vars (assoc/
49f0: 64 65 66 61 75 6c 74 20 27 73 65 74 2d 76 61 72 default 'set-var
4a00: 73 20 20 63 6d 64 69 6e 66 6f 29 29 20 3b 3b 20 s cmdinfo)) ;;
4a10: 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 66 72 pre-overrides fr
4a20: 6f 6d 20 2d 73 65 74 76 61 72 0a 09 20 20 20 20 om -setvar..
4a30: 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 28 61 (runname (a
4a40: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
4a50: 6e 6e 61 6d 65 20 20 20 63 6d 64 69 6e 66 6f 29 nname cmdinfo)
4a60: 29 0a 09 20 20 20 20 20 20 20 28 6d 65 67 61 74 ).. (megat
4a70: 65 73 74 20 20 28 61 73 73 6f 63 2f 64 65 66 61 est (assoc/defa
4a80: 75 6c 74 20 27 6d 65 67 61 74 65 73 74 20 20 63 ult 'megatest c
4a90: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
4aa0: 20 28 72 75 6e 74 6c 69 6d 20 20 20 28 61 73 73 (runtlim (ass
4ab0: 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 6e 74 oc/default 'runt
4ac0: 6c 69 6d 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a lim cmdinfo)).
4ad0: 09 20 20 20 20 20 20 20 28 63 6f 6e 74 6f 75 72 . (contour
4ae0: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
4af0: 74 20 27 63 6f 6e 74 6f 75 72 20 20 20 63 6d 64 t 'contour cmd
4b00: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
4b10: 69 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d item-path (item-
4b20: 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 list->path itemd
4b30: 61 74 29 29 0a 09 20 20 20 20 20 20 20 28 6d 74 at)).. (mt
4b40: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 61 73 -bindir-path (as
4b50: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 74 2d soc/default 'mt-
4b60: 62 69 6e 64 69 72 2d 70 61 74 68 20 63 6d 64 69 bindir-path cmdi
4b70: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 6b nfo)).. (k
4b80: 65 79 73 20 20 20 20 20 20 23 66 29 0a 09 20 20 eys #f)..
4b90: 20 20 20 20 20 28 6b 65 79 76 61 6c 73 20 20 20 (keyvals
4ba0: 23 66 29 0a 09 20 20 20 20 20 20 20 28 66 75 6c #f).. (ful
4bb0: 6c 72 75 6e 73 63 72 69 70 74 20 28 69 66 20 28 lrunscript (if (
4bc0: 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 29 0a 20 not runscript).
4bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bf0: 20 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f.
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c10: 20 20 20 20 20 20 28 69 66 20 28 73 75 62 73 74 (if (subst
4c20: 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f 22 20 72 ring-index "/" r
4c30: 75 6e 73 63 72 69 70 74 29 0a 20 20 20 20 20 20 unscript).
4c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c60: 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 75 73 65 runscript ;; use
4c70: 20 75 6e 61 64 75 6c 74 65 72 65 64 20 69 66 20 unadultered if
4c80: 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 68 65 73 contains slashes
4c90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cb0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 75 (let ((fu
4cc0: 6c 6c 6e 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 lln (conc work-a
4cd0: 72 65 61 20 22 2f 22 20 72 75 6e 73 63 72 69 70 rea "/" runscrip
4ce0: 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 20 20 t)))..
4cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d00: 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
4d10: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
4d20: 69 73 74 73 3f 20 66 75 6c 6c 6e 29 0a 20 20 20 ists? fulln).
4d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d60: 28 66 69 6c 65 2d 65 78 65 63 75 74 65 2d 61 63 (file-execute-ac
4d70: 63 65 73 73 3f 20 66 75 6c 6c 6e 29 29 0a 20 20 cess? fulln)).
4d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4da0: 20 20 20 20 20 20 20 20 20 20 20 20 66 75 6c 6c full
4db0: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
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 20 20 20 20 20
4de0: 72 75 6e 73 63 72 69 70 74 29 29 29 29 29 20 3b runscript))))) ;
4df0: 3b 20 61 73 73 75 6d 65 20 69 74 20 69 73 20 6f ; assume it is o
4e00: 6e 20 74 68 65 20 70 61 74 68 0a 20 20 20 20 20 n the path.
4e10: 20 20 20 20 20 20 20 20 20 20 28 63 68 65 63 6b (check
4e20: 2d 77 6f 72 6b 2d 61 72 65 61 20 20 20 20 20 20 -work-area
4e30: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
4e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e60: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e ;; N
4e70: 46 53 20 6d 69 67 68 74 20 6e 6f 74 20 68 61 76 FS might not hav
4e80: 65 20 70 72 6f 70 61 67 61 74 65 64 20 74 68 65 e propagated the
4e90: 20 64 69 72 65 63 74 6f 72 79 20 6d 65 74 61 20 directory meta
4ea0: 64 61 74 61 20 74 6f 20 74 68 65 20 72 75 6e 20 data to the run
4eb0: 68 6f 73 74 20 2d 20 67 69 76 65 20 69 74 20 74 host - give it t
4ec0: 69 6d 65 20 69 66 20 6e 65 65 64 65 64 0a 20 20 ime if needed.
4ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ef0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c (let l
4f00: 6f 6f 70 20 28 28 63 6f 75 6e 74 20 30 29 29 0a oop ((count 0)).
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 20 20 20 20 20 20 20 20 20
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
4f40: 66 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a 64 69 f (or (common:di
4f50: 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f 20 rectory-exists?
4f60: 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 20 work-area).
4f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fa0: 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a 20 (> count 10)).
4fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
4ff0: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 ry work-area).
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5030: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
5040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5060: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
5070: 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 g:print 0 *defau
5080: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e lt-log-port* "IN
5090: 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e 67 FO: Not starting
50a0: 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 72 65 63 job yet - direc
50b0: 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 61 tory " work-area
50c0: 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a 20 " not found").
50d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5100: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
5110: 21 20 31 30 29 0a 20 20 20 20 20 20 20 20 20 20 ! 10).
5120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6c 6f 6f 70 20 (loop
5150: 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 29 0a (+ count 1))))).
5160: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5180: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
5190: 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3d 3f 20 (not (string=?
51a0: 20 28 63 6f 6d 6d 6f 6e 3a 72 65 61 6c 2d 70 61 (common:real-pa
51b0: 74 68 20 77 6f 72 6b 2d 61 72 65 61 29 28 63 6f th work-area)(co
51c0: 6d 6d 6f 6e 3a 72 65 61 6c 2d 70 61 74 68 20 28 mmon:real-path (
51d0: 63 75 72 72 65 6e 74 2d 64 69 72 65 63 74 6f 72 current-director
51e0: 79 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 y)))).
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5210: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5250: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
5260: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
5270: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5290: 20 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: 22 49 4e 46 4f 3a 20 77 65 20 61 72 65 20 65 78 "INFO: we are ex
52c0: 70 65 63 74 69 6e 67 20 74 6f 20 62 65 20 69 6e pecting to be in
52d0: 20 64 69 72 65 63 74 6f 72 79 20 22 20 77 6f 72 directory " wor
52e0: 6b 2d 61 72 65 61 20 22 5c 6e 22 0a 20 20 20 20 k-area "\n".
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 20 20 20 20 20 20 20 20
5310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5320: 20 20 20 20 20 20 20 20 20 20 20 22 20 20 20 20 "
5330: 20 62 75 74 20 77 65 20 61 72 65 20 61 63 74 75 but we are actu
5340: 61 6c 6c 79 20 69 6e 20 74 68 65 20 64 69 72 65 ally in the dire
5350: 63 74 6f 72 79 20 22 20 28 63 75 72 72 65 6e 74 ctory " (current
5360: 2d 64 69 72 65 63 74 6f 72 79 29 20 22 5c 6e 22 -directory) "\n"
5370: 0a 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 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53b0: 22 20 20 20 20 20 64 6f 69 6e 67 20 61 6e 6f 74 " doing anot
53c0: 68 65 72 20 63 68 61 6e 67 65 20 64 69 72 2e 22 her change dir."
53d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
53e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5400: 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 (change-dire
5410: 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 ctory work-area)
5420: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0a .
5450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5470: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 ;; s
5480: 70 6f 74 20 63 68 65 63 6b 20 74 68 61 74 20 74 pot check that t
5490: 68 65 20 66 69 6c 65 73 20 69 6e 20 74 65 73 74 he files in test
54a0: 70 61 74 68 20 61 72 65 20 61 76 61 69 6c 61 62 path are availab
54b0: 6c 65 2e 20 54 6f 6f 20 6f 66 74 65 6e 20 4e 46 le. Too often NF
54c0: 53 20 64 65 6c 61 79 73 20 63 61 75 73 65 20 70 S delays cause p
54d0: 72 6f 62 6c 65 6d 73 20 68 65 72 65 2e 0a 20 20 roblems here..
54e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6c 65 74 20 28 (let (
5510: 28 66 69 6c 65 73 20 20 20 20 20 20 28 67 6c 6f (files (glo
5520: 62 20 28 63 6f 6e 63 20 74 65 73 74 70 61 74 68 b (conc testpath
5530: 20 22 2f 2a 22 29 29 29 0a 20 20 20 20 20 20 20 "/*"))).
5540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 62 61 64 2d (bad-
5570: 66 69 6c 65 73 20 27 28 29 29 29 0a 20 20 20 20 files '())).
5580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55a0: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 (for-e
55b0: 61 63 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 ach.
55c0: 20 20 20 20 20 20 20 20 20 20 20 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 28 6c 61 6d 62 64 61 20 28 66 75 6c 6c (lambda (full
55f0: 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 name).
5600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5620: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 66 (let* ((f
5630: 6e 61 6d 65 20 28 70 61 74 68 6e 61 6d 65 2d 73 name (pathname-s
5640: 74 72 69 70 2d 64 69 72 65 63 74 6f 72 79 20 66 trip-directory f
5650: 75 6c 6c 6e 61 6d 65 29 29 0a 20 20 20 20 20 20 ullname)).
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 20 20 20 20 20 20 20 20 20 20 20
5690: 20 20 28 74 61 72 67 6e 20 28 63 6f 6e 63 20 77 (targn (conc w
56a0: 6f 72 6b 2d 61 72 65 61 20 22 2f 22 20 66 6e 61 ork-area "/" fna
56b0: 6d 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 me))).
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 20 20 20 28 69 66 20 28 6e 6f (if (no
56f0: 74 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 t (file-exists?
5700: 74 61 72 67 6e 29 29 0a 20 20 20 20 20 20 20 20 targn)).
5710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5740: 73 65 74 21 20 62 61 64 2d 66 69 6c 65 73 20 28 set! bad-files (
5750: 63 6f 6e 73 20 66 6e 61 6d 65 20 62 61 64 2d 66 cons fname bad-f
5760: 69 6c 65 73 29 29 29 29 29 0a 20 20 20 20 20 20 iles))))).
5770: 20 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 66 69 6c 65 73 29 0a files).
57a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
57d0: 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 62 61 f (not (null? ba
57e0: 64 2d 66 69 6c 65 73 29 29 0a 20 20 20 20 20 20 d-files)).
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 20 20 20
5810: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
5820: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
5830: 20 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 28 64 65 62 75 67 3a 70 72 (debug:pr
5860: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
5870: 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 og-port* "INFO:
5880: 74 65 73 74 20 64 61 74 61 20 66 72 6f 6d 20 22 test data from "
5890: 20 74 65 73 74 70 61 74 68 20 22 20 6e 6f 74 20 testpath " not
58a0: 63 6f 70 69 65 64 20 70 72 6f 70 65 72 6c 79 20 copied properly
58b0: 6f 72 20 66 69 6c 65 73 79 73 74 65 6d 20 70 72 or filesystem pr
58c0: 6f 62 6c 65 6d 73 20 63 61 75 73 69 6e 67 20 64 oblems causing d
58d0: 61 74 61 20 74 6f 20 6e 6f 74 20 62 65 20 66 6f ata to not be fo
58e0: 75 6e 64 2e 20 52 65 2d 72 75 6e 6e 69 6e 67 20 und. Re-running
58f0: 74 68 65 20 63 6f 70 79 20 63 6f 6d 6d 61 6e 64 the copy command
5900: 2e 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 .").
5910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 64 65 62 75 67 3a 70 (debug:p
5940: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
5950: 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 4e 46 4f 3a log-port* "INFO:
5960: 20 6d 69 73 73 69 6e 67 20 66 69 6c 65 73 20 66 missing files f
5970: 72 6f 6d 20 22 20 77 6f 72 6b 2d 61 72 65 61 20 rom " work-area
5980: 22 3a 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 ": " (string-int
5990: 65 72 73 70 65 72 73 65 20 62 61 64 2d 66 69 6c ersperse bad-fil
59a0: 65 73 20 22 2c 20 22 29 29 0a 20 20 20 20 20 20 es ", ")).
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 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
59e0: 61 75 6e 63 68 3a 74 65 73 74 2d 63 6f 70 79 20 aunch:test-copy
59f0: 74 65 73 74 70 61 74 68 20 77 6f 72 6b 2d 61 72 testpath work-ar
5a00: 65 61 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ea)))).
5a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a30: 20 20 20 3b 3b 20 6f 6e 65 20 6d 6f 72 65 20 74 ;; one more t
5a40: 69 6d 65 2c 20 63 68 61 6e 67 65 20 74 6f 20 74 ime, change to t
5a50: 68 65 20 77 6f 72 6b 2d 61 72 65 61 20 64 69 72 he work-area dir
5a60: 65 63 74 6f 72 79 0a 20 20 20 20 20 20 20 20 20 ectory.
5a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a90: 20 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 (change-direc
5aa0: 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 29 tory work-area))
5ab0: 29 0a 09 20 20 20 20 20 20 20 29 20 3b 3b 20 6c ).. ) ;; l
5ac0: 65 74 2a 0a 0a 09 20 20 28 69 66 20 63 6f 6e 74 et*... (if cont
5ad0: 6f 75 72 20 28 73 65 74 65 6e 76 20 22 4d 54 5f our (setenv "MT_
5ae0: 43 4f 4e 54 4f 55 52 22 20 63 6f 6e 74 6f 75 72 CONTOUR" contour
5af0: 29 29 0a 09 20 20 0a 09 20 20 3b 3b 20 69 6d 6d )).. .. ;; imm
5b00: 65 64 69 61 74 65 64 20 73 65 74 20 73 6f 6d 65 ediated set some
5b10: 20 6b 65 79 20 76 61 72 69 61 62 6c 65 73 20 66 key variables f
5b20: 72 6f 6d 20 43 4d 44 49 4e 46 4f 20 64 61 74 61 rom CMDINFO data
5b30: 2c 20 79 65 73 2c 20 74 68 65 73 65 20 77 69 6c , yes, these wil
5b40: 6c 20 62 65 20 73 65 74 20 61 67 61 69 6e 20 62 l be set again b
5b50: 65 6c 6f 77 20 2e 2e 2e 0a 09 20 20 3b 3b 0a 09 elow ..... ;;..
5b60: 20 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 (setenv "MT_TE
5b70: 53 54 53 55 49 54 45 4e 41 4d 45 22 20 61 72 65 STSUITENAME" are
5b80: 61 6e 61 6d 65 29 0a 09 20 20 28 73 65 74 65 6e aname).. (seten
5b90: 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 v "MT_RUN_AREA_H
5ba0: 4f 4d 45 22 20 74 6f 70 2d 70 61 74 68 29 0a 09 OME" top-path)..
5bb0: 20 20 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 (set! *toppath
5bc0: 2a 20 74 6f 70 2d 70 61 74 68 29 0a 20 20 20 20 * top-path).
5bd0: 20 20 20 20 20 20 28 63 68 61 6e 67 65 2d 64 69 (change-di
5be0: 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 68 rectory *toppath
5bf0: 2a 29 20 3b 3b 20 74 65 6d 70 6f 72 61 72 69 6c *) ;; temporaril
5c00: 79 20 73 77 69 74 63 68 20 74 6f 20 74 68 65 20 y switch to the
5c10: 72 75 6e 20 61 72 65 61 20 68 6f 6d 65 0a 09 20 run area home..
5c20: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 (setenv "MT_TES
5c30: 54 5f 52 55 4e 5f 44 49 52 22 20 20 77 6f 72 6b T_RUN_DIR" work
5c40: 2d 61 72 65 61 29 0a 0a 09 20 20 28 6c 61 75 6e -area)... (laun
5c50: 63 68 3a 73 65 74 75 70 29 20 3b 3b 20 73 68 6f ch:setup) ;; sho
5c60: 75 6c 64 20 62 65 20 70 72 6f 70 65 72 6c 79 20 uld be properly
5c70: 69 6e 20 74 68 65 20 72 75 6e 20 61 72 65 61 20 in the run area
5c80: 68 6f 6d 65 20 6e 6f 77 0a 0a 09 20 20 28 69 66 home now... (if
5c90: 20 63 6f 6e 74 6f 75 72 20 28 73 65 74 65 6e 76 contour (setenv
5ca0: 20 22 4d 54 5f 43 4f 4e 54 4f 55 52 22 20 63 6f "MT_CONTOUR" co
5cb0: 6e 74 6f 75 72 29 29 0a 09 20 20 0a 09 20 20 3b ntour)).. .. ;
5cc0: 3b 20 69 6d 6d 65 64 69 61 74 65 64 20 73 65 74 ; immediated set
5cd0: 20 73 6f 6d 65 20 6b 65 79 20 76 61 72 69 61 62 some key variab
5ce0: 6c 65 73 20 66 72 6f 6d 20 43 4d 44 49 4e 46 4f les from CMDINFO
5cf0: 20 64 61 74 61 2c 20 79 65 73 2c 20 74 68 65 73 data, yes, thes
5d00: 65 20 77 69 6c 6c 20 62 65 20 73 65 74 20 61 67 e will be set ag
5d10: 61 69 6e 20 62 65 6c 6f 77 20 2e 2e 2e 0a 09 20 ain below .....
5d20: 20 3b 3b 0a 09 20 20 28 73 65 74 65 6e 76 20 22 ;;.. (setenv "
5d30: 4d 54 5f 54 45 53 54 53 55 49 54 45 4e 41 4d 45 MT_TESTSUITENAME
5d40: 22 20 61 72 65 61 6e 61 6d 65 29 0a 09 20 20 28 " areaname).. (
5d50: 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 setenv "MT_RUN_A
5d60: 52 45 41 5f 48 4f 4d 45 22 20 74 6f 70 2d 70 61 REA_HOME" top-pa
5d70: 74 68 29 0a 09 20 20 28 73 65 74 21 20 2a 74 6f th).. (set! *to
5d80: 70 70 61 74 68 2a 20 74 6f 70 2d 70 61 74 68 29 ppath* top-path)
5d90: 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 61 6e . (chan
5da0: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f ge-directory *to
5db0: 70 70 61 74 68 2a 29 20 3b 3b 20 74 65 6d 70 6f ppath*) ;; tempo
5dc0: 72 61 72 69 6c 79 20 73 77 69 74 63 68 20 74 6f rarily switch to
5dd0: 20 74 68 65 20 72 75 6e 20 61 72 65 61 20 68 6f the run area ho
5de0: 6d 65 0a 09 20 20 28 73 65 74 65 6e 76 20 22 4d me.. (setenv "M
5df0: 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 T_TEST_RUN_DIR"
5e00: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 0a 09 20 20 work-area)...
5e10: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 20 3b (launch:setup) ;
5e20: 3b 20 73 68 6f 75 6c 64 20 62 65 20 70 72 6f 70 ; should be prop
5e30: 65 72 6c 79 20 69 6e 20 74 68 65 20 72 75 6e 20 erly in the run
5e40: 61 72 65 61 20 68 6f 6d 65 20 6e 6f 77 0a 20 20 area home now.
5e50: 20 20 20 20 20 20 20 20 0a 09 20 20 28 73 65 74 .. (set
5e60: 21 20 74 63 6f 6e 66 69 67 72 65 67 20 28 74 65 ! tconfigreg (te
5e70: 73 74 73 3a 67 65 74 2d 61 6c 6c 29 29 20 3b 3b sts:get-all)) ;;
5e80: 20 6d 61 70 70 69 6e 67 20 6f 66 20 74 65 73 74 mapping of test
5e90: 6e 61 6d 65 20 3d 3e 20 74 65 73 74 20 73 6f 75 name => test sou
5ea0: 72 63 65 20 70 61 74 68 0a 09 20 20 28 6c 65 74 rce path.. (let
5eb0: 20 28 28 73 69 67 68 61 6e 64 20 28 6c 61 6d 62 ((sighand (lamb
5ec0: 64 61 20 28 73 69 67 6e 75 6d 29 0a 09 09 09 20 da (signum)....
5ed0: 20 20 3b 3b 20 28 73 69 67 6e 61 6c 2d 6d 61 73 ;; (signal-mas
5ee0: 6b 21 20 73 69 67 6e 75 6d 29 20 3b 3b 20 74 6f k! signum) ;; to
5ef0: 20 6d 61 73 6b 20 6f 72 20 6e 6f 74 3f 20 73 65 mask or not? se
5f00: 65 6d 73 20 74 6f 20 63 61 75 73 65 20 69 73 73 ems to cause iss
5f10: 75 65 73 20 69 6e 20 65 78 69 74 69 6e 67 0a 09 ues in exiting..
5f20: 09 09 20 20 20 28 69 66 20 28 65 71 3f 20 73 69 .. (if (eq? si
5f30: 67 6e 75 6d 20 73 69 67 6e 61 6c 2f 73 74 6f 70 gnum signal/stop
5f40: 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 65 62 ).... (deb
5f50: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
5f60: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
5f70: 72 74 2a 20 22 61 74 74 65 6d 70 74 20 74 6f 20 rt* "attempt to
5f80: 53 54 4f 50 20 70 72 6f 63 65 73 73 2e 20 45 78 STOP process. Ex
5f90: 69 74 69 6e 67 2e 22 29 29 0a 09 09 09 20 20 20 iting."))....
5fa0: 28 73 65 74 21 20 2a 74 69 6d 65 2d 74 6f 2d 65 (set! *time-to-e
5fb0: 78 69 74 2a 20 23 74 29 0a 09 09 09 20 20 20 28 xit* #t).... (
5fc0: 70 72 69 6e 74 20 22 52 65 63 65 69 76 65 64 20 print "Received
5fd0: 73 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 signal " signum
5fe0: 22 2c 20 63 6c 65 61 6e 69 6e 67 20 75 70 20 62 ", cleaning up b
5ff0: 65 66 6f 72 65 20 65 78 69 74 20 28 73 65 74 20 efore exit (set
6000: 74 68 69 73 20 74 65 73 74 20 74 6f 20 43 4f 4d this test to COM
6010: 50 4c 45 54 45 44 2f 41 42 4f 52 54 29 20 2e 20 PLETED/ABORT) .
6020: 50 6c 65 61 73 65 20 77 61 69 74 2e 2e 2e 22 29 Please wait...")
6030: 0a 09 09 09 20 20 20 28 6c 65 74 20 28 28 74 68 .... (let ((th
6040: 31 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 1 (make-thread (
6050: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
6060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6090: 70 72 69 6e 74 20 22 73 65 74 20 74 65 73 74 20 print "set test
60a0: 74 6f 20 43 4f 4d 50 4c 45 54 45 44 2f 41 42 4f to COMPLETED/ABO
60b0: 52 54 20 62 65 67 69 6e 2e 22 29 0a 09 09 09 09 RT begin.").....
60c0: 09 09 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 .. (rmt:test
60d0: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
60e0: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 s run-id test-id
60f0: 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 41 42 "COMPLETED" "AB
6100: 4f 52 54 22 20 22 72 65 63 65 69 76 65 64 20 6b ORT" "received k
6110: 69 6c 6c 20 73 69 67 6e 61 6c 22 29 0a 20 20 20 ill signal").
6120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6150: 20 20 28 70 72 69 6e 74 20 22 73 65 74 20 74 65 (print "set te
6160: 73 74 20 74 6f 20 43 4f 4d 50 4c 45 54 45 44 2f st to COMPLETED/
6170: 41 42 4f 52 54 20 63 6f 6d 70 6c 65 74 65 2e 22 ABORT complete."
6180: 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 70 72 )....... (pr
6190: 69 6e 74 20 22 4b 69 6c 6c 65 64 20 62 79 20 73 int "Killed by s
61a0: 69 67 6e 61 6c 20 22 20 73 69 67 6e 75 6d 20 22 ignal " signum "
61b0: 2e 20 45 78 69 74 69 6e 67 22 29 0a 09 09 09 09 . Exiting").....
61c0: 09 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
61d0: 29 29 0a 09 09 09 09 20 28 74 68 32 20 28 6d 61 ))..... (th2 (ma
61e0: 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 ke-thread (lambd
61f0: 61 20 28 29 0a 09 09 09 09 09 09 20 20 20 20 20 a ().......
6200: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 32 (thread-sleep! 2
6210: 30 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 64 0)....... (d
6220: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
6230: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6240: 22 44 6f 6e 65 22 29 0a 09 09 09 09 09 09 20 20 "Done").......
6250: 20 20 20 28 65 78 69 74 20 34 29 29 29 29 29 0a (exit 4))))).
6260: 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 2d ... (thread-
6270: 73 74 61 72 74 21 20 74 68 32 29 0a 09 09 09 20 start! th2)....
6280: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
6290: 74 21 20 74 68 31 29 0a 09 09 09 20 20 20 20 20 t! th1)....
62a0: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
62b0: 32 29 29 29 29 29 0a 09 20 20 20 20 28 73 65 74 2))))).. (set
62c0: 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 -signal-handler!
62d0: 20 73 69 67 6e 61 6c 2f 69 6e 74 20 73 69 67 68 signal/int sigh
62e0: 61 6e 64 29 0a 09 20 20 20 20 28 73 65 74 2d 73 and).. (set-s
62f0: 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 72 21 20 73 ignal-handler! s
6300: 69 67 6e 61 6c 2f 74 65 72 6d 20 73 69 67 68 61 ignal/term sigha
6310: 6e 64 29 0a 09 20 20 20 20 29 20 3b 3b 20 28 73 nd).. ) ;; (s
6320: 65 74 2d 73 69 67 6e 61 6c 2d 68 61 6e 64 6c 65 et-signal-handle
6330: 72 21 20 73 69 67 6e 61 6c 2f 73 74 6f 70 20 73 r! signal/stop s
6340: 69 67 68 61 6e 64 29 0a 09 20 20 0a 09 20 20 3b ighand).. .. ;
6350: 3b 20 44 6f 20 6e 6f 74 20 72 75 6e 20 74 68 65 ; Do not run the
6360: 20 74 65 73 74 20 69 66 20 69 74 20 69 73 20 52 test if it is R
6370: 45 4d 4f 56 49 4e 47 2c 20 52 55 4e 4e 49 4e 47 EMOVING, RUNNING
6380: 2c 20 4b 49 4c 4c 52 45 51 20 6f 72 20 52 45 4d , KILLREQ or REM
6390: 4f 54 45 48 4f 53 54 53 54 41 52 54 2c 0a 09 20 OTEHOSTSTART,..
63a0: 20 3b 3b 20 4d 61 72 6b 20 74 68 65 20 74 65 73 ;; Mark the tes
63b0: 74 20 61 73 20 52 45 4d 4f 54 45 48 4f 53 54 53 t as REMOTEHOSTS
63c0: 54 41 52 54 20 2a 49 4d 4d 45 44 49 41 54 45 4c TART *IMMEDIATEL
63d0: 59 2a 0a 09 20 20 3b 3b 0a 09 20 20 28 6c 65 74 Y*.. ;;.. (let
63e0: 2a 20 28 28 74 65 73 74 2d 69 6e 66 6f 20 28 6c * ((test-info (l
63f0: 65 74 20 6c 6f 6f 70 20 28 28 74 72 69 65 73 20 et loop ((tries
6400: 30 29 29 0a 09 09 09 20 20 20 20 20 20 28 6c 65 0)).... (le
6410: 74 20 28 28 74 69 6e 66 6f 20 28 72 6d 74 3a 67 t ((tinfo (rmt:g
6420: 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d et-test-info-by-
6430: 69 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 id run-id test-i
6440: 64 29 29 29 0a 09 09 09 09 28 69 66 20 74 69 6e d))).....(if tin
6450: 66 6f 0a 09 09 09 09 20 20 20 20 74 69 6e 66 6f fo..... tinfo
6460: 0a 09 09 09 09 20 20 20 20 28 69 66 20 28 3e 20 ..... (if (>
6470: 74 72 69 65 73 20 35 29 0a 09 09 09 09 09 23 66 tries 5)......#f
6480: 0a 09 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ......(begin....
6490: 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 .. (thread-slee
64a0: 70 21 20 28 2b 20 31 20 28 2a 20 74 72 69 65 73 p! (+ 1 (* tries
64b0: 20 31 30 29 29 29 0a 09 09 09 09 09 20 20 28 6c 10)))...... (l
64c0: 6f 6f 70 20 28 2b 20 74 72 69 65 73 20 31 29 29 oop (+ tries 1))
64d0: 29 29 29 29 29 29 0a 09 09 20 28 74 65 73 74 2d ))))))... (test-
64e0: 68 6f 73 74 20 28 69 66 20 74 65 73 74 2d 69 6e host (if test-in
64f0: 66 6f 0a 09 09 09 09 28 64 62 3a 74 65 73 74 2d fo.....(db:test-
6500: 67 65 74 2d 68 6f 73 74 20 20 20 20 20 20 20 20 get-host
6510: 74 65 73 74 2d 69 6e 66 6f 29 0a 09 09 09 09 28 test-info).....(
6520: 62 65 67 69 6e 0a 09 09 09 09 20 20 28 64 65 62 begin..... (deb
6530: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
6540: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 45 ult-log-port* "E
6550: 52 52 4f 52 3a 20 66 61 69 6c 65 64 20 74 6f 20 RROR: failed to
6560: 66 69 6e 64 20 61 20 72 65 63 6f 72 64 20 66 6f find a record fo
6570: 72 20 74 65 73 74 2d 69 64 20 22 20 74 65 73 74 r test-id " test
6580: 2d 69 64 20 22 2c 20 65 78 69 74 69 6e 67 2e 22 -id ", exiting."
6590: 29 0a 09 09 09 09 20 20 28 65 78 69 74 29 29 29 )..... (exit)))
65a0: 29 0a 09 09 20 28 74 65 73 74 2d 70 69 64 20 20 )... (test-pid
65b0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 70 72 6f (db:test-get-pro
65c0: 63 65 73 73 5f 69 64 20 20 74 65 73 74 2d 69 6e cess_id test-in
65d0: 66 6f 29 29 29 0a 09 20 20 20 20 28 63 6f 6e 64 fo))).. (cond
65e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b . ;;
65f0: 20 2d 6d 72 77 2d 20 49 27 6d 20 72 65 6d 6f 76 -mrw- I'm remov
6600: 69 6e 67 20 4b 49 4c 4c 52 45 51 20 66 72 6f 6d ing KILLREQ from
6610: 20 74 68 69 73 20 6c 69 73 74 20 73 6f 20 74 68 this list so th
6620: 61 74 20 61 20 74 65 73 74 20 69 6e 20 4b 49 4c at a test in KIL
6630: 4c 52 45 51 20 73 74 61 74 65 20 69 73 20 74 72 LREQ state is tr
6640: 65 61 74 65 64 20 61 73 20 61 20 22 64 6f 20 6e eated as a "do n
6650: 6f 74 20 72 75 6e 22 20 66 6c 61 67 2e 0a 09 20 ot run" flag...
6660: 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 64 62 ((member (db
6670: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
6680: 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 49 4e test-info) '("IN
6690: 43 4f 4d 50 4c 45 54 45 22 20 22 4b 49 4c 4c 45 COMPLETE" "KILLE
66a0: 44 22 20 22 55 4e 4b 4e 4f 57 4e 22 20 22 53 54 D" "UNKNOWN" "ST
66b0: 55 43 4b 22 29 29 20 3b 3b 20 70 72 69 6f 72 20 UCK")) ;; prior
66c0: 72 75 6e 20 6f 66 20 74 68 69 73 20 74 65 73 74 run of this test
66d0: 20 64 69 64 6e 27 74 20 63 6f 6d 70 6c 65 74 65 didn't complete
66e0: 2c 20 67 6f 20 61 68 65 61 64 20 61 6e 64 20 74 , go ahead and t
66f0: 72 79 20 74 6f 20 72 65 72 75 6e 0a 09 20 20 20 ry to rerun..
6700: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
6710: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
6720: 6f 72 74 2a 20 22 49 4e 46 4f 3a 20 74 65 73 74 ort* "INFO: test
6730: 20 69 73 20 49 4e 43 4f 4d 50 4c 45 54 45 20 6f is INCOMPLETE o
6740: 72 20 4b 49 4c 4c 45 44 2c 20 74 72 65 61 74 20 r KILLED, treat
6750: 74 68 69 73 20 65 78 65 63 75 74 65 20 63 61 6c this execute cal
6760: 6c 20 61 73 20 61 20 72 65 72 75 6e 20 72 65 71 l as a rerun req
6770: 75 65 73 74 22 29 0a 09 20 20 20 20 20 20 3b 3b uest").. ;;
6780: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 (tests:test-for
6790: 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 ce-state-status!
67a0: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
67b0: 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 "REMOTEHOSTSTART
67c0: 22 20 22 6e 2f 61 22 29 0a 0a 20 20 20 20 20 20 " "n/a")..
67d0: 20 20 20 20 20 20 20 20 28 72 6d 74 3a 67 65 6e (rmt:gen
67e0: 65 72 61 6c 2d 63 61 6c 6c 20 27 73 65 74 2d 74 eral-call 'set-t
67f0: 65 73 74 2d 73 74 61 72 74 2d 74 69 6d 65 20 23 est-start-time #
6800: 66 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20 f test-id).
6810: 20 20 20 20 20 20 20 20 20 28 72 6d 74 3a 74 65 (rmt:te
6820: 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 st-set-state-sta
6830: 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d tus run-id test-
6840: 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 id "REMOTEHOSTST
6850: 41 52 54 22 20 22 6e 2f 61 22 20 23 66 29 0a 09 ART" "n/a" #f)..
6860: 20 20 20 20 20 20 29 20 3b 3b 20 70 72 69 6d 65 ) ;; prime
6870: 20 69 74 20 66 6f 72 20 72 75 6e 6e 69 6e 67 0a it for running.
6880: 09 20 20 20 20 20 28 28 6d 65 6d 62 65 72 20 28 . ((member (
6890: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
68a0: 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 e test-info) '("
68b0: 52 55 4e 4e 49 4e 47 22 20 22 52 45 4d 4f 54 45 RUNNING" "REMOTE
68c0: 48 4f 53 54 53 54 41 52 54 22 29 29 0a 09 20 20 HOSTSTART"))..
68d0: 20 20 20 20 28 69 66 20 28 70 72 6f 63 65 73 73 (if (process
68e0: 3a 61 6c 69 76 65 2d 6f 6e 2d 68 6f 73 74 3f 20 :alive-on-host?
68f0: 74 65 73 74 2d 68 6f 73 74 20 74 65 73 74 2d 70 test-host test-p
6900: 69 64 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 id)... (debug:p
6910: 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 rint-error 0 *de
6920: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6930: 22 74 65 73 74 20 73 74 61 74 65 20 69 73 20 22 "test state is "
6940: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 (db:test-get-s
6950: 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 tate test-info)
6960: 22 20 61 6e 64 20 70 72 6f 63 65 73 73 20 22 20 " and process "
6970: 74 65 73 74 2d 70 69 64 20 22 20 69 73 20 73 74 test-pid " is st
6980: 69 6c 6c 20 72 75 6e 6e 69 6e 67 20 6f 6e 20 68 ill running on h
6990: 6f 73 74 20 22 20 74 65 73 74 2d 68 6f 73 74 20 ost " test-host
69a0: 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f 63 65 65 ", cannot procee
69b0: 64 22 29 0a 09 09 20 20 28 65 78 69 74 20 31 29 d")... (exit 1)
69c0: 29 29 0a 09 20 20 20 20 20 28 28 6d 65 6d 62 65 )).. ((membe
69d0: 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 r (db:test-get-s
69e0: 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 20 tate test-info)
69f0: 27 28 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 20 '("COMPLETED"))
6a00: 20 3b 3b 20 77 65 20 64 6f 20 4e 4f 54 20 77 61 ;; we do NOT wa
6a10: 6e 74 20 74 6f 20 72 65 2d 72 75 6e 20 43 4f 4d nt to re-run COM
6a20: 50 4c 45 54 45 44 20 6a 6f 62 73 2e 20 4d 61 72 PLETED jobs. Mar
6a30: 6b 20 61 73 20 4e 4f 54 5f 53 54 41 52 54 45 44 k as NOT_STARTED
6a40: 20 74 6f 20 72 75 6e 21 0a 09 20 20 20 20 20 20 to run!..
6a50: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
6a60: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
6a70: 2a 20 22 74 65 73 74 20 73 74 61 74 65 20 69 73 * "test state is
6a80: 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
6a90: 73 74 61 74 65 20 74 65 73 74 2d 69 6e 66 6f 29 state test-info)
6aa0: 20 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f 63 65 ", cannot proce
6ab0: 65 64 22 29 0a 09 20 20 20 20 20 20 28 64 65 62 ed").. (deb
6ac0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
6ad0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 65 ult-log-port* "e
6ae0: 78 69 74 69 6e 67 20 77 69 74 68 20 73 74 61 74 xiting with stat
6af0: 75 73 20 31 22 29 0a 09 20 20 20 20 20 20 28 65 us 1").. (e
6b00: 78 69 74 20 31 29 29 0a 09 20 20 20 20 20 28 28 xit 1)).. ((
6b10: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 64 62 3a not (member (db:
6b20: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
6b30: 65 73 74 2d 69 6e 66 6f 29 20 27 28 22 52 45 4d est-info) '("REM
6b40: 4f 56 49 4e 47 22 20 22 52 45 4d 4f 54 45 48 4f OVING" "REMOTEHO
6b50: 53 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e STSTART" "RUNNIN
6b60: 47 22 20 22 4b 49 4c 4c 52 45 51 22 29 29 29 0a G" "KILLREQ"))).
6b70: 09 20 20 20 20 20 20 3b 3b 20 28 74 65 73 74 73 . ;; (tests
6b80: 3a 74 65 73 74 2d 66 6f 72 63 65 2d 73 74 61 74 :test-force-stat
6b90: 65 2d 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 e-status! run-id
6ba0: 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 45 test-id "REMOTE
6bb0: 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 22 HOSTSTART" "n/a"
6bc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6bd0: 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 6c (rmt:general-cal
6be0: 6c 20 27 73 65 74 2d 74 65 73 74 2d 73 74 61 72 l 'set-test-star
6bf0: 74 2d 74 69 6d 65 20 23 66 20 74 65 73 74 2d 69 t-time #f test-i
6c00: 64 29 0a 09 20 20 20 20 20 20 28 72 6d 74 3a 74 d).. (rmt:t
6c10: 65 73 74 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 est-set-state-st
6c20: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
6c30: 2d 69 64 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 -id "REMOTEHOSTS
6c40: 54 41 52 54 22 20 22 6e 2f 61 22 20 23 66 29 29 TART" "n/a" #f))
6c50: 0a 09 20 20 20 20 20 28 65 6c 73 65 20 3b 3b 20 .. (else ;;
6c60: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
6c70: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 2d -get-state test-
6c80: 69 6e 66 6f 29 20 27 28 22 52 45 4d 4f 56 49 4e info) '("REMOVIN
6c90: 47 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 53 54 G" "REMOTEHOSTST
6ca0: 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 22 20 22 ART" "RUNNING" "
6cb0: 4b 49 4c 4c 52 45 51 22 29 29 0a 09 20 20 20 20 KILLREQ"))..
6cc0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6cd0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
6ce0: 72 74 2a 20 22 74 65 73 74 20 73 74 61 74 65 20 rt* "test state
6cf0: 69 73 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 is " (db:test-ge
6d00: 74 2d 73 74 61 74 65 20 74 65 73 74 2d 69 6e 66 t-state test-inf
6d10: 6f 29 20 22 2c 20 63 61 6e 6e 6f 74 20 70 72 6f o) ", cannot pro
6d20: 63 65 65 64 22 29 0a 09 20 20 20 20 20 20 28 64 ceed").. (d
6d30: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
6d40: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6d50: 22 65 78 69 74 69 6e 67 20 77 69 74 68 20 73 74 "exiting with st
6d60: 61 74 75 73 20 31 22 29 0a 09 20 20 20 20 20 20 atus 1")..
6d70: 28 65 78 69 74 20 31 29 29 29 29 0a 0a 20 20 20 (exit 1))))..
6d80: 20 20 20 20 20 20 20 3b 3b 20 63 6c 65 61 6e 75 ;; cleanu
6d90: 70 20 70 72 69 6f 72 20 65 78 65 63 75 74 69 6f p prior executio
6da0: 6e 27 73 20 73 74 65 70 73 0a 20 20 20 20 20 20 n's steps.
6db0: 20 20 20 20 28 72 6d 74 3a 64 65 6c 65 74 65 2d (rmt:delete-
6dc0: 73 74 65 70 73 2d 66 6f 72 2d 74 65 73 74 21 20 steps-for-test!
6dd0: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a run-id test-id).
6de0: 20 20 20 20 20 20 20 20 20 20 0a 09 20 20 28 64 .. (d
6df0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
6e00: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
6e10: 22 45 78 65 63 75 74 69 6e 67 20 22 20 74 65 73 "Executing " tes
6e20: 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 22 20 t-name " (id: "
6e30: 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 22 20 test-id ") on "
6e40: 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 29 29 (get-host-name))
6e50: 0a 09 20 20 28 73 65 74 21 20 6b 65 79 73 20 20 .. (set! keys
6e60: 20 20 20 20 20 28 72 6d 74 3a 67 65 74 2d 6b 65 (rmt:get-ke
6e70: 79 73 29 29 0a 09 20 20 3b 3b 20 28 72 75 6e 73 ys)).. ;; (runs
6e80: 3a 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e :set-megatest-en
6e90: 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 20 69 6e v-vars run-id in
6ea0: 6b 65 79 73 3a 20 6b 65 79 73 20 69 6e 6b 65 79 keys: keys inkey
6eb0: 76 61 6c 73 3a 20 6b 65 79 76 61 6c 73 29 20 3b vals: keyvals) ;
6ec0: 3b 20 74 68 65 73 65 20 6d 61 79 20 62 65 20 6e ; these may be n
6ed0: 65 65 64 65 64 20 62 79 20 74 68 65 20 6c 61 75 eeded by the lau
6ee0: 6e 63 68 69 6e 67 20 70 72 6f 63 65 73 73 0a 09 nching process..
6ef0: 20 20 3b 3b 20 6f 6e 65 20 6f 66 20 74 68 65 73 ;; one of thes
6f00: 65 20 69 73 20 64 65 66 75 6e 63 74 2f 72 65 64 e is defunct/red
6f10: 75 6e 64 61 6e 74 20 2e 2e 2e 0a 09 20 20 28 69 undant ..... (i
6f20: 66 20 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 73 f (not (launch:s
6f30: 65 74 75 70 20 66 6f 72 63 65 2d 72 65 72 65 61 etup force-rerea
6f40: 64 3a 20 23 74 29 29 0a 09 20 20 20 20 20 20 28 d: #t)).. (
6f50: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
6f60: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
6f70: 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 61 69 6c 65 log-port* "Faile
6f80: 64 20 74 6f 20 73 65 74 75 70 2c 20 65 78 69 74 d to setup, exit
6f90: 69 6e 67 22 29 20 0a 09 09 3b 3b 20 28 73 71 6c ing") ...;; (sql
6fa0: 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 64 ite3:finalize! d
6fb0: 62 29 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 b)...;; (sqlite3
6fc0: 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a :finalize! tdb).
6fd0: 09 09 28 65 78 69 74 20 31 29 29 29 0a 20 20 20 ..(exit 1))).
6fe0: 20 20 20 20 20 20 20 3b 3b 20 76 61 6c 69 64 61 ;; valida
6ff0: 74 65 20 74 68 61 74 20 74 68 65 20 74 65 73 74 te that the test
7000: 20 72 75 6e 20 61 72 65 61 20 69 73 20 61 76 61 run area is ava
7010: 69 6c 61 62 6c 65 0a 20 20 20 20 20 20 20 20 20 ilable.
7020: 20 28 63 68 65 63 6b 2d 77 6f 72 6b 2d 61 72 65 (check-work-are
7030: 61 29 0a 20 20 20 20 20 20 20 20 20 20 0a 20 20 a). .
7040: 20 20 20 20 20 20 20 20 3b 3b 20 73 74 69 6c 6c ;; still
7050: 20 6e 65 65 64 20 74 6f 20 67 6f 20 62 61 63 6b need to go back
7060: 20 74 6f 20 72 75 6e 20 61 72 65 61 20 68 6f 6d to run area hom
7070: 65 20 66 6f 72 20 6e 65 78 74 20 63 6f 75 70 6c e for next coupl
7080: 65 20 73 74 65 70 73 0a 09 20 20 28 63 68 61 6e e steps.. (chan
7090: 67 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f ge-directory *to
70a0: 70 70 61 74 68 2a 29 20 0a 0a 09 20 20 3b 3b 20 ppath*) ... ;;
70b0: 4e 4f 54 45 3a 20 43 75 72 72 65 6e 74 20 6f 72 NOTE: Current or
70c0: 64 65 72 20 69 73 20 74 6f 20 70 72 6f 63 65 73 der is to proces
70d0: 73 20 72 75 6e 63 6f 6e 66 69 67 73 20 2a 62 65 s runconfigs *be
70e0: 66 6f 72 65 2a 20 73 65 74 74 69 6e 67 20 74 68 fore* setting th
70f0: 65 20 4d 54 5f 20 76 61 72 73 2e 20 54 68 69 73 e MT_ vars. This
7100: 20 0a 09 20 20 3b 3b 20 20 20 20 20 20 20 73 65 .. ;; se
7110: 65 6d 73 20 6e 6f 6e 2d 69 64 65 61 6c 20 62 75 ems non-ideal bu
7120: 74 20 63 6f 75 6c 64 20 77 65 6c 6c 20 62 72 65 t could well bre
7130: 61 6b 20 73 74 75 66 66 0a 09 20 20 3b 3b 20 20 ak stuff.. ;;
7140: 20 20 42 55 47 3f 20 42 55 47 3f 20 42 55 47 3f BUG? BUG? BUG?
7150: 0a 09 20 20 0a 09 20 20 28 6c 65 74 20 28 28 72 .. .. (let ((r
7160: 63 6f 6e 66 69 67 20 28 66 75 6c 6c 2d 72 75 6e config (full-run
7170: 63 6f 6e 66 69 67 73 2d 72 65 61 64 29 29 20 3b configs-read)) ;
7180: 3b 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 ; (read-config (
7190: 63 6f 6e 63 20 20 2a 74 6f 70 70 61 74 68 2a 20 conc *toppath*
71a0: 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e "/runconfigs.con
71b0: 66 69 67 22 29 20 23 66 20 23 74 20 73 65 63 74 fig") #f #t sect
71c0: 69 6f 6e 73 3a 20 28 6c 69 73 74 20 22 64 65 66 ions: (list "def
71d0: 61 75 6c 74 22 20 74 61 72 67 65 74 29 29 29 29 ault" target))))
71e0: 0a 09 09 28 77 63 6f 6e 66 69 67 20 28 72 65 61 ...(wconfig (rea
71f0: 64 2d 63 6f 6e 66 69 67 20 22 77 61 69 76 65 72 d-config "waiver
7200: 73 2e 63 6f 6e 66 69 67 22 20 23 66 20 23 74 20 s.config" #f #t
7210: 73 65 63 74 69 6f 6e 73 3a 20 60 28 20 22 64 65 sections: `( "de
7220: 66 61 75 6c 74 22 20 2c 74 61 72 67 65 74 20 29 fault" ,target )
7230: 29 29 29 20 3b 3b 20 72 65 61 64 20 74 68 65 20 ))) ;; read the
7240: 77 61 69 76 65 72 73 20 63 6f 6e 66 69 67 20 69 waivers config i
7250: 66 20 69 74 20 65 78 69 73 74 73 0a 09 20 20 20 f it exists..
7260: 20 3b 3b 20 28 73 65 74 75 70 2d 65 6e 76 2d 64 ;; (setup-env-d
7270: 65 66 61 75 6c 74 73 20 28 63 6f 6e 63 20 2a 74 efaults (conc *t
7280: 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e 63 6f 6e oppath* "/runcon
7290: 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 72 75 figs.config") ru
72a0: 6e 2d 69 64 20 28 6d 61 6b 65 2d 68 61 73 68 2d n-id (make-hash-
72b0: 74 61 62 6c 65 29 20 6b 65 79 76 61 6c 73 20 74 table) keyvals t
72c0: 61 72 67 65 74 29 0a 09 20 20 20 20 3b 3b 20 28 arget).. ;; (
72d0: 73 65 74 2d 72 75 6e 2d 63 6f 6e 66 69 67 2d 76 set-run-config-v
72e0: 61 72 73 20 72 75 6e 2d 69 64 20 6b 65 79 76 61 ars run-id keyva
72f0: 6c 73 20 74 61 72 67 65 74 29 20 3b 3b 20 28 64 ls target) ;; (d
7300: 62 3a 67 65 74 2d 74 61 72 67 65 74 20 64 62 20 b:get-target db
7310: 72 75 6e 2d 69 64 29 29 0a 09 20 20 20 20 3b 3b run-id)).. ;;
7320: 20 4e 6f 77 20 68 61 76 65 20 72 75 6e 63 6f 6e Now have runcon
7330: 66 69 67 73 20 64 61 74 61 20 6c 6f 61 64 65 64 figs data loaded
7340: 2c 20 73 65 74 20 65 6e 76 69 72 6f 6e 6d 65 6e , set environmen
7350: 74 20 76 61 72 73 0a 09 20 20 20 20 28 66 6f 72 t vars.. (for
7360: 2d 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 6d -each.. (lam
7370: 62 64 61 20 28 73 65 63 74 69 6f 6e 29 0a 09 20 bda (section)..
7380: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a (for-each.
7390: 09 09 28 6c 61 6d 62 64 61 20 28 76 61 72 76 61 ..(lambda (varva
73a0: 6c 29 0a 09 09 20 20 28 6c 65 74 20 28 28 76 61 l)... (let ((va
73b0: 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 29 0a r (car varval)).
73c0: 09 09 09 28 76 61 6c 20 28 63 61 64 72 20 76 61 ...(val (cadr va
73d0: 72 76 61 6c 29 29 29 0a 09 09 20 20 20 20 28 69 rval)))... (i
73e0: 66 20 28 61 6e 64 20 28 73 74 72 69 6e 67 3f 20 f (and (string?
73f0: 76 61 72 29 28 73 74 72 69 6e 67 3f 20 76 61 6c var)(string? val
7400: 29 29 0a 09 09 09 28 62 65 67 69 6e 0a 09 09 09 ))....(begin....
7410: 20 20 28 73 61 66 65 2d 73 65 74 65 6e 76 20 76 (safe-setenv v
7420: 61 72 20 28 63 6f 6e 66 69 67 66 3a 65 76 61 6c ar (configf:eval
7430: 2d 73 74 72 69 6e 67 2d 69 6e 2d 65 6e 76 69 72 -string-in-envir
7440: 6f 6e 6d 65 6e 74 20 76 61 6c 29 29 29 20 3b 3b onment val))) ;;
7450: 20 76 61 6c 29 0a 09 09 09 28 64 65 62 75 67 3a val)....(debug:
7460: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
7470: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
7480: 20 22 62 61 64 20 76 61 72 69 61 62 6c 65 20 73 "bad variable s
7490: 70 65 63 2c 20 22 20 76 61 72 20 22 3d 22 20 76 pec, " var "=" v
74a0: 61 6c 29 29 29 29 0a 09 09 28 63 6f 6e 66 69 67 al))))...(config
74b0: 66 3a 67 65 74 2d 73 65 63 74 69 6f 6e 20 72 63 f:get-section rc
74c0: 6f 6e 66 69 67 20 73 65 63 74 69 6f 6e 29 29 29 onfig section)))
74d0: 0a 09 20 20 20 20 20 28 6c 69 73 74 20 22 64 65 .. (list "de
74e0: 66 61 75 6c 74 22 20 74 61 72 67 65 74 29 29 29 fault" target)))
74f0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 . ;;(bb
7500: 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a -check-path msg:
7510: 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 "launch:execute
7520: 20 70 6f 73 74 20 62 6c 6f 63 6b 20 31 22 29 0a post block 1").
7530: 0a 09 20 20 3b 3b 20 4e 46 53 20 6d 69 67 68 74 .. ;; NFS might
7540: 20 6e 6f 74 20 68 61 76 65 20 70 72 6f 70 61 67 not have propag
7550: 61 74 65 64 20 74 68 65 20 64 69 72 65 63 74 6f ated the directo
7560: 72 79 20 6d 65 74 61 20 64 61 74 61 20 74 6f 20 ry meta data to
7570: 74 68 65 20 72 75 6e 20 68 6f 73 74 20 2d 20 67 the run host - g
7580: 69 76 65 20 69 74 20 74 69 6d 65 20 69 66 20 6e ive it time if n
7590: 65 65 64 65 64 0a 09 20 20 28 6c 65 74 20 6c 6f eeded.. (let lo
75a0: 6f 70 20 28 28 63 6f 75 6e 74 20 30 29 29 0a 09 op ((count 0))..
75b0: 20 20 20 20 28 69 66 20 28 6f 72 20 28 63 6f 6d (if (or (com
75c0: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
75d0: 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 20 20 work-area)...
75e0: 20 20 28 3e 20 63 6f 75 6e 74 20 31 30 29 29 0a (> count 10)).
75f0: 09 09 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 ..(change-direct
7600: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 ory work-area)..
7610: 09 28 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 .(begin... (deb
7620: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
7630: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 49 ult-log-port* "I
7640: 4e 46 4f 3a 20 4e 6f 74 20 73 74 61 72 74 69 6e NFO: Not startin
7650: 67 20 6a 6f 62 20 79 65 74 20 2d 20 64 69 72 65 g job yet - dire
7660: 63 74 6f 72 79 20 22 20 77 6f 72 6b 2d 61 72 65 ctory " work-are
7670: 61 20 22 20 6e 6f 74 20 66 6f 75 6e 64 22 29 0a a " not found").
7680: 09 09 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 .. (thread-slee
7690: 70 21 20 31 30 29 0a 09 09 20 20 28 6c 6f 6f 70 p! 10)... (loop
76a0: 20 28 2b 20 63 6f 75 6e 74 20 31 29 29 29 29 29 (+ count 1)))))
76b0: 0a 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6e .. ;; n
76c0: 6f 77 20 77 65 20 63 61 6e 20 73 77 69 74 63 68 ow we can switch
76d0: 20 74 6f 20 74 68 65 20 77 6f 72 6b 2d 61 72 65 to the work-are
76e0: 61 3f 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 a?. (ch
76f0: 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 77 ange-directory w
7700: 6f 72 6b 2d 61 72 65 61 29 0a 20 20 20 20 20 20 ork-area).
7710: 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d ;;(bb-check-
7720: 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 path msg: "launc
7730: 68 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 h:execute post b
7740: 6c 6f 63 6b 20 31 2e 35 22 29 0a 09 20 20 3b 3b lock 1.5").. ;;
7750: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
7760: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 0a 09 ry work-area) ..
7770: 20 20 28 73 65 74 21 20 6b 65 79 76 61 6c 73 20 (set! keyvals
7780: 20 20 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d (keys:target-
7790: 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 >keyval keys tar
77a0: 67 65 74 29 29 0a 09 20 20 3b 3b 20 61 70 70 6c get)).. ;; appl
77b0: 79 20 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 y pre-overrides
77c0: 62 65 66 6f 72 65 20 6f 74 68 65 72 20 76 61 72 before other var
77d0: 69 61 62 6c 65 73 2e 20 54 68 65 20 70 72 65 2d iables. The pre-
77e0: 6f 76 65 72 72 69 64 65 20 76 61 72 73 20 6d 75 override vars mu
77f0: 73 74 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f st not.. ;; clo
7800: 62 62 65 72 73 20 74 68 69 6e 67 73 20 66 72 6f bbers things fro
7810: 6d 20 74 68 65 20 6f 66 66 69 63 69 61 6c 20 73 m the official s
7820: 6f 75 72 63 65 73 20 73 75 63 68 20 61 73 20 6d ources such as m
7830: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 egatest.config a
7840: 6e 64 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f nd runconfigs.co
7850: 6e 66 69 67 0a 09 20 20 28 69 66 20 28 73 74 72 nfig.. (if (str
7860: 69 6e 67 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 ing? set-vars)..
7870: 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 (let ((var
7880: 70 61 69 72 73 20 28 73 74 72 69 6e 67 2d 73 70 pairs (string-sp
7890: 6c 69 74 20 73 65 74 2d 76 61 72 73 20 22 2c 22 lit set-vars ","
78a0: 29 29 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 )))...(debug:pri
78b0: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
78c0: 67 2d 70 6f 72 74 2a 20 22 76 61 72 70 61 69 72 g-port* "varpair
78d0: 73 3a 20 22 20 76 61 72 70 61 69 72 73 29 0a 09 s: " varpairs)..
78e0: 09 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 76 .(map (lambda (v
78f0: 61 72 70 61 69 72 29 0a 09 09 20 20 20 20 20 20 arpair)...
7900: 20 28 6c 65 74 20 28 28 76 61 72 76 61 6c 20 28 (let ((varval (
7910: 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 76 61 72 string-split var
7920: 70 61 69 72 20 22 3d 22 29 29 29 0a 09 09 09 20 pair "=")))....
7930: 28 69 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 68 (if (eq? (length
7940: 20 76 61 72 76 61 6c 29 20 32 29 0a 09 09 09 20 varval) 2)....
7950: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 (let ((var (
7960: 63 61 72 20 76 61 72 76 61 6c 29 29 0a 09 09 09 car varval))....
7970: 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 20 76 . (val (cadr v
7980: 61 72 76 61 6c 29 29 29 0a 09 09 09 20 20 20 20 arval)))....
7990: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
79a0: 31 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 1 *default-log-p
79b0: 6f 72 74 2a 20 22 41 64 64 69 6e 67 20 70 72 65 ort* "Adding pre
79c0: 2d 76 61 72 2f 76 61 6c 20 22 20 76 61 72 20 22 -var/val " var "
79d0: 20 3d 20 22 20 76 61 6c 20 22 20 74 6f 20 74 68 = " val " to th
79e0: 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 22 29 0a e environment").
79f0: 09 09 09 20 20 20 20 20 20 20 28 73 65 74 65 6e ... (seten
7a00: 76 20 76 61 72 20 76 61 6c 29 29 29 29 29 0a 09 v var val)))))..
7a10: 09 20 20 20 20 20 76 61 72 70 61 69 72 73 29 29 . varpairs))
7a20: 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 ). ;;(b
7a30: 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 b-check-path msg
7a40: 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 : "launch:execut
7a50: 65 20 70 6f 73 74 20 62 6c 6f 63 6b 20 32 22 29 e post block 2")
7a60: 0a 09 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 .. (for-each..
7a70: 20 20 28 6c 61 6d 62 64 61 20 28 76 61 72 76 61 (lambda (varva
7a80: 6c 29 0a 09 20 20 20 20 20 28 6c 65 74 20 28 28 l).. (let ((
7a90: 76 61 72 20 28 63 61 72 20 76 61 72 76 61 6c 29 var (car varval)
7aa0: 29 0a 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 )... (val (cad
7ab0: 72 20 76 61 72 76 61 6c 29 29 29 0a 09 20 20 20 r varval)))..
7ac0: 20 20 20 20 28 69 66 20 76 61 6c 0a 09 09 20 20 (if val...
7ad0: 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 61 6c (setenv var val
7ae0: 29 0a 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 )... (begin...
7af0: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
7b00: 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 75 t-error 0 *defau
7b10: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 72 65 lt-log-port* "re
7b20: 71 75 69 72 65 64 20 76 61 72 69 61 62 6c 65 20 quired variable
7b30: 22 20 76 61 72 20 22 20 64 6f 65 73 20 6e 6f 74 " var " does not
7b40: 20 68 61 76 65 20 61 20 76 61 6c 69 64 20 76 61 have a valid va
7b50: 6c 75 65 2e 20 45 78 69 74 69 6e 67 22 29 0a 09 lue. Exiting")..
7b60: 09 20 20 20 20 20 28 65 78 69 74 29 29 29 29 29 . (exit)))))
7b70: 0a 09 20 20 20 20 20 28 6c 69 73 74 20 0a 09 20 .. (list ..
7b80: 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f (list "MT_
7b90: 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f TEST_RUN_DIR" wo
7ba0: 72 6b 2d 61 72 65 61 29 0a 09 20 20 20 20 20 20 rk-area)..
7bb0: 28 6c 69 73 74 20 20 22 4d 54 5f 54 45 53 54 5f (list "MT_TEST_
7bc0: 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 29 NAME" test-name)
7bd0: 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 .. (list "
7be0: 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 28 63 MT_ITEM_INFO" (c
7bf0: 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 0a 09 20 onc itemdat))..
7c00: 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f (list "MT_
7c10: 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d 2d ITEMPATH" item-
7c20: 70 61 74 68 29 0a 09 20 20 20 20 20 20 28 6c 69 path).. (li
7c30: 73 74 20 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 st "MT_RUNNAME"
7c40: 20 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 runname)..
7c50: 20 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 4d 45 (list "MT_ME
7c60: 47 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 GATEST" megates
7c70: 74 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 t).. (list
7c80: 20 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 "MT_TARGET"
7c90: 74 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 target).. (
7ca0: 6c 69 73 74 20 20 22 4d 54 5f 4c 49 4e 4b 54 52 list "MT_LINKTR
7cb0: 45 45 22 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 EE" (common:get
7cc0: 2d 6c 69 6e 6b 74 72 65 65 29 29 20 3b 3b 20 28 -linktree)) ;; (
7cd0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
7ce0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
7cf0: 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 0a p" "linktree")).
7d00: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
7d10: 54 5f 54 45 53 54 53 55 49 54 45 4e 41 4d 45 22 T_TESTSUITENAME"
7d20: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
7d30: 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 29 29 0a tsuite-name)))).
7d40: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 2d ;;(bb-
7d50: 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a 20 check-path msg:
7d60: 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 "launch:execute
7d70: 70 6f 73 74 20 62 6c 6f 63 6b 20 33 22 29 0a 0a post block 3")..
7d80: 09 20 20 28 69 66 20 6d 74 2d 62 69 6e 64 69 72 . (if mt-bindir
7d90: 2d 70 61 74 68 20 28 73 65 74 65 6e 76 20 22 50 -path (setenv "P
7da0: 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 65 ATH" (conc (gete
7db0: 6e 76 20 22 50 41 54 48 22 29 20 22 3a 22 20 6d nv "PATH") ":" m
7dc0: 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 29 29 29 t-bindir-path)))
7dd0: 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 28 62 62 . ;;(bb
7de0: 2d 63 68 65 63 6b 2d 70 61 74 68 20 6d 73 67 3a -check-path msg:
7df0: 20 22 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 "launch:execute
7e00: 20 70 6f 73 74 20 62 6c 6f 63 6b 20 34 22 29 0a post block 4").
7e10: 09 20 20 3b 3b 20 28 63 68 61 6e 67 65 2d 64 69 . ;; (change-di
7e20: 72 65 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 rectory top-path
7e30: 29 0a 09 20 20 3b 3b 20 43 61 6e 20 73 65 74 75 ).. ;; Can setu
7e40: 70 20 61 73 20 63 6c 69 65 6e 74 20 66 6f 72 20 p as client for
7e50: 73 65 72 76 65 72 20 6d 6f 64 65 20 6e 6f 77 0a server mode now.
7e60: 09 20 20 3b 3b 20 28 63 6c 69 65 6e 74 3a 73 65 . ;; (client:se
7e70: 74 75 70 29 0a 0a 09 20 20 0a 09 20 20 3b 3b 20 tup)... .. ;;
7e80: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 6f 76 65 72 environment over
7e90: 72 69 64 65 73 20 61 72 65 20 64 6f 6e 65 20 2a rides are done *
7ea0: 62 65 66 6f 72 65 2a 20 74 68 65 20 72 65 6d 61 before* the rema
7eb0: 69 6e 69 6e 67 20 63 72 69 74 69 63 61 6c 20 65 ining critical e
7ec0: 6e 76 61 72 73 2e 0a 09 20 20 28 61 6c 69 73 74 nvars... (alist
7ed0: 2d 3e 65 6e 76 2d 76 61 72 73 20 65 6e 76 2d 6f ->env-vars env-o
7ee0: 76 72 64 29 0a 20 20 20 20 20 20 20 20 20 20 3b vrd). ;
7ef0: 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 74 68 20 ;(bb-check-path
7f00: 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a 65 78 65 msg: "launch:exe
7f10: 63 75 74 65 20 70 6f 73 74 20 62 6c 6f 63 6b 20 cute post block
7f20: 34 31 22 29 0a 09 20 20 28 72 75 6e 73 3a 73 65 41").. (runs:se
7f30: 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 t-megatest-env-v
7f40: 61 72 73 20 72 75 6e 2d 69 64 20 69 6e 6b 65 79 ars run-id inkey
7f50: 73 3a 20 6b 65 79 73 20 69 6e 6b 65 79 76 61 6c s: keys inkeyval
7f60: 73 3a 20 6b 65 79 76 61 6c 73 29 0a 20 20 20 20 s: keyvals).
7f70: 20 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 ;;(bb-chec
7f80: 6b 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 k-path msg: "lau
7f90: 6e 63 68 3a 65 78 65 63 75 74 65 20 70 6f 73 74 nch:execute post
7fa0: 20 62 6c 6f 63 6b 20 34 32 22 29 0a 09 20 20 28 block 42").. (
7fb0: 73 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 set-item-env-var
7fc0: 73 20 69 74 65 6d 64 61 74 29 0a 20 20 20 20 20 s itemdat).
7fd0: 20 20 20 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b ;;(bb-check
7fe0: 2d 70 61 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e -path msg: "laun
7ff0: 63 68 3a 65 78 65 63 75 74 65 20 70 6f 73 74 20 ch:execute post
8000: 62 6c 6f 63 6b 20 34 33 22 29 0a 20 20 20 20 20 block 43").
8010: 20 20 20 20 20 28 6c 65 74 20 28 28 62 6c 61 63 (let ((blac
8020: 6b 6c 69 73 74 20 28 63 6f 6e 66 69 67 66 3a 6c klist (configf:l
8030: 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
8040: 2a 20 22 73 65 74 75 70 22 20 22 62 6c 61 63 6b * "setup" "black
8050: 6c 69 73 74 76 61 72 73 22 29 29 29 0a 20 20 20 listvars"))).
8060: 20 20 20 20 20 20 20 20 20 28 69 66 20 62 6c 61 (if bla
8070: 63 6b 6c 69 73 74 0a 09 09 28 6c 65 74 20 28 28 cklist...(let ((
8080: 76 61 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c vars (string-spl
8090: 69 74 20 62 6c 61 63 6b 6c 69 73 74 29 29 29 0a it blacklist))).
80a0: 09 09 20 20 28 73 61 76 65 2d 65 6e 76 69 72 6f .. (save-enviro
80b0: 6e 6d 65 6e 74 2d 61 73 2d 66 69 6c 65 73 20 22 nment-as-files "
80c0: 6d 65 67 61 74 65 73 74 22 20 69 67 6e 6f 72 65 megatest" ignore
80d0: 76 61 72 73 3a 20 76 61 72 73 29 0a 09 09 20 20 vars: vars)...
80e0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
80f0: 61 20 28 76 61 72 29 0a 09 09 09 20 20 20 20 20 a (var)....
8100: 20 28 75 6e 73 65 74 65 6e 76 20 76 61 72 29 29 (unsetenv var))
8110: 0a 09 09 09 20 20 20 20 76 61 72 73 29 29 0a 20 .... vars)).
8120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8130: 73 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 save-environment
8140: 2d 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 -as-files "megat
8150: 65 73 74 22 29 29 29 0a 20 20 20 20 20 20 20 20 est"))).
8160: 20 20 3b 3b 28 62 62 2d 63 68 65 63 6b 2d 70 61 ;;(bb-check-pa
8170: 74 68 20 6d 73 67 3a 20 22 6c 61 75 6e 63 68 3a th msg: "launch:
8180: 65 78 65 63 75 74 65 20 70 6f 73 74 20 62 6c 6f execute post blo
8190: 63 6b 20 34 34 22 29 0a 09 20 20 3b 3b 20 6f 70 ck 44").. ;; op
81a0: 65 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f 74 en-run-close not
81b0: 20 6e 65 65 64 65 64 20 66 6f 72 20 74 65 73 74 needed for test
81c0: 2d 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 -set-meta-info..
81d0: 20 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d ;; (tests:set-
81e0: 66 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 full-meta-info #
81f0: 66 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 f test-id run-id
8200: 20 30 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 20 0 work-area)..
8210: 20 3b 3b 20 28 74 65 73 74 73 3a 73 65 74 2d 66 ;; (tests:set-f
8220: 75 6c 6c 2d 6d 65 74 61 2d 69 6e 66 6f 20 74 65 ull-meta-info te
8230: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 30 20 77 st-id run-id 0 w
8240: 6f 72 6b 2d 61 72 65 61 29 0a 09 20 20 28 74 65 ork-area).. (te
8250: 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d 65 74 sts:set-full-met
8260: 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 a-info #f test-i
8270: 64 20 72 75 6e 2d 69 64 20 30 20 77 6f 72 6b 2d d run-id 0 work-
8280: 61 72 65 61 20 31 30 29 0a 0a 09 20 20 3b 3b 20 area 10)... ;;
8290: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 (thread-sleep! 0
82a0: 2e 33 29 20 3b 3b 20 4e 46 53 20 73 6c 6f 77 6e .3) ;; NFS slown
82b0: 65 73 73 20 68 61 73 20 63 61 75 73 65 64 20 67 ess has caused g
82c0: 72 69 65 66 20 68 65 72 65 0a 0a 09 20 20 28 69 rief here... (i
82d0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
82e0: 22 2d 78 74 65 72 6d 22 29 0a 09 20 20 20 20 20 "-xterm")..
82f0: 20 28 73 65 74 21 20 66 75 6c 6c 72 75 6e 73 63 (set! fullrunsc
8300: 72 69 70 74 20 22 78 74 65 72 6d 22 29 0a 09 20 ript "xterm")..
8310: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 66 75 (if (and fu
8320: 6c 6c 72 75 6e 73 63 72 69 70 74 20 0a 09 09 20 llrunscript ...
8330: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 66 69 (common:fi
8340: 6c 65 2d 65 78 69 73 74 73 3f 20 66 75 6c 6c 72 le-exists? fullr
8350: 75 6e 73 63 72 69 70 74 29 0a 09 09 20 20 20 20 unscript)...
8360: 20 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 (not (file-ex
8370: 65 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 75 ecute-access? fu
8380: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 llrunscript)))..
8390: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
83a0: 20 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 66 "chmod ug+x " f
83b0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 29 ullrunscript))))
83c0: 0a 0a 09 20 20 3b 3b 20 57 65 20 61 72 65 20 61 ... ;; We are a
83d0: 62 6f 75 74 20 74 6f 20 61 63 74 75 61 6c 6c 79 bout to actually
83e0: 20 6b 69 63 6b 20 6f 66 66 20 74 68 65 20 74 65 kick off the te
83f0: 73 74 0a 09 20 20 3b 3b 20 73 6f 20 74 68 69 73 st.. ;; so this
8400: 20 69 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 is a good place
8410: 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 72 to remove the r
8420: 65 63 6f 72 64 73 20 66 6f 72 20 0a 09 20 20 3b ecords for .. ;
8430: 3b 20 61 6e 79 20 70 72 65 76 69 6f 75 73 20 72 ; any previous r
8440: 75 6e 73 0a 09 20 20 3b 3b 20 28 64 62 3a 74 65 uns.. ;; (db:te
8450: 73 74 2d 72 65 6d 6f 76 65 2d 73 74 65 70 73 20 st-remove-steps
8460: 64 62 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 db run-id testna
8470: 6d 65 20 69 74 65 6d 64 61 74 29 0a 09 20 20 3b me itemdat).. ;
8480: 3b 20 6e 6f 77 20 69 73 20 61 6c 73 6f 20 61 20 ; now is also a
8490: 67 6f 6f 64 20 74 69 6d 65 20 74 6f 20 77 72 69 good time to wri
84a0: 74 65 20 74 68 65 20 2e 74 65 73 74 63 6f 6e 66 te the .testconf
84b0: 69 67 20 66 69 6c 65 0a 09 20 20 28 6c 65 74 2a ig file.. (let*
84c0: 20 28 28 74 63 6f 6e 66 69 67 2d 66 6e 61 6d 65 ((tconfig-fname
84d0: 20 20 20 28 63 6f 6e 63 20 77 6f 72 6b 2d 61 72 (conc work-ar
84e0: 65 61 20 22 2f 2e 74 65 73 74 63 6f 6e 66 69 67 ea "/.testconfig
84f0: 22 29 29 0a 09 09 20 28 74 63 6f 6e 66 69 67 2d "))... (tconfig-
8500: 74 6d 70 66 69 6c 65 20 28 63 6f 6e 63 20 74 63 tmpfile (conc tc
8510: 6f 6e 66 69 67 2d 66 6e 61 6d 65 20 22 2e 74 6d onfig-fname ".tm
8520: 70 22 29 29 0a 09 09 20 28 74 63 6f 6e 66 69 67 p"))... (tconfig
8530: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 73 3a (tests:
8540: 67 65 74 2d 74 65 73 74 63 6f 6e 66 69 67 20 74 get-testconfig t
8550: 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 est-name item-pa
8560: 74 68 20 74 63 6f 6e 66 69 67 72 65 67 20 23 74 th tconfigreg #t
8570: 20 66 6f 72 63 65 2d 63 72 65 61 74 65 3a 20 23 force-create: #
8580: 74 29 29 20 3b 3b 20 27 72 65 74 75 72 6e 2d 70 t)) ;; 'return-p
8590: 72 6f 63 73 29 29 29 0a 09 09 20 28 73 63 72 69 rocs)))... (scri
85a0: 70 74 73 20 28 63 6f 6e 66 69 67 66 3a 67 65 74 pts (configf:get
85b0: 2d 73 65 63 74 69 6f 6e 20 74 63 6f 6e 66 69 67 -section tconfig
85c0: 20 22 73 63 72 69 70 74 73 22 29 29 29 0a 09 20 "scripts")))..
85d0: 20 20 20 3b 3b 20 63 72 65 61 74 65 20 2e 74 65 ;; create .te
85e0: 73 74 63 6f 6e 66 69 67 20 66 69 6c 65 0a 09 20 stconfig file..
85f0: 20 20 20 28 63 6f 6e 66 69 67 66 3a 77 72 69 74 (configf:writ
8600: 65 2d 61 6c 69 73 74 20 74 63 6f 6e 66 69 67 20 e-alist tconfig
8610: 74 63 6f 6e 66 69 67 2d 74 6d 70 66 69 6c 65 29 tconfig-tmpfile)
8620: 0a 09 20 20 20 20 28 66 69 6c 65 2d 6d 6f 76 65 .. (file-move
8630: 20 74 63 6f 6e 66 69 67 2d 74 6d 70 66 69 6c 65 tconfig-tmpfile
8640: 20 74 63 6f 6e 66 69 67 2d 66 6e 61 6d 65 20 23 tconfig-fname #
8650: 74 29 0a 09 20 20 20 20 28 64 65 6c 65 74 65 2d t).. (delete-
8660: 66 69 6c 65 2a 20 22 2e 66 69 6e 61 6c 2d 73 74 file* ".final-st
8670: 61 74 75 73 22 29 0a 0a 09 20 20 20 20 3b 3b 20 atus")... ;;
8680: 65 78 74 72 61 63 74 20 73 63 72 69 70 74 73 20 extract scripts
8690: 66 72 6f 6d 20 74 65 73 74 63 6f 6e 66 69 67 20 from testconfig
86a0: 61 6e 64 20 77 72 69 74 65 20 74 68 65 6d 20 74 and write them t
86b0: 6f 20 66 69 6c 65 73 20 69 6e 20 74 65 73 74 20 o files in test
86c0: 72 75 6e 20 64 69 72 0a 09 20 20 20 20 28 66 6f run dir.. (fo
86d0: 72 2d 65 61 63 68 0a 09 20 20 20 20 20 28 6c 61 r-each.. (la
86e0: 6d 62 64 61 20 28 73 63 72 69 70 74 64 61 74 29 mbda (scriptdat)
86f0: 0a 09 20 20 20 20 20 20 20 28 6d 61 74 63 68 20 .. (match
8700: 73 63 72 69 70 74 64 61 74 0a 09 09 20 20 20 20 scriptdat...
8710: 20 20 28 28 6e 61 6d 65 20 63 6f 6e 74 65 6e 74 ((name content
8720: 29 0a 09 09 20 20 20 20 20 20 20 28 77 69 74 68 )... (with
8730: 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 -output-to-file
8740: 6e 61 6d 65 0a 09 09 09 20 28 6c 61 6d 62 64 61 name.... (lambda
8750: 20 28 29 0a 09 09 09 20 20 20 28 70 72 69 6e 74 ().... (print
8760: 20 63 6f 6e 74 65 6e 74 29 0a 09 09 09 20 20 20 content)....
8770: 28 63 68 61 6e 67 65 2d 66 69 6c 65 2d 6d 6f 64 (change-file-mod
8780: 65 20 6e 61 6d 65 20 28 62 69 74 77 69 73 65 2d e name (bitwise-
8790: 69 6f 72 20 70 65 72 6d 2f 69 72 77 78 67 20 70 ior perm/irwxg p
87a0: 65 72 6d 2f 69 72 77 78 75 29 29 29 29 29 0a 09 erm/irwxu)))))..
87b0: 09 20 20 20 20 20 20 28 65 6c 73 65 0a 09 09 20 . (else...
87c0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
87d0: 6e 74 2d 69 6e 66 6f 20 30 20 22 49 6e 76 61 6c nt-info 0 "Inval
87e0: 69 64 20 73 63 72 69 70 74 20 64 65 66 69 6e 69 id script defini
87f0: 74 6f 6e 20 66 6f 75 6e 64 20 69 6e 20 5b 73 63 ton found in [sc
8800: 72 69 70 74 73 5d 20 73 65 63 74 69 6f 6e 20 6f ripts] section o
8810: 66 20 74 65 73 74 63 6f 6e 66 69 67 2e 20 5c 22 f testconfig. \"
8820: 22 20 73 63 72 69 70 74 64 61 74 20 22 5c 22 22 " scriptdat "\""
8830: 29 29 29 29 0a 09 20 20 20 20 20 73 63 72 69 70 )))).. scrip
8840: 74 73 29 29 0a 09 20 20 3b 3b 0a 0a 09 20 20 28 ts)).. ;;... (
8850: 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 20 20 let* ((m
8860: 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 (make-mutex)
8870: 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 3f 20 )... (kill-job?
8880: 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 74 2d #f)... (exit-
8890: 69 6e 66 6f 20 20 20 20 28 6d 61 6b 65 2d 6c 61 info (make-la
88a0: 75 6e 63 68 3a 65 69 6e 66 20 70 69 64 3a 20 23 unch:einf pid: #
88b0: 74 20 65 78 69 74 2d 73 74 61 74 75 73 3a 20 23 t exit-status: #
88c0: 74 20 65 78 69 74 2d 63 6f 64 65 3a 20 23 74 20 t exit-code: #t
88d0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 3a 20 30 rollup-status: 0
88e0: 29 29 20 3b 3b 20 70 69 64 20 65 78 69 74 2d 73 )) ;; pid exit-s
88f0: 74 61 74 75 73 20 65 78 69 74 2d 63 6f 64 65 20 tatus exit-code
8900: 28 69 2e 65 2e 20 70 72 6f 63 65 73 73 20 77 61 (i.e. process wa
8910: 73 20 73 75 63 63 65 73 73 66 75 6c 6c 79 20 72 s successfully r
8920: 75 6e 29 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 un) rollup-statu
8930: 73 0a 09 09 20 28 6a 6f 62 2d 74 68 72 65 61 64 s... (job-thread
8940: 20 20 20 23 66 29 0a 09 09 20 3b 3b 20 28 6b 65 #f)... ;; (ke
8950: 65 70 2d 67 6f 69 6e 67 20 20 20 23 74 29 0a 09 ep-going #t)..
8960: 09 20 28 6d 69 73 63 2d 66 6c 61 67 73 20 20 20 . (misc-flags
8970: 28 6c 65 74 20 28 28 68 74 20 28 6d 61 6b 65 2d (let ((ht (make-
8980: 68 61 73 68 2d 74 61 62 6c 65 29 29 29 0a 09 09 hash-table)))...
8990: 09 09 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 .. (hash-table-s
89a0: 65 74 21 20 68 74 20 27 6b 65 65 70 2d 67 6f 69 et! ht 'keep-goi
89b0: 6e 67 20 23 74 29 0a 09 09 09 09 20 68 74 29 29 ng #t)..... ht))
89c0: 0a 09 09 20 28 72 75 6e 69 74 20 20 20 20 20 20 ... (runit
89d0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
89e0: 09 20 28 6c 61 75 6e 63 68 3a 6d 61 6e 61 67 65 . (launch:manage
89f0: 2d 73 74 65 70 73 20 72 75 6e 2d 69 64 20 74 65 -steps run-id te
8a00: 73 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 st-id item-path
8a10: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 7a fullrunscript ez
8a20: 73 74 65 70 73 20 73 75 62 72 75 6e 20 74 65 73 steps subrun tes
8a30: 74 2d 6e 61 6d 65 20 74 63 6f 6e 66 69 67 72 65 t-name tconfigre
8a40: 67 20 65 78 69 74 2d 69 6e 66 6f 20 6d 29 29 29 g exit-info m)))
8a50: 0a 09 09 20 28 6d 6f 6e 69 74 6f 72 6a 6f 62 20 ... (monitorjob
8a60: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 (lambda ()....
8a70: 09 20 28 6c 61 75 6e 63 68 3a 6d 6f 6e 69 74 6f . (launch:monito
8a80: 72 2d 6a 6f 62 20 20 72 75 6e 2d 69 64 20 74 65 r-job run-id te
8a90: 73 74 2d 69 64 20 69 74 65 6d 2d 70 61 74 68 20 st-id item-path
8aa0: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 65 7a fullrunscript ez
8ab0: 73 74 65 70 73 20 74 65 73 74 2d 6e 61 6d 65 20 steps test-name
8ac0: 74 63 6f 6e 66 69 67 72 65 67 20 65 78 69 74 2d tconfigreg exit-
8ad0: 69 6e 66 6f 20 6d 20 77 6f 72 6b 2d 61 72 65 61 info m work-area
8ae0: 20 72 75 6e 74 6c 69 6d 20 6d 69 73 63 2d 66 6c runtlim misc-fl
8af0: 61 67 73 29 29 29 0a 09 09 20 28 74 68 31 20 20 ags)))... (th1
8b00: 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 (make-th
8b10: 72 65 61 64 20 6d 6f 6e 69 74 6f 72 6a 6f 62 20 read monitorjob
8b20: 22 6d 6f 6e 69 74 6f 72 20 6a 6f 62 22 29 29 0a "monitor job")).
8b30: 09 09 20 28 74 68 32 20 20 20 20 20 20 20 20 20 .. (th2
8b40: 20 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 72 75 (make-thread ru
8b50: 6e 69 74 20 22 72 75 6e 20 6a 6f 62 22 29 29 0a nit "run job")).
8b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b70: 20 28 74 63 6f 6e 66 69 67 20 20 20 20 20 20 20 (tconfig
8b80: 20 20 28 74 65 73 74 73 3a 67 65 74 2d 74 65 73 (tests:get-tes
8b90: 74 63 6f 6e 66 69 67 20 74 65 73 74 2d 6e 61 6d tconfig test-nam
8ba0: 65 20 69 74 65 6d 2d 70 61 74 68 20 74 63 6f 6e e item-path tcon
8bb0: 66 69 67 72 65 67 20 23 74 29 29 0a 20 20 20 20 figreg #t)).
8bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 (pr
8bd0: 6f 70 61 67 61 74 65 2d 65 78 69 74 2d 63 6f 64 opagate-exit-cod
8be0: 65 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 e (configf:looku
8bf0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
8c00: 65 74 75 70 22 20 22 70 72 6f 70 61 67 61 74 65 etup" "propagate
8c10: 2d 65 78 69 74 2d 63 6f 64 65 22 29 29 0a 20 20 -exit-code")).
8c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8c30: 70 72 6f 70 61 67 61 74 65 2d 73 74 61 74 75 73 propagate-status
8c40: 2d 6c 69 73 74 20 27 28 22 46 41 49 4c 22 20 22 -list '("FAIL" "
8c50: 4b 49 4c 4c 45 44 22 20 22 41 42 4f 52 54 22 20 KILLED" "ABORT"
8c60: 22 44 45 41 44 22 20 22 43 48 45 43 4b 22 20 22 "DEAD" "CHECK" "
8c70: 53 4b 49 50 22 20 22 57 41 49 56 45 44 22 29 29 SKIP" "WAIVED"))
8c80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8c90: 20 20 28 74 65 73 74 2d 73 74 61 74 75 73 20 22 (test-status "
8ca0: 6e 6f 74 20 73 65 74 22 29 0a 20 20 20 20 20 20 not set").
8cb0: 20 20 20 20 20 20 20 20 20 20 20 29 0a 09 20 20 )..
8cc0: 20 20 28 73 65 74 21 20 6a 6f 62 2d 74 68 72 65 (set! job-thre
8cd0: 61 64 20 74 68 32 29 0a 09 20 20 20 20 28 74 68 ad th2).. (th
8ce0: 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 read-start! th1)
8cf0: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
8d00: 61 72 74 21 20 74 68 32 29 0a 09 20 20 20 20 28 art! th2).. (
8d10: 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 32 thread-join! th2
8d20: 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ).. (debug:pr
8d30: 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 int-info 0 *defa
8d40: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4d ult-log-port* "M
8d50: 65 67 61 74 65 73 74 20 65 78 65 63 75 74 65 20 egatest execute
8d60: 6f 66 20 74 65 73 74 20 22 20 74 65 73 74 2d 6e of test " test-n
8d70: 61 6d 65 20 22 2c 20 69 74 65 6d 20 70 61 74 68 ame ", item path
8d80: 20 22 20 69 74 65 6d 2d 70 61 74 68 20 22 20 63 " item-path " c
8d90: 6f 6d 70 6c 65 74 65 2e 20 4e 6f 74 69 66 79 69 omplete. Notifyi
8da0: 6e 67 20 74 68 65 20 64 62 20 2e 2e 2e 22 29 0a ng the db ...").
8db0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
8dc0: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
8dd0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
8de0: 74 2a 20 22 65 78 69 74 2d 69 6e 66 6f 20 3d 20 t* "exit-info =
8df0: 22 20 65 78 69 74 2d 69 6e 66 6f 29 0a 09 20 20 " exit-info)..
8e00: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
8e10: 74 21 20 6d 69 73 63 2d 66 6c 61 67 73 20 27 6b t! misc-flags 'k
8e20: 65 65 70 2d 67 6f 69 6e 67 20 23 66 29 0a 09 20 eep-going #f)..
8e30: 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 (thread-join!
8e40: 20 74 68 31 29 0a 09 20 20 20 20 28 74 68 72 65 th1).. (thre
8e50: 61 64 2d 73 6c 65 65 70 21 20 31 29 20 20 20 20 ad-sleep! 1)
8e60: 20 20 20 3b 3b 20 67 69 76 62 65 20 74 68 72 65 ;; givbe thre
8e70: 61 64 20 74 68 31 20 61 20 63 68 61 6e 63 65 20 ad th1 a chance
8e80: 74 6f 20 62 65 20 64 6f 6e 65 20 54 4f 44 4f 3a to be done TODO:
8e90: 20 56 65 72 69 66 79 20 74 68 69 73 20 69 73 20 Verify this is
8ea0: 6e 65 65 64 65 64 2e 20 41 74 20 30 2e 31 20 49 needed. At 0.1 I
8eb0: 20 77 61 73 20 67 65 74 74 69 6e 67 20 66 61 69 was getting fai
8ec0: 6c 20 74 6f 20 73 74 6f 70 2c 20 69 6e 63 72 65 l to stop, incre
8ed0: 61 73 65 64 20 74 6f 20 74 6f 74 61 6c 20 6f 66 ased to total of
8ee0: 20 31 2e 31 20 73 65 63 2e 0a 09 20 20 20 20 28 1.1 sec... (
8ef0: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 mutex-lock! m)..
8f00: 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 65 6d (let* ((item
8f10: 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 -path (item-list
8f20: 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 ->path itemdat))
8f30: 0a 09 09 20 20 20 3b 3b 20 6f 6e 6c 79 20 73 74 ... ;; only st
8f40: 61 74 65 20 61 6e 64 20 73 74 61 74 75 73 20 6e ate and status n
8f50: 65 65 64 65 64 20 2d 20 75 73 65 20 6c 61 7a 79 eeded - use lazy
8f60: 20 72 6f 75 74 69 6e 65 0a 09 09 20 20 20 28 74 routine... (t
8f70: 65 73 74 69 6e 66 6f 20 20 28 72 6d 74 3a 67 65 estinfo (rmt:ge
8f80: 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 t-testinfo-state
8f90: 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 20 74 -status run-id t
8fa0: 65 73 74 2d 69 64 29 29 29 0a 09 20 20 20 20 20 est-id)))..
8fb0: 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 ;; Am I complet
8fc0: 65 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 28 ed?.. (if (
8fd0: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
8fe0: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e get-state testin
8ff0: 66 6f 29 20 27 28 22 52 45 4d 4f 54 45 48 4f 53 fo) '("REMOTEHOS
9000: 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 TSTART" "RUNNING
9010: 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ")).
9020: 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 77 2d (let ((new-
9030: 73 74 61 74 65 20 20 28 69 66 20 6b 69 6c 6c 2d state (if kill-
9040: 6a 6f 62 3f 20 22 4b 49 4c 4c 45 44 22 20 22 43 job? "KILLED" "C
9050: 4f 4d 50 4c 45 54 45 44 22 29 29 0a 09 09 20 20 OMPLETED"))...
9060: 20 20 20 20 20 20 28 6e 65 77 2d 73 74 61 74 75 (new-statu
9070: 73 20 28 63 6f 6e 64 0a 09 09 09 09 20 20 20 20 s (cond.....
9080: 20 28 28 6e 6f 74 20 28 6c 61 75 6e 63 68 3a 65 ((not (launch:e
9090: 69 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 20 inf-exit-status
90a0: 65 78 69 74 2d 69 6e 66 6f 29 29 20 22 46 41 49 exit-info)) "FAI
90b0: 4c 22 29 20 3b 3b 20 6a 6f 62 20 66 61 69 6c 65 L") ;; job faile
90c0: 64 20 74 6f 20 72 75 6e 20 2e 2e 2e 20 28 76 65 d to run ... (ve
90d0: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
90e0: 66 6f 20 31 29 0a 09 09 09 09 20 20 20 20 20 28 fo 1)..... (
90f0: 28 65 71 3f 20 28 6c 61 75 6e 63 68 3a 65 69 6e (eq? (launch:ein
9100: 66 2d 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 f-rollup-status
9110: 65 78 69 74 2d 69 6e 66 6f 29 20 30 29 20 20 20 exit-info) 0)
9120: 20 20 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 ;; (vector-ref
9130: 20 65 78 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 exit-info 3)...
9140: 09 09 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 .. ;; if th
9150: 65 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 e current status
9160: 20 69 73 20 41 55 54 4f 20 74 68 65 6e 20 64 65 is AUTO then de
9170: 66 65 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 fer to the calcu
9180: 6c 61 74 65 64 20 76 61 6c 75 65 20 28 69 2e 65 lated value (i.e
9190: 2e 20 6c 65 61 76 65 20 74 68 69 73 20 41 55 54 . leave this AUT
91a0: 4f 29 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 O)..... (if
91b0: 20 28 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 (equal? (db:tes
91c0: 74 2d 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 t-get-status tes
91d0: 74 69 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 tinfo) "AUTO") "
91e0: 41 55 54 4f 22 20 22 50 41 53 53 22 29 29 0a 09 AUTO" "PASS"))..
91f0: 09 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c ... ((eq? (l
9200: 61 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 aunch:einf-rollu
9210: 70 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e p-status exit-in
9220: 66 6f 29 20 31 29 20 22 46 41 49 4c 22 29 20 20 fo) 1) "FAIL")
9230: 3b 3b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 ;; (vector-ref e
9240: 78 69 74 2d 69 6e 66 6f 20 33 29 0a 09 09 09 09 xit-info 3).....
9250: 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e ((eq? (laun
9260: 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 ch:einf-rollup-s
9270: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
9280: 20 32 29 09 20 20 20 20 20 3b 3b 09 28 76 65 63 2). ;;.(vec
9290: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
92a0: 6f 20 33 29 0a 09 09 09 09 20 20 20 20 20 20 3b o 3)..... ;
92b0: 3b 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 ; if the current
92c0: 20 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 status is AUTO
92d0: 74 68 65 20 64 65 66 65 72 20 74 6f 20 74 68 65 the defer to the
92e0: 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 calculated valu
92f0: 65 20 62 75 74 20 71 75 61 6c 69 66 79 20 28 69 e but qualify (i
9300: 2e 65 2e 20 6d 61 6b 65 20 74 68 69 73 20 41 55 .e. make this AU
9310: 54 4f 2d 57 41 52 4e 29 0a 09 09 09 09 20 20 20 TO-WARN).....
9320: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
9330: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
9340: 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 us testinfo) "AU
9350: 54 4f 22 29 20 22 41 55 54 4f 2d 57 41 52 4e 22 TO") "AUTO-WARN"
9360: 20 22 57 41 52 4e 22 29 29 0a 09 09 09 09 20 20 "WARN")).....
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 33 tus exit-info) 3
93a0: 29 20 22 43 48 45 43 4b 22 29 0a 09 09 09 09 20 ) "CHECK").....
93b0: 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 6e 63 ((eq? (launc
93c0: 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d 73 74 h:einf-rollup-st
93d0: 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 20 atus exit-info)
93e0: 34 29 20 22 57 41 49 56 45 44 22 29 0a 09 09 09 4) "WAIVED")....
93f0: 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 75 . ((eq? (lau
9400: 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 2d nch:einf-rollup-
9410: 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f status exit-info
9420: 29 20 35 29 20 22 41 42 4f 52 54 22 29 0a 09 09 ) 5) "ABORT")...
9430: 09 09 20 20 20 20 20 28 28 65 71 3f 20 28 6c 61 .. ((eq? (la
9440: 75 6e 63 68 3a 65 69 6e 66 2d 72 6f 6c 6c 75 70 unch:einf-rollup
9450: 2d 73 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 -status exit-inf
9460: 6f 29 20 36 29 20 22 53 4b 49 50 22 29 0a 09 09 o) 6) "SKIP")...
9470: 09 09 20 20 20 20 20 28 65 6c 73 65 20 22 46 41 .. (else "FA
9480: 49 4c 22 29 29 29 0a 20 20 20 20 20 20 20 20 20 IL"))).
9490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
94a0: 20 3b 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ;; (db:test-get
94b0: 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e 66 6f -status testinfo
94c0: 29 29 29 0a 09 09 20 20 20 20 28 64 65 62 75 67 )))... (debug
94d0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
94e0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
94f0: 20 22 54 65 73 74 20 65 78 69 74 65 64 20 69 6e "Test exited in
9500: 20 73 74 61 74 65 3d 22 20 28 64 62 3a 74 65 73 state=" (db:tes
9510: 74 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 t-get-state test
9520: 69 6e 66 6f 29 20 22 2c 20 73 65 74 74 69 6e 67 info) ", setting
9530: 20 73 74 61 74 65 2f 73 74 61 74 75 73 20 62 61 state/status ba
9540: 73 65 64 20 6f 6e 20 65 78 69 74 20 63 6f 64 65 sed on exit code
9550: 20 6f 66 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 of " (launch:ei
9560: 6e 66 2d 65 78 69 74 2d 73 74 61 74 75 73 20 65 nf-exit-status e
9570: 78 69 74 2d 69 6e 66 6f 29 20 22 20 61 6e 64 20 xit-info) " and
9580: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 6f 66 rollup-status of
9590: 20 22 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d " (launch:einf-
95a0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
95b0: 69 74 2d 69 6e 66 6f 29 29 0a 20 20 20 0a 20 20 it-info)). .
95c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
95d0: 20 20 3b 3b 20 4c 65 61 76 65 20 61 20 2e 66 69 ;; Leave a .fi
95e0: 6e 61 6c 2d 73 74 61 74 75 73 20 66 69 6c 65 20 nal-status file
95f0: 66 6f 72 20 65 61 63 68 20 73 75 62 2d 74 65 73 for each sub-tes
9600: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
9610: 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 61 76 (tests:sav
9620: 65 2d 66 69 6e 61 6c 2d 73 74 61 74 75 73 20 72 e-final-status r
9630: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 0a un-id test-id)..
9640: 09 09 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 .. (tests:tes
9650: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 72 75 t-set-status! ru
9660: 6e 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 74 n-id ...... t
9670: 65 73 74 2d 69 64 20 0a 09 09 09 09 09 20 20 20 est-id ......
9680: 20 6e 65 77 2d 73 74 61 74 65 0a 09 09 09 09 09 new-state......
9690: 20 20 20 20 6e 65 77 2d 73 74 61 74 75 73 0a 09 new-status..
96a0: 09 09 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 .... (args:ge
96b0: 74 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a t-arg "-m") #f).
96c0: 09 09 20 20 20 20 3b 3b 20 6e 65 65 64 20 74 6f .. ;; need to
96d0: 20 75 70 64 61 74 65 20 74 68 65 20 74 6f 70 20 update the top
96e0: 74 65 73 74 20 72 65 63 6f 72 64 20 69 66 20 50 test record if P
96f0: 41 53 53 20 6f 72 20 46 41 49 4c 20 61 6e 64 20 ASS or FAIL and
9700: 74 68 69 73 20 69 73 20 61 20 73 75 62 74 65 73 this is a subtes
9710: 74 0a 09 09 20 20 20 20 3b 3b 20 4e 4f 20 4e 45 t... ;; NO NE
9720: 45 44 20 54 4f 20 43 41 4c 4c 20 73 65 74 2d 73 ED TO CALL set-s
9730: 74 61 74 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d tate-status-and-
9740: 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d 73 20 48 45 roll-up-items HE
9750: 52 45 2c 20 54 48 49 53 20 49 53 20 44 4f 4e 45 RE, THIS IS DONE
9760: 20 49 4e 20 73 65 74 2d 73 74 61 74 65 2d 73 74 IN set-state-st
9770: 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
9780: 2d 69 74 65 6d 73 20 63 61 6c 6c 65 64 20 62 79 -items called by
9790: 20 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d tests:test-set-
97a0: 73 74 61 74 75 73 21 0a 09 09 20 29 0a 20 20 20 status!... ).
97b0: 20 20 20 20 20 20 20 20 20 20 20 29 0a 0a 0a 09 )....
97c0: 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 74 ;; for aut
97d0: 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e 20 omated creation
97e0: 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 74 of the rollup ht
97f0: 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 20 ml file this is
9800: 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e 0a a good place....
9810: 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
9820: 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 (equal? item-pat
9830: 68 20 22 22 29 29 0a 09 09 20 20 20 20 20 20 28 h ""))... (
9840: 74 65 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d tests:summarize-
9850: 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 items run-id tes
9860: 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 t-id test-name #
9870: 66 29 29 0a 09 20 20 20 20 20 20 28 74 65 73 74 f)).. (test
9880: 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 74 65 73 74 s:summarize-test
9890: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 run-id test-id)
98a0: 20 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 ;; don't force
98b0: 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 - just update i
98c0: 66 20 6e 6f 0a 20 20 20 20 20 20 20 20 20 20 20 f no.
98d0: 20 20 20 3b 3b 20 4c 65 61 76 65 20 61 20 2e 66 ;; Leave a .f
98e0: 69 6e 61 6c 2d 73 74 61 74 75 73 20 66 69 6c 65 inal-status file
98f0: 20 66 6f 72 20 74 68 65 20 74 6f 70 20 6c 65 76 for the top lev
9900: 65 6c 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 el test.
9910: 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 61 76 (tests:sav
9920: 65 2d 66 69 6e 61 6c 2d 73 74 61 74 75 73 20 72 e-final-status r
9930: 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 29 0a 09 un-id test-id)..
9940: 20 20 20 20 20 20 28 72 6d 74 3a 75 70 64 61 74 (rmt:updat
9950: 65 2d 72 75 6e 2d 73 74 61 74 73 20 72 75 6e 2d e-run-stats run-
9960: 69 64 20 28 72 6d 74 3a 67 65 74 2d 72 61 77 2d id (rmt:get-raw-
9970: 72 75 6e 2d 73 74 61 74 73 20 72 75 6e 2d 69 64 run-stats run-id
9980: 29 29 29 20 3b 3b 20 65 6e 64 20 6f 66 20 6c 65 ))) ;; end of le
9990: 74 2a 0a 0a 09 20 20 20 20 28 6d 75 74 65 78 2d t*... (mutex-
99a0: 75 6e 6c 6f 63 6b 21 20 6d 29 0a 20 20 20 20 20 unlock! m).
99b0: 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 3a 65 (launch:e
99c0: 6e 64 2d 6f 66 2d 72 75 6e 2d 63 68 65 63 6b 20 nd-of-run-check
99d0: 72 75 6e 2d 69 64 20 29 0a 09 20 20 20 20 28 64 run-id ).. (d
99e0: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
99f0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
9a00: 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 72 75 6e "Output from run
9a10: 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 6e 73 63 ning " fullrunsc
9a20: 72 69 70 74 20 22 2c 20 70 69 64 20 22 20 28 6c ript ", pid " (l
9a30: 61 75 6e 63 68 3a 65 69 6e 66 2d 70 69 64 20 65 aunch:einf-pid e
9a40: 78 69 74 2d 69 6e 66 6f 29 20 22 20 69 6e 20 77 xit-info) " in w
9a50: 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 20 ork area " ....
9a60: 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d work-area ":\n==
9a70: 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 ==\n exit code "
9a80: 20 28 6c 61 75 6e 63 68 3a 65 69 6e 66 2d 65 78 (launch:einf-ex
9a90: 69 74 2d 63 6f 64 65 20 65 78 69 74 2d 69 6e 66 it-code exit-inf
9aa0: 6f 29 20 22 5c 6e 22 20 22 3d 3d 3d 3d 5c 6e 22 o) "\n" "====\n"
9ab0: 29 0a 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 )...
9ac0: 28 73 65 74 21 20 74 65 73 74 2d 73 74 61 74 75 (set! test-statu
9ad0: 73 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 s (db:test-get-s
9ae0: 74 61 74 75 73 20 28 72 6d 74 3a 67 65 74 2d 74 tatus (rmt:get-t
9af0: 65 73 74 69 6e 66 6f 2d 73 74 61 74 65 2d 73 74 estinfo-state-st
9b00: 61 74 75 73 20 72 75 6e 2d 69 64 20 74 65 73 74 atus run-id test
9b10: 2d 69 64 29 29 29 0a 0a 20 20 20 20 20 20 20 20 -id)))..
9b20: 20 20 20 20 3b 3b 20 49 66 20 74 68 65 20 70 72 ;; If the pr
9b30: 6f 70 61 67 61 74 65 2d 65 78 69 74 2d 63 6f 64 opagate-exit-cod
9b40: 65 20 6f 70 74 69 6f 6e 20 68 61 73 20 62 65 65 e option has bee
9b50: 6e 20 73 65 74 20 69 6e 20 74 68 65 20 6d 65 67 n set in the meg
9b60: 61 74 65 73 74 20 63 6f 6e 66 69 67 2c 20 61 6e atest config, an
9b70: 64 20 74 68 65 20 74 65 73 74 20 73 74 61 74 75 d the test statu
9b80: 73 20 6d 61 74 63 68 65 73 20 74 68 65 20 6c 69 s matches the li
9b90: 73 74 2c 20 73 65 74 20 74 68 65 20 65 78 69 74 st, set the exit
9ba0: 20 63 6f 64 65 20 74 6f 20 31 2e 0a 0a 20 20 20 code to 1...
9bb0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
9bc0: 64 20 70 72 6f 70 61 67 61 74 65 2d 65 78 69 74 d propagate-exit
9bd0: 2d 63 6f 64 65 20 28 73 74 72 69 6e 67 3d 3f 20 -code (string=?
9be0: 70 72 6f 70 61 67 61 74 65 2d 65 78 69 74 2d 63 propagate-exit-c
9bf0: 6f 64 65 20 22 79 65 73 22 29 20 28 6d 65 6d 62 ode "yes") (memb
9c00: 65 72 20 74 65 73 74 2d 73 74 61 74 75 73 20 70 er test-status p
9c10: 72 6f 70 61 67 61 74 65 2d 73 74 61 74 75 73 2d ropagate-status-
9c20: 6c 69 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 list)).
9c30: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
9c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 (de
9c50: 62 75 67 3a 70 72 69 6e 74 20 31 20 2a 64 65 66 bug:print 1 *def
9c60: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
9c70: 53 65 74 74 69 6e 67 20 65 78 69 74 20 73 74 61 Setting exit sta
9c80: 74 75 73 20 74 6f 20 31 20 62 65 63 61 75 73 65 tus to 1 because
9c90: 20 6f 66 20 74 65 73 74 20 73 74 61 74 75 73 20 of test status
9ca0: 6f 66 20 22 20 74 65 73 74 2d 73 74 61 74 75 73 of " test-status
9cb0: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) .
9cc0: 20 20 20 28 73 65 74 21 20 2a 67 6c 6f 62 61 6c (set! *global
9cd0: 65 78 69 74 73 74 61 74 75 73 2a 20 31 29 0a 20 exitstatus* 1).
9ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 0a ).
9cf0: 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 0a 09 )...
9d00: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6c 61 (if (not (la
9d10: 75 6e 63 68 3a 65 69 6e 66 2d 65 78 69 74 2d 73 unch:einf-exit-s
9d20: 74 61 74 75 73 20 65 78 69 74 2d 69 6e 66 6f 29 tatus exit-info)
9d30: 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 0a )...(exit 4)))).
9d40: 20 20 20 20 20 20 20 20 29 29 29 0a 0a 3b 3b 20 )))..;;
9d50: 53 70 65 63 20 66 6f 72 20 45 6e 64 20 6f 66 20 Spec for End of
9d60: 74 65 73 74 0a 3b 3b 20 41 74 20 65 6e 64 20 6f test.;; At end o
9d70: 66 20 65 61 63 68 20 74 65 73 74 20 63 61 6c 6c f each test call
9d80: 2c 20 61 66 74 65 72 20 6d 61 72 6b 69 6e 67 20 , after marking
9d90: 73 65 6c 66 20 61 73 20 43 4f 4d 50 4c 45 54 45 self as COMPLETE
9da0: 44 20 64 6f 20 72 75 6e 2d 73 74 61 74 65 2d 73 D do run-state-s
9db0: 74 61 74 75 73 2d 72 6f 6c 6c 75 70 0a 3b 3b 20 tatus-rollup.;;
9dc0: 41 74 20 74 72 61 6e 73 69 74 69 6f 6e 20 74 6f At transition to
9dd0: 20 72 75 6e 20 43 4f 4d 50 4c 45 54 45 44 2f 58 run COMPLETED/X
9de0: 20 64 6f 20 68 6f 6f 6b 73 0a 3b 3b 20 44 65 66 do hooks.;; Def
9df0: 69 6e 69 74 69 6f 6e 3a 20 74 65 73 74 5f 64 65 inition: test_de
9e00: 61 64 20 69 66 20 65 76 65 6e 74 5f 74 69 6d 65 ad if event_time
9e10: 20 2b 20 64 75 72 61 74 69 6f 6e 20 2b 20 31 20 + duration + 1
9e20: 6d 69 6e 75 74 65 3f 20 3c 20 63 75 72 72 65 6e minute? < curren
9e30: 74 5f 74 69 6d 65 20 41 4e 44 0a 3b 3b 20 77 65 t_time AND.;; we
9e40: 20 63 61 6e 20 70 72 6f 76 65 20 74 68 65 20 70 can prove the p
9e50: 72 6f 63 65 73 73 20 69 73 20 6e 6f 74 20 61 6c rocess is not al
9e60: 69 76 65 20 28 73 73 68 20 68 6f 73 74 20 70 73 ive (ssh host ps
9e70: 74 72 65 65 20 2d 41 20 70 69 64 29 0a 3b 3b 20 tree -A pid).;;
9e80: 69 66 20 64 65 61 64 20 73 61 66 65 20 74 6f 20 if dead safe to
9e90: 6d 61 72 6b 20 74 68 65 20 74 65 73 74 20 61 73 mark the test as
9ea0: 20 6b 69 6c 6c 65 64 20 69 6e 20 74 68 65 20 64 killed in the d
9eb0: 62 0a 3b 3b 20 53 74 61 74 65 2f 73 74 61 74 75 b.;; State/statu
9ec0: 73 20 74 61 62 6c 65 0a 3b 3b 20 6e 65 77 0a 3b s table.;; new.;
9ed0: 3b 20 31 30 30 25 20 43 4f 4d 50 4c 45 54 45 44 ; 100% COMPLETED
9ee0: 2f 20 28 50 41 53 53 2c 46 41 49 4c 2c 41 42 4f / (PASS,FAIL,ABO
9ef0: 52 54 20 65 74 63 2e 29 20 3d 3d 3e 20 43 4f 4d RT etc.) ==> COM
9f00: 50 4c 45 54 45 44 20 2f 20 58 20 77 68 65 72 65 PLETED / X where
9f10: 20 58 20 69 73 20 73 61 6d 65 20 61 73 20 69 74 X is same as it
9f20: 65 6d 69 7a 65 64 20 72 6f 6c 6c 75 70 0a 3b 3b emized rollup.;;
9f30: 20 3e 20 33 20 52 55 4e 4e 49 4e 47 20 77 69 74 > 3 RUNNING wit
9f40: 68 20 6e 6f 74 20 74 65 73 74 5f 64 65 61 64 20 h not test_dead
9f50: 64 6f 20 6e 6f 74 68 69 6e 67 20 28 72 75 6e 20 do nothing (run
9f60: 73 68 6f 75 6c 64 20 61 6c 72 65 61 64 79 20 62 should already b
9f70: 65 20 52 55 4e 4e 49 4e 47 2f 20 6e 61 0a 3b 3b e RUNNING/ na.;;
9f80: 20 3e 20 30 20 52 55 4e 4e 49 4e 47 20 61 6e 64 > 0 RUNNING and
9f90: 20 74 65 73 74 5f 64 65 61 64 20 74 68 65 6e 20 test_dead then
9fa0: 73 65 6e 64 20 4b 49 4c 4c 52 45 51 20 3d 3d 3e send KILLREQ ==>
9fb0: 20 43 4f 4d 50 4c 45 54 45 44 0a 3b 3b 20 30 20 COMPLETED.;; 0
9fc0: 52 55 4e 4e 49 4e 47 20 3d 3d 3e 20 74 68 69 73 RUNNING ==> this
9fd0: 20 69 73 20 61 63 74 75 61 6c 6c 79 20 74 68 65 is actually the
9fe0: 20 66 69 72 73 74 20 63 6f 6e 64 69 74 69 6f 6e first condition
9ff0: 2c 20 73 68 6f 75 6c 64 20 6e 6f 74 20 67 65 74 , should not get
a000: 20 68 65 72 65 0a 0a 28 64 65 66 69 6e 65 20 28 here..(define (
a010: 6c 61 75 6e 63 68 3a 65 6e 64 2d 6f 66 2d 72 75 launch:end-of-ru
a020: 6e 2d 63 68 65 63 6b 20 72 75 6e 2d 69 64 20 29 n-check run-id )
a030: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 6f 74 . (let* ((not
a040: 2d 63 6f 6d 70 6c 65 74 65 64 2d 63 6e 74 20 28 -completed-cnt (
a050: 72 6d 74 3a 67 65 74 2d 6e 6f 74 2d 63 6f 6d 70 rmt:get-not-comp
a060: 6c 65 74 65 64 2d 63 6e 74 20 72 75 6e 2d 69 64 leted-cnt run-id
a070: 29 29 20 20 0a 20 20 20 20 20 20 20 20 20 20 20 )) .
a080: 28 72 75 6e 6e 69 6e 67 2d 63 6e 74 20 28 72 6d (running-cnt (rm
a090: 74 3a 67 65 74 2d 63 6f 75 6e 74 2d 74 65 73 74 t:get-count-test
a0a0: 73 2d 72 75 6e 6e 69 6e 67 2d 66 6f 72 2d 72 75 s-running-for-ru
a0b0: 6e 2d 69 64 20 72 75 6e 2d 69 64 29 29 0a 20 20 n-id run-id)).
a0c0: 20 20 20 20 20 20 20 20 20 28 61 6c 6c 2d 74 65 (all-te
a0d0: 73 74 2d 6c 61 75 6e 63 68 65 64 20 28 72 6d 74 st-launched (rmt
a0e0: 3a 67 65 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 :get-var (conc "
a0f0: 6c 75 6e 63 68 2d 63 6f 6d 70 6c 65 74 65 2d 22 lunch-complete-"
a100: 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 20 run-id))).
a110: 20 20 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 (current-s
a120: 74 61 74 65 20 28 72 6d 74 3a 67 65 74 2d 72 75 tate (rmt:get-ru
a130: 6e 2d 73 74 61 74 65 20 72 75 6e 2d 69 64 29 29 n-state run-id))
a140: 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 75 72 . (cur
a150: 72 65 6e 74 2d 73 74 61 74 75 73 20 28 72 6d 74 rent-status (rmt
a160: 3a 67 65 74 2d 72 75 6e 2d 73 74 61 74 75 73 20 :get-run-status
a170: 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 20 3b run-id))). ;
a180: 3b 67 65 74 2d 76 61 72 73 20 72 75 6e 2d 69 64 ;get-vars run-id
a190: 20 74 6f 20 71 75 65 72 79 20 6d 65 74 61 64 61 to query metada
a1a0: 74 61 20 74 61 62 6c 65 20 74 6f 20 63 68 65 63 ta table to chec
a1b0: 6b 20 69 66 20 61 6c 6c 20 63 6f 6d 70 6c 65 74 k if all complet
a1c0: 65 64 2e 20 69 66 20 61 6c 6c 2d 74 65 73 74 2d ed. if all-test-
a1d0: 6c 61 75 6e 63 68 65 64 20 3d 20 79 65 73 20 74 launched = yes t
a1e0: 68 65 6e 20 6f 6e 6c 79 20 6e 6f 74 2d 63 6f 6d hen only not-com
a1f0: 70 6c 65 74 65 64 2d 63 6e 74 20 3d 20 30 20 6d pleted-cnt = 0 m
a200: 65 61 6e 73 20 65 76 65 72 79 74 69 6e 67 20 69 eans everyting i
a210: 73 20 63 6f 6d 70 6c 65 74 65 64 20 69 66 20 6e s completed if n
a220: 6f 20 65 6e 74 72 79 20 66 6f 75 6e 64 20 69 6e o entry found in
a230: 20 74 68 65 20 74 61 62 6c 65 20 64 6f 20 6e 6f the table do no
a240: 74 68 69 6e 67 20 0a 20 20 20 20 20 28 64 65 62 thing . (deb
a250: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
a260: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 ult-log-port* "R
a270: 75 6e 6e 69 6e 67 20 74 65 73 74 20 63 6e 74 20 unning test cnt
a280: 3a 22 20 72 75 6e 6e 69 6e 67 2d 63 6e 74 29 20 :" running-cnt)
a290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2a0: 20 20 20 20 20 0a 20 20 20 20 20 28 72 6d 74 3a . (rmt:
a2b0: 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 set-state-status
a2c0: 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 72 75 6e -and-roll-up-run
a2d0: 20 20 72 75 6e 2d 69 64 20 63 75 72 72 65 6e 74 run-id current
a2e0: 2d 73 74 61 74 65 20 63 75 72 72 65 6e 74 2d 73 -state current-s
a2f0: 74 61 74 75 73 29 0a 20 20 20 20 20 28 72 75 6e tatus). (run
a300: 73 3a 75 70 64 61 74 65 2d 6a 75 6e 69 74 2d 74 s:update-junit-t
a310: 65 73 74 2d 72 65 70 6f 72 74 65 72 2d 78 6d 6c est-reporter-xml
a320: 20 72 75 6e 2d 69 64 29 20 0a 20 20 20 20 20 28 run-id) . (
a330: 63 6f 6e 64 20 0a 20 20 20 20 20 20 20 28 28 61 cond . ((a
a340: 6e 64 20 61 6c 6c 2d 74 65 73 74 2d 6c 61 75 6e nd all-test-laun
a350: 63 68 65 64 20 28 65 71 3f 20 6e 6f 74 2d 63 6f ched (eq? not-co
a360: 6d 70 6c 65 74 65 64 2d 63 6e 74 20 30 29 20 28 mpleted-cnt 0) (
a370: 65 71 75 61 6c 3f 20 61 6c 6c 2d 74 65 73 74 2d equal? all-test-
a380: 6c 61 75 6e 63 68 65 64 20 22 79 65 73 22 20 29 launched "yes" )
a390: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a3a0: 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 (if (and (equa
a3b0: 6c 3f 20 28 72 6d 74 3a 67 65 74 2d 76 61 72 20 l? (rmt:get-var
a3c0: 28 63 6f 6e 63 20 22 65 6e 64 2d 6f 66 2d 72 75 (conc "end-of-ru
a3d0: 6e 2d 22 20 72 75 6e 2d 69 64 29 29 20 22 6e 6f n-" run-id)) "no
a3e0: 22 29 20 28 63 6f 6d 6d 6f 6e 3a 73 69 6d 70 6c ") (common:simpl
a3f0: 65 2d 6c 6f 63 6b 20 28 63 6f 6e 63 20 22 65 6e e-lock (conc "en
a400: 64 4f 66 52 75 6e 22 20 72 75 6e 2d 69 64 29 29 dOfRun" run-id))
a410: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a420: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
a430: 20 20 20 20 09 28 64 65 62 75 67 3a 70 72 69 6e .(debug:prin
a440: 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 4 *default-log
a450: 2d 70 6f 72 74 2a 20 22 6c 6f 6f 6b 20 66 6f 72 -port* "look for
a460: 20 20 70 6f 73 74 20 68 6f 6f 6b 2e 20 63 75 72 post hook. cur
a470: 72 73 65 63 6f 6e 64 73 3a 20 22 20 28 63 75 72 rseconds: " (cur
a480: 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 22 20 rent-seconds) "
a490: 45 4f 52 20 22 20 28 72 6d 74 3a 67 65 74 2d 76 EOR " (rmt:get-v
a4a0: 61 72 20 28 63 6f 6e 63 20 22 65 6e 64 2d 6f 66 ar (conc "end-of
a4b0: 2d 72 75 6e 2d 22 20 72 75 6e 2d 69 64 29 29 29 -run-" run-id)))
a4c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a4d0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
a4e0: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
a4f0: 74 2a 20 22 45 6e 64 20 6f 66 20 52 75 6e 20 44 t* "End of Run D
a500: 65 74 65 63 74 65 64 2e 22 29 0a 20 20 20 20 20 etected.").
a510: 20 20 20 20 20 20 20 20 20 20 20 28 72 6d 74 3a (rmt:
a520: 73 65 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 65 set-var (conc "e
a530: 6e 64 2d 6f 66 2d 72 75 6e 2d 22 20 72 75 6e 2d nd-of-run-" run-
a540: 69 64 29 20 22 79 65 73 22 29 0a 20 20 20 20 20 id) "yes").
a550: 20 20 20 20 20 20 20 20 20 20 20 3b 28 74 68 72 ;(thr
a560: 65 61 64 2d 73 6c 65 65 70 21 20 31 30 29 0a 20 ead-sleep! 10).
a570: 20 20 20 20 20 20 20 20 20 09 28 72 75 6e 73 3a .(runs:
a580: 72 75 6e 2d 70 6f 73 74 2d 68 6f 6f 6b 20 72 75 run-post-hook ru
a590: 6e 2d 69 64 29 0a 20 20 20 20 20 20 20 20 20 20 n-id).
a5a0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
a5b0: 6e 74 20 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 4 *default-lo
a5c0: 67 2d 70 6f 72 74 2a 20 22 63 75 72 72 73 65 63 g-port* "currsec
a5d0: 6f 6e 64 73 3a 20 22 20 28 63 75 72 72 65 6e 74 onds: " (current
a5e0: 2d 73 65 63 6f 6e 64 73 29 22 20 65 6f 72 3a 20 -seconds)" eor:
a5f0: 22 20 28 72 6d 74 3a 67 65 74 2d 76 61 72 20 28 " (rmt:get-var (
a600: 63 6f 6e 63 20 22 65 6e 64 2d 6f 66 2d 72 75 6e conc "end-of-run
a610: 2d 22 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 -" run-id))).
a620: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
a630: 6d 6d 6f 6e 3a 73 69 6d 70 6c 65 2d 75 6e 6c 6f mmon:simple-unlo
a640: 63 6b 20 28 63 6f 6e 63 20 22 65 6e 64 4f 66 52 ck (conc "endOfR
a650: 75 6e 22 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 un" run-id))).
a660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
a670: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
a680: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
a690: 20 22 45 6e 64 20 6f 66 20 52 75 6e 20 44 65 74 "End of Run Det
a6a0: 65 63 74 65 64 20 62 75 74 20 6e 6f 74 20 72 75 ected but not ru
a6b0: 6e 6e 69 6e 67 20 70 6f 73 74 20 68 6f 6f 6b 2e nning post hook.
a6c0: 20 54 68 69 73 20 73 68 6f 75 6c 64 20 68 61 70 This should hap
a6d0: 70 65 6e 20 77 68 65 6e 20 65 6f 72 20 69 73 20 pen when eor is
a6e0: 73 65 74 20 74 6f 20 79 65 73 2e 20 54 68 69 73 set to yes. This
a6f0: 20 77 69 6c 6c 20 68 61 70 70 65 6e 20 6f 6e 6c will happen onl
a700: 79 20 77 68 65 6e 20 32 20 74 65 73 74 73 20 65 y when 2 tests e
a710: 78 69 74 20 61 74 20 73 6d 61 65 20 74 69 6d 65 xit at smae time
a720: 2e 20 65 6f 72 3d 20 22 20 28 72 6d 74 3a 67 65 . eor= " (rmt:ge
a730: 74 2d 76 61 72 20 28 63 6f 6e 63 20 22 65 6e 64 t-var (conc "end
a740: 2d 6f 66 2d 72 75 6e 2d 22 20 72 75 6e 2d 69 64 -of-run-" run-id
a750: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 ))))). ((
a760: 3e 20 72 75 6e 6e 69 6e 67 2d 63 6e 74 20 33 29 > running-cnt 3)
a770: 20 0a 20 20 20 20 20 20 20 20 09 20 20 28 64 65 . . (de
a780: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
a790: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
a7a0: 54 68 65 72 65 20 61 72 65 20 22 20 72 75 6e 6e There are " runn
a7b0: 69 6e 67 2d 63 6e 74 20 22 20 74 65 73 74 73 20 ing-cnt " tests
a7c0: 72 75 6e 6e 69 6e 67 2e 22 20 29 29 0a 20 20 20 running." )).
a7d0: 20 20 20 20 20 28 28 3e 20 72 75 6e 6e 69 6e 67 ((> running
a7e0: 2d 63 6e 74 20 30 29 0a 20 20 20 20 20 20 20 20 -cnt 0).
a7f0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
a800: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
a810: 70 6f 72 74 2a 20 22 72 75 6e 6e 69 6e 67 20 63 port* "running c
a820: 6e 74 20 3e 20 30 20 62 75 74 20 3c 3d 20 33 20 nt > 0 but <= 3
a830: 6b 69 6c 6c 2d 72 75 6e 6e 69 6e 67 2d 74 65 73 kill-running-tes
a840: 74 73 2d 69 66 2d 64 65 61 64 22 20 29 0a 20 20 ts-if-dead" ).
a850: 20 09 09 09 09 20 20 28 6c 65 74 20 28 28 6b 69 .... (let ((ki
a860: 6c 6c 2d 63 6e 74 20 28 6c 61 75 6e 63 68 3a 6b ll-cnt (launch:k
a870: 69 6c 6c 2d 74 65 73 74 73 2d 69 66 2d 64 65 61 ill-tests-if-dea
a880: 64 20 72 75 6e 2d 69 64 29 29 29 0a 20 20 20 20 d run-id))).
a890: 20 20 20 20 20 20 20 09 09 09 28 69 66 20 28 61 ...(if (a
a8a0: 6e 64 20 61 6c 6c 2d 74 65 73 74 2d 6c 61 75 6e nd all-test-laun
a8b0: 63 68 65 64 20 20 28 65 71 75 61 6c 3f 20 61 6c ched (equal? al
a8c0: 6c 2d 74 65 73 74 2d 6c 61 75 6e 63 68 65 64 20 l-test-launched
a8d0: 22 79 65 73 22 29 20 28 65 71 3f 20 6b 69 6c 6c "yes") (eq? kill
a8e0: 2d 63 6e 74 20 72 75 6e 6e 69 6e 67 2d 63 6e 74 -cnt running-cnt
a8f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 09 09 )). ..
a900: 09 09 09 28 6c 61 75 6e 63 68 3a 65 6e 64 2d 6f ...(launch:end-o
a910: 66 2d 72 75 6e 2d 63 68 65 63 6b 20 72 75 6e 2d f-run-check run-
a920: 69 64 29 29 29 29 20 3b 3b 74 6f 64 6f 0a 20 20 id)))) ;;todo.
a930: 20 20 20 20 20 20 28 65 6c 73 65 20 20 28 64 65 (else (de
a940: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
a950: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
a960: 53 68 6f 75 6c 64 20 69 74 20 67 65 74 20 68 65 Should it get he
a970: 72 65 3f 3f 20 4d 61 79 20 62 65 20 65 76 65 72 re?? May be ever
a980: 79 74 68 69 6e 67 20 69 73 20 6e 6f 74 20 6c 61 ything is not la
a990: 75 6e 63 68 65 64 20 79 65 74 2e 20 52 75 6e 6e unched yet. Runn
a9a0: 69 6e 67 20 74 65 73 74 20 63 6e 74 3a 22 20 72 ing test cnt:" r
a9b0: 75 6e 6e 69 6e 67 2d 63 6e 74 20 22 20 4e 6f 74 unning-cnt " Not
a9c0: 20 63 6f 6d 70 6c 65 74 65 64 20 74 65 73 74 20 completed test
a9d0: 63 6e 74 3a 22 20 6e 6f 74 2d 63 6f 6d 70 6c 65 cnt:" not-comple
a9e0: 74 65 64 2d 63 6e 74 29 0a 20 20 20 20 20 20 20 ted-cnt).
a9f0: 20 20 28 6c 65 74 2a 20 28 28 6e 6f 74 2d 63 6f (let* ((not-co
aa00: 6d 70 6c 65 74 65 64 2d 74 65 73 74 73 20 28 72 mpleted-tests (r
aa10: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
aa20: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 22 25 22 20 -run run-id "%"
aa30: 60 28 22 4e 4f 54 5f 53 54 41 52 54 45 44 22 20 `("NOT_STARTED"
aa40: 22 52 55 4e 4e 49 4e 47 22 20 22 4c 41 55 4e 43 "RUNNING" "LAUNC
aa50: 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f 53 54 HED" "REMOTEHOST
aa60: 53 54 41 52 54 22 29 20 60 28 29 20 23 66 20 23 START") `() #f #
aa70: 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 f #f #f #f #f #f
aa80: 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 28 69 #f))). (i
aa90: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 6e 6f 74 f (> (length not
aaa0: 2d 63 6f 6d 70 6c 65 74 65 64 2d 74 65 73 74 73 -completed-tests
aab0: 29 20 30 29 20 0a 20 20 20 20 20 20 20 20 20 20 ) 0) .
aac0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e (let loop ((run
aad0: 6e 69 6e 67 2d 74 65 73 74 20 28 63 61 72 20 6e ning-test (car n
aae0: 6f 74 2d 63 6f 6d 70 6c 65 74 65 64 2d 74 65 73 ot-completed-tes
aaf0: 74 73 29 29 0a 09 09 09 20 20 20 20 20 28 74 61 ts)).... (ta
ab00: 6c 20 20 20 20 28 63 64 72 20 6e 6f 74 2d 63 6f l (cdr not-co
ab10: 6d 70 6c 65 74 65 64 2d 74 65 73 74 73 29 29 29 mpleted-tests)))
ab20: 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 2a 20 ... (let*
ab30: 28 28 74 65 73 74 2d 6e 61 6d 65 20 28 76 65 63 ((test-name (vec
ab40: 74 6f 72 2d 72 65 66 20 72 75 6e 6e 69 6e 67 2d tor-ref running-
ab50: 74 65 73 74 20 32 29 29 0a 20 20 20 20 20 20 20 test 2)).
ab60: 20 20 20 20 20 20 20 20 20 20 28 69 74 65 6d 2d (item-
ab70: 70 61 74 68 20 28 76 65 63 74 6f 72 2d 72 65 66 path (vector-ref
ab80: 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 31 31 running-test 11
ab90: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 09 28 ))).... .(
aba0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
abb0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
abc0: 20 22 74 65 73 74 20 22 20 74 65 73 74 2d 6e 61 "test " test-na
abd0: 6d 65 20 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 me "/" item-path
abe0: 20 22 20 6e 6f 74 20 63 6f 6d 70 6c 65 74 65 64 " not completed
abf0: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
ac00: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
ac10: 20 74 61 6c 29 29 0a 09 09 20 20 28 6c 6f 6f 70 tal))... (loop
ac20: 20 28 63 61 72 20 74 61 6c 29 20 28 63 64 72 20 (car tal) (cdr
ac30: 74 61 6c 29 29 29 29 29 29 29 29 29 29 29 0a 0a tal)))))))))))..
ac40: 3b 3b 20 72 65 70 6c 61 63 65 64 20 62 65 6c 6f ;; replaced belo
ac50: 77 20 77 69 74 68 20 76 65 72 73 69 6f 6e 20 74 w with version t
ac60: 68 61 74 20 64 6f 65 73 20 6e 6f 74 20 73 73 68 hat does not ssh
ac70: 20 69 66 20 63 68 65 63 6b 69 6e 67 20 6f 6e 20 if checking on
ac80: 6c 6f 63 61 6c 68 6f 73 74 0a 23 3b 28 64 65 66 localhost.#;(def
ac90: 69 6e 65 20 28 6c 61 75 6e 63 68 3a 69 73 2d 74 ine (launch:is-t
aca0: 65 73 74 2d 61 6c 69 76 65 20 68 6f 73 74 20 70 est-alive host p
acb0: 69 64 29 0a 20 20 28 69 66 20 28 61 6e 64 20 68 id). (if (and h
acc0: 6f 73 74 20 70 69 64 20 28 6e 6f 74 20 28 65 71 ost pid (not (eq
acd0: 75 61 6c 3f 20 68 6f 73 74 20 22 6e 2f 61 22 29 ual? host "n/a")
ace0: 29 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 )). (let* (
acf0: 28 63 6d 64 20 28 63 6f 6e 63 20 22 73 73 68 20 (cmd (conc "ssh
ad00: 22 20 68 6f 73 74 20 22 20 70 73 74 72 65 65 20 " host " pstree
ad10: 2d 41 20 22 20 70 69 64 29 29 0a 09 20 20 20 20 -A " pid))..
ad20: 20 28 6f 75 74 70 75 74 20 28 77 69 74 68 2d 69 (output (with-i
ad30: 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 65 20 63 nput-from-pipe c
ad40: 6d 64 20 72 65 61 64 2d 6c 69 6e 65 73 29 29 29 md read-lines)))
ad50: 0a 09 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 ..(debug:print 2
ad60: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
ad70: 72 74 2a 20 22 52 75 6e 6e 69 6e 67 20 22 20 63 rt* "Running " c
ad80: 6d 64 20 22 20 72 65 63 65 69 76 65 64 20 22 20 md " received "
ad90: 6f 75 74 70 75 74 29 0a 09 28 69 66 20 28 65 71 output)..(if (eq
ada0: 3f 20 28 6c 65 6e 67 74 68 20 6f 75 74 70 75 74 ? (length output
adb0: 29 20 30 29 0a 09 20 20 20 23 66 0a 09 20 20 20 ) 0).. #f..
adc0: 23 74 29 29 0a 20 20 20 20 20 20 23 74 29 29 0a #t)). #t)).
add0: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
ade0: 3a 69 73 2d 74 65 73 74 2d 61 6c 69 76 65 20 68 :is-test-alive h
adf0: 6f 73 74 20 70 69 64 29 0a 20 20 28 6c 65 74 2a ost pid). (let*
ae00: 20 28 28 73 61 6d 65 2d 68 6f 73 74 20 28 65 71 ((same-host (eq
ae10: 75 61 6c 3f 20 68 6f 73 74 20 28 67 65 74 2d 68 ual? host (get-h
ae20: 6f 73 74 2d 6e 61 6d 65 29 29 29 0a 09 20 28 63 ost-name))).. (c
ae30: 6d 64 20 28 63 6f 6e 63 20 0a 09 20 20 20 20 20 md (conc ..
ae40: 20 20 28 69 66 20 73 61 6d 65 2d 68 6f 73 74 20 (if same-host
ae50: 22 22 20 28 63 6f 6e 63 20 22 73 73 68 20 22 68 "" (conc "ssh "h
ae60: 6f 73 74 22 20 22 29 29 0a 09 20 20 20 20 20 20 ost" "))..
ae70: 20 22 70 73 74 72 65 65 20 2d 41 20 22 70 69 64 "pstree -A "pid
ae80: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 ))). (if (and
ae90: 20 68 6f 73 74 20 70 69 64 0a 09 20 20 20 20 20 host pid..
aea0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 68 6f 73 (not (equal? hos
aeb0: 74 20 22 6e 2f 61 22 29 29 29 0a 09 0a 09 28 6c t "n/a")))....(l
aec0: 65 74 2a 20 28 28 6f 75 74 70 75 74 20 28 77 69 et* ((output (wi
aed0: 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 th-input-from-pi
aee0: 70 65 20 63 6d 64 20 72 65 61 64 2d 6c 69 6e 65 pe cmd read-line
aef0: 73 29 29 29 0a 09 20 20 28 64 65 62 75 67 3a 70 s))).. (debug:p
af00: 72 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d rint 2 *default-
af10: 6c 6f 67 2d 70 6f 72 74 2a 20 22 52 75 6e 6e 69 log-port* "Runni
af20: 6e 67 20 22 20 63 6d 64 20 22 20 72 65 63 65 69 ng " cmd " recei
af30: 76 65 64 20 22 20 6f 75 74 70 75 74 29 0a 09 20 ved " output)..
af40: 20 28 69 66 20 28 65 71 3f 20 28 6c 65 6e 67 74 (if (eq? (lengt
af50: 68 20 6f 75 74 70 75 74 29 20 30 29 0a 09 20 20 h output) 0)..
af60: 20 20 20 20 23 66 0a 09 20 20 20 20 20 20 23 74 #f.. #t
af70: 29 29 0a 09 23 74 29 29 29 20 3b 3b 20 61 73 73 ))..#t))) ;; ass
af80: 75 6d 69 6e 67 20 62 61 64 20 71 75 65 72 79 20 uming bad query
af90: 69 73 20 61 62 6f 75 74 20 61 20 6c 69 76 65 20 is about a live
afa0: 74 65 73 74 20 69 73 20 6c 69 6b 65 6c 79 20 6e test is likely n
afb0: 6f 74 20 74 68 65 20 72 69 67 68 74 20 74 68 69 ot the right thi
afc0: 6e 67 20 74 6f 20 64 6f 3f 0a 0a 28 64 65 66 69 ng to do?..(defi
afd0: 6e 65 20 28 6c 61 75 6e 63 68 3a 6b 69 6c 6c 2d ne (launch:kill-
afe0: 74 65 73 74 73 2d 69 66 2d 64 65 61 64 20 72 75 tests-if-dead ru
aff0: 6e 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 n-id). (let* ((
b000: 72 75 6e 6e 69 6e 67 2d 74 65 73 74 73 20 28 72 running-tests (r
b010: 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 mt:get-tests-for
b020: 2d 72 75 6e 20 72 75 6e 2d 69 64 20 22 25 22 20 -run run-id "%"
b030: 60 28 22 52 55 4e 4e 49 4e 47 22 20 22 4c 41 55 `("RUNNING" "LAU
b040: 4e 43 48 45 44 22 20 22 52 45 4d 4f 54 45 48 4f NCHED" "REMOTEHO
b050: 53 54 53 54 41 52 54 22 29 20 60 28 29 20 23 66 STSTART") `() #f
b060: 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 20 #f #f #f #f #f
b070: 23 66 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 #f #f))).
b080: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 72 75 6e 6e (let loop ((runn
b090: 69 6e 67 2d 74 65 73 74 20 28 63 61 72 20 72 75 ing-test (car ru
b0a0: 6e 6e 69 6e 67 2d 74 65 73 74 73 29 29 0a 09 09 nning-tests))...
b0b0: 09 20 20 20 20 20 28 74 61 6c 20 20 20 20 28 63 . (tal (c
b0c0: 64 72 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 73 dr running-tests
b0d0: 29 29 0a 09 09 09 20 20 20 20 20 28 6b 69 6c 6c )).... (kill
b0e0: 2d 63 6e 74 20 30 29 29 0a 09 09 20 20 20 20 20 -cnt 0))...
b0f0: 20 20 28 6c 65 74 2a 20 28 28 74 65 73 74 2d 6e (let* ((test-n
b100: 61 6d 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ame (vector-ref
b110: 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 32 29 29 running-test 2))
b120: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b130: 20 20 28 69 74 65 6d 2d 70 61 74 68 20 28 76 65 (item-path (ve
b140: 63 74 6f 72 2d 72 65 66 20 72 75 6e 6e 69 6e 67 ctor-ref running
b150: 2d 74 65 73 74 20 31 31 29 29 0a 09 09 20 28 74 -test 11))... (t
b160: 65 73 74 2d 69 64 20 28 76 65 63 74 6f 72 2d 72 est-id (vector-r
b170: 65 66 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 ef running-test
b180: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
b190: 20 20 20 20 20 28 68 6f 73 74 20 28 76 65 63 74 (host (vect
b1a0: 6f 72 2d 72 65 66 20 72 75 6e 6e 69 6e 67 2d 74 or-ref running-t
b1b0: 65 73 74 20 36 29 29 0a 20 20 20 20 20 20 20 20 est 6)).
b1c0: 20 20 20 20 20 20 20 20 20 28 70 69 64 20 20 28 (pid (
b1d0: 72 6d 74 3a 74 65 73 74 2d 67 65 74 2d 74 6f 70 rmt:test-get-top
b1e0: 2d 70 72 6f 63 65 73 73 2d 70 69 64 20 72 75 6e -process-pid run
b1f0: 2d 69 64 20 74 65 73 74 2d 69 64 29 29 20 20 20 -id test-id))
b200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b210: 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 28 76 (event-time (v
b220: 65 63 74 6f 72 2d 72 65 66 20 72 75 6e 6e 69 6e ector-ref runnin
b230: 67 2d 74 65 73 74 20 35 29 29 0a 20 20 20 20 20 g-test 5)).
b240: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 75 72 (dur
b250: 61 74 69 6f 6e 20 28 76 65 63 74 6f 72 2d 72 65 ation (vector-re
b260: 66 20 72 75 6e 6e 69 6e 67 2d 74 65 73 74 20 31 f running-test 1
b270: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
b280: 20 20 20 20 20 28 66 6c 61 67 20 30 29 20 20 20 (flag 0)
b290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b2a0: 20 20 28 63 75 72 72 2d 74 69 6d 65 20 28 63 75 (curr-time (cu
b2b0: 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 rrent-seconds)))
b2c0: 0a 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 . (if (and
b2d0: 20 28 3c 20 28 2b 20 65 76 65 6e 74 2d 74 69 6d (< (+ event-tim
b2e0: 65 20 64 75 72 61 74 69 6f 6e 20 36 30 30 29 20 e duration 600)
b2f0: 63 75 72 72 2d 74 69 6d 65 29 20 28 6e 6f 74 20 curr-time) (not
b300: 28 6c 61 75 6e 63 68 3a 69 73 2d 74 65 73 74 2d (launch:is-test-
b310: 61 6c 69 76 65 20 68 6f 73 74 20 70 69 64 29 29 alive host pid))
b320: 29 20 3b 3b 74 65 73 74 20 68 61 73 20 6e 6f 74 ) ;;test has not
b330: 20 75 70 64 61 74 65 64 20 64 75 72 61 74 69 6f updated duratio
b340: 6e 20 69 6e 20 6c 61 73 74 20 31 30 20 6d 69 6e n in last 10 min
b350: 20 74 68 65 6e 20 6c 69 6b 65 6c 79 20 69 74 73 then likely its
b360: 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 62 75 74 not running but
b370: 20 63 6f 6e 66 69 72 6d 20 62 65 66 6f 72 65 20 confirm before
b380: 6d 61 72 6b 69 6e 67 20 69 74 20 61 73 20 6b 69 marking it as ki
b390: 6c 6c 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 lled.
b3a0: 28 62 65 67 69 6e 20 20 20 20 0a 09 09 09 20 20 (begin ....
b3b0: 20 20 20 20 20 09 28 64 65 62 75 67 3a 70 72 69 .(debug:pri
b3c0: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
b3d0: 67 2d 70 6f 72 74 2a 20 22 74 65 73 74 20 22 20 g-port* "test "
b3e0: 74 65 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 test-name "/" it
b3f0: 65 6d 2d 70 61 74 68 20 22 20 6e 65 65 64 73 20 em-path " needs
b400: 74 6f 20 62 65 20 6b 69 6c 6c 65 64 22 29 0a 20 to be killed").
b410: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
b420: 74 21 20 66 6c 61 67 20 31 29 20 0a 20 20 20 20 t! flag 1) .
b430: 20 20 20 20 20 20 20 20 20 20 28 72 6d 74 3a 73 (rmt:s
b440: 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 2d et-state-status-
b450: 61 6e 64 2d 72 6f 6c 6c 2d 75 70 2d 69 74 65 6d and-roll-up-item
b460: 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 s run-id test-na
b470: 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 22 4b 49 me item-path "KI
b480: 4c 4c 52 45 51 22 20 22 6e 2f 61 22 20 23 66 29 LLREQ" "n/a" #f)
b490: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b4a0: 20 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c (if (not (null
b4b0: 3f 20 74 61 6c 29 29 0a 09 09 09 09 20 20 28 6c ? tal))..... (l
b4c0: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 28 63 oop (car tal) (c
b4d0: 64 72 20 74 61 6c 29 20 28 2b 20 6b 69 6c 6c 2d dr tal) (+ kill-
b4e0: 63 6e 74 20 66 6c 61 67 29 29 0a 20 20 20 20 20 cnt flag)).
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 6b (+ k
b500: 69 6c 6c 2d 63 6e 74 20 66 6c 61 67 29 29 29 29 ill-cnt flag))))
b510: 29 29 0a 0a 3b 3b 20 44 4f 20 4e 4f 54 20 55 53 ))..;; DO NOT US
b520: 45 20 2d 20 63 61 63 68 69 6e 67 20 6f 66 20 63 E - caching of c
b530: 6f 6e 66 69 67 73 20 69 73 20 68 61 6e 64 6c 65 onfigs is handle
b540: 64 20 69 6e 20 6c 61 75 6e 63 68 3a 73 65 74 75 d in launch:setu
b550: 70 20 6e 6f 77 2e 0a 3b 3b 0a 28 64 65 66 69 6e p now..;;.(defin
b560: 65 20 28 6c 61 75 6e 63 68 3a 63 61 63 68 65 2d e (launch:cache-
b570: 63 6f 6e 66 69 67 29 0a 20 20 3b 3b 20 69 66 20 config). ;; if
b580: 77 65 20 68 61 76 65 20 61 20 6c 69 6e 6b 74 72 we have a linktr
b590: 65 65 20 61 6e 64 20 2d 72 75 6e 74 65 73 74 73 ee and -runtests
b5a0: 20 61 6e 64 20 2d 74 61 72 67 65 74 20 61 6e 64 and -target and
b5b0: 20 74 68 65 20 64 69 72 65 63 74 6f 72 79 20 65 the directory e
b5c0: 78 69 73 74 73 20 64 75 6d 70 20 74 68 65 20 63 xists dump the c
b5d0: 6f 6e 66 69 67 0a 20 20 3b 3b 20 74 6f 20 6d 65 onfig. ;; to me
b5e0: 67 61 74 65 73 74 2d 28 63 75 72 72 65 6e 74 2d gatest-(current-
b5f0: 73 65 63 6f 6e 64 73 29 2e 63 66 67 20 61 6e 64 seconds).cfg and
b600: 20 73 79 6d 6c 69 6e 6b 20 69 74 20 74 6f 20 6d symlink it to m
b610: 65 67 61 74 65 73 74 2e 63 66 67 0a 20 20 28 69 egatest.cfg. (i
b620: 66 20 28 61 6e 64 20 2a 63 6f 6e 66 69 67 64 61 f (and *configda
b630: 74 2a 20 0a 09 20 20 20 28 6f 72 20 28 61 72 67 t* .. (or (arg
b640: 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 22 s:get-arg "-run"
b650: 29 0a 09 20 20 20 20 20 20 20 28 61 72 67 73 3a ).. (args:
b660: 67 65 74 2d 61 72 67 20 22 2d 72 75 6e 74 65 73 get-arg "-runtes
b670: 74 73 22 29 0a 09 20 20 20 20 20 20 20 28 61 72 ts").. (ar
b680: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 65 78 65 gs:get-arg "-exe
b690: 63 75 74 65 22 29 29 29 0a 20 20 20 20 20 20 28 cute"))). (
b6a0: 6c 65 74 2a 20 28 28 6c 69 6e 6b 74 72 65 65 20 let* ((linktree
b6b0: 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b (common:get-link
b6c0: 74 72 65 65 29 29 20 3b 3b 20 28 67 65 74 2d 65 tree)) ;; (get-e
b6d0: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
b6e0: 62 6c 65 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 ble "MT_LINKTREE
b6f0: 22 29 29 0a 09 20 20 20 20 20 28 74 61 72 67 65 ")).. (targe
b700: 74 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 t (common:args
b710: 2d 67 65 74 2d 74 61 72 67 65 74 20 65 78 69 74 -get-target exit
b720: 2d 69 66 2d 62 61 64 3a 20 23 74 29 29 0a 09 20 -if-bad: #t))..
b730: 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 28 6f (runname (o
b740: 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 r (args:get-arg
b750: 22 2d 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 "-runname")....
b760: 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 (args:get-arg
b770: 22 3a 72 75 6e 6e 61 6d 65 22 29 0a 09 09 09 20 ":runname")....
b780: 20 20 28 67 65 74 65 6e 76 20 22 4d 54 5f 52 55 (getenv "MT_RU
b790: 4e 4e 41 4d 45 22 29 29 29 0a 09 20 20 20 20 20 NNAME")))..
b7a0: 28 66 75 6c 6c 64 69 72 20 20 28 63 6f 6e 63 20 (fulldir (conc
b7b0: 6c 69 6e 6b 74 72 65 65 20 22 2f 22 0a 09 09 09 linktree "/"....
b7c0: 20 20 20 20 20 74 61 72 67 65 74 20 22 2f 22 0a target "/".
b7d0: 09 09 09 20 20 20 20 20 72 75 6e 6e 61 6d 65 29 ... runname)
b7e0: 29 29 0a 09 28 69 66 20 28 61 6e 64 20 6c 69 6e ))..(if (and lin
b7f0: 6b 74 72 65 65 20 28 63 6f 6d 6d 6f 6e 3a 66 69 ktree (common:fi
b800: 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e 6b 74 le-exists? linkt
b810: 72 65 65 29 29 20 3b 3b 20 63 61 6e 27 74 20 70 ree)) ;; can't p
b820: 72 6f 63 65 65 64 20 77 69 74 68 6f 75 74 20 6c roceed without l
b830: 69 6e 6b 74 72 65 65 0a 09 20 20 20 20 28 62 65 inktree.. (be
b840: 67 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 gin.. (debu
b850: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
b860: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
b870: 2a 20 22 48 61 76 65 20 2d 72 75 6e 20 77 69 74 * "Have -run wit
b880: 68 20 74 61 72 67 65 74 3d 22 20 74 61 72 67 65 h target=" targe
b890: 74 20 22 2c 20 72 75 6e 6e 61 6d 65 3d 22 20 72 t ", runname=" r
b8a0: 75 6e 6e 61 6d 65 20 22 2c 20 66 75 6c 6c 64 69 unname ", fulldi
b8b0: 72 3d 22 20 66 75 6c 6c 64 69 72 20 22 2c 20 74 r=" fulldir ", t
b8c0: 65 73 74 70 61 74 74 3d 22 20 28 6f 72 20 28 61 estpatt=" (or (a
b8d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 65 rgs:get-arg "-te
b8e0: 73 74 70 61 74 74 22 29 20 22 25 22 29 29 0a 09 stpatt") "%"))..
b8f0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 (if (not (
b900: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
b910: 74 73 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 ts? fulldir))...
b920: 20 20 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 (create-direct
b930: 6f 72 79 20 66 75 6c 6c 64 69 72 20 23 74 29 29 ory fulldir #t))
b940: 20 3b 3b 20 6e 65 65 64 20 74 6f 20 70 72 6f 74 ;; need to prot
b950: 65 63 74 20 77 69 74 68 20 65 78 63 65 70 74 69 ect with excepti
b960: 6f 6e 20 68 61 6e 64 6c 65 72 20 0a 09 20 20 20 on handler ..
b970: 20 20 20 28 69 66 20 28 61 6e 64 20 74 61 72 67 (if (and targ
b980: 65 74 0a 09 09 20 20 20 20 20 20 20 72 75 6e 6e et... runn
b990: 61 6d 65 0a 09 09 20 20 20 20 20 20 20 28 63 6f ame... (co
b9a0: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
b9b0: 3f 20 66 75 6c 6c 64 69 72 29 29 0a 09 09 20 20 ? fulldir))...
b9c0: 28 6c 65 74 20 28 28 74 6d 70 66 69 6c 65 20 20 (let ((tmpfile
b9d0: 28 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 2f (conc fulldir "/
b9e0: 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2e 22 20 .megatest.cfg."
b9f0: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
ba00: 29 29 29 0a 09 09 09 28 74 61 72 67 66 69 6c 65 )))....(targfile
ba10: 20 28 63 6f 6e 63 20 66 75 6c 6c 64 69 72 20 22 (conc fulldir "
ba20: 2f 2e 6d 65 67 61 74 65 73 74 2e 63 66 67 2d 22 /.megatest.cfg-"
ba30: 20 20 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 megatest-versi
ba40: 6f 6e 20 22 2d 22 20 6d 65 67 61 74 65 73 74 2d on "-" megatest-
ba50: 66 6f 73 73 69 6c 2d 68 61 73 68 29 29 0a 09 09 fossil-hash))...
ba60: 09 28 72 63 6f 6e 66 69 67 20 20 28 63 6f 6e 63 .(rconfig (conc
ba70: 20 66 75 6c 6c 64 69 72 20 22 2f 2e 72 75 6e 63 fulldir "/.runc
ba80: 6f 6e 66 69 67 2e 22 20 6d 65 67 61 74 65 73 74 onfig." megatest
ba90: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
baa0: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
bab0: 68 29 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 h)))... (if (
bac0: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
bad0: 74 73 3f 20 72 63 6f 6e 66 69 67 29 20 3b 3b 20 ts? rconfig) ;;
bae0: 6f 6e 6c 79 20 63 61 63 68 65 20 6d 65 67 61 74 only cache megat
baf0: 65 73 74 2e 63 6f 6e 66 69 67 20 41 46 54 45 52 est.config AFTER
bb00: 20 72 75 6e 63 6f 6e 66 69 67 73 20 68 61 73 20 runconfigs has
bb10: 62 65 65 6e 20 63 61 63 68 65 64 0a 09 09 09 28 been cached....(
bb20: 62 65 67 69 6e 0a 09 09 09 20 20 28 64 65 62 75 begin.... (debu
bb30: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
bb40: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
bb50: 2a 20 22 43 61 63 68 69 6e 67 20 6d 65 67 61 74 * "Caching megat
bb60: 65 73 74 2e 63 6f 6e 66 69 67 20 69 6e 20 22 20 est.config in "
bb70: 74 6d 70 66 69 6c 65 29 0a 20 20 20 20 20 20 20 tmpfile).
bb80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb90: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d (if (not (com
bba0: 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 2d 74 mon:in-running-t
bbb0: 65 73 74 3f 29 29 0a 20 20 20 20 20 20 20 20 20 est?)).
bbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbd0: 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 77 72 (configf:wr
bbe0: 69 74 65 2d 61 6c 69 73 74 20 2a 63 6f 6e 66 69 ite-alist *confi
bbf0: 67 64 61 74 2a 20 74 6d 70 66 69 6c 65 29 29 0a gdat* tmpfile)).
bc00: 09 09 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f ... (system (co
bc10: 6e 63 20 22 6c 6e 20 2d 73 66 20 22 20 74 6d 70 nc "ln -sf " tmp
bc20: 66 69 6c 65 20 22 20 22 20 74 61 72 67 66 69 6c file " " targfil
bc30: 65 29 29 29 29 0a 09 09 20 20 20 20 29 29 29 0a e))))... ))).
bc40: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
bc50: 74 2d 69 6e 66 6f 20 31 20 2a 64 65 66 61 75 6c t-info 1 *defaul
bc60: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 6f 20 t-log-port* "No
bc70: 6c 69 6e 6b 74 72 65 65 20 79 65 74 2c 20 6e 6f linktree yet, no
bc80: 20 63 61 63 68 69 6e 67 20 63 6f 6e 66 69 67 73 caching configs
bc90: 2e 22 29 29 29 29 29 0a 0a 0a 3b 3b 20 67 61 74 .")))))...;; gat
bca0: 68 65 72 20 61 76 61 69 6c 61 62 6c 65 20 69 6e her available in
bcb0: 66 6f 72 6d 61 74 69 6f 6e 2c 20 69 66 20 6c 65 formation, if le
bcc0: 67 69 74 20 72 65 61 64 20 63 6f 6e 66 69 67 73 git read configs
bcd0: 20 69 6e 20 74 68 69 73 20 6f 72 64 65 72 3a 0a in this order:.
bce0: 3b 3b 0a 3b 3b 20 20 20 69 66 20 68 61 76 65 20 ;;.;; if have
bcf0: 63 61 63 68 65 3b 0a 3b 3b 20 20 20 20 20 20 72 cache;.;; r
bd00: 65 61 64 20 69 74 20 61 20 72 65 74 75 72 6e 20 ead it a return
bd10: 69 74 0a 3b 3b 20 20 20 65 6c 73 65 0a 3b 3b 20 it.;; else.;;
bd20: 20 20 20 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e megatest.con
bd30: 66 69 67 20 20 20 20 20 28 64 6f 20 6e 6f 74 20 fig (do not
bd40: 63 61 63 68 65 29 0a 3b 3b 20 20 20 20 20 72 75 cache).;; ru
bd50: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 20 nconfigs.config
bd60: 20 20 28 63 61 63 68 65 20 69 66 20 61 6c 6c 20 (cache if all
bd70: 76 61 72 73 20 61 76 61 69 6c 29 0a 3b 3b 20 20 vars avail).;;
bd80: 20 20 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 megatest.conf
bd90: 69 67 20 20 20 20 20 28 63 61 63 68 65 20 69 66 ig (cache if
bda0: 20 61 6c 6c 20 76 61 72 73 20 61 76 61 69 6c 29 all vars avail)
bdb0: 0a 3b 3b 20 20 20 72 65 74 75 72 6e 73 3a 0a 3b .;; returns:.;
bdc0: 3b 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a 0a ; *toppath*.
bdd0: 3b 3b 20 20 20 73 69 64 65 20 65 66 66 65 63 74 ;; side effect
bde0: 73 3a 0a 3b 3b 20 20 20 20 20 73 65 74 73 3b 20 s:.;; sets;
bdf0: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 20 20 28 *configdat* (
be00: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 megatest.config
be10: 69 6e 66 6f 29 0a 3b 3b 20 20 20 20 20 20 20 20 info).;;
be20: 20 20 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 *runconfigdat
be30: 2a 20 28 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f * (runconfigs.co
be40: 6e 66 69 67 20 69 6e 66 6f 29 0a 3b 3b 20 20 20 nfig info).;;
be50: 20 20 20 20 20 20 20 20 2a 63 6f 6e 66 69 67 73 *configs
be60: 74 61 74 75 73 2a 20 28 73 74 61 74 75 73 20 6f tatus* (status o
be70: 66 20 74 68 65 20 72 65 61 64 20 64 61 74 61 29 f the read data)
be80: 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 .;;.(define (lau
be90: 6e 63 68 3a 73 65 74 75 70 20 23 21 6b 65 79 20 nch:setup #!key
bea0: 28 66 6f 72 63 65 2d 72 65 72 65 61 64 20 23 66 (force-reread #f
beb0: 29 20 28 61 72 65 61 70 61 74 68 20 23 66 29 29 ) (areapath #f))
bec0: 0a 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 . (mutex-lock!
bed0: 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 *launch-setup-mu
bee0: 74 65 78 2a 29 0a 20 20 28 69 66 20 28 61 6e 64 tex*). (if (and
bef0: 20 2a 74 6f 70 70 61 74 68 2a 0a 09 20 20 20 28 *toppath*.. (
bf00: 65 71 3f 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 eq? *configstatu
bf10: 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 20 28 6e s* 'fulldata) (n
bf20: 6f 74 20 66 6f 72 63 65 2d 72 65 72 65 61 64 29 ot force-reread)
bf30: 29 20 3b 3b 20 67 6f 74 20 69 74 20 61 6c 6c 0a ) ;; got it all.
bf40: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 28 64 (begin..(d
bf50: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
bf60: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
bf70: 22 4e 4f 54 45 3a 20 73 6b 69 70 70 69 6e 67 20 "NOTE: skipping
bf80: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 launch:setup-bod
bf90: 79 20 63 61 6c 6c 20 73 69 6e 63 65 20 77 65 20 y call since we
bfa0: 68 61 76 65 20 66 75 6c 6c 64 61 74 61 22 29 0a have fulldata").
bfb0: 09 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 .(mutex-unlock!
bfc0: 2a 6c 61 75 6e 63 68 2d 73 65 74 75 70 2d 6d 75 *launch-setup-mu
bfd0: 74 65 78 2a 29 0a 09 2a 74 6f 70 70 61 74 68 2a tex*)..*toppath*
bfe0: 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 ). (let ((r
bff0: 65 73 20 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 es (launch:setup
c000: 2d 62 6f 64 79 20 66 6f 72 63 65 2d 72 65 72 65 -body force-rere
c010: 61 64 3a 20 66 6f 72 63 65 2d 72 65 72 65 61 64 ad: force-reread
c020: 20 61 72 65 61 70 61 74 68 3a 20 61 72 65 61 70 areapath: areap
c030: 61 74 68 29 29 29 0a 09 28 6d 75 74 65 78 2d 75 ath)))..(mutex-u
c040: 6e 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 2d 73 nlock! *launch-s
c050: 65 74 75 70 2d 6d 75 74 65 78 2a 29 0a 09 72 65 etup-mutex*)..re
c060: 73 29 29 29 0a 0a 3b 3b 20 72 65 74 75 72 6e 20 s)))..;; return
c070: 70 61 74 68 73 20 64 65 70 65 6e 64 69 6e 67 20 paths depending
c080: 6f 6e 20 77 68 61 74 20 69 6e 66 6f 20 69 73 20 on what info is
c090: 61 76 61 69 6c 61 62 6c 65 2e 0a 3b 3b 0a 28 64 available..;;.(d
c0a0: 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 3a 67 65 efine (launch:ge
c0b0: 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d 70 61 74 t-cache-file-pat
c0c0: 68 73 20 61 72 65 61 70 61 74 68 20 74 6f 70 70 hs areapath topp
c0d0: 61 74 68 20 74 61 72 67 65 74 20 6d 74 63 6f 6e ath target mtcon
c0e0: 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 28 75 fig). (let* ((u
c0f0: 73 65 2d 63 61 63 68 65 20 28 63 6f 6d 6d 6f 6e se-cache (common
c100: 3a 75 73 65 2d 63 61 63 68 65 3f 29 29 0a 20 20 :use-cache?)).
c110: 20 20 20 20 20 20 20 28 72 75 6e 6e 61 6d 65 20 (runname
c120: 20 28 63 6f 6d 6d 6f 6e 3a 61 72 67 73 2d 67 65 (common:args-ge
c130: 74 2d 72 75 6e 6e 61 6d 65 29 29 0a 20 20 20 20 t-runname)).
c140: 20 20 20 20 20 28 6c 69 6e 6b 74 72 65 65 20 28 (linktree (
c150: 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 common:get-linkt
c160: 72 65 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 ree)). (
c170: 74 65 73 74 6e 61 6d 65 20 28 63 6f 6d 6d 6f 6e testname (common
c180: 3a 67 65 74 2d 66 75 6c 6c 2d 74 65 73 74 2d 6e :get-full-test-n
c190: 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 ame)). (
c1a0: 72 75 6e 64 69 72 20 20 20 28 69 66 20 28 61 6e rundir (if (an
c1b0: 64 20 72 75 6e 6e 61 6d 65 20 74 61 72 67 65 74 d runname target
c1c0: 20 6c 69 6e 6b 74 72 65 65 29 0a 20 20 20 20 20 linktree).
c1d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c1e0: 20 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 (common:direct
c1f0: 6f 72 79 2d 77 72 69 74 61 62 6c 65 3f 20 28 63 ory-writable? (c
c200: 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 22 2f 22 onc linktree "/"
c210: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
c220: 61 6d 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 ame)).
c230: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
c240: 29 0a 20 20 20 20 20 20 20 20 20 28 74 65 73 74 ). (test
c250: 64 69 72 20 20 28 69 66 20 28 61 6e 64 20 72 75 dir (if (and ru
c260: 6e 64 69 72 20 74 65 73 74 6e 61 6d 65 29 0a 20 ndir testname).
c270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c280: 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 64 69 (common:di
c290: 72 65 63 74 6f 72 79 2d 77 72 69 74 61 62 6c 65 rectory-writable
c2a0: 3f 20 28 63 6f 6e 63 20 72 75 6e 64 69 72 20 22 ? (conc rundir "
c2b0: 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 0a 20 20 /" testname)).
c2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c2d0: 20 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 #f)).
c2e0: 20 20 20 28 63 61 63 68 65 64 69 72 20 28 6f 72 (cachedir (or
c2f0: 20 74 65 73 74 64 69 72 20 72 75 6e 64 69 72 29 testdir rundir)
c300: 29 0a 20 20 20 20 20 20 20 20 20 28 6d 74 63 61 ). (mtca
c310: 63 68 65 66 20 28 61 6e 64 20 63 61 63 68 65 64 chef (and cached
c320: 69 72 20 28 63 6f 6e 63 20 63 61 63 68 65 64 69 ir (conc cachedi
c330: 72 20 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 74 r "/" ".megatest
c340: 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 .cfg-" megatest
c350: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
c360: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
c370: 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 h))). (r
c380: 63 63 61 63 68 65 66 20 28 61 6e 64 20 63 61 63 ccachef (and cac
c390: 68 65 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 hedir (conc cach
c3a0: 65 64 69 72 20 22 2f 22 20 22 2e 72 75 6e 63 6f edir "/" ".runco
c3b0: 6e 66 69 67 73 2e 63 66 67 2d 22 20 20 6d 65 67 nfigs.cfg-" meg
c3c0: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d atest-version "-
c3d0: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
c3e0: 6c 2d 68 61 73 68 29 29 29 29 0a 20 20 20 20 28 l-hash)))). (
c3f0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
c400: 20 36 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 6 *default-log-
c410: 70 6f 72 74 2a 20 0a 20 20 20 20 20 20 20 20 20 port* .
c420: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 72 75 "ru
c430: 6e 6e 61 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 20 nname=" runname
c440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c450: 20 20 20 20 20 20 20 22 5c 6e 20 20 6c 69 6e 6b "\n link
c460: 74 72 65 65 3d 22 20 6c 69 6e 6b 74 72 65 65 0a tree=" linktree.
c470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c480: 20 20 20 20 20 20 22 5c 6e 20 20 74 65 73 74 6e "\n testn
c490: 61 6d 65 3d 22 20 74 65 73 74 6e 61 6d 65 0a 20 ame=" testname.
c4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4b0: 20 20 20 20 20 22 5c 6e 20 20 72 75 6e 64 69 72 "\n rundir
c4c0: 3d 22 20 72 75 6e 64 69 72 20 0a 20 20 20 20 20 =" rundir .
c4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c4e0: 20 22 5c 6e 20 20 74 65 73 74 64 69 72 3d 22 20 "\n testdir="
c4f0: 74 65 73 74 64 69 72 20 0a 20 20 20 20 20 20 20 testdir .
c500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
c510: 5c 6e 20 20 63 61 63 68 65 64 69 72 3d 22 20 63 \n cachedir=" c
c520: 61 63 68 65 64 69 72 0a 20 20 20 20 20 20 20 20 achedir.
c530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 5c "\
c540: 6e 20 20 6d 74 63 61 63 68 65 66 3d 22 20 6d 74 n mtcachef=" mt
c550: 63 61 63 68 65 66 0a 20 20 20 20 20 20 20 20 20 cachef.
c560: 20 20 20 20 20 20 20 20 20 20 20 20 20 22 5c 6e "\n
c570: 20 20 72 63 63 61 63 68 65 66 3d 22 20 72 63 63 rccachef=" rcc
c580: 61 63 68 65 66 29 0a 20 20 20 20 28 63 6f 6e 73 achef). (cons
c590: 20 6d 74 63 61 63 68 65 66 20 72 63 63 61 63 68 mtcachef rccach
c5a0: 65 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ef)))..(define (
c5b0: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 launch:setup-bod
c5c0: 79 20 23 21 6b 65 79 20 28 66 6f 72 63 65 2d 72 y #!key (force-r
c5d0: 65 72 65 61 64 20 23 66 29 20 28 61 72 65 61 70 eread #f) (areap
c5e0: 61 74 68 20 23 66 29 29 0a 20 20 28 69 66 20 28 ath #f)). (if (
c5f0: 61 6e 64 20 28 65 71 3f 20 2a 63 6f 6e 66 69 67 and (eq? *config
c600: 73 74 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 status* 'fulldat
c610: 61 29 0a 09 20 20 20 2a 74 6f 70 70 61 74 68 2a a).. *toppath*
c620: 0a 09 20 20 20 28 6e 6f 74 20 66 6f 72 63 65 2d .. (not force-
c630: 72 65 72 65 61 64 29 29 20 3b 3b 20 6e 6f 20 6e reread)) ;; no n
c640: 65 65 64 20 74 6f 20 72 65 70 72 6f 63 65 73 73 eed to reprocess
c650: 0a 20 20 20 20 20 20 2a 74 6f 70 70 61 74 68 2a . *toppath*
c660: 20 20 20 3b 3b 20 72 65 74 75 72 6e 20 74 6f 70 ;; return top
c670: 70 61 74 68 0a 20 20 20 20 20 20 28 6c 65 74 2a path. (let*
c680: 20 28 28 75 73 65 2d 63 61 63 68 65 20 28 63 6f ((use-cache (co
c690: 6d 6d 6f 6e 3a 75 73 65 2d 63 61 63 68 65 3f 29 mmon:use-cache?)
c6a0: 29 20 3b 3b 20 42 42 2d 20 75 73 65 2d 63 61 63 ) ;; BB- use-cac
c6b0: 68 65 20 63 68 65 63 6b 73 20 2a 63 6f 6e 66 69 he checks *confi
c6c0: 67 64 61 74 2a 20 66 6f 72 20 75 73 65 2d 63 61 gdat* for use-ca
c6d0: 63 68 65 20 73 65 74 74 69 6e 67 2e 20 20 57 65 che setting. We
c6e0: 20 64 6f 20 6e 6f 74 20 68 61 76 65 20 2a 63 6f do not have *co
c6f0: 6e 66 69 67 64 61 74 2a 2e 20 20 42 6f 6f 74 73 nfigdat*. Boots
c700: 74 72 61 70 70 69 6e 67 20 70 72 6f 62 6c 65 6d trapping problem
c710: 20 68 65 72 65 2e 0a 09 20 20 20 20 20 28 74 6f here... (to
c720: 70 70 61 74 68 20 20 28 63 6f 6d 6d 6f 6e 3a 67 ppath (common:g
c730: 65 74 2d 74 6f 70 70 61 74 68 20 61 72 65 61 70 et-toppath areap
c740: 61 74 68 29 29 0a 09 20 20 20 20 20 28 74 61 72 ath)).. (tar
c750: 67 65 74 20 20 20 28 63 6f 6d 6d 6f 6e 3a 61 72 get (common:ar
c760: 67 73 2d 67 65 74 2d 74 61 72 67 65 74 29 29 0a gs-get-target)).
c770: 09 20 20 20 20 20 28 73 65 63 74 69 6f 6e 73 20 . (sections
c780: 28 69 66 20 74 61 72 67 65 74 20 28 6c 69 73 74 (if target (list
c790: 20 22 64 65 66 61 75 6c 74 22 20 74 61 72 67 65 "default" targe
c7a0: 74 29 20 23 66 29 29 20 3b 3b 20 66 6f 72 20 72 t) #f)) ;; for r
c7b0: 75 6e 63 6f 6e 66 69 67 73 0a 09 20 20 20 20 20 unconfigs..
c7c0: 28 6d 74 63 6f 6e 66 69 67 20 28 6f 72 20 28 61 (mtconfig (or (a
c7d0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
c7e0: 6e 66 69 67 22 29 20 22 6d 65 67 61 74 65 73 74 nfig") "megatest
c7f0: 2e 63 6f 6e 66 69 67 22 29 29 20 3b 3b 20 61 6c .config")) ;; al
c800: 6c 6f 77 20 6f 76 65 72 72 69 64 69 6e 67 20 6d low overriding m
c810: 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 0a egatest.config .
c820: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
c830: 63 68 65 66 69 6c 65 73 20 28 6c 61 75 6e 63 68 chefiles (launch
c840: 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 2d :get-cache-file-
c850: 70 61 74 68 73 20 61 72 65 61 70 61 74 68 20 74 paths areapath t
c860: 6f 70 70 61 74 68 20 74 61 72 67 65 74 20 6d 74 oppath target mt
c870: 63 6f 6e 66 69 67 29 29 0a 09 20 20 20 20 20 3b config)).. ;
c880: 3b 20 63 68 65 63 6b 69 6e 67 20 66 6f 72 20 6e ; checking for n
c890: 75 6c 6c 20 63 61 63 68 65 66 69 6c 65 73 20 73 ull cachefiles s
c8a0: 68 6f 75 6c 64 20 6e 6f 74 20 62 65 20 6e 65 63 hould not be nec
c8b0: 65 73 73 61 72 79 2c 20 49 20 77 61 73 20 73 65 essary, I was se
c8c0: 65 69 6e 67 20 65 72 72 6f 72 20 63 61 72 20 6f eing error car o
c8d0: 66 20 27 28 29 2c 20 6d 69 67 68 74 20 62 65 20 f '(), might be
c8e0: 61 20 63 68 69 63 6b 65 6e 20 62 75 67 20 6f 72 a chicken bug or
c8f0: 20 61 20 72 65 64 20 68 65 72 72 69 6e 67 20 2e a red herring .
c900: 2e 2e 0a 09 20 20 20 20 20 28 6d 74 63 61 63 68 .... (mtcach
c910: 65 66 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 ef (if (null?
c920: 63 61 63 68 65 66 69 6c 65 73 29 0a 09 09 09 20 cachefiles)....
c930: 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 20 28 #f.... (
c940: 63 61 72 20 63 61 63 68 65 66 69 6c 65 73 29 29 car cachefiles))
c950: 29 20 3b 3b 20 28 61 6e 64 20 63 61 63 68 65 64 ) ;; (and cached
c960: 69 72 20 28 63 6f 6e 63 20 63 61 63 68 65 64 69 ir (conc cachedi
c970: 72 20 22 2f 22 20 22 2e 6d 65 67 61 74 65 73 74 r "/" ".megatest
c980: 2e 63 66 67 2d 22 20 20 6d 65 67 61 74 65 73 74 .cfg-" megatest
c990: 2d 76 65 72 73 69 6f 6e 20 22 2d 22 20 6d 65 67 -version "-" meg
c9a0: 61 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 atest-fossil-has
c9b0: 68 29 29 29 0a 09 20 20 20 20 20 28 72 63 63 61 h))).. (rcca
c9c0: 63 68 65 66 20 20 20 28 69 66 20 28 6e 75 6c 6c chef (if (null
c9d0: 3f 20 63 61 63 68 65 66 69 6c 65 73 29 0a 09 09 ? cachefiles)...
c9e0: 09 20 20 20 20 20 23 66 0a 09 09 09 20 20 20 20 . #f....
c9f0: 20 28 63 64 72 20 63 61 63 68 65 66 69 6c 65 73 (cdr cachefiles
ca00: 29 29 29 29 20 3b 3b 20 28 61 6e 64 20 63 61 63 )))) ;; (and cac
ca10: 68 65 64 69 72 20 28 63 6f 6e 63 20 63 61 63 68 hedir (conc cach
ca20: 65 64 69 72 20 22 2f 22 20 22 2e 72 75 6e 63 6f edir "/" ".runco
ca30: 6e 66 69 67 73 2e 63 66 67 2d 22 20 20 6d 65 67 nfigs.cfg-" meg
ca40: 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 20 22 2d atest-version "-
ca50: 22 20 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 " megatest-fossi
ca60: 6c 2d 68 61 73 68 29 29 29 0a 09 20 20 20 20 20 l-hash)))..
ca70: 20 3b 3b 20 28 63 61 6e 63 72 65 61 74 65 20 28 ;; (cancreate (
ca80: 61 6e 64 20 63 61 63 68 65 64 69 72 20 28 63 6f and cachedir (co
ca90: 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
caa0: 3f 20 63 61 63 68 65 64 69 72 29 28 66 69 6c 65 ? cachedir)(file
cab0: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 63 -write-access? c
cac0: 61 63 68 65 64 69 72 29 20 28 6e 6f 74 20 28 63 achedir) (not (c
cad0: 6f 6d 6d 6f 6e 3a 69 6e 2d 72 75 6e 6e 69 6e 67 ommon:in-running
cae0: 2d 74 65 73 74 3f 29 29 29 29 29 0a 09 28 73 65 -test?)))))..(se
caf0: 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 74 6f 70 t! *toppath* top
cb00: 70 61 74 68 29 20 3b 3b 20 54 68 69 73 20 69 73 path) ;; This is
cb10: 20 6e 65 65 64 65 64 20 77 68 65 6e 20 77 65 20 needed when we
cb20: 61 72 65 20 72 75 6e 6e 69 6e 67 20 61 73 20 61 are running as a
cb30: 20 74 65 73 74 20 75 73 69 6e 67 20 43 4d 44 49 test using CMDI
cb40: 4e 46 4f 20 61 73 20 61 20 64 61 74 61 73 6f 75 NFO as a datasou
cb50: 72 63 65 0a 20 20 20 20 20 20 20 20 3b 3b 28 42 rce. ;;(B
cb60: 42 3e 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 B> "launch:setup
cb70: 2d 62 6f 64 79 20 2d 2d 20 63 61 63 68 65 66 69 -body -- cachefi
cb80: 6c 65 73 3d 22 63 61 63 68 65 66 69 6c 65 73 29 les="cachefiles)
cb90: 0a 09 28 63 6f 6e 64 0a 09 20 3b 3b 20 69 66 20 ..(cond.. ;; if
cba0: 6d 74 63 61 63 68 65 66 20 65 78 69 73 74 73 20 mtcachef exists
cbb0: 6a 75 73 74 20 72 65 61 64 20 69 74 2c 20 68 6f just read it, ho
cbc0: 77 65 76 65 72 20 77 65 20 6e 65 65 64 20 74 6f wever we need to
cbd0: 20 61 73 73 75 6d 65 20 74 6f 70 70 61 74 68 20 assume toppath
cbe0: 69 73 20 61 76 61 69 6c 61 62 6c 65 20 69 6e 20 is available in
cbf0: 24 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d $MT_RUN_AREA_HOM
cc00: 45 0a 09 20 28 28 61 6e 64 20 28 6e 6f 74 20 66 E.. ((and (not f
cc10: 6f 72 63 65 2d 72 65 72 65 61 64 29 0a 09 20 20 orce-reread)..
cc20: 20 20 20 20 20 6d 74 63 61 63 68 65 66 20 20 72 mtcachef r
cc30: 63 63 61 63 68 65 66 0a 09 20 20 20 20 20 20 20 ccachef..
cc40: 75 73 65 2d 63 61 63 68 65 0a 09 20 20 20 20 20 use-cache..
cc50: 20 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 (get-environme
cc60: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 4d 54 5f nt-variable "MT_
cc70: 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 0a RUN_AREA_HOME").
cc80: 09 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a . (common:
cc90: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6d 74 63 file-exists? mtc
cca0: 61 63 68 65 66 29 0a 09 20 20 20 20 20 20 20 28 achef).. (
ccb0: 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 common:file-exis
ccc0: 74 73 3f 20 72 63 63 61 63 68 65 66 29 29 0a 20 ts? rccachef)).
ccd0: 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 ;;(BB>
cce0: 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f "launch:setup-bo
ccf0: 64 79 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e 63 dy -- cond branc
cd00: 68 20 31 20 2d 20 75 73 65 2d 63 61 63 68 65 22 h 1 - use-cache"
cd10: 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 ). (set
cd20: 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 20 20 ! *configdat*
cd30: 20 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 (configf:read-a
cd40: 6c 69 73 74 20 6d 74 63 61 63 68 65 66 29 29 0a list mtcachef)).
cd50: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e ;;(BB>
cd60: 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 "launch:setup-b
cd70: 6f 64 79 20 2d 2d 20 31 20 73 65 74 21 20 2a 63 ody -- 1 set! *c
cd80: 6f 6e 66 69 67 64 61 74 2a 3d 22 2a 63 6f 6e 66 onfigdat*="*conf
cd90: 69 67 64 61 74 2a 29 0a 09 20 20 28 73 65 74 21 igdat*).. (set!
cda0: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 *runconfigdat*
cdb0: 28 63 6f 6e 66 69 67 66 3a 72 65 61 64 2d 61 6c (configf:read-al
cdc0: 69 73 74 20 72 63 63 61 63 68 65 66 29 29 0a 09 ist rccachef))..
cdd0: 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 69 (set! *configi
cde0: 6e 66 6f 2a 20 20 20 28 6c 69 73 74 20 2a 63 6f nfo* (list *co
cdf0: 6e 66 69 67 64 61 74 2a 20 20 28 67 65 74 2d 65 nfigdat* (get-e
ce00: 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 nvironment-varia
ce10: 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ble "MT_RUN_AREA
ce20: 5f 48 4f 4d 45 22 29 29 29 0a 09 20 20 28 73 65 _HOME"))).. (se
ce30: 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 t! *configstatus
ce40: 2a 20 27 66 75 6c 6c 64 61 74 61 29 0a 09 20 20 * 'fulldata)..
ce50: 28 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 (set! *toppath*
ce60: 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 72 6f (get-enviro
ce70: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
ce80: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
ce90: 22 29 29 0a 09 20 20 2a 74 6f 70 70 61 74 68 2a ")).. *toppath*
cea0: 29 0a 09 20 3b 3b 20 74 68 65 72 65 20 61 72 65 ).. ;; there are
ceb0: 20 6e 6f 20 65 78 69 73 74 69 6e 67 20 63 61 63 no existing cac
cec0: 68 65 64 20 63 6f 6e 66 69 67 73 2c 20 64 6f 20 hed configs, do
ced0: 66 75 6c 6c 20 72 65 61 64 73 20 6f 66 20 74 68 full reads of th
cee0: 65 20 63 6f 6e 66 69 67 73 20 61 6e 64 20 63 61 e configs and ca
cef0: 63 68 65 20 74 68 65 6d 0a 09 20 3b 3b 20 77 65 che them.. ;; we
cf00: 20 68 61 76 65 20 61 6c 6c 20 74 68 65 20 69 6e have all the in
cf10: 66 6f 20 6e 65 65 64 65 64 20 74 6f 20 66 75 6c fo needed to ful
cf20: 6c 79 20 70 72 6f 63 65 73 73 20 72 75 6e 63 6f ly process runco
cf30: 6e 66 69 67 73 20 61 6e 64 20 6d 65 67 61 74 65 nfigs and megate
cf40: 73 74 2e 63 6f 6e 66 69 67 0a 09 20 28 28 61 6e st.config.. ((an
cf50: 64 20 3b 3b 20 28 6e 6f 74 20 66 6f 72 63 65 2d d ;; (not force-
cf60: 72 65 72 65 61 64 29 20 3b 3b 20 66 6f 72 63 65 reread) ;; force
cf70: 2d 72 65 72 65 61 64 20 69 73 20 69 72 72 65 6c -reread is irrel
cf80: 65 76 61 6e 74 20 69 6e 20 74 68 65 20 41 4e 44 evant in the AND
cf90: 2c 20 63 6f 75 6c 64 20 68 6f 77 65 76 65 72 20 , could however
cfa0: 4f 52 20 69 74 3f 0a 09 20 20 20 20 20 20 20 6d OR it?.. m
cfb0: 74 63 61 63 68 65 66 0a 09 20 20 20 20 20 20 20 tcachef..
cfc0: 72 63 63 61 63 68 65 66 29 20 3b 3b 20 42 42 2d rccachef) ;; BB-
cfd0: 20 77 68 79 20 61 72 65 20 77 65 20 64 6f 69 6e why are we doin
cfe0: 67 20 74 68 69 73 20 77 69 74 68 6f 75 74 20 61 g this without a
cff0: 73 6b 69 6e 67 20 69 66 20 63 61 63 68 69 6e 67 sking if caching
d000: 20 69 73 20 64 65 73 69 72 65 64 3f 0a 20 20 20 is desired?.
d010: 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c ;;(BB> "l
d020: 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 aunch:setup-body
d030: 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e 63 68 20 -- cond branch
d040: 32 22 29 0a 09 20 20 28 6c 65 74 2a 20 28 28 66 2").. (let* ((f
d050: 69 72 73 74 2d 70 61 73 73 20 20 20 20 28 66 69 irst-pass (fi
d060: 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 nd-and-read-conf
d070: 69 67 20 20 20 20 20 20 20 20 3b 3b 20 4e 42 2f ig ;; NB/
d080: 2f 20 73 65 74 73 20 4d 54 5f 52 55 4e 5f 41 52 / sets MT_RUN_AR
d090: 45 41 5f 48 4f 4d 45 20 61 73 20 73 69 64 65 20 EA_HOME as side
d0a0: 65 66 66 65 63 74 0a 09 09 09 09 20 6d 74 63 6f effect..... mtco
d0b0: 6e 66 69 67 0a 09 09 09 09 20 65 6e 76 69 72 6f nfig..... enviro
d0c0: 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 n-patt: "env-ove
d0d0: 72 72 69 64 65 22 0a 09 09 09 09 20 67 69 76 65 rride"..... give
d0e0: 6e 2d 74 6f 70 70 61 74 68 3a 20 74 6f 70 70 61 n-toppath: toppa
d0f0: 74 68 0a 09 09 09 09 20 70 61 74 68 65 6e 76 76 th..... pathenvv
d100: 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 ar: "MT_RUN_AREA
d110: 5f 48 4f 4d 45 22 29 29 0a 09 09 20 28 66 69 72 _HOME"))... (fir
d120: 73 74 2d 72 75 6e 64 61 74 20 20 28 6c 65 74 20 st-rundat (let
d130: 28 28 74 6f 70 70 61 74 68 20 28 69 66 20 74 6f ((toppath (if to
d140: 70 70 61 74 68 20 0a 09 09 09 09 09 09 20 20 20 ppath .......
d150: 74 6f 70 70 61 74 68 0a 09 09 09 09 09 09 20 20 toppath.......
d160: 20 28 63 61 72 20 66 69 72 73 74 2d 70 61 73 73 (car first-pass
d170: 29 29 29 29 0a 09 09 09 09 20 20 28 72 65 61 64 ))))..... (read
d180: 2d 63 6f 6e 66 69 67 20 3b 3b 20 28 63 6f 6e 63 -config ;; (conc
d190: 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e 63 6f toppath "/runco
d1a0: 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 20 3b nfigs.config") ;
d1b0: 3b 20 74 68 69 73 20 73 68 6f 75 6c 64 20 62 65 ; this should be
d1c0: 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 72 75 converted to ru
d1d0: 6e 63 6f 6e 66 69 67 3a 72 65 61 64 20 62 75 74 nconfig:read but
d1e0: 20 69 74 20 69 73 20 6e 6f 6e 2d 74 72 69 76 69 it is non-trivi
d1f0: 61 6c 2c 20 6c 65 61 76 69 6e 67 20 69 74 20 66 al, leaving it f
d200: 6f 72 20 6e 6f 77 2e 0a 09 09 09 09 20 20 20 28 or now...... (
d210: 63 6f 6e 63 20 28 69 66 20 28 73 74 72 69 6e 67 conc (if (string
d220: 3f 20 74 6f 70 70 61 74 68 29 0a 09 09 09 09 09 ? toppath)......
d230: 20 20 20 20 20 74 6f 70 70 61 74 68 0a 09 09 09 toppath....
d240: 09 09 20 20 20 20 20 28 67 65 74 2d 65 6e 76 69 .. (get-envi
d250: 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 ronment-variable
d260: 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f "MT_RUN_AREA_HO
d270: 4d 45 22 29 29 0a 09 09 09 09 09 20 22 2f 72 75 ME"))...... "/ru
d280: 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 nconfigs.config"
d290: 29 0a 09 09 09 09 20 20 20 2a 72 75 6e 63 6f 6e )..... *runcon
d2a0: 66 69 67 64 61 74 2a 20 23 74 20 0a 09 09 09 09 figdat* #t .....
d2b0: 20 20 20 73 65 63 74 69 6f 6e 73 3a 20 73 65 63 sections: sec
d2c0: 74 69 6f 6e 73 29 29 29 29 0a 09 20 20 20 20 28 tions)))).. (
d2d0: 73 65 74 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 set! *runconfigd
d2e0: 61 74 2a 20 66 69 72 73 74 2d 72 75 6e 64 61 74 at* first-rundat
d2f0: 29 0a 09 20 20 20 20 28 69 66 20 66 69 72 73 74 ).. (if first
d300: 2d 70 61 73 73 20 20 3b 3b 20 0a 09 09 28 62 65 -pass ;; ...(be
d310: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
d320: 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 22 6c 61 ;;(BB> "la
d330: 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f 64 79 20 unch:setup-body
d340: 2d 2d 20 5c 22 66 69 72 73 74 2d 70 61 73 73 5c -- \"first-pass\
d350: 22 3d 66 69 72 73 74 2d 70 61 73 73 22 29 0a 09 "=first-pass")..
d360: 09 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 . (set! *config
d370: 64 61 74 2a 20 20 28 63 61 72 20 66 69 72 73 74 dat* (car first
d380: 2d 70 61 73 73 29 29 0a 20 20 20 20 20 20 20 20 -pass)).
d390: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e ;;(BB>
d3a0: 20 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 "launch:setup-b
d3b0: 6f 64 79 20 2d 2d 20 32 20 73 65 74 21 20 2a 63 ody -- 2 set! *c
d3c0: 6f 6e 66 69 67 64 61 74 2a 3d 22 2a 63 6f 6e 66 onfigdat*="*conf
d3d0: 69 67 64 61 74 2a 29 0a 09 09 20 20 28 73 65 74 igdat*)... (set
d3e0: 21 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 66 ! *configinfo* f
d3f0: 69 72 73 74 2d 70 61 73 73 29 0a 09 09 20 20 28 irst-pass)... (
d400: 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 20 set! *toppath*
d410: 20 20 28 6f 72 20 74 6f 70 70 61 74 68 20 28 63 (or toppath (c
d420: 61 64 72 20 66 69 72 73 74 2d 70 61 73 73 29 29 adr first-pass))
d430: 29 20 3b 3b 20 75 73 65 20 74 68 65 20 67 61 74 ) ;; use the gat
d440: 68 65 72 65 64 20 64 61 74 61 20 75 6e 6c 65 73 hered data unles
d450: 73 20 61 6c 72 65 61 64 79 20 68 61 76 65 20 69 s already have i
d460: 74 0a 09 09 20 20 28 73 65 74 21 20 74 6f 70 70 t... (set! topp
d470: 61 74 68 20 20 20 20 20 20 2a 74 6f 70 70 61 74 ath *toppat
d480: 68 2a 29 0a 09 09 20 20 28 69 66 20 28 6e 6f 74 h*)... (if (not
d490: 20 2a 74 6f 70 70 61 74 68 2a 29 0a 09 09 20 20 *toppath*)...
d4a0: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 28 64 (begin....(d
d4b0: 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
d4c0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
d4d0: 70 6f 72 74 2a 20 22 79 6f 75 20 61 72 65 20 6e port* "you are n
d4e0: 6f 74 20 69 6e 20 61 20 6d 65 67 61 74 65 73 74 ot in a megatest
d4f0: 20 61 72 65 61 21 22 29 0a 09 09 09 28 65 78 69 area!")....(exi
d500: 74 20 31 29 29 29 0a 09 09 20 20 28 73 65 74 65 t 1)))... (sete
d510: 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f nv "MT_RUN_AREA_
d520: 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 HOME" *toppath*)
d530: 0a 09 09 20 20 3b 3b 20 74 68 65 20 73 65 65 64 ... ;; the seed
d540: 20 72 65 61 64 20 69 73 20 64 6f 6e 65 2c 20 6e read is done, n
d550: 6f 77 20 72 65 61 64 20 72 75 6e 63 6f 6e 66 69 ow read runconfi
d560: 67 73 2c 20 63 61 63 68 65 20 69 74 20 74 68 65 gs, cache it the
d570: 6e 20 72 65 61 64 20 6d 65 67 61 74 65 73 74 2e n read megatest.
d580: 63 6f 6e 66 69 67 20 6f 6e 65 20 6d 6f 72 65 20 config one more
d590: 74 69 6d 65 20 61 6e 64 20 63 61 63 68 65 20 69 time and cache i
d5a0: 74 0a 09 09 20 20 28 6c 65 74 2a 20 28 28 6b 65 t... (let* ((ke
d5b0: 79 73 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d ys (comm
d5c0: 6f 6e 3a 6c 69 73 74 2d 6f 72 2d 6e 75 6c 6c 20 on:list-or-null
d5d0: 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 29 0a 09 (rmt:get-keys)..
d5e0: 09 09 09 09 09 09 20 20 20 20 6d 65 73 73 61 67 ...... messag
d5f0: 65 3a 20 22 46 61 69 6c 65 64 20 74 6f 20 72 65 e: "Failed to re
d600: 74 72 69 65 76 65 20 6b 65 79 73 20 69 6e 20 6c trieve keys in l
d610: 61 75 6e 63 68 2e 73 63 6d 2e 20 50 6c 65 61 73 aunch.scm. Pleas
d620: 65 20 72 65 70 6f 72 74 20 74 68 69 73 20 74 6f e report this to
d630: 20 74 68 65 20 64 65 76 65 6c 6f 70 65 72 73 2e the developers.
d640: 22 29 29 0a 09 09 09 20 28 6b 65 79 2d 76 61 6c ")).... (key-val
d650: 73 20 20 20 20 20 28 6b 65 79 73 3a 74 61 72 67 s (keys:targ
d660: 65 74 2d 3e 6b 65 79 76 61 6c 20 6b 65 79 73 20 et->keyval keys
d670: 74 61 72 67 65 74 29 29 0a 09 09 09 20 28 6c 69 target)).... (li
d680: 6e 6b 74 72 65 65 20 20 20 20 20 28 63 6f 6d 6d nktree (comm
d690: 6f 6e 3a 67 65 74 2d 6c 69 6e 6b 74 72 65 65 29 on:get-linktree)
d6a0: 29 20 3b 3b 20 28 6f 72 20 28 67 65 74 65 6e 76 ) ;; (or (getenv
d6b0: 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 45 22 29 28 "MT_LINKTREE")(
d6c0: 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 28 if *configdat* (
d6d0: 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
d6e0: 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 configdat* "setu
d6f0: 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 29 20 23 p" "linktree") #
d700: 66 29 29 29 0a 09 09 09 09 09 3b 20 20 20 20 20 f)))......;
d710: 28 69 66 20 2a 63 6f 6e 66 69 67 64 61 74 2a 0a (if *configdat*.
d720: 09 09 09 09 09 3b 20 09 20 20 20 28 63 6f 6e 66 .....; . (conf
d730: 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
d740: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
d750: 6c 69 6e 6b 74 72 65 65 22 29 0a 09 09 09 09 09 linktree")......
d760: 3b 20 09 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 ; . (conc *top
d770: 70 61 74 68 2a 20 22 2f 6c 74 22 29 29 29 29 0a path* "/lt")))).
d780: 09 09 09 20 28 73 65 63 6f 6e 64 2d 70 61 73 73 ... (second-pass
d790: 20 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 (find-and-read
d7a0: 2d 63 6f 6e 66 69 67 0a 09 09 09 09 09 6d 74 63 -config......mtc
d7b0: 6f 6e 66 69 67 0a 09 09 09 09 09 65 6e 76 69 72 onfig......envir
d7c0: 6f 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 on-patt: "env-ov
d7d0: 65 72 72 69 64 65 22 0a 09 09 09 09 09 67 69 76 erride"......giv
d7e0: 65 6e 2d 74 6f 70 70 61 74 68 3a 20 74 6f 70 70 en-toppath: topp
d7f0: 61 74 68 0a 09 09 09 09 09 70 61 74 68 65 6e 76 ath......pathenv
d800: 76 61 72 3a 20 22 4d 54 5f 52 55 4e 5f 41 52 45 var: "MT_RUN_ARE
d810: 41 5f 48 4f 4d 45 22 29 29 0a 09 09 09 20 28 72 A_HOME")).... (r
d820: 75 6e 63 6f 6e 66 69 67 64 61 74 20 28 62 65 67 unconfigdat (beg
d830: 69 6e 20 20 20 20 20 3b 3b 20 74 68 69 73 20 72 in ;; this r
d840: 65 61 64 20 6f 66 20 74 68 65 20 72 75 6e 63 6f ead of the runco
d850: 6e 66 69 67 73 20 77 69 6c 6c 20 73 65 65 20 61 nfigs will see a
d860: 6e 79 20 61 64 6a 75 73 74 6d 65 6e 74 73 20 6d ny adjustments m
d870: 61 64 65 20 62 79 20 72 65 2d 72 65 61 64 69 6e ade by re-readin
d880: 67 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 g megatest.confi
d890: 67 0a 09 09 09 09 09 20 28 66 6f 72 2d 65 61 63 g...... (for-eac
d8a0: 68 20 28 6c 61 6d 62 64 61 20 28 6b 74 29 0a 09 h (lambda (kt)..
d8b0: 09 09 09 09 09 20 20 20 20 20 28 73 65 74 65 6e ..... (seten
d8c0: 76 20 28 63 61 72 20 6b 74 29 20 28 63 61 64 72 v (car kt) (cadr
d8d0: 20 6b 74 29 29 29 0a 09 09 09 09 09 09 20 20 20 kt))).......
d8e0: 6b 65 79 2d 76 61 6c 73 29 0a 09 09 09 09 09 20 key-vals)......
d8f0: 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 63 6f (read-config (co
d900: 6e 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e nc toppath "/run
d910: 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 69 67 22 29 configs.config")
d920: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 *runconfigdat*
d930: 23 74 20 3b 3b 20 63 6f 6e 73 69 64 65 72 20 75 #t ;; consider u
d940: 73 69 6e 67 20 72 75 6e 63 6f 6e 66 69 67 3a 72 sing runconfig:r
d950: 65 61 64 20 73 6f 6d 65 20 64 61 79 20 2e 2e 2e ead some day ...
d960: 0a 09 09 09 09 09 09 20 20 20 20 20 20 73 65 63 ....... sec
d970: 74 69 6f 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 tions: sections)
d980: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
d990: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 63 (cac
d9a0: 68 65 66 69 6c 65 73 20 20 20 28 6c 61 75 6e 63 hefiles (launc
d9b0: 68 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 h:get-cache-file
d9c0: 2d 70 61 74 68 73 20 61 72 65 61 70 61 74 68 20 -paths areapath
d9d0: 74 6f 70 70 61 74 68 20 74 61 72 67 65 74 20 6d toppath target m
d9e0: 74 63 6f 6e 66 69 67 29 29 0a 20 20 20 20 20 20 tconfig)).
d9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da00: 20 20 20 28 6d 74 63 61 63 68 65 66 20 20 20 20 (mtcachef
da10: 20 28 63 61 72 20 63 61 63 68 65 66 69 6c 65 73 (car cachefiles
da20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
da30: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 63 63 (rcc
da40: 61 63 68 65 66 20 20 20 20 20 28 63 64 72 20 63 achef (cdr c
da50: 61 63 68 65 66 69 6c 65 73 29 29 29 0a 20 20 20 achefiles))).
da60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
da70: 20 3b 3b 20 20 74 72 61 70 20 65 78 63 65 70 74 ;; trap except
da80: 69 6f 6e 20 64 75 65 20 74 6f 20 73 74 61 6c 65 ion due to stale
da90: 20 4e 46 53 20 68 61 6e 64 6c 65 20 2d 2d 20 45 NFS handle -- E
daa0: 72 72 6f 72 3a 20 28 6f 70 65 6e 2d 6f 75 74 70 rror: (open-outp
dab0: 75 74 2d 66 69 6c 65 29 20 63 61 6e 6e 6f 74 20 ut-file) cannot
dac0: 6f 70 65 6e 20 66 69 6c 65 20 2d 20 53 74 61 6c open file - Stal
dad0: 65 20 4e 46 53 20 66 69 6c 65 20 68 61 6e 64 6c e NFS file handl
dae0: 65 3a 20 22 2f 70 2f 66 64 6b 2f 67 77 61 2f 6c e: "/p/fdk/gwa/l
daf0: 65 66 6b 6f 77 69 74 2f 6d 74 54 65 73 74 69 6e efkowit/mtTestin
db00: 67 2f 71 61 2f 70 72 69 6d 62 65 71 61 2f 6c 69 g/qa/primbeqa/li
db10: 6e 6b 73 2f 70 31 32 32 32 2f 31 31 2f 50 44 4b nks/p1222/11/PDK
db20: 5f 72 31 2e 31 2e 31 2f 70 72 69 6d 2f 63 6c 65 _r1.1.1/prim/cle
db30: 61 6e 2f 70 63 65 6c 6c 5f 74 65 73 74 67 65 6e an/pcell_testgen
db40: 2f 2e 72 75 6e 63 6f 6e 66 69 67 73 2e 63 66 67 /.runconfigs.cfg
db50: 2d 31 2e 36 34 32 37 2d 37 64 31 65 37 38 39 63 -1.6427-7d1e789c
db60: 62 33 66 36 32 66 39 63 64 65 37 31 39 61 34 38 b3f62f9cde719a48
db70: 36 35 62 62 35 31 62 33 63 31 37 65 61 38 35 33 65bb51b3c17ea853
db80: 22 20 2d 20 74 69 63 6b 65 74 20 32 32 30 35 34 " - ticket 22054
db90: 36 33 34 32 0a 20 20 20 20 20 20 20 20 20 20 20 6342.
dba0: 20 20 20 20 20 20 20 20 20 3b 3b 20 54 4f 44 4f ;; TODO
dbb0: 20 2d 20 63 6f 6e 73 69 64 65 72 20 31 29 20 75 - consider 1) u
dbc0: 73 69 6e 67 20 73 69 6d 70 6c 65 2d 6c 6f 63 6b sing simple-lock
dbd0: 20 74 6f 20 62 72 61 63 6b 65 74 20 63 61 63 68 to bracket cach
dbe0: 65 20 77 72 69 74 65 0a 20 20 20 20 20 20 20 20 e write.
dbf0: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
dc00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 32 2
dc10: 29 20 63 61 63 68 65 20 69 6e 20 68 61 73 68 20 ) cache in hash
dc20: 6f 6e 20 73 65 72 76 65 72 2c 20 73 69 6e 63 65 on server, since
dc30: 20 6e 65 65 64 20 74 6f 20 64 6f 20 72 6d 74 3a need to do rmt:
dc40: 20 61 6e 79 77 61 79 20 74 6f 20 6c 6f 63 6b 2e anyway to lock.
dc50: 0a 0a 09 09 20 20 20 20 28 69 66 20 72 63 63 61 .... (if rcca
dc60: 63 68 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 chef.
dc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
dc80: 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 mmon:fail-safe.
dc90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dca0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
dcb0: 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ().
dcc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
dcd0: 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 onfigf:write-ali
dce0: 73 74 20 72 75 6e 63 6f 6e 66 69 67 64 61 74 20 st runconfigdat
dcf0: 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 rccachef)).
dd00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dd10: 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 (conc "Could
dd20: 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 not write cache
dd30: 20 66 69 6c 65 20 2d 20 22 72 63 63 61 63 68 65 file - "rccache
dd40: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
dd50: 20 20 20 20 20 20 20 20 20 28 69 66 20 6d 74 63 (if mtc
dd60: 61 63 68 65 66 0a 20 20 20 20 20 20 20 20 20 20 achef.
dd70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
dd80: 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 65 0a ommon:fail-safe.
dd90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
dda0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
ddb0: 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
ddc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ddd0: 63 6f 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c configf:write-al
dde0: 69 73 74 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 ist *configdat*
ddf0: 6d 74 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 mtcachef)).
de00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
de10: 20 20 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 (conc "Could
de20: 20 6e 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 not write cache
de30: 20 66 69 6c 65 20 2d 20 22 6d 74 63 61 63 68 65 file - "mtcache
de40: 66 29 29 29 0a 09 09 20 20 20 20 28 73 65 74 21 f)))... (set!
de50: 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a 20 *runconfigdat*
de60: 72 75 6e 63 6f 6e 66 69 67 64 61 74 29 0a 09 09 runconfigdat)...
de70: 20 20 20 20 28 69 66 20 28 61 6e 64 20 72 63 63 (if (and rcc
de80: 61 63 68 65 66 20 6d 74 63 61 63 68 65 66 29 20 achef mtcachef)
de90: 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 (set! *configsta
dea0: 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 29 tus* 'fulldata))
deb0: 29 29 0a 09 09 3b 3b 20 6e 6f 20 63 6f 6e 66 69 ))...;; no confi
dec0: 67 73 20 66 6f 75 6e 64 3f 20 73 68 6f 75 6c 64 gs found? should
ded0: 20 6e 6f 74 20 68 61 70 70 65 6e 20 62 75 74 20 not happen but
dee0: 6c 65 74 27 73 20 74 72 79 20 74 6f 20 72 65 63 let's try to rec
def0: 6f 76 65 72 20 67 72 61 63 65 66 75 6c 6c 79 2c over gracefully,
df00: 20 72 65 74 75 72 6e 20 61 6e 20 65 6d 70 74 79 return an empty
df10: 20 68 61 73 68 2d 74 61 62 6c 65 0a 09 09 28 73 hash-table...(s
df20: 65 74 21 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 et! *configdat*
df30: 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 (make-hash-table
df40: 29 29 0a 09 09 29 29 29 0a 0a 09 20 3b 3b 20 65 ))...)))... ;; e
df50: 6c 73 65 20 72 65 61 64 20 77 68 61 74 20 79 6f lse read what yo
df60: 75 20 63 61 6e 20 61 6e 64 20 73 65 74 20 74 68 u can and set th
df70: 65 20 66 6c 61 67 20 61 63 63 6f 72 64 69 6e 67 e flag according
df80: 6c 79 0a 09 20 3b 3b 20 68 65 72 65 20 77 65 20 ly.. ;; here we
df90: 64 6f 6e 27 74 20 68 61 76 65 20 65 69 74 68 65 don't have eithe
dfa0: 72 20 6d 74 63 6f 6e 66 69 67 20 6f 72 20 72 63 r mtconfig or rc
dfb0: 63 61 63 68 65 66 0a 09 20 28 65 6c 73 65 0a 20 cachef.. (else.
dfc0: 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e 20 ;;(BB>
dfd0: 22 6c 61 75 6e 63 68 3a 73 65 74 75 70 2d 62 6f "launch:setup-bo
dfe0: 64 79 20 2d 2d 20 63 6f 6e 64 20 62 72 61 6e 63 dy -- cond branc
dff0: 68 20 33 20 2d 20 65 6c 73 65 22 29 0a 09 20 20 h 3 - else")..
e000: 28 6c 65 74 2a 20 28 28 63 66 67 64 61 74 20 20 (let* ((cfgdat
e010: 20 28 66 69 6e 64 2d 61 6e 64 2d 72 65 61 64 2d (find-and-read-
e020: 63 6f 6e 66 69 67 20 0a 09 09 09 20 20 20 20 28 config .... (
e030: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
e040: 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 6d 65 67 "-config") "meg
e050: 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 29 0a 09 atest.config")..
e060: 09 09 20 20 20 20 65 6e 76 69 72 6f 6e 2d 70 61 .. environ-pa
e070: 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 72 69 64 tt: "env-overrid
e080: 65 22 0a 09 09 09 20 20 20 20 67 69 76 65 6e 2d e".... given-
e090: 74 6f 70 70 61 74 68 3a 20 28 67 65 74 2d 65 6e toppath: (get-en
e0a0: 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 61 62 vironment-variab
e0b0: 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f le "MT_RUN_AREA_
e0c0: 48 4f 4d 45 22 29 0a 09 09 09 20 20 20 20 70 61 HOME").... pa
e0d0: 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 5f 52 55 thenvvar: "MT_RU
e0e0: 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 29 29 0a N_AREA_HOME"))).
e0f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 . (if
e100: 20 28 61 6e 64 20 63 66 67 64 61 74 20 28 6c 69 (and cfgdat (li
e110: 73 74 3f 20 63 66 67 64 61 74 29 20 28 3e 20 28 st? cfgdat) (> (
e120: 6c 65 6e 67 74 68 20 63 66 67 64 61 74 29 20 30 length cfgdat) 0
e130: 29 20 28 68 61 73 68 2d 74 61 62 6c 65 3f 20 28 ) (hash-table? (
e140: 63 61 72 20 63 66 67 64 61 74 29 29 29 0a 09 09 car cfgdat)))...
e150: 28 6c 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 (let* ((toppath
e160: 20 28 6f 72 20 28 67 65 74 2d 65 6e 76 69 72 6f (or (get-enviro
e170: 6e 6d 65 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 nment-variable "
e180: 4d 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 MT_RUN_AREA_HOME
e190: 22 29 28 63 61 64 72 20 63 66 67 64 61 74 29 29 ")(cadr cfgdat))
e1a0: 29 0a 09 09 20 20 20 20 20 20 20 28 72 64 61 74 )... (rdat
e1b0: 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 (read-confi
e1c0: 67 20 28 63 6f 6e 63 20 74 6f 70 70 61 74 68 20 g (conc toppath
e1d0: 20 3b 3b 20 63 6f 6e 76 65 72 74 20 74 68 69 73 ;; convert this
e1e0: 20 74 6f 20 75 73 65 20 72 75 6e 63 6f 6e 66 69 to use runconfi
e1f0: 67 3a 72 65 61 64 21 0a 09 09 09 09 09 09 20 20 g:read!.......
e200: 20 20 22 2f 72 75 6e 63 6f 6e 66 69 67 73 2e 63 "/runconfigs.c
e210: 6f 6e 66 69 67 22 29 20 2a 72 75 6e 63 6f 6e 66 onfig") *runconf
e220: 69 67 64 61 74 2a 20 23 74 20 73 65 63 74 69 6f igdat* #t sectio
e230: 6e 73 3a 20 73 65 63 74 69 6f 6e 73 29 29 29 0a ns: sections))).
e240: 09 09 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 .. (set! *confi
e250: 67 69 6e 66 6f 2a 20 20 20 63 66 67 64 61 74 29 ginfo* cfgdat)
e260: 0a 09 09 20 20 28 73 65 74 21 20 2a 63 6f 6e 66 ... (set! *conf
e270: 69 67 64 61 74 2a 20 20 20 20 28 63 61 72 20 63 igdat* (car c
e280: 66 67 64 61 74 29 29 0a 09 09 20 20 28 73 65 74 fgdat))... (set
e290: 21 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a ! *runconfigdat*
e2a0: 20 72 64 61 74 29 0a 09 09 20 20 28 73 65 74 21 rdat)... (set!
e2b0: 20 2a 74 6f 70 70 61 74 68 2a 20 20 20 20 20 20 *toppath*
e2c0: 74 6f 70 70 61 74 68 29 0a 09 09 20 20 28 73 65 toppath)... (se
e2d0: 74 21 20 2a 63 6f 6e 66 69 67 73 74 61 74 75 73 t! *configstatus
e2e0: 2a 20 27 70 61 72 74 69 61 6c 29 29 0a 09 09 28 * 'partial))...(
e2f0: 62 65 67 69 6e 0a 09 09 20 20 28 64 65 62 75 67 begin... (debug
e300: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
e310: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
e320: 2a 20 22 4e 6f 20 22 20 6d 74 63 6f 6e 66 69 67 * "No " mtconfig
e330: 20 22 20 66 69 6c 65 20 66 6f 75 6e 64 2e 20 47 " file found. G
e340: 69 76 69 6e 67 20 75 70 2e 22 29 0a 09 09 20 20 iving up.")...
e350: 28 65 78 69 74 20 32 29 29 29 29 29 29 0a 09 3b (exit 2))))))..;
e360: 3b 20 43 4f 4e 44 20 65 6e 64 73 20 68 65 72 65 ; COND ends here
e370: 2e 0a 09 0a 09 3b 3b 20 61 64 64 69 74 69 6f 6e .....;; addition
e380: 61 6c 20 68 6f 75 73 65 20 6b 65 65 70 69 6e 67 al house keeping
e390: 0a 09 28 6c 65 74 2a 20 28 28 6c 69 6e 6b 74 72 ..(let* ((linktr
e3a0: 65 65 20 28 6f 72 20 28 63 6f 6d 6d 6f 6e 3a 67 ee (or (common:g
e3b0: 65 74 2d 6c 69 6e 6b 74 72 65 65 29 0a 09 09 09 et-linktree)....
e3c0: 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 (conc *topp
e3d0: 61 74 68 2a 20 22 2f 6c 74 22 29 29 29 29 0a 09 ath* "/lt"))))..
e3e0: 20 20 28 69 66 20 6c 69 6e 6b 74 72 65 65 0a 09 (if linktree..
e3f0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 (begin...(
e400: 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a if (not (common:
e410: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 69 6e file-exists? lin
e420: 6b 74 72 65 65 29 29 0a 09 09 20 20 20 20 28 62 ktree))... (b
e430: 65 67 69 6e 0a 09 09 20 20 20 20 20 20 28 68 61 egin... (ha
e440: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
e450: 09 09 09 20 20 65 78 6e 0a 09 09 09 20 20 28 62 ... exn.... (b
e460: 65 67 69 6e 0a 09 09 09 20 20 20 20 28 64 65 62 egin.... (deb
e470: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
e480: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
e490: 72 74 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 rt* "Something w
e4a0: 65 6e 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 ent wrong when t
e4b0: 72 79 69 6e 67 20 74 6f 20 63 72 65 61 74 65 20 rying to create
e4c0: 6c 69 6e 6b 74 72 65 65 20 64 69 72 20 61 74 20 linktree dir at
e4d0: 22 20 6c 69 6e 6b 74 72 65 65 29 0a 09 09 09 20 " linktree)....
e4e0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
e4f0: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
e500: 6f 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 ort* " message:
e510: 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 " ((condition-pr
e520: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
e530: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
e540: 78 6e 29 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e xn) ", exn=" exn
e550: 29 0a 09 09 09 20 20 20 20 28 65 78 69 74 20 31 ).... (exit 1
e560: 29 29 0a 09 09 09 28 63 72 65 61 74 65 2d 64 69 ))....(create-di
e570: 72 65 63 74 6f 72 79 20 6c 69 6e 6b 74 72 65 65 rectory linktree
e580: 20 23 74 29 29 29 29 0a 09 09 28 68 61 6e 64 6c #t))))...(handl
e590: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 e-exceptions...
e5a0: 20 20 20 65 78 6e 0a 09 09 20 20 20 20 28 62 65 exn... (be
e5b0: 67 69 6e 0a 09 09 20 20 20 20 20 20 28 64 65 62 gin... (deb
e5c0: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
e5d0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
e5e0: 72 74 2a 20 22 53 6f 6d 65 74 68 69 6e 67 20 77 rt* "Something w
e5f0: 65 6e 74 20 77 72 6f 6e 67 20 77 68 65 6e 20 74 ent wrong when t
e600: 72 79 69 6e 67 20 74 6f 20 63 72 65 61 74 65 20 rying to create
e610: 6c 69 6e 6b 20 74 6f 20 6c 69 6e 6b 74 72 65 65 link to linktree
e620: 20 61 74 20 22 20 2a 74 6f 70 70 61 74 68 2a 29 at " *toppath*)
e630: 0a 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
e640: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
e650: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 6d 65 73 -log-port* " mes
e660: 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 sage: " ((condit
e670: 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
e680: 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
e690: 61 67 65 29 20 65 78 6e 29 20 22 2c 20 65 78 6e age) exn) ", exn
e6a0: 3d 22 20 65 78 6e 29 29 0a 09 09 20 20 28 6c 65 =" exn))... (le
e6b0: 74 20 28 28 74 6c 69 6e 6b 20 28 63 6f 6e 63 20 t ((tlink (conc
e6c0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6c 74 22 29 *toppath* "/lt")
e6d0: 29 29 0a 09 09 20 20 20 20 28 69 66 20 28 6e 6f ))... (if (no
e6e0: 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 t (common:file-e
e6f0: 78 69 73 74 73 3f 20 74 6c 69 6e 6b 29 29 0a 09 xists? tlink))..
e700: 09 09 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c ..(create-symbol
e710: 69 63 2d 6c 69 6e 6b 20 6c 69 6e 6b 74 72 65 65 ic-link linktree
e720: 20 74 6c 69 6e 6b 29 29 29 29 29 0a 09 20 20 20 tlink)))))..
e730: 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 65 62 (begin...(deb
e740: 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 ug:print-error 0
e750: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
e760: 72 74 2a 20 22 6c 69 6e 6b 74 72 65 65 20 6e 6f rt* "linktree no
e770: 74 20 64 65 66 69 6e 65 64 20 69 6e 20 5b 73 65 t defined in [se
e780: 74 75 70 5d 20 73 65 63 74 69 6f 6e 20 6f 66 20 tup] section of
e790: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
e7a0: 29 0a 09 09 29 29 29 0a 09 28 69 66 20 28 61 6e )...)))..(if (an
e7b0: 64 20 2a 74 6f 70 70 61 74 68 2a 0a 09 09 20 28 d *toppath*... (
e7c0: 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
e7d0: 3f 20 2a 74 6f 70 70 61 74 68 2a 29 29 0a 09 20 ? *toppath*))..
e7e0: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
e7f0: 20 28 73 65 74 65 6e 76 20 22 4d 54 5f 52 55 4e (setenv "MT_RUN
e800: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 _AREA_HOME" *top
e810: 70 61 74 68 2a 29 0a 09 20 20 20 20 20 20 28 73 path*).. (s
e820: 65 74 65 6e 76 20 22 4d 54 5f 54 45 53 54 53 55 etenv "MT_TESTSU
e830: 49 54 45 4e 41 4d 45 22 20 28 63 6f 6d 6d 6f 6e ITENAME" (common
e840: 3a 67 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e :get-testsuite-n
e850: 61 6d 65 29 29 29 0a 09 20 20 20 20 28 62 65 67 ame))).. (beg
e860: 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
e870: 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
e880: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
e890: 2a 20 22 66 61 69 6c 65 64 20 74 6f 20 66 69 6e * "failed to fin
e8a0: 64 20 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 d the top path t
e8b0: 6f 20 79 6f 75 72 20 4d 65 67 61 74 65 73 74 20 o your Megatest
e8c0: 61 72 65 61 2e 22 29 0a 09 20 20 20 20 20 20 28 area.").. (
e8d0: 73 65 74 21 20 2a 74 6f 70 70 61 74 68 2a 20 23 set! *toppath* #
e8e0: 66 29 20 3b 3b 20 66 6f 72 63 65 20 69 74 20 74 f) ;; force it t
e8f0: 6f 20 62 65 20 66 61 6c 73 65 20 73 6f 20 77 65 o be false so we
e900: 20 72 65 74 75 72 6e 20 23 66 0a 09 20 20 20 20 return #f..
e910: 20 20 23 66 29 29 0a 09 0a 20 20 20 20 20 20 20 #f))...
e920: 20 3b 3b 20 6f 6e 65 20 6d 6f 72 65 20 61 74 74 ;; one more att
e930: 65 6d 70 74 20 74 6f 20 63 61 63 68 65 20 74 68 empt to cache th
e940: 65 20 63 6f 6e 66 69 67 73 20 66 6f 72 20 66 75 e configs for fu
e950: 74 75 72 65 20 72 65 61 64 69 6e 67 0a 20 20 20 ture reading.
e960: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 61 63 (let* ((cac
e970: 68 65 66 69 6c 65 73 20 20 20 28 6c 61 75 6e 63 hefiles (launc
e980: 68 3a 67 65 74 2d 63 61 63 68 65 2d 66 69 6c 65 h:get-cache-file
e990: 2d 70 61 74 68 73 20 61 72 65 61 70 61 74 68 20 -paths areapath
e9a0: 74 6f 70 70 61 74 68 20 74 61 72 67 65 74 20 6d toppath target m
e9b0: 74 63 6f 6e 66 69 67 29 29 0a 20 20 20 20 20 20 tconfig)).
e9c0: 20 20 20 20 20 20 20 20 20 28 6d 74 63 61 63 68 (mtcach
e9d0: 65 66 20 20 20 20 20 28 63 61 72 20 63 61 63 68 ef (car cach
e9e0: 65 66 69 6c 65 73 29 29 0a 20 20 20 20 20 20 20 efiles)).
e9f0: 20 20 20 20 20 20 20 20 28 72 63 63 61 63 68 65 (rccache
ea00: 66 20 20 20 20 20 28 63 64 72 20 63 61 63 68 65 f (cdr cache
ea10: 66 69 6c 65 73 29 29 29 0a 0a 20 20 20 20 20 20 files)))..
ea20: 20 20 20 20 3b 3b 20 74 72 61 70 20 65 78 63 65 ;; trap exce
ea30: 70 74 69 6f 6e 20 64 75 65 20 74 6f 20 73 74 61 ption due to sta
ea40: 6c 65 20 4e 46 53 20 68 61 6e 64 6c 65 20 2d 2d le NFS handle --
ea50: 20 45 72 72 6f 72 3a 20 28 6f 70 65 6e 2d 6f 75 Error: (open-ou
ea60: 74 70 75 74 2d 66 69 6c 65 29 20 63 61 6e 6e 6f tput-file) canno
ea70: 74 20 6f 70 65 6e 20 66 69 6c 65 20 2d 20 53 74 t open file - St
ea80: 61 6c 65 20 4e 46 53 20 66 69 6c 65 20 68 61 6e ale NFS file han
ea90: 64 6c 65 3a 20 22 2e 2e 2e 73 6f 6d 65 70 61 74 dle: "...somepat
eaa0: 68 2e 2e 2e 2f 2e 72 75 6e 63 6f 6e 66 69 67 73 h.../.runconfigs
eab0: 2e 63 66 67 2d 31 2e 36 34 32 37 2d 37 64 31 65 .cfg-1.6427-7d1e
eac0: 37 38 39 63 62 33 66 36 32 66 39 63 64 65 37 31 789cb3f62f9cde71
ead0: 39 61 34 38 36 35 62 62 35 31 62 33 63 31 37 65 9a4865bb51b3c17e
eae0: 61 38 35 33 22 20 2d 20 74 69 63 6b 65 74 20 32 a853" - ticket 2
eaf0: 32 30 35 34 36 33 34 32 0a 20 20 20 20 20 20 20 20546342.
eb00: 20 20 20 3b 3b 20 54 4f 44 4f 20 2d 20 63 6f 6e ;; TODO - con
eb10: 73 69 64 65 72 20 31 29 20 75 73 69 6e 67 20 73 sider 1) using s
eb20: 69 6d 70 6c 65 2d 6c 6f 63 6b 20 74 6f 20 62 72 imple-lock to br
eb30: 61 63 6b 65 74 20 63 61 63 68 65 20 77 72 69 74 acket cache writ
eb40: 65 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 e. ;;
eb50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 32 2
eb60: 29 20 63 61 63 68 65 20 69 6e 20 68 61 73 68 20 ) cache in hash
eb70: 6f 6e 20 73 65 72 76 65 72 2c 20 73 69 6e 63 65 on server, since
eb80: 20 6e 65 65 64 20 74 6f 20 64 6f 20 72 6d 74 3a need to do rmt:
eb90: 20 61 6e 79 77 61 79 20 74 6f 20 6c 6f 63 6b 2e anyway to lock.
eba0: 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 . (if (
ebb0: 61 6e 64 20 72 63 63 61 63 68 65 66 20 2a 72 75 and rccachef *ru
ebc0: 6e 63 6f 6e 66 69 67 64 61 74 2a 20 28 6e 6f 74 nconfigdat* (not
ebd0: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
ebe0: 69 73 74 73 3f 20 72 63 63 61 63 68 65 66 29 29 ists? rccachef))
ebf0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
ec00: 28 63 6f 6d 6d 6f 6e 3a 66 61 69 6c 2d 73 61 66 (common:fail-saf
ec10: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
ec20: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
ec30: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
ec40: 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 nfigf:write-alis
ec50: 74 20 2a 72 75 6e 63 6f 6e 66 69 67 64 61 74 2a t *runconfigdat*
ec60: 20 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 20 rccachef)).
ec70: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 (conc
ec80: 20 22 43 6f 75 6c 64 20 6e 6f 74 20 77 72 69 74 "Could not writ
ec90: 65 20 63 61 63 68 65 20 66 69 6c 65 20 2d 20 22 e cache file - "
eca0: 72 63 63 61 63 68 65 66 29 29 0a 20 20 20 20 20 rccachef)).
ecb0: 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 ).
ecc0: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 6d 74 (if (and mt
ecd0: 63 61 63 68 65 66 20 2a 63 6f 6e 66 69 67 64 61 cachef *configda
ece0: 74 2a 20 20 20 20 28 6e 6f 74 20 28 63 6f 6d 6d t* (not (comm
ecf0: 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 on:file-exists?
ed00: 6d 74 63 61 63 68 65 66 29 29 29 0a 20 20 20 20 mtcachef))).
ed10: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f (commo
ed20: 6e 3a 66 61 69 6c 2d 73 61 66 65 0a 20 20 20 20 n:fail-safe.
ed30: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
ed40: 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 da ().
ed50: 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 3a (configf:
ed60: 77 72 69 74 65 2d 61 6c 69 73 74 20 2a 63 6f 6e write-alist *con
ed70: 66 69 67 64 61 74 2a 20 6d 74 63 61 63 68 65 66 figdat* mtcachef
ed80: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
ed90: 20 20 28 63 6f 6e 63 20 22 43 6f 75 6c 64 20 6e (conc "Could n
eda0: 6f 74 20 77 72 69 74 65 20 63 61 63 68 65 20 66 ot write cache f
edb0: 69 6c 65 20 2d 20 22 6d 74 63 61 63 68 65 66 29 ile - "mtcachef)
edc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
edd0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 ). (if
ede0: 28 61 6e 64 20 72 63 63 61 63 68 65 66 20 6d 74 (and rccachef mt
edf0: 63 61 63 68 65 66 20 2a 72 75 6e 63 6f 6e 66 69 cachef *runconfi
ee00: 67 64 61 74 2a 20 2a 63 6f 6e 66 69 67 64 61 74 gdat* *configdat
ee10: 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 *).
ee20: 20 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 73 74 (set! *configst
ee30: 61 74 75 73 2a 20 27 66 75 6c 6c 64 61 74 61 29 atus* 'fulldata)
ee40: 29 29 0a 0a 09 3b 3b 20 69 66 20 68 61 76 65 20 ))...;; if have
ee50: 2d 61 70 70 65 6e 64 2d 63 6f 6e 66 69 67 20 74 -append-config t
ee60: 68 65 6e 20 72 65 61 64 20 61 6e 64 20 61 70 70 hen read and app
ee70: 65 6e 64 20 68 65 72 65 0a 09 28 6c 65 74 20 28 end here..(let (
ee80: 28 63 66 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 (cfname (args:ge
ee90: 74 2d 61 72 67 20 22 2d 61 70 70 65 6e 64 2d 63 t-arg "-append-c
eea0: 6f 6e 66 69 67 22 29 29 29 0a 09 20 20 28 69 66 onfig"))).. (if
eeb0: 20 28 61 6e 64 20 63 66 6e 61 6d 65 0a 09 09 20 (and cfname...
eec0: 20 20 28 66 69 6c 65 2d 72 65 61 64 2d 61 63 63 (file-read-acc
eed0: 65 73 73 3f 20 63 66 6e 61 6d 65 29 29 0a 09 20 ess? cfname))..
eee0: 20 20 20 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 (read-confi
eef0: 67 20 63 66 6e 61 6d 65 20 2a 63 6f 6e 66 69 67 g cfname *config
ef00: 64 61 74 2a 20 23 74 29 29 29 20 3b 3b 20 76 61 dat* #t))) ;; va
ef10: 6c 75 65 73 20 61 72 65 20 61 64 64 65 64 20 74 lues are added t
ef20: 6f 20 74 68 65 20 68 61 73 68 2c 20 6e 6f 20 6e o the hash, no n
ef30: 65 65 64 20 74 6f 20 64 6f 20 61 6e 79 74 68 69 eed to do anythi
ef40: 6e 67 20 73 70 65 63 69 61 6c 2e 0a 09 2a 74 6f ng special...*to
ef50: 70 70 61 74 68 2a 29 29 29 0a 0a 0a 28 64 65 66 ppath*)))...(def
ef60: 69 6e 65 20 28 67 65 74 2d 62 65 73 74 2d 64 69 ine (get-best-di
ef70: 73 6b 20 63 6f 6e 66 64 61 74 20 74 65 73 74 63 sk confdat testc
ef80: 6f 6e 66 69 67 29 0a 20 20 28 6c 65 74 2a 20 28 onfig). (let* (
ef90: 28 64 69 73 6b 73 20 20 20 28 6f 72 20 28 61 6e (disks (or (an
efa0: 64 20 74 65 73 74 63 6f 6e 66 69 67 20 28 68 61 d testconfig (ha
efb0: 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 sh-table-ref/def
efc0: 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 ault testconfig
efd0: 22 64 69 73 6b 73 22 20 23 66 29 29 0a 09 09 20 "disks" #f))...
efe0: 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 (hash-table
eff0: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 63 6f 6e -ref/default con
f000: 66 64 61 74 20 22 64 69 73 6b 73 22 20 23 66 29 fdat "disks" #f)
f010: 29 29 0a 09 20 28 6d 69 6e 73 70 61 63 65 20 28 )).. (minspace (
f020: 6c 65 74 20 28 28 6d 20 28 63 6f 6e 66 69 67 66 let ((m (configf
f030: 3a 6c 6f 6f 6b 75 70 20 63 6f 6e 66 64 61 74 20 :lookup confdat
f040: 22 73 65 74 75 70 22 20 22 6d 69 6e 73 70 61 63 "setup" "minspac
f050: 65 22 29 29 29 0a 09 09 20 20 20 20 20 28 73 74 e")))... (st
f060: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 ring->number (or
f070: 20 6d 20 22 31 30 30 30 30 22 29 29 29 29 29 0a m "10000"))))).
f080: 20 20 20 20 28 69 66 20 64 69 73 6b 73 20 0a 09 (if disks ..
f090: 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f 6d 6d (let ((res (comm
f0a0: 6f 6e 3a 67 65 74 2d 64 69 73 6b 2d 77 69 74 68 on:get-disk-with
f0b0: 2d 6d 6f 73 74 2d 66 72 65 65 2d 73 70 61 63 65 -most-free-space
f0c0: 20 64 69 73 6b 73 20 6d 69 6e 73 70 61 63 65 29 disks minspace)
f0d0: 29 29 0a 09 20 20 28 69 66 20 72 65 73 0a 09 20 )).. (if res..
f0e0: 20 20 20 20 20 28 63 64 72 20 72 65 73 29 0a 20 (cdr res).
f0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
f100: 65 6c 73 65 20 69 66 20 6e 6f 20 76 61 6c 69 64 else if no valid
f110: 20 64 69 73 6b 73 2e 2e 2e 0a 09 20 20 20 20 20 disks.....
f120: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
f130: 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 (debug:p
f140: 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
f150: 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
f160: 4e 47 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 73 NG: No valid dis
f170: 6b 73 20 6f 72 20 6e 6f 20 64 69 73 6b 20 77 69 ks or no disk wi
f180: 74 68 20 65 6e 6f 75 67 68 20 73 70 61 63 65 20 th enough space
f190: 66 6f 75 6e 64 20 66 72 6f 6d 20 22 20 64 69 73 found from " dis
f1a0: 6b 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ks).
f1b0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 64 (if (null? d
f1c0: 69 73 6b 73 29 0a 20 20 20 20 20 20 20 20 20 20 isks).
f1d0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
f1e0: 20 31 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 1 (conc *toppat
f1f0: 68 2a 20 22 2f 72 75 6e 73 22 29 29 0a 0a 20 20 h* "/runs"))..
f200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f210: 20 20 20 3b 3b 20 65 6c 73 65 20 74 72 79 20 74 ;; else try t
f220: 6f 20 63 72 65 61 74 65 20 74 68 65 20 64 69 72 o create the dir
f230: 65 63 74 6f 72 69 65 73 20 61 6e 79 77 61 79 2e ectories anyway.
f240: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
f250: 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 74 (let ((pat
f260: 68 73 20 28 73 6f 72 74 20 64 69 73 6b 73 20 28 hs (sort disks (
f270: 6c 61 6d 62 64 61 20 28 78 20 79 29 20 28 3e 20 lambda (x y) (>
f280: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 28 (string-length (
f290: 63 61 64 72 20 78 29 29 20 28 73 74 72 69 6e 67 cadr x)) (string
f2a0: 2d 6c 65 6e 67 74 68 20 28 63 61 64 72 20 79 29 -length (cadr y)
f2b0: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 )))))).
f2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
f2d0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 61 64 20 28 et loop ((head (
f2e0: 63 61 72 20 70 61 74 68 73 29 29 20 28 74 61 69 car paths)) (tai
f2f0: 6c 20 28 63 64 72 20 70 61 74 68 73 29 29 29 0a l (cdr paths))).
f300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f310: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
f320: 72 65 73 75 6c 74 20 28 68 61 6e 64 6c 65 2d 65 result (handle-e
f330: 78 63 65 70 74 69 6f 6e 73 20 65 78 6e 0a 09 09 xceptions exn...
f340: 09 09 09 20 28 62 65 67 69 6e 0a 09 09 09 09 09 ... (begin......
f350: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
f360: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
f370: 6f 72 74 2a 20 22 66 61 69 6c 65 64 20 74 6f 20 ort* "failed to
f380: 63 72 65 61 74 65 20 64 69 72 20 22 20 28 63 61 create dir " (ca
f390: 64 72 20 68 65 61 64 29 20 22 2c 20 65 78 6e 3d dr head) ", exn=
f3a0: 22 20 65 78 6e 29 0a 09 09 09 09 09 20 20 20 23 " exn)...... #
f3b0: 66 29 0a 09 09 09 09 09 20 28 63 72 65 61 74 65 f)...... (create
f3c0: 2d 64 69 72 65 63 74 6f 72 79 20 28 63 61 64 72 -directory (cadr
f3d0: 20 68 65 61 64 29 20 23 74 29 29 29 29 0a 20 20 head) #t)))).
f3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f3f0: 20 20 20 20 20 20 20 20 20 28 69 66 20 72 65 73 (if res
f400: 75 6c 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 ult.
f410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f420: 20 20 20 72 65 73 75 6c 74 0a 20 20 20 20 20 20 result.
f430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f440: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
f450: 6c 6c 3f 20 74 61 69 6c 29 0a 20 20 20 20 20 20 ll? tail).
f460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f470: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 (be
f480: 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gin.
f490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f4a0: 20 20 20 20 20 20 20 20 20 28 64 65 62 75 67 3a (debug:
f4b0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
f4c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 55 73 69 6e -log-port* "Usin
f4d0: 67 20 74 6f 70 70 61 74 68 2f 72 75 6e 73 22 29 g toppath/runs")
f4e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
f4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f500: 20 20 20 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 (conc *top
f510: 70 61 74 68 2a 20 22 2f 72 75 6e 73 22 29 0a 20 path* "/runs").
f520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f540: 20 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ).
f550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f560: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 (loop (ca
f570: 72 20 74 61 69 6c 29 20 28 63 64 72 20 74 61 69 r tail) (cdr tai
f580: 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 l)))))).
f590: 20 20 20 20 20 20 20 20 20 20 20 20 20 29 0a 20 ).
f5a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 29 )
f5b0: 20 3b 3b 20 69 66 20 6e 75 6c 6c 3f 20 64 69 73 ;; if null? dis
f5c0: 6b 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ks.
f5d0: 20 29 20 3b 3b 20 69 66 20 6e 6f 74 20 72 65 73 ) ;; if not res
f5e0: 0a 20 20 20 20 20 20 20 20 20 20 29 0a 20 20 20 . ).
f5f0: 20 20 20 20 20 29 0a 09 3b 3b 20 6e 6f 20 64 69 )..;; no di
f600: 73 6b 73 20 64 65 66 69 6e 69 74 69 6f 6e 20 2d sks definition -
f610: 20 75 73 65 20 74 6f 70 70 61 74 68 2f 72 75 6e use toppath/run
f620: 73 2c 20 66 61 6c 6c 20 62 61 63 6b 20 74 6f 20 s, fall back to
f630: 63 75 72 72 64 69 72 2f 72 75 6e 73 0a 09 28 6c currdir/runs..(l
f640: 65 74 2a 20 28 28 74 6f 70 70 61 74 68 20 28 6f et* ((toppath (o
f650: 72 20 2a 74 6f 70 70 61 74 68 2a 0a 09 09 09 20 r *toppath*....
f660: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 (common:get-t
f670: 6f 70 70 61 74 68 20 2a 74 6f 70 70 61 74 68 2a oppath *toppath*
f680: 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ).... (begin.
f690: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
f6a0: 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 print-error 0 *d
f6b0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
f6c0: 20 22 43 72 65 61 74 69 6e 67 20 72 75 6e 73 20 "Creating runs
f6d0: 64 69 72 20 69 6e 20 63 75 72 72 65 6e 74 20 64 dir in current d
f6e0: 69 72 65 63 74 6f 72 79 2c 20 74 68 69 73 20 69 irectory, this i
f6f0: 73 20 70 72 6f 62 61 62 6c 79 20 6e 6f 74 20 77 s probably not w
f700: 68 61 74 20 79 6f 75 20 77 61 6e 74 65 64 2e 20 hat you wanted.
f710: 50 6c 65 61 73 65 20 63 68 65 63 6b 20 79 6f 75 Please check you
f720: 72 20 73 65 74 75 70 2e 22 29 0a 09 09 09 20 20 r setup.")....
f730: 20 20 20 20 28 63 75 72 72 65 6e 74 2d 64 69 72 (current-dir
f740: 65 63 74 6f 72 79 29 29 29 29 0a 09 20 20 20 20 ectory))))..
f750: 20 20 20 28 72 75 6e 73 64 69 72 20 28 63 6f 6e (runsdir (con
f760: 63 20 74 6f 70 70 61 74 68 20 22 2f 72 75 6e 73 c toppath "/runs
f770: 22 29 29 29 0a 09 20 20 28 69 66 20 28 6e 6f 74 "))).. (if (not
f780: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 72 (file-exists? r
f790: 75 6e 73 64 69 72 29 29 28 63 72 65 61 74 65 2d unsdir))(create-
f7a0: 64 69 72 65 63 74 6f 72 79 20 72 75 6e 73 64 69 directory runsdi
f7b0: 72 29 29 0a 09 20 20 72 75 6e 73 64 69 72 29 0a r)).. runsdir).
f7c0: 09 29 29 29 20 3b 3b 20 74 68 65 20 63 6f 64 65 .))) ;; the code
f7d0: 20 63 72 65 61 74 65 73 20 74 68 65 20 6e 65 63 creates the nec
f7e0: 65 73 73 61 72 79 20 64 69 72 65 63 74 6f 72 69 essary directori
f7f0: 65 73 20 69 66 20 69 74 20 64 6f 65 73 20 6e 6f es if it does no
f800: 74 20 65 78 69 73 74 20 61 6e 64 20 72 65 74 75 t exist and retu
f810: 72 6e 73 20 74 68 65 20 70 61 74 68 2e 0a 0a 0a rns the path....
f820: 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 68 .(define (launch
f830: 3a 74 65 73 74 2d 63 6f 70 79 20 74 65 73 74 2d :test-copy test-
f840: 73 72 63 2d 70 61 74 68 20 74 65 73 74 2d 70 61 src-path test-pa
f850: 74 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f 76 th). (let* ((ov
f860: 72 63 6d 64 20 28 6c 65 74 20 28 28 63 6d 64 20 rcmd (let ((cmd
f870: 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 (configf:lookup
f880: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
f890: 75 70 22 20 22 74 65 73 74 63 6f 70 79 63 6d 64 up" "testcopycmd
f8a0: 22 29 29 29 0a 09 09 20 20 20 28 69 66 20 63 6d ")))... (if cm
f8b0: 64 0a 09 09 20 20 20 20 20 20 20 3b 3b 20 73 75 d... ;; su
f8c0: 62 73 74 69 74 75 74 65 20 74 68 65 20 54 45 53 bstitute the TES
f8d0: 54 5f 53 52 43 5f 50 41 54 48 20 61 6e 64 20 54 T_SRC_PATH and T
f8e0: 45 53 54 5f 54 41 52 47 5f 50 41 54 48 0a 09 09 EST_TARG_PATH...
f8f0: 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 73 (string-s
f900: 75 62 73 74 69 74 75 74 65 20 22 54 45 53 54 5f ubstitute "TEST_
f910: 54 41 52 47 5f 50 41 54 48 22 20 74 65 73 74 2d TARG_PATH" test-
f920: 70 61 74 68 0a 09 09 09 09 09 20 20 28 73 74 72 path...... (str
f930: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
f940: 54 45 53 54 5f 53 52 43 5f 50 41 54 48 22 20 74 TEST_SRC_PATH" t
f950: 65 73 74 2d 73 72 63 2d 70 61 74 68 20 63 6d 64 est-src-path cmd
f960: 20 23 74 29 20 23 74 29 0a 09 09 20 20 20 20 20 #t) #t)...
f970: 20 20 23 66 29 29 29 0a 09 20 28 63 6d 64 20 20 #f))).. (cmd
f980: 20 20 28 69 66 20 6f 76 72 63 6d 64 20 0a 09 09 (if ovrcmd ...
f990: 20 20 20 20 20 6f 76 72 63 6d 64 0a 09 09 20 20 ovrcmd...
f9a0: 20 20 20 28 63 6f 6e 63 20 22 72 73 79 6e 63 20 (conc "rsync
f9b0: 2d 61 76 22 20 28 69 66 20 28 64 65 62 75 67 3a -av" (if (debug:
f9c0: 64 65 62 75 67 2d 6d 6f 64 65 20 31 29 20 22 22 debug-mode 1) ""
f9d0: 20 22 71 22 29 20 22 20 22 20 74 65 73 74 2d 73 "q") " " test-s
f9e0: 72 63 2d 70 61 74 68 20 22 2f 20 22 20 74 65 73 rc-path "/ " tes
f9f0: 74 2d 70 61 74 68 20 22 2f 22 0a 09 09 09 20 20 t-path "/"....
fa00: 20 22 20 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 " >> " test-pat
fa10: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
fa20: 67 20 32 3e 3e 20 22 20 74 65 73 74 2d 70 61 74 g 2>> " test-pat
fa30: 68 20 22 2f 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f h "/mt_launch.lo
fa40: 67 22 29 29 29 0a 09 20 28 73 74 61 74 75 73 20 g"))).. (status
fa50: 28 73 79 73 74 65 6d 20 63 6d 64 29 29 29 0a 20 (system cmd))).
fa60: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 71 3f (if (not (eq?
fa70: 20 73 74 61 74 75 73 20 30 29 29 0a 09 28 64 65 status 0))..(de
fa80: 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 66 bug:print 2 *def
fa90: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
faa0: 45 52 52 4f 52 3a 20 70 72 6f 62 6c 65 6d 20 77 ERROR: problem w
fab0: 69 74 68 20 72 75 6e 6e 69 6e 67 20 5c 22 22 20 ith running \""
fac0: 63 6d 64 20 22 5c 22 22 29 29 29 29 0a 0a 0a 3b cmd "\""))))...;
fad0: 3b 20 44 65 73 69 72 65 64 20 64 69 72 65 63 74 ; Desired direct
fae0: 6f 72 79 20 73 74 72 75 63 74 75 72 65 3a 0a 3b ory structure:.;
faf0: 3b 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 3e 20 ;.;; <linkdir>
fb00: 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 - <target> - <te
fb10: 73 74 6e 61 6d 65 3e 20 2d 2e 0a 3b 3b 20 20 20 stname> -..;;
fb20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb40: 20 20 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 |.;;
fb50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb60: 20 20 20 20 20 20 20 20 20 20 20 76 0a 3b 3b 20 v.;;
fb70: 20 3c 72 75 6e 64 69 72 3e 20 20 2d 20 20 3c 74 <rundir> - <t
fb80: 61 72 67 65 74 3e 20 20 2d 20 20 20 20 3c 74 65 arget> - <te
fb90: 73 74 6e 61 6d 65 3e 20 2d 7c 2d 20 3c 69 74 65 stname> -|- <ite
fba0: 6d 70 61 74 68 28 73 29 3e 0a 3b 3b 0a 3b 3b 20 mpath(s)>.;;.;;
fbb0: 20 64 69 72 20 73 74 6f 72 65 64 20 69 6e 20 74 dir stored in t
fbc0: 65 73 74 20 69 73 3a 0a 3b 3b 20 0a 3b 3b 20 20 est is:.;; .;;
fbd0: 3c 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 <linkdir> - <tar
fbe0: 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 get> - <testname
fbf0: 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 74 68 3e > [ - <itempath>
fc00: 20 5d 0a 3b 3b 20 0a 3b 3b 20 41 6c 6c 20 6c 6f ].;; .;; All lo
fc10: 67 20 66 69 6c 65 20 6c 69 6e 6b 73 20 73 68 6f g file links sho
fc20: 75 6c 64 20 62 65 20 73 74 6f 72 65 64 20 72 65 uld be stored re
fc30: 6c 61 74 69 76 65 20 74 6f 20 74 68 65 20 74 6f lative to the to
fc40: 70 20 6f 66 20 6c 69 6e 6b 20 70 61 74 68 0a 3b p of link path.;
fc50: 3b 20 20 0a 3b 3b 20 3c 74 61 72 67 65 74 3e 20 ; .;; <target>
fc60: 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d - <testname> [ -
fc70: 20 3c 69 74 65 6d 70 61 74 68 3e 20 5d 20 0a 3b <itempath> ] .;
fc80: 3b 0a 28 64 65 66 69 6e 65 20 28 63 72 65 61 74 ;.(define (creat
fc90: 65 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 6e 2d e-work-area run-
fca0: 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 id run-info keyv
fcb0: 61 6c 73 20 74 65 73 74 2d 69 64 20 74 65 73 74 als test-id test
fcc0: 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b 2d 70 -src-path disk-p
fcd0: 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 74 65 ath testname ite
fce0: 6d 64 61 74 20 23 21 6b 65 79 20 28 72 65 6d 74 mdat #!key (remt
fcf0: 72 69 65 73 20 32 29 29 0a 20 20 28 6c 65 74 2a ries 2)). (let*
fd00: 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 69 66 ((item-path (if
fd10: 20 28 73 74 72 69 6e 67 3f 20 69 74 65 6d 64 61 (string? itemda
fd20: 74 29 20 69 74 65 6d 64 61 74 20 28 69 74 65 6d t) itemdat (item
fd30: 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d -list->path item
fd40: 64 61 74 29 29 29 20 3b 3b 20 69 66 20 70 61 73 dat))) ;; if pas
fd50: 73 20 69 6e 20 73 74 72 69 6e 67 20 2d 20 6a 75 s in string - ju
fd60: 73 74 20 75 73 65 20 69 74 0a 09 20 28 72 75 6e st use it.. (run
fd70: 6e 61 6d 65 20 20 20 28 69 66 20 28 73 74 72 69 name (if (stri
fd80: 6e 67 3f 20 72 75 6e 2d 69 6e 66 6f 29 20 3b 3b ng? run-info) ;;
fd90: 20 69 66 20 77 65 20 70 61 73 73 20 69 6e 20 61 if we pass in a
fda0: 20 73 74 72 69 6e 67 20 61 73 20 72 75 6e 2d 69 string as run-i
fdb0: 6e 66 6f 20 75 73 65 20 69 74 20 61 73 20 72 75 nfo use it as ru
fdc0: 6e 2d 6e 61 6d 65 2e 0a 09 09 09 72 75 6e 2d 69 n-name.....run-i
fdd0: 6e 66 6f 0a 09 09 09 28 64 62 3a 67 65 74 2d 76 nfo....(db:get-v
fde0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 28 alue-by-header (
fdf0: 64 62 3a 67 65 74 2d 72 6f 77 73 20 72 75 6e 2d db:get-rows run-
fe00: 69 6e 66 6f 29 0a 09 09 09 09 09 09 28 64 62 3a info).......(db:
fe10: 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 2d 69 get-header run-i
fe20: 6e 66 6f 29 0a 09 09 09 09 09 09 22 72 75 6e 6e nfo)......."runn
fe30: 61 6d 65 22 29 29 29 0a 09 20 28 63 6f 6e 74 6f ame"))).. (conto
fe40: 75 72 20 20 20 23 66 29 20 3b 3b 20 4e 4f 54 20 ur #f) ;; NOT
fe50: 52 45 41 44 59 20 46 4f 52 20 54 48 49 53 20 28 READY FOR THIS (
fe60: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
fe70: 6f 6e 74 6f 75 72 22 29 29 0a 09 20 3b 3b 20 63 ontour")).. ;; c
fe80: 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 6f 20 64 onvert back to d
fe90: 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d 20 74 b: from rdb: - t
fea0: 68 69 73 20 69 73 20 61 6c 77 61 79 73 20 72 75 his is always ru
feb0: 6e 20 61 74 20 73 65 72 76 65 72 20 65 6e 64 0a n at server end.
fec0: 09 20 28 74 61 72 67 65 74 20 20 20 28 73 74 72 . (target (str
fed0: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 ing-intersperse
fee0: 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c (map cadr keyval
fef0: 73 29 20 22 2f 22 29 29 0a 0a 09 20 28 6e 6f 74 s) "/"))... (not
ff00: 2d 69 74 65 72 61 74 65 64 20 20 28 65 71 75 61 -iterated (equa
ff10: 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 68 29 l? "" item-path)
ff20: 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 73 74 )... ;; all test
ff30: 73 20 61 72 65 20 66 6f 75 6e 64 20 61 74 20 3c s are found at <
ff40: 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 61 73 rundir>/test-bas
ff50: 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e 2f 74 e or <linkdir>/t
ff60: 65 73 74 2d 62 61 73 65 0a 09 20 28 74 65 73 74 est-base.. (test
ff70: 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 20 74 top-base (conc t
ff80: 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d arget "/" runnam
ff90: 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 e "/" testname))
ffa0: 0a 09 20 28 74 65 73 74 2d 62 61 73 65 20 20 20 .. (test-base
ffb0: 20 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 2d 62 (conc testtop-b
ffc0: 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 ase (if not-iter
ffd0: 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 ated "" "/") ite
ffe0: 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b 20 6e m-path))... ;; n
fff0: 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 68 20 b// if itempath
10000 69 73 20 6e 6f 74 20 22 22 20 74 68 65 6e 20 69 is not "" then i
10010 74 20 69 73 20 70 72 65 66 69 78 65 64 20 77 69 t is prefixed wi
10020 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 65 73 th "/".. (toptes
10030 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 69 73 t-path (conc dis
10040 6b 2d 70 61 74 68 20 28 69 66 20 63 6f 6e 74 6f k-path (if conto
10050 75 72 20 28 63 6f 6e 63 20 22 2f 22 20 63 6f 6e ur (conc "/" con
10060 74 6f 75 72 29 20 22 22 29 20 22 2f 22 20 74 65 tour) "") "/" te
10070 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 sttop-base)).. (
10080 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f test-path (co
10090 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 28 69 66 nc disk-path (if
100a0 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 20 22 contour (conc "
100b0 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 29 20 /" contour) "")
100c0 22 2f 22 20 74 65 73 74 2d 62 61 73 65 29 29 0a "/" test-base)).
100d0 0a 09 20 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 .. ;; ensure thi
100e0 73 20 65 78 69 73 74 73 20 66 69 72 73 74 20 61 s exists first a
100f0 73 20 6c 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 s links to subte
10100 73 74 73 20 6d 75 73 74 20 62 65 20 63 72 65 61 sts must be crea
10110 74 65 64 20 74 68 65 72 65 0a 09 20 28 6c 69 6e ted there.. (lin
10120 6b 74 72 65 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 ktree (common:g
10130 65 74 2d 6c 69 6e 6b 74 72 65 65 29 29 0a 09 20 et-linktree))..
10140 3b 3b 20 57 41 53 3a 20 28 6c 65 74 20 28 28 72 ;; WAS: (let ((r
10150 64 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 d (configf:looku
10160 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
10170 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 65 22 etup" "linktree"
10180 29 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 ))).. ;;
10190 20 28 69 66 20 72 64 20 72 64 20 28 63 6f 6e 63 (if rd rd (conc
101a0 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 72 75 6e *toppath* "/run
101b0 73 22 29 29 29 29 0a 09 20 3b 3b 20 77 68 69 63 s")))).. ;; whic
101c0 68 20 73 65 65 6d 73 20 77 72 6f 6e 67 20 2e 2e h seems wrong ..
101d0 2e 0a 0a 09 20 28 6c 6e 6b 62 61 73 65 20 20 20 .... (lnkbase
101e0 28 63 6f 6e 63 20 6c 69 6e 6b 74 72 65 65 20 28 (conc linktree (
101f0 69 66 20 63 6f 6e 74 6f 75 72 20 28 63 6f 6e 63 if contour (conc
10200 20 22 2f 22 20 63 6f 6e 74 6f 75 72 29 20 22 22 "/" contour) ""
10210 29 20 22 2f 22 20 74 61 72 67 65 74 20 22 2f 22 ) "/" target "/"
10220 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 28 6c 6e runname)).. (ln
10230 6b 70 61 74 68 20 20 20 28 63 6f 6e 63 20 6c 6e kpath (conc ln
10240 6b 62 61 73 65 20 22 2f 22 20 74 65 73 74 6e 61 kbase "/" testna
10250 6d 65 29 29 0a 09 20 28 6c 6e 6b 70 61 74 68 66 me)).. (lnkpathf
10260 20 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 (conc lnkpath
10270 28 69 66 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 (if not-iterated
10280 20 22 22 20 22 2f 22 29 20 69 74 65 6d 2d 70 61 "" "/") item-pa
10290 74 68 29 29 0a 09 20 28 6c 6e 6b 74 61 72 67 65 th)).. (lnktarge
102a0 74 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 t (conc lnkpath
102b0 22 2f 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 "/" item-path)))
102c0 0a 0a 20 20 20 20 3b 3b 20 55 70 64 61 74 65 20 .. ;; Update
102d0 74 68 65 20 72 75 6e 64 69 72 20 70 61 74 68 20 the rundir path
102e0 69 6e 20 74 68 65 20 74 65 73 74 20 72 65 63 6f in the test reco
102f0 72 64 20 66 6f 72 20 61 6c 6c 2c 20 72 75 6e 64 rd for all, rund
10300 69 72 3d 70 68 79 73 69 63 61 6c 2c 20 73 68 6f ir=physical, sho
10310 72 74 64 69 72 3d 6c 6f 67 69 63 61 6c 0a 20 20 rtdir=logical.
10320 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ;;
10330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10350 20 20 20 20 20 72 75 6e 64 69 72 20 20 20 73 68 rundir sh
10360 6f 72 74 64 69 72 0a 20 20 20 20 28 72 6d 74 3a ortdir. (rmt:
10370 67 65 6e 65 72 61 6c 2d 63 61 6c 6c 20 27 74 65 general-call 'te
10380 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 73 68 st-set-rundir-sh
10390 6f 72 74 64 69 72 20 72 75 6e 2d 69 64 20 6c 6e ortdir run-id ln
103a0 6b 70 61 74 68 66 20 74 65 73 74 2d 70 61 74 68 kpathf test-path
103b0 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
103c0 61 74 68 20 72 75 6e 2d 69 64 29 0a 0a 20 20 20 ath run-id)..
103d0 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 (debug:print 2
103e0 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
103f0 74 2a 20 22 49 4e 46 4f 3a 5c 6e 20 20 20 20 20 t* "INFO:\n
10400 20 20 6c 6e 6b 62 61 73 65 3d 22 20 6c 6e 6b 62 lnkbase=" lnkb
10410 61 73 65 20 22 5c 6e 20 20 20 20 20 20 20 6c 6e ase "\n ln
10420 6b 70 61 74 68 3d 22 20 6c 6e 6b 70 61 74 68 20 kpath=" lnkpath
10430 22 5c 6e 20 20 74 6f 70 74 65 73 74 2d 70 61 74 "\n toptest-pat
10440 68 3d 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 h=" toptest-path
10450 20 22 5c 6e 20 20 20 20 20 74 65 73 74 2d 70 61 "\n test-pa
10460 74 68 3d 22 20 74 65 73 74 2d 70 61 74 68 29 0a th=" test-path).
10470 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 63 6f (if (not (co
10480 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
10490 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 62 ? linktree))..(b
104a0 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a 70 egin.. (debug:p
104b0 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d rint 0 *default-
104c0 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e 49 log-port* "WARNI
104d0 4e 47 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 NG: linktree did
104e0 20 6e 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 not exist! Crea
104f0 74 69 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 ting it now at "
10500 20 6c 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 linktree).. (c
10510 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 reate-directory
10520 6c 69 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b linktree #t))) ;
10530 3b 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 ; (system (conc
10540 22 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b "mkdir -p " link
10550 74 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 tree)))). ;;
10560 63 72 65 61 74 65 20 74 68 65 20 64 69 72 65 63 create the direc
10570 74 6f 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 tory for the tes
10580 74 73 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 ts dir links, th
10590 69 73 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 is is needed no
105a0 6d 61 74 74 65 72 20 77 68 61 74 2e 2e 2e 20 74 matter what... t
105b0 72 79 20 75 70 20 74 6f 20 74 68 72 65 65 20 74 ry up to three t
105c0 69 6d 65 73 0a 20 20 20 20 28 6c 65 74 20 6c 6f imes. (let lo
105d0 6f 70 20 28 28 64 6f 6e 65 20 33 29 29 20 0a 20 op ((done 3)) .
105e0 20 20 20 20 20 28 6c 65 74 20 28 28 73 75 63 63 (let ((succ
105f0 65 73 73 20 28 69 66 20 28 61 6e 64 20 28 6e 6f ess (if (and (no
10600 74 20 28 63 6f 6d 6d 6f 6e 3a 64 69 72 65 63 74 t (common:direct
10610 6f 72 79 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 ory-exists? lnkb
10620 61 73 65 29 29 0a 09 09 09 20 20 20 20 20 20 28 ase)).... (
10630 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 not (common:file
10640 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 62 61 73 65 -exists? lnkbase
10650 29 29 29 0a 09 09 09 20 28 68 61 6e 64 6c 65 2d ))).... (handle-
10660 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 09 20 20 exceptions....
10670 65 78 6e 0a 09 09 09 20 20 28 62 65 67 69 6e 0a exn.... (begin.
10680 09 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
10690 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 int-error 0 *def
106a0 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
106b0 50 72 6f 62 6c 65 6d 20 63 72 65 61 74 69 6e 67 Problem creating
106c0 20 6c 69 6e 6b 74 72 65 65 20 62 61 73 65 20 61 linktree base a
106d0 74 20 22 20 6c 6e 6b 62 61 73 65 20 22 2c 20 65 t " lnkbase ", e
106e0 78 6e 3d 22 20 65 78 6e 29 0a 09 09 09 20 20 20 xn=" exn)....
106f0 20 28 70 72 69 6e 74 2d 65 72 72 6f 72 2d 6d 65 (print-error-me
10700 73 73 61 67 65 20 65 78 6e 20 28 63 75 72 72 65 ssage exn (curre
10710 6e 74 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 0a nt-error-port)).
10720 09 09 09 20 20 20 20 23 74 29 0a 09 09 09 20 20 ... #t)....
10730 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
10740 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 0a 09 09 y lnkbase #t)...
10750 09 20 20 23 66 29 29 29 29 0a 09 28 69 66 20 28 . #f))))..(if (
10760 61 6e 64 20 28 6e 6f 74 20 73 75 63 63 65 73 73 and (not success
10770 29 28 3e 20 64 6f 6e 65 20 30 29 29 0a 09 20 20 )(> done 0))..
10780 20 20 28 6c 6f 6f 70 20 28 2d 20 64 6f 6e 65 20 (loop (- done
10790 31 29 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 1))))). .
107a0 3b 3b 20 75 70 64 61 74 65 20 74 68 65 20 74 6f ;; update the to
107b0 70 74 65 73 74 20 72 65 63 6f 72 64 20 77 69 74 ptest record wit
107c0 68 20 69 74 73 20 6c 6f 63 61 74 69 6f 6e 20 72 h its location r
107d0 75 6e 64 69 72 2c 20 63 61 63 68 65 20 74 68 65 undir, cache the
107e0 20 70 61 74 68 0a 20 20 20 20 3b 3b 20 54 68 69 path. ;; Thi
107f0 73 20 77 61 73 73 20 68 69 67 68 6c 79 20 69 6e s wass highly in
10800 65 66 66 69 63 69 65 6e 74 2c 20 6f 6e 65 20 64 efficient, one d
10810 62 20 77 72 69 74 65 20 66 6f 72 20 65 76 65 72 b write for ever
10820 79 20 73 75 62 74 65 73 74 2c 20 70 6f 74 65 6e y subtest, poten
10830 74 69 61 6c 6c 79 0a 20 20 20 20 3b 3b 20 74 68 tially. ;; th
10840 6f 75 73 61 6e 64 73 20 6f 66 20 75 6e 6e 65 63 ousands of unnec
10850 65 73 73 61 72 79 20 75 70 64 61 74 65 73 2c 20 essary updates,
10860 63 61 63 68 65 20 74 68 65 20 66 61 63 74 20 69 cache the fact i
10870 74 20 77 61 73 20 73 65 74 20 61 6e 64 20 64 6f t was set and do
10880 6e 27 74 20 73 65 74 20 69 74 20 0a 20 20 20 20 n't set it .
10890 3b 3b 20 61 67 61 69 6e 2e 20 0a 0a 20 20 20 20 ;; again. ..
108a0 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 74 68 ;; Now create th
108b0 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 20 e link from the
108c0 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 68 65 test path to the
108d0 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 65 link tree, howe
108e0 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 68 ver. ;; if th
108f0 65 20 74 65 73 74 20 69 73 20 69 74 65 72 61 74 e test is iterat
10900 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 73 61 ed it is necessa
10910 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 68 65 ry to create the
10920 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 20 20 parent path.
10930 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 72 61 ;; to the itera
10940 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e 61 tion. use pathna
10950 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 20 me-directory to
10960 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 62 79 trim the path by
10970 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 65 one. ;; leve
10980 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e l. (if (not n
10990 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 ot-iterated) ;;
109a0 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a 09 28 i.e. iterated..(
109b0 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 2d 70 let ((iterated-p
109c0 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 6d 65 arent (pathname
109d0 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f 6e 63 -directory (conc
109e0 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 lnkpath "/" ite
109f0 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 28 64 m-path)))).. (d
10a00 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
10a10 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
10a20 6f 72 74 2a 20 22 43 72 65 61 74 69 6e 67 20 69 ort* "Creating i
10a30 74 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 terated parent "
10a40 20 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 iterated-parent
10a50 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 ).. (handle-exc
10a60 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a eptions.. exn.
10a70 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
10a80 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 (debug:print-er
10a90 72 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c ror 0 *default-l
10aa0 6f 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 og-port* " Faile
10ab0 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 d to create dire
10ac0 63 74 6f 72 79 20 22 20 69 74 65 72 61 74 65 64 ctory " iterated
10ad0 2d 70 61 72 65 6e 74 20 28 28 63 6f 6e 64 69 74 -parent ((condit
10ae0 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 ion-property-acc
10af0 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 essor 'exn 'mess
10b00 61 67 65 29 20 65 78 6e 29 0a 09 09 09 09 22 2c age) exn).....",
10b10 20 63 6f 6e 74 69 6e 75 69 6e 67 20 62 75 74 20 continuing but
10b20 6c 69 6e 6b 20 74 72 65 65 20 6d 61 79 20 62 65 link tree may be
10b30 20 63 6f 72 72 75 70 74 65 64 2c 20 65 78 6e 3d corrupted, exn=
10b40 22 20 65 78 6e 29 0a 09 20 20 20 20 20 23 3b 28 " exn).. #;(
10b50 65 78 69 74 20 31 29 29 0a 09 20 20 20 28 63 72 exit 1)).. (cr
10b60 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 69 eate-directory i
10b70 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 20 23 terated-parent #
10b80 74 29 29 29 29 0a 0a 20 20 20 20 28 69 66 20 28 t)))).. (if (
10b90 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c symbolic-link? l
10ba0 6e 6b 70 61 74 68 29 20 0a 09 28 68 61 6e 64 6c nkpath) ..(handl
10bb0 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 e-exceptions.. e
10bc0 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 xn.. (begin..
10bd0 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
10be0 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
10bf0 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 g-port* " Failed
10c00 20 74 6f 20 72 65 6d 6f 76 65 20 73 79 6d 6c 69 to remove symli
10c10 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 63 nk " lnkpath ((c
10c20 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
10c30 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
10c40 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 0a 09 'message) exn)..
10c50 09 09 20 20 20 20 20 20 22 2c 20 63 6f 6e 74 69 .. ", conti
10c60 6e 75 69 6e 67 20 62 75 74 20 6c 69 6e 6b 20 74 nuing but link t
10c70 72 65 65 20 6d 61 79 20 62 65 20 63 6f 72 72 75 ree may be corru
10c80 70 74 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e 29 pted. exn=" exn)
10c90 0a 09 20 20 20 23 3b 28 65 78 69 74 20 31 29 29 .. #;(exit 1))
10ca0 0a 09 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 .. (delete-file
10cb0 6c 6e 6b 70 61 74 68 29 29 29 0a 0a 20 20 20 20 lnkpath)))..
10cc0 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 63 6f (if (not (or (co
10cd0 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 mmon:file-exists
10ce0 3f 20 6c 6e 6b 70 61 74 68 29 0a 09 09 20 28 73 ? lnkpath)... (s
10cf0 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e ymbolic-link? ln
10d00 6b 70 61 74 68 29 29 29 0a 09 28 68 61 6e 64 6c kpath)))..(handl
10d10 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 65 e-exceptions.. e
10d20 78 6e 0a 09 20 28 62 65 67 69 6e 0a 09 20 20 20 xn.. (begin..
10d30 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 (debug:print-err
10d40 6f 72 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f or 0 *default-lo
10d50 67 2d 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 g-port* " Failed
10d60 20 74 6f 20 63 72 65 61 74 65 20 73 79 6d 6c 69 to create symli
10d70 6e 6b 20 22 20 6c 6e 6b 70 61 74 68 20 28 28 63 nk " lnkpath ((c
10d80 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
10d90 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
10da0 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 0a 09 'message) exn)..
10db0 09 09 20 20 20 20 20 20 22 2c 20 63 6f 6e 74 69 .. ", conti
10dc0 6e 75 69 6e 67 20 62 75 74 20 6c 69 6e 6b 20 74 nuing but link t
10dd0 72 65 65 20 6d 61 79 20 62 65 20 63 6f 72 72 75 ree may be corru
10de0 70 74 65 64 2e 20 65 78 6e 3d 22 20 65 78 6e 29 pted. exn=" exn)
10df0 0a 09 20 20 20 23 3b 28 65 78 69 74 20 31 29 29 .. #;(exit 1))
10e00 0a 09 20 28 63 72 65 61 74 65 2d 73 79 6d 62 6f .. (create-symbo
10e10 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 74 lic-link toptest
10e20 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 29 -path lnkpath)))
10e30 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 4e 42 20 . . ;; NB
10e40 2d 20 54 68 69 73 20 77 61 73 20 6e 6f 74 20 77 - This was not w
10e50 6f 72 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 73 orking right - s
10e60 6f 6d 65 20 74 6f 70 20 74 65 73 74 73 20 61 72 ome top tests ar
10e70 65 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 68 e not getting th
10e80 65 20 70 61 74 68 20 73 65 74 21 21 21 0a 20 20 e path set!!!.
10e90 20 20 3b 3b 0a 20 20 20 20 3b 3b 20 44 6f 20 74 ;;. ;; Do t
10ea0 68 65 20 73 65 74 74 69 6e 67 20 6f 66 20 74 68 he setting of th
10eb0 69 73 20 72 65 63 6f 72 64 20 61 66 74 65 72 20 is record after
10ec0 74 68 65 20 70 61 74 68 73 20 61 72 65 20 63 72 the paths are cr
10ed0 65 61 74 65 64 20 73 6f 20 74 68 61 74 20 74 68 eated so that th
10ee0 65 20 73 68 6f 72 74 64 69 72 20 63 61 6e 20 0a e shortdir can .
10ef0 20 20 20 20 3b 3b 20 62 65 20 73 65 74 20 74 6f ;; be set to
10f00 20 74 68 65 20 72 65 61 6c 20 64 69 72 65 63 74 the real direct
10f10 6f 72 79 20 6c 6f 63 61 74 69 6f 6e 2e 20 54 68 ory location. Th
10f20 69 73 20 69 73 20 73 61 66 65 72 20 66 6f 72 20 is is safer for
10f30 66 75 74 75 72 65 20 63 6c 65 61 6e 20 75 70 20 future clean up
10f40 69 66 20 74 68 65 20 6c 69 6e 6b 0a 20 20 20 20 if the link.
10f50 3b 3b 20 74 72 65 65 20 69 73 20 64 61 6d 61 67 ;; tree is damag
10f60 65 64 20 6f 72 20 6c 6f 73 74 2e 0a 20 20 20 20 ed or lost..
10f70 3b 3b 20 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 ;; . (if (not
10f80 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
10f90 2f 64 65 66 61 75 6c 74 20 2a 74 6f 70 74 65 73 /default *toptes
10fa0 74 2d 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d t-paths* testnam
10fb0 65 20 23 66 29 29 0a 09 28 6c 65 74 2a 20 28 28 e #f))..(let* ((
10fc0 74 65 73 74 69 6e 66 6f 20 20 20 20 20 20 20 28 testinfo (
10fd0 72 6d 74 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 rmt:get-test-inf
10fe0 6f 2d 62 79 2d 69 64 20 72 75 6e 2d 69 64 20 74 o-by-id run-id t
10ff0 65 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e est-id)) ;; run
11000 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 -id testname ite
11010 6d 2d 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 m-path))..
11020 20 28 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 (curr-test-path
11030 20 28 69 66 20 74 65 73 74 69 6e 66 6f 20 3b 3b (if testinfo ;;
11040 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 61 74 (filedb:get-pat
11050 68 20 2a 66 64 62 2a 0a 09 09 09 09 09 09 09 20 h *fdb*........
11060 20 20 20 20 3b 3b 20 28 64 62 3a 67 65 74 2d 70 ;; (db:get-p
11070 61 74 68 20 64 62 73 74 72 75 63 74 0a 09 09 09 ath dbstruct....
11080 09 20 20 20 3b 3b 20 28 72 6d 74 3a 73 64 62 2d . ;; (rmt:sdb-
11090 71 72 79 20 27 67 65 74 73 74 72 20 0a 09 09 09 qry 'getstr ....
110a0 09 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 . (db:test-get
110b0 2d 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f -rundir testinfo
110c0 29 20 3b 3b 20 29 20 3b 3b 20 29 0a 09 09 09 09 ) ;; ) ;; ).....
110d0 20 20 20 23 66 29 29 29 0a 09 20 20 28 68 61 73 #f))).. (has
110e0 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 6f h-table-set! *to
110f0 70 74 65 73 74 2d 70 61 74 68 73 2a 20 74 65 73 ptest-paths* tes
11100 74 6e 61 6d 65 20 63 75 72 72 2d 74 65 73 74 2d tname curr-test-
11110 70 61 74 68 29 0a 09 20 20 3b 3b 20 4e 42 2f 2f path).. ;; NB//
11120 20 57 61 73 20 74 68 69 73 20 66 6f 72 20 74 68 Was this for th
11130 65 20 74 65 73 74 20 6f 72 20 66 6f 72 20 74 68 e test or for th
11140 65 20 70 61 72 65 6e 74 20 69 6e 20 61 6e 20 69 e parent in an i
11150 74 65 72 61 74 65 64 20 74 65 73 74 3f 0a 09 20 terated test?..
11160 20 28 72 6d 74 3a 67 65 6e 65 72 61 6c 2d 63 61 (rmt:general-ca
11170 6c 6c 20 27 74 65 73 74 2d 73 65 74 2d 72 75 6e ll 'test-set-run
11180 64 69 72 2d 73 68 6f 72 74 64 69 72 20 72 75 6e dir-shortdir run
11190 2d 69 64 20 6c 6e 6b 70 61 74 68 20 0a 09 09 09 -id lnkpath ....
111a0 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a (if (common:
111b0 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b file-exists? lnk
111c0 70 61 74 68 29 0a 09 09 09 09 3b 3b 20 28 72 65 path).....;; (re
111d0 73 6f 6c 76 65 2d 70 61 74 68 6e 61 6d 65 20 6c solve-pathname l
111e0 6e 6b 70 61 74 68 29 0a 09 09 09 09 28 63 6f 6d nkpath).....(com
111f0 6d 6f 6e 3a 6e 69 63 65 2d 70 61 74 68 20 6c 6e mon:nice-path ln
11200 6b 70 61 74 68 29 0a 09 09 09 09 6c 6e 6b 70 61 kpath).....lnkpa
11210 74 68 29 0a 09 09 09 20 20 20 20 74 65 73 74 6e th).... testn
11220 61 6d 65 20 22 22 20 72 75 6e 2d 69 64 29 0a 09 ame "" run-id)..
11230 20 20 3b 3b 20 28 72 6d 74 3a 67 65 6e 65 72 61 ;; (rmt:genera
11240 6c 2d 63 61 6c 6c 20 27 74 65 73 74 2d 73 65 74 l-call 'test-set
11250 2d 72 75 6e 64 69 72 20 72 75 6e 2d 69 64 20 6c -rundir run-id l
11260 6e 6b 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 nkpath testname
11270 22 22 29 20 3b 3b 20 74 6f 70 74 65 73 74 2d 70 "") ;; toptest-p
11280 61 74 68 29 0a 09 20 20 28 69 66 20 28 6f 72 20 ath).. (if (or
11290 28 6e 6f 74 20 63 75 72 72 2d 74 65 73 74 2d 70 (not curr-test-p
112a0 61 74 68 29 0a 09 09 20 20 28 6e 6f 74 20 28 64 ath)... (not (d
112b0 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 3f irectory-exists?
112c0 20 74 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 toptest-path)))
112d0 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
112e0 09 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e .(debug:print-in
112f0 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 2 *default-lo
11300 67 2d 70 6f 72 74 2a 20 22 43 72 65 61 74 69 6e g-port* "Creatin
11310 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 74 68 g " toptest-path
11320 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 6c 6e " and link " ln
11330 6b 70 61 74 68 29 0a 09 09 28 68 61 6e 64 6c 65 kpath)...(handle
11340 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 20 20 -exceptions...
11350 20 20 65 78 6e 0a 09 09 20 20 28 62 65 67 69 6e exn... (begin
11360 0a 09 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 ... (debug:pr
11370 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
11380 6f 67 2d 70 6f 72 74 2a 20 22 66 61 69 6c 65 64 og-port* "failed
11390 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 to create direc
113a0 74 6f 72 79 20 22 20 74 6f 70 74 65 73 74 2d 70 tory " toptest-p
113b0 61 74 68 20 22 2c 20 65 78 6e 3d 22 20 65 78 6e ath ", exn=" exn
113c0 29 0a 09 09 20 20 20 20 23 66 29 0a 09 09 20 28 )... #f)... (
113d0 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
113e0 20 74 6f 70 74 65 73 74 2d 70 61 74 68 20 23 74 toptest-path #t
113f0 29 29 0a 09 09 28 68 61 73 68 2d 74 61 62 6c 65 ))...(hash-table
11400 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 -set! *toptest-p
11410 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 74 aths* testname t
11420 6f 70 74 65 73 74 2d 70 61 74 68 29 29 29 29 29 optest-path)))))
11430 0a 0a 20 20 20 20 3b 3b 20 54 68 65 20 74 6f 70 .. ;; The top
11440 74 65 73 74 20 70 61 74 68 20 68 61 73 20 62 65 test path has be
11450 65 6e 20 63 72 65 61 74 65 64 2c 20 74 68 65 20 en created, the
11460 6c 69 6e 6b 20 74 6f 20 74 68 65 20 74 65 73 74 link to the test
11470 20 69 6e 20 74 68 65 20 6c 69 6e 6b 74 72 65 65 in the linktree
11480 20 68 61 73 0a 20 20 20 20 3b 3b 20 62 65 65 6e has. ;; been
11490 20 63 72 65 61 74 65 64 2e 20 4e 6f 77 2c 20 69 created. Now, i
114a0 66 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 65 f this is an ite
114b0 72 61 74 65 64 20 74 65 73 74 20 74 68 65 20 72 rated test the r
114c0 65 61 6c 20 74 65 73 74 20 64 69 72 20 6d 75 73 eal test dir mus
114d0 74 20 62 65 20 63 72 65 61 74 65 64 0a 20 20 20 t be created.
114e0 20 28 69 66 20 28 6e 6f 74 20 6e 6f 74 2d 69 74 (if (not not-it
114f0 65 72 61 74 65 64 29 20 3b 3b 20 74 68 69 73 20 erated) ;; this
11500 69 73 20 61 6e 20 69 74 65 72 61 74 65 64 20 74 is an iterated t
11510 65 73 74 0a 09 28 62 65 67 69 6e 20 3b 3b 20 28 est..(begin ;; (
11520 6c 65 74 20 28 28 6c 6e 6b 74 61 72 67 65 74 20 let ((lnktarget
11530 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
11540 22 20 69 74 65 6d 2d 70 61 74 68 29 29 29 0a 09 " item-path)))..
11550 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 (debug:print 2
11560 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
11570 72 74 2a 20 22 53 65 74 74 69 6e 67 20 75 70 20 rt* "Setting up
11580 73 75 62 20 74 65 73 74 20 72 75 6e 20 61 72 65 sub test run are
11590 61 22 29 0a 09 20 20 28 64 65 62 75 67 3a 70 72 a").. (debug:pr
115a0 69 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c int 2 *default-l
115b0 6f 67 2d 70 6f 72 74 2a 20 22 20 2d 20 63 72 65 og-port* " - cre
115c0 61 74 69 6e 67 20 72 75 6e 20 61 72 65 61 20 69 ating run area i
115d0 6e 20 22 20 74 65 73 74 2d 70 61 74 68 29 0a 09 n " test-path)..
115e0 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 (handle-except
115f0 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 20 ions.. exn..
11600 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 64 (begin.. (d
11610 65 62 75 67 3a 70 72 69 6e 74 2d 65 72 72 6f 72 ebug:print-error
11620 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
11630 70 6f 72 74 2a 20 22 20 46 61 69 6c 65 64 20 74 port* " Failed t
11640 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 74 6f o create directo
11650 72 79 20 22 20 74 65 73 74 2d 70 61 74 68 20 28 ry " test-path (
11660 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 (condition-prope
11670 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 rty-accessor 'ex
11680 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 n 'message) exn)
11690 0a 09 09 09 09 22 2c 20 65 78 69 74 69 6e 67 2c .....", exiting,
116a0 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 20 20 20 exn=" exn)..
116b0 20 20 28 65 78 69 74 20 31 29 29 0a 09 20 20 20 (exit 1))..
116c0 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
116d0 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 29 29 y test-path #t))
116e0 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
116f0 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 2 *default-log-
11700 70 6f 72 74 2a 20 0a 09 09 20 20 20 20 20 20 20 port* ...
11710 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c 69 6e " - creating lin
11720 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 2d 70 k from: " test-p
11730 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 20 20 ath "\n"...
11740 20 20 22 20 20 20 20 20 20 20 20 20 20 20 20 20 "
11750 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e 6b 74 to: " lnkt
11760 61 72 67 65 74 29 0a 0a 09 20 20 3b 3b 20 49 66 arget)... ;; If
11770 20 74 68 65 72 65 20 69 73 20 61 6c 72 65 61 64 there is alread
11780 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 6c 65 y a symlink dele
11790 74 65 20 69 74 20 61 6e 64 20 72 65 63 72 65 61 te it and recrea
117a0 74 65 20 69 74 2e 0a 09 20 20 28 68 61 6e 64 6c te it... (handl
117b0 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 e-exceptions..
117c0 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a exn.. (begin.
117d0 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
117e0 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
117f0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 ult-log-port* "
11800 46 61 69 6c 65 64 20 74 6f 20 72 65 2d 63 72 65 Failed to re-cre
11810 61 74 65 20 6c 69 6e 6b 20 22 20 6c 6e 6b 74 61 ate link " lnkta
11820 72 67 65 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e rget ((condition
11830 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
11840 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
11850 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
11860 67 2c 20 65 78 6e 3d 22 20 65 78 6e 29 0a 09 20 g, exn=" exn)..
11870 20 20 20 20 28 65 78 69 74 29 29 0a 09 20 20 20 (exit))..
11880 28 69 66 20 28 73 79 6d 62 6f 6c 69 63 2d 6c 69 (if (symbolic-li
11890 6e 6b 3f 20 6c 6e 6b 74 61 72 67 65 74 29 20 20 nk? lnktarget)
118a0 20 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 (delete-file
118b0 6c 6e 6b 74 61 72 67 65 74 29 29 0a 09 20 20 20 lnktarget))..
118c0 28 69 66 20 28 6e 6f 74 20 28 63 6f 6d 6d 6f 6e (if (not (common
118d0 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e :file-exists? ln
118e0 6b 74 61 72 67 65 74 29 29 20 28 63 72 65 61 74 ktarget)) (creat
118f0 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 e-symbolic-link
11900 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 test-path lnktar
11910 67 65 74 29 29 29 29 29 0a 0a 20 20 20 20 28 69 get))))).. (i
11920 66 20 28 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 f (not (director
11930 79 3f 20 74 65 73 74 2d 70 61 74 68 29 29 0a 09 y? test-path))..
11940 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
11950 79 20 74 65 73 74 2d 70 61 74 68 20 23 74 29 29 y test-path #t))
11960 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 68 61 ;; this is a ha
11970 63 6b 2c 20 49 20 64 6f 6e 27 74 20 6b 6e 6f 77 ck, I don't know
11980 20 77 68 79 20 6f 75 74 20 6f 66 20 74 68 65 20 why out of the
11990 62 6c 75 65 20 74 68 69 73 20 70 61 74 68 20 64 blue this path d
119a0 6f 65 73 20 6e 6f 74 20 65 78 69 73 74 20 73 6f oes not exist so
119b0 6d 65 74 69 6d 65 73 0a 0a 20 20 20 20 28 69 66 metimes.. (if
119c0 20 28 61 6e 64 20 74 65 73 74 2d 73 72 63 2d 70 (and test-src-p
119d0 61 74 68 20 28 64 69 72 65 63 74 6f 72 79 3f 20 ath (directory?
119e0 74 65 73 74 2d 70 61 74 68 29 29 0a 09 28 62 65 test-path))..(be
119f0 67 69 6e 0a 09 20 20 28 6c 61 75 6e 63 68 3a 74 gin.. (launch:t
11a00 65 73 74 2d 63 6f 70 79 20 74 65 73 74 2d 73 72 est-copy test-sr
11a10 63 2d 70 61 74 68 20 74 65 73 74 2d 70 61 74 68 c-path test-path
11a20 29 0a 09 20 20 28 6c 69 73 74 20 6c 6e 6b 70 61 ).. (list lnkpa
11a30 74 68 66 20 6c 6e 6b 70 61 74 68 20 29 29 0a 09 thf lnkpath ))..
11a40 28 69 66 20 28 61 6e 64 20 74 65 73 74 2d 73 72 (if (and test-sr
11a50 63 2d 70 61 74 68 20 28 3e 20 72 65 6d 74 72 69 c-path (> remtri
11a60 65 73 20 30 29 29 0a 09 20 20 20 20 28 62 65 67 es 0)).. (beg
11a70 69 6e 0a 09 20 20 20 20 20 20 28 64 65 62 75 67 in.. (debug
11a80 3a 70 72 69 6e 74 2d 65 72 72 6f 72 20 30 20 2a :print-error 0 *
11a90 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
11aa0 2a 20 22 46 61 69 6c 65 64 20 74 6f 20 63 72 65 * "Failed to cre
11ab0 61 74 65 20 77 6f 72 6b 20 61 72 65 61 20 61 74 ate work area at
11ac0 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 77 " test-path " w
11ad0 69 74 68 20 6c 69 6e 6b 20 61 74 20 22 20 6c 6e ith link at " ln
11ae0 6b 74 61 72 67 65 74 20 22 2c 20 72 65 6d 61 69 ktarget ", remai
11af0 6e 69 6e 67 20 61 74 74 65 6d 70 74 73 20 22 20 ning attempts "
11b00 72 65 6d 74 72 69 65 73 29 0a 09 20 20 20 20 20 remtries)..
11b10 20 3b 3b 20 0a 09 20 20 20 20 20 20 28 63 72 65 ;; .. (cre
11b20 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 20 72 75 ate-work-area ru
11b30 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 n-id run-info ke
11b40 79 76 61 6c 73 20 74 65 73 74 2d 69 64 20 74 65 yvals test-id te
11b50 73 74 2d 73 72 63 2d 70 61 74 68 20 64 69 73 6b st-src-path disk
11b60 2d 70 61 74 68 20 74 65 73 74 6e 61 6d 65 20 69 -path testname i
11b70 74 65 6d 64 61 74 20 72 65 6d 74 72 69 65 73 3a temdat remtries:
11b80 20 28 2d 20 72 65 6d 74 72 69 65 73 20 31 29 29 (- remtries 1))
11b90 29 0a 09 20 20 20 20 28 6c 69 73 74 20 23 66 20 ).. (list #f
11ba0 23 66 29 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e #f)))))...(defin
11bb0 65 20 28 6c 61 75 6e 63 68 3a 68 61 6e 64 6c 65 e (launch:handle
11bc0 2d 7a 6f 6d 62 69 65 2d 74 65 73 74 73 20 72 75 -zombie-tests ru
11bd0 6e 2d 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 n-id). (let* ((
11be0 6b 65 79 20 28 63 6f 6e 63 20 22 7a 6f 6d 62 69 key (conc "zombi
11bf0 65 73 63 61 6e 2d 72 75 6e 69 64 2d 22 72 75 6e escan-runid-"run
11c00 2d 69 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 -id)). (
11c10 6e 6f 77 20 28 63 75 72 72 65 6e 74 2d 73 65 63 now (current-sec
11c20 6f 6e 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 onds)).
11c30 28 74 68 72 65 73 68 6f 6c 64 20 28 2d 20 28 63 (threshold (- (c
11c40 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 urrent-seconds)
11c50 20 28 2a 20 32 20 28 6f 72 20 28 63 6f 6e 66 69 (* 2 (or (confi
11c60 67 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 gf:lookup-number
11c70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
11c80 74 75 70 22 20 22 64 65 61 64 74 69 6d 65 22 29 tup" "deadtime")
11c90 20 31 32 30 29 29 29 29 0a 20 20 20 20 20 20 20 120)))).
11ca0 20 20 28 76 61 6c 20 28 72 6d 74 3a 67 65 74 2d (val (rmt:get-
11cb0 76 61 72 20 6b 65 79 29 29 0a 20 20 20 20 20 20 var key)).
11cc0 20 20 20 28 64 6f 2d 73 63 61 6e 3f 0a 20 20 20 (do-scan?.
11cd0 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
11ce0 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 76 61 ((not va
11cf0 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 l). #
11d00 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 t). ((
11d10 3c 20 76 61 6c 20 74 68 72 65 73 68 6f 6c 64 29 < val threshold)
11d20 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 74 29 . #t)
11d30 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 . (els
11d40 65 20 23 66 29 29 29 29 0a 20 20 20 20 28 77 68 e #f)))). (wh
11d50 65 6e 20 64 6f 2d 73 63 61 6e 3f 0a 20 20 20 20 en do-scan?.
11d60 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 (debug:print 1
11d70 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
11d80 72 74 2a 20 22 49 4e 46 4f 3a 20 73 65 61 72 63 rt* "INFO: searc
11d90 68 20 61 6e 64 20 6d 61 72 6b 20 7a 6f 6d 62 69 h and mark zombi
11da0 65 20 74 65 73 74 73 22 29 0a 20 20 20 20 20 20 e tests").
11db0 28 72 6d 74 3a 73 65 74 2d 76 61 72 20 6b 65 79 (rmt:set-var key
11dc0 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
11dd0 73 29 29 0a 20 20 20 20 20 20 28 72 6d 74 3a 66 s)). (rmt:f
11de0 69 6e 64 2d 61 6e 64 2d 6d 61 72 6b 2d 69 6e 63 ind-and-mark-inc
11df0 6f 6d 70 6c 65 74 65 20 72 75 6e 2d 69 64 20 23 omplete run-id #
11e00 66 29 29 29 29 0a 0a 0a 0a 0a 0a 3b 3b 20 31 2e f))))......;; 1.
11e10 20 6c 6f 6f 6b 20 74 68 6f 75 67 68 20 64 69 73 look though dis
11e20 6b 73 20 6c 69 73 74 20 66 6f 72 20 64 69 73 6b ks list for disk
11e30 20 77 69 74 68 20 6d 6f 73 74 20 73 70 61 63 65 with most space
11e40 0a 3b 3b 20 32 2e 20 63 72 65 61 74 65 20 72 75 .;; 2. create ru
11e50 6e 20 64 69 72 20 6f 6e 20 64 69 73 6b 2c 20 70 n dir on disk, p
11e60 61 74 68 20 6e 61 6d 65 20 69 73 20 6d 65 61 6e ath name is mean
11e70 69 6e 67 66 75 6c 0a 3b 3b 20 33 2e 20 63 72 65 ingful.;; 3. cre
11e80 61 74 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 72 75 ate link from ru
11e90 6e 20 64 69 72 20 74 6f 20 6d 65 67 61 74 65 73 n dir to megates
11ea0 74 20 72 75 6e 73 20 61 72 65 61 20 0a 3b 3b 20 t runs area .;;
11eb0 34 2e 20 72 65 6d 6f 74 65 6c 79 20 72 75 6e 20 4. remotely run
11ec0 74 68 65 20 74 65 73 74 20 6f 6e 20 61 6c 6c 6f the test on allo
11ed0 63 61 74 65 64 20 68 6f 73 74 0a 3b 3b 20 20 20 cated host.;;
11ee0 20 2d 20 63 6f 75 6c 64 20 62 65 20 73 73 68 20 - could be ssh
11ef0 74 6f 20 68 6f 73 74 20 66 72 6f 6d 20 68 6f 73 to host from hos
11f00 74 73 20 74 61 62 6c 65 20 28 75 70 64 61 74 65 ts table (update
11f10 20 72 65 67 75 6c 61 72 6c 79 20 77 69 74 68 20 regularly with
11f20 6c 6f 61 64 29 0a 3b 3b 20 20 20 20 2d 20 63 6f load).;; - co
11f30 75 6c 64 20 62 65 20 6e 65 74 62 61 74 63 68 0a uld be netbatch.
11f40 3b 3b 20 20 20 20 20 20 28 6c 61 75 6e 63 68 2d ;; (launch-
11f50 74 65 73 74 20 64 62 20 28 63 61 64 72 20 73 74 test db (cadr st
11f60 61 74 75 73 29 20 74 65 73 74 2d 63 6f 6e 66 29 atus) test-conf)
11f70 29 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 ).(define (launc
11f80 68 2d 74 65 73 74 20 74 65 73 74 2d 69 64 20 72 h-test test-id r
11f90 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f 20 6b un-id run-info k
11fa0 65 79 76 61 6c 73 20 72 75 6e 6e 61 6d 65 20 74 eyvals runname t
11fb0 65 73 74 2d 63 6f 6e 66 20 74 65 73 74 2d 6e 61 est-conf test-na
11fc0 6d 65 20 74 65 73 74 2d 70 61 74 68 20 69 74 65 me test-path ite
11fd0 6d 64 61 74 20 70 61 72 61 6d 73 29 0a 20 20 28 mdat params). (
11fe0 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 6c 61 75 mutex-lock! *lau
11ff0 6e 63 68 2d 73 65 74 75 70 2d 6d 75 74 65 78 2a nch-setup-mutex*
12000 29 20 3b 3b 20 73 65 74 74 69 6e 67 20 76 61 72 ) ;; setting var
12010 69 61 62 6c 65 73 20 61 6e 64 20 70 72 6f 63 65 iables and proce
12020 73 73 69 6e 67 20 74 68 65 20 74 65 73 74 63 6f ssing the testco
12030 6e 66 69 67 20 69 73 20 4e 4f 54 20 74 68 72 65 nfig is NOT thre
12040 61 64 2d 73 61 66 65 2c 20 72 65 75 73 65 20 74 ad-safe, reuse t
12050 68 65 20 6c 61 75 6e 63 68 2d 73 65 74 75 70 20 he launch-setup
12060 6d 75 74 65 78 0a 20 20 28 6c 65 74 2a 20 28 20 mutex. (let* (
12070 3b 3b 20 28 6c 6f 63 6b 2d 6b 65 79 20 20 20 20 ;; (lock-key
12080 20 20 20 20 28 63 6f 6e 63 20 22 74 65 73 74 2d (conc "test-
12090 22 20 74 65 73 74 2d 69 64 29 29 0a 09 3b 3b 20 " test-id))..;;
120a0 28 67 6f 74 2d 6c 6f 63 6b 20 20 20 20 20 20 20 (got-lock
120b0 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 6f 63 (let loop ((loc
120c0 6b 20 20 20 20 20 20 20 20 28 72 6d 74 3a 6e 6f k (rmt:no
120d0 2d 73 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c -sync-get-lock l
120e0 6f 63 6b 2d 6b 65 79 29 29 0a 09 3b 3b 20 09 09 ock-key))..;; ..
120f0 09 20 20 20 20 20 28 65 78 70 69 72 65 2d 74 69 . (expire-ti
12100 6d 65 20 28 2b 20 28 63 75 72 72 65 6e 74 2d 73 me (+ (current-s
12110 65 63 6f 6e 64 73 29 20 31 35 29 29 29 20 3b 3b econds) 15))) ;;
12120 20 67 69 76 65 20 75 70 20 6f 6e 20 67 65 74 74 give up on gett
12130 69 6e 67 20 74 68 65 20 6c 6f 63 6b 20 61 6e 64 ing the lock and
12140 20 73 74 65 61 6c 20 69 74 20 61 66 74 65 72 20 steal it after
12150 31 35 20 73 65 63 6f 6e 64 73 0a 09 3b 3b 20 09 15 seconds..;; .
12160 09 20 20 20 20 28 69 66 20 28 63 61 72 20 6c 6f . (if (car lo
12170 63 6b 29 0a 09 3b 3b 20 09 09 09 23 74 0a 09 3b ck)..;; ...#t..;
12180 3b 20 09 09 09 28 69 66 20 28 3e 20 28 63 75 72 ; ...(if (> (cur
12190 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 65 78 rent-seconds) ex
121a0 70 69 72 65 2d 74 69 6d 65 29 0a 09 3b 3b 20 09 pire-time)..;; .
121b0 09 09 20 20 20 20 28 62 65 67 69 6e 0a 09 3b 3b .. (begin..;;
121c0 20 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
121d0 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 :print-info 0 *d
121e0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
121f0 20 22 54 69 6d 65 64 20 6f 75 74 20 77 61 69 74 "Timed out wait
12200 69 6e 67 20 66 6f 72 20 61 20 6c 6f 63 6b 20 74 ing for a lock t
12210 6f 20 6c 61 75 6e 63 68 20 74 65 73 74 20 22 20 o launch test "
12220 6b 65 79 76 61 6c 73 20 22 20 22 20 72 75 6e 6e keyvals " " runn
12230 61 6d 65 20 22 20 22 20 74 65 73 74 2d 6e 61 6d ame " " test-nam
12240 65 20 22 20 22 20 74 65 73 74 2d 70 61 74 68 29 e " " test-path)
12250 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 20 28 72 ..;; ... (r
12260 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c 21 20 mt:no-sync-del!
12270 6c 6f 63 6b 2d 6b 65 79 29 20 3b 3b 20 64 65 73 lock-key) ;; des
12280 74 72 6f 79 20 74 68 65 20 6c 6f 63 6b 0a 09 3b troy the lock..;
12290 3b 20 09 09 09 20 20 20 20 20 20 28 6c 6f 6f 70 ; ... (loop
122a0 20 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 67 65 (rmt:no-sync-ge
122b0 74 2d 6c 6f 63 6b 20 6c 6f 63 6b 2d 6b 65 79 29 t-lock lock-key)
122c0 20 65 78 70 69 72 65 2d 74 69 6d 65 29 29 20 3b expire-time)) ;
122d0 3b 20 0a 09 3b 3b 20 09 09 09 20 20 20 20 28 62 ; ..;; ... (b
122e0 65 67 69 6e 0a 09 3b 3b 20 09 09 09 20 20 20 20 egin..;; ...
122f0 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
12300 20 31 29 0a 09 3b 3b 20 09 09 09 20 20 20 20 20 1)..;; ...
12310 20 28 6c 6f 6f 70 20 28 72 6d 74 3a 6e 6f 2d 73 (loop (rmt:no-s
12320 79 6e 63 2d 67 65 74 2d 6c 6f 63 6b 20 6c 6f 63 ync-get-lock loc
12330 6b 2d 6b 65 79 29 20 65 78 70 69 72 65 2d 74 69 k-key) expire-ti
12340 6d 65 29 29 29 29 29 29 0a 09 20 28 69 74 65 6d me)))))).. (item
12350 2d 70 61 74 68 20 20 20 20 20 20 20 28 69 74 65 -path (ite
12360 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
12370 6d 64 61 74 29 29 0a 09 20 28 63 6f 6e 74 6f 75 mdat)).. (contou
12380 72 20 20 20 20 20 20 20 20 20 23 66 29 29 20 3b r #f)) ;
12390 3b 20 4e 4f 54 20 52 45 41 44 59 20 46 4f 52 20 ; NOT READY FOR
123a0 54 48 49 53 20 28 61 72 67 73 3a 67 65 74 2d 61 THIS (args:get-a
123b0 72 67 20 22 2d 63 6f 6e 74 6f 75 72 22 29 29 29 rg "-contour")))
123c0 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 . (let loop (
123d0 28 64 65 6c 74 61 20 20 20 20 20 20 20 20 28 2d (delta (-
123e0 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
123f0 73 29 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 2a s) *last-launch*
12400 29 29 0a 09 20 20 20 20 20 20 20 28 6c 61 75 6e )).. (laun
12410 63 68 2d 64 65 6c 61 79 20 28 63 6f 6e 66 69 67 ch-delay (config
12420 66 3a 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 20 f:lookup-number
12430 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 *configdat* "set
12440 75 70 22 20 22 6c 61 75 6e 63 68 2d 64 65 6c 61 up" "launch-dela
12450 79 22 20 64 65 66 61 75 6c 74 3a 20 30 29 29 29 y" default: 0)))
12460 0a 20 20 20 20 20 20 28 69 66 20 28 3e 20 6c 61 . (if (> la
12470 75 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 unch-delay delta
12480 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
12490 20 28 69 66 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 77 (if (common:low
124a0 2d 6e 6f 69 73 65 2d 70 72 69 6e 74 20 31 32 30 -noise-print 120
124b0 30 20 22 74 65 73 74 20 6c 61 75 6e 63 68 20 64 0 "test launch d
124c0 65 6c 61 79 22 29 20 3b 3b 20 65 76 65 72 79 20 elay") ;; every
124d0 74 77 6f 20 68 6f 75 72 73 20 6f 72 20 73 6f 20 two hours or so
124e0 72 65 6d 69 6e 64 20 74 68 65 20 75 73 65 72 20 remind the user
124f0 61 62 6f 75 74 20 6c 61 75 6e 63 68 20 64 65 6c about launch del
12500 61 79 2e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 ay....(debug:pri
12510 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 nt-info 0 *defau
12520 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e 4f lt-log-port* "NO
12530 54 45 3a 20 74 65 73 74 20 6c 61 75 6e 63 68 65 TE: test launche
12540 73 20 61 72 65 20 64 65 6c 61 79 65 64 20 62 79 s are delayed by
12550 20 22 20 6c 61 75 6e 63 68 2d 64 65 6c 61 79 20 " launch-delay
12560 22 20 73 65 63 6f 6e 64 73 2e 20 53 65 65 20 6d " seconds. See m
12570 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 6c egatest.config l
12580 61 75 6e 63 68 2d 64 65 6c 61 79 20 73 65 74 74 aunch-delay sett
12590 69 6e 67 20 74 6f 20 61 64 6a 75 73 74 2e 22 29 ing to adjust.")
125a0 29 20 3b 3b 20 6c 61 75 6e 63 68 20 6f 66 20 22 ) ;; launch of "
125b0 20 74 65 73 74 2d 6e 61 6d 65 20 22 20 66 6f 72 test-name " for
125c0 20 22 20 28 2d 20 6c 61 75 6e 63 68 2d 64 65 6c " (- launch-del
125d0 61 79 20 64 65 6c 74 61 29 20 22 20 73 65 63 6f ay delta) " seco
125e0 6e 64 73 22 29 29 0a 09 20 20 20 20 28 74 68 72 nds")).. (thr
125f0 65 61 64 2d 73 6c 65 65 70 21 20 28 2d 20 6c 61 ead-sleep! (- la
12600 75 6e 63 68 2d 64 65 6c 61 79 20 64 65 6c 74 61 unch-delay delta
12610 29 29 0a 09 20 20 20 20 28 6c 6f 6f 70 20 28 2d )).. (loop (-
12620 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
12630 73 29 20 2a 6c 61 73 74 2d 6c 61 75 6e 63 68 2a s) *last-launch*
12640 29 20 6c 61 75 6e 63 68 2d 64 65 6c 61 79 29 29 ) launch-delay))
12650 29 29 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 )). (change-d
12660 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
12670 68 2a 29 0a 20 20 20 20 28 61 6c 69 73 74 2d 3e h*). (alist->
12680 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 env-vars ;; cons
12690 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f 64 olidate this cod
126a0 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 20 e with the code
126b0 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 in megatest.scm
126c0 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 2c 20 for "-execute",
126d0 2a 6d 61 79 62 65 2a 20 2d 20 74 68 65 20 6c 6f *maybe* - the lo
126e0 6e 67 65 72 20 74 68 65 79 20 61 72 65 20 73 65 nger they are se
126f0 74 20 74 68 65 20 6c 6f 6e 67 65 72 20 65 61 63 t the longer eac
12700 68 20 6c 61 75 6e 63 68 20 74 61 6b 65 73 20 28 h launch takes (
12710 6d 75 73 74 20 62 65 20 6e 6f 6e 2d 6f 76 65 72 must be non-over
12720 6c 61 70 70 69 6e 67 20 77 69 74 68 20 74 68 65 lapping with the
12730 20 76 61 72 73 29 0a 20 20 20 20 20 28 61 70 70 vars). (app
12740 65 6e 64 0a 20 20 20 20 20 20 28 6c 69 73 74 0a end. (list.
12750 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 4d 54 (list "MT
12760 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 20 _RUN_AREA_HOME"
12770 2a 74 6f 70 70 61 74 68 2a 29 0a 20 20 20 20 20 *toppath*).
12780 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 (list "MT_TEST
12790 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 _NAME" test-name
127a0 29 0a 20 20 20 20 20 20 20 28 6c 69 73 74 20 22 ). (list "
127b0 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 75 MT_RUNNAME" ru
127c0 6e 6e 61 6d 65 29 0a 20 20 20 20 20 20 20 28 6c nname). (l
127d0 69 73 74 20 22 4d 54 5f 49 54 45 4d 50 41 54 48 ist "MT_ITEMPATH
127e0 22 20 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 " item-path).
127f0 20 20 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 43 (list "MT_C
12800 4f 4e 54 4f 55 52 22 20 20 20 63 6f 6e 74 6f 75 ONTOUR" contou
12810 72 29 0a 20 20 20 20 20 20 20 29 0a 20 20 20 20 r). ).
12820 20 20 69 74 65 6d 64 61 74 29 29 0a 20 20 20 20 itemdat)).
12830 28 6c 65 74 2a 20 28 28 74 72 65 67 69 73 74 72 (let* ((tregistr
12840 79 20 20 20 20 20 20 20 28 74 65 73 74 73 3a 67 y (tests:g
12850 65 74 2d 61 6c 6c 29 29 20 3b 3b 20 74 68 69 72 et-all)) ;; thir
12860 64 20 70 61 72 61 6d 20 28 62 65 6c 6f 77 29 20 d param (below)
12870 69 73 20 73 79 73 74 65 6d 2d 61 6c 6c 6f 77 65 is system-allowe
12880 64 0a 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 d. ;;
12890 66 6f 72 20 74 63 6f 6e 66 69 67 2c 20 77 68 79 for tconfig, why
128a0 20 64 6f 20 77 65 20 61 6c 6c 6f 77 20 66 61 6c do we allow fal
128b0 6c 62 61 63 6b 20 74 6f 20 74 65 73 74 2d 63 6f lback to test-co
128c0 6e 66 3f 0a 09 20 20 20 28 74 63 6f 6e 66 69 67 nf?.. (tconfig
128d0 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 74 65 (or (te
128e0 73 74 73 3a 67 65 74 2d 74 65 73 74 63 6f 6e 66 sts:get-testconf
128f0 69 67 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 ig test-name ite
12900 6d 2d 70 61 74 68 20 74 72 65 67 69 73 74 72 79 m-path tregistry
12910 20 23 74 20 66 6f 72 63 65 2d 63 72 65 61 74 65 #t force-create
12920 3a 20 23 74 29 0a 09 09 09 09 28 62 65 67 69 6e : #t).....(begin
12930 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12940 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12950 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
12960 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
12970 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 66 ort* "WARNING: f
12980 61 6c 6c 69 6e 67 20 62 61 63 6b 20 74 6f 20 70 alling back to p
12990 72 65 2d 63 61 6c 63 75 6c 61 74 65 64 20 74 65 re-calculated te
129a0 73 74 63 6f 6e 66 69 67 2e 20 54 68 69 73 20 69 stconfig. This i
129b0 73 20 6c 69 6b 65 6c 79 20 6e 6f 74 20 64 65 73 s likely not des
129c0 69 72 65 64 2e 22 29 0a 20 20 20 20 20 20 20 20 ired.").
129d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
129e0 20 20 20 20 20 20 20 20 20 20 74 65 73 74 2d 63 test-c
129f0 6f 6e 66 29 29 29 20 3b 3b 20 66 6f 72 63 65 20 onf))) ;; force
12a00 72 65 2d 72 65 61 64 20 6e 6f 77 20 74 68 61 74 re-read now that
12a10 20 61 6c 6c 20 76 61 72 73 20 61 72 65 20 73 65 all vars are se
12a20 74 0a 09 20 20 20 28 75 73 65 73 68 65 6c 6c 20 t.. (useshell
12a30 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 75 73 (let ((us
12a40 68 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 h (configf:looku
12a50 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a p *configdat* "j
12a60 6f 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 75 73 obtools" "us
12a70 65 73 68 65 6c 6c 22 29 29 29 0a 09 09 09 20 20 eshell")))....
12a80 20 20 20 20 28 69 66 20 75 73 68 20 0a 09 09 09 (if ush ....
12a90 09 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 75 . (if (equal? u
12aa0 73 68 20 22 6e 6f 22 29 20 3b 3b 20 6d 75 73 74 sh "no") ;; must
12ab0 20 75 73 65 20 22 6e 6f 22 20 74 6f 20 4e 4f 54 use "no" to NOT
12ac0 20 75 73 65 20 73 68 65 6c 6c 0a 09 09 09 09 20 use shell.....
12ad0 20 20 20 20 20 23 66 0a 09 09 09 09 20 20 20 20 #f.....
12ae0 20 20 75 73 68 29 0a 09 09 09 09 20 20 23 74 29 ush)..... #t)
12af0 29 29 20 20 20 20 20 3b 3b 20 64 65 66 61 75 6c )) ;; defaul
12b00 74 20 69 73 20 79 65 73 0a 09 20 20 20 28 72 75 t is yes.. (ru
12b10 6e 73 63 72 69 70 74 20 20 20 20 20 20 20 28 63 nscript (c
12b20 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 63 onfigf:lookup tc
12b30 6f 6e 66 69 67 20 20 20 22 73 65 74 75 70 22 20 onfig "setup"
12b40 20 20 20 20 20 20 20 22 72 75 6e 73 63 72 69 70 "runscrip
12b50 74 22 29 29 0a 09 20 20 20 28 65 7a 73 74 65 70 t")).. (ezstep
12b60 73 20 20 20 20 20 20 20 20 20 28 3e 20 28 6c 65 s (> (le
12b70 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 ngth (hash-table
12b80 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 63 6f -ref/default tco
12b90 6e 66 69 67 20 22 65 7a 73 74 65 70 73 22 20 27 nfig "ezsteps" '
12ba0 28 29 29 29 20 30 29 29 20 3b 3b 20 64 6f 6e 27 ())) 0)) ;; don'
12bb0 74 20 73 65 6e 64 20 61 6c 6c 20 74 68 65 20 73 t send all the s
12bc0 74 65 70 73 2c 20 63 6f 75 6c 64 20 62 65 20 62 teps, could be b
12bd0 69 67 2c 20 6a 75 73 74 20 73 65 6e 64 20 61 20 ig, just send a
12be0 66 6c 61 67 0a 09 20 20 20 28 73 75 62 72 75 6e flag.. (subrun
12bf0 20 20 20 20 20 20 20 20 20 20 28 3e 20 28 6c 65 (> (le
12c00 6e 67 74 68 20 28 68 61 73 68 2d 74 61 62 6c 65 ngth (hash-table
12c10 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 74 63 6f -ref/default tco
12c20 6e 66 69 67 20 22 73 75 62 72 75 6e 22 20 20 27 nfig "subrun" '
12c30 28 29 29 29 20 30 29 29 20 3b 3b 20 73 65 6e 64 ())) 0)) ;; send
12c40 20 61 20 66 6c 61 67 20 74 6f 20 70 72 6f 63 65 a flag to proce
12c50 73 73 20 61 20 73 75 62 72 75 6e 0a 09 20 20 20 ss a subrun..
12c60 3b 3b 20 28 64 69 73 6b 73 70 61 63 65 20 20 20 ;; (diskspace
12c70 20 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f (configf:loo
12c80 6b 75 70 20 74 63 6f 6e 66 69 67 20 20 20 22 72 kup tconfig "r
12c90 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 64 69 equirements" "di
12ca0 73 6b 73 70 61 63 65 22 29 29 0a 09 20 20 20 3b skspace")).. ;
12cb0 3b 20 28 6d 65 6d 6f 72 79 20 20 20 20 20 20 20 ; (memory
12cc0 20 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b (configf:look
12cd0 75 70 20 74 63 6f 6e 66 69 67 20 20 20 22 72 65 up tconfig "re
12ce0 71 75 69 72 65 6d 65 6e 74 73 22 20 22 6d 65 6d quirements" "mem
12cf0 6f 72 79 22 29 29 0a 09 20 20 20 3b 3b 20 28 68 ory")).. ;; (h
12d00 6f 73 74 73 20 20 20 20 20 20 20 20 20 20 20 28 osts (
12d10 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a configf:lookup *
12d20 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 configdat* "jobt
12d30 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b 68 ools" "workh
12d40 6f 73 74 73 22 29 29 20 3b 3b 20 49 27 6d 20 70 osts")) ;; I'm p
12d50 72 65 74 74 79 20 73 75 72 65 20 74 68 69 73 20 retty sure this
12d60 77 61 73 20 6e 65 76 65 72 20 63 6f 6d 70 6c 65 was never comple
12d70 74 65 64 0a 09 20 20 20 28 72 65 6d 6f 74 65 2d ted.. (remote-
12d80 6d 65 67 61 74 65 73 74 20 28 63 6f 6e 66 69 67 megatest (config
12d90 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
12da0 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 65 78 dat* "setup" "ex
12db0 65 63 75 74 61 62 6c 65 22 29 29 0a 09 20 20 20 ecutable"))..
12dc0 28 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 20 (run-time-limit
12dd0 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
12de0 6f 6b 75 70 20 20 74 63 6f 6e 66 69 67 20 20 20 okup tconfig
12df0 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 20 22 "requirements" "
12e00 72 75 6e 74 69 6d 65 6c 69 6d 22 29 0a 09 09 09 runtimelim")....
12e10 09 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 .(configf:lookup
12e20 20 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 *configdat* "s
12e30 65 74 75 70 22 20 22 72 75 6e 74 69 6d 65 6c 69 etup" "runtimeli
12e40 6d 22 29 29 29 0a 09 20 20 20 3b 3b 20 46 49 58 m"))).. ;; FIX
12e50 4d 45 20 53 4f 4d 45 44 41 59 3a 20 6e 6f 74 20 ME SOMEDAY: not
12e60 67 6f 6f 64 20 68 6f 77 20 74 68 69 73 20 69 73 good how this is
12e70 20 73 6f 20 6f 62 74 75 73 65 2c 20 74 68 69 73 so obtuse, this
12e80 20 68 61 63 6b 20 69 73 20 74 6f 20 0a 09 20 20 hack is to ..
12e90 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
12ea0 20 20 20 61 6c 6c 6f 77 20 72 75 6e 6e 69 6e 67 allow running
12eb0 20 66 72 6f 6d 20 64 61 73 68 62 6f 61 72 64 2e from dashboard.
12ec0 20 45 78 74 72 61 63 74 20 74 68 65 20 70 61 74 Extract the pat
12ed0 68 0a 09 20 20 20 3b 3b 20 20 20 20 20 20 20 20 h.. ;;
12ee0 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 68 65 from the
12ef0 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 73 74 called megatest
12f00 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 61 73 and convert das
12f10 68 62 6f 61 72 64 0a 09 20 20 20 3b 3b 20 20 20 hboard.. ;;
12f20 20 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 . or
12f30 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 dboard to megate
12f40 73 74 0a 09 20 20 20 28 6c 6f 63 61 6c 2d 6d 65 st.. (local-me
12f50 67 61 74 65 73 74 20 20 28 63 6f 6d 6d 6f 6e 3a gatest (common:
12f60 66 69 6e 64 2d 6c 6f 63 61 6c 2d 6d 65 67 61 74 find-local-megat
12f70 65 73 74 29 29 0a 09 20 20 20 23 3b 28 6c 6f 63 est)).. #;(loc
12f80 61 6c 2d 6d 65 67 61 74 65 73 74 20 20 28 6c 65 al-megatest (le
12f90 74 2a 20 28 28 6c 6d 20 20 28 63 61 72 20 28 61 t* ((lm (car (a
12fa0 72 67 76 29 29 29 0a 09 09 09 09 20 20 20 28 64 rgv)))..... (d
12fb0 69 72 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 ir (pathname-dir
12fc0 65 63 74 6f 72 79 20 6c 6d 29 29 0a 09 09 09 09 ectory lm)).....
12fd0 20 20 20 28 65 78 65 20 28 70 61 74 68 6e 61 6d (exe (pathnam
12fe0 65 2d 73 74 72 69 70 2d 64 69 72 65 63 74 6f 72 e-strip-director
12ff0 79 20 6c 6d 29 29 29 0a 09 09 09 20 20 20 20 20 y lm)))....
13000 20 28 63 6f 6e 63 20 28 69 66 20 64 69 72 20 28 (conc (if dir (
13010 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 20 22 22 conc dir "/") ""
13020 29 0a 09 09 09 09 20 20 20 20 28 63 61 73 65 20 )..... (case
13030 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
13040 65 78 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 exe)..... (
13050 28 64 62 6f 61 72 64 29 20 20 20 20 22 2e 2e 2f (dboard) "../
13060 6d 65 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 megatest").....
13070 20 20 20 20 20 28 28 6d 74 65 73 74 29 20 20 20 ((mtest)
13080 20 20 22 2e 2e 2f 6d 65 67 61 74 65 73 74 22 29 "../megatest")
13090 0a 09 09 09 09 20 20 20 20 20 20 28 28 64 61 73 ..... ((das
130a0 68 62 6f 61 72 64 29 20 22 6d 65 67 61 74 65 73 hboard) "megates
130b0 74 22 29 0a 09 09 09 09 20 20 20 20 20 20 28 65 t")..... (e
130c0 6c 73 65 20 65 78 65 29 29 29 29 29 0a 09 20 20 lse exe)))))..
130d0 20 28 6c 61 75 6e 63 68 65 72 20 20 20 20 20 20 (launcher
130e0 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 6c 61 (common:get-la
130f0 75 6e 63 68 65 72 20 2a 63 6f 6e 66 69 67 64 61 uncher *configda
13100 74 2a 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 t* test-name ite
13110 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 63 6f 6e m-path)) ;; (con
13120 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e figf:lookup *con
13130 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c figdat* "jobtool
13140 73 22 20 20 20 20 20 22 6c 61 75 6e 63 68 65 72 s" "launcher
13150 22 29 29 0a 09 20 20 20 28 74 65 73 74 2d 73 69 ")).. (test-si
13160 67 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 28 g (conc (
13170 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 common:get-tests
13180 75 69 74 65 2d 6e 61 6d 65 29 20 22 3a 22 20 74 uite-name) ":" t
13190 65 73 74 2d 6e 61 6d 65 20 22 3a 22 20 69 74 65 est-name ":" ite
131a0 6d 2d 70 61 74 68 29 29 20 3b 3b 20 28 69 74 65 m-path)) ;; (ite
131b0 6d 2d 6c 69 73 74 2d 3e 70 61 74 68 20 69 74 65 m-list->path ite
131c0 6d 64 61 74 29 29 29 20 3b 3b 20 74 65 73 74 2d mdat))) ;; test-
131d0 70 61 74 68 20 69 73 20 74 68 65 20 66 75 6c 6c path is the full
131e0 20 70 61 74 68 20 69 6e 63 6c 75 64 69 6e 67 20 path including
131f0 74 68 65 20 69 74 65 6d 2d 70 61 74 68 0a 09 20 the item-path..
13200 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 20 20 20 (work-area
13210 20 20 20 23 66 29 0a 09 20 20 20 28 74 6f 70 74 #f).. (topt
13220 65 73 74 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 est-work-area #f
13230 29 20 3b 3b 20 66 6f 72 20 69 74 65 72 61 74 65 ) ;; for iterate
13240 64 20 74 65 73 74 73 20 74 68 65 20 74 6f 70 20 d tests the top
13250 74 65 73 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 test contains da
13260 74 61 20 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 ta relevant for
13270 61 6c 6c 0a 09 20 20 20 28 64 69 73 6b 70 61 74 all.. (diskpat
13280 68 20 20 20 23 66 29 0a 09 20 20 20 28 63 6d 64 h #f).. (cmd
13290 70 61 72 6d 73 20 20 20 23 66 29 0a 09 20 20 20 parms #f)..
132a0 28 66 75 6c 6c 63 6d 64 20 20 20 20 23 66 29 20 (fullcmd #f)
132b0 3b 3b 20 28 64 65 66 69 6e 65 20 61 20 28 77 69 ;; (define a (wi
132c0 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 th-output-to-str
132d0 69 6e 67 20 28 6c 61 6d 62 64 61 20 28 29 28 77 ing (lambda ()(w
132e0 72 69 74 65 20 78 29 29 29 29 0a 09 20 20 20 28 rite x)))).. (
132f0 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 23 mt-bindir-path #
13300 66 29 0a 09 20 20 20 28 74 65 73 74 69 6e 66 6f f).. (testinfo
13310 20 20 20 28 72 6d 74 3a 67 65 74 2d 74 65 73 74 (rmt:get-test
13320 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e 2d -info-by-id run-
13330 69 64 20 74 65 73 74 2d 69 64 29 29 0a 09 20 20 id test-id))..
13340 20 28 6d 74 5f 74 61 72 67 65 74 20 20 28 73 74 (mt_target (st
13350 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
13360 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 (map cadr keyva
13370 6c 73 29 20 22 2f 22 29 29 0a 09 20 20 20 28 64 ls) "/")).. (d
13380 65 62 75 67 2d 70 61 72 61 6d 20 28 61 70 70 65 ebug-param (appe
13390 6e 64 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 nd (if (args:get
133a0 2d 61 72 67 20 22 2d 64 65 62 75 67 22 29 20 20 -arg "-debug")
133b0 28 6c 69 73 74 20 22 2d 64 65 62 75 67 22 20 28 (list "-debug" (
133c0 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 args:get-arg "-d
133d0 65 62 75 67 22 29 29 20 27 28 29 29 0a 09 09 09 ebug")) '())....
133e0 09 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 .(if (args:get-a
133f0 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
13400 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
13410 27 28 29 29 0a 09 09 09 09 28 69 66 20 28 63 6f '()).....(if (co
13420 6e 66 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f nfigf:lookup *co
13430 6e 66 69 67 64 61 74 2a 20 22 6d 69 73 63 22 20 nfigdat* "misc"
13440 22 70 72 6f 66 69 6c 65 73 77 22 29 0a 09 09 09 "profilesw")....
13450 09 20 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 66 . (list (conf
13460 69 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 igf:lookup *conf
13470 69 67 64 61 74 2a 20 22 6d 69 73 63 22 20 22 70 igdat* "misc" "p
13480 72 6f 66 69 6c 65 73 77 22 29 29 0a 09 09 09 09 rofilesw")).....
13490 20 20 20 20 27 28 29 29 29 29 29 0a 20 20 20 20 '())))).
134a0 20 20 3b 3b 20 28 69 66 20 68 6f 73 74 73 20 28 ;; (if hosts (
134b0 73 65 74 21 20 68 6f 73 74 73 20 28 73 74 72 69 set! hosts (stri
134c0 6e 67 2d 73 70 6c 69 74 20 68 6f 73 74 73 29 29 ng-split hosts))
134d0 29 0a 20 20 20 20 20 20 3b 3b 20 73 65 74 20 74 ). ;; set t
134e0 68 65 20 6d 65 67 61 74 65 73 74 20 74 6f 20 62 he megatest to b
134f0 65 20 63 61 6c 6c 65 64 20 6f 6e 20 74 68 65 20 e called on the
13500 72 65 6d 6f 74 65 20 68 6f 73 74 0a 20 20 20 20 remote host.
13510 20 20 28 69 66 20 28 6e 6f 74 20 72 65 6d 6f 74 (if (not remot
13520 65 2d 6d 65 67 61 74 65 73 74 29 28 73 65 74 21 e-megatest)(set!
13530 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
13540 20 6c 6f 63 61 6c 2d 6d 65 67 61 74 65 73 74 29 local-megatest)
13550 29 20 3b 3b 20 22 6d 65 67 61 74 65 73 74 22 29 ) ;; "megatest")
13560 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 6d 74 ). (set! mt
13570 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 70 61 -bindir-path (pa
13580 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
13590 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
135a0 29 29 0a 20 20 20 20 20 20 28 69 66 20 6c 61 75 )). (if lau
135b0 6e 63 68 65 72 20 28 73 65 74 21 20 6c 61 75 6e ncher (set! laun
135c0 63 68 65 72 20 28 73 74 72 69 6e 67 2d 73 70 6c cher (string-spl
135d0 69 74 20 6c 61 75 6e 63 68 65 72 29 29 29 0a 20 it launcher))).
135e0 20 20 20 20 20 3b 3b 20 73 65 74 20 75 70 20 74 ;; set up t
135f0 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 72 65 61 he run work area
13600 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 0a 20 for this test.
13610 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 61 (if (and (a
13620 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 70 72 rgs:get-arg "-pr
13630 65 63 6c 65 61 6e 22 29 20 3b 3b 20 75 73 65 72 eclean") ;; user
13640 20 68 61 73 20 72 65 71 75 65 73 74 65 64 20 74 has requested t
13650 6f 20 70 72 65 63 6c 65 61 6e 20 66 6f 72 20 74 o preclean for t
13660 68 69 73 20 72 75 6e 0a 09 20 20 20 20 20 20 20 his run..
13670 28 6e 6f 74 20 28 6d 65 6d 62 65 72 20 28 64 62 (not (member (db
13680 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
13690 20 74 65 73 74 69 6e 66 6f 29 28 6c 69 73 74 20 testinfo)(list
136a0 22 6e 2f 61 22 20 22 2f 74 6d 70 2f 62 61 64 6e "n/a" "/tmp/badn
136b0 61 6d 65 22 29 29 29 29 20 3b 3b 20 6e 2f 61 20 ame")))) ;; n/a
136c0 69 73 20 61 20 70 6c 61 63 65 68 6f 6c 64 65 72 is a placeholder
136d0 20 61 6e 64 20 74 68 75 73 20 6e 6f 74 20 61 20 and thus not a
136e0 72 65 61 64 20 64 69 72 0a 09 20 20 28 62 65 67 read dir.. (beg
136f0 69 6e 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 in.. (debug:p
13700 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
13710 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13720 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 70 72 attempting to pr
13730 65 63 6c 65 61 6e 20 64 69 72 65 63 74 6f 72 79 eclean directory
13740 20 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d " (db:test-get-
13750 72 75 6e 64 69 72 20 74 65 73 74 69 6e 66 6f 29 rundir testinfo)
13760 20 22 20 66 6f 72 20 74 65 73 74 20 22 20 74 65 " for test " te
13770 73 74 2d 6e 61 6d 65 20 22 2f 22 20 69 74 65 6d st-name "/" item
13780 2d 70 61 74 68 29 0a 09 20 20 20 20 28 72 75 6e -path).. (run
13790 73 3a 72 65 6d 6f 76 65 2d 74 65 73 74 2d 64 69 s:remove-test-di
137a0 72 65 63 74 6f 72 79 20 74 65 73 74 69 6e 66 6f rectory testinfo
137b0 20 27 72 65 6d 6f 76 65 2d 64 61 74 61 2d 6f 6e 'remove-data-on
137c0 6c 79 29 29 29 20 3b 3b 20 72 65 6d 6f 76 65 20 ly))) ;; remove
137d0 64 61 74 61 20 6f 6e 6c 79 2c 20 64 6f 20 6e 6f data only, do no
137e0 74 20 70 65 72 74 75 72 62 20 74 68 65 20 72 65 t perturb the re
137f0 63 6f 72 64 0a 20 20 20 20 20 20 0a 20 20 20 20 cord. .
13800 20 20 3b 3b 20 70 72 65 76 65 6e 74 20 6f 76 65 ;; prevent ove
13810 72 6c 61 70 70 69 6e 67 20 61 63 74 69 6f 6e 73 rlapping actions
13820 20 2d 20 73 65 74 20 74 6f 20 4c 41 55 4e 43 48 - set to LAUNCH
13830 45 44 20 61 73 20 65 61 72 6c 79 20 61 73 20 70 ED as early as p
13840 6f 73 73 69 62 6c 65 0a 20 20 20 20 20 20 3b 3b ossible. ;;
13850 0a 20 20 20 20 20 20 3b 3b 20 74 68 65 20 66 6f . ;; the fo
13860 6c 6c 6f 77 69 6e 67 20 63 61 6c 6c 20 68 61 6e llowing call han
13870 64 6c 65 73 20 77 61 69 76 65 72 20 70 72 6f 70 dles waiver prop
13880 6f 67 61 74 69 6f 6e 2e 20 63 61 6e 6e 6f 74 20 ogation. cannot
13890 79 65 74 20 63 6f 6e 64 65 6e 73 65 20 69 6e 74 yet condense int
138a0 6f 20 72 6f 6c 6c 2d 75 70 2d 70 61 73 73 2d 66 o roll-up-pass-f
138b0 61 69 6c 0a 20 20 20 20 20 20 28 74 65 73 74 73 ail. (tests
138c0 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
138d0 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
138e0 20 22 4c 41 55 4e 43 48 45 44 22 20 22 6e 2f 61 "LAUNCHED" "n/a
138f0 22 20 23 66 20 23 66 29 20 3b 3b 20 28 69 66 20 " #f #f) ;; (if
13900 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 6c launch-results l
13910 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 22 46 aunch-results "F
13920 41 49 4c 45 44 22 29 29 0a 20 20 20 20 20 20 28 AILED")). (
13930 72 6d 74 3a 73 65 74 2d 73 74 61 74 65 2d 73 74 rmt:set-state-st
13940 61 74 75 73 2d 61 6e 64 2d 72 6f 6c 6c 2d 75 70 atus-and-roll-up
13950 2d 69 74 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 -items run-id te
13960 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
13970 68 20 23 66 20 22 4c 41 55 4e 43 48 45 44 22 20 h #f "LAUNCHED"
13980 23 66 29 0a 20 20 20 20 20 20 3b 3b 20 28 70 70 #f). ;; (pp
13990 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 3e 61 6c (hash-table->al
139a0 69 73 74 20 74 63 6f 6e 66 69 67 29 29 0a 20 20 ist tconfig)).
139b0 20 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 61 (set! diskpa
139c0 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 73 th (get-best-dis
139d0 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 74 63 k *configdat* tc
139e0 6f 6e 66 69 67 29 29 0a 20 20 20 20 20 20 28 64 onfig)). (d
139f0 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 65 ebug:print 2 *de
13a00 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
13a10 22 62 65 73 74 20 64 69 73 6b 20 70 61 74 68 20 "best disk path
13a20 3d 20 22 20 64 69 73 6b 70 61 74 68 29 0a 20 20 = " diskpath).
13a30 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 68 (if diskpath
13a40 0a 09 20 20 28 6c 65 74 20 28 28 64 61 74 20 20 .. (let ((dat
13a50 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 (create-work-are
13a60 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 a run-id run-inf
13a70 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 2d 69 o keyvals test-i
13a80 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b d test-path disk
13a90 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 path test-name i
13aa0 74 65 6d 64 61 74 29 29 29 0a 09 20 20 20 20 28 temdat))).. (
13ab0 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
13ac0 63 61 72 20 64 61 74 29 29 0a 09 20 20 20 20 28 car dat)).. (
13ad0 73 65 74 21 20 74 6f 70 74 65 73 74 2d 77 6f 72 set! toptest-wor
13ae0 6b 2d 61 72 65 61 20 28 63 61 64 72 20 64 61 74 k-area (cadr dat
13af0 29 29 0a 09 20 20 20 20 28 64 65 62 75 67 3a 70 )).. (debug:p
13b00 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 rint-info 2 *def
13b10 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
13b20 55 73 69 6e 67 20 77 6f 72 6b 20 61 72 65 61 20 Using work area
13b30 22 20 77 6f 72 6b 2d 61 72 65 61 29 29 0a 09 20 " work-area))..
13b40 20 28 62 65 67 69 6e 0a 09 20 20 20 20 28 73 65 (begin.. (se
13b50 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 6f t! work-area (co
13b60 6e 63 20 74 65 73 74 2d 70 61 74 68 20 22 2f 74 nc test-path "/t
13b70 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 20 20 28 mp_run")).. (
13b80 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
13b90 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 work-area #t)..
13ba0 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
13bb0 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
13bc0 70 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 port* "WARNING:
13bd0 4e 6f 20 64 69 73 6b 20 77 6f 72 6b 20 61 72 65 No disk work are
13be0 61 20 73 70 65 63 69 66 69 65 64 20 2d 20 72 75 a specified - ru
13bf0 6e 6e 69 6e 67 20 69 6e 20 74 68 65 20 74 65 73 nning in the tes
13c00 74 20 64 69 72 65 63 74 6f 72 79 20 75 6e 64 65 t directory unde
13c10 72 20 74 6d 70 5f 72 75 6e 22 29 29 29 0a 20 20 r tmp_run"))).
13c20 20 20 20 20 28 73 65 74 21 20 63 6d 64 70 61 72 (set! cmdpar
13c30 6d 73 20 28 62 61 73 65 36 34 3a 62 61 73 65 36 ms (base64:base6
13c40 34 2d 65 6e 63 6f 64 65 20 0a 09 09 20 20 20 20 4-encode ...
13c50 20 20 28 7a 33 3a 65 6e 63 6f 64 65 2d 62 75 66 (z3:encode-buf
13c60 66 65 72 20 0a 09 09 20 20 20 20 20 20 20 28 77 fer ... (w
13c70 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 73 74 ith-output-to-st
13c80 72 69 6e 67 0a 09 09 09 20 28 6c 61 6d 62 64 61 ring.... (lambda
13c90 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f () ;; (list 'ho
13ca0 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 sts hosts)..
13cb0 09 09 20 20 20 28 77 72 69 74 65 20 28 6c 69 73 .. (write (lis
13cc0 74 20 28 6c 69 73 74 20 27 74 65 73 74 70 61 74 t (list 'testpat
13cd0 68 20 20 74 65 73 74 2d 70 61 74 68 29 0a 09 09 h test-path)...
13ce0 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 74 72 61 ...;; (list 'tra
13cf0 6e 73 70 6f 72 74 20 28 63 6f 6e 63 20 2a 74 72 nsport (conc *tr
13d00 61 6e 73 70 6f 72 74 2d 74 79 70 65 2a 29 29 0a ansport-type*)).
13d10 09 09 09 09 09 3b 3b 20 28 6c 69 73 74 20 27 73 .....;; (list 's
13d20 65 72 76 65 72 69 6e 66 20 2a 73 65 72 76 65 72 erverinf *server
13d30 2d 69 6e 66 6f 2a 29 0a 09 09 09 09 09 28 6c 69 -info*)......(li
13d40 73 74 20 27 68 6f 6d 65 68 6f 73 74 20 20 28 6c st 'homehost (l
13d50 65 74 2a 20 28 28 68 68 64 61 74 20 28 63 6f 6d et* ((hhdat (com
13d60 6d 6f 6e 3a 67 65 74 2d 68 6f 6d 65 68 6f 73 74 mon:get-homehost
13d70 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 28 69 )))........ (i
13d80 66 20 68 68 64 61 74 0a 09 09 09 09 09 09 09 20 f hhdat........
13d90 20 20 20 20 20 20 28 63 61 72 20 68 68 64 61 74 (car hhdat
13da0 29 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 )........
13db0 23 66 29 29 29 0a 09 09 09 09 09 28 6c 69 73 74 #f)))......(list
13dc0 20 27 73 65 72 76 65 72 75 72 6c 20 28 69 66 20 'serverurl (if
13dd0 2a 72 75 6e 72 65 6d 6f 74 65 2a 0a 09 09 09 09 *runremote*.....
13de0 09 09 09 20 20 20 20 20 28 72 65 6d 6f 74 65 2d ... (remote-
13df0 73 65 72 76 65 72 2d 75 72 6c 20 2a 72 75 6e 72 server-url *runr
13e00 65 6d 6f 74 65 2a 29 0a 09 09 09 09 09 09 09 20 emote*)........
13e10 20 20 20 20 23 66 29 29 20 3b 3b 0a 09 09 09 09 #f)) ;;.....
13e20 09 28 6c 69 73 74 20 27 61 72 65 61 6e 61 6d 65 .(list 'areaname
13e30 20 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 (common:get-te
13e40 73 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 0a 09 stsuite-name))..
13e50 09 09 09 09 28 6c 69 73 74 20 27 74 6f 70 70 61 ....(list 'toppa
13e60 74 68 20 20 20 2a 74 6f 70 70 61 74 68 2a 29 0a th *toppath*).
13e70 09 09 09 09 09 28 6c 69 73 74 20 27 77 6f 72 6b .....(list 'work
13e80 2d 61 72 65 61 20 77 6f 72 6b 2d 61 72 65 61 29 -area work-area)
13e90 0a 09 09 09 09 09 28 6c 69 73 74 20 27 74 65 73 ......(list 'tes
13ea0 74 2d 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 t-name test-name
13eb0 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 27 72 ) ......(list 'r
13ec0 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 69 unscript runscri
13ed0 70 74 29 20 0a 09 09 09 09 09 28 6c 69 73 74 20 pt) ......(list
13ee0 27 72 75 6e 2d 69 64 20 20 20 20 72 75 6e 2d 69 'run-id run-i
13ef0 64 20 20 20 29 0a 09 09 09 09 09 28 6c 69 73 74 d )......(list
13f00 20 27 74 65 73 74 2d 69 64 20 20 20 74 65 73 74 'test-id test
13f10 2d 69 64 20 20 29 0a 09 09 09 09 09 3b 3b 20 28 -id )......;; (
13f20 6c 69 73 74 20 27 69 74 65 6d 2d 70 61 74 68 20 list 'item-path
13f30 69 74 65 6d 2d 70 61 74 68 20 29 0a 09 09 09 09 item-path ).....
13f40 09 28 6c 69 73 74 20 27 69 74 65 6d 64 61 74 20 .(list 'itemdat
13f50 20 20 69 74 65 6d 64 61 74 20 20 29 0a 09 09 09 itemdat )....
13f60 09 09 28 6c 69 73 74 20 27 6d 65 67 61 74 65 73 ..(list 'megates
13f70 74 20 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 t remote-megate
13f80 73 74 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 st)......(list '
13f90 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 65 70 ezsteps ezstep
13fa0 73 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 73 s)......(list 's
13fb0 75 62 72 75 6e 20 20 20 20 73 75 62 72 75 6e 29 ubrun subrun)
13fc0 0a 09 09 09 09 09 28 6c 69 73 74 20 27 74 61 72 ......(list 'tar
13fd0 67 65 74 20 20 20 20 6d 74 5f 74 61 72 67 65 74 get mt_target
13fe0 29 0a 09 09 09 09 09 28 6c 69 73 74 20 27 63 6f )......(list 'co
13ff0 6e 74 6f 75 72 20 20 20 63 6f 6e 74 6f 75 72 29 ntour contour)
14000 0a 09 09 09 09 09 28 6c 69 73 74 20 27 72 75 6e ......(list 'run
14010 74 6c 69 6d 20 20 20 28 69 66 20 72 75 6e 2d 74 tlim (if run-t
14020 69 6d 65 2d 6c 69 6d 69 74 20 28 63 6f 6d 6d 6f ime-limit (commo
14030 6e 3a 68 6d 73 2d 73 74 72 69 6e 67 2d 3e 73 65 n:hms-string->se
14040 63 6f 6e 64 73 20 72 75 6e 2d 74 69 6d 65 2d 6c conds run-time-l
14050 69 6d 69 74 29 20 23 66 29 29 0a 09 09 09 09 09 imit) #f))......
14060 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 (list 'env-ovrd
14070 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
14080 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
14090 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
140a0 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 09 de" '())) ......
140b0 28 6c 69 73 74 20 27 73 65 74 2d 76 61 72 73 20 (list 'set-vars
140c0 20 28 69 66 20 70 61 72 61 6d 73 20 28 68 61 73 (if params (has
140d0 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
140e0 75 6c 74 20 70 61 72 61 6d 73 20 22 2d 73 65 74 ult params "-set
140f0 76 61 72 73 22 20 23 66 29 29 29 0a 09 09 09 09 vars" #f))).....
14100 09 28 6c 69 73 74 20 27 72 75 6e 6e 61 6d 65 20 .(list 'runname
14110 20 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 runname)......
14120 28 6c 69 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 (list 'mt-bindir
14130 2d 70 61 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d -path mt-bindir-
14140 70 61 74 68 29 29 29 29 29 29 29 29 0a 0a 20 20 path))))))))..
14150 20 20 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d (setenv "M
14160 54 5f 43 4d 44 49 4e 46 4f 22 20 63 6d 64 70 61 T_CMDINFO" cmdpa
14170 72 6d 73 29 20 20 3b 3b 20 73 65 74 74 69 6e 67 rms) ;; setting
14180 20 74 68 69 73 20 66 6f 72 20 75 73 65 20 69 6e this for use in
14190 20 6e 62 6c 61 75 6e 63 68 65 72 0a 20 20 20 20 nblauncher.
141a0 20 20 0a 20 20 20 20 20 20 3b 3b 20 63 6c 65 61 . ;; clea
141b0 6e 20 6f 75 74 20 73 74 65 70 20 72 65 63 6f 72 n out step recor
141c0 64 73 20 66 72 6f 6d 20 70 72 65 76 69 6f 75 73 ds from previous
141d0 20 72 75 6e 20 69 66 20 74 68 65 79 20 65 78 69 run if they exi
141e0 73 74 0a 20 20 20 20 20 20 3b 3b 20 28 72 6d 74 st. ;; (rmt
141f0 3a 64 65 6c 65 74 65 2d 74 65 73 74 2d 73 74 65 :delete-test-ste
14200 70 2d 72 65 63 6f 72 64 73 20 72 75 6e 2d 69 64 p-records run-id
14210 20 74 65 73 74 2d 69 64 29 0a 20 20 20 20 20 20 test-id).
14220 3b 3b 20 69 66 20 74 68 65 20 64 69 72 20 64 6f ;; if the dir do
14230 65 73 20 6e 6f 74 20 65 78 69 73 74 20 77 65 20 es not exist we
14240 6d 61 79 20 68 61 76 65 20 61 20 69 74 65 6d 70 may have a itemp
14250 61 74 68 20 77 68 65 72 65 20 69 6e 64 69 76 69 ath where indivi
14260 64 75 61 6c 20 76 61 72 69 61 62 6c 65 73 20 61 dual variables a
14270 72 65 20 61 20 70 61 74 68 2c 20 6c 61 75 6e 63 re a path, launc
14280 68 20 61 6e 79 77 61 79 0a 20 20 20 20 20 20 28 h anyway. (
14290 69 66 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d if (common:file-
142a0 65 78 69 73 74 73 3f 20 77 6f 72 6b 2d 61 72 65 exists? work-are
142b0 61 29 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 a).. (change-di
142c0 72 65 63 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 rectory work-are
142d0 61 29 29 20 3b 3b 20 73 6f 20 74 68 61 74 20 6c a)) ;; so that l
142e0 6f 67 20 66 69 6c 65 73 20 66 72 6f 6d 20 74 68 og files from th
142f0 65 20 6c 61 75 6e 63 68 20 70 72 6f 63 65 73 73 e launch process
14300 20 64 6f 6e 27 74 20 63 6c 75 74 74 65 72 20 74 don't clutter t
14310 68 65 20 74 65 73 74 20 64 69 72 0a 20 20 20 20 he test dir.
14320 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 3b (cond. ;
14330 3b 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 ; ((and launcher
14340 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 hosts) ;; must
14350 62 65 20 75 73 69 6e 67 20 73 73 68 20 68 6f 73 be using ssh hos
14360 74 6e 61 6d 65 0a 20 20 20 20 20 20 20 3b 3b 20 tname. ;;
14370 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 (set! fullcmd
14380 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
14390 72 20 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 r (car hosts)(li
143a0 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 st remote-megate
143b0 73 74 20 22 2d 6d 22 20 74 65 73 74 2d 73 69 67 st "-m" test-sig
143c0 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
143d0 61 72 6d 73 29 20 64 65 62 75 67 2d 70 61 72 61 arms) debug-para
143e0 6d 29 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 28 m))). ;; (
143f0 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 set! fullcmd (ap
14400 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 63 pend launcher (c
14410 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 72 ar hosts)(list r
14420 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 74 emote-megatest t
14430 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 74 est-sig "-execut
14440 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 0a e" cmdparms)))).
14450 20 20 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 (launcher
14460 0a 09 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 ..(set! fullcmd
14470 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 (append launcher
14480 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
14490 67 61 74 65 73 74 20 22 2d 6d 22 20 74 65 73 74 gatest "-m" test
144a0 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
144b0 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
144c0 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 20 20 param))).
144d0 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
144e0 20 28 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 (append launche
144f0 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d r (list remote-m
14500 65 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 egatest test-sig
14510 20 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 "-execute" cmdp
14520 61 72 6d 73 29 29 29 29 0a 20 20 20 20 20 20 20 arms)))).
14530 28 65 6c 73 65 0a 09 28 69 66 20 28 6e 6f 74 20 (else..(if (not
14540 75 73 65 73 68 65 6c 6c 29 28 64 65 62 75 67 3a useshell)(debug:
14550 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
14560 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 57 41 52 4e -log-port* "WARN
14570 49 4e 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c 61 ING: internal la
14580 75 6e 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 unching will not
14590 20 77 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 6f work well witho
145a0 75 74 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 65 ut \"useshell ye
145b0 73 5c 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 s\" in your [job
145c0 74 6f 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 29 tools] section")
145d0 29 0a 09 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 )..(set! fullcmd
145e0 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 72 (append (list r
145f0 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 22 emote-megatest "
14600 2d 6d 22 20 74 65 73 74 2d 73 69 67 20 22 2d 65 -m" test-sig "-e
14610 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 xecute" cmdparms
14620 29 20 64 65 62 75 67 2d 70 61 72 61 6d 20 28 6c ) debug-param (l
14630 69 73 74 20 28 69 66 20 75 73 65 73 68 65 6c 6c ist (if useshell
14640 20 22 26 22 20 22 22 29 29 29 29 29 29 0a 20 20 "&" "")))))).
14650 20 20 20 20 3b 3b 20 28 73 65 74 21 20 66 75 6c ;; (set! ful
14660 6c 63 6d 64 20 28 6c 69 73 74 20 72 65 6d 6f 74 lcmd (list remot
14670 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d e-megatest test-
14680 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 sig "-execute" c
14690 6d 64 70 61 72 6d 73 20 28 69 66 20 75 73 65 73 mdparms (if uses
146a0 68 65 6c 6c 20 22 26 22 20 22 22 29 29 29 29 29 hell "&" "")))))
146b0 0a 20 20 20 20 20 20 28 69 66 20 28 61 72 67 73 . (if (args
146c0 3a 67 65 74 2d 61 72 67 20 22 2d 78 74 65 72 6d :get-arg "-xterm
146d0 22 29 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 ")(set! fullcmd
146e0 28 61 70 70 65 6e 64 20 66 75 6c 6c 63 6d 64 20 (append fullcmd
146f0 28 6c 69 73 74 20 22 2d 78 74 65 72 6d 22 29 29 (list "-xterm"))
14700 29 29 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a )). (debug:
14710 70 72 69 6e 74 20 31 20 2a 64 65 66 61 75 6c 74 print 1 *default
14720 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4c 61 75 6e -log-port* "Laun
14730 63 68 69 6e 67 20 22 20 77 6f 72 6b 2d 61 72 65 ching " work-are
14740 61 29 0a 20 20 20 20 20 20 3b 3b 20 73 65 74 20 a). ;; set
14750 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 76 pre-launch-env-v
14760 61 72 73 20 62 65 66 6f 72 65 20 6c 61 75 6e 63 ars before launc
14770 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 20 76 hing, keep the v
14780 61 72 73 20 69 6e 20 70 72 65 76 76 61 6c 73 20 ars in prevvals
14790 61 6e 64 20 70 75 74 20 74 68 65 20 65 6e 76 69 and put the envi
147a0 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 65 6e onment back when
147b0 20 64 6f 6e 65 0a 20 20 20 20 20 20 28 64 65 62 done. (deb
147c0 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 66 61 ug:print 4 *defa
147d0 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 66 ult-log-port* "f
147e0 75 6c 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 6d ullcmd: " fullcm
147f0 64 29 0a 20 20 20 20 20 20 28 73 65 74 21 20 2a d). (set! *
14800 6c 61 73 74 2d 6c 61 75 6e 63 68 2a 20 28 63 75 last-launch* (cu
14810 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 20 rrent-seconds))
14820 3b 3b 20 61 6c 6c 20 74 68 61 74 20 6a 75 6e 6b ;; all that junk
14830 20 61 62 6f 76 65 20 74 61 6b 65 73 20 74 69 6d above takes tim
14840 65 2c 20 73 65 74 20 74 68 69 73 20 61 73 20 6c e, set this as l
14850 61 74 65 20 61 73 20 70 6f 73 73 69 62 6c 65 2e ate as possible.
14860 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 . (let* ((c
14870 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 61 ommonprevvals (a
14880 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 list->env-vars..
14890 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta
148a0 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
148b0 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 65 6e 76 *configdat* "env
148c0 2d 6f 76 65 72 72 69 64 65 22 20 27 28 29 29 29 -override" '()))
148d0 29 0a 09 20 20 20 20 20 28 6d 69 73 63 70 72 65 ).. (miscpre
148e0 76 76 61 6c 73 20 20 20 28 61 6c 69 73 74 2d 3e vvals (alist->
148f0 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 env-vars ;; cons
14900 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f 64 olidate this cod
14910 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 20 e with the code
14920 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 in megatest.scm
14930 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a 09 for "-execute"..
14940 09 09 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 .. (append
14950 28 6c 69 73 74 20 28 6c 69 73 74 20 22 4d 54 5f (list (list "MT_
14960 54 45 53 54 5f 52 55 4e 5f 44 49 52 22 20 77 6f TEST_RUN_DIR" wo
14970 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 09 20 20 rk-area)......
14980 20 20 28 6c 69 73 74 20 22 4d 54 5f 54 45 53 54 (list "MT_TEST
14990 5f 4e 41 4d 45 22 20 74 65 73 74 2d 6e 61 6d 65 _NAME" test-name
149a0 29 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 )...... (list
149b0 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 4f 22 20 "MT_ITEM_INFO"
149c0 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 29 29 20 (conc itemdat))
149d0 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 ...... (list
149e0 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 72 "MT_RUNNAME" r
149f0 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 20 unname)......
14a00 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
14a10 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
14a20 0a 09 09 09 09 09 20 20 20 20 28 6c 69 73 74 20 ...... (list
14a30 22 4d 54 5f 49 54 45 4d 50 41 54 48 22 20 20 69 "MT_ITEMPATH" i
14a40 74 65 6d 2d 70 61 74 68 29 0a 09 09 09 09 09 20 tem-path)......
14a50 20 20 20 29 0a 09 09 09 09 20 20 20 20 20 20 69 )..... i
14a60 74 65 6d 64 61 74 29 29 29 0a 09 20 20 20 20 20 temdat)))..
14a70 28 74 65 73 74 70 72 65 76 76 61 6c 73 20 20 20 (testprevvals
14a80 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
14a90 0a 09 09 09 20 20 20 20 20 20 28 68 61 73 68 2d .... (hash-
14aa0 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
14ab0 74 20 74 63 6f 6e 66 69 67 20 22 70 72 65 2d 6c t tconfig "pre-l
14ac0 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 69 aunch-env-overri
14ad0 64 65 73 22 20 27 28 29 29 29 29 0a 09 20 20 20 des" '())))..
14ae0 20 20 3b 3b 20 4c 61 75 6e 63 68 77 61 69 74 20 ;; Launchwait
14af0 64 65 66 61 75 6c 74 73 20 74 6f 20 74 72 75 65 defaults to true
14b00 2c 20 6d 75 73 74 20 6f 76 65 72 72 69 64 65 20 , must override
14b10 69 74 20 74 6f 20 74 75 72 6e 20 6f 66 66 20 77 it to turn off w
14b20 61 69 74 0a 09 20 20 20 20 20 28 6c 61 75 6e 63 ait.. (launc
14b30 68 77 61 69 74 20 20 20 20 20 28 69 66 20 28 65 hwait (if (e
14b40 71 75 61 6c 3f 20 28 63 6f 6e 66 69 67 66 3a 6c qual? (configf:l
14b50 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 ookup *configdat
14b60 2a 20 22 73 65 74 75 70 22 20 22 6c 61 75 6e 63 * "setup" "launc
14b70 68 77 61 69 74 22 29 20 22 6e 6f 22 29 20 23 66 hwait") "no") #f
14b80 20 23 74 29 29 0a 09 20 20 20 20 20 28 6c 61 75 #t)).. (lau
14b90 6e 63 68 2d 72 65 73 75 6c 74 73 2d 70 72 65 76 nch-results-prev
14ba0 20 28 61 70 70 6c 79 20 28 69 66 20 6c 61 75 6e (apply (if laun
14bb0 63 68 77 61 69 74 20 3b 3b 20 42 42 3a 20 54 4f chwait ;; BB: TO
14bc0 44 4f 3a 20 72 65 66 61 63 74 6f 72 20 74 68 69 DO: refactor thi
14bd0 73 20 74 6f 20 65 78 61 6d 69 6e 65 20 72 65 74 s to examine ret
14be0 75 72 6e 20 63 6f 64 65 20 6f 66 20 6c 61 75 6e urn code of laun
14bf0 63 68 65 72 2c 20 69 66 20 6e 6f 6e 7a 65 72 6f cher, if nonzero
14c00 2c 20 73 65 74 20 73 74 61 74 65 20 74 6f 20 6c , set state to l
14c10 61 75 6e 63 68 20 66 61 69 6c 65 64 2e 0a 09 09 aunch failed....
14c20 09 09 09 20 20 20 20 20 70 72 6f 63 65 73 73 3a ... process:
14c30 63 6d 64 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 cmd-run-with-std
14c40 65 72 72 2d 61 6e 64 2d 65 78 69 74 63 6f 64 65 err-and-exitcode
14c50 2d 3e 6c 69 73 74 0a 09 09 09 09 09 20 20 20 20 ->list......
14c60 20 70 72 6f 63 65 73 73 2d 72 75 6e 29 0a 09 09 process-run)...
14c70 09 09 09 20 28 69 66 20 75 73 65 73 68 65 6c 6c ... (if useshell
14c80 0a 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 ...... (let
14c90 28 28 63 6d 64 73 74 72 20 28 73 74 72 69 6e 67 ((cmdstr (string
14ca0 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
14cb0 6c 63 6d 64 20 22 20 22 29 29 29 0a 09 09 09 09 lcmd " "))).....
14cc0 09 20 20 20 20 20 20 20 28 69 66 20 6c 61 75 6e . (if laun
14cd0 63 68 77 61 69 74 0a 09 09 09 09 09 09 20 20 20 chwait.......
14ce0 63 6d 64 73 74 72 0a 09 09 09 09 09 09 20 20 20 cmdstr.......
14cf0 28 63 6f 6e 63 20 63 6d 64 73 74 72 20 22 20 3e (conc cmdstr " >
14d00 3e 20 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 20 > mt_launch.log
14d10 32 3e 26 31 20 26 22 29 29 29 0a 09 09 09 09 09 2>&1 &")))......
14d20 20 20 20 20 20 28 63 61 72 20 66 75 6c 6c 63 6d (car fullcm
14d30 64 29 29 0a 09 09 09 09 09 20 28 69 66 20 75 73 d))...... (if us
14d40 65 73 68 65 6c 6c 0a 09 09 09 09 09 20 20 20 20 eshell......
14d50 20 27 28 29 0a 09 09 09 09 09 20 20 20 20 20 28 '()...... (
14d60 63 64 72 20 66 75 6c 6c 63 6d 64 29 29 29 29 0a cdr fullcmd)))).
14d70 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su
14d80 63 63 65 73 73 20 20 20 20 20 20 20 20 28 69 66 ccess (if
14d90 20 6c 61 75 6e 63 68 77 61 69 74 20 28 65 71 75 launchwait (equ
14da0 61 6c 3f 20 30 20 28 63 61 64 72 20 6c 61 75 6e al? 0 (cadr laun
14db0 63 68 2d 72 65 73 75 6c 74 73 2d 70 72 65 76 29 ch-results-prev)
14dc0 29 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 ) #t)).
14dd0 20 20 20 20 28 6c 61 75 6e 63 68 2d 72 65 73 75 (launch-resu
14de0 6c 74 73 20 28 69 66 20 6c 61 75 6e 63 68 77 61 lts (if launchwa
14df0 69 74 20 28 63 61 72 20 6c 61 75 6e 63 68 2d 72 it (car launch-r
14e00 65 73 75 6c 74 73 2d 70 72 65 76 29 20 6c 61 75 esults-prev) lau
14e10 6e 63 68 2d 72 65 73 75 6c 74 73 2d 70 72 65 76 nch-results-prev
14e20 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 ))). (if
14e30 28 6e 6f 74 20 73 75 63 63 65 73 73 29 0a 20 20 (not success).
14e40 20 20 20 20 20 20 20 20 20 20 28 74 65 73 74 73 (tests
14e50 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
14e60 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
14e70 20 22 43 4f 4d 50 4c 45 54 45 44 22 20 22 44 45 "COMPLETED" "DE
14e80 41 44 22 20 22 6c 61 75 6e 63 68 65 72 20 66 61 AD" "launcher fa
14e90 69 6c 65 64 3b 20 65 78 69 74 65 64 20 6e 6f 6e iled; exited non
14ea0 2d 7a 65 72 6f 3b 20 63 68 65 63 6b 20 6d 74 5f -zero; check mt_
14eb0 6c 61 75 6e 63 68 2e 6c 6f 67 22 20 23 66 29 29 launch.log" #f))
14ec0 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d 72 ;; (if launch-r
14ed0 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 65 esults launch-re
14ee0 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 29 sults "FAILED"))
14ef0 0a 20 20 20 20 20 20 20 20 28 6d 75 74 65 78 2d . (mutex-
14f00 75 6e 6c 6f 63 6b 21 20 2a 6c 61 75 6e 63 68 2d unlock! *launch-
14f10 73 65 74 75 70 2d 6d 75 74 65 78 2a 29 20 3b 3b setup-mutex*) ;;
14f20 20 79 65 73 2c 20 72 65 61 6c 6c 79 20 73 68 6f yes, really sho
14f30 75 6c 64 20 6d 75 74 65 78 20 61 6c 6c 20 74 68 uld mutex all th
14f40 65 20 77 61 79 20 74 6f 20 68 65 72 65 2e 20 4e e way to here. N
14f50 65 65 64 20 74 6f 20 70 75 74 20 74 68 69 73 20 eed to put this
14f60 65 6e 74 69 72 65 20 70 72 6f 63 65 73 73 20 69 entire process i
14f70 6e 74 6f 20 61 20 66 6f 72 6b 2e 0a 09 3b 3b 20 nto a fork...;;
14f80 28 72 6d 74 3a 6e 6f 2d 73 79 6e 63 2d 64 65 6c (rmt:no-sync-del
14f90 21 20 6c 6f 63 6b 2d 6b 65 79 29 20 20 20 20 20 ! lock-key)
14fa0 20 20 20 20 3b 3b 20 72 65 6c 65 61 73 65 20 74 ;; release t
14fb0 68 65 20 6c 6f 63 6b 20 66 6f 72 20 73 74 61 72 he lock for star
14fc0 74 69 6e 67 20 74 68 69 73 20 74 65 73 74 0a 09 ting this test..
14fd0 28 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 77 (if (not launchw
14fe0 61 69 74 29 20 3b 3b 20 67 69 76 65 20 74 68 65 ait) ;; give the
14ff0 20 4f 53 20 61 20 6c 69 74 74 6c 65 20 74 69 6d OS a little tim
15000 65 20 74 6f 20 61 6c 6c 6f 77 20 74 68 65 20 70 e to allow the p
15010 72 6f 63 65 73 73 20 74 6f 20 73 74 61 72 74 0a rocess to start.
15020 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 . (thread-sle
15030 65 70 21 20 30 2e 30 31 29 29 0a 09 28 77 69 74 ep! 0.01))..(wit
15040 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 h-output-to-file
15050 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 22 "mt_launch.log"
15060 0a 09 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 .. (lambda ()..
15070 20 20 20 20 28 70 72 69 6e 74 20 22 4c 41 55 4e (print "LAUN
15080 43 48 43 4d 44 3a 20 22 20 28 73 74 72 69 6e 67 CHCMD: " (string
15090 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
150a0 6c 63 6d 64 20 22 20 22 29 29 0a 09 20 20 20 20 lcmd " "))..
150b0 28 69 66 20 28 6c 69 73 74 3f 20 6c 61 75 6e 63 (if (list? launc
150c0 68 2d 72 65 73 75 6c 74 73 29 0a 09 09 28 61 70 h-results)...(ap
150d0 70 6c 79 20 70 72 69 6e 74 20 6c 61 75 6e 63 68 ply print launch
150e0 2d 72 65 73 75 6c 74 73 29 0a 09 09 28 70 72 69 -results)...(pri
150f0 6e 74 20 22 4e 4f 54 45 3a 20 6c 61 75 6e 63 68 nt "NOTE: launch
15100 65 64 20 5c 22 22 20 66 75 6c 6c 63 6d 64 20 22 ed \"" fullcmd "
15110 5c 22 5c 6e 20 20 62 75 74 20 64 69 64 20 6e 6f \"\n but did no
15120 74 20 77 61 69 74 20 66 6f 72 20 69 74 20 74 6f t wait for it to
15130 20 70 72 6f 63 65 65 64 2e 20 41 64 64 20 74 68 proceed. Add th
15140 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 74 6f 20 6d e following to m
15150 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 5c egatest.config \
15160 6e 5b 73 65 74 75 70 5d 5c 6e 6c 61 75 6e 63 68 n[setup]\nlaunch
15170 77 61 69 74 20 79 65 73 5c 6e 20 20 69 66 20 79 wait yes\n if y
15180 6f 75 20 68 61 76 65 20 70 72 6f 62 6c 65 6d 73 ou have problems
15190 20 77 69 74 68 20 74 68 69 73 22 29 29 0a 09 20 with this"))..
151a0 20 20 20 23 3a 61 70 70 65 6e 64 29 29 0a 09 28 #:append))..(
151b0 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 2a 64 debug:print 2 *d
151c0 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
151d0 20 22 4c 61 75 6e 63 68 69 6e 67 20 63 6f 6d 70 "Launching comp
151e0 6c 65 74 65 64 2c 20 75 70 64 61 74 69 6e 67 20 leted, updating
151f0 64 62 22 29 0a 09 28 64 65 62 75 67 3a 70 72 69 db")..(debug:pri
15200 6e 74 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 2 *default-lo
15210 67 2d 70 6f 72 74 2a 20 22 4c 61 75 6e 63 68 20 g-port* "Launch
15220 72 65 73 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 results: " launc
15230 68 2d 72 65 73 75 6c 74 73 29 0a 09 28 69 66 20 h-results)..(if
15240 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 65 73 75 (not launch-resu
15250 6c 74 73 29 0a 09 20 20 20 20 28 62 65 67 69 6e lts).. (begin
15260 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
15270 45 52 52 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f ERROR: Failed to
15280 20 72 75 6e 20 22 20 28 73 74 72 69 6e 67 2d 69 run " (string-i
15290 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c 6c 63 ntersperse fullc
152a0 6d 64 20 22 20 22 29 20 22 2c 20 65 78 69 74 69 md " ") ", exiti
152b0 6e 67 20 6e 6f 77 22 29 0a 09 20 20 20 20 20 20 ng now")..
152c0 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 ;; (sqlite3:fina
152d0 6c 69 7a 65 21 20 64 62 29 0a 09 20 20 20 20 20 lize! db)..
152e0 20 3b 3b 20 67 6f 6f 64 20 6f 6c 65 20 22 65 78 ;; good ole "ex
152f0 69 74 22 20 73 65 65 6d 73 20 6e 6f 74 20 74 6f it" seems not to
15300 20 77 6f 72 6b 0a 09 20 20 20 20 20 20 3b 3b 20 work.. ;;
15310 28 5f 65 78 69 74 20 39 29 0a 09 20 20 20 20 20 (_exit 9)..
15320 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
15330 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
15340 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
15350 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
15360 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 09 20 en email list..
15370 20 20 20 20 20 3b 3b 20 4e 42 2f 2f 20 49 73 20 ;; NB// Is
15380 74 68 69 73 20 73 74 69 6c 6c 20 6e 65 65 64 65 this still neede
15390 64 3f 20 53 68 6f 75 6c 64 20 62 65 20 73 61 66 d? Should be saf
153a0 65 20 74 6f 20 67 6f 20 62 61 63 6b 20 74 6f 20 e to go back to
153b0 22 65 78 69 74 22 20 6e 6f 77 3f 0a 09 20 20 20 "exit" now?..
153c0 20 20 20 28 70 72 6f 63 65 73 73 2d 73 69 67 6e (process-sign
153d0 61 6c 20 28 63 75 72 72 65 6e 74 2d 70 72 6f 63 al (current-proc
153e0 65 73 73 2d 69 64 29 20 73 69 67 6e 61 6c 2f 6b ess-id) signal/k
153f0 69 6c 6c 29 0a 09 20 20 20 20 20 20 29 29 0a 09 ill).. ))..
15400 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
15410 20 6d 69 73 63 70 72 65 76 76 61 6c 73 29 0a 09 miscprevvals)..
15420 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
15430 20 74 65 73 74 70 72 65 76 76 61 6c 73 29 0a 09 testprevvals)..
15440 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 (alist->env-vars
15450 20 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 commonprevvals)
15460 0a 09 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 ..launch-results
15470 29 29 0a 20 20 20 20 28 63 68 61 6e 67 65 2d 64 )). (change-d
15480 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 74 irectory *toppat
15490 68 2a 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d h*). (thread-
154a0 73 6c 65 65 70 21 20 28 63 6f 6e 66 69 67 66 3a sleep! (configf:
154b0 6c 6f 6f 6b 75 70 2d 6e 75 6d 62 65 72 20 2a 63 lookup-number *c
154c0 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 onfigdat* "setup
154d0 22 20 22 69 6e 74 65 72 2d 74 65 73 74 2d 64 65 " "inter-test-de
154e0 6c 61 79 22 20 64 65 66 61 75 6c 74 3a 20 30 2e lay" default: 0.
154f0 30 29 29 29 29 0a 0a 3b 3b 20 72 65 63 6f 76 65 0))))..;; recove
15500 72 20 61 20 74 65 73 74 20 77 68 65 72 65 20 74 r a test where t
15510 68 65 20 74 6f 70 20 63 6f 6e 74 72 6f 6c 6c 69 he top controlli
15520 6e 67 20 6d 74 65 73 74 20 6d 61 79 20 68 61 76 ng mtest may hav
15530 65 20 64 69 65 64 0a 3b 3b 0a 28 64 65 66 69 6e e died.;;.(defin
15540 65 20 28 6c 61 75 6e 63 68 3a 72 65 63 6f 76 65 e (launch:recove
15550 72 2d 74 65 73 74 20 72 75 6e 2d 69 64 20 74 65 r-test run-id te
15560 73 74 2d 69 64 29 0a 20 20 3b 3b 20 74 68 69 73 st-id). ;; this
15570 20 66 75 6e 63 74 69 6f 6e 20 69 73 20 63 61 6c function is cal
15580 6c 65 64 20 6f 6e 20 74 68 65 20 74 65 73 74 20 led on the test
15590 72 75 6e 20 68 6f 73 74 20 76 69 61 20 73 73 68 run host via ssh
155a0 0a 20 20 3b 3b 0a 20 20 3b 3b 20 31 2e 20 6c 6f . ;;. ;; 1. lo
155b0 6f 6b 20 61 74 20 74 68 65 20 70 72 6f 63 65 73 ok at the proces
155c0 73 20 66 72 6f 6d 20 70 69 64 0a 20 20 3b 3b 20 s from pid. ;;
155d0 20 20 20 2d 20 69 73 20 69 74 20 6f 77 6e 65 64 - is it owned
155e0 20 62 79 20 63 61 6c 6c 69 6e 67 20 75 73 65 72 by calling user
155f0 0a 20 20 3b 3b 20 20 20 20 2d 20 69 74 20 69 74 . ;; - it it
15600 27 73 20 72 75 6e 20 64 69 72 65 63 74 6f 72 79 's run directory
15610 20 63 6f 72 72 65 63 74 20 66 6f 72 20 74 68 65 correct for the
15620 20 74 65 73 74 0a 20 20 3b 3b 20 20 20 20 2d 20 test. ;; -
15630 69 73 20 74 68 65 72 65 20 61 20 63 6f 6e 74 72 is there a contr
15640 6f 6c 6c 69 6e 67 20 6d 74 65 73 74 20 28 6d 61 olling mtest (ma
15650 79 62 65 20 73 74 75 63 6b 29 0a 20 20 3b 3b 20 ybe stuck). ;;
15660 32 2e 20 69 66 20 72 65 63 6f 76 65 72 79 20 69 2. if recovery i
15670 73 20 6e 65 65 64 65 64 20 77 61 74 63 68 20 70 s needed watch p
15680 69 64 0a 20 20 3b 3b 20 20 20 20 2d 20 77 68 65 id. ;; - whe
15690 6e 20 69 74 20 65 78 69 74 73 20 74 61 6b 65 20 n it exits take
156a0 74 68 65 20 65 78 69 74 20 63 6f 64 65 20 61 6e the exit code an
156b0 64 20 64 6f 20 74 68 65 20 6e 65 65 64 66 75 6c d do the needful
156c0 0a 20 20 3b 3b 0a 20 20 28 6c 65 74 2a 20 28 28 . ;;. (let* ((
156d0 70 69 64 20 28 72 6d 74 3a 74 65 73 74 2d 67 65 pid (rmt:test-ge
156e0 74 2d 74 6f 70 2d 70 72 6f 63 65 73 73 2d 70 69 t-top-process-pi
156f0 64 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 d run-id test-id
15700 29 29 0a 09 20 28 70 73 72 65 73 20 28 77 69 74 )).. (psres (wit
15710 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 70 69 70 h-input-from-pip
15720 65 0a 09 09 20 28 63 6f 6e 63 20 22 70 73 20 2d e... (conc "ps -
15730 46 20 2d 75 20 22 20 28 63 75 72 72 65 6e 74 2d F -u " (current-
15740 75 73 65 72 2d 6e 61 6d 65 29 20 22 20 7c 20 67 user-name) " | g
15750 72 65 70 20 2d 45 20 27 22 20 70 69 64 20 22 20 rep -E '" pid "
15760 27 20 7c 20 67 72 65 70 20 2d 76 20 27 67 72 65 ' | grep -v 'gre
15770 70 20 2d 45 20 22 20 70 69 64 20 22 27 22 29 0a p -E " pid "'").
15780 09 09 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 .. (lambda ()...
15790 20 20 20 28 72 65 61 64 2d 6c 69 6e 65 29 29 29 (read-line)))
157a0 29 0a 09 20 28 72 75 6e 64 69 72 20 28 69 66 20 ).. (rundir (if
157b0 28 73 74 72 69 6e 67 3f 20 70 73 72 65 73 29 20 (string? psres)
157c0 3b 3b 20 72 65 61 6c 20 70 72 6f 63 65 73 73 20 ;; real process
157d0 6f 77 6e 65 64 20 62 79 20 75 73 65 72 0a 09 09 owned by user...
157e0 20 20 20 20 20 28 72 65 61 64 2d 73 79 6d 62 6f (read-symbo
157f0 6c 69 63 2d 6c 69 6e 6b 20 28 63 6f 6e 63 20 22 lic-link (conc "
15800 2f 70 72 6f 63 2f 22 20 70 69 64 20 22 2f 63 77 /proc/" pid "/cw
15810 64 22 29 29 0a 09 09 20 20 20 20 20 23 66 29 29 d"))... #f))
15820 29 0a 20 20 20 20 3b 3b 20 6e 6f 77 20 77 61 69 ). ;; now wai
15830 74 20 6f 6e 20 74 68 61 74 20 70 72 6f 63 65 73 t on that proces
15840 73 20 69 66 20 61 6c 6c 20 69 73 20 63 6f 72 72 s if all is corr
15850 65 63 74 0a 20 20 20 20 3b 3b 20 70 65 72 69 6f ect. ;; perio
15860 64 69 63 61 6c 6c 79 20 75 70 64 61 74 65 20 74 dically update t
15870 68 65 20 64 62 20 77 69 74 68 20 72 75 6e 74 69 he db with runti
15880 6d 65 0a 20 20 20 20 3b 3b 20 77 68 65 6e 20 74 me. ;; when t
15890 68 65 20 70 72 6f 63 65 73 73 20 65 78 69 74 73 he process exits
158a0 20 6c 6f 6f 6b 20 61 74 20 74 68 65 20 64 62 2c look at the db,
158b0 20 69 66 20 73 74 69 6c 6c 20 52 55 4e 4e 49 4e if still RUNNIN
158c0 47 20 61 66 74 65 72 20 31 30 20 73 65 63 6f 6e G after 10 secon
158d0 64 73 20 73 65 74 0a 20 20 20 20 3b 3b 20 73 74 ds set. ;; st
158e0 61 74 65 2f 73 74 61 74 75 73 20 61 70 70 72 6f ate/status appro
158f0 70 72 69 61 74 65 6c 79 0a 20 20 20 20 28 70 72 priately. (pr
15900 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 29 29 ocess-wait pid))
15910 29 0a ).