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: 73 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 28 sdb:qry 'getid (
2db0: 63 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e conc stepname ".
2dc0: 68 74 6d 6c 22 29 29 29 29 0a 09 09 09 09 09 09 html")))).......
2dd0: 20 20 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 ;; set the
2de0: 74 65 73 74 20 66 69 6e 61 6c 20 73 74 61 74 75 test final statu
2df0: 73 0a 09 09 09 09 09 09 20 20 20 20 20 28 6c 65 s....... (le
2e00: 74 2a 20 28 28 74 68 69 73 2d 73 74 65 70 2d 73 t* ((this-step-s
2e10: 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 09 09 tatus (cond.....
2e20: 09 09 09 09 09 20 20 20 20 20 20 20 28 28 61 6e ..... ((an
2e30: 64 20 28 65 71 3f 20 28 76 65 63 74 6f 72 2d 72 d (eq? (vector-r
2e40: 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 20 ef exit-info 2)
2e50: 32 29 20 6c 6f 67 70 72 6f 2d 75 73 65 64 29 20 2) logpro-used)
2e60: 27 77 61 72 6e 29 0a 09 09 09 09 09 09 09 09 09 'warn)..........
2e70: 20 20 20 20 20 20 20 28 28 65 71 3f 20 28 76 65 ((eq? (ve
2e80: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
2e90: 66 6f 20 32 29 20 30 29 20 20 20 20 20 20 20 20 fo 2) 0)
2ea0: 20 20 20 20 20 20 20 20 20 20 20 27 70 61 73 73 'pass
2eb0: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
2ec0: 20 20 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 (else 'fail)))
2ed0: 0a 09 09 09 09 09 09 09 20 20 20 20 28 6f 76 65 ........ (ove
2ee0: 72 61 6c 6c 2d 73 74 61 74 75 73 20 20 20 28 63 rall-status (c
2ef0: 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 20 ond..........
2f00: 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 ((eq? rollup
2f10: 2d 73 74 61 74 75 73 20 32 29 20 27 77 61 72 6e -status 2) 'warn
2f20: 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 )..........
2f30: 20 20 28 28 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 ((eq? rollup-s
2f40: 74 61 74 75 73 20 30 29 20 27 70 61 73 73 29 0a tatus 0) 'pass).
2f50: 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 .........
2f60: 28 65 6c 73 65 20 27 66 61 69 6c 29 29 29 0a 09 (else 'fail)))..
2f70: 09 09 09 09 09 09 20 20 20 20 28 6e 65 78 74 2d ...... (next-
2f80: 73 74 61 74 75 73 20 20 20 20 20 20 28 63 6f 6e status (con
2f90: 64 20 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 d ..........
2fa0: 20 20 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c ((eq? overall
2fb0: 2d 73 74 61 74 75 73 20 27 70 61 73 73 29 20 74 -status 'pass) t
2fc0: 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 29 his-step-status)
2fd0: 0a 09 09 09 09 09 09 09 09 09 20 20 20 20 20 20 ..........
2fe0: 20 28 28 65 71 3f 20 6f 76 65 72 61 6c 6c 2d 73 ((eq? overall-s
2ff0: 74 61 74 75 73 20 27 77 61 72 6e 29 0a 09 09 09 tatus 'warn)....
3000: 09 09 09 09 09 09 09 28 69 66 20 28 65 71 3f 20 .......(if (eq?
3010: 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 this-step-status
3020: 20 27 66 61 69 6c 29 20 27 66 61 69 6c 20 27 77 'fail) 'fail 'w
3030: 61 72 6e 29 29 0a 09 09 09 09 09 09 09 09 09 20 arn))..........
3040: 20 20 20 20 20 20 28 65 6c 73 65 20 27 66 61 69 (else 'fai
3050: 6c 29 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 l)))........
3060: 28 6e 65 78 74 2d 73 74 61 74 65 20 20 20 20 20 (next-state
3070: 20 20 22 52 55 4e 4e 49 4e 47 22 29 20 0a 09 09 "RUNNING") ...
3080: 09 09 09 09 09 20 20 20 20 20 20 20 20 20 20 20 .....
3090: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 28 ;; (
30a0: 63 6f 6e 64 0a 09 09 09 09 09 09 09 09 09 20 20 cond..........
30b0: 20 20 20 20 3b 3b 20 20 28 28 6e 75 6c 6c 3f 20 ;; ((null?
30c0: 74 61 6c 29 20 3b 3b 20 6d 6f 72 65 20 74 6f 20 tal) ;; more to
30d0: 72 75 6e 3f 0a 09 09 09 09 09 09 09 09 09 20 20 run?..........
30e0: 20 20 20 20 3b 3b 20 20 20 22 43 4f 4d 50 4c 45 ;; "COMPLE
30f0: 54 45 44 22 29 0a 09 09 09 09 09 09 09 09 09 20 TED")..........
3100: 20 20 20 20 20 3b 3b 20 20 28 65 6c 73 65 20 22 ;; (else "
3110: 52 55 4e 4e 49 4e 47 22 29 29 0a 09 09 09 09 09 RUNNING"))......
3120: 09 09 20 20 20 20 29 0a 09 09 09 09 09 09 20 20 .. ).......
3130: 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e (debug:prin
3140: 74 20 34 20 22 45 78 69 74 20 76 61 6c 75 65 20 t 4 "Exit value
3150: 72 65 63 65 69 76 65 64 3a 20 22 20 28 76 65 63 received: " (vec
3160: 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 tor-ref exit-inf
3170: 6f 20 32 29 20 22 20 6c 6f 67 70 72 6f 2d 75 73 o 2) " logpro-us
3180: 65 64 3a 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 ed: " logpro-use
3190: 64 20 0a 09 09 09 09 09 09 09 09 20 20 20 20 22 d ......... "
31a0: 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 this-step-statu
31b0: 73 3a 20 22 20 74 68 69 73 2d 73 74 65 70 2d 73 s: " this-step-s
31c0: 74 61 74 75 73 20 22 20 6f 76 65 72 61 6c 6c 2d tatus " overall-
31d0: 73 74 61 74 75 73 3a 20 22 20 6f 76 65 72 61 6c status: " overal
31e0: 6c 2d 73 74 61 74 75 73 20 0a 09 09 09 09 09 09 l-status .......
31f0: 09 09 20 20 20 20 22 20 6e 65 78 74 2d 73 74 61 .. " next-sta
3200: 74 75 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 tus: " next-stat
3210: 75 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 us " rollup-stat
3220: 75 73 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 us: " rollup-sta
3230: 74 75 73 29 0a 09 09 09 09 09 09 20 20 20 20 20 tus).......
3240: 20 20 28 63 61 73 65 20 6e 65 78 74 2d 73 74 61 (case next-sta
3250: 74 75 73 0a 09 09 09 09 09 09 09 20 28 28 77 61 tus........ ((wa
3260: 72 6e 29 0a 09 09 09 09 09 09 09 20 20 28 73 65 rn)........ (se
3270: 74 21 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 t! rollup-status
3280: 20 32 29 0a 09 09 09 09 09 09 09 20 20 3b 3b 20 2)........ ;;
3290: 4e 42 2f 2f 20 74 65 73 74 2d 73 65 74 2d 73 74 NB// test-set-st
32a0: 61 74 75 73 21 20 64 6f 65 73 20 72 64 62 20 63 atus! does rdb c
32b0: 61 6c 6c 73 20 75 6e 64 65 72 20 74 68 65 20 68 alls under the h
32c0: 6f 6f 64 0a 09 09 09 09 09 09 09 20 20 28 74 65 ood........ (te
32d0: 73 74 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 sts:test-set-sta
32e0: 74 75 73 21 20 74 65 73 74 2d 69 64 20 6e 65 78 tus! test-id nex
32f0: 74 2d 73 74 61 74 65 20 22 57 41 52 4e 22 20 0a t-state "WARN" .
3300: 09 09 09 09 09 09 09 09 09 20 20 28 69 66 20 28 ......... (if (
3310: 65 71 3f 20 74 68 69 73 2d 73 74 65 70 2d 73 74 eq? this-step-st
3320: 61 74 75 73 20 27 77 61 72 6e 29 20 22 4c 6f 67 atus 'warn) "Log
3330: 70 72 6f 20 77 61 72 6e 69 6e 67 20 66 6f 75 6e pro warning foun
3340: 64 22 20 23 66 29 0a 09 09 09 09 09 09 09 09 09 d" #f)..........
3350: 20 20 23 66 29 29 0a 09 09 09 09 09 09 09 20 28 #f))........ (
3360: 28 70 61 73 73 29 0a 09 09 09 09 09 09 09 20 20 (pass)........
3370: 28 74 65 73 74 73 3a 74 65 73 74 2d 73 65 74 2d (tests:test-set-
3380: 73 74 61 74 75 73 21 20 74 65 73 74 2d 69 64 20 status! test-id
3390: 6e 65 78 74 2d 73 74 61 74 65 20 22 50 41 53 53 next-state "PASS
33a0: 22 20 23 66 20 23 66 29 29 0a 09 09 09 09 09 09 " #f #f)).......
33b0: 09 20 28 65 6c 73 65 20 3b 3b 20 27 66 61 69 6c . (else ;; 'fail
33c0: 0a 09 09 09 09 09 09 09 20 20 28 73 65 74 21 20 ........ (set!
33d0: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 20 31 29 rollup-status 1)
33e0: 20 3b 3b 20 66 6f 72 63 65 20 66 61 69 6c 0a 09 ;; force fail..
33f0: 09 09 09 09 09 09 20 20 28 74 65 73 74 73 3a 74 ...... (tests:t
3400: 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 est-set-status!
3410: 74 65 73 74 2d 69 64 20 6e 65 78 74 2d 73 74 61 test-id next-sta
3420: 74 65 20 22 46 41 49 4c 22 20 28 63 6f 6e 63 20 te "FAIL" (conc
3430: 22 46 61 69 6c 65 64 20 61 74 20 73 74 65 70 20 "Failed at step
3440: 22 20 73 74 65 70 6e 61 6d 65 29 20 23 66 29 0a " stepname) #f).
3450: 09 09 09 09 09 09 09 20 20 29 29 29 29 0a 09 09 ....... ))))...
3460: 09 09 09 09 20 20 20 28 69 66 20 28 61 6e 64 20 .... (if (and
3470: 28 73 74 65 70 72 75 6e 2d 67 6f 6f 64 3f 20 6c (steprun-good? l
3480: 6f 67 70 72 6f 2d 75 73 65 64 20 28 76 65 63 74 ogpro-used (vect
3490: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
34a0: 20 32 29 29 0a 09 09 09 09 09 09 09 20 20 20 20 2))........
34b0: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 (not (null? tal)
34c0: 29 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 )).......
34d0: 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 20 (loop (car tal)
34e0: 28 63 64 72 20 74 61 6c 29 20 73 74 65 70 6e 61 (cdr tal) stepna
34f0: 6d 65 29 29 29 0a 09 09 09 09 09 09 20 28 64 65 me)))....... (de
3500: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 57 41 52 bug:print 4 "WAR
3510: 4e 49 4e 47 3a 20 61 20 70 72 69 6f 72 20 73 74 NING: a prior st
3520: 65 70 20 66 61 69 6c 65 64 2c 20 73 74 6f 70 70 ep failed, stopp
3530: 69 6e 67 20 61 74 20 22 20 65 7a 73 74 65 70 29 ing at " ezstep)
3540: 29 29 29 29 29 29 29 0a 09 09 20 28 6d 6f 6e 69 )))))))... (moni
3550: 74 6f 72 6a 6f 62 20 20 20 28 6c 61 6d 62 64 61 torjob (lambda
3560: 20 28 29 0a 09 09 09 09 20 28 6c 65 74 2a 20 28 ()..... (let* (
3570: 28 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 20 28 (start-seconds (
3580: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
3590: 29 0a 09 09 09 09 09 28 63 61 6c 63 2d 6d 69 6e )......(calc-min
35a0: 75 74 65 73 20 20 28 6c 61 6d 62 64 61 20 28 29 utes (lambda ()
35b0: 0a 09 09 09 09 09 09 09 20 28 69 6e 65 78 61 63 ........ (inexac
35c0: 74 2d 3e 65 78 61 63 74 20 0a 09 09 09 09 09 09 t->exact .......
35d0: 09 20 20 28 72 6f 75 6e 64 20 0a 09 09 09 09 09 . (round ......
35e0: 09 09 20 20 20 28 2d 20 0a 09 09 09 09 09 09 09 .. (- ........
35f0: 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (current-sec
3600: 6f 6e 64 73 29 20 0a 09 09 09 09 09 09 09 20 20 onds) ........
3610: 20 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 73 29 start-seconds)
3620: 29 29 29 29 0a 09 09 09 09 09 28 6b 69 6c 6c 2d ))))......(kill-
3630: 74 72 69 65 73 20 30 29 29 0a 09 09 09 09 20 20 tries 0)).....
3640: 20 28 74 65 73 74 73 3a 73 65 74 2d 66 75 6c 6c (tests:set-full
3650: 2d 6d 65 74 61 2d 69 6e 66 6f 20 23 66 20 74 65 -meta-info #f te
3660: 73 74 2d 69 64 20 72 75 6e 2d 69 64 20 28 63 61 st-id run-id (ca
3670: 6c 63 2d 6d 69 6e 75 74 65 73 29 20 77 6f 72 6b lc-minutes) work
3680: 2d 61 72 65 61 29 0a 09 09 09 09 20 20 20 28 6c -area)..... (l
3690: 65 74 20 6c 6f 6f 70 20 28 28 6d 69 6e 75 74 65 et loop ((minute
36a0: 73 20 20 20 28 63 61 6c 63 2d 6d 69 6e 75 74 65 s (calc-minute
36b0: 73 29 29 29 0a 09 09 09 09 20 20 20 20 20 28 62 s)))..... (b
36c0: 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 20 egin.....
36d0: 28 73 65 74 21 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 (set! kill-job?
36e0: 28 6f 72 20 28 74 65 73 74 2d 67 65 74 2d 6b 69 (or (test-get-ki
36f0: 6c 6c 2d 72 65 71 75 65 73 74 20 74 65 73 74 2d ll-request test-
3700: 69 64 29 20 3b 3b 20 72 75 6e 2d 69 64 20 74 65 id) ;; run-id te
3710: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 st-name itemdat)
3720: 29 0a 09 09 09 09 09 09 09 20 20 20 28 61 6e 64 )........ (and
3730: 20 72 75 6e 74 6c 69 6d 20 28 6c 65 74 2a 20 28 runtlim (let* (
3740: 28 72 75 6e 2d 73 65 63 6f 6e 64 73 20 20 20 28 (run-seconds (
3750: 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e - (current-secon
3760: 64 73 29 20 73 74 61 72 74 2d 73 65 63 6f 6e 64 ds) start-second
3770: 73 29 29 0a 09 09 09 09 09 09 09 09 09 20 20 20 s))..........
3780: 20 20 20 20 28 74 69 6d 65 2d 65 78 63 65 65 64 (time-exceed
3790: 65 64 20 28 3e 20 72 75 6e 2d 73 65 63 6f 6e 64 ed (> run-second
37a0: 73 20 72 75 6e 74 6c 69 6d 29 29 29 0a 09 09 09 s runtlim)))....
37b0: 09 09 09 09 09 09 20 20 28 69 66 20 74 69 6d 65 ...... (if time
37c0: 2d 65 78 63 65 65 64 65 64 0a 09 09 09 09 09 09 -exceeded.......
37d0: 09 09 09 20 20 20 20 20 20 28 62 65 67 69 6e 0a ... (begin.
37e0: 09 09 09 09 09 09 09 09 09 09 28 64 65 62 75 67 ..........(debug
37f0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 22 4b :print-info 0 "K
3800: 49 4c 4c 49 4e 47 20 54 45 53 54 20 44 55 45 20 ILLING TEST DUE
3810: 54 4f 20 54 49 4d 45 20 4c 49 4d 49 54 20 45 58 TO TIME LIMIT EX
3820: 43 45 45 44 45 44 21 20 52 75 6e 74 69 6d 65 3d CEEDED! Runtime=
3830: 22 20 72 75 6e 2d 73 65 63 6f 6e 64 73 20 22 20 " run-seconds "
3840: 73 65 63 6f 6e 64 73 2c 20 6c 69 6d 69 74 3d 22 seconds, limit="
3850: 20 72 75 6e 74 6c 69 6d 29 0a 09 09 09 09 09 09 runtlim).......
3860: 09 09 09 09 23 74 29 0a 09 09 09 09 09 09 09 09 ....#t).........
3870: 09 20 20 20 20 20 20 23 66 29 29 29 29 29 0a 09 . #f)))))..
3880: 09 09 09 20 20 20 20 20 20 20 3b 3b 20 6f 70 65 ... ;; ope
3890: 6e 2d 72 75 6e 2d 63 6c 6f 73 65 20 6e 6f 74 20 n-run-close not
38a0: 6e 65 65 64 65 64 20 66 6f 72 20 74 65 73 74 2d needed for test-
38b0: 73 65 74 2d 6d 65 74 61 2d 69 6e 66 6f 0a 09 09 set-meta-info...
38c0: 09 09 20 20 20 20 20 20 20 28 74 65 73 74 73 3a .. (tests:
38d0: 73 65 74 2d 70 61 72 74 69 61 6c 2d 6d 65 74 61 set-partial-meta
38e0: 2d 69 6e 66 6f 20 23 66 20 74 65 73 74 2d 69 64 -info #f test-id
38f0: 20 72 75 6e 2d 69 64 20 6d 69 6e 75 74 65 73 20 run-id minutes
3900: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 20 work-area).....
3910: 20 20 20 20 20 20 28 69 66 20 6b 69 6c 6c 2d 6a (if kill-j
3920: 6f 62 3f 20 0a 09 09 09 09 09 20 20 20 28 62 65 ob? ...... (be
3930: 67 69 6e 0a 09 09 09 09 09 20 20 20 20 20 28 6d gin...... (m
3940: 75 74 65 78 2d 6c 6f 63 6b 21 20 6d 29 0a 09 09 utex-lock! m)...
3950: 09 09 09 20 20 20 20 20 3b 3b 20 4e 4f 54 45 3a ... ;; NOTE:
3960: 20 54 68 65 20 70 69 64 20 63 61 6e 20 63 68 61 The pid can cha
3970: 6e 67 65 20 61 73 20 64 69 66 66 65 72 65 6e 74 nge as different
3980: 20 73 74 65 70 73 20 61 72 65 20 72 75 6e 2e 20 steps are run.
3990: 44 6f 20 77 65 20 6e 65 65 64 20 68 61 6e 64 73 Do we need hands
39a0: 68 61 6b 69 6e 67 20 62 65 74 77 65 65 6e 20 74 haking between t
39b0: 68 69 73 0a 09 09 09 09 09 20 20 20 20 20 3b 3b his...... ;;
39c0: 20 20 20 20 20 20 20 73 65 63 74 69 6f 6e 20 61 section a
39d0: 6e 64 20 74 68 65 20 72 75 6e 69 74 20 73 65 63 nd the runit sec
39e0: 74 69 6f 6e 3f 20 4f 72 20 61 64 64 20 61 20 6c tion? Or add a l
39f0: 6f 6f 70 20 74 68 61 74 20 74 72 69 65 73 20 74 oop that tries t
3a00: 68 72 65 65 20 74 69 6d 65 73 20 77 69 74 68 20 hree times with
3a10: 61 20 31 2f 34 20 73 65 63 6f 6e 64 0a 09 09 09 a 1/4 second....
3a20: 09 09 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 .. ;;
3a30: 62 65 74 77 65 65 6e 20 74 72 69 65 73 3f 0a 09 between tries?..
3a40: 09 09 09 09 20 20 20 20 20 28 6c 65 74 2a 20 28 .... (let* (
3a50: 28 70 69 64 20 28 76 65 63 74 6f 72 2d 72 65 66 (pid (vector-ref
3a60: 20 65 78 69 74 2d 69 6e 66 6f 20 30 29 29 29 0a exit-info 0))).
3a70: 09 09 09 09 09 20 20 20 20 20 20 20 28 69 66 20 ..... (if
3a80: 28 6e 75 6d 62 65 72 3f 20 70 69 64 29 0a 09 09 (number? pid)...
3a90: 09 09 09 09 20 20 20 28 70 72 6f 63 65 73 73 2d .... (process-
3aa0: 73 69 67 6e 61 6c 20 70 69 64 20 73 69 67 6e 61 signal pid signa
3ab0: 6c 2f 6b 69 6c 6c 29 0a 09 09 09 09 09 09 20 20 l/kill).......
3ac0: 20 3b 3b 20 28 62 65 67 69 6e 0a 09 09 09 09 09 ;; (begin......
3ad0: 09 20 20 20 3b 3b 20 20 20 28 64 65 62 75 67 3a . ;; (debug:
3ae0: 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 print 0 "WARNING
3af0: 3a 20 52 65 71 75 65 73 74 20 72 65 63 65 69 76 : Request receiv
3b00: 65 64 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 28 ed to kill job (
3b10: 61 74 74 65 6d 70 74 20 23 20 22 20 6b 69 6c 6c attempt # " kill
3b20: 2d 74 72 69 65 73 20 22 29 22 29 0a 09 09 09 09 -tries ")").....
3b30: 09 09 20 20 20 3b 3b 20 20 20 28 6c 65 74 20 28 .. ;; (let (
3b40: 28 70 72 6f 63 65 73 73 65 73 20 28 63 6d 64 2d (processes (cmd-
3b50: 72 75 6e 2d 3e 6c 69 73 74 20 28 63 6f 6e 63 20 run->list (conc
3b60: 22 70 67 72 65 70 20 2d 6c 20 2d 50 20 22 20 70 "pgrep -l -P " p
3b70: 69 64 29 29 29 29 0a 09 09 09 09 09 09 20 20 20 id)))).......
3b80: 3b 3b 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 ;; (for-each
3b90: 20 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 ....... ;;
3ba0: 20 20 20 28 6c 61 6d 62 64 61 20 28 70 29 0a 09 (lambda (p)..
3bb0: 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 20 ..... ;;
3bc0: 20 20 28 6c 65 74 2a 20 28 28 70 61 72 74 73 20 (let* ((parts
3bd0: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 70 (string-split p
3be0: 29 29 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 ))....... ;;
3bf0: 20 20 20 20 09 20 28 70 2d 69 64 20 20 20 28 69 . (p-id (i
3c00: 66 20 28 3e 20 28 6c 65 6e 67 74 68 20 70 61 72 f (> (length par
3c10: 74 73 29 20 30 29 0a 09 09 09 09 09 09 20 20 20 ts) 0).......
3c20: 3b 3b 20 20 20 20 20 20 09 09 20 20 20 20 20 28 ;; .. (
3c30: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
3c40: 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 09 09 car parts)).....
3c50: 09 09 20 20 20 3b 3b 20 20 20 20 20 20 09 09 20 .. ;; ..
3c60: 20 20 20 20 23 66 29 29 29 0a 09 09 09 09 09 09 #f))).......
3c70: 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 28 ;; (
3c80: 69 66 20 70 2d 69 64 0a 09 09 09 09 09 09 20 20 if p-id.......
3c90: 20 3b 3b 20 20 20 20 20 20 09 28 62 65 67 69 6e ;; .(begin
3ca0: 0a 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 ....... ;;
3cb0: 20 20 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
3cc0: 74 20 30 20 22 4b 69 6c 6c 69 6e 67 20 22 20 28 t 0 "Killing " (
3cd0: 63 61 64 72 20 70 61 72 74 73 29 20 22 3b 20 6b cadr parts) "; k
3ce0: 69 6c 6c 20 2d 39 20 20 22 20 70 2d 69 64 29 0a ill -9 " p-id).
3cf0: 09 09 09 09 09 09 20 20 20 3b 3b 20 20 20 20 20 ...... ;;
3d00: 20 09 20 20 28 73 79 73 74 65 6d 20 28 63 6f 6e . (system (con
3d10: 63 20 22 6b 69 6c 6c 20 2d 39 20 22 20 70 2d 69 c "kill -9 " p-i
3d20: 64 29 29 29 29 29 29 0a 09 09 09 09 09 09 20 20 d)))))).......
3d30: 20 3b 3b 20 20 20 20 20 20 28 63 61 72 20 70 72 ;; (car pr
3d40: 6f 63 65 73 73 65 73 29 29 0a 09 09 09 09 09 09 ocesses)).......
3d50: 20 20 20 3b 3b 20 20 20 20 20 28 73 79 73 74 65 ;; (syste
3d60: 6d 20 28 63 6f 6e 63 20 22 6b 69 6c 6c 20 2d 39 m (conc "kill -9
3d70: 20 2d 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 -" pid)))).....
3d80: 09 09 20 20 20 28 62 65 67 69 6e 0a 09 09 09 09 .. (begin.....
3d90: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
3da0: 69 6e 74 20 30 20 22 57 41 52 4e 49 4e 47 3a 20 int 0 "WARNING:
3db0: 52 65 71 75 65 73 74 20 72 65 63 65 69 76 65 64 Request received
3dc0: 20 74 6f 20 6b 69 6c 6c 20 6a 6f 62 20 62 75 74 to kill job but
3dd0: 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 70 72 problem with pr
3de0: 6f 63 65 73 73 2c 20 61 74 74 65 6d 70 74 69 6e ocess, attemptin
3df0: 67 20 74 6f 20 6b 69 6c 6c 20 6d 61 6e 61 67 65 g to kill manage
3e00: 72 20 70 72 6f 63 65 73 73 22 29 0a 09 09 09 09 r process").....
3e10: 09 09 20 20 20 20 20 28 74 65 73 74 73 3a 74 65 .. (tests:te
3e20: 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 st-set-status! t
3e30: 65 73 74 2d 69 64 20 22 4b 49 4c 4c 45 44 22 20 est-id "KILLED"
3e40: 20 22 46 41 49 4c 22 0a 09 09 09 09 09 09 09 09 "FAIL".........
3e50: 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d 61 (args:get-a
3e60: 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 09 rg "-m") #f)....
3e70: 09 09 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 ... (sqlite3
3e80: 3a 66 69 6e 61 6c 69 7a 65 21 20 74 64 62 29 0a :finalize! tdb).
3e90: 09 09 09 09 09 09 20 20 20 20 20 28 65 78 69 74 ...... (exit
3ea0: 20 31 29 29 29 29 0a 09 09 09 09 09 20 20 20 20 1))))......
3eb0: 20 28 73 65 74 21 20 6b 69 6c 6c 2d 74 72 69 65 (set! kill-trie
3ec0: 73 20 28 2b 20 31 20 6b 69 6c 6c 2d 74 72 69 65 s (+ 1 kill-trie
3ed0: 73 29 29 0a 09 09 09 09 09 20 20 20 20 20 28 6d s))...... (m
3ee0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 29 utex-unlock! m))
3ef0: 29 0a 09 09 09 09 20 20 20 20 20 20 20 3b 3b 20 )..... ;;
3f00: 28 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a (sqlite3:finaliz
3f10: 65 21 20 64 62 29 0a 09 09 09 09 20 20 20 20 20 e! db).....
3f20: 20 20 28 69 66 20 6b 65 65 70 2d 67 6f 69 6e 67 (if keep-going
3f30: 0a 09 09 09 09 09 20 20 20 28 62 65 67 69 6e 0a ...... (begin.
3f40: 09 09 09 09 09 20 20 20 20 20 28 74 68 72 65 61 ..... (threa
3f50: 64 2d 73 6c 65 65 70 21 20 33 29 20 3b 3b 20 28 d-sleep! 3) ;; (
3f60: 2b 20 33 20 28 72 61 6e 64 6f 6d 20 36 29 29 29 + 3 (random 6)))
3f70: 20 3b 3b 20 61 64 64 20 73 6f 6d 65 20 6a 69 74 ;; add some jit
3f80: 74 65 72 20 74 6f 20 74 68 65 20 63 61 6c 6c 20 ter to the call
3f90: 68 6f 6d 65 20 74 69 6d 65 20 74 6f 20 73 70 72 home time to spr
3fa0: 65 61 64 20 6f 75 74 20 74 68 65 20 64 62 20 61 ead out the db a
3fb0: 63 63 65 73 73 65 73 0a 09 09 09 09 09 20 20 20 ccesses......
3fc0: 20 20 28 69 66 20 6b 65 65 70 2d 67 6f 69 6e 67 (if keep-going
3fd0: 0a 09 09 09 09 09 09 20 28 6c 6f 6f 70 20 28 63 ....... (loop (c
3fe0: 61 6c 63 2d 6d 69 6e 75 74 65 73 29 29 29 29 29 alc-minutes)))))
3ff0: 29 29 29 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 43 ))))) ;; NOTE: C
4000: 68 65 63 6b 69 6e 67 20 74 77 69 63 65 20 66 6f hecking twice fo
4010: 72 20 6b 65 65 70 2d 67 6f 69 6e 67 20 69 73 20 r keep-going is
4020: 69 6e 74 65 6e 74 69 6f 6e 61 6c 0a 09 09 20 28 intentional... (
4030: 74 68 31 20 20 20 20 20 20 20 20 20 20 28 6d 61 th1 (ma
4040: 6b 65 2d 74 68 72 65 61 64 20 6d 6f 6e 69 74 6f ke-thread monito
4050: 72 6a 6f 62 20 22 6d 6f 6e 69 74 6f 72 20 6a 6f rjob "monitor jo
4060: 62 22 29 29 0a 09 09 20 28 74 68 32 20 20 20 20 b"))... (th2
4070: 20 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 (make-thre
4080: 61 64 20 72 75 6e 69 74 20 22 72 75 6e 20 6a 6f ad runit "run jo
4090: 62 22 29 29 29 0a 09 20 20 20 20 28 73 65 74 21 b"))).. (set!
40a0: 20 6a 6f 62 2d 74 68 72 65 61 64 20 74 68 32 29 job-thread th2)
40b0: 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 .. (thread-st
40c0: 61 72 74 21 20 74 68 31 29 0a 09 20 20 20 20 28 art! th1).. (
40d0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
40e0: 32 29 0a 09 20 20 20 20 28 74 68 72 65 61 64 2d 2).. (thread-
40f0: 6a 6f 69 6e 21 20 74 68 32 29 0a 09 20 20 20 20 join! th2)..
4100: 28 73 65 74 21 20 6b 65 65 70 2d 67 6f 69 6e 67 (set! keep-going
4110: 20 23 66 29 0a 09 20 20 20 20 28 74 68 72 65 61 #f).. (threa
4120: 64 2d 6a 6f 69 6e 21 20 74 68 31 29 0a 09 20 20 d-join! th1)..
4130: 20 20 3b 3b 20 28 74 68 72 65 61 64 2d 73 6c 65 ;; (thread-sle
4140: 65 70 21 20 31 29 0a 09 20 20 20 20 3b 3b 20 28 ep! 1).. ;; (
4150: 74 68 72 65 61 64 2d 74 65 72 6d 69 6e 61 74 65 thread-terminate
4160: 21 20 74 68 31 29 20 3b 3b 20 4e 6f 74 20 73 75 ! th1) ;; Not su
4170: 72 65 20 69 66 20 74 68 69 73 20 69 73 20 61 20 re if this is a
4180: 67 6f 6f 64 20 69 64 65 61 0a 09 20 20 20 20 28 good idea.. (
4190: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 thread-sleep! 1)
41a0: 20 20 20 20 20 20 20 3b 3b 20 67 69 76 65 20 74 ;; give t
41b0: 68 72 65 61 64 20 74 68 31 20 61 20 63 68 61 6e hread th1 a chan
41c0: 63 65 20 74 6f 20 62 65 20 64 6f 6e 65 20 54 4f ce to be done TO
41d0: 44 4f 3a 20 56 65 72 69 66 79 20 74 68 69 73 20 DO: Verify this
41e0: 69 73 20 6e 65 65 64 65 64 2e 20 41 74 20 30 2e is needed. At 0.
41f0: 31 20 49 20 77 61 73 20 67 65 74 74 69 6e 67 20 1 I was getting
4200: 66 61 69 6c 20 74 6f 20 73 74 6f 70 2c 20 69 6e fail to stop, in
4210: 63 72 65 61 73 65 64 20 74 6f 20 74 6f 74 61 6c creased to total
4220: 20 6f 66 20 31 2e 31 20 73 65 63 2e 0a 09 20 20 of 1.1 sec...
4230: 20 20 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 6d (mutex-lock! m
4240: 29 0a 09 20 20 20 20 28 6c 65 74 2a 20 28 28 69 ).. (let* ((i
4250: 74 65 6d 2d 70 61 74 68 20 28 69 74 65 6d 2d 6c tem-path (item-l
4260: 69 73 74 2d 3e 70 61 74 68 20 69 74 65 6d 64 61 ist->path itemda
4270: 74 29 29 0a 09 09 20 20 20 28 74 65 73 74 69 6e t))... (testin
4280: 66 6f 20 20 28 63 64 62 3a 67 65 74 2d 74 65 73 fo (cdb:get-tes
4290: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 2a 72 75 t-info-by-id *ru
42a0: 6e 72 65 6d 6f 74 65 2a 20 74 65 73 74 2d 69 64 nremote* test-id
42b0: 29 29 29 20 3b 3b 20 29 29 20 3b 3b 20 72 75 6e ))) ;; )) ;; run
42c0: 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 -id test-name it
42d0: 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 20 20 em-path)))..
42e0: 20 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 ;; Am I comple
42f0: 74 65 64 3f 0a 09 20 20 20 20 20 20 28 69 66 20 ted?.. (if
4300: 28 6d 65 6d 62 65 72 20 28 64 62 3a 74 65 73 74 (member (db:test
4310: 2d 67 65 74 2d 73 74 61 74 65 20 74 65 73 74 69 -get-state testi
4320: 6e 66 6f 29 20 27 28 22 52 45 4d 4f 54 45 48 4f nfo) '("REMOTEHO
4330: 53 54 53 54 41 52 54 22 20 22 52 55 4e 4e 49 4e STSTART" "RUNNIN
4340: 47 22 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 49 74 G")) ;; NOTE: It
4350: 20 73 68 6f 75 6c 64 20 2a 6e 6f 74 2a 20 62 65 should *not* be
4360: 20 52 45 4d 4f 54 45 48 4f 53 54 53 54 41 52 54 REMOTEHOSTSTART
4370: 20 62 75 74 20 66 6f 72 20 72 65 61 73 6f 6e 73 but for reasons
4380: 20 49 20 64 6f 6e 27 74 20 79 65 74 20 75 6e 64 I don't yet und
4390: 65 72 73 74 61 6e 64 20 69 74 20 73 6f 6d 65 74 erstand it somet
43a0: 69 6d 65 73 20 67 65 74 73 20 73 74 75 63 6b 20 imes gets stuck
43b0: 69 6e 20 74 68 61 74 20 73 74 61 74 65 20 3b 3b in that state ;;
43c0: 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 (not (equal? (d
43d0: 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 b:test-get-state
43e0: 20 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 testinfo) "COMP
43f0: 4c 45 54 45 44 22 29 29 0a 09 09 20 20 28 6c 65 LETED"))... (le
4400: 74 20 28 28 6e 65 77 2d 73 74 61 74 65 20 20 28 t ((new-state (
4410: 69 66 20 6b 69 6c 6c 2d 6a 6f 62 3f 20 22 4b 49 if kill-job? "KI
4420: 4c 4c 45 44 22 20 22 43 4f 4d 50 4c 45 54 45 44 LLED" "COMPLETED
4430: 22 29 20 3b 3b 20 28 69 66 20 28 65 71 3f 20 28 ") ;; (if (eq? (
4440: 76 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d vector-ref exit-
4450: 69 6e 66 6f 20 32 29 20 30 29 20 3b 3b 20 65 78 info 2) 0) ;; ex
4460: 69 74 65 64 20 77 69 74 68 20 22 67 6f 6f 64 22 ited with "good"
4470: 20 73 74 61 74 75 73 0a 09 09 09 09 20 20 20 20 status.....
4480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44a0: 20 20 20 20 3b 3b 20 22 43 4f 4d 50 4c 45 54 45 ;; "COMPLETE
44b0: 44 22 0a 09 09 09 09 09 09 09 20 20 20 20 20 20 D"........
44c0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 28 64 62 ;; (db
44d0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
44e0: 74 65 73 74 69 6e 66 6f 29 29 29 20 20 20 3b 3b testinfo))) ;;
44f0: 20 65 6c 73 65 20 70 72 65 73 65 76 65 20 74 68 else preseve th
4500: 65 20 73 74 61 74 65 20 61 73 20 73 65 74 20 77 e state as set w
4510: 69 74 68 69 6e 20 74 68 65 20 74 65 73 74 0a 09 ithin the test..
4520: 09 09 09 20 20 20 20 29 0a 09 09 09 28 6e 65 77 ... )....(new
4530: 2d 73 74 61 74 75 73 20 28 63 6f 6e 64 0a 09 09 -status (cond...
4540: 09 09 20 20 20 20 20 28 28 6e 6f 74 20 28 76 65 .. ((not (ve
4550: 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e ctor-ref exit-in
4560: 66 6f 20 31 29 29 20 22 46 41 49 4c 22 29 20 3b fo 1)) "FAIL") ;
4570: 3b 20 6a 6f 62 20 66 61 69 6c 65 64 20 74 6f 20 ; job failed to
4580: 72 75 6e 0a 09 09 09 09 20 20 20 20 20 28 28 65 run..... ((e
4590: 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 q? rollup-status
45a0: 20 30 29 0a 09 09 09 09 20 20 20 20 20 20 3b 3b 0)..... ;;
45b0: 20 69 66 20 74 68 65 20 63 75 72 72 65 6e 74 20 if the current
45c0: 73 74 61 74 75 73 20 69 73 20 41 55 54 4f 20 74 status is AUTO t
45d0: 68 65 6e 20 64 65 66 65 72 20 74 6f 20 74 68 65 hen defer to the
45e0: 20 63 61 6c 63 75 6c 61 74 65 64 20 76 61 6c 75 calculated valu
45f0: 65 20 28 69 2e 65 2e 20 6c 65 61 76 65 20 74 68 e (i.e. leave th
4600: 69 73 20 41 55 54 4f 29 0a 09 09 09 09 20 20 20 is AUTO).....
4610: 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 28 (if (equal? (
4620: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
4630: 75 73 20 74 65 73 74 69 6e 66 6f 29 20 22 41 55 us testinfo) "AU
4640: 54 4f 22 29 20 22 41 55 54 4f 22 20 22 50 41 53 TO") "AUTO" "PAS
4650: 53 22 29 29 0a 09 09 09 09 20 20 20 20 20 28 28 S"))..... ((
4660: 65 71 3f 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 eq? rollup-statu
4670: 73 20 31 29 20 22 46 41 49 4c 22 29 0a 09 09 09 s 1) "FAIL")....
4680: 09 20 20 20 20 20 28 28 65 71 3f 20 72 6f 6c 6c . ((eq? roll
4690: 75 70 2d 73 74 61 74 75 73 20 32 29 0a 09 09 09 up-status 2)....
46a0: 09 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65 . ;; if the
46b0: 20 63 75 72 72 65 6e 74 20 73 74 61 74 75 73 20 current status
46c0: 69 73 20 41 55 54 4f 20 74 68 65 20 64 65 66 65 is AUTO the defe
46d0: 72 20 74 6f 20 74 68 65 20 63 61 6c 63 75 6c 61 r to the calcula
46e0: 74 65 64 20 76 61 6c 75 65 20 62 75 74 20 71 75 ted value but qu
46f0: 61 6c 69 66 79 20 28 69 2e 65 2e 20 6d 61 6b 65 alify (i.e. make
4700: 20 74 68 69 73 20 41 55 54 4f 2d 57 41 52 4e 29 this AUTO-WARN)
4710: 0a 09 09 09 09 20 20 20 20 20 20 28 69 66 20 28 ..... (if (
4720: 65 71 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d equal? (db:test-
4730: 67 65 74 2d 73 74 61 74 75 73 20 74 65 73 74 69 get-status testi
4740: 6e 66 6f 29 20 22 41 55 54 4f 22 29 20 22 41 55 nfo) "AUTO") "AU
4750: 54 4f 2d 57 41 52 4e 22 20 22 57 41 52 4e 22 29 TO-WARN" "WARN")
4760: 29 0a 09 09 09 09 20 20 20 20 20 28 65 6c 73 65 )..... (else
4770: 20 22 46 41 49 4c 22 29 29 29 29 20 3b 3b 20 28 "FAIL")))) ;; (
4780: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
4790: 75 73 20 74 65 73 74 69 6e 66 6f 29 29 29 0a 09 us testinfo)))..
47a0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
47b0: 74 2d 69 6e 66 6f 20 31 20 22 54 65 73 74 20 65 t-info 1 "Test e
47c0: 78 69 74 65 64 20 69 6e 20 73 74 61 74 65 3d 22 xited in state="
47d0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 (db:test-get-st
47e0: 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 2c ate testinfo) ",
47f0: 20 73 65 74 74 69 6e 67 20 73 74 61 74 65 2f 73 setting state/s
4800: 74 61 74 75 73 20 62 61 73 65 64 20 6f 6e 20 65 tatus based on e
4810: 78 69 74 20 63 6f 64 65 20 6f 66 20 22 20 28 76 xit code of " (v
4820: 65 63 74 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 ector-ref exit-i
4830: 6e 66 6f 20 31 29 20 22 20 61 6e 64 20 72 6f 6c nfo 1) " and rol
4840: 6c 75 70 2d 73 74 61 74 75 73 20 6f 66 20 22 20 lup-status of "
4850: 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 29 0a 09 rollup-status)..
4860: 09 20 20 20 20 28 74 65 73 74 73 3a 74 65 73 74 . (tests:test
4870: 2d 73 65 74 2d 73 74 61 74 75 73 21 20 74 65 73 -set-status! tes
4880: 74 2d 69 64 20 0a 09 09 09 09 09 20 20 20 20 6e t-id ...... n
4890: 65 77 2d 73 74 61 74 65 0a 09 09 09 09 09 20 20 ew-state......
48a0: 20 20 6e 65 77 2d 73 74 61 74 75 73 0a 09 09 09 new-status....
48b0: 09 09 20 20 20 20 28 61 72 67 73 3a 67 65 74 2d .. (args:get-
48c0: 61 72 67 20 22 2d 6d 22 29 20 23 66 29 0a 09 09 arg "-m") #f)...
48d0: 20 20 20 20 3b 3b 20 6e 65 65 64 20 74 6f 20 75 ;; need to u
48e0: 70 64 61 74 65 20 74 68 65 20 74 6f 70 20 74 65 pdate the top te
48f0: 73 74 20 72 65 63 6f 72 64 20 69 66 20 50 41 53 st record if PAS
4900: 53 20 6f 72 20 46 41 49 4c 20 61 6e 64 20 74 68 S or FAIL and th
4910: 69 73 20 69 73 20 61 20 73 75 62 74 65 73 74 0a is is a subtest.
4920: 09 09 20 20 20 20 3b 3b 20 4e 4f 20 4e 45 45 44 .. ;; NO NEED
4930: 20 54 4f 20 43 41 4c 4c 20 72 6f 6c 6c 2d 75 70 TO CALL roll-up
4940: 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 -pass-fail-count
4950: 73 20 48 45 52 45 2c 20 54 48 49 53 20 49 53 20 s HERE, THIS IS
4960: 44 4f 4e 45 20 49 4e 20 72 6f 6c 6c 2d 75 70 2d DONE IN roll-up-
4970: 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e 74 73 pass-fail-counts
4980: 20 63 61 6c 6c 65 64 20 62 79 20 74 65 73 74 73 called by tests
4990: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
49a0: 21 0a 09 09 20 20 20 20 3b 3b 20 28 69 66 20 28 !... ;; (if (
49b0: 6e 6f 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d not (equal? item
49c0: 2d 70 61 74 68 20 22 22 29 29 0a 09 09 20 20 20 -path ""))...
49d0: 20 3b 3b 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ;; (begin..
49e0: 09 20 20 20 20 3b 3b 20 20 20 20 20 20 20 28 74 . ;; (t
49f0: 68 72 65 61 64 2d 73 6c 65 65 70 21 20 30 2e 31 hread-sleep! 0.1
4a00: 29 20 3b 3b 20 67 69 76 65 20 6f 74 68 65 72 20 ) ;; give other
4a10: 70 72 6f 63 65 73 73 65 73 20 61 6e 20 6f 70 70 processes an opp
4a20: 6f 72 74 75 6e 69 74 79 20 74 6f 20 61 63 63 65 ortunity to acce
4a30: 73 73 20 74 68 65 20 64 62 20 61 73 20 72 6f 6c ss the db as rol
4a40: 6c 75 70 20 69 73 20 6c 6f 77 65 72 20 70 72 69 lup is lower pri
4a50: 6f 72 69 74 79 0a 09 09 20 20 20 20 3b 3b 20 20 ority... ;;
4a60: 20 20 20 20 20 28 63 64 62 3a 72 6f 6c 6c 2d 75 (cdb:roll-u
4a70: 70 2d 70 61 73 73 2d 66 61 69 6c 2d 63 6f 75 6e p-pass-fail-coun
4a80: 74 73 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 ts *runremote* r
4a90: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
4aa0: 69 74 65 6d 2d 70 61 74 68 20 6e 65 77 2d 73 74 item-path new-st
4ab0: 61 74 75 73 29 29 29 0a 09 09 20 20 20 20 29 29 atus)))... ))
4ac0: 0a 09 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 .. ;; for a
4ad0: 75 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f utomated creatio
4ae0: 6e 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 n of the rollup
4af0: 68 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 html file this i
4b00: 73 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e s a good place..
4b10: 2e 0a 09 20 20 20 20 20 20 28 69 66 20 28 6e 6f ... (if (no
4b20: 74 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 t (equal? item-p
4b30: 61 74 68 20 22 22 29 29 0a 09 09 20 20 28 74 65 ath ""))... (te
4b40: 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
4b50: 65 6d 73 20 23 66 20 72 75 6e 2d 69 64 20 74 65 ems #f run-id te
4b60: 73 74 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 st-id test-name
4b70: 23 66 29 29 29 20 3b 3b 20 64 6f 6e 27 74 20 66 #f))) ;; don't f
4b80: 6f 72 63 65 20 2d 20 6a 75 73 74 20 75 70 64 61 orce - just upda
4b90: 74 65 20 69 66 20 6e 6f 0a 09 20 20 20 20 28 6d te if no.. (m
4ba0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 6d 29 0a utex-unlock! m).
4bb0: 09 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e . (debug:prin
4bc0: 74 20 32 20 22 4f 75 74 70 75 74 20 66 72 6f 6d t 2 "Output from
4bd0: 20 72 75 6e 6e 69 6e 67 20 22 20 66 75 6c 6c 72 running " fullr
4be0: 75 6e 73 63 72 69 70 74 20 22 2c 20 70 69 64 20 unscript ", pid
4bf0: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 " (vector-ref ex
4c00: 69 74 2d 69 6e 66 6f 20 30 29 20 22 20 69 6e 20 it-info 0) " in
4c10: 77 6f 72 6b 20 61 72 65 61 20 22 20 0a 09 09 09 work area " ....
4c20: 20 77 6f 72 6b 2d 61 72 65 61 20 22 3a 5c 6e 3d work-area ":\n=
4c30: 3d 3d 3d 5c 6e 20 65 78 69 74 20 63 6f 64 65 20 ===\n exit code
4c40: 22 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 78 " (vector-ref ex
4c50: 69 74 2d 69 6e 66 6f 20 32 29 20 22 5c 6e 22 20 it-info 2) "\n"
4c60: 22 3d 3d 3d 3d 5c 6e 22 29 0a 09 20 20 20 20 28 "====\n").. (
4c70: 69 66 20 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d if (not (vector-
4c80: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 31 29 ref exit-info 1)
4c90: 29 0a 09 09 28 65 78 69 74 20 34 29 29 29 29 29 )...(exit 4)))))
4ca0: 29 29 0a 0a 3b 3b 20 73 65 74 20 75 70 20 74 68 ))..;; set up th
4cb0: 65 20 76 65 72 79 20 62 61 73 69 63 73 20 6e 65 e very basics ne
4cc0: 65 64 65 64 20 66 6f 72 20 64 6f 69 6e 67 20 61 eded for doing a
4cd0: 6e 79 74 68 69 6e 67 20 68 65 72 65 2e 0a 28 64 nything here..(d
4ce0: 65 66 69 6e 65 20 28 73 65 74 75 70 2d 66 6f 72 efine (setup-for
4cf0: 2d 72 75 6e 29 0a 20 20 3b 3b 20 77 6f 75 6c 64 -run). ;; would
4d00: 20 73 65 74 20 76 61 6c 75 65 73 20 66 6f 72 20 set values for
4d10: 4b 45 59 53 20 69 6e 20 74 68 65 20 65 6e 76 69 KEYS in the envi
4d20: 72 6f 6e 6d 65 6e 74 20 68 65 72 65 20 66 6f 72 ronment here for
4d30: 20 62 65 74 74 65 72 20 73 75 70 70 6f 72 74 20 better support
4d40: 6f 66 20 65 6e 76 2d 6f 76 65 72 72 69 64 65 20 of env-override
4d50: 62 75 74 20 0a 20 20 3b 3b 20 68 61 76 65 20 63 but . ;; have c
4d60: 68 69 63 6b 65 6e 2f 65 67 67 20 73 63 65 6e 61 hicken/egg scena
4d70: 72 69 6f 2e 20 6e 65 65 64 20 74 6f 20 72 65 61 rio. need to rea
4d80: 64 20 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 d megatest.confi
4d90: 67 20 74 68 65 6e 20 72 65 61 64 20 69 74 20 61 g then read it a
4da0: 67 61 69 6e 2e 20 47 6f 69 6e 67 20 74 6f 20 0a gain. Going to .
4db0: 20 20 3b 3b 20 70 61 73 73 20 6f 6e 20 74 68 61 ;; pass on tha
4dc0: 74 20 69 64 65 61 20 66 6f 72 20 6e 6f 77 0a 20 t idea for now.
4dd0: 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 ;; special case
4de0: 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 . (if (not (has
4df0: 68 2d 74 61 62 6c 65 3f 20 2a 63 6f 6e 66 69 67 h-table? *config
4e00: 64 61 74 2a 29 29 20 20 3b 3b 20 6e 6f 20 6e 65 dat*)) ;; no ne
4e10: 65 64 20 74 6f 20 72 65 2d 6f 70 65 6e 20 6f 6e ed to re-open on
4e20: 20 65 76 65 72 79 20 63 61 6c 6c 0a 20 20 20 20 every call.
4e30: 20 20 28 62 65 67 69 6e 0a 09 28 73 65 74 21 20 (begin..(set!
4e40: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 20 28 66 69 *configinfo* (fi
4e50: 6e 64 2d 61 6e 64 2d 72 65 61 64 2d 63 6f 6e 66 nd-and-read-conf
4e60: 69 67 20 0a 09 09 09 20 20 20 20 28 69 66 20 28 ig .... (if (
4e70: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 63 args:get-arg "-c
4e80: 6f 6e 66 69 67 22 29 28 61 72 67 73 3a 67 65 74 onfig")(args:get
4e90: 2d 61 72 67 20 22 2d 63 6f 6e 66 69 67 22 29 20 -arg "-config")
4ea0: 22 6d 65 67 61 74 65 73 74 2e 63 6f 6e 66 69 67 "megatest.config
4eb0: 22 29 0a 09 09 09 20 20 20 20 65 6e 76 69 72 6f ").... enviro
4ec0: 6e 2d 70 61 74 74 3a 20 22 65 6e 76 2d 6f 76 65 n-patt: "env-ove
4ed0: 72 72 69 64 65 22 0a 09 09 09 20 20 20 20 67 69 rride".... gi
4ee0: 76 65 6e 2d 74 6f 70 70 61 74 68 3a 20 28 67 65 ven-toppath: (ge
4ef0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
4f00: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
4f10: 52 45 41 5f 48 4f 4d 45 22 29 0a 09 09 09 20 20 REA_HOME")....
4f20: 20 20 70 61 74 68 65 6e 76 76 61 72 3a 20 22 4d pathenvvar: "M
4f30: 54 5f 52 55 4e 5f 41 52 45 41 5f 48 4f 4d 45 22 T_RUN_AREA_HOME"
4f40: 29 29 0a 09 28 73 65 74 21 20 2a 63 6f 6e 66 69 ))..(set! *confi
4f50: 67 64 61 74 2a 20 20 28 69 66 20 28 63 61 72 20 gdat* (if (car
4f60: 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 63 61 *configinfo*)(ca
4f70: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 20 r *configinfo*)
4f80: 23 66 29 29 0a 09 28 73 65 74 21 20 2a 74 6f 70 #f))..(set! *top
4f90: 70 61 74 68 2a 20 20 20 20 28 69 66 20 28 63 61 path* (if (ca
4fa0: 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f 2a 29 28 r *configinfo*)(
4fb0: 63 61 64 72 20 2a 63 6f 6e 66 69 67 69 6e 66 6f cadr *configinfo
4fc0: 2a 29 20 23 66 29 29 0a 09 28 69 66 20 2a 74 6f *) #f))..(if *to
4fd0: 70 70 61 74 68 2a 0a 09 20 20 20 20 28 73 65 74 ppath*.. (set
4fe0: 65 6e 76 20 22 4d 54 5f 52 55 4e 5f 41 52 45 41 env "MT_RUN_AREA
4ff0: 5f 48 4f 4d 45 22 20 2a 74 6f 70 70 61 74 68 2a _HOME" *toppath*
5000: 29 20 3b 3b 20 74 6f 20 62 65 20 64 65 70 72 65 ) ;; to be depre
5010: 63 61 74 65 64 0a 09 20 20 20 20 28 64 65 62 75 cated.. (debu
5020: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
5030: 3a 20 66 61 69 6c 65 64 20 74 6f 20 66 69 6e 64 : failed to find
5040: 20 74 68 65 20 74 6f 70 20 70 61 74 68 20 74 6f the top path to
5050: 20 79 6f 75 72 20 4d 65 67 61 74 65 73 74 20 61 your Megatest a
5060: 72 65 61 2e 22 29 29 29 29 0a 20 20 2a 74 6f 70 rea.")))). *top
5070: 70 61 74 68 2a 29 0a 0a 28 64 65 66 69 6e 65 20 path*)..(define
5080: 28 67 65 74 2d 62 65 73 74 2d 64 69 73 6b 20 63 (get-best-disk c
5090: 6f 6e 66 64 61 74 29 0a 20 20 28 6c 65 74 2a 20 onfdat). (let*
50a0: 28 28 64 69 73 6b 73 20 20 20 20 28 68 61 73 68 ((disks (hash
50b0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
50c0: 6c 74 20 63 6f 6e 66 64 61 74 20 22 64 69 73 6b lt confdat "disk
50d0: 73 22 20 23 66 29 29 0a 09 20 28 62 65 73 74 20 s" #f)).. (best
50e0: 20 20 20 20 23 66 29 0a 09 20 28 62 65 73 74 73 #f).. (bests
50f0: 69 7a 65 20 30 29 29 0a 20 20 20 20 28 69 66 20 ize 0)). (if
5100: 64 69 73 6b 73 20 0a 09 28 66 6f 72 2d 65 61 63 disks ..(for-eac
5110: 68 20 0a 09 20 28 6c 61 6d 62 64 61 20 28 64 69 h .. (lambda (di
5120: 73 6b 2d 6e 75 6d 29 0a 09 20 20 20 28 6c 65 74 sk-num).. (let
5130: 2a 20 28 28 64 69 72 70 61 74 68 20 20 20 20 28 * ((dirpath (
5140: 63 61 64 72 20 28 61 73 73 6f 63 20 64 69 73 6b cadr (assoc disk
5150: 2d 6e 75 6d 20 64 69 73 6b 73 29 29 29 0a 09 09 -num disks)))...
5160: 20 20 28 66 72 65 65 73 70 63 20 20 20 20 28 69 (freespc (i
5170: 66 20 28 61 6e 64 20 28 64 69 72 65 63 74 6f 72 f (and (director
5180: 79 3f 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 y? dirpath).....
5190: 20 20 20 20 20 20 20 28 66 69 6c 65 2d 77 72 69 (file-wri
51a0: 74 65 2d 61 63 63 65 73 73 3f 20 64 69 72 70 61 te-access? dirpa
51b0: 74 68 29 29 0a 09 09 09 09 20 20 28 67 65 74 2d th))..... (get-
51c0: 64 66 20 64 69 72 70 61 74 68 29 0a 09 09 09 09 df dirpath).....
51d0: 20 20 28 62 65 67 69 6e 0a 09 09 09 09 20 20 20 (begin.....
51e0: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
51f0: 22 57 41 52 4e 49 4e 47 3a 20 70 61 74 68 20 22 "WARNING: path "
5200: 20 64 69 72 70 61 74 68 20 22 20 69 6e 20 5b 64 dirpath " in [d
5210: 69 73 6b 73 5d 20 73 65 63 74 69 6f 6e 20 6e 6f isks] section no
5220: 74 20 76 61 6c 69 64 20 6f 72 20 77 72 69 74 61 t valid or writa
5230: 62 6c 65 22 29 0a 09 09 09 09 20 20 20 20 30 29 ble")..... 0)
5240: 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 3e ))).. (if (>
5250: 20 66 72 65 65 73 70 63 20 62 65 73 74 73 69 7a freespc bestsiz
5260: 65 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 09 20 e)... (begin...
5270: 20 20 28 73 65 74 21 20 62 65 73 74 20 20 20 20 (set! best
5280: 20 64 69 72 70 61 74 68 29 0a 09 09 20 20 20 28 dirpath)... (
5290: 73 65 74 21 20 62 65 73 74 73 69 7a 65 20 66 72 set! bestsize fr
52a0: 65 65 73 70 63 29 29 29 29 29 0a 09 20 28 6d 61 eespc))))).. (ma
52b0: 70 20 63 61 72 20 64 69 73 6b 73 29 29 29 0a 20 p car disks))).
52c0: 20 20 20 28 69 66 20 62 65 73 74 0a 09 62 65 73 (if best..bes
52d0: 74 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 64 65 t..(begin.. (de
52e0: 62 75 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 bug:print 0 "ERR
52f0: 4f 52 3a 20 4e 6f 20 76 61 6c 69 64 20 64 69 73 OR: No valid dis
5300: 6b 73 20 66 6f 75 6e 64 20 69 6e 20 6d 65 67 61 ks found in mega
5310: 74 65 73 74 2e 63 6f 6e 66 69 67 2e 20 50 6c 65 test.config. Ple
5320: 61 73 65 20 61 64 64 20 73 6f 6d 65 20 74 6f 20 ase add some to
5330: 79 6f 75 72 20 5b 64 69 73 6b 73 5d 20 73 65 63 your [disks] sec
5340: 74 69 6f 6e 22 29 0a 09 20 20 28 65 78 69 74 20 tion").. (exit
5350: 31 29 29 29 29 29 0a 0a 3b 3b 20 44 65 73 69 72 1)))))..;; Desir
5360: 65 64 20 64 69 72 65 63 74 6f 72 79 20 73 74 72 ed directory str
5370: 75 63 74 75 72 65 3a 0a 3b 3b 0a 3b 3b 20 20 3c ucture:.;;.;; <
5380: 6c 69 6e 6b 64 69 72 3e 20 2d 20 3c 74 61 72 67 linkdir> - <targ
5390: 65 74 3e 20 2d 20 3c 74 65 73 74 6e 61 6d 65 3e et> - <testname>
53a0: 20 2d 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 -..;;
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53c0: 20 20 20 20 20 20 20 20 20 20 20 7c 0a 3b 3b 20 |.;;
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53f0: 20 20 20 20 76 0a 3b 3b 20 20 3c 72 75 6e 64 69 v.;; <rundi
5400: 72 3e 20 20 2d 20 20 3c 74 61 72 67 65 74 3e 20 r> - <target>
5410: 20 2d 20 20 20 20 3c 74 65 73 74 6e 61 6d 65 3e - <testname>
5420: 20 2d 7c 2d 20 3c 69 74 65 6d 70 61 74 68 28 73 -|- <itempath(s
5430: 29 3e 0a 3b 3b 0a 3b 3b 20 20 64 69 72 20 73 74 )>.;;.;; dir st
5440: 6f 72 65 64 20 69 6e 20 74 65 73 74 20 69 73 3a ored in test is:
5450: 0a 3b 3b 20 0a 3b 3b 20 20 3c 6c 69 6e 6b 64 69 .;; .;; <linkdi
5460: 72 3e 20 2d 20 3c 74 61 72 67 65 74 3e 20 2d 20 r> - <target> -
5470: 3c 74 65 73 74 6e 61 6d 65 3e 20 5b 20 2d 20 3c <testname> [ - <
5480: 69 74 65 6d 70 61 74 68 3e 20 5d 0a 3b 3b 20 0a itempath> ].;; .
5490: 3b 3b 20 41 6c 6c 20 6c 6f 67 20 66 69 6c 65 20 ;; All log file
54a0: 6c 69 6e 6b 73 20 73 68 6f 75 6c 64 20 62 65 20 links should be
54b0: 73 74 6f 72 65 64 20 72 65 6c 61 74 69 76 65 20 stored relative
54c0: 74 6f 20 74 68 65 20 74 6f 70 20 6f 66 20 6c 69 to the top of li
54d0: 6e 6b 20 70 61 74 68 0a 3b 3b 20 20 0a 3b 3b 20 nk path.;; .;;
54e0: 3c 74 61 72 67 65 74 3e 20 2d 20 3c 74 65 73 74 <target> - <test
54f0: 6e 61 6d 65 3e 20 5b 20 2d 20 3c 69 74 65 6d 70 name> [ - <itemp
5500: 61 74 68 3e 20 5d 20 0a 3b 3b 0a 28 64 65 66 69 ath> ] .;;.(defi
5510: 6e 65 20 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d ne (create-work-
5520: 61 72 65 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d area run-id run-
5530: 69 6e 66 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 info keyvals tes
5540: 74 2d 69 64 20 74 65 73 74 2d 73 72 63 2d 70 61 t-id test-src-pa
5550: 74 68 20 64 69 73 6b 2d 70 61 74 68 20 74 65 73 th disk-path tes
5560: 74 6e 61 6d 65 20 69 74 65 6d 64 61 74 29 0a 20 tname itemdat).
5570: 20 28 6c 65 74 2a 20 28 28 69 74 65 6d 2d 70 61 (let* ((item-pa
5580: 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 th (item-list->p
5590: 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 20 ath itemdat))..
55a0: 28 72 75 6e 6e 61 6d 65 20 20 28 64 62 3a 67 65 (runname (db:ge
55b0: 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 t-value-by-heade
55c0: 72 20 28 64 62 3a 67 65 74 2d 72 6f 77 20 72 75 r (db:get-row ru
55d0: 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 20 n-info)......
55e0: 28 64 62 3a 67 65 74 2d 68 65 61 64 65 72 20 72 (db:get-header r
55f0: 75 6e 2d 69 6e 66 6f 29 0a 09 09 09 09 09 20 20 un-info)......
5600: 20 22 72 75 6e 6e 61 6d 65 22 29 29 0a 09 20 3b "runname")).. ;
5610: 3b 20 63 6f 6e 76 65 72 74 20 62 61 63 6b 20 74 ; convert back t
5620: 6f 20 64 62 3a 20 66 72 6f 6d 20 72 64 62 3a 20 o db: from rdb:
5630: 2d 20 74 68 69 73 20 69 73 20 61 6c 77 61 79 73 - this is always
5640: 20 72 75 6e 20 61 74 20 73 65 72 76 65 72 20 65 run at server e
5650: 6e 64 0a 09 20 28 74 61 72 67 65 74 20 20 20 28 nd.. (target (
5660: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
5670: 73 65 20 28 6d 61 70 20 63 61 64 72 20 6b 65 79 se (map cadr key
5680: 76 61 6c 73 29 20 22 2f 22 29 29 0a 0a 09 20 28 vals) "/"))... (
5690: 6e 6f 74 2d 69 74 65 72 61 74 65 64 20 20 28 65 not-iterated (e
56a0: 71 75 61 6c 3f 20 22 22 20 69 74 65 6d 2d 70 61 qual? "" item-pa
56b0: 74 68 29 29 0a 0a 09 20 3b 3b 20 61 6c 6c 20 74 th))... ;; all t
56c0: 65 73 74 73 20 61 72 65 20 66 6f 75 6e 64 20 61 ests are found a
56d0: 74 20 3c 72 75 6e 64 69 72 3e 2f 74 65 73 74 2d t <rundir>/test-
56e0: 62 61 73 65 20 6f 72 20 3c 6c 69 6e 6b 64 69 72 base or <linkdir
56f0: 3e 2f 74 65 73 74 2d 62 61 73 65 0a 09 20 28 74 >/test-base.. (t
5700: 65 73 74 74 6f 70 2d 62 61 73 65 20 28 63 6f 6e esttop-base (con
5710: 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e c target "/" run
5720: 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d name "/" testnam
5730: 65 29 29 0a 09 20 28 74 65 73 74 2d 62 61 73 65 e)).. (test-base
5740: 20 20 20 20 28 63 6f 6e 63 20 74 65 73 74 74 6f (conc testto
5750: 70 2d 62 61 73 65 20 28 69 66 20 6e 6f 74 2d 69 p-base (if not-i
5760: 74 65 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 terated "" "/")
5770: 69 74 65 6d 2d 70 61 74 68 29 29 0a 0a 09 20 3b item-path))... ;
5780: 3b 20 6e 62 2f 2f 20 69 66 20 69 74 65 6d 70 61 ; nb// if itempa
5790: 74 68 20 69 73 20 6e 6f 74 20 22 22 20 74 68 65 th is not "" the
57a0: 6e 20 69 74 20 69 73 20 70 72 65 66 69 78 65 64 n it is prefixed
57b0: 20 77 69 74 68 20 22 2f 22 0a 09 20 28 74 6f 70 with "/".. (top
57c0: 74 65 73 74 2d 70 61 74 68 20 28 63 6f 6e 63 20 test-path (conc
57d0: 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 20 74 65 disk-path "/" te
57e0: 73 74 74 6f 70 2d 62 61 73 65 29 29 0a 09 20 28 sttop-base)).. (
57f0: 74 65 73 74 2d 70 61 74 68 20 20 20 20 28 63 6f test-path (co
5800: 6e 63 20 64 69 73 6b 2d 70 61 74 68 20 22 2f 22 nc disk-path "/"
5810: 20 74 65 73 74 2d 62 61 73 65 29 29 0a 0a 09 20 test-base))...
5820: 3b 3b 20 65 6e 73 75 72 65 20 74 68 69 73 20 65 ;; ensure this e
5830: 78 69 73 74 73 20 66 69 72 73 74 20 61 73 20 6c xists first as l
5840: 69 6e 6b 73 20 74 6f 20 73 75 62 74 65 73 74 73 inks to subtests
5850: 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 65 64 must be created
5860: 20 74 68 65 72 65 0a 09 20 28 6c 69 6e 6b 74 72 there.. (linktr
5870: 65 65 20 20 28 6c 65 74 20 28 28 72 64 20 28 63 ee (let ((rd (c
5880: 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f onfig-lookup *co
5890: 6e 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 nfigdat* "setup"
58a0: 20 22 6c 69 6e 6b 74 72 65 65 22 29 29 29 0a 09 "linktree")))..
58b0: 09 20 20 20 20 20 20 28 69 66 20 72 64 20 72 64 . (if rd rd
58c0: 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 74 68 2a (conc *toppath*
58d0: 20 22 2f 72 75 6e 73 22 29 29 29 29 0a 0a 09 20 "/runs"))))...
58e0: 28 6c 6e 6b 62 61 73 65 20 20 28 63 6f 6e 63 20 (lnkbase (conc
58f0: 6c 69 6e 6b 74 72 65 65 20 22 2f 22 20 74 61 72 linktree "/" tar
5900: 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 29 get "/" runname)
5910: 29 0a 09 20 28 6c 6e 6b 70 61 74 68 20 20 28 63 ).. (lnkpath (c
5920: 6f 6e 63 20 6c 6e 6b 62 61 73 65 20 22 2f 22 20 onc lnkbase "/"
5930: 74 65 73 74 6e 61 6d 65 29 29 0a 09 20 28 6c 6e testname)).. (ln
5940: 6b 70 61 74 68 66 20 28 63 6f 6e 63 20 6c 6e 6b kpathf (conc lnk
5950: 70 61 74 68 20 28 69 66 20 6e 6f 74 2d 69 74 65 path (if not-ite
5960: 72 61 74 65 64 20 22 22 20 22 2f 22 29 20 69 74 rated "" "/") it
5970: 65 6d 2d 70 61 74 68 29 29 29 0a 0a 20 20 20 20 em-path)))..
5980: 3b 3b 20 55 70 64 61 74 65 20 74 68 65 20 72 75 ;; Update the ru
5990: 6e 64 69 72 20 70 61 74 68 20 69 6e 20 74 68 65 ndir path in the
59a0: 20 74 65 73 74 20 72 65 63 6f 72 64 20 66 6f 72 test record for
59b0: 20 61 6c 6c 0a 20 20 20 20 28 63 64 62 3a 74 65 all. (cdb:te
59c0: 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 2d 62 79 st-set-rundir-by
59d0: 2d 74 65 73 74 2d 69 64 20 2a 72 75 6e 72 65 6d -test-id *runrem
59e0: 6f 74 65 2a 20 74 65 73 74 2d 69 64 20 28 73 64 ote* test-id (sd
59f0: 62 3a 71 72 79 20 27 67 65 74 69 64 20 6c 6e 6b b:qry 'getid lnk
5a00: 70 61 74 68 66 29 29 0a 0a 20 20 20 20 28 64 65 pathf)).. (de
5a10: 62 75 67 3a 70 72 69 6e 74 20 32 20 22 49 4e 46 bug:print 2 "INF
5a20: 4f 3a 5c 6e 20 20 20 20 20 20 20 6c 6e 6b 62 61 O:\n lnkba
5a30: 73 65 3d 22 20 6c 6e 6b 62 61 73 65 20 22 5c 6e se=" lnkbase "\n
5a40: 20 20 20 20 20 20 20 6c 6e 6b 70 61 74 68 3d 22 lnkpath="
5a50: 20 6c 6e 6b 70 61 74 68 20 22 5c 6e 20 20 74 6f lnkpath "\n to
5a60: 70 74 65 73 74 2d 70 61 74 68 3d 22 20 74 6f 70 ptest-path=" top
5a70: 74 65 73 74 2d 70 61 74 68 20 22 5c 6e 20 20 20 test-path "\n
5a80: 20 20 74 65 73 74 2d 70 61 74 68 3d 22 20 74 65 test-path=" te
5a90: 73 74 2d 70 61 74 68 29 0a 20 20 20 20 28 69 66 st-path). (if
5aa0: 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 69 73 (not (file-exis
5ab0: 74 73 3f 20 6c 69 6e 6b 74 72 65 65 29 29 0a 09 ts? linktree))..
5ac0: 28 62 65 67 69 6e 0a 09 20 20 28 64 65 62 75 67 (begin.. (debug
5ad0: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
5ae0: 47 3a 20 6c 69 6e 6b 74 72 65 65 20 64 69 64 20 G: linktree did
5af0: 6e 6f 74 20 65 78 69 73 74 21 20 43 72 65 61 74 not exist! Creat
5b00: 69 6e 67 20 69 74 20 6e 6f 77 20 61 74 20 22 20 ing it now at "
5b10: 6c 69 6e 6b 74 72 65 65 29 0a 09 20 20 28 63 72 linktree).. (cr
5b20: 65 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 6c eate-directory l
5b30: 69 6e 6b 74 72 65 65 20 23 74 29 29 29 20 3b 3b inktree #t))) ;;
5b40: 20 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 (system (conc "
5b50: 6d 6b 64 69 72 20 2d 70 20 22 20 6c 69 6e 6b 74 mkdir -p " linkt
5b60: 72 65 65 29 29 29 29 0a 20 20 20 20 3b 3b 20 63 ree)))). ;; c
5b70: 72 65 61 74 65 20 74 68 65 20 64 69 72 65 63 74 reate the direct
5b80: 6f 72 79 20 66 6f 72 20 74 68 65 20 74 65 73 74 ory for the test
5b90: 73 20 64 69 72 20 6c 69 6e 6b 73 2c 20 74 68 69 s dir links, thi
5ba0: 73 20 69 73 20 6e 65 65 64 65 64 20 6e 6f 20 6d s is needed no m
5bb0: 61 74 74 65 72 20 77 68 61 74 2e 2e 2e 0a 20 20 atter what....
5bc0: 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 (if (and (not
5bd0: 28 64 69 72 65 63 74 6f 72 79 2d 65 78 69 73 74 (directory-exist
5be0: 73 3f 20 6c 6e 6b 62 61 73 65 29 29 0a 09 20 20 s? lnkbase))..
5bf0: 20 20 20 28 6e 6f 74 20 28 66 69 6c 65 2d 65 78 (not (file-ex
5c00: 69 73 74 73 3f 20 6c 6e 6b 62 61 73 65 29 29 29 ists? lnkbase)))
5c10: 0a 09 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 ..(create-direct
5c20: 6f 72 79 20 6c 6e 6b 62 61 73 65 20 23 74 29 29 ory lnkbase #t))
5c30: 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 75 70 64 . . ;; upd
5c40: 61 74 65 20 74 68 65 20 74 6f 70 74 65 73 74 20 ate the toptest
5c50: 72 65 63 6f 72 64 20 77 69 74 68 20 69 74 73 20 record with its
5c60: 6c 6f 63 61 74 69 6f 6e 20 72 75 6e 64 69 72 2c location rundir,
5c70: 20 63 61 63 68 65 20 74 68 65 20 70 61 74 68 0a cache the path.
5c80: 20 20 20 20 3b 3b 20 54 68 69 73 20 77 61 73 73 ;; This wass
5c90: 20 68 69 67 68 6c 79 20 69 6e 65 66 66 69 63 69 highly ineffici
5ca0: 65 6e 74 2c 20 6f 6e 65 20 64 62 20 77 72 69 74 ent, one db writ
5cb0: 65 20 66 6f 72 20 65 76 65 72 79 20 73 75 62 74 e for every subt
5cc0: 65 73 74 2c 20 70 6f 74 65 6e 74 69 61 6c 6c 79 est, potentially
5cd0: 0a 20 20 20 20 3b 3b 20 74 68 6f 75 73 61 6e 64 . ;; thousand
5ce0: 73 20 6f 66 20 75 6e 6e 65 63 65 73 73 61 72 79 s of unnecessary
5cf0: 20 75 70 64 61 74 65 73 2c 20 63 61 63 68 65 20 updates, cache
5d00: 74 68 65 20 66 61 63 74 20 69 74 20 77 61 73 20 the fact it was
5d10: 73 65 74 20 61 6e 64 20 64 6f 6e 27 74 20 73 65 set and don't se
5d20: 74 20 69 74 20 0a 20 20 20 20 3b 3b 20 61 67 61 t it . ;; aga
5d30: 69 6e 2e 20 0a 0a 20 20 20 20 3b 3b 20 4e 42 20 in. .. ;; NB
5d40: 2d 20 54 68 69 73 20 69 73 20 6e 6f 74 20 77 6f - This is not wo
5d50: 72 6b 69 6e 67 20 72 69 67 68 74 20 2d 20 73 6f rking right - so
5d60: 6d 65 20 74 6f 70 20 74 65 73 74 73 20 61 72 65 me top tests are
5d70: 20 6e 6f 74 20 67 65 74 74 69 6e 67 20 74 68 65 not getting the
5d80: 20 70 61 74 68 20 73 65 74 21 21 21 0a 0a 20 20 path set!!!..
5d90: 20 20 28 69 66 20 28 6e 6f 74 20 28 68 61 73 68 (if (not (hash
5da0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
5db0: 6c 74 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 lt *toptest-path
5dc0: 73 2a 20 74 65 73 74 6e 61 6d 65 20 23 66 29 29 s* testname #f))
5dd0: 0a 09 28 6c 65 74 2a 20 28 28 74 65 73 74 69 6e ..(let* ((testin
5de0: 66 6f 20 20 20 20 20 20 20 28 63 64 62 3a 67 65 fo (cdb:ge
5df0: 74 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 t-test-info-by-i
5e00: 64 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 74 65 d *runremote* te
5e10: 73 74 2d 69 64 29 29 20 3b 3b 20 20 72 75 6e 2d st-id)) ;; run-
5e20: 69 64 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d id testname item
5e30: 2d 70 61 74 68 29 29 0a 09 20 20 20 20 20 20 20 -path))..
5e40: 28 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 20 (curr-test-path
5e50: 28 69 66 20 74 65 73 74 69 6e 66 6f 20 28 73 64 (if testinfo (sd
5e60: 62 3a 71 72 79 20 27 67 65 74 73 74 72 20 28 64 b:qry 'getstr (d
5e70: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
5e80: 72 20 74 65 73 74 69 6e 66 6f 29 29 20 23 66 29 r testinfo)) #f)
5e90: 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 6c )).. (hash-tabl
5ea0: 65 2d 73 65 74 21 20 2a 74 6f 70 74 65 73 74 2d e-set! *toptest-
5eb0: 70 61 74 68 73 2a 20 74 65 73 74 6e 61 6d 65 20 paths* testname
5ec0: 63 75 72 72 2d 74 65 73 74 2d 70 61 74 68 29 0a curr-test-path).
5ed0: 09 20 20 3b 3b 20 4e 42 2f 2f 20 57 61 73 20 74 . ;; NB// Was t
5ee0: 68 69 73 20 66 6f 72 20 74 68 65 20 74 65 73 74 his for the test
5ef0: 20 6f 72 20 66 6f 72 20 74 68 65 20 70 61 72 65 or for the pare
5f00: 6e 74 20 69 6e 20 61 6e 20 69 74 65 72 61 74 65 nt in an iterate
5f10: 64 20 74 65 73 74 3f 0a 09 20 20 28 63 64 62 3a d test?.. (cdb:
5f20: 74 65 73 74 2d 73 65 74 2d 72 75 6e 64 69 72 21 test-set-rundir!
5f30: 20 2a 72 75 6e 72 65 6d 6f 74 65 2a 20 72 75 6e *runremote* run
5f40: 2d 69 64 20 74 65 73 74 6e 61 6d 65 20 22 22 20 -id testname ""
5f50: 28 73 64 62 3a 71 72 79 20 27 67 65 74 69 64 20 (sdb:qry 'getid
5f60: 6c 6e 6b 70 61 74 68 29 29 20 3b 3b 20 74 6f 70 lnkpath)) ;; top
5f70: 74 65 73 74 2d 70 61 74 68 29 0a 09 20 20 28 69 test-path).. (i
5f80: 66 20 28 6f 72 20 28 6e 6f 74 20 63 75 72 72 2d f (or (not curr-
5f90: 74 65 73 74 2d 70 61 74 68 29 0a 09 09 20 20 28 test-path)... (
5fa0: 6e 6f 74 20 28 64 69 72 65 63 74 6f 72 79 2d 65 not (directory-e
5fb0: 78 69 73 74 73 3f 20 74 6f 70 74 65 73 74 2d 70 xists? toptest-p
5fc0: 61 74 68 29 29 29 0a 09 20 20 20 20 20 20 28 62 ath))).. (b
5fd0: 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 72 egin...(debug:pr
5fe0: 69 6e 74 2d 69 6e 66 6f 20 32 20 22 43 72 65 61 int-info 2 "Crea
5ff0: 74 69 6e 67 20 22 20 74 6f 70 74 65 73 74 2d 70 ting " toptest-p
6000: 61 74 68 20 22 20 61 6e 64 20 6c 69 6e 6b 20 22 ath " and link "
6010: 20 6c 6e 6b 70 61 74 68 29 0a 09 09 28 63 72 65 lnkpath)...(cre
6020: 61 74 65 2d 64 69 72 65 63 74 6f 72 79 20 74 6f ate-directory to
6030: 70 74 65 73 74 2d 70 61 74 68 20 23 74 29 0a 09 ptest-path #t)..
6040: 09 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 .(hash-table-set
6050: 21 20 2a 74 6f 70 74 65 73 74 2d 70 61 74 68 73 ! *toptest-paths
6060: 2a 20 74 65 73 74 6e 61 6d 65 20 74 6f 70 74 65 * testname topte
6070: 73 74 2d 70 61 74 68 29 29 29 29 29 0a 0a 20 20 st-path)))))..
6080: 20 20 3b 3b 20 4e 6f 77 20 63 72 65 61 74 65 20 ;; Now create
6090: 74 68 65 20 6c 69 6e 6b 20 66 72 6f 6d 20 74 68 the link from th
60a0: 65 20 74 65 73 74 20 70 61 74 68 20 74 6f 20 74 e test path to t
60b0: 68 65 20 6c 69 6e 6b 20 74 72 65 65 2c 20 68 6f he link tree, ho
60c0: 77 65 76 65 72 0a 20 20 20 20 3b 3b 20 69 66 20 wever. ;; if
60d0: 74 68 65 20 74 65 73 74 20 69 73 20 69 74 65 72 the test is iter
60e0: 61 74 65 64 20 69 74 20 69 73 20 6e 65 63 65 73 ated it is neces
60f0: 73 61 72 79 20 74 6f 20 63 72 65 61 74 65 20 74 sary to create t
6100: 68 65 20 70 61 72 65 6e 74 20 70 61 74 68 0a 20 he parent path.
6110: 20 20 20 3b 3b 20 74 6f 20 74 68 65 20 69 74 65 ;; to the ite
6120: 72 61 74 69 6f 6e 2e 20 75 73 65 20 70 61 74 68 ration. use path
6130: 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 74 name-directory t
6140: 6f 20 74 72 69 6d 20 74 68 65 20 70 61 74 68 20 o trim the path
6150: 62 79 20 6f 6e 65 0a 20 20 20 20 3b 3b 20 6c 65 by one. ;; le
6160: 76 65 6c 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 vel. (if (not
6170: 20 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b not-iterated) ;
6180: 3b 20 69 2e 65 2e 20 69 74 65 72 61 74 65 64 0a ; i.e. iterated.
6190: 09 28 6c 65 74 20 28 28 69 74 65 72 61 74 65 64 .(let ((iterated
61a0: 2d 70 61 72 65 6e 74 20 20 28 70 61 74 68 6e 61 -parent (pathna
61b0: 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 28 63 6f me-directory (co
61c0: 6e 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 nc lnkpath "/" i
61d0: 74 65 6d 2d 70 61 74 68 29 29 29 29 0a 09 20 20 tem-path))))..
61e0: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
61f0: 6f 20 32 20 22 43 72 65 61 74 69 6e 67 20 69 74 o 2 "Creating it
6200: 65 72 61 74 65 64 20 70 61 72 65 6e 74 20 22 20 erated parent "
6210: 69 74 65 72 61 74 65 64 2d 70 61 72 65 6e 74 29 iterated-parent)
6220: 0a 09 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 .. (handle-exce
6230: 70 74 69 6f 6e 73 0a 09 20 20 20 65 78 6e 0a 09 ptions.. exn..
6240: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
6250: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 22 (debug:print 0 "
6260: 45 52 52 4f 52 3a 20 20 46 61 69 6c 65 64 20 74 ERROR: Failed t
6270: 6f 20 63 72 65 61 74 65 20 64 69 72 65 63 74 6f o create directo
6280: 72 79 20 22 20 69 74 65 72 61 74 65 64 2d 70 61 ry " iterated-pa
6290: 72 65 6e 74 20 28 28 63 6f 6e 64 69 74 69 6f 6e rent ((condition
62a0: 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 -property-access
62b0: 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 or 'exn 'message
62c0: 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e ) exn) ", exitin
62d0: 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 g").. (exit
62e0: 31 29 29 0a 09 20 20 20 28 63 72 65 61 74 65 2d 1)).. (create-
62f0: 64 69 72 65 63 74 6f 72 79 20 69 74 65 72 61 74 directory iterat
6300: 65 64 2d 70 61 72 65 6e 74 20 23 74 29 29 29 29 ed-parent #t))))
6310: 0a 0a 20 20 20 20 28 69 66 20 28 73 79 6d 62 6f .. (if (symbo
6320: 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 lic-link? lnkpat
6330: 68 29 20 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 h) ..(handle-exc
6340: 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 eptions.. exn..
6350: 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 (begin.. (debu
6360: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
6370: 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 72 65 6d : Failed to rem
6380: 6f 76 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e ove symlink " ln
6390: 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f kpath ((conditio
63a0: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
63b0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
63c0: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 e) exn) ", exiti
63d0: 6e 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 ng").. (exit 1
63e0: 29 29 0a 09 20 28 64 65 6c 65 74 65 2d 66 69 6c )).. (delete-fil
63f0: 65 20 6c 6e 6b 70 61 74 68 29 29 29 0a 0a 20 20 e lnkpath)))..
6400: 20 20 28 69 66 20 28 6e 6f 74 20 28 6f 72 20 28 (if (not (or (
6410: 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e 6b file-exists? lnk
6420: 70 61 74 68 29 0a 09 09 20 28 73 79 6d 62 6f 6c path)... (symbol
6430: 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 70 61 74 68 ic-link? lnkpath
6440: 29 29 29 0a 09 28 68 61 6e 64 6c 65 2d 65 78 63 )))..(handle-exc
6450: 65 70 74 69 6f 6e 73 0a 09 20 65 78 6e 0a 09 20 eptions.. exn..
6460: 28 62 65 67 69 6e 0a 09 20 20 20 28 64 65 62 75 (begin.. (debu
6470: 67 3a 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 g:print 0 "ERROR
6480: 3a 20 20 46 61 69 6c 65 64 20 74 6f 20 63 72 65 : Failed to cre
6490: 61 74 65 20 73 79 6d 6c 69 6e 6b 20 22 20 6c 6e ate symlink " ln
64a0: 6b 70 61 74 68 20 28 28 63 6f 6e 64 69 74 69 6f kpath ((conditio
64b0: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
64c0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
64d0: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 e) exn) ", exiti
64e0: 6e 67 22 29 0a 09 20 20 20 28 65 78 69 74 20 31 ng").. (exit 1
64f0: 29 29 0a 09 20 28 63 72 65 61 74 65 2d 73 79 6d )).. (create-sym
6500: 62 6f 6c 69 63 2d 6c 69 6e 6b 20 74 6f 70 74 65 bolic-link topte
6510: 73 74 2d 70 61 74 68 20 6c 6e 6b 70 61 74 68 29 st-path lnkpath)
6520: 29 29 0a 20 20 20 20 0a 20 20 20 20 3b 3b 20 54 )). . ;; T
6530: 68 65 20 74 6f 70 74 65 73 74 20 70 61 74 68 20 he toptest path
6540: 68 61 73 20 62 65 65 6e 20 63 72 65 61 74 65 64 has been created
6550: 2c 20 74 68 65 20 6c 69 6e 6b 20 74 6f 20 74 68 , the link to th
6560: 65 20 74 65 73 74 20 69 6e 20 74 68 65 20 6c 69 e test in the li
6570: 6e 6b 74 72 65 65 20 68 61 73 0a 20 20 20 20 3b nktree has. ;
6580: 3b 20 62 65 65 6e 20 63 72 65 61 74 65 64 2e 20 ; been created.
6590: 4e 6f 77 2c 20 69 66 20 74 68 69 73 20 69 73 20 Now, if this is
65a0: 61 6e 20 69 74 65 72 61 74 65 64 20 74 65 73 74 an iterated test
65b0: 20 74 68 65 20 72 65 61 6c 20 74 65 73 74 20 64 the real test d
65c0: 69 72 20 6d 75 73 74 20 62 65 20 63 72 65 61 74 ir must be creat
65d0: 65 64 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ed. (if (not
65e0: 6e 6f 74 2d 69 74 65 72 61 74 65 64 29 20 3b 3b not-iterated) ;;
65f0: 20 74 68 69 73 20 69 73 20 61 6e 20 69 74 65 72 this is an iter
6600: 61 74 65 64 20 74 65 73 74 0a 09 28 6c 65 74 20 ated test..(let
6610: 28 28 6c 6e 6b 74 61 72 67 65 74 20 28 63 6f 6e ((lnktarget (con
6620: 63 20 6c 6e 6b 70 61 74 68 20 22 2f 22 20 69 74 c lnkpath "/" it
6630: 65 6d 2d 70 61 74 68 29 29 29 0a 09 20 20 28 64 em-path))).. (d
6640: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 53 65 ebug:print 2 "Se
6650: 74 74 69 6e 67 20 75 70 20 73 75 62 20 74 65 73 tting up sub tes
6660: 74 20 72 75 6e 20 61 72 65 61 22 29 0a 09 20 20 t run area")..
6670: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 (debug:print 2 "
6680: 20 2d 20 63 72 65 61 74 69 6e 67 20 72 75 6e 20 - creating run
6690: 61 72 65 61 20 69 6e 20 22 20 74 65 73 74 2d 70 area in " test-p
66a0: 61 74 68 29 0a 09 20 20 28 68 61 6e 64 6c 65 2d ath).. (handle-
66b0: 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 20 65 exceptions.. e
66c0: 78 6e 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 xn.. (begin..
66d0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
66e0: 20 30 20 22 45 52 52 4f 52 3a 20 20 46 61 69 6c 0 "ERROR: Fail
66f0: 65 64 20 74 6f 20 63 72 65 61 74 65 20 64 69 72 ed to create dir
6700: 65 63 74 6f 72 79 20 22 20 74 65 73 74 2d 70 61 ectory " test-pa
6710: 74 68 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 th ((condition-p
6720: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
6730: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
6740: 65 78 6e 29 20 22 2c 20 65 78 69 74 69 6e 67 22 exn) ", exiting"
6750: 29 0a 09 20 20 20 20 20 28 65 78 69 74 20 31 29 ).. (exit 1)
6760: 29 0a 09 20 20 20 28 63 72 65 61 74 65 2d 64 69 ).. (create-di
6770: 72 65 63 74 6f 72 79 20 74 65 73 74 2d 70 61 74 rectory test-pat
6780: 68 20 23 74 29 29 0a 09 20 20 28 64 65 62 75 67 h #t)).. (debug
6790: 3a 70 72 69 6e 74 20 32 20 0a 09 09 20 20 20 20 :print 2 ...
67a0: 20 20 20 22 20 2d 20 63 72 65 61 74 69 6e 67 20 " - creating
67b0: 6c 69 6e 6b 20 66 72 6f 6d 3a 20 22 20 74 65 73 link from: " tes
67c0: 74 2d 70 61 74 68 20 22 5c 6e 22 0a 09 09 20 20 t-path "\n"...
67d0: 20 20 20 20 20 22 20 20 20 20 20 20 20 20 20 20 "
67e0: 20 20 20 20 20 20 20 20 20 74 6f 3a 20 22 20 6c to: " l
67f0: 6e 6b 74 61 72 67 65 74 29 0a 0a 09 20 20 3b 3b nktarget)... ;;
6800: 20 49 66 20 74 68 65 72 65 20 69 73 20 61 6c 72 If there is alr
6810: 65 61 64 79 20 61 20 73 79 6d 6c 69 6e 6b 20 64 eady a symlink d
6820: 65 6c 65 74 65 20 69 74 20 61 6e 64 20 72 65 63 elete it and rec
6830: 72 65 61 74 65 20 69 74 2e 0a 09 20 20 28 68 61 reate it... (ha
6840: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
6850: 09 20 20 20 65 78 6e 0a 09 20 20 20 28 62 65 67 . exn.. (beg
6860: 69 6e 0a 09 20 20 20 20 20 28 64 65 62 75 67 3a in.. (debug:
6870: 70 72 69 6e 74 20 30 20 22 45 52 52 4f 52 3a 20 print 0 "ERROR:
6880: 20 46 61 69 6c 65 64 20 74 6f 20 72 65 2d 63 72 Failed to re-cr
6890: 65 61 74 65 20 6c 69 6e 6b 20 22 20 6c 6e 6b 74 eate link " lnkt
68a0: 61 72 67 65 74 20 28 28 63 6f 6e 64 69 74 69 6f arget ((conditio
68b0: 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 73 n-property-acces
68c0: 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 67 sor 'exn 'messag
68d0: 65 29 20 65 78 6e 29 20 22 2c 20 65 78 69 74 69 e) exn) ", exiti
68e0: 6e 67 22 29 0a 09 20 20 20 20 20 28 65 78 69 74 ng").. (exit
68f0: 29 29 0a 09 20 20 20 28 69 66 20 28 73 79 6d 62 )).. (if (symb
6900: 6f 6c 69 63 2d 6c 69 6e 6b 3f 20 6c 6e 6b 74 61 olic-link? lnkta
6910: 72 67 65 74 29 20 20 20 20 20 28 64 65 6c 65 74 rget) (delet
6920: 65 2d 66 69 6c 65 20 6c 6e 6b 74 61 72 67 65 74 e-file lnktarget
6930: 29 29 0a 09 20 20 20 28 69 66 20 28 6e 6f 74 20 )).. (if (not
6940: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 6c 6e (file-exists? ln
6950: 6b 74 61 72 67 65 74 29 29 20 28 63 72 65 61 74 ktarget)) (creat
6960: 65 2d 73 79 6d 62 6f 6c 69 63 2d 6c 69 6e 6b 20 e-symbolic-link
6970: 74 65 73 74 2d 70 61 74 68 20 6c 6e 6b 74 61 72 test-path lnktar
6980: 67 65 74 29 29 29 29 29 0a 0a 20 20 20 20 3b 3b get))))).. ;;
6990: 20 49 20 73 75 73 70 65 63 74 20 74 68 69 73 20 I suspect this
69a0: 73 65 63 74 69 6f 6e 20 77 61 73 20 64 65 6c 65 section was dele
69b0: 74 69 6e 67 20 74 65 73 74 20 64 69 72 65 63 74 ting test direct
69c0: 6f 72 69 65 73 20 75 6e 64 65 72 20 73 6f 6d 65 ories under some
69d0: 20 0a 20 20 20 20 3b 3b 20 77 69 65 72 64 20 73 . ;; wierd s
69e0: 69 74 61 74 69 6f 6e 73 3f 20 54 68 69 73 20 64 itations? This d
69f0: 6f 65 73 6e 27 74 20 6d 61 6b 65 20 73 65 6e 73 oesn't make sens
6a00: 65 20 2d 20 72 65 65 6e 61 62 6c 69 6e 67 20 74 e - reenabling t
6a10: 68 65 20 72 6d 20 2d 66 20 0a 20 20 20 20 3b 3b he rm -f . ;;
6a20: 20 49 20 68 6f 6e 65 73 74 6c 79 20 64 6f 6e 27 I honestly don'
6a30: 74 20 72 65 6d 65 6d 62 65 72 20 2a 77 68 79 2a t remember *why*
6a40: 20 74 68 69 73 20 63 68 75 6e 6b 20 77 61 73 20 this chunk was
6a50: 6e 65 65 64 65 64 2e 2e 2e 0a 20 20 20 20 3b 3b needed.... ;;
6a60: 20 28 6c 65 74 20 28 28 74 65 73 74 6c 69 6e 6b (let ((testlink
6a70: 20 28 63 6f 6e 63 20 6c 6e 6b 70 61 74 68 20 22 (conc lnkpath "
6a80: 2f 22 20 74 65 73 74 6e 61 6d 65 29 29 29 0a 20 /" testname))).
6a90: 20 20 20 3b 3b 20 20 20 28 69 66 20 28 61 6e 64 ;; (if (and
6aa0: 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 74 (file-exists? t
6ab0: 65 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 estlink). ;;
6ac0: 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 (or (
6ad0: 72 65 67 75 6c 61 72 2d 66 69 6c 65 3f 20 74 65 regular-file? te
6ae0: 73 74 6c 69 6e 6b 29 0a 20 20 20 20 3b 3b 20 20 stlink). ;;
6af0: 20 20 20 09 20 20 20 28 73 79 6d 62 6f 6c 69 63 . (symbolic
6b00: 2d 6c 69 6e 6b 3f 20 74 65 73 74 6c 69 6e 6b 29 -link? testlink)
6b10: 29 29 0a 20 20 20 20 3b 3b 20 20 20 20 20 20 20 )). ;;
6b20: 28 73 79 73 74 65 6d 20 28 63 6f 6e 63 20 22 72 (system (conc "r
6b30: 6d 20 2d 66 20 22 20 74 65 73 74 6c 69 6e 6b 29 m -f " testlink)
6b40: 29 29 0a 20 20 20 20 3b 3b 20 20 20 28 73 79 73 )). ;; (sys
6b50: 74 65 6d 20 20 28 63 6f 6e 63 20 22 6c 6e 20 2d tem (conc "ln -
6b60: 73 66 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 sf " test-path "
6b70: 20 22 20 74 65 73 74 6c 69 6e 6b 29 29 29 0a 20 " testlink))).
6b80: 20 20 20 28 69 66 20 28 64 69 72 65 63 74 6f 72 (if (director
6b90: 79 3f 20 74 65 73 74 2d 70 61 74 68 29 0a 09 28 y? test-path)..(
6ba0: 62 65 67 69 6e 0a 09 20 20 28 6c 65 74 2a 20 28 begin.. (let* (
6bb0: 28 6f 76 72 63 6d 64 20 28 6c 65 74 20 28 28 63 (ovrcmd (let ((c
6bc0: 6d 64 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 md (config-looku
6bd0: 70 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 73 p *configdat* "s
6be0: 65 74 75 70 22 20 22 74 65 73 74 63 6f 70 79 63 etup" "testcopyc
6bf0: 6d 64 22 29 29 29 0a 09 09 09 20 20 20 28 69 66 md"))).... (if
6c00: 20 63 6d 64 0a 09 09 09 20 20 20 20 20 20 20 3b cmd.... ;
6c10: 3b 20 73 75 62 73 74 69 74 75 74 65 20 74 68 65 ; substitute the
6c20: 20 54 45 53 54 5f 53 52 43 5f 50 41 54 48 20 61 TEST_SRC_PATH a
6c30: 6e 64 20 54 45 53 54 5f 54 41 52 47 5f 50 41 54 nd TEST_TARG_PAT
6c40: 48 0a 09 09 09 20 20 20 20 20 20 20 28 73 74 72 H.... (str
6c50: 69 6e 67 2d 73 75 62 73 74 69 74 75 74 65 20 22 ing-substitute "
6c60: 54 45 53 54 5f 54 41 52 47 5f 50 41 54 48 22 20 TEST_TARG_PATH"
6c70: 74 65 73 74 2d 70 61 74 68 0a 09 09 09 09 09 09 test-path.......
6c80: 20 20 28 73 74 72 69 6e 67 2d 73 75 62 73 74 69 (string-substi
6c90: 74 75 74 65 20 22 54 45 53 54 5f 53 52 43 5f 50 tute "TEST_SRC_P
6ca0: 41 54 48 22 20 74 65 73 74 2d 73 72 63 2d 70 61 ATH" test-src-pa
6cb0: 74 68 20 63 6d 64 20 23 74 29 20 23 74 29 0a 09 th cmd #t) #t)..
6cc0: 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 .. #f)))..
6cd0: 09 20 28 63 6d 64 20 20 20 20 28 69 66 20 6f 76 . (cmd (if ov
6ce0: 72 63 6d 64 20 0a 09 09 09 20 20 20 20 20 6f 76 rcmd .... ov
6cf0: 72 63 6d 64 0a 09 09 09 20 20 20 20 20 28 63 6f rcmd.... (co
6d00: 6e 63 20 22 72 73 79 6e 63 20 2d 61 76 22 20 28 nc "rsync -av" (
6d10: 69 66 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d if (debug:debug-
6d20: 6d 6f 64 65 20 31 29 20 22 22 20 22 71 22 29 20 mode 1) "" "q")
6d30: 22 20 22 20 74 65 73 74 2d 73 72 63 2d 70 61 74 " " test-src-pat
6d40: 68 20 22 2f 20 22 20 74 65 73 74 2d 70 61 74 68 h "/ " test-path
6d50: 20 22 2f 22 0a 09 09 09 09 20 20 20 22 20 3e 3e "/"..... " >>
6d60: 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f 6d " test-path "/m
6d70: 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 20 32 3e 3e t_launch.log 2>>
6d80: 20 22 20 74 65 73 74 2d 70 61 74 68 20 22 2f 6d " test-path "/m
6d90: 74 5f 6c 61 75 6e 63 68 2e 6c 6f 67 22 29 29 29 t_launch.log")))
6da0: 0a 09 09 20 28 73 74 61 74 75 73 20 28 73 79 73 ... (status (sys
6db0: 74 65 6d 20 63 6d 64 29 29 29 0a 09 20 20 20 20 tem cmd)))..
6dc0: 28 69 66 20 28 6e 6f 74 20 28 65 71 3f 20 73 74 (if (not (eq? st
6dd0: 61 74 75 73 20 30 29 29 0a 09 09 28 64 65 62 75 atus 0))...(debu
6de0: 67 3a 70 72 69 6e 74 20 32 20 22 45 52 52 4f 52 g:print 2 "ERROR
6df0: 3a 20 70 72 6f 62 6c 65 6d 20 77 69 74 68 20 72 : problem with r
6e00: 75 6e 6e 69 6e 67 20 5c 22 22 20 63 6d 64 20 22 unning \"" cmd "
6e10: 5c 22 22 29 29 29 0a 09 20 20 28 6c 69 73 74 20 \""))).. (list
6e20: 6c 6e 6b 70 61 74 68 66 20 6c 6e 6b 70 61 74 68 lnkpathf lnkpath
6e30: 20 29 29 0a 09 28 6c 69 73 74 20 23 66 20 23 66 ))..(list #f #f
6e40: 29 29 29 29 0a 0a 3b 3b 20 31 2e 20 6c 6f 6f 6b ))))..;; 1. look
6e50: 20 74 68 6f 75 67 68 20 64 69 73 6b 73 20 6c 69 though disks li
6e60: 73 74 20 66 6f 72 20 64 69 73 6b 20 77 69 74 68 st for disk with
6e70: 20 6d 6f 73 74 20 73 70 61 63 65 0a 3b 3b 20 32 most space.;; 2
6e80: 2e 20 63 72 65 61 74 65 20 72 75 6e 20 64 69 72 . create run dir
6e90: 20 6f 6e 20 64 69 73 6b 2c 20 70 61 74 68 20 6e on disk, path n
6ea0: 61 6d 65 20 69 73 20 6d 65 61 6e 69 6e 67 66 75 ame is meaningfu
6eb0: 6c 0a 3b 3b 20 33 2e 20 63 72 65 61 74 65 20 6c l.;; 3. create l
6ec0: 69 6e 6b 20 66 72 6f 6d 20 72 75 6e 20 64 69 72 ink from run dir
6ed0: 20 74 6f 20 6d 65 67 61 74 65 73 74 20 72 75 6e to megatest run
6ee0: 73 20 61 72 65 61 20 0a 3b 3b 20 34 2e 20 72 65 s area .;; 4. re
6ef0: 6d 6f 74 65 6c 79 20 72 75 6e 20 74 68 65 20 74 motely run the t
6f00: 65 73 74 20 6f 6e 20 61 6c 6c 6f 63 61 74 65 64 est on allocated
6f10: 20 68 6f 73 74 0a 3b 3b 20 20 20 20 2d 20 63 6f host.;; - co
6f20: 75 6c 64 20 62 65 20 73 73 68 20 74 6f 20 68 6f uld be ssh to ho
6f30: 73 74 20 66 72 6f 6d 20 68 6f 73 74 73 20 74 61 st from hosts ta
6f40: 62 6c 65 20 28 75 70 64 61 74 65 20 72 65 67 75 ble (update regu
6f50: 6c 61 72 6c 79 20 77 69 74 68 20 6c 6f 61 64 29 larly with load)
6f60: 0a 3b 3b 20 20 20 20 2d 20 63 6f 75 6c 64 20 62 .;; - could b
6f70: 65 20 6e 65 74 62 61 74 63 68 0a 3b 3b 20 20 20 e netbatch.;;
6f80: 20 20 20 28 6c 61 75 6e 63 68 2d 74 65 73 74 20 (launch-test
6f90: 64 62 20 28 63 61 64 72 20 73 74 61 74 75 73 29 db (cadr status)
6fa0: 20 74 65 73 74 2d 63 6f 6e 66 29 29 0a 28 64 65 test-conf)).(de
6fb0: 66 69 6e 65 20 28 6c 61 75 6e 63 68 2d 74 65 73 fine (launch-tes
6fc0: 74 20 74 65 73 74 2d 69 64 20 72 75 6e 2d 69 64 t test-id run-id
6fd0: 20 72 75 6e 2d 69 6e 66 6f 20 6b 65 79 76 61 6c run-info keyval
6fe0: 73 20 72 75 6e 6e 61 6d 65 20 74 65 73 74 2d 63 s runname test-c
6ff0: 6f 6e 66 20 74 65 73 74 2d 6e 61 6d 65 20 74 65 onf test-name te
7000: 73 74 2d 70 61 74 68 20 69 74 65 6d 64 61 74 20 st-path itemdat
7010: 70 61 72 61 6d 73 29 0a 20 20 28 63 68 61 6e 67 params). (chang
7020: 65 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 e-directory *top
7030: 70 61 74 68 2a 29 0a 20 20 28 61 6c 69 73 74 2d path*). (alist-
7040: 3e 65 6e 76 2d 76 61 72 73 20 3b 3b 20 63 6f 6e >env-vars ;; con
7050: 73 6f 6c 69 64 61 74 65 20 74 68 69 73 20 63 6f solidate this co
7060: 64 65 20 77 69 74 68 20 74 68 65 20 63 6f 64 65 de with the code
7070: 20 69 6e 20 6d 65 67 61 74 65 73 74 2e 73 63 6d in megatest.scm
7080: 20 66 6f 72 20 22 2d 65 78 65 63 75 74 65 22 0a for "-execute".
7090: 20 20 20 28 6c 69 73 74 20 3b 3b 20 28 6c 69 73 (list ;; (lis
70a0: 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e 5f 44 t "MT_TEST_RUN_D
70b0: 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 0a 20 IR" work-area).
70c0: 20 20 20 28 6c 69 73 74 20 22 4d 54 5f 52 55 4e (list "MT_RUN
70d0: 5f 41 52 45 41 5f 48 4f 4d 45 22 20 2a 74 6f 70 _AREA_HOME" *top
70e0: 70 61 74 68 2a 29 0a 20 20 20 20 28 6c 69 73 74 path*). (list
70f0: 20 22 4d 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 "MT_TEST_NAME"
7100: 74 65 73 74 2d 6e 61 6d 65 29 0a 20 20 20 20 3b test-name). ;
7110: 3b 20 28 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d ; (list "MT_ITEM
7120: 5f 49 4e 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 _INFO" (conc ite
7130: 6d 64 61 74 29 29 20 0a 20 20 20 20 28 6c 69 73 mdat)) . (lis
7140: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
7150: 20 72 75 6e 6e 61 6d 65 29 0a 20 20 20 20 3b 3b runname). ;;
7160: 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
7170: 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
7180: 0a 20 20 20 20 29 29 0a 20 20 28 6c 65 74 2a 20 . )). (let*
7190: 28 28 75 73 65 73 68 65 6c 6c 20 20 20 20 20 20 ((useshell
71a0: 20 20 28 6c 65 74 20 28 28 75 73 68 20 28 63 6f (let ((ush (co
71b0: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e nfig-lookup *con
71c0: 66 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c figdat* "jobtool
71d0: 73 22 20 20 20 20 20 22 75 73 65 73 68 65 6c 6c s" "useshell
71e0: 22 29 29 29 0a 09 09 09 20 20 20 20 28 69 66 20 "))).... (if
71f0: 75 73 68 20 0a 09 09 09 09 28 69 66 20 28 65 71 ush .....(if (eq
7200: 75 61 6c 3f 20 75 73 68 20 22 6e 6f 22 29 20 3b ual? ush "no") ;
7210: 3b 20 6d 75 73 74 20 75 73 65 20 22 6e 6f 22 20 ; must use "no"
7220: 74 6f 20 4e 4f 54 20 75 73 65 20 73 68 65 6c 6c to NOT use shell
7230: 0a 09 09 09 09 20 20 20 20 23 66 0a 09 09 09 09 ..... #f.....
7240: 20 20 20 20 75 73 68 29 0a 09 09 09 09 23 74 29 ush).....#t)
7250: 29 29 20 20 20 20 20 3b 3b 20 64 65 66 61 75 6c )) ;; defaul
7260: 74 20 69 73 20 79 65 73 0a 09 20 28 6c 61 75 6e t is yes.. (laun
7270: 63 68 65 72 20 20 20 20 20 20 20 20 28 63 6f 6e cher (con
7280: 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 fig-lookup *conf
7290: 69 67 64 61 74 2a 20 22 6a 6f 62 74 6f 6f 6c 73 igdat* "jobtools
72a0: 22 20 20 20 20 20 22 6c 61 75 6e 63 68 65 72 22 " "launcher"
72b0: 29 29 0a 09 20 28 72 75 6e 73 63 72 69 70 74 20 )).. (runscript
72c0: 20 20 20 20 20 20 28 63 6f 6e 66 69 67 2d 6c 6f (config-lo
72d0: 6f 6b 75 70 20 74 65 73 74 2d 63 6f 6e 66 20 20 okup test-conf
72e0: 20 22 73 65 74 75 70 22 20 20 20 20 20 20 20 20 "setup"
72f0: 22 72 75 6e 73 63 72 69 70 74 22 29 29 0a 09 20 "runscript"))..
7300: 28 65 7a 73 74 65 70 73 20 20 20 20 20 20 20 20 (ezsteps
7310: 20 28 3e 20 28 6c 65 6e 67 74 68 20 28 68 61 73 (> (length (has
7320: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
7330: 75 6c 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 65 ult test-conf "e
7340: 7a 73 74 65 70 73 22 20 27 28 29 29 29 20 30 29 zsteps" '())) 0)
7350: 29 20 3b 3b 20 64 6f 6e 27 74 20 73 65 6e 64 20 ) ;; don't send
7360: 61 6c 6c 20 74 68 65 20 73 74 65 70 73 2c 20 63 all the steps, c
7370: 6f 75 6c 64 20 62 65 20 62 69 67 0a 09 20 28 64 ould be big.. (d
7380: 69 73 6b 73 70 61 63 65 20 20 20 20 20 20 20 28 iskspace (
7390: 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 74 65 config-lookup te
73a0: 73 74 2d 63 6f 6e 66 20 20 20 22 72 65 71 75 69 st-conf "requi
73b0: 72 65 6d 65 6e 74 73 22 20 22 64 69 73 6b 73 70 rements" "disksp
73c0: 61 63 65 22 29 29 0a 09 20 28 6d 65 6d 6f 72 79 ace")).. (memory
73d0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 66 69 (confi
73e0: 67 2d 6c 6f 6f 6b 75 70 20 74 65 73 74 2d 63 6f g-lookup test-co
73f0: 6e 66 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e nf "requiremen
7400: 74 73 22 20 22 6d 65 6d 6f 72 79 22 29 29 0a 09 ts" "memory"))..
7410: 20 28 68 6f 73 74 73 20 20 20 20 20 20 20 20 20 (hosts
7420: 20 20 28 63 6f 6e 66 69 67 2d 6c 6f 6f 6b 75 70 (config-lookup
7430: 20 2a 63 6f 6e 66 69 67 64 61 74 2a 20 22 6a 6f *configdat* "jo
7440: 62 74 6f 6f 6c 73 22 20 20 20 20 20 22 77 6f 72 btools" "wor
7450: 6b 68 6f 73 74 73 22 29 29 0a 09 20 28 72 65 6d khosts")).. (rem
7460: 6f 74 65 2d 6d 65 67 61 74 65 73 74 20 28 63 6f ote-megatest (co
7470: 6e 66 69 67 2d 6c 6f 6f 6b 75 70 20 2a 63 6f 6e nfig-lookup *con
7480: 66 69 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 figdat* "setup"
7490: 22 65 78 65 63 75 74 61 62 6c 65 22 29 29 0a 09 "executable"))..
74a0: 20 28 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 74 (run-time-limit
74b0: 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 3a 6c (or (configf:l
74c0: 6f 6f 6b 75 70 20 20 74 65 73 74 2d 63 6f 6e 66 ookup test-conf
74d0: 20 20 20 22 72 65 71 75 69 72 65 6d 65 6e 74 73 "requirements
74e0: 22 20 22 72 75 6e 74 69 6d 65 6c 69 6d 22 29 0a " "runtimelim").
74f0: 09 09 09 20 20 20 20 20 20 28 63 6f 6e 66 69 67 ... (config
7500: 66 3a 6c 6f 6f 6b 75 70 20 20 2a 63 6f 6e 66 69 f:lookup *confi
7510: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 72 gdat* "setup" "r
7520: 75 6e 74 69 6d 65 6c 69 6d 22 29 29 29 0a 09 20 untimelim")))..
7530: 3b 3b 20 46 49 58 4d 45 20 53 4f 4d 45 44 41 59 ;; FIXME SOMEDAY
7540: 3a 20 6e 6f 74 20 67 6f 6f 64 20 68 6f 77 20 74 : not good how t
7550: 68 69 73 20 69 73 20 73 6f 20 6f 62 74 75 73 65 his is so obtuse
7560: 2c 20 74 68 69 73 20 68 61 63 6b 20 69 73 20 74 , this hack is t
7570: 6f 20 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 o .. ;;
7580: 20 20 20 20 20 20 20 61 6c 6c 6f 77 20 72 75 6e allow run
7590: 6e 69 6e 67 20 66 72 6f 6d 20 64 61 73 68 62 6f ning from dashbo
75a0: 61 72 64 2e 20 45 78 74 72 61 63 74 20 74 68 65 ard. Extract the
75b0: 20 70 61 74 68 0a 09 20 3b 3b 20 20 20 20 20 20 path.. ;;
75c0: 20 20 20 20 20 20 20 20 20 20 66 72 6f 6d 20 74 from t
75d0: 68 65 20 63 61 6c 6c 65 64 20 6d 65 67 61 74 65 he called megate
75e0: 73 74 20 61 6e 64 20 63 6f 6e 76 65 72 74 20 64 st and convert d
75f0: 61 73 68 62 6f 61 72 64 0a 09 20 3b 3b 20 20 20 ashboard.. ;;
7600: 20 20 20 20 20 20 20 20 20 20 09 20 20 6f 72 20 . or
7610: 64 62 6f 61 72 64 20 74 6f 20 6d 65 67 61 74 65 dboard to megate
7620: 73 74 0a 09 20 28 6c 6f 63 61 6c 2d 6d 65 67 61 st.. (local-mega
7630: 74 65 73 74 20 20 28 6c 65 74 2a 20 28 28 6c 6d test (let* ((lm
7640: 20 20 28 63 61 72 20 28 61 72 67 76 29 29 29 0a (car (argv))).
7650: 09 09 09 09 20 28 64 69 72 20 28 70 61 74 68 6e .... (dir (pathn
7660: 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 20 6c 6d ame-directory lm
7670: 29 29 0a 09 09 09 09 20 28 65 78 65 20 28 70 61 ))..... (exe (pa
7680: 74 68 6e 61 6d 65 2d 73 74 72 69 70 2d 64 69 72 thname-strip-dir
7690: 65 63 74 6f 72 79 20 6c 6d 29 29 29 0a 09 09 09 ectory lm)))....
76a0: 20 20 20 20 28 63 6f 6e 63 20 28 69 66 20 64 69 (conc (if di
76b0: 72 20 28 63 6f 6e 63 20 64 69 72 20 22 2f 22 29 r (conc dir "/")
76c0: 20 22 22 29 0a 09 09 09 09 20 20 28 63 61 73 65 "")..... (case
76d0: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
76e0: 20 65 78 65 29 0a 09 09 09 09 20 20 20 20 28 28 exe)..... ((
76f0: 64 62 6f 61 72 64 29 20 20 20 20 22 6d 65 67 61 dboard) "mega
7700: 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 28 test")..... (
7710: 28 6d 74 65 73 74 29 20 20 20 20 20 22 6d 65 67 (mtest) "meg
7720: 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 20 atest").....
7730: 28 28 64 61 73 68 62 6f 61 72 64 29 20 22 6d 65 ((dashboard) "me
7740: 67 61 74 65 73 74 22 29 0a 09 09 09 09 20 20 20 gatest").....
7750: 20 28 65 6c 73 65 20 65 78 65 29 29 29 29 29 0a (else exe))))).
7760: 09 20 28 74 65 73 74 2d 73 69 67 20 20 20 28 63 . (test-sig (c
7770: 6f 6e 63 20 74 65 73 74 2d 6e 61 6d 65 20 22 3a onc test-name ":
7780: 22 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 " (item-list->pa
7790: 74 68 20 69 74 65 6d 64 61 74 29 29 29 20 3b 3b th itemdat))) ;;
77a0: 20 74 65 73 74 2d 70 61 74 68 20 69 73 20 74 68 test-path is th
77b0: 65 20 66 75 6c 6c 20 70 61 74 68 20 69 6e 63 6c e full path incl
77c0: 75 64 69 6e 67 20 74 68 65 20 69 74 65 6d 2d 70 uding the item-p
77d0: 61 74 68 0a 09 20 28 77 6f 72 6b 2d 61 72 65 61 ath.. (work-area
77e0: 20 20 23 66 29 0a 09 20 28 74 6f 70 74 65 73 74 #f).. (toptest
77f0: 2d 77 6f 72 6b 2d 61 72 65 61 20 23 66 29 20 3b -work-area #f) ;
7800: 3b 20 66 6f 72 20 69 74 65 72 61 74 65 64 20 74 ; for iterated t
7810: 65 73 74 73 20 74 68 65 20 74 6f 70 20 74 65 73 ests the top tes
7820: 74 20 63 6f 6e 74 61 69 6e 73 20 64 61 74 61 20 t contains data
7830: 72 65 6c 65 76 61 6e 74 20 66 6f 72 20 61 6c 6c relevant for all
7840: 0a 09 20 28 64 69 73 6b 70 61 74 68 20 20 20 23 .. (diskpath #
7850: 66 29 0a 09 20 28 63 6d 64 70 61 72 6d 73 20 20 f).. (cmdparms
7860: 20 23 66 29 0a 09 20 28 66 75 6c 6c 63 6d 64 20 #f).. (fullcmd
7870: 20 20 20 23 66 29 20 3b 3b 20 28 64 65 66 69 6e #f) ;; (defin
7880: 65 20 61 20 28 77 69 74 68 2d 6f 75 74 70 75 74 e a (with-output
7890: 2d 74 6f 2d 73 74 72 69 6e 67 20 28 6c 61 6d 62 -to-string (lamb
78a0: 64 61 20 28 29 28 77 72 69 74 65 20 78 29 29 29 da ()(write x)))
78b0: 29 0a 09 20 28 6d 74 2d 62 69 6e 64 69 72 2d 70 ).. (mt-bindir-p
78c0: 61 74 68 20 23 66 29 0a 09 20 28 69 74 65 6d 2d ath #f).. (item-
78d0: 70 61 74 68 20 28 69 74 65 6d 2d 6c 69 73 74 2d path (item-list-
78e0: 3e 70 61 74 68 20 69 74 65 6d 64 61 74 29 29 0a >path itemdat)).
78f0: 09 20 3b 3b 20 28 74 65 73 74 2d 69 64 20 20 20 . ;; (test-id
7900: 20 28 63 64 62 3a 72 65 6d 6f 74 65 2d 72 75 6e (cdb:remote-run
7910: 20 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 64 20 db:get-test-id
7920: 23 66 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 6e #f run-id test-n
7930: 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 29 0a ame item-path)).
7940: 09 20 28 74 65 73 74 69 6e 66 6f 20 20 20 28 63 . (testinfo (c
7950: 64 62 3a 67 65 74 2d 74 65 73 74 2d 69 6e 66 6f db:get-test-info
7960: 2d 62 79 2d 69 64 20 2a 72 75 6e 72 65 6d 6f 74 -by-id *runremot
7970: 65 2a 20 74 65 73 74 2d 69 64 29 29 0a 09 20 28 e* test-id)).. (
7980: 6d 74 5f 74 61 72 67 65 74 20 20 28 73 74 72 69 mt_target (stri
7990: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
79a0: 6d 61 70 20 63 61 64 72 20 6b 65 79 76 61 6c 73 map cadr keyvals
79b0: 29 20 22 2f 22 29 29 0a 09 20 28 64 65 62 75 67 ) "/")).. (debug
79c0: 2d 70 61 72 61 6d 20 28 61 70 70 65 6e 64 20 28 -param (append (
79d0: 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 if (args:get-arg
79e0: 20 22 2d 64 65 62 75 67 22 29 20 20 28 6c 69 73 "-debug") (lis
79f0: 74 20 22 2d 64 65 62 75 67 22 20 28 61 72 67 73 t "-debug" (args
7a00: 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 62 75 67 :get-arg "-debug
7a10: 22 29 29 20 27 28 29 29 0a 09 09 09 20 20 20 20 ")) '())....
7a20: 20 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d (if (args:get-
7a30: 61 72 67 20 22 2d 6c 6f 67 67 69 6e 67 22 29 28 arg "-logging")(
7a40: 6c 69 73 74 20 22 2d 6c 6f 67 67 69 6e 67 22 29 list "-logging")
7a50: 20 27 28 29 29 29 29 29 0a 20 20 20 20 28 73 65 '())))). (se
7a60: 74 65 6e 76 20 22 4d 54 5f 49 54 45 4d 50 41 54 tenv "MT_ITEMPAT
7a70: 48 22 20 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 H" item-path).
7a80: 20 20 28 69 66 20 68 6f 73 74 73 20 28 73 65 74 (if hosts (set
7a90: 21 20 68 6f 73 74 73 20 28 73 74 72 69 6e 67 2d ! hosts (string-
7aa0: 73 70 6c 69 74 20 68 6f 73 74 73 29 29 29 0a 20 split hosts))).
7ab0: 20 20 20 3b 3b 20 73 65 74 20 74 68 65 20 6d 65 ;; set the me
7ac0: 67 61 74 65 73 74 20 74 6f 20 62 65 20 63 61 6c gatest to be cal
7ad0: 6c 65 64 20 6f 6e 20 74 68 65 20 72 65 6d 6f 74 led on the remot
7ae0: 65 20 68 6f 73 74 0a 20 20 20 20 28 69 66 20 28 e host. (if (
7af0: 6e 6f 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 not remote-megat
7b00: 65 73 74 29 28 73 65 74 21 20 72 65 6d 6f 74 65 est)(set! remote
7b10: 2d 6d 65 67 61 74 65 73 74 20 6c 6f 63 61 6c 2d -megatest local-
7b20: 6d 65 67 61 74 65 73 74 29 29 20 3b 3b 20 22 6d megatest)) ;; "m
7b30: 65 67 61 74 65 73 74 22 29 29 0a 20 20 20 20 28 egatest")). (
7b40: 73 65 74 21 20 6d 74 2d 62 69 6e 64 69 72 2d 70 set! mt-bindir-p
7b50: 61 74 68 20 28 70 61 74 68 6e 61 6d 65 2d 64 69 ath (pathname-di
7b60: 72 65 63 74 6f 72 79 20 72 65 6d 6f 74 65 2d 6d rectory remote-m
7b70: 65 67 61 74 65 73 74 29 29 0a 20 20 20 20 28 69 egatest)). (i
7b80: 66 20 6c 61 75 6e 63 68 65 72 20 28 73 65 74 21 f launcher (set!
7b90: 20 6c 61 75 6e 63 68 65 72 20 28 73 74 72 69 6e launcher (strin
7ba0: 67 2d 73 70 6c 69 74 20 6c 61 75 6e 63 68 65 72 g-split launcher
7bb0: 29 29 29 0a 20 20 20 20 3b 3b 20 73 65 74 20 75 ))). ;; set u
7bc0: 70 20 74 68 65 20 72 75 6e 20 77 6f 72 6b 20 61 p the run work a
7bd0: 72 65 61 20 66 6f 72 20 74 68 69 73 20 74 65 73 rea for this tes
7be0: 74 0a 20 20 20 20 28 73 65 74 21 20 64 69 73 6b t. (set! disk
7bf0: 70 61 74 68 20 28 67 65 74 2d 62 65 73 74 2d 64 path (get-best-d
7c00: 69 73 6b 20 2a 63 6f 6e 66 69 67 64 61 74 2a 29 isk *configdat*)
7c10: 29 0a 20 20 20 20 28 69 66 20 64 69 73 6b 70 61 ). (if diskpa
7c20: 74 68 0a 09 28 6c 65 74 20 28 28 64 61 74 20 20 th..(let ((dat
7c30: 28 63 72 65 61 74 65 2d 77 6f 72 6b 2d 61 72 65 (create-work-are
7c40: 61 20 72 75 6e 2d 69 64 20 72 75 6e 2d 69 6e 66 a run-id run-inf
7c50: 6f 20 6b 65 79 76 61 6c 73 20 74 65 73 74 2d 69 o keyvals test-i
7c60: 64 20 74 65 73 74 2d 70 61 74 68 20 64 69 73 6b d test-path disk
7c70: 70 61 74 68 20 74 65 73 74 2d 6e 61 6d 65 20 69 path test-name i
7c80: 74 65 6d 64 61 74 29 29 29 0a 09 20 20 28 73 65 temdat))).. (se
7c90: 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 28 63 61 t! work-area (ca
7ca0: 72 20 64 61 74 29 29 0a 09 20 20 28 73 65 74 21 r dat)).. (set!
7cb0: 20 74 6f 70 74 65 73 74 2d 77 6f 72 6b 2d 61 72 toptest-work-ar
7cc0: 65 61 20 28 63 61 64 72 20 64 61 74 29 29 0a 09 ea (cadr dat))..
7cd0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
7ce0: 6e 66 6f 20 32 20 22 55 73 69 6e 67 20 77 6f 72 nfo 2 "Using wor
7cf0: 6b 20 61 72 65 61 20 22 20 77 6f 72 6b 2d 61 72 k area " work-ar
7d00: 65 61 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ea))..(begin..
7d10: 28 73 65 74 21 20 77 6f 72 6b 2d 61 72 65 61 20 (set! work-area
7d20: 28 63 6f 6e 63 20 74 65 73 74 2d 70 61 74 68 20 (conc test-path
7d30: 22 2f 74 6d 70 5f 72 75 6e 22 29 29 0a 09 20 20 "/tmp_run"))..
7d40: 28 63 72 65 61 74 65 2d 64 69 72 65 63 74 6f 72 (create-director
7d50: 79 20 77 6f 72 6b 2d 61 72 65 61 20 23 74 29 0a y work-area #t).
7d60: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 . (debug:print
7d70: 30 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 64 0 "WARNING: No d
7d80: 69 73 6b 20 77 6f 72 6b 20 61 72 65 61 20 73 70 isk work area sp
7d90: 65 63 69 66 69 65 64 20 2d 20 72 75 6e 6e 69 6e ecified - runnin
7da0: 67 20 69 6e 20 74 68 65 20 74 65 73 74 20 64 69 g in the test di
7db0: 72 65 63 74 6f 72 79 20 75 6e 64 65 72 20 74 6d rectory under tm
7dc0: 70 5f 72 75 6e 22 29 29 29 0a 20 20 20 20 28 73 p_run"))). (s
7dd0: 65 74 21 20 63 6d 64 70 61 72 6d 73 20 28 62 61 et! cmdparms (ba
7de0: 73 65 36 34 3a 62 61 73 65 36 34 2d 65 6e 63 6f se64:base64-enco
7df0: 64 65 20 0a 09 09 20 20 20 20 28 77 69 74 68 2d de ... (with-
7e00: 6f 75 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 output-to-string
7e10: 0a 09 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 ... (lambda
7e20: 20 28 29 20 3b 3b 20 28 6c 69 73 74 20 27 68 6f () ;; (list 'ho
7e30: 73 74 73 20 20 20 20 20 68 6f 73 74 73 29 0a 09 sts hosts)..
7e40: 09 09 28 77 72 69 74 65 20 28 6c 69 73 74 20 28 ..(write (list (
7e50: 6c 69 73 74 20 27 74 65 73 74 70 61 74 68 20 20 list 'testpath
7e60: 74 65 73 74 2d 70 61 74 68 29 0a 09 09 09 09 20 test-path).....
7e70: 20 20 20 20 3b 3b 20 28 6c 69 73 74 20 27 72 75 ;; (list 'ru
7e80: 6e 72 65 6d 6f 74 65 20 2a 72 75 6e 72 65 6d 6f nremote *runremo
7e90: 74 65 2a 29 0a 09 09 09 09 20 20 20 20 20 28 6c te*)..... (l
7ea0: 69 73 74 20 27 74 72 61 6e 73 70 6f 72 74 20 28 ist 'transport (
7eb0: 63 6f 6e 63 20 2a 74 72 61 6e 73 70 6f 72 74 2d conc *transport-
7ec0: 74 79 70 65 2a 29 29 0a 09 09 09 09 20 20 20 20 type*)).....
7ed0: 20 28 6c 69 73 74 20 27 73 65 72 76 65 72 69 6e (list 'serverin
7ee0: 66 20 2a 73 65 72 76 65 72 2d 69 6e 66 6f 2a 29 f *server-info*)
7ef0: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
7f00: 27 74 6f 70 70 61 74 68 20 20 20 2a 74 6f 70 70 'toppath *topp
7f10: 61 74 68 2a 29 0a 09 09 09 09 20 20 20 20 20 28 ath*)..... (
7f20: 6c 69 73 74 20 27 77 6f 72 6b 2d 61 72 65 61 20 list 'work-area
7f30: 77 6f 72 6b 2d 61 72 65 61 29 0a 09 09 09 09 20 work-area).....
7f40: 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 2d (list 'test-
7f50: 6e 61 6d 65 20 74 65 73 74 2d 6e 61 6d 65 29 20 name test-name)
7f60: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
7f70: 27 72 75 6e 73 63 72 69 70 74 20 72 75 6e 73 63 'runscript runsc
7f80: 72 69 70 74 29 20 0a 09 09 09 09 20 20 20 20 20 ript) .....
7f90: 28 6c 69 73 74 20 27 72 75 6e 2d 69 64 20 20 20 (list 'run-id
7fa0: 20 72 75 6e 2d 69 64 20 20 20 29 0a 09 09 09 09 run-id ).....
7fb0: 20 20 20 20 20 28 6c 69 73 74 20 27 74 65 73 74 (list 'test
7fc0: 2d 69 64 20 20 20 74 65 73 74 2d 69 64 20 20 29 -id test-id )
7fd0: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
7fe0: 27 69 74 65 6d 64 61 74 20 20 20 69 74 65 6d 64 'itemdat itemd
7ff0: 61 74 20 20 29 0a 09 09 09 09 20 20 20 20 20 28 at )..... (
8000: 6c 69 73 74 20 27 6d 65 67 61 74 65 73 74 20 20 list 'megatest
8010: 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 29 remote-megatest)
8020: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
8030: 27 65 7a 73 74 65 70 73 20 20 20 65 7a 73 74 65 'ezsteps ezste
8040: 70 73 29 20 0a 09 09 09 09 20 20 20 20 20 28 6c ps) ..... (l
8050: 69 73 74 20 27 74 61 72 67 65 74 20 20 20 20 6d ist 'target m
8060: 74 5f 74 61 72 67 65 74 29 0a 09 09 09 09 20 20 t_target).....
8070: 20 20 20 28 6c 69 73 74 20 27 72 75 6e 74 6c 69 (list 'runtli
8080: 6d 20 20 20 28 69 66 20 72 75 6e 2d 74 69 6d 65 m (if run-time
8090: 2d 6c 69 6d 69 74 20 28 63 6f 6d 6d 6f 6e 3a 68 -limit (common:h
80a0: 6d 73 2d 73 74 72 69 6e 67 2d 3e 73 65 63 6f 6e ms-string->secon
80b0: 64 73 20 72 75 6e 2d 74 69 6d 65 2d 6c 69 6d 69 ds run-time-limi
80c0: 74 29 20 23 66 29 29 0a 09 09 09 09 20 20 20 20 t) #f)).....
80d0: 20 28 6c 69 73 74 20 27 65 6e 76 2d 6f 76 72 64 (list 'env-ovrd
80e0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
80f0: 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e 66 69 f/default *confi
8100: 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 72 72 gdat* "env-overr
8110: 69 64 65 22 20 27 28 29 29 29 20 0a 09 09 09 09 ide" '())) .....
8120: 20 20 20 20 20 28 6c 69 73 74 20 27 73 65 74 2d (list 'set-
8130: 76 61 72 73 20 20 28 69 66 20 70 61 72 61 6d 73 vars (if params
8140: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
8150: 2f 64 65 66 61 75 6c 74 20 70 61 72 61 6d 73 20 /default params
8160: 22 2d 73 65 74 76 61 72 73 22 20 23 66 29 29 29 "-setvars" #f)))
8170: 0a 09 09 09 09 20 20 20 20 20 28 6c 69 73 74 20 ..... (list
8180: 27 72 75 6e 6e 61 6d 65 20 20 20 72 75 6e 6e 61 'runname runna
8190: 6d 65 29 0a 09 09 09 09 20 20 20 20 20 28 6c 69 me)..... (li
81a0: 73 74 20 27 6d 74 2d 62 69 6e 64 69 72 2d 70 61 st 'mt-bindir-pa
81b0: 74 68 20 6d 74 2d 62 69 6e 64 69 72 2d 70 61 74 th mt-bindir-pat
81c0: 68 29 29 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 h))))))). ;;
81d0: 63 6c 65 61 6e 20 6f 75 74 20 73 74 65 70 20 72 clean out step r
81e0: 65 63 6f 72 64 73 20 66 72 6f 6d 20 70 72 65 76 ecords from prev
81f0: 69 6f 75 73 20 72 75 6e 20 69 66 20 74 68 65 79 ious run if they
8200: 20 65 78 69 73 74 0a 20 20 20 20 3b 3b 20 28 64 exist. ;; (d
8210: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
8220: 34 20 22 46 49 58 4d 45 45 45 45 45 21 21 21 21 4 "FIXMEEEEE!!!!
8230: 20 54 68 69 73 20 63 61 6e 20 62 65 20 72 65 6d This can be rem
8240: 6f 76 65 64 20 73 6f 6d 65 20 64 61 79 2c 20 70 oved some day, p
8250: 65 72 68 61 70 73 20 6d 6f 76 65 20 61 6c 6c 20 erhaps move all
8260: 74 65 73 74 20 72 65 63 6f 72 64 73 20 74 6f 20 test records to
8270: 74 68 65 20 74 65 73 74 20 64 62 3f 22 29 0a 20 the test db?").
8280: 20 20 20 3b 3b 20 28 6f 70 65 6e 2d 72 75 6e 2d ;; (open-run-
8290: 63 6c 6f 73 65 20 64 62 3a 64 65 6c 65 74 65 2d close db:delete-
82a0: 74 65 73 74 2d 73 74 65 70 2d 72 65 63 6f 72 64 test-step-record
82b0: 73 20 64 62 20 74 65 73 74 2d 69 64 29 0a 20 20 s db test-id).
82c0: 20 20 28 63 68 61 6e 67 65 2d 64 69 72 65 63 74 (change-direct
82d0: 6f 72 79 20 77 6f 72 6b 2d 61 72 65 61 29 20 3b ory work-area) ;
82e0: 3b 20 73 6f 20 74 68 61 74 20 6c 6f 67 20 66 69 ; so that log fi
82f0: 6c 65 73 20 66 72 6f 6d 20 74 68 65 20 6c 61 75 les from the lau
8300: 6e 63 68 20 70 72 6f 63 65 73 73 20 64 6f 6e 27 nch process don'
8310: 74 20 63 6c 75 74 74 65 72 20 74 68 65 20 74 65 t clutter the te
8320: 73 74 20 64 69 72 0a 20 20 20 20 28 74 65 73 74 st dir. (test
8330: 73 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 s:test-set-statu
8340: 73 21 20 74 65 73 74 2d 69 64 20 22 4c 41 55 4e s! test-id "LAUN
8350: 43 48 45 44 22 20 22 6e 2f 61 22 20 23 66 20 23 CHED" "n/a" #f #
8360: 66 29 20 3b 3b 20 28 69 66 20 6c 61 75 6e 63 68 f) ;; (if launch
8370: 2d 72 65 73 75 6c 74 73 20 6c 61 75 6e 63 68 2d -results launch-
8380: 72 65 73 75 6c 74 73 20 22 46 41 49 4c 45 44 22 results "FAILED"
8390: 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 )). (cond.
83a0: 20 20 28 28 61 6e 64 20 6c 61 75 6e 63 68 65 72 ((and launcher
83b0: 20 68 6f 73 74 73 29 20 3b 3b 20 6d 75 73 74 20 hosts) ;; must
83c0: 62 65 20 75 73 69 6e 67 20 73 73 68 20 68 6f 73 be using ssh hos
83d0: 74 6e 61 6d 65 0a 20 20 20 20 20 20 28 73 65 74 tname. (set
83e0: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
83f0: 64 20 6c 61 75 6e 63 68 65 72 20 28 63 61 72 20 d launcher (car
8400: 68 6f 73 74 73 29 28 6c 69 73 74 20 72 65 6d 6f hosts)(list remo
8410: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
8420: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
8430: 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
8440: 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b param))). ;;
8450: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
8460: 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 append launcher
8470: 28 63 61 72 20 68 6f 73 74 73 29 28 6c 69 73 74 (car hosts)(list
8480: 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 74 remote-megatest
8490: 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 63 test-sig "-exec
84a0: 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 29 29 ute" cmdparms)))
84b0: 29 0a 20 20 20 20 20 28 6c 61 75 6e 63 68 65 72 ). (launcher
84c0: 0a 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c . (set! ful
84d0: 6c 63 6d 64 20 28 61 70 70 65 6e 64 20 6c 61 75 lcmd (append lau
84e0: 6e 63 68 65 72 20 28 6c 69 73 74 20 72 65 6d 6f ncher (list remo
84f0: 74 65 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 te-megatest test
8500: 2d 73 69 67 20 22 2d 65 78 65 63 75 74 65 22 20 -sig "-execute"
8510: 63 6d 64 70 61 72 6d 73 29 20 64 65 62 75 67 2d cmdparms) debug-
8520: 70 61 72 61 6d 29 29 29 0a 20 20 20 20 20 3b 3b param))). ;;
8530: 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 20 28 (set! fullcmd (
8540: 61 70 70 65 6e 64 20 6c 61 75 6e 63 68 65 72 20 append launcher
8550: 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 67 (list remote-meg
8560: 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 22 atest test-sig "
8570: 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 72 -execute" cmdpar
8580: 6d 73 29 29 29 29 0a 20 20 20 20 20 28 65 6c 73 ms)))). (els
8590: 65 0a 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 e. (if (not
85a0: 20 75 73 65 73 68 65 6c 6c 29 28 64 65 62 75 67 useshell)(debug
85b0: 3a 70 72 69 6e 74 20 30 20 22 57 41 52 4e 49 4e :print 0 "WARNIN
85c0: 47 3a 20 69 6e 74 65 72 6e 61 6c 20 6c 61 75 6e G: internal laun
85d0: 63 68 69 6e 67 20 77 69 6c 6c 20 6e 6f 74 20 77 ching will not w
85e0: 6f 72 6b 20 77 65 6c 6c 20 77 69 74 68 6f 75 74 ork well without
85f0: 20 5c 22 75 73 65 73 68 65 6c 6c 20 79 65 73 5c \"useshell yes\
8600: 22 20 69 6e 20 79 6f 75 72 20 5b 6a 6f 62 74 6f " in your [jobto
8610: 6f 6c 73 5d 20 73 65 63 74 69 6f 6e 22 29 29 0a ols] section")).
8620: 20 20 20 20 20 20 28 73 65 74 21 20 66 75 6c 6c (set! full
8630: 63 6d 64 20 28 61 70 70 65 6e 64 20 28 6c 69 73 cmd (append (lis
8640: 74 20 72 65 6d 6f 74 65 2d 6d 65 67 61 74 65 73 t remote-megates
8650: 74 20 74 65 73 74 2d 73 69 67 20 22 2d 65 78 65 t test-sig "-exe
8660: 63 75 74 65 22 20 63 6d 64 70 61 72 6d 73 29 20 cute" cmdparms)
8670: 64 65 62 75 67 2d 70 61 72 61 6d 20 28 6c 69 73 debug-param (lis
8680: 74 20 28 69 66 20 75 73 65 73 68 65 6c 6c 20 22 t (if useshell "
8690: 26 22 20 22 22 29 29 29 29 29 29 0a 20 20 20 20 &" "")))))).
86a0: 3b 3b 20 28 73 65 74 21 20 66 75 6c 6c 63 6d 64 ;; (set! fullcmd
86b0: 20 28 6c 69 73 74 20 72 65 6d 6f 74 65 2d 6d 65 (list remote-me
86c0: 67 61 74 65 73 74 20 74 65 73 74 2d 73 69 67 20 gatest test-sig
86d0: 22 2d 65 78 65 63 75 74 65 22 20 63 6d 64 70 61 "-execute" cmdpa
86e0: 72 6d 73 20 28 69 66 20 75 73 65 73 68 65 6c 6c rms (if useshell
86f0: 20 22 26 22 20 22 22 29 29 29 29 29 0a 20 20 20 "&" ""))))).
8700: 20 28 69 66 20 28 61 72 67 73 3a 67 65 74 2d 61 (if (args:get-a
8710: 72 67 20 22 2d 78 74 65 72 6d 22 29 28 73 65 74 rg "-xterm")(set
8720: 21 20 66 75 6c 6c 63 6d 64 20 28 61 70 70 65 6e ! fullcmd (appen
8730: 64 20 66 75 6c 6c 63 6d 64 20 28 6c 69 73 74 20 d fullcmd (list
8740: 22 2d 78 74 65 72 6d 22 29 29 29 29 0a 20 20 20 "-xterm")))).
8750: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 31 20 (debug:print 1
8760: 22 4c 61 75 6e 63 68 69 6e 67 20 22 20 77 6f 72 "Launching " wor
8770: 6b 2d 61 72 65 61 29 0a 20 20 20 20 3b 3b 20 73 k-area). ;; s
8780: 65 74 20 70 72 65 2d 6c 61 75 6e 63 68 2d 65 6e et pre-launch-en
8790: 76 2d 76 61 72 73 20 62 65 66 6f 72 65 20 6c 61 v-vars before la
87a0: 75 6e 63 68 69 6e 67 2c 20 6b 65 65 70 20 74 68 unching, keep th
87b0: 65 20 76 61 72 73 20 69 6e 20 70 72 65 76 76 61 e vars in prevva
87c0: 6c 73 20 61 6e 64 20 70 75 74 20 74 68 65 20 65 ls and put the e
87d0: 6e 76 69 6f 6e 6d 65 6e 74 20 62 61 63 6b 20 77 nvionment back w
87e0: 68 65 6e 20 64 6f 6e 65 0a 20 20 20 20 28 64 65 hen done. (de
87f0: 62 75 67 3a 70 72 69 6e 74 20 34 20 22 66 75 6c bug:print 4 "ful
8800: 6c 63 6d 64 3a 20 22 20 66 75 6c 6c 63 6d 64 29 lcmd: " fullcmd)
8810: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d . (let* ((com
8820: 6d 6f 6e 70 72 65 76 76 61 6c 73 20 28 61 6c 69 monprevvals (ali
8830: 73 74 2d 3e 65 6e 76 2d 76 61 72 73 0a 09 09 09 st->env-vars....
8840: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
8850: 72 65 66 2f 64 65 66 61 75 6c 74 20 2a 63 6f 6e ref/default *con
8860: 66 69 67 64 61 74 2a 20 22 65 6e 76 2d 6f 76 65 figdat* "env-ove
8870: 72 72 69 64 65 22 20 27 28 29 29 29 29 0a 09 20 rride" '())))..
8880: 20 20 28 74 65 73 74 70 72 65 76 76 61 6c 73 20 (testprevvals
8890: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
88a0: 72 73 0a 09 09 09 20 20 20 20 28 68 61 73 68 2d rs.... (hash-
88b0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
88c0: 74 20 74 65 73 74 2d 63 6f 6e 66 20 22 70 72 65 t test-conf "pre
88d0: 2d 6c 61 75 6e 63 68 2d 65 6e 76 2d 6f 76 65 72 -launch-env-over
88e0: 72 69 64 65 73 22 20 27 28 29 29 29 29 0a 09 20 rides" '())))..
88f0: 20 20 28 6d 69 73 63 70 72 65 76 76 61 6c 73 20 (miscprevvals
8900: 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 (alist->env-va
8910: 72 73 20 3b 3b 20 63 6f 6e 73 6f 6c 69 64 61 74 rs ;; consolidat
8920: 65 20 74 68 69 73 20 63 6f 64 65 20 77 69 74 68 e this code with
8930: 20 74 68 65 20 63 6f 64 65 20 69 6e 20 6d 65 67 the code in meg
8940: 61 74 65 73 74 2e 73 63 6d 20 66 6f 72 20 22 2d atest.scm for "-
8950: 65 78 65 63 75 74 65 22 0a 09 09 09 20 20 20 20 execute"....
8960: 28 61 70 70 65 6e 64 20 28 6c 69 73 74 20 28 6c (append (list (l
8970: 69 73 74 20 22 4d 54 5f 54 45 53 54 5f 52 55 4e ist "MT_TEST_RUN
8980: 5f 44 49 52 22 20 77 6f 72 6b 2d 61 72 65 61 29 _DIR" work-area)
8990: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
89a0: 54 5f 54 45 53 54 5f 4e 41 4d 45 22 20 74 65 73 T_TEST_NAME" tes
89b0: 74 2d 6e 61 6d 65 29 0a 09 09 09 09 09 20 20 28 t-name)...... (
89c0: 6c 69 73 74 20 22 4d 54 5f 49 54 45 4d 5f 49 4e list "MT_ITEM_IN
89d0: 46 4f 22 20 28 63 6f 6e 63 20 69 74 65 6d 64 61 FO" (conc itemda
89e0: 74 29 29 20 0a 09 09 09 09 09 20 20 28 6c 69 73 t)) ...... (lis
89f0: 74 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 22 20 20 t "MT_RUNNAME"
8a00: 20 72 75 6e 6e 61 6d 65 29 0a 09 09 09 09 09 20 runname)......
8a10: 20 28 6c 69 73 74 20 22 4d 54 5f 54 41 52 47 45 (list "MT_TARGE
8a20: 54 22 20 20 20 20 6d 74 5f 74 61 72 67 65 74 29 T" mt_target)
8a30: 0a 09 09 09 09 09 20 20 28 6c 69 73 74 20 22 4d ...... (list "M
8a40: 54 5f 49 54 45 4d 50 41 54 48 22 20 20 69 74 65 T_ITEMPATH" ite
8a50: 6d 2d 70 61 74 68 29 0a 09 09 09 09 09 20 20 29 m-path)...... )
8a60: 0a 09 09 09 09 20 20 20 20 69 74 65 6d 64 61 74 ..... itemdat
8a70: 29 29 29 0a 09 20 20 20 3b 3b 20 4c 61 75 6e 63 ))).. ;; Launc
8a80: 68 77 61 69 74 20 64 65 66 61 75 6c 74 73 20 74 hwait defaults t
8a90: 6f 20 74 72 75 65 2c 20 6d 75 73 74 20 6f 76 65 o true, must ove
8aa0: 72 72 69 64 65 20 69 74 20 74 6f 20 74 75 72 6e rride it to turn
8ab0: 20 6f 66 66 20 77 61 69 74 0a 09 20 20 20 28 6c off wait.. (l
8ac0: 61 75 6e 63 68 77 61 69 74 20 20 20 20 20 28 69 aunchwait (i
8ad0: 66 20 28 65 71 75 61 6c 3f 20 28 63 6f 6e 66 69 f (equal? (confi
8ae0: 67 66 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 gf:lookup *confi
8af0: 67 64 61 74 2a 20 22 73 65 74 75 70 22 20 22 6c gdat* "setup" "l
8b00: 61 75 6e 63 68 77 61 69 74 22 29 20 22 6e 6f 22 aunchwait") "no"
8b10: 29 20 23 66 20 23 74 29 29 0a 09 20 20 20 28 6c ) #f #t)).. (l
8b20: 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 20 28 61 aunch-results (a
8b30: 70 70 6c 79 20 28 69 66 20 6c 61 75 6e 63 68 77 pply (if launchw
8b40: 61 69 74 0a 09 09 09 09 20 20 20 20 20 20 63 6d ait..... cm
8b50: 64 2d 72 75 6e 2d 77 69 74 68 2d 73 74 64 65 72 d-run-with-stder
8b60: 72 2d 3e 6c 69 73 74 0a 09 09 09 09 20 20 20 20 r->list.....
8b70: 20 20 70 72 6f 63 65 73 73 2d 72 75 6e 29 0a 09 process-run)..
8b80: 09 09 09 20 20 28 69 66 20 75 73 65 73 68 65 6c ... (if useshel
8b90: 6c 0a 09 09 09 09 20 20 20 20 20 20 28 6c 65 74 l..... (let
8ba0: 20 28 28 63 6d 64 73 74 72 20 28 73 74 72 69 6e ((cmdstr (strin
8bb0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 66 75 g-intersperse fu
8bc0: 6c 6c 63 6d 64 20 22 20 22 29 29 29 0a 09 09 09 llcmd " ")))....
8bd0: 09 09 28 69 66 20 6c 61 75 6e 63 68 77 61 69 74 ..(if launchwait
8be0: 0a 09 09 09 09 09 20 20 20 20 63 6d 64 73 74 72 ...... cmdstr
8bf0: 0a 09 09 09 09 09 20 20 20 20 28 63 6f 6e 63 20 ...... (conc
8c00: 63 6d 64 73 74 72 20 22 20 3e 3e 20 6d 74 5f 6c cmdstr " >> mt_l
8c10: 61 75 6e 63 68 2e 6c 6f 67 20 32 3e 26 31 22 29 aunch.log 2>&1")
8c20: 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 63 61 ))..... (ca
8c30: 72 20 66 75 6c 6c 63 6d 64 29 29 0a 09 09 09 09 r fullcmd)).....
8c40: 20 20 28 69 66 20 75 73 65 73 68 65 6c 6c 0a 09 (if useshell..
8c50: 09 09 09 20 20 20 20 20 20 27 28 29 0a 09 09 09 ... '()....
8c60: 09 20 20 20 20 20 20 28 63 64 72 20 66 75 6c 6c . (cdr full
8c70: 63 6d 64 29 29 29 29 29 0a 20 20 20 20 20 20 28 cmd))))). (
8c80: 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 77 61 if (not launchwa
8c90: 69 74 29 20 3b 3b 20 67 69 76 65 20 74 68 65 20 it) ;; give the
8ca0: 4f 53 20 61 20 6c 69 74 74 6c 65 20 74 69 6d 65 OS a little time
8cb0: 20 74 6f 20 61 6c 6c 6f 77 20 74 68 65 20 70 72 to allow the pr
8cc0: 6f 63 65 73 73 20 74 6f 20 73 74 61 72 74 0a 09 ocess to start..
8cd0: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
8ce0: 20 30 2e 30 31 29 29 0a 20 20 20 20 20 20 28 77 0.01)). (w
8cf0: 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 ith-output-to-fi
8d00: 6c 65 20 22 6d 74 5f 6c 61 75 6e 63 68 2e 6c 6f le "mt_launch.lo
8d10: 67 22 0a 09 28 6c 61 6d 62 64 61 20 28 29 0a 09 g"..(lambda ()..
8d20: 20 20 28 69 66 20 28 6c 69 73 74 3f 20 6c 61 75 (if (list? lau
8d30: 6e 63 68 2d 72 65 73 75 6c 74 73 29 0a 09 20 20 nch-results)..
8d40: 20 20 20 20 28 61 70 70 6c 79 20 70 72 69 6e 74 (apply print
8d50: 20 6c 61 75 6e 63 68 2d 72 65 73 75 6c 74 73 29 launch-results)
8d60: 0a 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 .. (print "
8d70: 4e 4f 54 45 3a 20 6c 61 75 6e 63 68 65 64 20 5c NOTE: launched \
8d80: 22 22 20 66 75 6c 6c 63 6d 64 20 22 5c 22 5c 6e "" fullcmd "\"\n
8d90: 20 20 62 75 74 20 64 69 64 20 6e 6f 74 20 77 61 but did not wa
8da0: 69 74 20 66 6f 72 20 69 74 20 74 6f 20 70 72 6f it for it to pro
8db0: 63 65 65 64 2e 20 41 64 64 20 74 68 65 20 66 6f ceed. Add the fo
8dc0: 6c 6c 6f 77 69 6e 67 20 74 6f 20 6d 65 67 61 74 llowing to megat
8dd0: 65 73 74 2e 63 6f 6e 66 69 67 20 5c 6e 5b 73 65 est.config \n[se
8de0: 74 75 70 5d 5c 6e 6c 61 75 6e 63 68 77 61 69 74 tup]\nlaunchwait
8df0: 20 79 65 73 5c 6e 20 20 69 66 20 79 6f 75 20 68 yes\n if you h
8e00: 61 76 65 20 70 72 6f 62 6c 65 6d 73 20 77 69 74 ave problems wit
8e10: 68 20 74 68 69 73 22 29 29 0a 09 20 20 23 3a 61 h this")).. #:a
8e20: 70 70 65 6e 64 29 29 0a 20 20 20 20 20 20 28 64 ppend)). (d
8e30: 65 62 75 67 3a 70 72 69 6e 74 20 32 20 22 4c 61 ebug:print 2 "La
8e40: 75 6e 63 68 69 6e 67 20 63 6f 6d 70 6c 65 74 65 unching complete
8e50: 64 2c 20 75 70 64 61 74 69 6e 67 20 64 62 22 29 d, updating db")
8e60: 0a 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 . (debug:pr
8e70: 69 6e 74 20 32 20 22 4c 61 75 6e 63 68 20 72 65 int 2 "Launch re
8e80: 73 75 6c 74 73 3a 20 22 20 6c 61 75 6e 63 68 2d sults: " launch-
8e90: 72 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 28 results). (
8ea0: 69 66 20 28 6e 6f 74 20 6c 61 75 6e 63 68 2d 72 if (not launch-r
8eb0: 65 73 75 6c 74 73 29 0a 20 20 20 20 20 20 20 20 esults).
8ec0: 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 (begin.
8ed0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 45 52 52 (print "ERR
8ee0: 4f 52 3a 20 46 61 69 6c 65 64 20 74 6f 20 72 75 OR: Failed to ru
8ef0: 6e 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 n " (string-inte
8f00: 72 73 70 65 72 73 65 20 66 75 6c 6c 63 6d 64 20 rsperse fullcmd
8f10: 22 20 22 29 20 22 2c 20 65 78 69 74 69 6e 67 20 " ") ", exiting
8f20: 6e 6f 77 22 29 0a 20 20 20 20 20 20 20 20 20 20 now").
8f30: 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 66 69 ;; (sqlite3:fi
8f40: 6e 61 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 nalize! db).
8f50: 20 20 20 20 20 20 20 20 3b 3b 20 67 6f 6f 64 20 ;; good
8f60: 6f 6c 65 20 22 65 78 69 74 22 20 73 65 65 6d 73 ole "exit" seems
8f70: 20 6e 6f 74 20 74 6f 20 77 6f 72 6b 0a 20 20 20 not to work.
8f80: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 5f 65 78 ;; (_ex
8f90: 69 74 20 39 29 0a 20 20 20 20 20 20 20 20 20 20 it 9).
8fa0: 20 20 3b 3b 20 62 75 74 20 74 68 69 73 20 68 61 ;; but this ha
8fb0: 63 6b 20 77 69 6c 6c 20 77 6f 72 6b 21 20 54 68 ck will work! Th
8fc0: 61 6e 6b 73 20 67 6f 20 74 6f 20 41 6c 61 6e 20 anks go to Alan
8fd0: 50 6f 73 74 20 6f 66 20 74 68 65 20 43 68 69 63 Post of the Chic
8fe0: 6b 65 6e 20 65 6d 61 69 6c 20 6c 69 73 74 0a 20 ken email list.
8ff0: 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4e 42 ;; NB
9000: 2f 2f 20 49 73 20 74 68 69 73 20 73 74 69 6c 6c // Is this still
9010: 20 6e 65 65 64 65 64 3f 20 53 68 6f 75 6c 64 20 needed? Should
9020: 62 65 20 73 61 66 65 20 74 6f 20 67 6f 20 62 61 be safe to go ba
9030: 63 6b 20 74 6f 20 22 65 78 69 74 22 20 6e 6f 77 ck to "exit" now
9040: 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 70 ?. (p
9050: 72 6f 63 65 73 73 2d 73 69 67 6e 61 6c 20 28 63 rocess-signal (c
9060: 75 72 72 65 6e 74 2d 70 72 6f 63 65 73 73 2d 69 urrent-process-i
9070: 64 29 20 73 69 67 6e 61 6c 2f 6b 69 6c 6c 29 0a d) signal/kill).
9080: 20 20 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 )).
9090: 20 20 20 20 20 28 61 6c 69 73 74 2d 3e 65 6e 76 (alist->env
90a0: 2d 76 61 72 73 20 6d 69 73 63 70 72 65 76 76 61 -vars miscprevva
90b0: 6c 73 29 0a 20 20 20 20 20 20 28 61 6c 69 73 74 ls). (alist
90c0: 2d 3e 65 6e 76 2d 76 61 72 73 20 74 65 73 74 70 ->env-vars testp
90d0: 72 65 76 76 61 6c 73 29 0a 20 20 20 20 20 20 28 revvals). (
90e0: 61 6c 69 73 74 2d 3e 65 6e 76 2d 76 61 72 73 20 alist->env-vars
90f0: 63 6f 6d 6d 6f 6e 70 72 65 76 76 61 6c 73 29 0a commonprevvals).
9100: 20 20 20 20 20 20 6c 61 75 6e 63 68 2d 72 65 73 launch-res
9110: 75 6c 74 73 29 29 0a 20 20 28 63 68 61 6e 67 65 ults)). (change
9120: 2d 64 69 72 65 63 74 6f 72 79 20 2a 74 6f 70 70 -directory *topp
9130: 61 74 68 2a 29 29 0a 0a ath*))..