0000: 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 .;; Copyright 20
0010: 30 36 2d 32 30 31 33 2c 20 4d 61 74 74 68 65 77 06-2013, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 This program i
0040: 73 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 s made available
0050: 20 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 under the GNU G
0060: 50 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f PL version 2.0 o
0070: 72 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 r.;; greater. S
0080: 65 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 ee the accompany
0090: 69 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 ing file COPYING
00a0: 20 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b for details..;;
00b0: 20 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 .;; This progr
00c0: 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 am is distribute
00d0: 64 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 d WITHOUT ANY WA
00e0: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
00f0: 65 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 even the.;; imp
0100: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0110: 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 MERCHANTABILITY
0120: 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 or FITNESS FOR
0130: 41 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 A PARTICULAR.;;
0140: 20 50 55 52 50 4f 53 45 2e 0a 0a 3b 3b 3d 3d 3d PURPOSE...;;===
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 0a 3b 3b 20 6c 61 75 6e 63 68 20 61 20 ===.;; launch a
01a0: 74 61 73 6b 20 2d 20 74 68 69 73 20 72 75 6e 73 task - this runs
01b0: 20 6f 6e 20 74 68 65 20 6f 72 69 67 69 6e 61 74 on the originat
01c0: 69 6e 67 20 68 6f 73 74 2c 20 74 65 73 74 73 20 ing host, tests
01d0: 74 68 65 6d 73 65 6c 76 65 73 0a 3b 3b 0a 3b 3b themselves.;;.;;
01e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0210: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0220: 3d 3d 3d 3d 3d 3d 0a 0a 28 75 73 65 20 72 65 67 ======..(use reg
0230: 65 78 20 72 65 67 65 78 2d 63 61 73 65 20 62 61 ex regex-case ba
0240: 73 65 36 34 20 73 71 6c 69 74 65 33 20 73 72 66 se64 sqlite3 srf
0250: 69 2d 31 38 29 0a 28 69 6d 70 6f 72 74 20 28 70 i-18).(import (p
0260: 72 65 66 69 78 20 62 61 73 65 36 34 20 62 61 73 refix base64 bas
0270: 65 36 34 3a 29 29 0a 28 69 6d 70 6f 72 74 20 28 e64:)).(import (
0280: 70 72 65 66 69 78 20 73 71 6c 69 74 65 33 20 73 prefix sqlite3 s
0290: 71 6c 69 74 65 33 3a 29 29 0a 0a 28 64 65 63 6c qlite3:))..(decl
02a0: 61 72 65 20 28 75 6e 69 74 20 6c 61 75 6e 63 68 are (unit launch
02b0: 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 )).(declare (use
02c0: 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c s common)).(decl
02d0: 61 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 are (uses config
02e0: 66 29 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 f)).(declare (us
02f0: 65 73 20 64 62 29 29 0a 28 64 65 63 6c 61 72 65 es db)).(declare
0300: 20 28 75 73 65 73 20 73 64 62 29 29 0a 0a 28 69 (uses sdb))..(i
0310: 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 nclude "common_r
0320: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
0330: 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 clude "key_recor
0340: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
0350: 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 e "db_records.sc
0360: 6d 22 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d m")..;;=========
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 3b 3b =============.;;
03b0: 20 65 7a 73 74 65 70 73 0a 3b 3b 3d 3d 3d 3d 3d ezsteps.;;=====
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0400: 3d 0a 0a 3b 3b 20 65 7a 73 74 65 70 73 20 77 65 =..;; ezsteps we
0410: 72 65 20 67 6f 69 6e 67 20 74 6f 20 62 65 20 63 re going to be c
0420: 6f 64 65 64 20 61 73 0a 3b 3b 20 73 74 65 70 6e oded as.;; stepn
0430: 61 6d 65 5b 2c 70 72 65 64 73 74 65 70 31 2c 70 ame[,predstep1,p
0440: 72 65 64 73 74 65 70 32 20 2e 2e 2e 5d 20 5b 7b redstep2 ...] [{
0450: 56 41 52 31 3d 66 69 72 73 74 2c 73 65 63 6f 6e VAR1=first,secon
0460: 64 2c 74 68 69 72 64 7d 5d 20 63 6f 6d 6d 61 6e d,third}] comman
0470: 64 20 74 6f 20 65 78 65 63 75 74 65 0a 3b 3b 20 d to execute.;;
0480: 20 20 42 55 54 0a 3b 3b 20 6e 6f 77 20 61 72 65 BUT.;; now are
0490: 0a 3b 3b 20 73 74 65 70 6e 61 6d 65 20 7b 56 41 .;; stepname {VA
04a0: 52 3d 66 69 72 73 74 2c 73 65 63 6f 6e 64 2c 74 R=first,second,t
04b0: 68 69 72 64 20 2e 2e 2e 7d 20 63 6f 6d 6d 61 6e hird ...} comman
04c0: 64 20 2e 2e 2e 0a 3b 3b 20 77 68 65 72 65 20 74 d ....;; where t
04d0: 68 65 20 7b 56 41 52 3d 66 69 72 73 74 2c 73 65 he {VAR=first,se
04e0: 63 6f 6e 64 2c 74 68 69 72 64 20 2e 2e 2e 7d 20 cond,third ...}
04f0: 69 73 20 6f 70 74 69 6f 6e 61 6c 2e 0a 0a 3b 3b is optional...;;
0500: 20 67 69 76 65 6e 20 61 6e 20 65 78 69 74 20 63 given an exit c
0510: 6f 64 65 20 61 6e 64 20 77 68 65 74 68 65 72 20 ode and whether
0520: 6f 72 20 6e 6f 74 20 6c 6f 67 70 72 6f 20 77 61 or not logpro wa
0530: 73 20 75 73 65 64 20 63 61 6c 63 75 6c 61 74 65 s used calculate
0540: 20 4f 4b 2f 42 41 44 0a 3b 3b 20 72 65 74 75 72 OK/BAD.;; retur
0550: 6e 20 23 74 20 69 66 20 77 65 20 61 72 65 20 6f n #t if we are o
0560: 6b 2c 20 23 66 20 6f 74 68 65 72 77 69 73 65 0a k, #f otherwise.
0570: 28 64 65 66 69 6e 65 20 28 73 74 65 70 72 75 6e (define (steprun
0580: 2d 67 6f 6f 64 3f 20 6c 6f 67 70 72 6f 20 65 78 -good? logpro ex
0590: 69 74 63 6f 64 65 29 0a 20 20 28 6f 72 20 28 65 itcode). (or (e
05a0: 71 3f 20 65 78 69 74 63 6f 64 65 20 30 29 0a 20 q? exitcode 0).
05b0: 20 20 20 20 20 28 61 6e 64 20 6c 6f 67 70 72 6f (and logpro
05c0: 20 28 65 71 3f 20 65 78 69 74 63 6f 64 65 20 32 (eq? exitcode 2
05d0: 29 29 29 29 0a 0a 3b 3b 20 69 66 20 68 61 6e 64 ))))..;; if hand
05e0: 65 64 20 61 20 73 74 72 69 6e 67 2c 20 70 72 6f ed a string, pro
05f0: 63 65 73 73 20 69 74 2c 20 65 6c 73 65 20 6c 6f cess it, else lo
0600: 6f 6b 20 66 6f 72 20 4d 54 5f 43 4d 44 49 4e 46 ok for MT_CMDINF
0610: 4f 0a 28 64 65 66 69 6e 65 20 28 6c 61 75 6e 63 O.(define (launc
0620: 68 3a 67 65 74 2d 63 6d 64 69 6e 66 6f 2d 61 73 h:get-cmdinfo-as
0630: 73 6f 63 2d 6c 69 73 74 20 23 21 6b 65 79 20 28 soc-list #!key (
0640: 65 6e 63 6f 64 65 64 2d 63 6d 64 20 23 66 29 29 encoded-cmd #f))
0650: 0a 20 20 28 6c 65 74 20 28 28 65 6e 63 63 6d 64 . (let ((enccmd
0660: 20 28 69 66 20 65 6e 63 6f 64 65 64 2d 63 6d 64 (if encoded-cmd
0670: 20 65 6e 63 6f 64 65 64 2d 63 6d 64 20 28 67 65 encoded-cmd (ge
0680: 74 65 6e 76 20 22 4d 54 5f 43 4d 44 49 4e 46 4f tenv "MT_CMDINFO
0690: 22 29 29 29 29 0a 20 20 20 20 28 69 66 20 65 6e ")))). (if en
06a0: 63 63 6d 64 0a 09 28 72 65 61 64 20 28 6f 70 65 ccmd..(read (ope
06b0: 6e 2d 69 6e 70 75 74 2d 73 74 72 69 6e 67 20 28 n-input-string (
06c0: 62 61 73 65 36 34 3a 62 61 73 65 36 34 2d 64 65 base64:base64-de
06d0: 63 6f 64 65 20 65 6e 63 63 6d 64 29 29 29 0a 09 code enccmd)))..
06e0: 27 28 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 '())))..(define
06f0: 28 6c 61 75 6e 63 68 3a 65 78 65 63 75 74 65 20 (launch:execute
0700: 65 6e 63 6f 64 65 64 2d 63 6d 64 29 0a 20 20 28 encoded-cmd). (
0710: 6c 65 74 2a 20 28 28 63 6d 64 69 6e 66 6f 20 20 let* ((cmdinfo
0720: 20 28 72 65 61 64 20 28 6f 70 65 6e 2d 69 6e 70 (read (open-inp
0730: 75 74 2d 73 74 72 69 6e 67 20 28 62 61 73 65 36 ut-string (base6
0740: 34 3a 62 61 73 65 36 34 2d 64 65 63 6f 64 65 20 4:base64-decode
0750: 65 6e 63 6f 64 65 64 2d 63 6d 64 29 29 29 29 29 encoded-cmd)))))
0760: 0a 20 20 20 20 28 73 65 74 65 6e 76 20 22 4d 54 . (setenv "MT
0770: 5f 43 4d 44 49 4e 46 4f 22 20 65 6e 63 6f 64 65 _CMDINFO" encode
0780: 64 2d 63 6d 64 29 0a 20 20 20 20 28 69 66 20 28 d-cmd). (if (
0790: 6c 69 73 74 3f 20 63 6d 64 69 6e 66 6f 29 20 3b list? cmdinfo) ;
07a0: 3b 20 28 28 74 65 73 74 70 61 74 68 20 2f 74 6d ; ((testpath /tm
07b0: 70 2f 6d 72 77 65 6c 6c 61 6e 2f 6a 61 7a 7a 6d p/mrwellan/jazzm
07c0: 69 6e 64 2f 73 72 63 2f 65 78 61 6d 70 6c 65 5f ind/src/example_
07d0: 72 75 6e 2f 74 65 73 74 73 2f 73 71 6c 69 74 65 run/tests/sqlite
07e0: 73 70 65 65 64 29 0a 09 3b 3b 20 28 74 65 73 74 speed)..;; (test
07f0: 2d 6e 61 6d 65 20 73 71 6c 69 74 65 73 70 65 65 -name sqlitespee
0800: 64 29 20 28 72 75 6e 73 63 72 69 70 74 20 72 75 d) (runscript ru
0810: 6e 73 63 72 69 70 74 2e 72 62 29 20 28 64 62 2d nscript.rb) (db-
0820: 68 6f 73 74 20 6c 6f 63 61 6c 68 6f 73 74 29 20 host localhost)
0830: 28 72 75 6e 2d 69 64 20 31 29 29 0a 09 28 6c 65 (run-id 1))..(le
0840: 74 2a 20 28 28 74 65 73 74 70 61 74 68 20 20 28 t* ((testpath (
0850: 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 assoc/default 't
0860: 65 73 74 70 61 74 68 20 20 63 6d 64 69 6e 66 6f estpath cmdinfo
0870: 29 29 20 20 3b 3b 20 74 65 73 74 70 61 74 68 20 )) ;; testpath
0880: 69 73 20 74 68 65 20 74 65 73 74 20 73 70 65 63 is the test spec
0890: 20 61 72 65 61 0a 09 20 20 20 20 20 20 20 28 74 area.. (t
08a0: 6f 70 2d 70 61 74 68 20 20 28 61 73 73 6f 63 2f op-path (assoc/
08b0: 64 65 66 61 75 6c 74 20 27 74 6f 70 70 61 74 68 default 'toppath
08c0: 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 cmdinfo))..
08d0: 20 20 20 20 20 28 77 6f 72 6b 2d 61 72 65 61 20 (work-area
08e0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
08f0: 77 6f 72 6b 2d 61 72 65 61 20 63 6d 64 69 6e 66 work-area cmdinf
0900: 6f 29 29 20 20 3b 3b 20 77 6f 72 6b 2d 61 72 65 o)) ;; work-are
0910: 61 20 69 73 20 74 68 65 20 74 65 73 74 20 72 75 a is the test ru
0920: 6e 20 61 72 65 61 0a 09 20 20 20 20 20 20 20 28 n area.. (
0930: 74 65 73 74 2d 6e 61 6d 65 20 28 61 73 73 6f 63 test-name (assoc
0940: 2f 64 65 66 61 75 6c 74 20 27 74 65 73 74 2d 6e /default 'test-n
0950: 61 6d 65 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 ame cmdinfo))..
0960: 20 20 20 20 20 20 28 72 75 6e 73 63 72 69 70 74 (runscript
0970: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0980: 27 72 75 6e 73 63 72 69 70 74 20 63 6d 64 69 6e 'runscript cmdin
0990: 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 65 7a fo)).. (ez
09a0: 73 74 65 70 73 20 20 20 28 61 73 73 6f 63 2f 64 steps (assoc/d
09b0: 65 66 61 75 6c 74 20 27 65 7a 73 74 65 70 73 20 efault 'ezsteps
09c0: 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 cmdinfo))..
09d0: 20 20 20 20 3b 3b 20 28 72 75 6e 72 65 6d 6f 74 ;; (runremot
09e0: 65 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 e (assoc/default
09f0: 20 27 72 75 6e 72 65 6d 6f 74 65 20 63 6d 64 69 'runremote cmdi
0a00: 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 74 nfo)).. (t
0a10: 72 61 6e 73 70 6f 72 74 20 28 61 73 73 6f 63 2f ransport (assoc/
0a20: 64 65 66 61 75 6c 74 20 27 74 72 61 6e 73 70 6f default 'transpo
0a30: 72 74 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 rt cmdinfo))..
0a40: 20 20 20 20 20 28 73 65 72 76 65 72 69 6e 66 20 (serverinf
0a50: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0a60: 73 65 72 76 65 72 69 6e 66 20 63 6d 64 69 6e 66 serverinf cmdinf
0a70: 6f 29 29 0a 09 20 20 20 20 20 20 20 28 70 6f 72 o)).. (por
0a80: 74 20 20 20 20 20 20 28 61 73 73 6f 63 2f 64 65 t (assoc/de
0a90: 66 61 75 6c 74 20 27 70 6f 72 74 20 20 20 20 20 fault 'port
0aa0: 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 cmdinfo))..
0ab0: 20 20 20 28 72 75 6e 2d 69 64 20 20 20 20 28 61 (run-id (a
0ac0: 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 72 75 ssoc/default 'ru
0ad0: 6e 2d 69 64 20 20 20 20 63 6d 64 69 6e 66 6f 29 n-id cmdinfo)
0ae0: 29 0a 09 20 20 20 20 20 20 20 28 74 65 73 74 2d ).. (test-
0af0: 69 64 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 id (assoc/defa
0b00: 75 6c 74 20 27 74 65 73 74 2d 69 64 20 20 20 63 ult 'test-id c
0b10: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0b20: 20 28 74 61 72 67 65 74 20 20 20 20 28 61 73 73 (target (ass
0b30: 6f 63 2f 64 65 66 61 75 6c 74 20 27 74 61 72 67 oc/default 'targ
0b40: 65 74 20 20 20 20 63 6d 64 69 6e 66 6f 29 29 0a et cmdinfo)).
0b50: 09 20 20 20 20 20 20 20 28 69 74 65 6d 64 61 74 . (itemdat
0b60: 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c (assoc/defaul
0b70: 74 20 27 69 74 65 6d 64 61 74 20 20 20 63 6d 64 t 'itemdat cmd
0b80: 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 28 info)).. (
0b90: 65 6e 76 2d 6f 76 72 64 20 20 28 61 73 73 6f 63 env-ovrd (assoc
0ba0: 2f 64 65 66 61 75 6c 74 20 27 65 6e 76 2d 6f 76 /default 'env-ov
0bb0: 72 64 20 20 63 6d 64 69 6e 66 6f 29 29 0a 09 20 rd cmdinfo))..
0bc0: 20 20 20 20 20 20 28 73 65 74 2d 76 61 72 73 20 (set-vars
0bd0: 20 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 (assoc/default
0be0: 27 73 65 74 2d 76 61 72 73 20 20 63 6d 64 69 6e 'set-vars cmdin
0bf0: 66 6f 29 29 20 3b 3b 20 70 72 65 2d 6f 76 65 72 fo)) ;; pre-over
0c00: 72 69 64 65 73 20 66 72 6f 6d 20 2d 73 65 74 76 rides from -setv
0c10: 61 72 0a 09 20 20 20 20 20 20 20 28 72 75 6e 6e ar.. (runn
0c20: 61 6d 65 20 20 20 28 61 73 73 6f 63 2f 64 65 66 ame (assoc/def
0c30: 61 75 6c 74 20 27 72 75 6e 6e 61 6d 65 20 20 20 ault 'runname
0c40: 63 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 cmdinfo))..
0c50: 20 20 28 6d 65 67 61 74 65 73 74 20 20 28 61 73 (megatest (as
0c60: 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 6d 65 67 soc/default 'meg
0c70: 61 74 65 73 74 20 20 63 6d 64 69 6e 66 6f 29 29 atest cmdinfo))
0c80: 0a 09 20 20 20 20 20 20 20 28 72 75 6e 74 6c 69 .. (runtli
0c90: 6d 20 20 20 28 61 73 73 6f 63 2f 64 65 66 61 75 m (assoc/defau
0ca0: 6c 74 20 27 72 75 6e 74 6c 69 6d 20 20 20 63 6d lt 'runtlim cm
0cb0: 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 20 dinfo))..
0cc0: 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 (mt-bindir-path
0cd0: 28 61 73 73 6f 63 2f 64 65 66 61 75 6c 74 20 27 (assoc/default '
0ce0: 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 63 mt-bindir-path c
0cf0: 6d 64 69 6e 66 6f 29 29 0a 09 20 20 20 20 20 20 mdinfo))..
0d00: 20 28 6b 65 79 73 20 20 20 20 20 20 23 66 29 0a (keys #f).
0d10: 09 20 20 20 20 20 20 20 28 6b 65 79 76 61 6c 73 . (keyvals
0d20: 20 20 20 23 66 29 0a 09 20 20 20 20 20 20 20 28 #f).. (
0d30: 66 75 6c 6c 72 75 6e 73 63 72 69 70 74 20 28 69 fullrunscript (i
0d40: 66 20 28 6e 6f 74 20 72 75 6e 73 63 72 69 70 74 f (not runscript
0d50: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d70: 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 20 #f.
0d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d90: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 75 (if (su
0da0: 62 73 74 72 69 6e 67 2d 69 6e 64 65 78 20 22 2f bstring-index "/
0db0: 22 20 72 75 6e 73 63 72 69 70 74 29 0a 20 20 20 " runscript).
0dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0de0: 20 20 20 72 75 6e 73 63 72 69 70 74 20 3b 3b 20 runscript ;;
0df0: 75 73 65 20 75 6e 61 64 75 6c 74 65 72 65 64 20 use unadultered
0e00: 69 66 20 63 6f 6e 74 61 69 6e 73 20 73 6c 61 73 if contains slas
0e10: 68 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 hes.
0e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e30: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
0e40: 28 66 75 6c 6c 6e 20 28 63 6f 6e 63 20 74 65 73 (fulln (conc tes
0e50: 74 70 61 74 68 20 22 2f 22 20 72 75 6e 73 63 72 tpath "/" runscr
0e60: 69 70 74 29 29 29 0a 09 20 20 20 20 20 20 20 20 ipt)))..
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 (if (a
0e90: 6e 64 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f nd (file-exists?
0ea0: 20 66 75 6c 6c 6e 29 0a 20 20 20 20 20 20 20 20 fulln).
0eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0ed0: 20 20 20 20 20 20 20 20 20 20 20 28 66 69 6c 65 (file
0ee0: 2d 65 78 65 63 75 74 65 2d 61 63 63 65 73 73 3f -execute-access?
0ef0: 20 66 75 6c 6c 6e 29 29 0a 20 20 20 20 20 20 20 fulln)).
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f20: 20 20 20 20 20 20 20 66 75 6c 6c 6e 0a 20 20 20 fulln.
0f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0f50: 20 20 20 20 20 20 20 20 20 20 20 72 75 6e 73 63 runsc
0f60: 72 69 70 74 29 29 29 29 29 20 3b 3b 20 61 73 73 ript))))) ;; ass
0f70: 75 6d 65 20 69 74 20 69 73 20 6f 6e 20 74 68 65 ume it is on the
0f80: 20 70 61 74 68 0a 09 20 20 20 20 20 20 20 28 72 path.. (r
0f90: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 30 29 29 ollup-status 0))
0fa0: 0a 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 .. (change-dire
0fb0: 63 74 6f 72 79 20 74 6f 70 2d 70 61 74 68 29 0a ctory top-path).
0fc0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
0fd0: 32 20 22 45 78 65 63 74 75 69 6e 67 20 22 20 74 2 "Exectuing " t
0fe0: 65 73 74 2d 6e 61 6d 65 20 22 20 28 69 64 3a 20 est-name " (id:
0ff0: 22 20 74 65 73 74 2d 69 64 20 22 29 20 6f 6e 20 " test-id ") on
1000: 22 20 28 67 65 74 2d 68 6f 73 74 2d 6e 61 6d 65 " (get-host-name
1010: 29 29 0a 09 20 20 3b 3b 20 53 65 74 75 70 20 74 )).. ;; Setup t
1020: 68 65 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 67 he *runremote* g
1030: 6c 6f 62 61 6c 20 76 61 72 0a 09 20 20 28 69 66 lobal var.. (if
1040: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 28 64 65 *runremote* (de
1050: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 bug:print 2 "ERR
1060: 4f 52 3a 20 49 27 6d 20 6e 6f 74 20 65 78 70 65 OR: I'm not expe
1070: 63 74 69 6e 67 20 2a 72 75 6e 72 65 6d 6f 74 65 cting *runremote
1080: 2a 20 74 6f 20 62 65 20 73 65 74 20 61 74 20 74 * to be set at t
1090: 68 69 73 20 74 69 6d 65 22 29 29 0a 09 20 20 3b his time")).. ;
10a0: 3b 20 28 73 65 74 21 20 2a 72 75 6e 72 65 6d 6f ; (set! *runremo
10b0: 74 65 2a 20 72 75 6e 72 65 6d 6f 74 65 29 0a 09 te* runremote)..
10c0: 20 20 3b 3b 20 28 73 65 74 21 20 2a 74 72 61 6e ;; (set! *tran
10d0: 73 70 6f 72 74 2d 74 79 70 65 2a 20 28 73 74 72 sport-type* (str
10e0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 74 72 61 6e ing->symbol tran
10f0: 73 70 6f 72 74 29 29 0a 09 20 20 28 73 65 74 21 sport)).. (set!
1100: 20 6b 65 79 73 20 20 20 20 20 20 20 28 63 64 62 keys (cdb
1110: 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 64 62 3a 67 :remote-run db:g
1120: 65 74 2d 6b 65 79 73 20 23 66 29 29 0a 09 20 20 et-keys #f))..
1130: 28 73 65 74 21 20 6b 65 79 76 61 6c 73 20 20 20 (set! keyvals
1140: 20 28 6b 65 79 73 3a 74 61 72 67 65 74 2d 3e 6b (keys:target->k
1150: 65 79 76 61 6c 20 6b 65 79 73 20 74 61 72 67 65 eyval keys targe
1160: 74 29 29 0a 09 20 20 3b 3b 20 61 70 70 6c 79 20 t)).. ;; apply
1170: 70 72 65 2d 6f 76 65 72 72 69 64 65 73 20 62 65 pre-overrides be
1180: 66 6f 72 65 20 6f 74 68 65 72 20 76 61 72 69 61 fore other varia
1190: 62 6c 65 73 2e 20 54 68 65 20 70 72 65 2d 6f 76 bles. The pre-ov
11a0: 65 72 72 69 64 65 20 76 61 72 73 20 6d 75 73 74 erride vars must
11b0: 20 6e 6f 74 0a 09 20 20 3b 3b 20 63 6c 6f 62 62 not.. ;; clobb
11c0: 65 72 73 20 74 68 69 6e 67 73 20 66 72 6f 6d 20 ers things from
11d0: 74 68 65 20 6f 66 66 69 63 69 61 6c 20 73 6f 75 the official sou
11e0: 72 63 65 73 20 73 75 63 68 20 61 73 20 6d 65 67 rces such as meg
11f0: 61 74 65 73 74 2e 63 6f 6e 66 69 67 20 61 6e 64 atest.config and
1200: 20 72 75 6e 63 6f 6e 66 69 67 73 2e 63 6f 6e 66 runconfigs.conf
1210: 69 67 0a 09 20 20 28 69 66 20 28 73 74 72 69 6e ig.. (if (strin
1220: 67 3f 20 73 65 74 2d 76 61 72 73 29 0a 09 20 20 g? set-vars)..
1230: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 70 61 (let ((varpa
1240: 69 72 73 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 irs (string-spli
1250: 74 20 73 65 74 2d 76 61 72 73 20 22 2c 22 29 29 t set-vars ","))
1260: 29 0a 09 09 28 64 65 62 75 67 3a 70 72 69 6e 74 )...(debug:print
1270: 20 34 20 22 76 61 72 70 61 69 72 73 3a 20 22 20 4 "varpairs: "
1280: 76 61 72 70 61 69 72 73 29 0a 09 09 28 6d 61 70 varpairs)...(map
1290: 20 28 6c 61 6d 62 64 61 20 28 76 61 72 70 61 69 (lambda (varpai
12a0: 72 29 0a 09 09 20 20 20 20 20 20 20 28 6c 65 74 r)... (let
12b0: 20 28 28 76 61 72 76 61 6c 20 28 73 74 72 69 6e ((varval (strin
12c0: 67 2d 73 70 6c 69 74 20 76 61 72 70 61 69 72 20 g-split varpair
12d0: 22 3d 22 29 29 29 0a 09 09 09 20 28 69 66 20 28 "="))).... (if (
12e0: 65 71 3f 20 28 6c 65 6e 67 74 68 20 76 61 72 76 eq? (length varv
12f0: 61 6c 29 20 32 29 0a 09 09 09 20 20 20 20 20 28 al) 2).... (
1300: 6c 65 74 20 28 28 76 61 72 20 28 63 61 72 20 76 let ((var (car v
1310: 61 72 76 61 6c 29 29 0a 09 09 09 09 20 20 20 28 arval))..... (
1320: 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 6c val (cadr varval
1330: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 28 64 ))).... (d
1340: 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 41 64 ebug:print 1 "Ad
1350: 64 69 6e 67 20 70 72 65 2d 76 61 72 2f 76 61 6c ding pre-var/val
1360: 20 22 20 76 61 72 20 22 20 3d 20 22 20 76 61 6c " var " = " val
1370: 20 22 20 74 6f 20 74 68 65 20 65 6e 76 69 72 6f " to the enviro
1380: 6e 6d 65 6e 74 22 29 0a 09 09 09 20 20 20 20 20 nment")....
1390: 20 20 28 73 65 74 65 6e 76 20 76 61 72 20 76 61 (setenv var va
13a0: 6c 29 29 29 29 29 0a 09 09 20 20 20 20 20 76 61 l)))))... va
13b0: 72 70 61 69 72 73 29 29 29 0a 09 20 20 28 66 6f rpairs))).. (fo
13c0: 72 2d 65 61 63 68 0a 09 20 20 20 28 6c 61 6d 62 r-each.. (lamb
13d0: 64 61 20 28 76 61 72 76 61 6c 29 0a 09 20 20 20 da (varval)..
13e0: 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 63 61 (let ((var (ca
13f0: 72 20 76 61 72 76 61 6c 29 29 0a 09 09 20 20 20 r varval))...
1400: 28 76 61 6c 20 28 63 61 64 72 20 76 61 72 76 61 (val (cadr varva
1410: 6c 29 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 l))).. (if
1420: 20 76 61 6c 0a 09 09 20 20 20 28 73 65 74 65 6e val... (seten
1430: 76 20 76 61 72 20 76 61 6c 29 0a 09 09 20 20 20 v var val)...
1440: 28 62 65 67 69 6e 0a 09 09 20 20 20 20 20 28 64 (begin... (d
1450: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 ebug:print 0 "ER
1460: 52 4f 52 3a 20 72 65 71 75 69 72 65 64 20 76 61 ROR: required va
1470: 72 69 61 62 6c 65 20 22 20 76 61 72 20 22 20 64 riable " var " d
1480: 6f 65 73 20 6e 6f 74 20 68 61 76 65 20 61 20 76 oes not have a v
1490: 61 6c 69 64 20 76 61 6c 75 65 2e 20 45 78 69 74 alid value. Exit
14a0: 69 6e 67 22 29 0a 09 09 20 20 20 20 20 28 65 78 ing")... (ex
14b0: 69 74 29 29 29 29 29 0a 09 20 20 20 20 20 28 6c it))))).. (l
14c0: 69 73 74 20 0a 09 20 20 20 20 20 20 28 6c 69 73 ist .. (lis
14d0: 74 20 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f t "MT_TEST_RUN_
14e0: 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a DIR" work-area).
14f0: 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 22 4d . (list "M
1500: 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes
1510: 74 2d 6e 61 6d 65 29 0a 09 20 20 20 20 20 20 28 t-name).. (
1520: 6c 69 73 74 20 20 22 4d 54 5f 49 54 45 4d 5f 49 list "MT_ITEM_I
1530: 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 NFO" (conc itemd
1540: 61 74 29 29 0a 09 20 20 20 20 20 20 28 6c 69 73 at)).. (lis
1550: 74 20 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 t "MT_RUNNAME"
1560: 20 20 72 75 6e 6e 61 6d 65 29 0a 09 20 20 20 20 runname)..
1570: 20 20 28 6c 69 73 74 20 20 22 4d 54 5f 4d 45 47 (list "MT_MEG
1580: 41 54 45 53 54 22 20 20 6d 65 67 61 74 65 73 74 ATEST" megatest
1590: 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 20 20 ).. (list
15a0: 22 4d 54 5f 54 41 52 47 45 54 22 20 20 20 20 74 "MT_TARGET" t
15b0: 61 72 67 65 74 29 0a 09 20 20 20 20 20 20 28 6c arget).. (l
15c0: 69 73 74 20 20 22 4d 54 5f 4c 49 4e 4b 54 52 45 ist "MT_LINKTRE
15d0: 45 22 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f E" (configf:loo
15e0: 6b 75 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 kup *configdat*
15f0: 22 73 65 74 75 70 22 20 22 6c 69 6e 6b 74 72 65 "setup" "linktre
1600: 65 22 29 29 29 29 0a 09 20 20 28 69 66 20 6d 74 e")))).. (if mt
1610: 2d 62 69 6e 64 69 72 2d 70 61 74 68 20 28 73 65 -bindir-path (se
1620: 74 65 6e 76 20 22 50 41 54 48 22 20 28 63 6f 6e tenv "PATH" (con
1630: 63 20 28 67 65 74 65 6e 76 20 22 50 41 54 48 22 c (getenv "PATH"
1640: 29 20 22 3a 22 20 6d 74 2d 62 69 6e 64 69 72 2d ) ":" mt-bindir-
1650: 70 61 74 68 29 29 29 0a 09 20 20 3b 3b 20 28 63 path))).. ;; (c
1660: 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 79 20 hange-directory
1670: 74 6f 70 2d 70 61 74 68 29 0a 09 20 20 28 69 66 top-path).. (if
1680: 20 28 6e 6f 74 20 28 73 65 74 75 70 2d 66 6f 72 (not (setup-for
1690: 2d 72 75 6e 29 29 0a 09 20 20 20 20 20 20 28 62 -run)).. (b
16a0: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
16b0: 69 6e 74 20 30 20 22 46 61 69 6c 65 64 20 74 6f int 0 "Failed to
16c0: 20 73 65 74 75 70 2c 20 65 78 69 74 69 6e 67 22 setup, exiting"
16d0: 29 20 0a 09 09 3b 3b 20 28 73 71 6c 69 74 65 33 ) ...;; (sqlite3
16e0: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 62 29 0a 09 :finalize! db)..
16f0: 09 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e .;; (sqlite3:fin
1700: 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 09 28 65 alize! tdb)...(e
1710: 78 69 74 20 31 29 29 29 0a 09 20 20 3b 3b 20 43 xit 1))).. ;; C
1720: 61 6e 20 73 65 74 75 70 20 61 73 20 63 6c 69 65 an setup as clie
1730: 6e 74 20 66 6f 72 20 73 65 72 76 65 72 20 6d 6f nt for server mo
1740: 64 65 20 6e 6f 77 0a 09 20 20 3b 3b 20 28 63 6c de now.. ;; (cl
1750: 69 65 6e 74 3a 73 65 74 75 70 29 0a 0a 09 20 20 ient:setup)...
1760: 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f 72 (change-director
1770: 79 20 2a 74 6f 70 70 61 74 68 2a 29 20 0a 09 20 y *toppath*) ..
1780: 20 28 73 65 74 2d 6d 65 67 61 74 65 73 74 2d 65 (set-megatest-e
1790: 6e 76 2d 76 61 72 73 20 72 75 6e 2d 69 64 29 20 nv-vars run-id)
17a0: 3b 3b 20 74 68 65 73 65 20 6d 61 79 20 62 65 20 ;; these may be
17b0: 6e 65 65 64 65 64 20 62 79 20 74 68 65 20 6c 61 needed by the la
17c0: 75 6e 63 68 69 6e 67 20 70 72 6f 63 65 73 73 0a unching process.
17d0: 09 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 . (change-direc
17e0: 74 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 tory work-area)
17f0: 0a 0a 09 20 20 28 73 65 74 2d 72 75 6e 2d 63 6f ... (set-run-co
1800: 6e 66 69 67 2d 76 61 72 73 20 72 75 6e 2d 69 64 nfig-vars run-id
1810: 20 6b 65 79 76 61 6c 73 20 74 61 72 67 65 74 29 keyvals target)
1820: 20 3b 3b 20 28 64 62 3a 67 65 74 2d 74 61 72 67 ;; (db:get-targ
1830: 65 74 20 64 62 20 72 75 6e 2d 69 64 29 29 0a 09 et db run-id))..
1840: 20 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 ;; environment
1850: 20 6f 76 65 72 72 69 64 65 73 20 61 72 65 20 64 overrides are d
1860: 6f 6e 65 20 2a 62 65 66 6f 72 65 2a 20 74 68 65 one *before* the
1870: 20 72 65 6d 61 69 6e 69 6e 67 20 63 72 69 74 69 remaining criti
1880: 63 61 6c 20 65 6e 76 61 72 73 2e 0a 09 20 20 28 cal envars... (
1890: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
18a0: 65 6e 76 2d 6f 76 72 64 29 0a 09 20 20 28 73 65 env-ovrd).. (se
18b0: 74 2d 6d 65 67 61 74 65 73 74 2d 65 6e 76 2d 76 t-megatest-env-v
18c0: 61 72 73 20 72 75 6e 2d 69 64 29 0a 09 20 20 28 ars run-id).. (
18d0: 73 65 74 2d 69 74 65 6d 2d 65 6e 76 2d 76 61 72 set-item-env-var
18e0: 73 20 69 74 65 6d 64 61 74 29 0a 09 20 20 28 73 s itemdat).. (s
18f0: 61 76 65 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d ave-environment-
1900: 61 73 2d 66 69 6c 65 73 20 22 6d 65 67 61 74 65 as-files "megate
1910: 73 74 22 29 0a 09 20 20 3b 3b 20 6f 70 65 6e 2d st").. ;; open-
1920: 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f 74 20 6e 65 run-close not ne
1930: 65 64 65 64 20 66 6f 72 20 74 65 73 74 2d 73 65 eded for test-se
1940: 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 20 20 28 t-meta-info.. (
1950: 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d 6d tests:set-full-m
1960: 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 eta-info #f test
1970: 2d 69 64 20 72 75 6e 2d 69 64 20 30 20 77 6f 72 -id run-id 0 wor
1980: 6b 2d 61 72 65 61 29 0a 0a 09 20 20 3b 3b 20 28 k-area)... ;; (
1990: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
19a0: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 tatus! test-id "
19b0: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 22 REMOTEHOSTSTART"
19c0: 20 22 6e 2f 61 22 20 28 61 72 67 73 3a 67 65 74 "n/a" (args:get
19d0: 2d 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 -arg "-m") #f)..
19e0: 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f (tests:test-fo
19f0: 72 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 rce-state-status
1a00: 21 20 74 65 73 74 2d 69 64 20 22 52 45 4d 4f 54 ! test-id "REMOT
1a10: 45 48 4f 53 54 53 54 41 52 54 22 20 22 6e 2f 61 EHOSTSTART" "n/a
1a20: 22 29 0a 09 20 20 28 74 68 72 65 61 64 2d 73 6c ").. (thread-sl
1a30: 65 65 70 21 20 30 2e 33 29 20 3b 3b 20 4e 46 53 eep! 0.3) ;; NFS
1a40: 20 73 6c 6f 77 6e 65 73 73 20 68 61 73 20 63 61 slowness has ca
1a50: 75 73 65 64 20 67 72 69 65 66 20 68 65 72 65 0a used grief here.
1a60: 0a 09 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 .. (if (args:ge
1a70: 74 2d 61 72 67 20 22 2d 78 74 65 72 6d 22 29 0a t-arg "-xterm").
1a80: 09 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
1a90: 6c 72 75 6e 73 63 72 69 70 74 20 22 78 74 65 72 lrunscript "xter
1aa0: 6d 22 29 0a 09 20 20 20 20 20 20 28 69 66 20 28 m").. (if (
1ab0: 61 6e 64 20 66 75 6c 6c 72 75 6e 73 63 72 69 70 and fullrunscrip
1ac0: 74 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 65 t (not (file-exe
1ad0: 63 75 74 65 2d 61 63 63 65 73 73 3f 20 66 75 6c cute-access? ful
1ae0: 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 09 lrunscript)))...
1af0: 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 (system (conc
1b00: 22 63 68 6d 6f 64 20 75 67 2b 78 20 22 20 66 75 "chmod ug+x " fu
1b10: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 29 0a llrunscript)))).
1b20: 09 20 20 3b 3b 20 57 65 20 61 72 65 20 61 62 6f . ;; We are abo
1b30: 75 74 20 74 6f 20 61 63 74 75 61 6c 6c 79 20 6b ut to actually k
1b40: 69 63 6b 20 6f 66 66 20 74 68 65 20 74 65 73 74 ick off the test
1b50: 0a 09 20 20 3b 3b 20 73 6f 20 74 68 69 73 20 69 .. ;; so this i
1b60: 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 20 74 s a good place t
1b70: 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 72 65 63 o remove the rec
1b80: 6f 72 64 73 20 66 6f 72 20 0a 09 20 20 3b 3b 20 ords for .. ;;
1b90: 61 6e 79 20 70 72 65 76 69 6f 75 73 20 72 75 6e any previous run
1ba0: 73 0a 09 20 20 3b 3b 20 28 64 62 3a 74 65 73 74 s.. ;; (db:test
1bb0: 2d 72 65 6d 6f 76 65 2d 73 74 65 70 73 20 64 62 -remove-steps db
1bc0: 20 72 75 6e 2d 69 64 20 74 65 73 74 6e 61 6d 65 run-id testname
1bd0: 20 69 74 65 6d 64 61 74 29 0a 09 20 20 0a 09 20 itemdat).. ..
1be0: 20 28 6c 65 74 2a 20 28 28 6d 20 20 20 20 20 20 (let* ((m
1bf0: 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d 75 74 65 (make-mute
1c00: 78 29 29 0a 09 09 20 28 6b 69 6c 6c 2d 6a 6f 62 x))... (kill-job
1c10: 3f 20 20 20 20 23 66 29 0a 09 09 20 28 65 78 69 ? #f)... (exi
1c20: 74 2d 69 6e 66 6f 20 20 20 20 28 76 65 63 74 6f t-info (vecto
1c30: 72 20 23 74 20 23 74 20 23 74 29 29 0a 09 09 20 r #t #t #t))...
1c40: 28 6a 6f 62 2d 74 68 72 65 61 64 20 20 20 23 66 (job-thread #f
1c50: 29 0a 09 09 20 28 6b 65 65 70 2d 67 6f 69 6e 67 )... (keep-going
1c60: 20 20 20 23 74 29 0a 09 09 20 28 72 75 6e 69 74 #t)... (runit
1c70: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1c80: 28 29 0a 09 09 09 09 20 3b 3b 20 28 6c 65 74 2d ()..... ;; (let-
1c90: 76 61 6c 75 65 73 0a 09 09 09 09 20 3b 3b 20 20 values..... ;;
1ca0: 28 28 28 70 69 64 20 65 78 69 74 2d 73 74 61 74 (((pid exit-stat
1cb0: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 09 us exit-code)...
1cc0: 09 09 20 3b 3b 20 20 20 20 28 72 75 6e 2d 6e 2d .. ;; (run-n-
1cd0: 77 61 69 74 20 66 75 6c 6c 72 75 6e 73 63 72 69 wait fullrunscri
1ce0: 70 74 29 29 29 0a 09 09 09 09 20 3b 3b 20 28 74 pt)))..... ;; (t
1cf0: 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 ests:test-set-st
1d00: 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 22 52 atus! test-id "R
1d10: 55 4e 4e 49 4e 47 22 20 22 6e 2f 61 22 20 23 66 UNNING" "n/a" #f
1d20: 20 23 66 29 0a 09 09 09 09 20 3b 3b 20 53 69 6e #f)..... ;; Sin
1d30: 63 65 20 77 65 20 73 68 6f 75 6c 64 20 68 61 76 ce we should hav
1d40: 65 20 61 20 63 6c 65 61 6e 20 73 6c 61 74 65 20 e a clean slate
1d50: 61 74 20 74 68 69 73 20 74 69 6d 65 20 74 68 65 at this time the
1d60: 72 65 20 69 73 20 6e 6f 20 6e 65 65 64 20 74 6f re is no need to
1d70: 20 64 6f 20 0a 09 09 09 09 20 3b 3b 20 61 6e 79 do ..... ;; any
1d80: 20 6f 66 20 74 68 65 20 6f 74 68 65 72 20 73 74 of the other st
1d90: 75 66 66 20 74 68 61 74 20 74 65 73 74 73 3a 74 uff that tests:t
1da0: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
1db0: 64 6f 65 73 2e 20 4c 65 74 27 73 20 6a 75 73 74 does. Let's just
1dc0: 20 0a 09 09 09 09 20 3b 3b 20 66 6f 72 63 65 20 ..... ;; force
1dd0: 52 55 4e 4e 49 4e 47 2f 6e 2f 61 0a 09 09 09 09 RUNNING/n/a.....
1de0: 20 0a 0a 09 09 09 09 20 28 74 68 72 65 61 64 2d ...... (thread-
1df0: 73 6c 65 65 70 21 20 30 2e 33 29 0a 09 09 09 09 sleep! 0.3).....
1e00: 20 28 74 65 73 74 73 3a 74 65 73 74 2d 66 6f 72 (tests:test-for
1e10: 63 65 2d 73 74 61 74 65 2d 73 74 61 74 75 73 21 ce-state-status!
1e20: 20 74 65 73 74 2d 69 64 20 22 52 55 4e 4e 49 4e test-id "RUNNIN
1e30: 47 22 20 22 6e 2f 61 22 29 0a 09 09 09 09 20 28 G" "n/a")..... (
1e40: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e thread-sleep! 0.
1e50: 33 29 20 3b 3b 20 4e 46 53 20 73 6c 6f 77 6e 65 3) ;; NFS slowne
1e60: 73 73 20 68 61 73 20 63 61 75 73 65 64 20 67 72 ss has caused gr
1e70: 69 65 66 20 68 65 72 65 0a 0a 09 09 09 09 20 3b ief here...... ;
1e80: 3b 20 69 66 20 74 68 65 72 65 20 69 73 20 61 20 ; if there is a
1e90: 72 75 6e 73 63 72 69 70 74 20 64 6f 20 69 74 20 runscript do it
1ea0: 66 69 72 73 74 0a 09 09 09 09 20 28 69 66 20 66 first..... (if f
1eb0: 75 6c 6c 72 75 6e 73 63 72 69 70 74 0a 09 09 09 ullrunscript....
1ec0: 09 20 20 20 20 20 28 6c 65 74 20 28 28 70 69 64 . (let ((pid
1ed0: 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 66 75 (process-run fu
1ee0: 6c 6c 72 75 6e 73 63 72 69 70 74 29 29 29 0a 09 llrunscript)))..
1ef0: 09 09 09 20 20 20 20 20 20 20 28 6c 65 74 20 6c ... (let l
1f00: 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 09 09 oop ((i 0)).....
1f10: 09 20 28 6c 65 74 2d 76 61 6c 75 65 73 0a 09 09 . (let-values...
1f20: 09 09 09 20 20 28 28 28 70 69 64 2d 76 61 6c 20 ... (((pid-val
1f30: 65 78 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 exit-status exit
1f40: 2d 63 6f 64 65 29 20 28 70 72 6f 63 65 73 73 2d -code) (process-
1f50: 77 61 69 74 20 70 69 64 20 23 74 29 29 29 0a 09 wait pid #t)))..
1f60: 09 09 09 09 20 20 28 6d 75 74 65 78 2d 6c 6f 63 .... (mutex-loc
1f70: 6b 21 20 6d 29 0a 09 09 09 09 09 20 20 28 76 65 k! m)...... (ve
1f80: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
1f90: 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 nfo 0 pid)......
1fa0: 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 (vector-set! e
1fb0: 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d xit-info 1 exit-
1fc0: 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 28 status)...... (
1fd0: 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 vector-set! exit
1fe0: 2d 69 6e 66 6f 20 32 20 65 78 69 74 2d 63 6f 64 -info 2 exit-cod
1ff0: 65 29 0a 09 09 09 09 09 20 20 28 73 65 74 21 20 e)...... (set!
2000: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 65 78 rollup-status ex
2010: 69 74 2d 63 6f 64 65 29 20 0a 09 09 09 09 09 20 it-code) ......
2020: 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 (mutex-unlock!
2030: 6d 29 0a 09 09 09 09 09 20 20 28 69 66 20 28 65 m)...... (if (e
2040: 71 3f 20 70 69 64 2d 76 61 6c 20 30 29 0a 09 09 q? pid-val 0)...
2050: 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ... (begin.
2060: 09 09 09 09 09 09 28 74 68 72 65 61 64 2d 73 6c ......(thread-sl
2070: 65 65 70 21 20 32 29 0a 09 09 09 09 09 09 28 6c eep! 2).......(l
2080: 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a 09 09 oop (+ i 1)))...
2090: 09 09 09 20 20 20 20 20 20 29 29 29 29 29 0a 09 ... )))))..
20a0: 09 09 09 20 3b 3b 20 74 68 65 6e 2c 20 69 66 20 ... ;; then, if
20b0: 72 75 6e 73 63 72 69 70 74 20 72 61 6e 20 6f 6b runscript ran ok
20c0: 20 28 6f 72 20 64 69 64 20 6e 6f 74 20 67 65 74 (or did not get
20d0: 20 63 61 6c 6c 65 64 29 0a 09 09 09 09 20 3b 3b called)..... ;;
20e0: 20 64 6f 20 61 6c 6c 20 74 68 65 20 65 7a 73 74 do all the ezst
20f0: 65 70 73 20 28 69 66 20 61 6e 79 29 0a 09 09 09 eps (if any)....
2100: 09 20 28 69 66 20 65 7a 73 74 65 70 73 0a 09 09 . (if ezsteps...
2110: 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 .. (let* ((t
2120: 65 73 74 63 6f 6e 66 69 67 20 28 72 65 61 64 2d estconfig (read-
2130: 63 6f 6e 66 69 67 20 28 63 6f 6e 63 20 77 6f 72 config (conc wor
2140: 6b 2d 61 72 65 61 20 22 2f 74 65 73 74 63 6f 6e k-area "/testcon
2150: 66 69 67 22 29 20 23 66 20 23 74 20 65 6e 76 69 fig") #f #t envi
2160: 72 6f 6e 2d 70 61 74 74 3a 20 22 70 72 65 2d 6c ron-patt: "pre-l
2170: 61 75 6e 63 68 2d 65 6e 76 2d 76 61 72 73 22 29 aunch-env-vars")
2180: 29 20 3b 3b 20 46 49 58 4d 45 3f 3f 3f 20 69 73 ) ;; FIXME??? is
2190: 20 61 6c 6c 6f 77 2d 73 79 73 74 65 6d 20 6f 6b allow-system ok
21a0: 20 68 65 72 65 3f 0a 09 09 09 09 09 20 20 20 20 here?......
21b0: 28 65 7a 73 74 65 70 73 6c 73 74 20 28 68 61 73 (ezstepslst (has
21c0: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
21d0: 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 ult testconfig "
21e0: 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 29 0a ezsteps" '()))).
21f0: 09 09 09 09 20 20 20 20 20 20 20 28 68 61 73 68 .... (hash
2200: 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 74 65 73 -table-set! *tes
2210: 74 63 6f 6e 66 69 67 73 2a 20 74 65 73 74 2d 6e tconfigs* test-n
2220: 61 6d 65 20 74 65 73 74 63 6f 6e 66 69 67 29 20 ame testconfig)
2230: 3b 3b 20 63 61 63 68 65 64 20 66 6f 72 20 6c 61 ;; cached for la
2240: 7a 79 20 72 65 61 64 73 20 6c 61 74 65 72 20 2e zy reads later .
2250: 2e 2e 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 ....... (i
2260: 66 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 f (not (file-exi
2270: 73 74 73 3f 20 22 2e 65 7a 73 74 65 70 73 22 29 sts? ".ezsteps")
2280: 29 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f )(create-directo
2290: 72 79 20 22 2e 65 7a 73 74 65 70 73 22 29 29 0a ry ".ezsteps")).
22a0: 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 69 66 .... ;; if
22b0: 20 65 7a 73 74 65 70 73 20 77 61 73 20 64 65 66 ezsteps was def
22c0: 69 6e 65 64 20 74 68 65 6e 20 77 65 20 61 72 65 ined then we are
22d0: 20 73 75 72 65 20 74 6f 20 68 61 76 65 20 61 74 sure to have at
22e0: 20 6c 65 61 73 74 20 6f 6e 65 20 73 74 65 70 20 least one step
22f0: 62 75 74 20 63 68 65 63 6b 20 61 6e 79 77 61 79 but check anyway
2300: 0a 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
2310: 28 6e 6f 74 20 28 3e 20 28 6c 65 6e 67 74 68 20 (not (> (length
2320: 65 7a 73 74 65 70 73 6c 73 74 29 20 30 29 29 0a ezstepslst) 0)).
2330: 09 09 09 09 09 20 20 20 28 64 65 62 75 67 3a 70 ..... (debug:p
2340: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 65 rint 0 "ERROR: e
2350: 7a 73 74 65 70 73 20 64 65 66 69 6e 65 64 20 62 zsteps defined b
2360: 75 74 20 65 7a 73 74 65 70 73 6c 73 74 20 69 73 ut ezstepslst is
2370: 20 7a 65 72 6f 20 6c 65 6e 67 74 68 22 29 0a 09 zero length")..
2380: 09 09 09 09 20 20 20 28 6c 65 74 20 6c 6f 6f 70 .... (let loop
2390: 20 28 28 65 7a 73 74 65 70 20 28 63 61 72 20 65 ((ezstep (car e
23a0: 7a 73 74 65 70 73 6c 73 74 29 29 0a 09 09 09 09 zstepslst)).....
23b0: 09 09 20 20 20 20 20 20 28 74 61 6c 20 20 20 20 .. (tal
23c0: 28 63 64 72 20 65 7a 73 74 65 70 73 6c 73 74 29 (cdr ezstepslst)
23d0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 28 70 )....... (p
23e0: 72 65 76 73 74 65 70 20 23 66 29 29 0a 09 09 09 revstep #f))....
23f0: 09 09 20 20 20 20 20 3b 3b 20 63 68 65 63 6b 20 .. ;; check
2400: 65 78 69 74 2d 69 6e 66 6f 20 28 76 65 63 74 6f exit-info (vecto
2410: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2420: 31 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 1)...... (if
2430: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
2440: 74 2d 69 6e 66 6f 20 31 29 0a 09 09 09 09 09 09 t-info 1).......
2450: 20 28 6c 65 74 2a 20 28 28 73 74 65 70 6e 61 6d (let* ((stepnam
2460: 65 20 20 28 63 61 72 20 65 7a 73 74 65 70 29 29 e (car ezstep))
2470: 20 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 6f ;; do stuff to
2480: 20 72 75 6e 20 74 68 65 20 73 74 65 70 0a 09 09 run the step...
2490: 09 09 09 09 09 28 73 74 65 70 69 6e 66 6f 20 20 .....(stepinfo
24a0: 28 63 61 64 72 20 65 7a 73 74 65 70 29 29 0a 09 (cadr ezstep))..
24b0: 09 09 09 09 09 09 28 73 74 65 70 70 61 72 74 73 ......(stepparts
24c0: 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 (string-match (
24d0: 72 65 67 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e regexp "^(\\{([^
24e0: 5c 5c 7d 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 \\}]*)\\}\\s*|)(
24f0: 2e 2a 29 24 22 29 20 73 74 65 70 69 6e 66 6f 29 .*)$") stepinfo)
2500: 29 0a 09 09 09 09 09 09 09 28 73 74 65 70 70 61 )........(steppa
2510: 72 6d 73 20 28 6c 69 73 74 2d 72 65 66 20 73 74 rms (list-ref st
2520: 65 70 70 61 72 74 73 20 32 29 29 20 3b 3b 20 66 epparts 2)) ;; f
2530: 6f 72 20 66 75 74 75 72 65 20 75 73 65 2c 20 7b or future use, {
2540: 56 41 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e 20 VAR=1,2,3}, run
2550: 73 74 65 70 20 66 6f 72 20 65 61 63 68 20 0a 09 step for each ..
2560: 09 09 09 09 09 09 28 73 74 65 70 63 6d 64 20 20 ......(stepcmd
2570: 20 28 6c 69 73 74 2d 72 65 66 20 73 74 65 70 70 (list-ref stepp
2580: 61 72 74 73 20 33 29 29 0a 09 09 09 09 09 09 09 arts 3))........
2590: 28 73 63 72 69 70 74 20 20 20 20 22 22 29 20 3b (script "") ;
25a0: 20 22 23 21 2f 62 69 6e 2f 62 61 73 68 5c 6e 22 "#!/bin/bash\n"
25b0: 29 20 3b 3b 20 79 65 70 2c 20 77 65 20 64 65 70 ) ;; yep, we dep
25c0: 65 6e 64 20 6f 6e 20 62 69 6e 2f 62 61 73 68 20 end on bin/bash
25d0: 46 49 58 4d 45 21 21 21 0a 09 09 09 09 09 09 09 FIXME!!!........
25e0: 28 6c 6f 67 70 72 6f 2d 75 73 65 64 20 23 66 29 (logpro-used #f)
25f0: 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 4e 42 )....... ;; NB
2600: 2f 2f 20 63 61 6e 20 73 61 66 65 6c 79 20 61 73 // can safely as
2610: 73 75 6d 65 20 77 65 20 61 72 65 20 69 6e 20 74 sume we are in t
2620: 65 73 74 2d 61 72 65 61 20 64 69 72 65 63 74 6f est-area directo
2630: 72 79 0a 09 09 09 09 09 09 20 20 20 28 64 65 62 ry....... (deb
2640: 75 67 3a 70 72 69 6e 74 20 34 20 22 65 7a 73 74 ug:print 4 "ezst
2650: 65 70 73 3a 5c 6e 20 73 74 65 70 6e 61 6d 65 3a eps:\n stepname:
2660: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 73 74 " stepname " st
2670: 65 70 69 6e 66 6f 3a 20 22 20 73 74 65 70 69 6e epinfo: " stepin
2680: 66 6f 20 22 20 73 74 65 70 70 61 72 74 73 3a 20 fo " stepparts:
2690: 22 20 73 74 65 70 70 61 72 74 73 0a 09 09 09 09 " stepparts.....
26a0: 09 09 09 09 22 20 73 74 65 70 70 61 72 6d 73 3a ...." stepparms:
26b0: 20 22 20 73 74 65 70 70 61 72 6d 73 20 22 20 73 " stepparms " s
26c0: 74 65 70 63 6d 64 3a 20 22 20 73 74 65 70 63 6d tepcmd: " stepcm
26d0: 64 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 d)....... ....
26e0: 09 09 09 20 20 20 28 69 66 20 28 66 69 6c 65 2d ... (if (file-
26f0: 65 78 69 73 74 73 3f 20 28 63 6f 6e 63 20 73 74 exists? (conc st
2700: 65 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 epname ".logpro"
2710: 29 29 28 73 65 74 21 20 6c 6f 67 70 72 6f 2d 75 ))(set! logpro-u
2720: 73 65 64 20 23 74 29 29 0a 0a 09 09 09 09 09 09 sed #t))........
2730: 20 20 20 3b 3b 20 3b 3b 20 66 69 72 73 74 20 73 ;; ;; first s
2740: 6f 75 72 63 65 20 74 68 65 20 70 72 65 76 69 6f ource the previo
2750: 75 73 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 0a 09 us environment..
2760: 09 09 09 09 09 20 20 20 3b 3b 20 28 6c 65 74 20 ..... ;; (let
2770: 28 28 70 72 65 76 2d 65 6e 76 20 28 63 6f 6e 63 ((prev-env (conc
2780: 20 22 2e 65 7a 73 74 65 70 73 2f 22 20 70 72 65 ".ezsteps/" pre
2790: 76 73 74 65 70 20 28 69 66 20 28 73 74 72 69 6e vstep (if (strin
27a0: 67 2d 73 65 61 72 63 68 20 28 72 65 67 65 78 70 g-search (regexp
27b0: 20 22 63 73 68 22 29 20 0a 09 09 09 09 09 09 20 "csh") .......
27c0: 20 20 3b 3b 20 20 20 20 20 20 09 09 09 09 09 09 ;; ......
27d0: 09 20 28 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 . (get-environme
27e0: 6e 74 2d 76 61 72 69 61 62 6c 65 20 22 53 48 45 nt-variable "SHE
27f0: 4c 4c 22 29 29 20 22 2e 63 73 68 22 20 22 2e 73 LL")) ".csh" ".s
2800: 68 22 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 h")))).......
2810: 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 70 72 ;; (if (and pr
2820: 65 76 73 74 65 70 20 28 66 69 6c 65 2d 65 78 69 evstep (file-exi
2830: 73 74 73 3f 20 70 72 65 76 2d 65 6e 76 29 29 0a sts? prev-env)).
2840: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 ...... ;;
2850: 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 28 (set! script (
2860: 63 6f 6e 63 20 73 63 72 69 70 74 20 22 73 6f 75 conc script "sou
2870: 72 63 65 20 22 20 70 72 65 76 2d 65 6e 76 29 29 rce " prev-env))
2880: 29 29 0a 09 09 09 09 09 09 20 20 20 0a 09 09 09 ))....... ....
2890: 09 09 09 20 20 20 3b 3b 20 63 61 6c 6c 20 74 68 ... ;; call th
28a0: 65 20 63 6f 6d 6d 61 6e 64 20 75 73 69 6e 67 20 e command using
28b0: 6d 74 5f 65 7a 73 74 65 70 0a 09 09 09 09 09 09 mt_ezstep.......
28c0: 20 20 20 28 73 65 74 21 20 73 63 72 69 70 74 20 (set! script
28d0: 28 63 6f 6e 63 20 22 6d 74 5f 65 7a 73 74 65 70 (conc "mt_ezstep
28e0: 20 22 20 73 74 65 70 6e 61 6d 65 20 22 20 22 20 " stepname " "
28f0: 28 69 66 20 70 72 65 76 73 74 65 70 20 70 72 65 (if prevstep pre
2900: 76 73 74 65 70 20 22 2d 22 29 20 22 20 22 20 73 vstep "-") " " s
2910: 74 65 70 63 6d 64 29 29 0a 0a 09 09 09 09 09 09 tepcmd))........
2920: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
2930: 34 20 22 73 63 72 69 70 74 3a 20 22 20 73 63 72 4 "script: " scr
2940: 69 70 74 29 0a 09 09 09 09 09 09 20 20 20 3b 3b ipt)....... ;;
2950: 20 44 4f 20 4e 4f 54 20 72 65 6d 6f 74 65 0a 09 DO NOT remote..
2960: 09 09 09 09 09 20 20 20 28 64 62 3a 74 65 73 74 ..... (db:test
2970: 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 step-set-status!
2980: 20 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 70 #f test-id step
2990: 6e 61 6d 65 20 22 73 74 61 72 74 22 20 22 2d 22 name "start" "-"
29a0: 20 23 66 20 23 66 20 77 6f 72 6b 2d 61 72 65 61 #f #f work-area
29b0: 3a 20 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 : work-area)....
29c0: 09 09 09 20 20 20 3b 3b 20 6e 6f 77 20 6c 61 75 ... ;; now lau
29d0: 6e 63 68 0a 09 09 09 09 09 09 20 20 20 28 6c 65 nch....... (le
29e0: 74 20 28 28 70 69 64 20 28 70 72 6f 63 65 73 73 t ((pid (process
29f0: 2d 72 75 6e 20 73 63 72 69 70 74 29 29 29 0a 09 -run script)))..
2a00: 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 20 70 ..... (let p
2a10: 72 6f 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 rocessloop ((i 0
2a20: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
2a30: 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 (let-values (((p
2a40: 69 64 2d 76 61 6c 20 65 78 69 74 2d 73 74 61 74 id-val exit-stat
2a50: 75 73 20 65 78 69 74 2d 63 6f 64 65 29 28 70 72 us exit-code)(pr
2a60: 6f 63 65 73 73 2d 77 61 69 74 20 70 69 64 20 23 ocess-wait pid #
2a70: 74 29 29 29 0a 09 09 09 09 09 09 09 09 20 20 20 t))).........
2a80: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a (mutex-lock! m).
2a90: 09 09 09 09 09 09 09 09 20 20 20 28 76 65 63 74 ........ (vect
2aa0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
2ab0: 6f 20 30 20 70 69 64 29 0a 09 09 09 09 09 09 09 o 0 pid)........
2ac0: 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 . (vector-set!
2ad0: 20 65 78 69 74 2d 69 6e 66 6f 20 31 20 65 78 69 exit-info 1 exi
2ae0: 74 2d 73 74 61 74 75 73 29 0a 09 09 09 09 09 09 t-status).......
2af0: 09 09 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 .. (vector-set
2b00: 21 20 65 78 69 74 2d 69 6e 66 6f 20 32 20 65 78 ! exit-info 2 ex
2b10: 69 74 2d 63 6f 64 65 29 0a 09 09 09 09 09 09 09 it-code)........
2b20: 09 20 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 . (mutex-unloc
2b30: 6b 21 20 6d 29 0a 09 09 09 09 09 09 09 09 20 20 k! m).........
2b40: 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d 76 61 (if (eq? pid-va
2b50: 6c 20 30 29 0a 09 09 09 09 09 09 09 09 20 20 20 l 0).........
2b60: 20 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 (begin......
2b70: 09 09 09 09 20 28 74 68 72 65 61 64 2d 73 6c 65 .... (thread-sle
2b80: 65 70 21 20 32 29 0a 09 09 09 09 09 09 09 09 09 ep! 2)..........
2b90: 20 28 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b (processloop (+
2ba0: 20 69 20 31 29 29 29 29 0a 09 09 09 09 09 09 09 i 1))))........
2bb0: 09 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 . )).
2bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2be0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
2bf0: 20 28 28 65 78 69 6e 66 6f 20 28 76 65 63 74 6f ((exinfo (vecto
2c00: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
2c10: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
2c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2c50: 6c 6f 67 66 6e 61 20 28 69 66 20 6c 6f 67 70 72 logfna (if logpr
2c60: 6f 2d 75 73 65 64 20 28 63 6f 6e 63 20 73 74 65 o-used (conc ste
2c70: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 20 22 pname ".html") "
2c80: 22 29 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 "))).......
2c90: 20 20 3b 3b 20 74 65 73 74 69 6e 67 20 69 66 20 ;; testing if
2ca0: 70 72 6f 63 65 64 75 72 65 73 20 63 61 6c 6c 65 procedures calle
2cb0: 64 20 69 6e 20 61 20 72 65 6d 6f 74 65 20 63 61 d in a remote ca
2cc0: 6c 6c 20 63 61 75 73 65 20 70 72 6f 62 6c 65 6d ll cause problem
2cd0: 73 20 28 61 6e 73 3a 20 6e 6f 20 6f 72 20 73 6f s (ans: no or so
2ce0: 20 49 20 73 75 73 70 65 63 74 29 0a 09 09 09 09 I suspect).....
2cf0: 09 09 20 20 20 20 20 20 20 28 64 62 3a 74 65 73 .. (db:tes
2d00: 74 73 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 tstep-set-status
2d10: 21 20 23 66 20 74 65 73 74 2d 69 64 20 73 74 65 ! #f test-id ste
2d20: 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 69 6e pname "end" exin
2d30: 66 6f 20 23 66 20 6c 6f 67 66 6e 61 20 77 6f 72 fo #f logfna wor
2d40: 6b 2d 61 72 65 61 3a 20 77 6f 72 6b 2d 61 72 65 k-area: work-are
2d50: 61 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 28 a))....... (
2d60: 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a 09 if logpro-used..
2d70: 09 09 09 09 09 09 20 28 63 64 62 3a 74 65 73 74 ...... (cdb:test
2d80: 2d 73 65 74 2d 6c 6f 67 21 20 2a 72 75 6e 72 65 -set-log! *runre
2d90: 6d 6f 74 65 2a 20 20 74 65 73 74 2d 69 64 20 28 mote* test-id (
2da0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
2db0: 68 74 6d 6c 22 29 29 29 0a 09 09 09 09 09 09 20 html"))).......
2dc0: 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 74 ;; set the t
2dd0: 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 73 est final status
2de0: 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 74 ....... (let
2df0: 2a 20 28 28 74 68 69 73 2d 73 74 65 70 2d 73 74 * ((this-step-st
2e00: 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 09 atus (cond......
2e10: 09 09 09 09 20 20 20 20 20 20 20 28 28 61 6e 64 .... ((and
2e20: 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 65 (eq? (vector-re
2e30: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 32 f exit-info 2) 2
2e40: 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 27 ) logpro-used) '
2e50: 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 20 warn)..........
2e60: 20 20 20 20 20 20 28 28 65 71 3f 20 28 76 65 63 ((eq? (vec
2e70: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
2e80: 6f 20 32 29 20 30 29 20 20 20 20 20 20 20 20 20 o 2) 0)
2e90: 20 20 20 20 20 20 20 20 20 20 27 70 61 73 73 29 'pass)
2ea0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2eb0: 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a (else 'fail))).
2ec0: 09 09 09 09 09 09 09 20 20 20 20 28 6f 76 65 72 ....... (over
2ed0: 61 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 6f all-status (co
2ee0: 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 nd..........
2ef0: 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d ((eq? rollup-
2f00: 73 74 61 74 75 73 20 32 29 20 27 77 61 72 6e 29 status 2) 'warn)
2f10: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2f20: 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 ((eq? rollup-st
2f30: 61 74 75 73 20 30 29 20 27 70 61 73 73 29 0a 09 atus 0) 'pass)..
2f40: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
2f50: 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 09 else 'fail)))...
2f60: 09 09 09 09 09 20 20 20 20 28 6e 65 78 74 2d 73 ..... (next-s
2f70: 74 61 74 75 73 20 20 20 20 20 20 28 63 6f 6e 64 tatus (cond
2f80: 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 ..........
2f90: 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d ((eq? overall-
2fa0: 73 74 61 74 75 73 20 27 70 61 73 73 29 20 74 68 status 'pass) th
2fb0: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 29 0a is-step-status).
2fc0: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2fd0: 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 74 ((eq? overall-st
2fe0: 61 74 75 73 20 27 77 61 72 6e 29 0a 09 09 09 09 atus 'warn).....
2ff0: 09 09 09 09 09 09 28 69 66 20 28 65 71 3f 20 74 ......(if (eq? t
3000: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 his-step-status
3010: 27 66 61 69 6c 29 20 27 66 61 69 6c 20 27 77 61 'fail) 'fail 'wa
3020: 72 6e 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 rn))..........
3030: 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 6c (else 'fail
3040: 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 )))........ (
3050: 6e 65 78 74 2d 73 74 61 74 65 20 20 20 20 20 20 next-state
3060: 20 22 52 55 4e 4e 49 4e 47 22 29 20 0a 09 09 09 "RUNNING") ....
3070: 09 09 09 09 20 20 20 20 20 20 20 20 20 20 20 20 ....
3080: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 28 63 ;; (c
3090: 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 ond..........
30a0: 20 20 20 3b 3b 20 20 28 28 6e 75 6c 6c 3f 20 74 ;; ((null? t
30b0: 61 6c 29 20 3b 3b 20 6d 6f 72 65 20 74 6f 20 72 al) ;; more to r
30c0: 75 6e 3f 0a 09 09 09 09 09 09 09 09 09 20 20 20 un?..........
30d0: 20 20 20 3b 3b 20 20 20 22 43 4f 4d 50 4c 45 54 ;; "COMPLET
30e0: 45 44 22 29 0a 09 09 09 09 09 09 09 09 09 20 20 ED")..........
30f0: 20 20 20 20 3b 3b 20 20 28 65 6c 73 65 20 22 52 ;; (else "R
3100: 55 4e 4e 49 4e 47 22 29 29 0a 09 09 09 09 09 09 UNNING")).......
3110: 09 20 20 20 20 29 0a 09 09 09 09 09 09 20 20 20 . ).......
3120: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
3130: 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 20 72 4 "Exit value r
3140: 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 63 74 eceived: " (vect
3150: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
3160: 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 2) " logpro-use
3170: 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 d: " logpro-used
3180: 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 20 ......... "
3190: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
31a0: 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d 73 74 : " this-step-st
31b0: 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d 73 atus " overall-s
31c0: 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 6c 6c tatus: " overall
31d0: 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 09 09 -status ........
31e0: 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 61 74 . " next-stat
31f0: 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 75 us: " next-statu
3200: 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 s " rollup-statu
3210: 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 s: " rollup-stat
3220: 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 us).......
3230: 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 61 74 (case next-stat
3240: 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 61 72 us........ ((war
3250: 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 65 74 n)........ (set
3260: 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ! rollup-status
3270: 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b 20 4e 2)........ ;; N
3280: 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 61 B// test-set-sta
3290: 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 61 tus! does rdb ca
32a0: 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 6f lls under the ho
32b0: 6f 64 0a 09 09 09 09 09 09 09 20 20 28 74 65 73 od........ (tes
32c0: 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 ts:test-set-stat
32d0: 75 73 21 20 74 65 73 74 2d 69 64 20 6e 65 78 74 us! test-id next
32e0: 2d 73 74 61 74 65 20 22 57 41 52 4e 22 20 0a 09 -state "WARN" ..
32f0: 09 09 09 09 09 09 09 09 20 20 28 69 66 20 28 65 ........ (if (e
3300: 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 q? this-step-sta
3310: 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 70 tus 'warn) "Logp
3320: 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e 64 ro warning found
3330: 22 20 23 66 29 0a 09 09 09 09 09 09 09 09 09 20 " #f)..........
3340: 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 28 #f))........ ((
3350: 70 61 73 73 29 0a 09 09 09 09 09 09 09 20 20 28 pass)........ (
3360: 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 tests:test-set-s
3370: 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 6e tatus! test-id n
3380: 65 78 74 2d 73 74 61 74 65 20 22 50 41 53 53 22 ext-state "PASS"
3390: 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 09 #f #f))........
33a0: 20 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c 0a (else ;; 'fail.
33b0: 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 72 ....... (set! r
33c0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 20 ollup-status 1)
33d0: 3b 3b 20 66 6f 72 63 65 20 66 61 69 6c 0a 09 09 ;; force fail...
33e0: 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 65 ..... (tests:te
33f0: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
3400: 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 74 est-id next-stat
3410: 65 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 22 e "FAIL" (conc "
3420: 46 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 22 Failed at step "
3430: 20 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a 09 stepname) #f)..
3440: 09 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 09 ...... ))))....
3450: 09 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 28 ... (if (and (
3460: 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c 6f steprun-good? lo
3470: 67 70 72 6f 2d 75 73 65 64 20 28 76 65 63 74 6f gpro-used (vecto
3480: 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 r-ref exit-info
3490: 32 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 28 2))........ (
34a0: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 not (null? tal))
34b0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
34c0: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 28 loop (car tal) (
34d0: 63 64 72 20 74 61 6c 29 20 73 74 65 70 6e 61 6d cdr tal) stepnam
34e0: 65 29 29 29 0a 09 09 09 09 09 09 20 28 64 65 62 e)))....... (deb
34f0: 75 67 3a 70 72 69 6e 74 20 34 20 22 57 41 52 4e ug:print 4 "WARN
3500: 49 4e 47 3a 20 61 20 70 72 69 6f 72 20 73 74 65 ING: a prior ste
3510: 70 20 66 61 69 6c 65 64 2c 20 73 74 6f 70 70 69 p failed, stoppi
3520: 6e 67 20 61 74 20 22 20 65 7a 73 74 65 70 29 29 ng at " ezstep))
3530: 29 29 29 29 29 29 0a 09 09 20 28 6d 6f 6e 69 74 ))))))... (monit
3540: 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 20 orjob (lambda
3550: 28 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 28 ()..... (let* ((
3560: 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 63 start-seconds (c
3570: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
3580: 0a 09 09 09 09 09 28 63 61 6c 63 2d 6d 69 6e 75 ......(calc-minu
3590: 74 65 73 20 20 28 6c 61 6d 62 64 61 20 28 29 0a tes (lambda ().
35a0: 09 09 09 09 09 09 09 20 28 69 6e 65 78 61 63 74 ....... (inexact
35b0: 2d 3e 65 78 61 63 74 20 0a 09 09 09 09 09 09 09 ->exact ........
35c0: 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 09 09 (round .......
35d0: 09 20 20 20 28 2d 20 0a 09 09 09 09 09 09 09 20 . (- ........
35e0: 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (current-seco
35f0: 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 20 nds) ........
3600: 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 29 start-seconds))
3610: 29 29 29 0a 09 09 09 09 09 28 6b 69 6c 6c 2d 74 )))......(kill-t
3620: 72 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 20 ries 0)).....
3630: 28 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c 2d (tests:set-full-
3640: 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 73 meta-info #f tes
3650: 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 6c t-id run-id (cal
3660: 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b 2d c-minutes) work-
3670: 61 72 65 61 29 0a 09 09 09 09 20 20 20 28 6c 65 area)..... (le
3680: 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 65 73 t loop ((minutes
3690: 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 73 (calc-minutes
36a0: 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 62 65 )))..... (be
36b0: 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 20 28 gin..... (
36c0: 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 28 set! kill-job? (
36d0: 6f 72 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 6c or (test-get-kil
36e0: 6c 2d 72 65 71 75 65 73 74 20 74 65 73 74 2d 69 l-request test-i
36f0: 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 73 d) ;; run-id tes
3700: 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 29 t-name itemdat))
3710: 0a 09 09 09 09 09 09 09 20 20 20 28 61 6e 64 20 ........ (and
3720: 72 75 6e 74 6c 69 6d 20 28 6c 65 74 2a 20 28 28 runtlim (let* ((
3730: 72 75 6e 2d 73 65 63 6f 6e 64 73 20 20 20 28 2d run-seconds (-
3740: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
3750: 73 29 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 s) start-seconds
3760: 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 ))..........
3770: 20 20 20 28 74 69 6d 65 2d 65 78 63 65 65 64 65 (time-exceede
3780: 64 20 28 3e 20 72 75 6e 2d 73 65 63 6f 6e 64 73 d (> run-seconds
3790: 20 72 75 6e 74 6c 69 6d 29 29 29 0a 09 09 09 09 runtlim))).....
37a0: 09 09 09 09 09 20 20 28 69 66 20 74 69 6d 65 2d ..... (if time-
37b0: 65 78 63 65 65 64 65 64 0a 09 09 09 09 09 09 09 exceeded........
37c0: 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a 09 .. (begin..
37d0: 09 09 09 09 09 09 09 09 09 28 64 65 62 75 67 3a .........(debug:
37e0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 4b 49 print-info 0 "KI
37f0: 4c 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 54 LLING TEST DUE T
3800: 4f 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 43 O TIME LIMIT EXC
3810: 45 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d 22 EEDED! Runtime="
3820: 20 72 75 6e 2d 73 65 63 6f 6e 64 73 20 22 20 73 run-seconds " s
3830: 65 63 6f 6e 64 73 2c 20 6c 69 6d 69 74 3d 22 20 econds, limit="
3840: 72 75 6e 74 6c 69 6d 29 0a 09 09 09 09 09 09 09 runtlim)........
3850: 09 09 09 23 74 29 0a 09 09 09 09 09 09 09 09 09 ...#t)..........
3860: 20 20 20 20 20 20 23 66 29 29 29 29 29 0a 09 09 #f)))))...
3870: 09 09 20 20 20 20 20 20 20 3b 3b 20 6f 70 65 6e .. ;; open
3880: 2d 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f 74 20 6e -run-close not n
3890: 65 65 64 65 64 20 66 6f 72 20 74 65 73 74 2d 73 eeded for test-s
38a0: 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 09 09 et-meta-info....
38b0: 09 20 20 20 20 20 20 20 28 74 65 73 74 73 3a 73 . (tests:s
38c0: 65 74 2d 70 61 72 74 69 61 6c 2d 6d 65 74 61 2d et-partial-meta-
38d0: 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 20 info #f test-id
38e0: 72 75 6e 2d 69 64 20 6d 69 6e 75 74 65 73 20 77 run-id minutes w
38f0: 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 20 20 ork-area).....
3900: 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a 6f (if kill-jo
3910: 62 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 67 b? ...... (beg
3920: 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 in...... (mu
3930: 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 09 tex-lock! m)....
3940: 09 09 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a 20 .. ;; NOTE:
3950: 54 68 65 20 70 69 64 20 63 61 6e 20 63 68 61 6e The pid can chan
3960: 67 65 20 61 73 20 64 69 66 66 65 72 65 6e 74 20 ge as different
3970: 73 74 65 70 73 20 61 72 65 20 72 75 6e 2e 20 44 steps are run. D
3980: 6f 20 77 65 20 6e 65 65 64 20 68 61 6e 64 73 68 o we need handsh
3990: 61 6b 69 6e 67 20 62 65 74 77 65 65 6e 20 74 68 aking between th
39a0: 69 73 0a 09 09 09 09 09 20 20 20 20 20 3b 3b 20 is...... ;;
39b0: 20 20 20 20 20 20 73 65 63 74 69 6f 6e 20 61 6e section an
39c0: 64 20 74 68 65 20 72 75 6e 69 74 20 73 65 63 74 d the runit sect
39d0: 69 6f 6e 3f 20 4f 72 20 61 64 64 20 61 20 6c 6f ion? Or add a lo
39e0: 6f 70 20 74 68 61 74 20 74 72 69 65 73 20 74 68 op that tries th
39f0: 72 65 65 20 74 69 6d 65 73 20 77 69 74 68 20 61 ree times with a
3a00: 20 31 2f 34 20 73 65 63 6f 6e 64 0a 09 09 09 09 1/4 second.....
3a10: 09 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 62 . ;; b
3a20: 65 74 77 65 65 6e 20 74 72 69 65 73 3f 0a 09 09 etween tries?...
3a30: 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ... (let* ((
3a40: 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 20 pid (vector-ref
3a50: 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a 09 exit-info 0)))..
3a60: 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 28 .... (if (
3a70: 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 09 number? pid)....
3a80: 09 09 09 20 20 20 28 70 72 6f 63 65 73 73 2d 73 ... (process-s
3a90: 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 6c ignal pid signal
3aa0: 2f 6b 69 6c 6c 29 0a 09 09 09 09 09 09 20 20 20 /kill).......
3ab0: 3b 3b 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 ;; (begin.......
3ac0: 20 20 20 3b 3b 20 20 20 28 64 65 62 75 67 3a 70 ;; (debug:p
3ad0: 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a rint 0 "WARNING:
3ae0: 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 65 Request receive
3af0: 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 61 d to kill job (a
3b00: 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c 2d ttempt # " kill-
3b10: 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 09 tries ")")......
3b20: 09 20 20 20 3b 3b 20 20 20 28 6c 65 74 20 28 28 . ;; (let ((
3b30: 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d 72 processes (cmd-r
3b40: 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 22 un->list (conc "
3b50: 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 69 pgrep -l -P " pi
3b60: 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 3b d))))....... ;
3b70: 3b 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 ; (for-each
3b80: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 ....... ;;
3b90: 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 09 (lambda (p)...
3ba0: 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 20 .... ;;
3bb0: 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 20 (let* ((parts
3bc0: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 29 (string-split p)
3bd0: 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 )....... ;;
3be0: 20 20 20 09 20 28 70 2d 69 64 20 20 20 28 69 66 . (p-id (if
3bf0: 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 74 (> (length part
3c00: 73 29 20 30 29 0a 09 09 09 09 09 09 20 20 20 3b s) 0)....... ;
3c10: 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28 73 ; .. (s
3c20: 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 tring->number (c
3c30: 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 09 09 ar parts))......
3c40: 09 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 20 . ;; ..
3c50: 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 20 #f))).......
3c60: 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 28 69 ;; (i
3c70: 66 20 70 2d 69 64 0a 09 09 09 09 09 09 20 20 20 f p-id.......
3c80: 3b 3b 20 20 20 20 20 20 09 28 62 65 67 69 6e 0a ;; .(begin.
3c90: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 ...... ;;
3ca0: 20 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 . (debug:print
3cb0: 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 63 0 "Killing " (c
3cc0: 61 64 72 20 70 61 72 74 73 29 20 22 3b 20 6b 69 adr parts) "; ki
3cd0: 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 0a 09 ll -9 " p-id)..
3ce0: 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 ..... ;;
3cf0: 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 . (system (conc
3d00: 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 64 "kill -9 " p-id
3d10: 29 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 )))))).......
3d20: 3b 3b 20 20 20 20 20 20 28 63 61 72 20 70 72 6f ;; (car pro
3d30: 63 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 20 cesses)).......
3d40: 20 20 3b 3b 20 20 20 20 20 28 73 79 73 74 65 6d ;; (system
3d50: 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 20 (conc "kill -9
3d60: 2d 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 09 -" pid))))......
3d70: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 09 . (begin......
3d80: 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 . (debug:pri
3d90: 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 52 nt 0 "WARNING: R
3da0: 65 71 75 65 73 74 20 72 65 63 65 69 76 65 64 20 equest received
3db0: 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 75 74 20 to kill job but
3dc0: 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 70 72 6f problem with pro
3dd0: 63 65 73 73 2c 20 61 74 74 65 6d 70 74 69 6e 67 cess, attempting
3de0: 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 67 65 72 to kill manager
3df0: 20 70 72 6f 63 65 73 73 22 29 0a 09 09 09 09 09 process")......
3e00: 09 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 . (tests:tes
3e10: 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 t-set-status! te
3e20: 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 20 st-id "KILLED"
3e30: 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09 20 "FAIL".........
3e40: 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (args:get-ar
3e50: 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 09 g "-m") #f).....
3e60: 09 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a .. (sqlite3:
3e70: 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a 09 finalize! tdb)..
3e80: 09 09 09 09 09 20 20 20 20 20 28 65 78 69 74 20 ..... (exit
3e90: 31 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 20 1))))......
3ea0: 28 73 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 73 (set! kill-tries
3eb0: 20 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 73 (+ 1 kill-tries
3ec0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 6d 75 ))...... (mu
3ed0: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 29 tex-unlock! m)))
3ee0: 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 28 ..... ;; (
3ef0: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
3f00: 21 20 64 62 29 0a 09 09 09 09 20 20 20 20 20 20 ! db).....
3f10: 20 28 69 66 20 6b 65 65 70 2d 67 6f 69 6e 67 0a (if keep-going.
3f20: 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a 09 ..... (begin..
3f30: 09 09 09 09 20 20 20 20 20 28 74 68 72 65 61 64 .... (thread
3f40: 2d 73 6c 65 65 70 21 20 33 29 20 3b 3b 20 28 2b -sleep! 3) ;; (+
3f50: 20 33 20 28 72 61 6e 64 6f 6d 20 36 29 29 29 20 3 (random 6)))
3f60: 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 74 ;; add some jitt
3f70: 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 68 er to the call h
3f80: 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 65 ome time to spre
3f90: 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 63 ad out the db ac
3fa0: 63 65 73 73 65 73 0a 09 09 09 09 09 20 20 20 20 cesses......
3fb0: 20 28 69 66 20 6b 65 65 70 2d 67 6f 69 6e 67 0a (if keep-going.
3fc0: 09 09 09 09 09 09 20 28 6c 6f 6f 70 20 28 63 61 ...... (loop (ca
3fd0: 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 29 29 lc-minutes))))))
3fe0: 29 29 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 43 68 )))) ;; NOTE: Ch
3ff0: 65 63 6b 69 6e 67 20 74 77 69 63 65 20 66 6f 72 ecking twice for
4000: 20 6b 65 65 70 2d 67 6f 69 6e 67 20 69 73 20 69 keep-going is i
4010: 6e 74 65 6e 74 69 6f 6e 61 6c 0a 09 09 20 28 74 ntentional... (t
4020: 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b h1 (mak
4030: 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f 72 e-thread monitor
4040: 6a 6f 62 20 22 6d 6f 6e 69 74 6f 72 20 6a 6f 62 job "monitor job
4050: 22 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 20 "))... (th2
4060: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
4070: 64 20 72 75 6e 69 74 20 22 72 75 6e 20 6a 6f 62 d runit "run job
4080: 22 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 20 "))).. (set!
4090: 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 0a job-thread th2).
40a0: 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 . (thread-sta
40b0: 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 28 74 rt! th1).. (t
40c0: 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 32 hread-start! th2
40d0: 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 6a ).. (thread-j
40e0: 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 20 20 28 oin! th2).. (
40f0: 73 65 74 21 20 6b 65 65 70 2d 67 6f 69 6e 67 20 set! keep-going
4100: 23 66 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 #f).. (thread
4110: 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 09 20 20 20 -join! th1)..
4120: 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 65 ;; (thread-slee
4130: 70 21 20 31 29 0a 09 20 20 20 20 3b 3b 20 28 74 p! 1).. ;; (t
4140: 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 74 65 21 hread-terminate!
4150: 20 74 68 31 29 20 3b 3b 20 4e 6f 74 20 73 75 72 th1) ;; Not sur
4160: 65 20 69 66 20 74 68 69 73 20 69 73 20 61 20 67 e if this is a g
4170: 6f 6f 64 20 69 64 65 61 0a 09 20 20 20 20 28 74 ood idea.. (t
4180: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 20 hread-sleep! 1)
4190: 20 20 20 20 20 20 3b 3b 20 67 69 76 65 20 74 68 ;; give th
41a0: 72 65 61 64 20 74 68 31 20 61 20 63 68 61 6e 63 read th1 a chanc
41b0: 65 20 74 6f 20 62 65 20 64 6f 6e 65 20 54 4f 44 e to be done TOD
41c0: 4f 3a 20 56 65 72 69 66 79 20 74 68 69 73 20 69 O: Verify this i
41d0: 73 20 6e 65 65 64 65 64 2e 20 41 74 20 30 2e 31 s needed. At 0.1
41e0: 20 49 20 77 61 73 20 67 65 74 74 69 6e 67 20 66 I was getting f
41f0: 61 69 6c 20 74 6f 20 73 74 6f 70 2c 20 69 6e 63 ail to stop, inc
4200: 72 65 61 73 65 64 20 74 6f 20 74 6f 74 61 6c 20 reased to total
4210: 6f 66 20 31 2e 31 20 73 65 63 2e 0a 09 20 20 20 of 1.1 sec...
4220: 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 (mutex-lock! m)
4230: 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 74 .. (let* ((it
4240: 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 em-path (item-li
4250: 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 74 st->path itemdat
4260: 29 29 0a 09 09 20 20 20 28 74 65 73 74 69 6e 66 ))... (testinf
4270: 6f 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 74 o (cdb:get-test
4280: 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 6e -info-by-id *run
4290: 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 29 remote* test-id)
42a0: 29 29 20 3b 3b 20 29 29 20 3b 3b 20 72 75 6e 2d )) ;; )) ;; run-
42b0: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
42c0: 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 20 m-path)))..
42d0: 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 ;; Am I complet
42e0: 65 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 28 ed?.. (if (
42f0: 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 2d member (db:test-
4300: 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e get-state testin
4310: 66 6f 29 20 27 28 22 52 45 4d 4f 54 45 48 4f 53 fo) '("REMOTEHOS
4320: 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e 47 TSTART" "RUNNING
4330: 22 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 49 74 20 ")) ;; NOTE: It
4340: 73 68 6f 75 6c 64 20 2a 6e 6f 74 2a 20 62 65 20 should *not* be
4350: 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 20 REMOTEHOSTSTART
4360: 62 75 74 20 66 6f 72 20 72 65 61 73 6f 6e 73 20 but for reasons
4370: 49 20 64 6f 6e 27 74 20 79 65 74 20 75 6e 64 65 I don't yet unde
4380: 72 73 74 61 6e 64 20 69 74 20 73 6f 6d 65 74 69 rstand it someti
4390: 6d 65 73 20 67 65 74 73 20 73 74 75 63 6b 20 69 mes gets stuck i
43a0: 6e 20 74 68 61 74 20 73 74 61 74 65 20 3b 3b 20 n that state ;;
43b0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
43c0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
43d0: 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c testinfo) "COMPL
43e0: 45 54 45 44 22 29 29 0a 09 09 20 20 28 6c 65 74 ETED"))... (let
43f0: 20 28 28 6e 65 77 2d 73 74 61 74 65 20 20 28 69 ((new-state (i
4400: 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 4c f kill-job? "KIL
4410: 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 LED" "COMPLETED"
4420: 29 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 28 76 ) ;; (if (eq? (v
4430: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
4440: 6e 66 6f 20 32 29 20 30 29 20 3b 3b 20 65 78 69 nfo 2) 0) ;; exi
4450: 74 65 64 20 77 69 74 68 20 22 67 6f 6f 64 22 20 ted with "good"
4460: 73 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 20 status.....
4470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 3b 3b 20 22 43 4f 4d 50 4c 45 54 45 44 ;; "COMPLETED
44a0: 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 20 "........
44b0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 62 3a ;; (db:
44c0: 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 74 test-get-state t
44d0: 65 73 74 69 6e 66 6f 29 29 29 20 20 20 3b 3b 20 estinfo))) ;;
44e0: 65 6c 73 65 20 70 72 65 73 65 76 65 20 74 68 65 else preseve the
44f0: 20 73 74 61 74 65 20 61 73 20 73 65 74 20 77 69 state as set wi
4500: 74 68 69 6e 20 74 68 65 20 74 65 73 74 0a 09 09 thin the test...
4510: 09 09 20 20 20 20 29 0a 09 09 09 28 6e 65 77 2d .. )....(new-
4520: 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 status (cond....
4530: 09 20 20 20 20 20 28 28 6e 6f 74 20 28 76 65 63 . ((not (vec
4540: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
4550: 6f 20 31 29 29 20 22 46 41 49 4c 22 29 20 3b 3b o 1)) "FAIL") ;;
4560: 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 72 job failed to r
4570: 75 6e 0a 09 09 09 09 20 20 20 20 20 28 28 65 71 un..... ((eq
4580: 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 ? rollup-status
4590: 30 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 20 0)..... ;;
45a0: 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 73 if the current s
45b0: 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 68 tatus is AUTO th
45c0: 65 6e 20 64 65 66 65 72 20 74 6f 20 74 68 65 20 en defer to the
45d0: 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 65 calculated value
45e0: 20 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 69 (i.e. leave thi
45f0: 73 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 20 s AUTO).....
4600: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 64 (if (equal? (d
4610: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
4620: 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 54 s testinfo) "AUT
4630: 4f 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 53 O") "AUTO" "PASS
4640: 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 65 "))..... ((e
4650: 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 q? rollup-status
4660: 20 31 29 20 22 46 41 49 4c 22 29 0a 09 09 09 09 1) "FAIL").....
4670: 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 ((eq? rollu
4680: 70 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 09 p-status 2).....
4690: 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 20 ;; if the
46a0: 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 69 current status i
46b0: 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 72 s AUTO the defer
46c0: 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 74 to the calculat
46d0: 65 64 20 76 61 6c 75 65 20 62 75 74 20 71 75 61 ed value but qua
46e0: 6c 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 20 lify (i.e. make
46f0: 74 68 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 0a this AUTO-WARN).
4700: 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 65 .... (if (e
4710: 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 qual? (db:test-g
4720: 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 6e et-status testin
4730: 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 54 fo) "AUTO") "AUT
4740: 4f 2d 57 41 52 4e 22 20 22 57 41 52 4e 22 29 29 O-WARN" "WARN"))
4750: 0a 09 09 09 09 20 20 20 20 20 28 65 6c 73 65 20 ..... (else
4760: 22 46 41 49 4c 22 29 29 29 29 20 3b 3b 20 28 64 "FAIL")))) ;; (d
4770: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 75 b:test-get-statu
4780: 73 20 74 65 73 74 69 6e 66 6f 29 29 29 0a 09 09 s testinfo)))...
4790: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
47a0: 2d 69 6e 66 6f 20 31 20 22 54 65 73 74 20 65 78 -info 1 "Test ex
47b0: 69 74 65 64 20 69 6e 20 73 74 61 74 65 3d 22 20 ited in state="
47c0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
47d0: 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 2c 20 te testinfo) ",
47e0: 73 65 74 74 69 6e 67 20 73 74 61 74 65 2f 73 74 setting state/st
47f0: 61 74 75 73 20 62 61 73 65 64 20 6f 6e 20 65 78 atus based on ex
4800: 69 74 20 63 6f 64 65 20 6f 66 20 22 20 28 76 65 it code of " (ve
4810: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4820: 66 6f 20 31 29 20 22 20 61 6e 64 20 72 6f 6c 6c fo 1) " and roll
4830: 75 70 2d 73 74 61 74 75 73 20 6f 66 20 22 20 72 up-status of " r
4840: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 09 ollup-status)...
4850: 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 2d (tests:test-
4860: 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 74 set-status! test
4870: 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 6e 65 -id ...... ne
4880: 77 2d 73 74 61 74 65 0a 09 09 09 09 09 20 20 20 w-state......
4890: 20 6e 65 77 2d 73 74 61 74 75 73 0a 09 09 09 09 new-status.....
48a0: 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 . (args:get-a
48b0: 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 20 rg "-m") #f)...
48c0: 20 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 75 70 ;; need to up
48d0: 64 61 74 65 20 74 68 65 20 74 6f 70 20 74 65 73 date the top tes
48e0: 74 20 72 65 63 6f 72 64 20 69 66 20 50 41 53 53 t record if PASS
48f0: 20 6f 72 20 46 41 49 4c 20 61 6e 64 20 74 68 69 or FAIL and thi
4900: 73 20 69 73 20 61 20 73 75 62 74 65 73 74 0a 09 s is a subtest..
4910: 09 20 20 20 20 3b 3b 20 4e 4f 20 4e 45 45 44 20 . ;; NO NEED
4920: 54 4f 20 43 41 4c 4c 20 72 6f 6c 6c 2d 75 70 2d TO CALL roll-up-
4930: 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
4940: 20 48 45 52 45 2c 20 54 48 49 53 20 49 53 20 44 HERE, THIS IS D
4950: 4f 4e 45 20 49 4e 20 72 6f 6c 6c 2d 75 70 2d 70 ONE IN roll-up-p
4960: 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 20 ass-fail-counts
4970: 63 61 6c 6c 65 64 20 62 79 20 74 65 73 74 73 3a called by tests:
4980: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
4990: 0a 09 09 20 20 20 20 3b 3b 20 28 69 66 20 28 6e ... ;; (if (n
49a0: 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d ot (equal? item-
49b0: 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 20 20 path ""))...
49c0: 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 ;; (begin...
49d0: 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 74 68 ;; (th
49e0: 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 31 29 read-sleep! 0.1)
49f0: 20 3b 3b 20 67 69 76 65 20 6f 74 68 65 72 20 70 ;; give other p
4a00: 72 6f 63 65 73 73 65 73 20 61 6e 20 6f 70 70 6f rocesses an oppo
4a10: 72 74 75 6e 69 74 79 20 74 6f 20 61 63 63 65 73 rtunity to acces
4a20: 73 20 74 68 65 20 64 62 20 61 73 20 72 6f 6c 6c s the db as roll
4a30: 75 70 20 69 73 20 6c 6f 77 65 72 20 70 72 69 6f up is lower prio
4a40: 72 69 74 79 0a 09 09 20 20 20 20 3b 3b 20 20 20 rity... ;;
4a50: 20 20 20 20 28 63 64 62 3a 72 6f 6c 6c 2d 75 70 (cdb:roll-up
4a60: 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 -pass-fail-count
4a70: 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 s *runremote* ru
4a80: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
4a90: 74 65 6d 2d 70 61 74 68 20 6e 65 77 2d 73 74 61 tem-path new-sta
4aa0: 74 75 73 29 29 29 0a 09 09 20 20 20 20 29 29 0a tus)))... )).
4ab0: 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 . ;; for au
4ac0: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
4ad0: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
4ae0: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
4af0: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
4b00: 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 .. (if (not
4b10: 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 (equal? item-pa
4b20: 74 68 20 22 22 29 29 0a 09 09 20 20 28 74 65 73 th ""))... (tes
4b30: 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 65 ts:summarize-ite
4b40: 6d 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 73 ms #f run-id tes
4b50: 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 t-id test-name #
4b60: 66 29 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f f))) ;; don't fo
4b70: 72 63 65 20 2d 20 6a 75 73 74 20 75 70 64 61 74 rce - just updat
4b80: 65 20 69 66 20 6e 6f 0a 09 20 20 20 20 28 6d 75 e if no.. (mu
4b90: 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a 09 tex-unlock! m)..
4ba0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
4bb0: 20 32 20 22 4f 75 74 70 75 74 20 66 72 6f 6d 20 2 "Output from
4bc0: 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c 72 75 running " fullru
4bd0: 6e 73 63 72 69 70 74 20 22 2c 20 70 69 64 20 22 nscript ", pid "
4be0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
4bf0: 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 6e 20 77 t-info 0) " in w
4c00: 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 20 ork area " ....
4c10: 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d 3d work-area ":\n==
4c20: 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 22 ==\n exit code "
4c30: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 (vector-ref exi
4c40: 74 2d 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 22 t-info 2) "\n" "
4c50: 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 28 69 ====\n").. (i
4c60: 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d 72 f (not (vector-r
4c70: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 29 ef exit-info 1))
4c80: 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 29 29 ...(exit 4))))))
4c90: 29 0a 0a 3b 3b 20 73 65 74 20 75 70 20 74 68 65 )..;; set up the
4ca0: 20 76 65 72 79 20 62 61 73 69 63 73 20 6e 65 65 very basics nee
4cb0: 64 65 64 20 66 6f 72 20 64 6f 69 6e 67 20 61 6e ded for doing an
4cc0: 79 74 68 69 6e 67 20 68 65 72 65 2e 0a 28 64 65 ything here..(de
4cd0: 66 69 6e 65 20 28 73 65 74 75 70 2d 66 6f 72 2d fine (setup-for-
4ce0: 72 75 6e 29 0a 20 20 3b 3b 20 77 6f 75 6c 64 20 run). ;; would
4cf0: 73 65 74 20 76 61 6c 75 65 73 20 66 6f 72 20 4b set values for K
4d00: 45 59 53 20 69 6e 20 74 68 65 20 65 6e 76 69 72 EYS in the envir
4d10: 6f 6e 6d 65 6e 74 20 68 65 72 65 20 66 6f 72 20 onment here for
4d20: 62 65 74 74 65 72 20 73 75 70 70 6f 72 74 20 6f better support o
4d30: 66 20 65 6e 76 2d 6f 76 65 72 72 69 64 65 20 62 f env-override b
4d40: 75 74 20 0a 20 20 3b 3b 20 68 61 76 65 20 63 68 ut . ;; have ch
4d50: 69 63 6b 65 6e 2f 65 67 67 20 73 63 65 6e 61 72 icken/egg scenar
4d60: 69 6f 2e 20 6e 65 65 64 20 74 6f 20 72 65 61 64 io. need to read
4d70: 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 megatest.config
4d80: 20 74 68 65 6e 20 72 65 61 64 20 69 74 20 61 67 then read it ag
4d90: 61 69 6e 2e 20 47 6f 69 6e 67 20 74 6f 20 0a 20 ain. Going to .
4da0: 20 3b 3b 20 70 61 73 73 20 6f 6e 20 74 68 61 74 ;; pass on that
4db0: 20 69 64 65 61 20 66 6f 72 20 6e 6f 77 0a 20 20 idea for now.
4dc0: 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 0a ;; special case.
4dd0: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash
4de0: 2d 74 61 62 6c 65 3f 20 2a 63 6f 6e 66 69 67 64 -table? *configd
4df0: 61 74 2a 29 29 20 20 3b 3b 20 6e 6f 20 6e 65 65 at*)) ;; no nee
4e00: 64 20 74 6f 20 72 65 2d 6f 70 65 6e 20 6f 6e 20 d to re-open on
4e10: 65 76 65 72 79 20 63 61 6c 6c 0a 20 20 20 20 20 every call.
4e20: 20 28 62 65 67 69 6e 0a 09 28 73 65 74 21 20 2a (begin..(set! *
4e30: 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 6e configinfo* (fin
4e40: 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 69 d-and-read-confi
4e50: 67 20 0a 09 09 09 20 20 20 20 28 69 66 20 28 61 g .... (if (a
4e60: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 6f rgs:get-arg "-co
4e70: 6e 66 69 67 22 29 28 61 72 67 73 3a 67 65 74 2d nfig")(args:get-
4e80: 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 22 arg "-config") "
4e90: 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 22 megatest.config"
4ea0: 29 0a 09 09 09 20 20 20 20 65 6e 76 69 72 6f 6e ).... environ
4eb0: 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 72 -patt: "env-over
4ec0: 72 69 64 65 22 0a 09 09 09 20 20 20 20 67 69 76 ride".... giv
4ed0: 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 65 74 en-toppath: (get
4ee0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
4ef0: 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 52 iable "MT_RUN_AR
4f00: 45 41 5f 48 4f 4d 45 22 29 0a 09 09 09 20 20 20 EA_HOME")....
4f10: 20 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d 54 pathenvvar: "MT
4f20: 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 29 _RUN_AREA_HOME")
4f30: 29 0a 09 28 73 65 74 21 20 2a 63 6f 6e 66 69 67 )..(set! *config
4f40: 64 61 74 2a 20 20 28 69 66 20 28 63 61 72 20 2a dat* (if (car *
4f50: 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 72 configinfo*)(car
4f60: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 23 *configinfo*) #
4f70: 66 29 29 0a 09 28 73 65 74 21 20 2a 74 6f 70 70 f))..(set! *topp
4f80: 61 74 68 2a 20 20 20 20 28 69 66 20 28 63 61 72 ath* (if (car
4f90: 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 *configinfo*)(c
4fa0: 61 64 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a adr *configinfo*
4fb0: 29 20 23 66 29 29 0a 09 28 69 66 20 2a 74 6f 70 ) #f))..(if *top
4fc0: 70 61 74 68 2a 0a 09 20 20 20 20 28 73 65 74 65 path*.. (sete
4fd0: 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 5f nv "MT_RUN_AREA_
4fe0: 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a 29 HOME" *toppath*)
4ff0: 20 3b 3b 20 74 6f 20 62 65 20 64 65 70 72 65 63 ;; to be deprec
5000: 61 74 65 64 0a 09 20 20 20 20 28 64 65 62 75 67 ated.. (debug
5010: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
5020: 20 66 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 20 failed to find
5030: 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 6f 20 the top path to
5040: 79 6f 75 72 20 4d 65 67 61 74 65 73 74 20 61 72 your Megatest ar
5050: 65 61 2e 22 29 29 29 29 0a 20 20 2a 74 6f 70 70 ea.")))). *topp
5060: 61 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 20 28 ath*)..(define (
5070: 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 63 6f get-best-disk co
5080: 6e 66 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 28 nfdat). (let* (
5090: 28 64 69 73 6b 73 20 20 20 20 28 68 61 73 68 2d (disks (hash-
50a0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
50b0: 74 20 63 6f 6e 66 64 61 74 20 22 64 69 73 6b 73 t confdat "disks
50c0: 22 20 23 66 29 29 0a 09 20 28 62 65 73 74 20 20 " #f)).. (best
50d0: 20 20 20 23 66 29 0a 09 20 28 62 65 73 74 73 69 #f).. (bestsi
50e0: 7a 65 20 30 29 29 0a 20 20 20 20 28 69 66 20 64 ze 0)). (if d
50f0: 69 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 63 68 isks ..(for-each
5100: 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 69 73 .. (lambda (dis
5110: 6b 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 74 2a k-num).. (let*
5120: 20 28 28 64 69 72 70 61 74 68 20 20 20 20 28 63 ((dirpath (c
5130: 61 64 72 20 28 61 73 73 6f 63 20 64 69 73 6b 2d adr (assoc disk-
5140: 6e 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 09 20 num disks)))...
5150: 20 28 66 72 65 65 73 70 63 20 20 20 20 28 69 66 (freespc (if
5160: 20 28 61 6e 64 20 28 64 69 72 65 63 74 6f 72 79 (and (directory
5170: 3f 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 20 ? dirpath).....
5180: 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 74 (file-writ
5190: 65 2d 61 63 63 65 73 73 3f 20 64 69 72 70 61 74 e-access? dirpat
51a0: 68 29 29 0a 09 09 09 09 20 20 28 67 65 74 2d 64 h))..... (get-d
51b0: 66 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 20 f dirpath).....
51c0: 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 (begin.....
51d0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
51e0: 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 22 20 WARNING: path "
51f0: 64 69 72 70 61 74 68 20 22 20 69 6e 20 5b 64 69 dirpath " in [di
5200: 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e 6f 74 sks] section not
5210: 20 76 61 6c 69 64 20 6f 72 20 77 72 69 74 61 62 valid or writab
5220: 6c 65 22 29 0a 09 09 09 09 20 20 20 20 30 29 29 le")..... 0))
5230: 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 3e 20 )).. (if (>
5240: 66 72 65 65 73 70 63 20 62 65 73 74 73 69 7a 65 freespc bestsize
5250: 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 )... (begin...
5260: 20 28 73 65 74 21 20 62 65 73 74 20 20 20 20 20 (set! best
5270: 64 69 72 70 61 74 68 29 0a 09 09 20 20 20 28 73 dirpath)... (s
5280: 65 74 21 20 62 65 73 74 73 69 7a 65 20 66 72 65 et! bestsize fre
5290: 65 73 70 63 29 29 29 29 29 0a 09 20 28 6d 61 70 espc))))).. (map
52a0: 20 63 61 72 20 64 69 73 6b 73 29 29 29 0a 20 20 car disks))).
52b0: 20 20 28 69 66 20 62 65 73 74 0a 09 62 65 73 74 (if best..best
52c0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 ..(begin.. (deb
52d0: 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f ug:print 0 "ERRO
52e0: 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 73 6b R: No valid disk
52f0: 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 61 74 s found in megat
5300: 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c 65 61 est.config. Plea
5310: 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f 20 79 se add some to y
5320: 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 63 74 our [disks] sect
5330: 69 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 20 31 ion").. (exit 1
5340: 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 72 65 )))))..;; Desire
5350: 64 20 64 69 72 65 63 74 6f 72 79 20 73 74 72 75 d directory stru
5360: 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 3c 6c cture:.;;.;; <l
5370: 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 65 inkdir> - <targe
5380: 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e 20 t> - <testname>
5390: 2d 2e 0a 3b 3b 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: 20 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b 20 20 |.;;
53c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53e0: 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 69 72 v.;; <rundir
53f0: 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 3e 20 20 > - <target>
5400: 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 3e 20 - <testname>
5410: 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 73 29 -|- <itempath(s)
5420: 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 74 6f >.;;.;; dir sto
5430: 72 65 64 20 69 6e 20 74 65 73 74 20 69 73 3a 0a red in test is:.
5440: 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 72 ;; .;; <linkdir
5450: 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 3c > - <target> - <
5460: 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 testname> [ - <i
5470: 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 0a 3b tempath> ].;; .;
5480: 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 20 6c ; All log file l
5490: 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 20 73 inks should be s
54a0: 74 6f 72 65 64 20 72 65 6c 61 74 69 76 65 20 74 tored relative t
54b0: 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 6c 69 6e o the top of lin
54c0: 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b 20 3c k path.;; .;; <
54d0: 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 6e target> - <testn
54e0: 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 61 ame> [ - <itempa
54f0: 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 69 6e th> ] .;;.(defin
5500: 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 e (create-work-a
5510: 72 65 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 rea run-id run-i
5520: 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 nfo keyvals test
5530: 2d 69 64 20 74 65 73 74 2d 73 72 63 2d 70 61 74 -id test-src-pat
5540: 68 20 64 69 73 6b 2d 70 61 74 68 20 74 65 73 74 h disk-path test
5550: 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 20 name itemdat).
5560: 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 74 (let* ((item-pat
5570: 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 h (item-list->pa
5580: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 28 th itemdat)).. (
5590: 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a 67 65 74 runname (db:get
55a0: 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 -value-by-header
55b0: 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 6e (db:get-row run
55c0: 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 28 -info)...... (
55d0: 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 db:get-header ru
55e0: 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 n-info)......
55f0: 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 3b 3b "runname")).. ;;
5600: 20 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 6f convert back to
5610: 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 2d db: from rdb: -
5620: 20 74 68 69 73 20 69 73 20 61 6c 77 61 79 73 20 this is always
5630: 72 75 6e 20 61 74 20 73 65 72 76 65 72 20 65 6e run at server en
5640: 64 0a 09 20 28 74 61 72 67 65 74 20 20 20 28 73 d.. (target (s
5650: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
5660: 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 76 e (map cadr keyv
5670: 61 6c 73 29 20 22 2f 22 29 29 0a 0a 09 20 28 6e als) "/"))... (n
5680: 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 71 ot-iterated (eq
5690: 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 74 ual? "" item-pat
56a0: 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 65 h))... ;; all te
56b0: 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 74 sts are found at
56c0: 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d 62 <rundir>/test-b
56d0: 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 3e ase or <linkdir>
56e0: 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 65 /test-base.. (te
56f0: 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e 63 sttop-base (conc
5700: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
5710: 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ame "/" testname
5720: 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 20 )).. (test-base
5730: 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f 70 (conc testtop
5740: 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 74 -base (if not-it
5750: 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 erated "" "/") i
5760: 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b 3b tem-path))... ;;
5770: 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 74 nb// if itempat
5780: 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 6e h is not "" then
5790: 20 69 74 20 69 73 20 70 72 65 66 69 78 65 64 20 it is prefixed
57a0: 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 74 with "/".. (topt
57b0: 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 64 est-path (conc d
57c0: 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 73 isk-path "/" tes
57d0: 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 74 ttop-base)).. (t
57e0: 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f 6e est-path (con
57f0: 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 c disk-path "/"
5800: 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 3b test-base))... ;
5810: 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 65 78 ; ensure this ex
5820: 69 73 74 73 20 66 69 72 73 74 20 61 73 20 6c 69 ists first as li
5830: 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 73 20 nks to subtests
5840: 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 64 20 must be created
5850: 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 65 there.. (linktre
5860: 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 63 6f e (let ((rd (co
5870: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e nfig-lookup *con
5880: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
5890: 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 09 "linktree")))...
58a0: 20 20 20 20 20 20 28 69 66 20 72 64 20 72 64 20 (if rd rd
58b0: 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a 20 (conc *toppath*
58c0: 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 28 "/runs"))))... (
58d0: 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 6c lnkbase (conc l
58e0: 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 67 inktree "/" targ
58f0: 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 et "/" runname))
5900: 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 6f .. (lnkpath (co
5910: 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 74 nc lnkbase "/" t
5920: 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e 6b estname)).. (lnk
5930: 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b 70 pathf (conc lnkp
5940: 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 72 ath (if not-iter
5950: 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 65 ated "" "/") ite
5960: 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 3b m-path))).. ;
5970: 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 75 6e ; Update the run
5980: 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 20 dir path in the
5990: 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 test record for
59a0: 61 6c 6c 0a 20 20 20 20 28 63 64 62 3a 74 65 73 all. (cdb:tes
59b0: 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 2d t-set-rundir-by-
59c0: 74 65 73 74 2d 69 64 20 2a 72 75 6e 72 65 6d 6f test-id *runremo
59d0: 74 65 2a 20 74 65 73 74 2d 69 64 20 28 73 64 62 te* test-id (sdb
59e0: 3a 71 72 79 20 27 67 65 74 69 64 20 6c 6e 6b 70 :qry 'getid lnkp
59f0: 61 74 68 66 29 29 0a 0a 20 20 20 20 28 64 65 62 athf)).. (deb
5a00: 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 4f ug:print 2 "INFO
5a10: 3a 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 73 :\n lnkbas
5a20: 65 3d 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e 20 e=" lnkbase "\n
5a30: 20 20 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 20 lnkpath="
5a40: 6c 6e 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f 70 lnkpath "\n top
5a50: 74 65 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 74 test-path=" topt
5a60: 65 73 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 20 est-path "\n
5a70: 20 74 65 73 74 2d 70 61 74 68 3d 22 20 74 65 73 test-path=" tes
5a80: 74 2d 70 61 74 68 29 0a 20 20 20 20 28 69 66 20 t-path). (if
5a90: 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 74 (not (file-exist
5aa0: 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 28 s? linktree))..(
5ab0: 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 3a begin.. (debug:
5ac0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
5ad0: 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 6e : linktree did n
5ae0: 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 74 69 ot exist! Creati
5af0: 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 20 6c ng it now at " l
5b00: 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 72 65 inktree).. (cre
5b10: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 69 ate-directory li
5b20: 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b 3b 20 nktree #t))) ;;
5b30: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 6d (system (conc "m
5b40: 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 72 kdir -p " linktr
5b50: 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 72 ee)))). ;; cr
5b60: 65 61 74 65 20 74 68 65 20 64 69 72 65 63 74 6f eate the directo
5b70: 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 74 73 ry for the tests
5b80: 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 73 dir links, this
5b90: 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d 61 is needed no ma
5ba0: 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 20 tter what....
5bb0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
5bc0: 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 73 directory-exists
5bd0: 3f 20 6c 6e 6b 62 61 73 65 29 29 0a 09 20 20 20 ? lnkbase))..
5be0: 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 (not (file-exi
5bf0: 73 74 73 3f 20 6c 6e 6b 62 61 73 65 29 29 29 0a sts? lnkbase))).
5c00: 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f .(create-directo
5c10: 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 0a ry lnkbase #t)).
5c20: 20 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 61 . ;; upda
5c30: 74 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 72 te the toptest r
5c40: 65 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 6c ecord with its l
5c50: 6f 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c 20 ocation rundir,
5c60: 63 61 63 68 65 20 74 68 65 20 70 61 74 68 0a 20 cache the path.
5c70: 20 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 20 ;; This wass
5c80: 68 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 65 highly inefficie
5c90: 6e 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 65 nt, one db write
5ca0: 20 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 65 for every subte
5cb0: 73 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 0a st, potentially.
5cc0: 20 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 73 ;; thousands
5cd0: 20 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 20 of unnecessary
5ce0: 75 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 74 updates, cache t
5cf0: 68 65 20 66 61 63 74 20 69 74 20 77 61 73 20 73 he fact it was s
5d00: 65 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 74 et and don't set
5d10: 20 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 69 it . ;; agai
5d20: 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 42 20 2d n. .. ;; NB -
5d30: 20 54 68 69 73 20 69 73 20 6e 6f 74 20 77 6f 72 This is not wor
5d40: 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f 6d king right - som
5d50: 65 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 20 e top tests are
5d60: 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 20 not getting the
5d70: 70 61 74 68 20 73 65 74 21 21 21 0a 0a 20 20 20 path set!!!..
5d80: 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 2d (if (not (hash-
5d90: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
5da0: 74 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 t *toptest-paths
5db0: 2a 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 0a * testname #f)).
5dc0: 09 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e 66 .(let* ((testinf
5dd0: 6f 20 20 20 20 20 20 20 28 63 64 62 3a 67 65 74 o (cdb:get
5de0: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
5df0: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 73 *runremote* tes
5e00: 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e 2d 69 t-id)) ;; run-i
5e10: 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d d testname item-
5e20: 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 20 28 path)).. (
5e30: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 20 28 curr-test-path (
5e40: 69 66 20 74 65 73 74 69 6e 66 6f 20 28 73 64 62 if testinfo (sdb
5e50: 3a 71 72 79 20 27 67 65 74 73 74 72 20 28 64 62 :qry 'getstr (db
5e60: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 72 :test-get-rundir
5e70: 20 74 65 73 74 69 6e 66 6f 29 29 20 23 66 29 29 testinfo)) #f))
5e80: 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c 65 ).. (hash-table
5e90: 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d 70 -set! *toptest-p
5ea0: 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 63 aths* testname c
5eb0: 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a 09 urr-test-path)..
5ec0: 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 74 68 ;; NB// Was th
5ed0: 69 73 20 66 6f 72 20 74 68 65 20 74 65 73 74 20 is for the test
5ee0: 6f 72 20 66 6f 72 20 74 68 65 20 70 61 72 65 6e or for the paren
5ef0: 74 20 69 6e 20 61 6e 20 69 74 65 72 61 74 65 64 t in an iterated
5f00: 20 74 65 73 74 3f 0a 09 20 20 28 63 64 62 3a 74 test?.. (cdb:t
5f10: 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 20 est-set-rundir!
5f20: 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e 2d *runremote* run-
5f30: 69 64 20 74 65 73 74 6e 61 6d 65 20 22 22 20 28 id testname "" (
5f40: 73 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 6c sdb:qry 'getid l
5f50: 6e 6b 70 61 74 68 29 29 20 3b 3b 20 74 6f 70 74 nkpath)) ;; topt
5f60: 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 69 66 est-path).. (if
5f70: 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d 74 (or (not curr-t
5f80: 65 73 74 2d 70 61 74 68 29 0a 09 09 20 20 28 6e est-path)... (n
5f90: 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 78 ot (directory-ex
5fa0: 69 73 74 73 3f 20 74 6f 70 74 65 73 74 2d 70 61 ists? toptest-pa
5fb0: 74 68 29 29 29 0a 09 20 20 20 20 20 20 28 62 65 th))).. (be
5fc0: 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 69 gin...(debug:pri
5fd0: 6e 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 74 nt-info 2 "Creat
5fe0: 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 61 ing " toptest-pa
5ff0: 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 20 th " and link "
6000: 6c 6e 6b 70 61 74 68 29 0a 09 09 28 63 72 65 61 lnkpath)...(crea
6010: 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f 70 te-directory top
6020: 74 65 73 74 2d 70 61 74 68 20 23 74 29 0a 09 09 test-path #t)...
6030: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
6040: 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 2a *toptest-paths*
6050: 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 73 testname toptes
6060: 74 2d 70 61 74 68 29 29 29 29 29 0a 0a 20 20 20 t-path)))))..
6070: 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 74 ;; Now create t
6080: 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 65 he link from the
6090: 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 68 test path to th
60a0: 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f 77 e link tree, how
60b0: 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 74 ever. ;; if t
60c0: 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 61 he test is itera
60d0: 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 73 ted it is necess
60e0: 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 68 ary to create th
60f0: 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 20 e parent path.
6100: 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 72 ;; to the iter
6110: 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 6e ation. use pathn
6120: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f ame-directory to
6130: 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 62 trim the path b
6140: 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 76 y one. ;; lev
6150: 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 el. (if (not
6160: 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b not-iterated) ;;
6170: 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a 09 i.e. iterated..
6180: 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 2d (let ((iterated-
6190: 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 6d parent (pathnam
61a0: 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f 6e e-directory (con
61b0: 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 c lnkpath "/" it
61c0: 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 28 em-path)))).. (
61d0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
61e0: 20 32 20 22 43 72 65 61 74 69 6e 67 20 69 74 65 2 "Creating ite
61f0: 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 20 69 rated parent " i
6200: 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 29 0a terated-parent).
6210: 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 . (handle-excep
6220: 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 20 tions.. exn..
6230: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 (begin.. (
6240: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 debug:print 0 "E
6250: 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 6f RROR: Failed to
6260: 20 63 72 65 61 74 65 20 64 69 72 65 63 74 6f 72 create director
6270: 79 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 72 y " iterated-par
6280: 65 6e 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d ent ((condition-
6290: 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f property-accesso
62a0: 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 r 'exn 'message)
62b0: 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 exn) ", exiting
62c0: 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 ").. (exit 1
62d0: 29 29 0a 09 20 20 20 28 63 72 65 61 74 65 2d 64 )).. (create-d
62e0: 69 72 65 63 74 6f 72 79 20 69 74 65 72 61 74 65 irectory iterate
62f0: 64 2d 70 61 72 65 6e 74 20 23 74 29 29 29 29 0a d-parent #t)))).
6300: 0a 20 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c . (if (symbol
6310: 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 ic-link? lnkpath
6320: 29 20 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 ) ..(handle-exce
6330: 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 ptions.. exn.. (
6340: 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 begin.. (debug
6350: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6360: 20 20 46 61 69 6c 65 64 20 74 6f 20 72 65 6d 6f Failed to remo
6370: 76 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e 6b ve symlink " lnk
6380: 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e path ((condition
6390: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
63a0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
63b0: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
63c0: 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 29 g").. (exit 1)
63d0: 29 0a 09 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 ).. (delete-file
63e0: 20 6c 6e 6b 70 61 74 68 29 29 29 0a 0a 20 20 20 lnkpath)))..
63f0: 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 66 (if (not (or (f
6400: 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b 70 ile-exists? lnkp
6410: 61 74 68 29 0a 09 09 20 28 73 79 6d 62 6f 6c 69 ath)... (symboli
6420: 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 29 c-link? lnkpath)
6430: 29 29 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 65 ))..(handle-exce
6440: 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 28 ptions.. exn.. (
6450: 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 67 begin.. (debug
6460: 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a :print 0 "ERROR:
6470: 20 20 46 61 69 6c 65 64 20 74 6f 20 63 72 65 61 Failed to crea
6480: 74 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e 6b te symlink " lnk
6490: 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e path ((condition
64a0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
64b0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
64c0: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
64d0: 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 29 g").. (exit 1)
64e0: 29 0a 09 20 28 63 72 65 61 74 65 2d 73 79 6d 62 ).. (create-symb
64f0: 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 73 olic-link toptes
6500: 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 29 t-path lnkpath))
6510: 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 54 68 ). . ;; Th
6520: 65 20 74 6f 70 74 65 73 74 20 70 61 74 68 20 68 e toptest path h
6530: 61 73 20 62 65 65 6e 20 63 72 65 61 74 65 64 2c as been created,
6540: 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 74 68 65 the link to the
6550: 20 74 65 73 74 20 69 6e 20 74 68 65 20 6c 69 6e test in the lin
6560: 6b 74 72 65 65 20 68 61 73 0a 20 20 20 20 3b 3b ktree has. ;;
6570: 20 62 65 65 6e 20 63 72 65 61 74 65 64 2e 20 4e been created. N
6580: 6f 77 2c 20 69 66 20 74 68 69 73 20 69 73 20 61 ow, if this is a
6590: 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 20 n iterated test
65a0: 74 68 65 20 72 65 61 6c 20 74 65 73 74 20 64 69 the real test di
65b0: 72 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 r must be create
65c0: 64 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6e d. (if (not n
65d0: 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b 20 ot-iterated) ;;
65e0: 74 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 61 this is an itera
65f0: 74 65 64 20 74 65 73 74 0a 09 28 6c 65 74 20 28 ted test..(let (
6600: 28 6c 6e 6b 74 61 72 67 65 74 20 28 63 6f 6e 63 (lnktarget (conc
6610: 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 65 lnkpath "/" ite
6620: 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 28 64 65 m-path))).. (de
6630: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 53 65 74 bug:print 2 "Set
6640: 74 69 6e 67 20 75 70 20 73 75 62 20 74 65 73 74 ting up sub test
6650: 20 72 75 6e 20 61 72 65 61 22 29 0a 09 20 20 28 run area").. (
6660: 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 20 debug:print 2 "
6670: 2d 20 63 72 65 61 74 69 6e 67 20 72 75 6e 20 61 - creating run a
6680: 72 65 61 20 69 6e 20 22 20 74 65 73 74 2d 70 61 rea in " test-pa
6690: 74 68 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 th).. (handle-e
66a0: 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 xceptions.. ex
66b0: 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 n.. (begin..
66c0: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
66d0: 30 20 22 45 52 52 4f 52 3a 20 20 46 61 69 6c 65 0 "ERROR: Faile
66e0: 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 65 d to create dire
66f0: 63 74 6f 72 79 20 22 20 74 65 73 74 2d 70 61 74 ctory " test-pat
6700: 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 h ((condition-pr
6710: 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 operty-accessor
6720: 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 'exn 'message) e
6730: 78 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 22 29 xn) ", exiting")
6740: 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 29 .. (exit 1))
6750: 0a 09 20 20 20 28 63 72 65 61 74 65 2d 64 69 72 .. (create-dir
6760: 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 74 68 ectory test-path
6770: 20 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 3a #t)).. (debug:
6780: 70 72 69 6e 74 20 32 20 0a 09 09 20 20 20 20 20 print 2 ...
6790: 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 6c " - creating l
67a0: 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 74 ink from: " test
67b0: 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 20 -path "\n"...
67c0: 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 20 "
67d0: 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c 6e to: " ln
67e0: 6b 74 61 72 67 65 74 29 0a 0a 09 20 20 3b 3b 20 ktarget)... ;;
67f0: 49 66 20 74 68 65 72 65 20 69 73 20 61 6c 72 65 If there is alre
6800: 61 64 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 65 ady a symlink de
6810: 6c 65 74 65 20 69 74 20 61 6e 64 20 72 65 63 72 lete it and recr
6820: 65 61 74 65 20 69 74 2e 0a 09 20 20 28 68 61 6e eate it... (han
6830: 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 dle-exceptions..
6840: 20 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 69 exn.. (begi
6850: 6e 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 n.. (debug:p
6860: 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 20 rint 0 "ERROR:
6870: 46 61 69 6c 65 64 20 74 6f 20 72 65 2d 63 72 65 Failed to re-cre
6880: 61 74 65 20 6c 69 6e 6b 20 22 20 6c 6e 6b 74 61 ate link " lnkta
6890: 72 67 65 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e rget ((condition
68a0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
68b0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
68c0: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
68d0: 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 29 g").. (exit)
68e0: 29 0a 09 20 20 20 28 69 66 20 28 73 79 6d 62 6f ).. (if (symbo
68f0: 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 72 lic-link? lnktar
6900: 67 65 74 29 20 20 20 20 20 28 64 65 6c 65 74 65 get) (delete
6910: 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 67 65 74 29 -file lnktarget)
6920: 29 0a 09 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ).. (if (not (
6930: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b file-exists? lnk
6940: 74 61 72 67 65 74 29 29 20 28 63 72 65 61 74 65 target)) (create
6950: 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 -symbolic-link t
6960: 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 67 est-path lnktarg
6970: 65 74 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 et))))).. ;;
6980: 49 20 73 75 73 70 65 63 74 20 74 68 69 73 20 73 I suspect this s
6990: 65 63 74 69 6f 6e 20 77 61 73 20 64 65 6c 65 74 ection was delet
69a0: 69 6e 67 20 74 65 73 74 20 64 69 72 65 63 74 6f ing test directo
69b0: 72 69 65 73 20 75 6e 64 65 72 20 73 6f 6d 65 20 ries under some
69c0: 0a 20 20 20 20 3b 3b 20 77 69 65 72 64 20 73 69 . ;; wierd si
69d0: 74 61 74 69 6f 6e 73 3f 20 54 68 69 73 20 64 6f tations? This do
69e0: 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 6e 73 65 esn't make sense
69f0: 20 2d 20 72 65 65 6e 61 62 6c 69 6e 67 20 74 68 - reenabling th
6a00: 65 20 72 6d 20 2d 66 20 0a 20 20 20 20 3b 3b 20 e rm -f . ;;
6a10: 49 20 68 6f 6e 65 73 74 6c 79 20 64 6f 6e 27 74 I honestly don't
6a20: 20 72 65 6d 65 6d 62 65 72 20 2a 77 68 79 2a 20 remember *why*
6a30: 74 68 69 73 20 63 68 75 6e 6b 20 77 61 73 20 6e this chunk was n
6a40: 65 65 64 65 64 2e 2e 2e 0a 20 20 20 20 3b 3b 20 eeded.... ;;
6a50: 28 6c 65 74 20 28 28 74 65 73 74 6c 69 6e 6b 20 (let ((testlink
6a60: 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f (conc lnkpath "/
6a70: 22 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 20 20 " testname))).
6a80: 20 20 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 20 ;; (if (and
6a90: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 65 (file-exists? te
6aa0: 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 stlink). ;;
6ab0: 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 72 (or (r
6ac0: 65 67 75 6c 61 72 2d 66 69 6c 65 3f 20 74 65 73 egular-file? tes
6ad0: 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 20 tlink). ;;
6ae0: 20 20 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 2d . (symbolic-
6af0: 6c 69 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 29 link? testlink))
6b00: 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 ). ;; (
6b10: 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 6d system (conc "rm
6b20: 20 2d 66 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 -f " testlink))
6b30: 29 0a 20 20 20 20 3b 3b 20 20 20 28 73 79 73 74 ). ;; (syst
6b40: 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d 73 em (conc "ln -s
6b50: 66 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 20 f " test-path "
6b60: 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 20 " testlink))).
6b70: 20 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 79 (if (directory
6b80: 3f 20 74 65 73 74 2d 70 61 74 68 29 0a 09 28 62 ? test-path)..(b
6b90: 65 67 69 6e 0a 09 20 20 28 6c 65 74 2a 20 28 28 egin.. (let* ((
6ba0: 6f 76 72 63 6d 64 20 28 6c 65 74 20 28 28 63 6d ovrcmd (let ((cm
6bb0: 64 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 d (config-lookup
6bc0: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 65 *configdat* "se
6bd0: 74 75 70 22 20 22 74 65 73 74 63 6f 70 79 63 6d tup" "testcopycm
6be0: 64 22 29 29 29 0a 09 09 09 20 20 20 28 69 66 20 d"))).... (if
6bf0: 63 6d 64 0a 09 09 09 20 20 20 20 20 20 20 3b 3b cmd.... ;;
6c00: 20 73 75 62 73 74 69 74 75 74 65 20 74 68 65 20 substitute the
6c10: 54 45 53 54 5f 53 52 43 5f 50 41 54 48 20 61 6e TEST_SRC_PATH an
6c20: 64 20 54 45 53 54 5f 54 41 52 47 5f 50 41 54 48 d TEST_TARG_PATH
6c30: 0a 09 09 09 20 20 20 20 20 20 20 28 73 74 72 69 .... (stri
6c40: 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 54 ng-substitute "T
6c50: 45 53 54 5f 54 41 52 47 5f 50 41 54 48 22 20 74 EST_TARG_PATH" t
6c60: 65 73 74 2d 70 61 74 68 0a 09 09 09 09 09 09 20 est-path.......
6c70: 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 74 (string-substit
6c80: 75 74 65 20 22 54 45 53 54 5f 53 52 43 5f 50 41 ute "TEST_SRC_PA
6c90: 54 48 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 TH" test-src-pat
6ca0: 68 20 63 6d 64 20 23 74 29 20 23 74 29 0a 09 09 h cmd #t) #t)...
6cb0: 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 . #f)))...
6cc0: 20 28 63 6d 64 20 20 20 20 28 69 66 20 6f 76 72 (cmd (if ovr
6cd0: 63 6d 64 20 0a 09 09 09 20 20 20 20 20 6f 76 72 cmd .... ovr
6ce0: 63 6d 64 0a 09 09 09 20 20 20 20 20 28 63 6f 6e cmd.... (con
6cf0: 63 20 22 72 73 79 6e 63 20 2d 61 76 22 20 28 69 c "rsync -av" (i
6d00: 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d f (debug:debug-m
6d10: 6f 64 65 20 31 29 20 22 22 20 22 71 22 29 20 22 ode 1) "" "q") "
6d20: 20 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 68 " test-src-path
6d30: 20 22 2f 20 22 20 74 65 73 74 2d 70 61 74 68 20 "/ " test-path
6d40: 22 2f 22 0a 09 09 09 09 20 20 20 22 20 3e 3e 20 "/"..... " >>
6d50: 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f 6d 74 " test-path "/mt
6d60: 5f 6c 61 75 6e 63 68 2e 6c 6f 67 20 32 3e 3e 20 _launch.log 2>>
6d70: 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f 6d 74 " test-path "/mt
6d80: 5f 6c 61 75 6e 63 68 2e 6c 6f 67 22 29 29 29 0a _launch.log"))).
6d90: 09 09 20 28 73 74 61 74 75 73 20 28 73 79 73 74 .. (status (syst
6da0: 65 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 20 28 em cmd))).. (
6db0: 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 if (not (eq? sta
6dc0: 74 75 73 20 30 29 29 0a 09 09 28 64 65 62 75 67 tus 0))...(debug
6dd0: 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 3a :print 2 "ERROR:
6de0: 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 72 75 problem with ru
6df0: 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 5c nning \"" cmd "\
6e00: 22 22 29 29 29 0a 09 20 20 28 6c 69 73 74 20 6c ""))).. (list l
6e10: 6e 6b 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 20 nkpathf lnkpath
6e20: 29 29 0a 09 28 6c 69 73 74 20 23 66 20 23 66 29 ))..(list #f #f)
6e30: 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b 20 )))..;; 1. look
6e40: 74 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 73 though disks lis
6e50: 74 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 20 t for disk with
6e60: 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 2e most space.;; 2.
6e70: 20 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 20 create run dir
6e80: 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e 61 on disk, path na
6e90: 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 6c me is meaningful
6ea0: 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c 69 .;; 3. create li
6eb0: 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 20 nk from run dir
6ec0: 74 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e 73 to megatest runs
6ed0: 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 6d area .;; 4. rem
6ee0: 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 65 otely run the te
6ef0: 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 20 st on allocated
6f00: 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 host.;; - cou
6f10: 6c 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f 73 ld be ssh to hos
6f20: 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 62 t from hosts tab
6f30: 6c 65 20 28 75 70 64 61 74 65 20 72 65 67 75 6c le (update regul
6f40: 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 0a arly with load).
6f50: 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 65 ;; - could be
6f60: 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 20 netbatch.;;
6f70: 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 64 (launch-test d
6f80: 62 20 28 63 61 64 72 20 73 74 61 74 75 73 29 20 b (cadr status)
6f90: 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 66 test-conf)).(def
6fa0: 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 ine (launch-test
6fb0: 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 test-id run-id
6fc0: 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c 73 run-info keyvals
6fd0: 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 6f runname test-co
6fe0: 6e 66 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 73 nf test-name tes
6ff0: 74 2d 70 61 74 68 20 69 74 65 6d 64 61 74 20 70 t-path itemdat p
7000: 61 72 61 6d 73 29 0a 20 20 28 63 68 61 6e 67 65 arams). (change
7010: 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 -directory *topp
7020: 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 74 2d 3e ath*). (alist->
7030: 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e 73 env-vars ;; cons
7040: 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f 64 olidate this cod
7050: 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 20 e with the code
7060: 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d 20 in megatest.scm
7070: 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a 20 for "-execute".
7080: 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c 69 73 74 (list ;; (list
7090: 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 49 "MT_TEST_RUN_DI
70a0: 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 20 R" work-area).
70b0: 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e 5f (list "MT_RUN_
70c0: 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 AREA_HOME" *topp
70d0: 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 73 74 20 ath*). (list
70e0: 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 "MT_TEST_NAME" t
70f0: 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 3b 3b est-name). ;;
7100: 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f (list "MT_ITEM_
7110: 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d INFO" (conc item
7120: 64 61 74 29 29 20 0a 20 20 20 20 28 6c 69 73 74 dat)) . (list
7130: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 "MT_RUNNAME"
7140: 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 3b 3b 20 runname). ;;
7150: 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 (list "MT_TARGET
7160: 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a " mt_target).
7170: 20 20 20 20 29 29 0a 20 20 28 6c 65 74 2a 20 28 )). (let* (
7180: 28 75 73 65 73 68 65 6c 6c 20 20 20 20 20 20 20 (useshell
7190: 20 28 6c 65 74 20 28 28 75 73 68 20 28 63 6f 6e (let ((ush (con
71a0: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
71b0: 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 igdat* "jobtools
71c0: 22 20 20 20 20 20 22 75 73 65 73 68 65 6c 6c 22 " "useshell"
71d0: 29 29 29 0a 09 09 09 20 20 20 20 28 69 66 20 75 ))).... (if u
71e0: 73 68 20 0a 09 09 09 09 28 69 66 20 28 65 71 75 sh .....(if (equ
71f0: 61 6c 3f 20 75 73 68 20 22 6e 6f 22 29 20 3b 3b al? ush "no") ;;
7200: 20 6d 75 73 74 20 75 73 65 20 22 6e 6f 22 20 74 must use "no" t
7210: 6f 20 4e 4f 54 20 75 73 65 20 73 68 65 6c 6c 0a o NOT use shell.
7220: 09 09 09 09 20 20 20 20 23 66 0a 09 09 09 09 20 .... #f.....
7230: 20 20 20 75 73 68 29 0a 09 09 09 09 23 74 29 29 ush).....#t))
7240: 29 20 20 20 20 20 3b 3b 20 64 65 66 61 75 6c 74 ) ;; default
7250: 20 69 73 20 79 65 73 0a 09 20 28 6c 61 75 6e 63 is yes.. (launc
7260: 68 65 72 20 20 20 20 20 20 20 20 28 63 6f 6e 66 her (conf
7270: 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 ig-lookup *confi
7280: 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 22 gdat* "jobtools"
7290: 20 20 20 20 20 22 6c 61 75 6e 63 68 65 72 22 29 "launcher")
72a0: 29 0a 09 20 28 72 75 6e 73 63 72 69 70 74 20 20 ).. (runscript
72b0: 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f (config-loo
72c0: 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 20 kup test-conf
72d0: 22 73 65 74 75 70 22 20 20 20 20 20 20 20 20 22 "setup" "
72e0: 72 75 6e 73 63 72 69 70 74 22 29 29 0a 09 20 28 runscript")).. (
72f0: 65 7a 73 74 65 70 73 20 20 20 20 20 20 20 20 20 ezsteps
7300: 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 68 (> (length (hash
7310: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
7320: 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 7a lt test-conf "ez
7330: 73 74 65 70 73 22 20 27 28 29 29 29 20 30 29 29 steps" '())) 0))
7340: 20 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 61 ;; don't send a
7350: 6c 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 6f ll the steps, co
7360: 75 6c 64 20 62 65 20 62 69 67 0a 09 20 28 64 69 uld be big.. (di
7370: 73 6b 73 70 61 63 65 20 20 20 20 20 20 20 28 63 skspace (c
7380: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 onfig-lookup tes
7390: 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 72 t-conf "requir
73a0: 65 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 61 ements" "diskspa
73b0: 63 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 20 ce")).. (memory
73c0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 67 (config
73d0: 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e -lookup test-con
73e0: 66 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 f "requirement
73f0: 73 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 20 s" "memory"))..
7400: 28 68 6f 73 74 73 20 20 20 20 20 20 20 20 20 20 (hosts
7410: 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 (config-lookup
7420: 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f 62 *configdat* "job
7430: 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 6b tools" "work
7440: 68 6f 73 74 73 22 29 29 0a 09 20 28 72 65 6d 6f hosts")).. (remo
7450: 74 65 2d 6d 65 67 61 74 65 73 74 20 28 63 6f 6e te-megatest (con
7460: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
7470: 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 igdat* "setup" "
7480: 65 78 65 63 75 74 61 62 6c 65 22 29 29 0a 09 20 executable"))..
7490: 28 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 20 (run-time-limit
74a0: 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c 6f (or (configf:lo
74b0: 6f 6b 75 70 20 20 74 65 73 74 2d 63 6f 6e 66 20 okup test-conf
74c0: 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 22 "requirements"
74d0: 20 22 72 75 6e 74 69 6d 65 6c 69 6d 22 29 0a 09 "runtimelim")..
74e0: 09 09 20 20 20 20 20 20 28 63 6f 6e 66 69 67 66 .. (configf
74f0: 3a 6c 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 67 :lookup *config
7500: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 72 75 dat* "setup" "ru
7510: 6e 74 69 6d 65 6c 69 6d 22 29 29 29 0a 09 20 3b ntimelim"))).. ;
7520: 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 3a ; FIXME SOMEDAY:
7530: 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 20 74 68 not good how th
7540: 69 73 20 69 73 20 73 6f 20 6f 62 74 75 73 65 2c is is so obtuse,
7550: 20 74 68 69 73 20 68 61 63 6b 20 69 73 20 74 6f this hack is to
7560: 20 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 .. ;;
7570: 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 75 6e 6e allow runn
7580: 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 62 6f 61 ing from dashboa
7590: 72 64 2e 20 45 78 74 72 61 63 74 20 74 68 65 20 rd. Extract the
75a0: 70 61 74 68 0a 09 20 3b 3b 20 20 20 20 20 20 20 path.. ;;
75b0: 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 68 from th
75c0: 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 73 e called megates
75d0: 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 61 t and convert da
75e0: 73 68 62 6f 61 72 64 0a 09 20 3b 3b 20 20 20 20 shboard.. ;;
75f0: 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 64 . or d
7600: 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 73 board to megates
7610: 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d 65 67 61 74 t.. (local-megat
7620: 65 73 74 20 20 28 6c 65 74 2a 20 28 28 6c 6d 20 est (let* ((lm
7630: 20 28 63 61 72 20 28 61 72 67 76 29 29 29 0a 09 (car (argv)))..
7640: 09 09 09 20 28 64 69 72 20 28 70 61 74 68 6e 61 ... (dir (pathna
7650: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d 29 me-directory lm)
7660: 29 0a 09 09 09 09 20 28 65 78 65 20 28 70 61 74 )..... (exe (pat
7670: 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 65 hname-strip-dire
7680: 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 20 ctory lm)))....
7690: 20 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 72 (conc (if dir
76a0: 20 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 20 (conc dir "/")
76b0: 22 22 29 0a 09 09 09 09 20 20 28 63 61 73 65 20 "")..... (case
76c0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
76d0: 65 78 65 29 0a 09 09 09 09 20 20 20 20 28 28 64 exe)..... ((d
76e0: 62 6f 61 72 64 29 20 20 20 20 22 6d 65 67 61 74 board) "megat
76f0: 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 28 est")..... ((
7700: 6d 74 65 73 74 29 20 20 20 20 20 22 6d 65 67 61 mtest) "mega
7710: 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 test")..... (
7720: 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 67 (dashboard) "meg
7730: 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 atest").....
7740: 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a 09 (else exe)))))..
7750: 20 28 74 65 73 74 2d 73 69 67 20 20 20 28 63 6f (test-sig (co
7760: 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a 22 nc test-name ":"
7770: 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 74 (item-list->pat
7780: 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b 20 h itemdat))) ;;
7790: 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 65 test-path is the
77a0: 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c 75 full path inclu
77b0: 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 61 ding the item-pa
77c0: 74 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 61 20 th.. (work-area
77d0: 20 23 66 29 0a 09 20 28 74 6f 70 74 65 73 74 2d #f).. (toptest-
77e0: 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 3b 3b work-area #f) ;;
77f0: 20 66 6f 72 20 69 74 65 72 61 74 65 64 20 74 65 for iterated te
7800: 73 74 73 20 74 68 65 20 74 6f 70 20 74 65 73 74 sts the top test
7810: 20 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 72 contains data r
7820: 65 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c 0a elevant for all.
7830: 09 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 66 . (diskpath #f
7840: 29 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 20 20 ).. (cmdparms
7850: 23 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 20 20 #f).. (fullcmd
7860: 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e 65 #f) ;; (define
7870: 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 2d a (with-output-
7880: 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 64 to-string (lambd
7890: 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 29 a ()(write x))))
78a0: 0a 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 61 .. (mt-bindir-pa
78b0: 74 68 20 23 66 29 0a 09 20 28 69 74 65 6d 2d 70 th #f).. (item-p
78c0: 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e ath (item-list->
78d0: 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 path itemdat))..
78e0: 20 3b 3b 20 28 74 65 73 74 2d 69 64 20 20 20 20 ;; (test-id
78f0: 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e 20 (cdb:remote-run
7900: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 23 db:get-test-id #
7910: 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 f run-id test-na
7920: 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a 09 me item-path))..
7930: 20 28 74 65 73 74 69 6e 66 6f 20 20 20 28 63 64 (testinfo (cd
7940: 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f 2d b:get-test-info-
7950: 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 65 by-id *runremote
7960: 2a 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 6d * test-id)).. (m
7970: 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 69 6e t_target (strin
7980: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
7990: 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 29 ap cadr keyvals)
79a0: 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 2d "/")).. (debug-
79b0: 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 69 param (append (i
79c0: 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 f (args:get-arg
79d0: 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 74 "-debug") (list
79e0: 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 3a "-debug" (args:
79f0: 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 22 get-arg "-debug"
7a00: 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 20 )) '())....
7a10: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
7a20: 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 6c rg "-logging")(l
7a30: 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 20 ist "-logging")
7a40: 27 28 29 29 29 29 29 0a 20 20 20 20 28 73 65 74 '())))). (set
7a50: 65 6e 76 20 22 4d 54 5f 49 54 45 4d 50 41 54 48 env "MT_ITEMPATH
7a60: 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 20 " item-path).
7a70: 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 21 (if hosts (set!
7a80: 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d 73 hosts (string-s
7a90: 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 20 plit hosts))).
7aa0: 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 67 ;; set the meg
7ab0: 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c 6c atest to be call
7ac0: 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 65 ed on the remote
7ad0: 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 6e host. (if (n
7ae0: 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 ot remote-megate
7af0: 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 2d st)(set! remote-
7b00: 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d 6d megatest local-m
7b10: 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d 65 egatest)) ;; "me
7b20: 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 73 gatest")). (s
7b30: 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 et! mt-bindir-pa
7b40: 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 72 th (pathname-dir
7b50: 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d 65 ectory remote-me
7b60: 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 66 gatest)). (if
7b70: 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 20 launcher (set!
7b80: 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e 67 launcher (string
7b90: 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 29 -split launcher)
7ba0: 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 70 )). ;; set up
7bb0: 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 72 the run work ar
7bc0: 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 74 ea for this test
7bd0: 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 6b 70 . (set! diskp
7be0: 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 69 ath (get-best-di
7bf0: 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 29 sk *configdat*))
7c00: 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 74 . (if diskpat
7c10: 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 20 28 h..(let ((dat (
7c20: 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 61 create-work-area
7c30: 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 6f run-id run-info
7c40: 20 6b 65 79 76 61 6c 73 20 74 65 73 74 2d 69 64 keyvals test-id
7c50: 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b 70 test-path diskp
7c60: 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 ath test-name it
7c70: 65 6d 64 61 74 29 29 29 0a 09 20 20 28 73 65 74 emdat))).. (set
7c80: 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 72 ! work-area (car
7c90: 20 64 61 74 29 29 0a 09 20 20 28 73 65 74 21 20 dat)).. (set!
7ca0: 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 65 toptest-work-are
7cb0: 61 20 28 63 61 64 72 20 64 61 74 29 29 0a 09 20 a (cadr dat))..
7cc0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
7cd0: 66 6f 20 32 20 22 55 73 69 6e 67 20 77 6f 72 6b fo 2 "Using work
7ce0: 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 65 area " work-are
7cf0: 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 a))..(begin.. (
7d00: 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 set! work-area (
7d10: 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 20 22 conc test-path "
7d20: 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 28 /tmp_run")).. (
7d30: 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 create-directory
7d40: 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a 09 work-area #t)..
7d50: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
7d60: 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 69 "WARNING: No di
7d70: 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 73 70 65 sk work area spe
7d80: 63 69 66 69 65 64 20 2d 20 72 75 6e 6e 69 6e 67 cified - running
7d90: 20 69 6e 20 74 68 65 20 74 65 73 74 20 64 69 72 in the test dir
7da0: 65 63 74 6f 72 79 20 75 6e 64 65 72 20 74 6d 70 ectory under tmp
7db0: 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 28 73 65 _run"))). (se
7dc0: 74 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 73 t! cmdparms (bas
7dd0: 65 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f 64 e64:base64-encod
7de0: 65 20 0a 09 09 20 20 20 20 28 77 69 74 68 2d 6f e ... (with-o
7df0: 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a utput-to-string.
7e00: 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 .. (lambda
7e10: 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f 73 () ;; (list 'hos
7e20: 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 09 ts hosts)...
7e30: 09 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 6c .(write (list (l
7e40: 69 73 74 20 27 74 65 73 74 70 61 74 68 20 20 74 ist 'testpath t
7e50: 65 73 74 2d 70 61 74 68 29 0a 09 09 09 09 20 20 est-path).....
7e60: 20 20 20 3b 3b 20 28 6c 69 73 74 20 27 72 75 6e ;; (list 'run
7e70: 72 65 6d 6f 74 65 20 2a 72 75 6e 72 65 6d 6f 74 remote *runremot
7e80: 65 2a 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 e*)..... (li
7e90: 73 74 20 27 74 72 61 6e 73 70 6f 72 74 20 28 63 st 'transport (c
7ea0: 6f 6e 63 20 2a 74 72 61 6e 73 70 6f 72 74 2d 74 onc *transport-t
7eb0: 79 70 65 2a 29 29 0a 09 09 09 09 20 20 20 20 20 ype*)).....
7ec0: 28 6c 69 73 74 20 27 73 65 72 76 65 72 69 6e 66 (list 'serverinf
7ed0: 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f 2a 29 0a *server-info*).
7ee0: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
7ef0: 74 6f 70 70 61 74 68 20 20 20 2a 74 6f 70 70 61 toppath *toppa
7f00: 74 68 2a 29 0a 09 09 09 09 20 20 20 20 20 28 6c th*)..... (l
7f10: 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 77 ist 'work-area w
7f20: 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 20 20 ork-area).....
7f30: 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d 6e (list 'test-n
7f40: 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 20 0a ame test-name) .
7f50: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
7f60: 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 72 runscript runscr
7f70: 69 70 74 29 20 0a 09 09 09 09 20 20 20 20 20 28 ipt) ..... (
7f80: 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 20 20 list 'run-id
7f90: 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 09 20 run-id ).....
7fa0: 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d (list 'test-
7fb0: 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 0a id test-id ).
7fc0: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
7fd0: 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 64 61 itemdat itemda
7fe0: 74 20 20 29 0a 09 09 09 09 20 20 20 20 20 28 6c t )..... (l
7ff0: 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 20 72 ist 'megatest r
8000: 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 0a emote-megatest).
8010: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
8020: 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 65 70 ezsteps ezstep
8030: 73 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c 69 s) ..... (li
8040: 73 74 20 27 74 61 72 67 65 74 20 20 20 20 6d 74 st 'target mt
8050: 5f 74 61 72 67 65 74 29 0a 09 09 09 09 20 20 20 _target).....
8060: 20 20 28 6c 69 73 74 20 27 72 75 6e 74 6c 69 6d (list 'runtlim
8070: 20 20 20 28 69 66 20 72 75 6e 2d 74 69 6d 65 2d (if run-time-
8080: 6c 69 6d 69 74 20 28 63 6f 6d 6d 6f 6e 3a 68 6d limit (common:hm
8090: 73 2d 73 74 72 69 6e 67 2d 3e 73 65 63 6f 6e 64 s-string->second
80a0: 73 20 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 s run-time-limit
80b0: 29 20 23 66 29 29 0a 09 09 09 09 20 20 20 20 20 ) #f)).....
80c0: 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 20 (list 'env-ovrd
80d0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
80e0: 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 67 /default *config
80f0: 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 69 dat* "env-overri
8100: 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 20 de" '())) .....
8110: 20 20 20 20 28 6c 69 73 74 20 27 73 65 74 2d 76 (list 'set-v
8120: 61 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 20 ars (if params
8130: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
8140: 64 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 22 default params "
8150: 2d 73 65 74 76 61 72 73 22 20 23 66 29 29 29 0a -setvars" #f))).
8160: 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 27 .... (list '
8170: 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 6d runname runnam
8180: 65 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 e)..... (lis
8190: 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 t 'mt-bindir-pat
81a0: 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 68 h mt-bindir-path
81b0: 29 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 ))))))). ;; c
81c0: 6c 65 61 6e 20 6f 75 74 20 73 74 65 70 20 72 65 lean out step re
81d0: 63 6f 72 64 73 20 66 72 6f 6d 20 70 72 65 76 69 cords from previ
81e0: 6f 75 73 20 72 75 6e 20 69 66 20 74 68 65 79 20 ous run if they
81f0: 65 78 69 73 74 0a 20 20 20 20 3b 3b 20 28 64 65 exist. ;; (de
8200: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 34 bug:print-info 4
8210: 20 22 46 49 58 4d 45 45 45 45 45 21 21 21 21 20 "FIXMEEEEE!!!!
8220: 54 68 69 73 20 63 61 6e 20 62 65 20 72 65 6d 6f This can be remo
8230: 76 65 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 65 ved some day, pe
8240: 72 68 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 74 rhaps move all t
8250: 65 73 74 20 72 65 63 6f 72 64 73 20 74 6f 20 74 est records to t
8260: 68 65 20 74 65 73 74 20 64 62 3f 22 29 0a 20 20 he test db?").
8270: 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d 63 ;; (open-run-c
8280: 6c 6f 73 65 20 64 62 3a 64 65 6c 65 74 65 2d 74 lose db:delete-t
8290: 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 73 est-step-records
82a0: 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 20 db test-id).
82b0: 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 6f (change-directo
82c0: 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b 3b ry work-area) ;;
82d0: 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 6c so that log fil
82e0: 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 6e es from the laun
82f0: 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 74 ch process don't
8300: 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 73 clutter the tes
8310: 74 20 64 69 72 0a 20 20 20 20 28 74 65 73 74 73 t dir. (tests
8320: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
8330: 21 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e 43 ! test-id "LAUNC
8340: 48 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 66 HED" "n/a" #f #f
8350: 29 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 2d ) ;; (if launch-
8360: 72 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d 72 results launch-r
8370: 65 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 29 esults "FAILED")
8380: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
8390: 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 20 ((and launcher
83a0: 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 62 hosts) ;; must b
83b0: 65 20 75 73 69 6e 67 20 73 73 68 20 68 6f 73 74 e using ssh host
83c0: 6e 61 6d 65 0a 20 20 20 20 20 20 28 73 65 74 21 name. (set!
83d0: 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
83e0: 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 68 launcher (car h
83f0: 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f 74 osts)(list remot
8400: 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d e-megatest test-
8410: 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 sig "-execute" c
8420: 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 mdparms) debug-p
8430: 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 aram))). ;;
8440: 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 (set! fullcmd (a
8450: 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 ppend launcher (
8460: 63 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 20 car hosts)(list
8470: 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 remote-megatest
8480: 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 75 test-sig "-execu
8490: 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 29 te" cmdparms))))
84a0: 0a 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 0a . (launcher.
84b0: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
84c0: 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 6e cmd (append laun
84d0: 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f 74 cher (list remot
84e0: 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d e-megatest test-
84f0: 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 63 sig "-execute" c
8500: 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d 70 mdparms) debug-p
8510: 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b 20 aram))). ;;
8520: 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 61 (set! fullcmd (a
8530: 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 28 ppend launcher (
8540: 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 list remote-mega
8550: 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 2d test test-sig "-
8560: 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 6d execute" cmdparm
8570: 73 29 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 s)))). (else
8580: 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 . (if (not
8590: 75 73 65 73 68 65 6c 6c 29 28 64 65 62 75 67 3a useshell)(debug:
85a0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
85b0: 3a 20 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e 63 : internal launc
85c0: 68 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 6f hing will not wo
85d0: 72 6b 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 20 rk well without
85e0: 5c 22 75 73 65 73 68 65 6c 6c 20 79 65 73 5c 22 \"useshell yes\"
85f0: 20 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f 6f in your [jobtoo
8600: 6c 73 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a 20 ls] section")).
8610: 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c 63 (set! fullc
8620: 6d 64 20 28 61 70 70 65 6e 64 20 28 6c 69 73 74 md (append (list
8630: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
8640: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
8650: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 64 ute" cmdparms) d
8660: 65 62 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 74 ebug-param (list
8670: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 26 (if useshell "&
8680: 22 20 22 22 29 29 29 29 29 29 0a 20 20 20 20 3b " "")))))). ;
8690: 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 ; (set! fullcmd
86a0: 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 (list remote-meg
86b0: 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 atest test-sig "
86c0: 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 -execute" cmdpar
86d0: 6d 73 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 ms (if useshell
86e0: 22 26 22 20 22 22 29 29 29 29 29 0a 20 20 20 20 "&" ""))))).
86f0: 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 (if (args:get-ar
8700: 67 20 22 2d 78 74 65 72 6d 22 29 28 73 65 74 21 g "-xterm")(set!
8710: 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e 64 fullcmd (append
8720: 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 22 fullcmd (list "
8730: 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 20 20 20 -xterm")))).
8740: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 22 (debug:print 1 "
8750: 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 6b Launching " work
8760: 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 65 -area). ;; se
8770: 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e 76 t pre-launch-env
8780: 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c 61 75 -vars before lau
8790: 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 65 nching, keep the
87a0: 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 61 6c vars in prevval
87b0: 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 65 6e s and put the en
87c0: 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 68 vionment back wh
87d0: 65 6e 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 62 en done. (deb
87e0: 75 67 3a 70 72 69 6e 74 20 34 20 22 66 75 6c 6c ug:print 4 "full
87f0: 63 6d 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 0a cmd: " fullcmd).
8800: 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d (let* ((comm
8810: 6f 6e 70 72 65 76 76 61 6c 73 20 28 61 6c 69 73 onprevvals (alis
8820: 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 20 t->env-vars....
8830: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 (hash-table-r
8840: 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 ef/default *conf
8850: 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 igdat* "env-over
8860: 72 69 64 65 22 20 27 28 29 29 29 29 0a 09 20 20 ride" '())))..
8870: 20 28 74 65 73 74 70 72 65 76 76 61 6c 73 20 20 (testprevvals
8880: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
8890: 73 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d 74 s.... (hash-t
88a0: 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 able-ref/default
88b0: 20 74 65 73 74 2d 63 6f 6e 66 20 22 70 72 65 2d test-conf "pre-
88c0: 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 72 launch-env-overr
88d0: 69 64 65 73 22 20 27 28 29 29 29 29 0a 09 20 20 ides" '())))..
88e0: 20 28 6d 69 73 63 70 72 65 76 76 61 6c 73 20 20 (miscprevvals
88f0: 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 (alist->env-var
8900: 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 65 s ;; consolidate
8910: 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 20 this code with
8920: 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 61 the code in mega
8930: 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d 65 test.scm for "-e
8940: 78 65 63 75 74 65 22 0a 09 09 09 20 20 20 20 28 xecute".... (
8950: 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 6c 69 append (list (li
8960: 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f st "MT_TEST_RUN_
8970: 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a DIR" work-area).
8980: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
8990: 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 74 _TEST_NAME" test
89a0: 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 6c -name)...... (l
89b0: 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e 46 ist "MT_ITEM_INF
89c0: 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 74 O" (conc itemdat
89d0: 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 73 74 )) ...... (list
89e0: 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 20 "MT_RUNNAME"
89f0: 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 runname)......
8a00: 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 54 (list "MT_TARGET
8a10: 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 0a " mt_target).
8a20: 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d 54 ..... (list "MT
8a30: 5f 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 6d _ITEMPATH" item
8a40: 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 29 0a -path)...... ).
8a50: 09 09 09 09 20 20 20 20 69 74 65 6d 64 61 74 29 .... itemdat)
8a60: 29 29 0a 09 20 20 20 3b 3b 20 4c 61 75 6e 63 68 )).. ;; Launch
8a70: 77 61 69 74 20 64 65 66 61 75 6c 74 73 20 74 6f wait defaults to
8a80: 20 74 72 75 65 2c 20 6d 75 73 74 20 6f 76 65 72 true, must over
8a90: 72 69 64 65 20 69 74 20 74 6f 20 74 75 72 6e 20 ride it to turn
8aa0: 6f 66 66 20 77 61 69 74 0a 09 20 20 20 28 6c 61 off wait.. (la
8ab0: 75 6e 63 68 77 61 69 74 20 20 20 20 20 28 69 66 unchwait (if
8ac0: 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 69 67 (equal? (config
8ad0: 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 f:lookup *config
8ae0: 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c 61 dat* "setup" "la
8af0: 75 6e 63 68 77 61 69 74 22 29 20 22 6e 6f 22 29 unchwait") "no")
8b00: 20 23 66 20 23 74 29 29 0a 09 20 20 20 28 6c 61 #f #t)).. (la
8b10: 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 70 unch-results (ap
8b20: 70 6c 79 20 28 69 66 20 6c 61 75 6e 63 68 77 61 ply (if launchwa
8b30: 69 74 0a 09 09 09 09 20 20 20 20 20 20 63 6d 64 it..... cmd
8b40: 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 72 -run-with-stderr
8b50: 2d 3e 6c 69 73 74 0a 09 09 09 09 20 20 20 20 20 ->list.....
8b60: 20 70 72 6f 63 65 73 73 2d 72 75 6e 29 0a 09 09 process-run)...
8b70: 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c .. (if useshell
8b80: 0a 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 20 ..... (let
8b90: 28 28 63 6d 64 73 74 72 20 28 73 74 72 69 6e 67 ((cmdstr (string
8ba0: 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 6c -intersperse ful
8bb0: 6c 63 6d 64 20 22 20 22 29 29 29 0a 09 09 09 09 lcmd " "))).....
8bc0: 09 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 0a .(if launchwait.
8bd0: 09 09 09 09 09 20 20 20 20 63 6d 64 73 74 72 0a ..... cmdstr.
8be0: 09 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 63 ..... (conc c
8bf0: 6d 64 73 74 72 20 22 20 3e 3e 20 6d 74 5f 6c 61 mdstr " >> mt_la
8c00: 75 6e 63 68 2e 6c 6f 67 20 32 3e 26 31 22 29 29 unch.log 2>&1"))
8c10: 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 72 )..... (car
8c20: 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 20 fullcmd)).....
8c30: 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 09 (if useshell...
8c40: 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 09 .. '().....
8c50: 20 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c 63 (cdr fullc
8c60: 6d 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 md))))). (i
8c70: 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 77 61 69 f (not launchwai
8c80: 74 29 20 3b 3b 20 67 69 76 65 20 74 68 65 20 4f t) ;; give the O
8c90: 53 20 61 20 6c 69 74 74 6c 65 20 74 69 6d 65 20 S a little time
8ca0: 74 6f 20 61 6c 6c 6f 77 20 74 68 65 20 70 72 6f to allow the pro
8cb0: 63 65 73 73 20 74 6f 20 73 74 61 72 74 0a 09 20 cess to start..
8cc0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
8cd0: 30 2e 30 31 29 29 0a 20 20 20 20 20 20 28 77 69 0.01)). (wi
8ce0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
8cf0: 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 e "mt_launch.log
8d00: 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 20 "..(lambda ()..
8d10: 20 28 69 66 20 28 6c 69 73 74 3f 20 6c 61 75 6e (if (list? laun
8d20: 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 20 ch-results)..
8d30: 20 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 20 (apply print
8d40: 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a launch-results).
8d50: 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 4e . (print "N
8d60: 4f 54 45 3a 20 6c 61 75 6e 63 68 65 64 20 5c 22 OTE: launched \"
8d70: 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 5c 6e 20 " fullcmd "\"\n
8d80: 20 62 75 74 20 64 69 64 20 6e 6f 74 20 77 61 69 but did not wai
8d90: 74 20 66 6f 72 20 69 74 20 74 6f 20 70 72 6f 63 t for it to proc
8da0: 65 65 64 2e 20 41 64 64 20 74 68 65 20 66 6f 6c eed. Add the fol
8db0: 6c 6f 77 69 6e 67 20 74 6f 20 6d 65 67 61 74 65 lowing to megate
8dc0: 73 74 2e 63 6f 6e 66 69 67 20 5c 6e 5b 73 65 74 st.config \n[set
8dd0: 75 70 5d 5c 6e 6c 61 75 6e 63 68 77 61 69 74 20 up]\nlaunchwait
8de0: 79 65 73 5c 6e 20 20 69 66 20 79 6f 75 20 68 61 yes\n if you ha
8df0: 76 65 20 70 72 6f 62 6c 65 6d 73 20 77 69 74 68 ve problems with
8e00: 20 74 68 69 73 22 29 29 0a 09 20 20 23 3a 61 70 this")).. #:ap
8e10: 70 65 6e 64 29 29 0a 20 20 20 20 20 20 28 64 65 pend)). (de
8e20: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 75 bug:print 2 "Lau
8e30: 6e 63 68 69 6e 67 20 63 6f 6d 70 6c 65 74 65 64 nching completed
8e40: 2c 20 75 70 64 61 74 69 6e 67 20 64 62 22 29 0a , updating db").
8e50: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
8e60: 6e 74 20 32 20 22 4c 61 75 6e 63 68 20 72 65 73 nt 2 "Launch res
8e70: 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 68 2d 72 ults: " launch-r
8e80: 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 28 69 esults). (i
8e90: 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 65 f (not launch-re
8ea0: 73 75 6c 74 73 29 0a 20 20 20 20 20 20 20 20 20 sults).
8eb0: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 (begin.
8ec0: 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 4f (print "ERRO
8ed0: 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 72 75 6e R: Failed to run
8ee0: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
8ef0: 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 22 sperse fullcmd "
8f00: 20 22 29 20 22 2c 20 65 78 69 74 69 6e 67 20 6e ") ", exiting n
8f10: 6f 77 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 ow").
8f20: 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 6e ;; (sqlite3:fin
8f30: 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 20 alize! db).
8f40: 20 20 20 20 20 20 20 3b 3b 20 67 6f 6f 64 20 6f ;; good o
8f50: 6c 65 20 22 65 78 69 74 22 20 73 65 65 6d 73 20 le "exit" seems
8f60: 6e 6f 74 20 74 6f 20 77 6f 72 6b 0a 20 20 20 20 not to work.
8f70: 20 20 20 20 20 20 20 20 3b 3b 20 28 5f 65 78 69 ;; (_exi
8f80: 74 20 39 29 0a 20 20 20 20 20 20 20 20 20 20 20 t 9).
8f90: 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 63 ;; but this hac
8fa0: 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 61 k will work! Tha
8fb0: 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 50 nks go to Alan P
8fc0: 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 6b ost of the Chick
8fd0: 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 20 20 en email list.
8fe0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 42 2f ;; NB/
8ff0: 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c 6c 20 / Is this still
9000: 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 62 needed? Should b
9010: 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 61 63 e safe to go bac
9020: 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 3f k to "exit" now?
9030: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 . (pr
9040: 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 75 ocess-signal (cu
9050: 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 64 rrent-process-id
9060: 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a 20 ) signal/kill).
9070: 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 )).
9080: 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d (alist->env-
9090: 76 61 72 73 20 6d 69 73 63 70 72 65 76 76 61 6c vars miscprevval
90a0: 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 2d s). (alist-
90b0: 3e 65 6e 76 2d 76 61 72 73 20 74 65 73 74 70 72 >env-vars testpr
90c0: 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 61 evvals). (a
90d0: 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 63 list->env-vars c
90e0: 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 0a 20 ommonprevvals).
90f0: 20 20 20 20 20 6c 61 75 6e 63 68 2d 72 65 73 75 launch-resu
9100: 6c 74 73 29 29 0a 20 20 28 63 68 61 6e 67 65 2d lts)). (change-
9110: 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 61 directory *toppa
9120: 74 68 2a 29 29 0a 0a th*))..