Artifact
41c86444fa7da3ca515c96f6f08745a6e621c60e:
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 36 2c 20 4d 61 74 74 68 65 77 06-2016, Matthew
0020: 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b Welland..;; .;;
0030: 20 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 This file is pa
0040: 72 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a rt of Megatest..
0050: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
0060: 65 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 est is free soft
0070: 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 ware: you can re
0080: 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e distribute it an
0090: 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 d/or modify.;;
00a0: 20 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 it under the
00b0: 74 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 terms of the GNU
00c0: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
00d0: 4c 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 License as publi
00e0: 73 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 shed by.;; t
00f0: 68 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 he Free Software
0100: 20 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 Foundation, eit
0110: 68 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 her version 3 of
0120: 20 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 the License, or
0130: 0a 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 .;; (at your
0140: 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 option) any lat
0150: 65 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a er version..;; .
0160: 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 ;; Megatest
0170: 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 is distributed i
0180: 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 n the hope that
0190: 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 it will be usefu
01a0: 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 l,.;; but WI
01b0: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01c0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01d0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01e0: 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 ranty of.;;
01f0: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0200: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0210: 20 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 PARTICULAR PURP
0220: 4f 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b OSE. See the.;;
0230: 20 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c GNU General
0240: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0250: 66 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 for more details
0260: 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 ..;; .;; You
0270: 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 should have rec
0280: 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 eived a copy of
0290: 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 the GNU General
02a0: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b Public License.;
02b0: 3b 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 ; along with
02c0: 20 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e Megatest. If n
02d0: 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f ot, see <http://
02e0: 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 www.gnu.org/lice
02f0: 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 20 20 73 74 72 nses/>...;; str
0300: 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f 25 59 20 ftime('%m/%d/%Y
0310: 25 48 3a 25 4d 3a 25 53 27 2c 27 6e 6f 77 27 2c %H:%M:%S','now',
0320: 27 6c 6f 63 61 6c 74 69 6d 65 27 29 0a 0a 28 75 'localtime')..(u
0330: 73 65 20 28 70 72 65 66 69 78 20 73 71 6c 69 74 se (prefix sqlit
0340: 65 33 20 73 71 6c 69 74 65 33 3a 29 20 73 72 66 e3 sqlite3:) srf
0350: 69 2d 31 20 70 6f 73 69 78 20 72 65 67 65 78 20 i-1 posix regex
0360: 72 65 67 65 78 2d 63 61 73 65 20 73 72 66 69 2d regex-case srfi-
0370: 36 39 20 28 73 72 66 69 20 31 38 29 20 0a 20 20 69 (srfi 18) .
0380: 20 20 20 70 6f 73 69 78 2d 65 78 74 72 61 73 20 posix-extras
0390: 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c 73 20 directory-utils
03a0: 70 61 74 68 6e 61 6d 65 2d 65 78 70 61 6e 64 20 pathname-expand
03b0: 74 79 70 65 64 2d 72 65 63 6f 72 64 73 20 66 6f typed-records fo
03c0: 72 6d 61 74 0a 20 20 20 20 20 63 61 6c 6c 2d 77 rmat. call-w
03d0: 69 74 68 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d ith-environment-
03e0: 76 61 72 69 61 62 6c 65 73 29 0a 28 64 65 63 6c variables).(decl
03f0: 61 72 65 20 28 75 6e 69 74 20 73 75 62 72 75 6e are (unit subrun
0400: 29 29 0a 3b 3b 28 64 65 63 6c 61 72 65 20 28 75 )).;;(declare (u
0410: 73 65 73 20 72 75 6e 73 29 29 0a 28 64 65 63 6c ses runs)).(decl
0420: 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a 28 are (uses db)).(
0430: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f declare (uses co
0440: 6d 6d 6f 6e 29 29 0a 3b 3b 28 64 65 63 6c 61 72 mmon)).;;(declar
0450: 65 20 28 75 73 65 73 20 69 74 65 6d 73 29 29 0a e (uses items)).
0460: 3b 3b 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ;;(declare (uses
0470: 20 72 75 6e 63 6f 6e 66 69 67 29 29 0a 3b 3b 28 runconfig)).;;(
0480: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 74 65 declare (uses te
0490: 73 74 73 29 29 0a 3b 3b 28 64 65 63 6c 61 72 65 sts)).;;(declare
04a0: 20 28 75 73 65 73 20 73 65 72 76 65 72 29 29 0a (uses server)).
04b0: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d (declare (uses m
04c0: 74 29 29 0a 3b 3b 28 64 65 63 6c 61 72 65 20 28 t)).;;(declare (
04d0: 75 73 65 73 20 61 72 63 68 69 76 65 29 29 0a 3b uses archive)).;
04e0: 3b 20 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ; (declare (uses
04f0: 20 66 69 6c 65 64 62 29 29 0a 0a 28 64 65 63 6c filedb))..(decl
0500: 61 72 65 20 28 75 73 65 73 20 63 6f 6d 6d 6f 6e are (uses common
0510: 6d 6f 64 29 29 0a 28 64 65 63 6c 61 72 65 20 28 mod)).(declare (
0520: 75 73 65 73 20 64 65 62 75 67 70 72 69 6e 74 29 uses debugprint)
0530: 29 0a 28 69 6d 70 6f 72 74 20 63 6f 6d 6d 6f 6e ).(import common
0540: 6d 6f 64 29 0a 28 69 6d 70 6f 72 74 20 64 65 62 mod).(import deb
0550: 75 67 70 72 69 6e 74 29 0a 0a 28 64 65 63 6c 61 ugprint)..(decla
0560: 72 65 20 28 75 73 65 73 20 63 6f 6e 66 69 67 66 re (uses configf
0570: 6d 6f 64 29 29 0a 28 69 6d 70 6f 72 74 20 63 6f mod)).(import co
0580: 6e 66 69 67 66 6d 6f 64 29 0a 0a 28 64 65 63 6c nfigfmod)..(decl
0590: 61 72 65 20 28 75 73 65 73 20 64 62 6d 6f 64 29 are (uses dbmod)
05a0: 29 0a 28 69 6d 70 6f 72 74 20 64 62 6d 6f 64 29 ).(import dbmod)
05b0: 0a 0a 3b 3b 28 69 6e 63 6c 75 64 65 20 22 63 6f ..;;(include "co
05c0: 6d 6d 6f 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d mmon_records.scm
05d0: 22 29 0a 3b 3b 28 69 6e 63 6c 75 64 65 20 22 6b ").;;(include "k
05e0: 65 79 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 ey_records.scm")
05f0: 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 65 .(include "db_re
0600: 63 6f 72 64 73 2e 73 63 6d 22 29 20 3b 3b 20 70 cords.scm") ;; p
0610: 72 6f 76 69 64 65 73 20 64 62 3a 74 65 73 74 2d rovides db:test-
0620: 67 65 74 2d 69 64 0a 3b 3b 28 69 6e 63 6c 75 64 get-id.;;(includ
0630: 65 20 22 72 75 6e 5f 72 65 63 6f 72 64 73 2e 73 e "run_records.s
0640: 63 6d 22 29 0a 3b 3b 28 69 6e 63 6c 75 64 65 20 cm").;;(include
0650: 22 74 65 73 74 5f 72 65 63 6f 72 64 73 2e 73 63 "test_records.sc
0660: 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 m")..(define (su
0670: 62 72 75 6e 3a 73 75 62 72 75 6e 2d 74 65 73 74 brun:subrun-test
0680: 2d 69 6e 69 74 69 61 6c 69 7a 65 64 3f 20 74 65 -initialized? te
0690: 73 74 2d 72 75 6e 2d 64 69 72 29 0a 20 20 28 69 st-run-dir). (i
06a0: 66 20 28 61 6e 64 20 28 63 6f 6d 6d 6f 6e 3a 66 f (and (common:f
06b0: 69 6c 65 2d 65 78 69 73 74 73 3f 20 28 63 6f 6e ile-exists? (con
06c0: 63 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 22 c test-run-dir "
06d0: 2f 73 75 62 72 75 6e 2d 61 72 65 61 22 29 20 29 /subrun-area") )
06e0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6d . (com
06f0: 6d 6f 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f mon:file-exists?
0700: 20 28 63 6f 6e 63 20 74 65 73 74 2d 72 75 6e 2d (conc test-run-
0710: 64 69 72 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 dir "/testconfig
0720: 2e 73 75 62 72 75 6e 22 29 20 29 29 0a 20 20 20 .subrun") )).
0730: 20 20 20 23 74 0a 20 20 20 20 20 20 23 66 29 29 #t. #f))
0740: 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 62 72 75 ..(define (subru
0750: 6e 3a 6c 61 75 6e 63 68 2d 64 61 73 68 62 6f 61 n:launch-dashboa
0760: 72 64 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 rd test-run-dir
0770: 23 21 6b 65 79 20 28 74 61 72 67 65 74 20 23 66 #!key (target #f
0780: 29 28 72 75 6e 6e 61 6d 65 20 23 66 29 29 0a 20 )(runname #f)).
0790: 20 28 69 66 20 28 73 75 62 72 75 6e 3a 73 75 62 (if (subrun:sub
07a0: 72 75 6e 2d 74 65 73 74 2d 69 6e 69 74 69 61 6c run-test-initial
07b0: 69 7a 65 64 3f 20 74 65 73 74 2d 72 75 6e 2d 64 ized? test-run-d
07c0: 69 72 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 ir). (let*
07d0: 28 28 73 75 62 61 72 65 61 20 28 73 75 62 72 75 ((subarea (subru
07e0: 6e 3a 67 65 74 2d 72 75 6e 61 72 65 61 20 74 65 n:get-runarea te
07f0: 73 74 2d 72 75 6e 2d 64 69 72 29 29 0a 09 20 20 st-run-dir))..
0800: 20 20 20 28 70 61 72 61 6d 73 20 20 28 63 6f 6e (params (con
0810: 63 20 28 69 66 20 74 61 72 67 65 74 20 28 63 6f c (if target (co
0820: 6e 63 20 22 20 2d 74 61 72 67 65 74 20 22 20 74 nc " -target " t
0830: 61 72 67 65 74 29 20 22 22 29 0a 09 09 09 20 20 arget) "")....
0840: 20 20 28 69 66 20 72 75 6e 6e 61 6d 65 20 28 63 (if runname (c
0850: 6f 6e 63 20 22 20 2d 72 75 6e 6e 61 6d 65 20 22 onc " -runname "
0860: 20 72 75 6e 6e 61 6d 65 29 20 22 22 29 29 29 29 runname) ""))))
0870: 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e . (if (an
0880: 64 20 73 75 62 61 72 65 61 20 28 63 6f 6d 6d 6f d subarea (commo
0890: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 73 n:file-exists? s
08a0: 75 62 61 72 65 61 29 29 0a 20 20 20 20 20 20 20 ubarea)).
08b0: 20 20 20 20 20 28 73 79 73 74 65 6d 20 28 63 6f (system (co
08c0: 6e 63 20 22 63 64 20 22 20 73 75 62 61 72 65 61 nc "cd " subarea
08d0: 20 22 3b 65 6e 76 20 2d 69 20 50 41 54 48 3d 24 ";env -i PATH=$
08e0: 50 41 54 48 20 44 49 53 50 4c 41 59 3d 24 44 49 PATH DISPLAY=$DI
08f0: 53 50 4c 41 59 20 48 4f 4d 45 3d 24 48 4f 4d 45 SPLAY HOME=$HOME
0900: 20 55 53 45 52 3d 24 55 53 45 52 20 6e 62 66 61 USER=$USER nbfa
0910: 6b 65 20 64 61 73 68 62 6f 61 72 64 20 22 20 70 ke dashboard " p
0920: 61 72 61 6d 73 29 29 29 29 29 29 0a 0a 28 64 65 arams))))))..(de
0930: 66 69 6e 65 20 28 73 75 62 72 75 6e 3a 73 75 62 fine (subrun:sub
0940: 72 75 6e 2d 72 65 6d 6f 76 65 64 3f 20 74 65 73 run-removed? tes
0950: 74 2d 72 75 6e 2d 64 69 72 29 0a 20 20 28 69 66 t-run-dir). (if
0960: 20 28 73 75 62 72 75 6e 3a 73 75 62 72 75 6e 2d (subrun:subrun-
0970: 74 65 73 74 2d 69 6e 69 74 69 61 6c 69 7a 65 64 test-initialized
0980: 3f 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 0a ? test-run-dir).
0990: 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 6c 61 (let ((fla
09a0: 67 66 69 6c 65 20 28 63 6f 6e 63 20 74 65 73 74 gfile (conc test
09b0: 2d 72 75 6e 2d 64 69 72 20 22 2f 73 75 62 72 75 -run-dir "/subru
09c0: 6e 2e 72 65 6d 6f 76 65 64 22 29 29 29 0a 20 20 n.removed"))).
09d0: 20 20 20 20 20 20 28 69 66 20 28 63 6f 6d 6d 6f (if (commo
09e0: 6e 3a 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 66 n:file-exists? f
09f0: 6c 61 67 66 69 6c 65 29 0a 20 20 20 20 20 20 20 lagfile).
0a00: 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 20 #t.
0a10: 20 20 20 20 23 66 29 29 0a 20 20 20 20 20 20 23 #f)). #
0a20: 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 t))..(define (su
0a30: 62 72 75 6e 3a 73 65 74 2d 73 75 62 72 75 6e 2d brun:set-subrun-
0a40: 72 65 6d 6f 76 65 64 20 74 65 73 74 2d 72 75 6e removed test-run
0a50: 2d 64 69 72 29 0a 20 20 28 6c 65 74 20 28 28 66 -dir). (let ((f
0a60: 6c 61 67 66 69 6c 65 20 28 63 6f 6e 63 20 74 65 lagfile (conc te
0a70: 73 74 2d 72 75 6e 2d 64 69 72 20 22 2f 73 75 62 st-run-dir "/sub
0a80: 72 75 6e 2e 72 65 6d 6f 76 65 64 22 29 29 29 0a run.removed"))).
0a90: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 73 75 (if (and (su
0aa0: 62 72 75 6e 3a 73 75 62 72 75 6e 2d 74 65 73 74 brun:subrun-test
0ab0: 2d 69 6e 69 74 69 61 6c 69 7a 65 64 3f 20 74 65 -initialized? te
0ac0: 73 74 2d 72 75 6e 2d 64 69 72 29 20 28 6e 6f 74 st-run-dir) (not
0ad0: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
0ae0: 69 73 74 73 3f 20 66 6c 61 67 66 69 6c 65 29 29 ists? flagfile))
0af0: 29 0a 20 20 20 20 20 20 20 20 28 77 69 74 68 2d ). (with-
0b00: 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c 65 20 66 output-to-file f
0b10: 6c 61 67 66 69 6c 65 0a 20 20 20 20 20 20 20 20 lagfile.
0b20: 20 20 28 6c 61 6d 62 64 61 20 28 29 20 28 70 72 (lambda () (pr
0b30: 69 6e 74 20 28 63 75 72 72 65 6e 74 2d 73 65 63 int (current-sec
0b40: 6f 6e 64 73 29 29 29 29 29 29 29 0a 0a 28 64 65 onds)))))))..(de
0b50: 66 69 6e 65 20 28 73 75 62 72 75 6e 3a 75 6e 73 fine (subrun:uns
0b60: 65 74 2d 73 75 62 72 75 6e 2d 72 65 6d 6f 76 65 et-subrun-remove
0b70: 64 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 0a d test-run-dir).
0b80: 20 20 28 6c 65 74 20 28 28 66 6c 61 67 66 69 6c (let ((flagfil
0b90: 65 20 28 63 6f 6e 63 20 74 65 73 74 2d 72 75 6e e (conc test-run
0ba0: 2d 64 69 72 20 22 2f 73 75 62 72 75 6e 2e 72 65 -dir "/subrun.re
0bb0: 6d 6f 76 65 64 22 29 29 29 0a 20 20 20 20 28 69 moved"))). (i
0bc0: 66 20 28 61 6e 64 20 28 73 75 62 72 75 6e 3a 73 f (and (subrun:s
0bd0: 75 62 72 75 6e 2d 74 65 73 74 2d 69 6e 69 74 69 ubrun-test-initi
0be0: 61 6c 69 7a 65 64 3f 20 74 65 73 74 2d 72 75 6e alized? test-run
0bf0: 2d 64 69 72 29 20 28 63 6f 6d 6d 6f 6e 3a 66 69 -dir) (common:fi
0c00: 6c 65 2d 65 78 69 73 74 73 3f 20 66 6c 61 67 66 le-exists? flagf
0c10: 69 6c 65 29 29 0a 20 20 20 20 20 20 20 20 28 64 ile)). (d
0c20: 65 6c 65 74 65 2d 66 69 6c 65 20 66 6c 61 67 66 elete-file flagf
0c30: 69 6c 65 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e ile))))...(defin
0c40: 65 20 28 73 75 62 72 75 6e 3a 74 65 73 74 63 6f e (subrun:testco
0c50: 6e 66 69 67 2d 64 65 66 69 6e 65 73 2d 73 75 62 nfig-defines-sub
0c60: 72 75 6e 3f 20 74 65 73 74 63 6f 6e 66 69 67 29 run? testconfig)
0c70: 0a 20 20 28 63 6f 6e 66 69 67 66 3a 6c 6f 6f 6b . (configf:look
0c80: 75 70 20 74 65 73 74 63 6f 6e 66 69 67 20 22 73 up testconfig "s
0c90: 75 62 72 75 6e 22 20 22 72 75 6e 77 61 69 74 22 ubrun" "runwait"
0ca0: 29 29 20 3b 3b 20 77 65 20 75 73 65 20 72 75 6e )) ;; we use run
0cb0: 77 61 69 74 20 61 73 20 74 68 65 20 66 6c 61 67 wait as the flag
0cc0: 20 74 68 61 74 20 61 20 73 75 62 72 75 6e 20 69 that a subrun i
0cd0: 73 20 72 65 71 75 65 73 74 65 64 0a 0a 28 64 65 s requested..(de
0ce0: 66 69 6e 65 20 28 73 75 62 72 75 6e 3a 69 6e 69 fine (subrun:ini
0cf0: 74 69 61 6c 69 7a 65 2d 74 6f 70 72 75 6e 2d 74 tialize-toprun-t
0d00: 65 73 74 20 20 74 65 73 74 63 6f 6e 66 69 67 20 est testconfig
0d10: 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 0a 20 20 test-run-dir).
0d20: 28 6c 65 74 20 28 28 72 61 20 28 63 6f 6e 66 69 (let ((ra (confi
0d30: 67 66 3a 6c 6f 6f 6b 75 70 20 74 65 73 74 63 6f gf:lookup testco
0d40: 6e 66 69 67 20 22 73 75 62 72 75 6e 22 20 22 72 nfig "subrun" "r
0d50: 75 6e 2d 61 72 65 61 22 29 29 0a 20 20 20 20 20 un-area")).
0d60: 20 20 20 28 6c 6f 67 70 72 6f 20 28 63 6f 6e 66 (logpro (conf
0d70: 69 67 66 3a 6c 6f 6f 6b 75 70 20 74 65 73 74 63 igf:lookup testc
0d80: 6f 6e 66 69 67 20 22 73 75 62 72 75 6e 22 20 22 onfig "subrun" "
0d90: 6c 6f 67 70 72 6f 22 29 29 0a 20 20 20 20 20 20 logpro")).
0da0: 20 20 28 73 79 6d 6c 69 6e 6b 2d 74 61 72 67 65 (symlink-targe
0db0: 74 20 28 63 6f 6e 63 20 74 65 73 74 2d 72 75 6e t (conc test-run
0dc0: 2d 64 69 72 20 22 2f 73 75 62 72 75 6e 2d 61 72 -dir "/subrun-ar
0dd0: 65 61 22 29 29 0a 20 20 20 20 20 20 20 20 29 0a ea")). ).
0de0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 72 61 29 (if (not ra)
0df0: 20 20 20 20 20 20 3b 3b 20 77 68 65 6e 20 72 75 ;; when ru
0e00: 6e 61 72 65 61 20 69 73 20 6e 6f 74 20 73 65 74 narea is not set
0e10: 20 77 65 20 64 65 66 61 75 6c 74 20 74 6f 20 2a we default to *
0e20: 74 6f 70 70 61 74 68 2a 2e 20 48 6f 77 65 76 65 toppath*. Howeve
0e30: 72 20 0a 09 28 6c 65 74 20 28 28 66 61 6c 6c 62 r ..(let ((fallb
0e40: 61 63 6b 2d 72 75 6e 2d 61 72 65 61 20 28 6f 72 ack-run-area (or
0e50: 20 2a 74 6f 70 70 61 74 68 2a 20 28 63 6f 6e 63 *toppath* (conc
0e60: 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 22 2f test-run-dir "/
0e70: 73 75 62 72 75 6e 22 29 29 29 29 0a 09 20 20 3b subrun")))).. ;
0e80: 3b 20 77 65 20 6e 65 65 64 20 74 6f 20 66 6f 72 ; we need to for
0e90: 63 65 20 74 68 65 20 73 65 74 74 69 6e 67 20 69 ce the setting i
0ea0: 6e 20 74 68 65 20 74 65 73 74 63 6f 6e 66 69 67 n the testconfig
0eb0: 20 73 6f 20 69 74 20 77 69 6c 6c 0a 20 20 20 20 so it will.
0ec0: 20 20 20 20 20 20 3b 3b 20 62 65 20 70 72 65 73 ;; be pres
0ed0: 65 72 76 65 64 20 69 6e 20 74 68 65 20 74 65 73 erved in the tes
0ee0: 74 63 6f 6e 66 69 67 2e 73 75 62 72 75 6e 20 66 tconfig.subrun f
0ef0: 69 6c 65 0a 09 20 20 28 63 6f 6e 66 69 67 66 3a ile.. (configf:
0f00: 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 61 72 20 set-section-var
0f10: 74 65 73 74 63 6f 6e 66 69 67 20 22 73 75 62 72 testconfig "subr
0f20: 75 6e 22 20 22 72 75 6e 2d 61 72 65 61 22 20 66 un" "run-area" f
0f30: 61 6c 6c 62 61 63 6b 2d 72 75 6e 2d 61 72 65 61 allback-run-area
0f40: 29 0a 09 20 20 28 73 65 74 21 20 72 61 20 66 61 ).. (set! ra fa
0f50: 6c 6c 62 61 63 6b 2d 72 75 6e 2d 61 72 65 61 29 llback-run-area)
0f60: 29 29 0a 20 20 20 20 28 63 6f 6e 66 69 67 66 3a )). (configf:
0f70: 73 65 74 2d 73 65 63 74 69 6f 6e 2d 76 61 72 20 set-section-var
0f80: 74 65 73 74 63 6f 6e 66 69 67 20 22 6c 6f 67 70 testconfig "logp
0f90: 72 6f 22 20 22 73 75 62 72 75 6e 22 20 6c 6f 67 ro" "subrun" log
0fa0: 70 72 6f 29 20 3b 3b 20 61 70 70 65 6e 64 20 74 pro) ;; append t
0fb0: 68 65 20 6c 6f 67 70 72 6f 20 72 75 6c 65 73 20 he logpro rules
0fc0: 74 6f 20 74 68 65 20 6c 6f 67 70 72 6f 20 73 65 to the logpro se
0fd0: 63 74 69 6f 6e 20 61 73 20 73 74 65 70 6e 61 6d ction as stepnam
0fe0: 65 20 73 75 62 72 75 6e 0a 20 20 20 20 28 69 66 e subrun. (if
0ff0: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
1000: 69 73 74 73 3f 20 73 79 6d 6c 69 6e 6b 2d 74 61 ists? symlink-ta
1010: 72 67 65 74 29 0a 20 20 20 20 20 20 20 20 28 64 rget). (d
1020: 65 6c 65 74 65 2d 66 69 6c 65 20 73 79 6d 6c 69 elete-file symli
1030: 6e 6b 2d 74 61 72 67 65 74 29 29 0a 20 20 20 20 nk-target)).
1040: 28 63 72 65 61 74 65 2d 73 79 6d 62 6f 6c 69 63 (create-symbolic
1050: 2d 6c 69 6e 6b 20 72 61 20 73 79 6d 6c 69 6e 6b -link ra symlink
1060: 2d 74 61 72 67 65 74 29 0a 20 20 20 20 28 63 6f -target). (co
1070: 6e 66 69 67 66 3a 77 72 69 74 65 2d 61 6c 69 73 nfigf:write-alis
1080: 74 20 74 65 73 74 63 6f 6e 66 69 67 20 22 74 65 t testconfig "te
1090: 73 74 63 6f 6e 66 69 67 2e 73 75 62 72 75 6e 22 stconfig.subrun"
10a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 )))..(define (su
10b0: 62 72 75 6e 3a 73 65 74 2d 73 74 61 74 65 2d 73 brun:set-state-s
10c0: 74 61 74 75 73 20 74 65 73 74 2d 72 75 6e 2d 64 tatus test-run-d
10d0: 69 72 20 73 74 61 74 65 20 73 74 61 74 75 73 20 ir state status
10e0: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
10f0: 29 0a 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f ). (if (and (no
1100: 74 20 28 73 75 62 72 75 6e 3a 73 75 62 72 75 6e t (subrun:subrun
1110: 2d 72 65 6d 6f 76 65 64 3f 20 74 65 73 74 2d 72 -removed? test-r
1120: 75 6e 2d 64 69 72 29 29 20 28 73 75 62 72 75 6e un-dir)) (subrun
1130: 3a 73 75 62 72 75 6e 2d 74 65 73 74 2d 69 6e 69 :subrun-test-ini
1140: 74 69 61 6c 69 7a 65 64 3f 20 74 65 73 74 2d 72 tialized? test-r
1150: 75 6e 2d 64 69 72 29 29 0a 20 20 20 20 20 20 28 un-dir)). (
1160: 6c 65 74 2a 20 28 28 61 63 74 69 6f 6e 2d 73 77 let* ((action-sw
1170: 69 74 63 68 65 73 2d 73 74 72 0a 20 20 20 20 20 itches-str.
1180: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 (conc "
1190: 2d 73 65 74 2d 73 74 61 74 65 2d 73 74 61 74 75 -set-state-statu
11a0: 73 20 22 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 s "new-state-sta
11b0: 74 75 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 tus.
11c0: 20 20 20 20 20 20 20 20 28 69 66 20 73 74 61 74 (if stat
11d0: 65 20 28 63 6f 6e 63 20 22 20 2d 73 74 61 74 65 e (conc " -state
11e0: 20 22 73 74 61 74 65 29 20 22 22 29 0a 20 20 20 "state) "").
11f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1200: 20 28 69 66 20 73 74 61 74 75 73 20 28 63 6f 6e (if status (con
1210: 63 20 22 20 2d 73 74 61 74 75 73 20 22 73 74 61 c " -status "sta
1220: 74 75 73 29 20 22 22 29 29 29 0a 20 20 20 20 20 tus) ""))).
1230: 20 20 20 20 20 20 20 20 28 6c 6f 67 2d 70 72 65 (log-pre
1240: 66 69 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 fix.
1250: 20 20 28 73 75 62 72 75 6e 3a 73 61 6e 69 74 69 (subrun:saniti
1260: 7a 65 2d 70 61 74 68 0a 20 20 20 20 20 20 20 20 ze-path.
1270: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 73 65 (conc "se
1280: 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 3d 22 t-state-status="
1290: 6e 65 77 2d 73 74 61 74 65 2d 73 74 61 74 75 73 new-state-status
12a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12b0: 20 20 20 20 20 20 28 69 66 20 73 74 61 74 65 20 (if state
12c0: 28 63 6f 6e 63 20 22 3a 73 74 61 74 65 3d 22 73 (conc ":state="s
12d0: 74 61 74 65 29 20 22 22 29 0a 20 20 20 20 20 20 tate) "").
12e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12f0: 69 66 20 73 74 61 74 75 73 20 28 63 6f 6e 63 20 if status (conc
1300: 22 2b 73 74 61 74 75 73 3d 22 73 74 61 74 75 73 "+status="status
1310: 29 20 22 22 29 29 29 29 0a 20 20 20 20 20 20 20 ) "")))).
1320: 20 20 20 20 20 20 28 73 75 62 6d 74 2d 72 65 73 (submt-res
1330: 75 6c 74 20 0a 20 20 20 20 20 20 20 20 20 20 20 ult .
1340: 20 20 20 28 73 75 62 72 75 6e 3a 65 78 65 63 2d (subrun:exec-
1350: 73 75 62 2d 6d 65 67 61 74 65 73 74 20 74 65 73 sub-megatest tes
1360: 74 2d 72 75 6e 2d 64 69 72 20 61 63 74 69 6f 6e t-run-dir action
1370: 2d 73 77 69 74 63 68 65 73 2d 73 74 72 20 6c 6f -switches-str lo
1380: 67 2d 70 72 65 66 69 78 29 29 29 0a 20 20 20 20 g-prefix))).
1390: 20 20 20 20 73 75 62 6d 74 2d 72 65 73 75 6c 74 submt-result
13a0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 )))..(define (su
13b0: 62 72 75 6e 3a 72 65 6d 6f 76 65 2d 73 75 62 72 brun:remove-subr
13c0: 75 6e 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 un test-run-dir
13d0: 6b 65 65 70 2d 72 65 63 6f 72 64 73 20 29 0a 20 keep-records ).
13e0: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 28 (if (and (not (
13f0: 73 75 62 72 75 6e 3a 73 75 62 72 75 6e 2d 72 65 subrun:subrun-re
1400: 6d 6f 76 65 64 3f 20 74 65 73 74 2d 72 75 6e 2d moved? test-run-
1410: 64 69 72 29 29 20 28 73 75 62 72 75 6e 3a 73 75 dir)) (subrun:su
1420: 62 72 75 6e 2d 74 65 73 74 2d 69 6e 69 74 69 61 brun-test-initia
1430: 6c 69 7a 65 64 3f 20 74 65 73 74 2d 72 75 6e 2d lized? test-run-
1440: 64 69 72 29 29 0a 20 20 20 20 20 20 28 6c 65 74 dir)). (let
1450: 2a 20 28 28 61 63 74 69 6f 6e 2d 73 77 69 74 63 * ((action-switc
1460: 68 65 73 2d 73 74 72 0a 20 20 20 20 20 20 20 20 hes-str.
1470: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 2d 72 65 (conc "-re
1480: 6d 6f 76 65 2d 72 75 6e 73 22 0a 20 20 20 20 20 move-runs".
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
14a0: 69 66 20 6b 65 65 70 2d 72 65 63 6f 72 64 73 20 if keep-records
14b0: 22 2d 6b 65 65 70 2d 72 65 63 6f 72 64 73 20 22 "-keep-records "
14c0: 20 22 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 "").
14d0: 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 20 20 )).
14e0: 20 20 20 20 20 20 20 20 20 28 72 65 6d 6f 76 65 (remove
14f0: 2d 72 65 73 75 6c 74 0a 20 20 20 20 20 20 20 20 -result.
1500: 20 20 20 20 20 20 28 73 75 62 72 75 6e 3a 65 78 (subrun:ex
1510: 65 63 2d 73 75 62 2d 6d 65 67 61 74 65 73 74 20 ec-sub-megatest
1520: 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 61 63 74 test-run-dir act
1530: 69 6f 6e 2d 73 77 69 74 63 68 65 73 2d 73 74 72 ion-switches-str
1540: 20 22 72 65 6d 6f 76 65 22 29 29 29 0a 20 20 20 "remove"))).
1550: 20 20 20 20 20 28 69 66 20 72 65 6d 6f 76 65 2d (if remove-
1560: 72 65 73 75 6c 74 0a 20 20 20 20 20 20 20 20 20 result.
1570: 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
1580: 20 20 20 20 20 20 20 20 28 73 75 62 72 75 6e 3a (subrun:
1590: 73 65 74 2d 73 75 62 72 75 6e 2d 72 65 6d 6f 76 set-subrun-remov
15a0: 65 64 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 ed test-run-dir)
15b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 . #
15c0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 23 t). #
15d0: 66 29 29 0a 20 20 20 20 20 20 23 74 29 29 0a 0a f)). #t))..
15e0: 28 64 65 66 69 6e 65 20 28 73 75 62 72 75 6e 3a (define (subrun:
15f0: 6b 69 6c 6c 2d 73 75 62 72 75 6e 20 74 65 73 74 kill-subrun test
1600: 2d 72 75 6e 2d 64 69 72 20 29 0a 20 20 28 69 66 -run-dir ). (if
1610: 20 28 61 6e 64 20 28 6e 6f 74 20 28 73 75 62 72 (and (not (subr
1620: 75 6e 3a 73 75 62 72 75 6e 2d 72 65 6d 6f 76 65 un:subrun-remove
1630: 64 3f 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 d? test-run-dir)
1640: 29 20 28 73 75 62 72 75 6e 3a 73 75 62 72 75 6e ) (subrun:subrun
1650: 2d 74 65 73 74 2d 69 6e 69 74 69 61 6c 69 7a 65 -test-initialize
1660: 64 3f 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 29 d? test-run-dir)
1670: 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ). (let* ((
1680: 61 63 74 69 6f 6e 2d 73 77 69 74 63 68 65 73 2d action-switches-
1690: 73 74 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 str.
16a0: 20 20 28 63 6f 6e 63 20 22 2d 6b 69 6c 6c 2d 72 (conc "-kill-r
16b0: 75 6e 73 22 20 29 29 0a 20 20 20 20 20 20 20 20 uns" )).
16c0: 20 20 20 20 20 28 6b 69 6c 6c 2d 72 65 73 75 6c (kill-resul
16d0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
16e0: 28 73 75 62 72 75 6e 3a 65 78 65 63 2d 73 75 62 (subrun:exec-sub
16f0: 2d 6d 65 67 61 74 65 73 74 20 74 65 73 74 2d 72 -megatest test-r
1700: 75 6e 2d 64 69 72 20 61 63 74 69 6f 6e 2d 73 77 un-dir action-sw
1710: 69 74 63 68 65 73 2d 73 74 72 20 22 6b 69 6c 6c itches-str "kill
1720: 22 29 29 29 0a 20 20 20 20 20 20 20 20 6b 69 6c "))). kil
1730: 6c 2d 72 65 73 75 6c 74 29 0a 20 20 20 20 20 20 l-result).
1740: 23 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 #t))..(define (s
1750: 75 62 72 75 6e 3a 6c 61 75 6e 63 68 2d 63 6d 64 ubrun:launch-cmd
1760: 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 23 21 test-run-dir #!
1770: 6f 70 74 69 6f 6e 61 6c 20 28 73 75 62 2d 63 6d optional (sub-cm
1780: 64 20 22 2d 72 75 6e 22 29 29 20 3b 3b 20 42 55 d "-run")) ;; BU
1790: 47 3a 20 22 2d 72 75 6e 22 20 73 68 6f 75 6c 64 G: "-run" should
17a0: 20 62 65 20 63 68 61 6e 67 65 64 20 74 6f 20 22 be changed to "
17b0: 2d 72 65 72 75 6e 2d 63 6c 65 61 6e 22 20 62 75 -rerun-clean" bu
17c0: 74 20 63 75 72 72 65 6e 74 20 64 6f 65 73 6e 27 t current doesn'
17d0: 74 20 77 6f 72 6b 0a 20 20 28 69 66 20 28 73 75 t work. (if (su
17e0: 62 72 75 6e 3a 73 75 62 72 75 6e 2d 72 65 6d 6f brun:subrun-remo
17f0: 76 65 64 3f 20 74 65 73 74 2d 72 75 6e 2d 64 69 ved? test-run-di
1800: 72 29 0a 20 20 20 20 20 20 28 73 75 62 72 75 6e r). (subrun
1810: 3a 75 6e 73 65 74 2d 73 75 62 72 75 6e 2d 72 65 :unset-subrun-re
1820: 6d 6f 76 65 64 20 74 65 73 74 2d 72 75 6e 2d 64 moved test-run-d
1830: 69 72 29 29 20 20 20 20 20 20 0a 0a 20 20 28 6c ir)) .. (l
1840: 65 74 2a 20 28 28 6c 6f 67 2d 70 72 65 66 69 78 et* ((log-prefix
1850: 20 22 72 75 6e 22 29 0a 20 20 20 20 20 20 20 20 "run").
1860: 20 28 73 77 69 74 63 68 65 73 20 28 73 75 62 72 (switches (subr
1870: 75 6e 3a 73 65 6c 65 63 74 6f 72 2b 6c 6f 67 2d un:selector+log-
1880: 73 77 69 74 63 68 65 73 20 74 65 73 74 2d 72 75 switches test-ru
1890: 6e 2d 64 69 72 20 6c 6f 67 2d 70 72 65 66 69 78 n-dir log-prefix
18a0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 75 6e )). (run
18b0: 2d 77 61 69 74 20 23 74 29 0a 20 20 20 20 20 20 -wait #t).
18c0: 20 20 20 28 63 6d 64 20 20 20 20 20 20 28 63 6f (cmd (co
18d0: 6e 63 20 22 6d 65 67 61 74 65 73 74 20 22 20 73 nc "megatest " s
18e0: 75 62 2d 63 6d 64 20 22 20 22 20 73 77 69 74 63 ub-cmd " " switc
18f0: 68 65 73 22 20 22 0a 20 20 20 20 20 20 20 20 20 hes" ".
1900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1910: 28 69 66 20 72 75 6e 2d 77 61 69 74 20 22 2d 72 (if run-wait "-r
1920: 75 6e 2d 77 61 69 74 20 22 20 22 22 29 29 29 29 un-wait " ""))))
1930: 0a 20 20 20 20 63 6d 64 29 29 0a 0a 0a 28 64 65 . cmd))...(de
1940: 66 69 6e 65 20 28 73 75 62 72 75 6e 3a 73 61 6e fine (subrun:san
1950: 69 74 69 7a 65 2d 70 61 74 68 20 69 6e 70 61 74 itize-path inpat
1960: 68 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 6e 73 h). (let* ((ins
1970: 61 6e 65 2d 70 61 74 74 65 72 6e 20 28 69 72 72 ane-pattern (irr
1980: 65 67 65 78 20 22 5b 5e 5b 61 2d 7a 41 2d 5a 30 egex "[^[a-zA-Z0
1990: 2d 39 5f 5c 5c 2d 5d 22 29 29 29 0a 20 20 20 20 -9_\\-]"))).
19a0: 28 72 65 67 65 78 23 73 74 72 69 6e 67 2d 73 75 (regex#string-su
19b0: 62 73 74 69 74 75 74 65 20 69 6e 73 61 6e 65 2d bstitute insane-
19c0: 70 61 74 74 65 72 6e 20 22 5f 22 20 69 6e 70 61 pattern "_" inpa
19d0: 74 68 20 23 74 29 29 29 0a 0a 28 64 65 66 69 6e th #t)))..(defin
19e0: 65 20 28 73 75 62 72 75 6e 3a 67 65 74 2d 72 75 e (subrun:get-ru
19f0: 6e 61 72 65 61 20 74 65 73 74 2d 72 75 6e 2d 64 narea test-run-d
1a00: 69 72 29 0a 20 20 28 69 66 20 28 73 75 62 72 75 ir). (if (subru
1a10: 6e 3a 73 75 62 72 75 6e 2d 74 65 73 74 2d 69 6e n:subrun-test-in
1a20: 69 74 69 61 6c 69 7a 65 64 3f 20 74 65 73 74 2d itialized? test-
1a30: 72 75 6e 2d 64 69 72 29 0a 20 20 20 20 20 20 28 run-dir). (
1a40: 6c 65 74 2a 20 28 28 69 6e 66 6f 2d 61 6c 69 73 let* ((info-alis
1a50: 74 20 28 73 75 62 72 75 6e 3a 73 65 6c 65 63 74 t (subrun:select
1a60: 6f 72 2b 6c 6f 67 2d 61 6c 69 73 74 0a 20 20 20 or+log-alist.
1a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a80: 20 20 20 20 20 20 20 74 65 73 74 2d 72 75 6e 2d test-run-
1a90: 64 69 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 dir.
1aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 66 "f
1ab0: 6f 6f 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 oo")).
1ac0: 20 20 20 28 72 75 6e 2d 61 72 65 61 20 20 20 28 (run-area (
1ad0: 69 66 20 28 6c 69 73 74 3f 20 69 6e 66 6f 2d 61 if (list? info-a
1ae0: 6c 69 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 list).
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b00: 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 2d (alist-ref "-
1b10: 73 74 61 72 74 2d 64 69 72 22 20 69 6e 66 6f 2d start-dir" info-
1b20: 61 6c 69 73 74 20 65 71 75 61 6c 3f 20 23 66 29 alist equal? #f)
1b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 #f
1b50: 29 29 29 0a 20 20 20 20 20 20 20 20 72 75 6e 2d ))). run-
1b60: 61 72 65 61 29 0a 20 20 20 20 20 20 23 66 29 29 area). #f))
1b70: 0a 0a 28 64 65 66 69 6e 65 20 28 73 75 62 72 75 ..(define (subru
1b80: 6e 3a 73 65 6c 65 63 74 6f 72 2b 6c 6f 67 2d 61 n:selector+log-a
1b90: 6c 69 73 74 20 74 65 73 74 2d 72 75 6e 2d 64 69 list test-run-di
1ba0: 72 20 6c 6f 67 2d 70 72 65 66 69 78 29 0a 20 20 r log-prefix).
1bb0: 28 6c 65 74 2a 20 28 28 73 77 69 74 63 68 2d 64 (let* ((switch-d
1bc0: 65 66 2d 61 6c 69 73 74 20 28 63 6f 6d 6d 6f 6e ef-alist (common
1bd0: 3a 67 65 74 2d 70 61 72 61 6d 2d 6d 61 70 70 69 :get-param-mappi
1be0: 6e 67 20 66 6c 61 76 6f 72 3a 20 27 63 6f 6e 66 ng flavor: 'conf
1bf0: 69 67 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 ig)). (s
1c00: 75 62 72 75 6e 66 69 6c 65 20 20 20 28 63 6f 6e ubrunfile (con
1c10: 63 20 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 22 c test-run-dir "
1c20: 2f 74 65 73 74 63 6f 6e 66 69 67 2e 73 75 62 72 /testconfig.subr
1c30: 75 6e 22 20 29 29 0a 20 20 20 20 20 20 20 20 20 un" )).
1c40: 28 73 75 62 72 75 6e 64 61 74 61 20 20 20 28 77 (subrundata (w
1c50: 69 74 68 2d 69 6e 70 75 74 2d 66 72 6f 6d 2d 66 ith-input-from-f
1c60: 69 6c 65 20 73 75 62 72 75 6e 66 69 6c 65 20 72 ile subrunfile r
1c70: 65 61 64 29 29 0a 20 20 20 20 20 20 20 20 20 28 ead)). (
1c80: 73 75 62 72 75 6e 63 6f 6e 66 69 67 20 28 63 6f subrunconfig (co
1c90: 6e 66 69 67 66 3a 61 6c 69 73 74 2d 3e 63 6f 6e nfigf:alist->con
1ca0: 66 69 67 20 73 75 62 72 75 6e 64 61 74 61 29 29 fig subrundata))
1cb0: 0a 20 20 20 20 20 20 20 20 20 28 72 75 6e 2d 61 . (run-a
1cc0: 72 65 61 20 20 20 20 20 28 63 6f 6e 66 69 67 66 rea (configf
1cd0: 3a 6c 6f 6f 6b 75 70 20 73 75 62 72 75 6e 63 6f :lookup subrunco
1ce0: 6e 66 69 67 20 22 73 75 62 72 75 6e 22 20 22 72 nfig "subrun" "r
1cf0: 75 6e 2d 61 72 65 61 22 29 29 0a 20 20 20 20 20 un-area")).
1d00: 20 20 20 20 28 64 65 66 76 61 6c 73 20 20 20 20 (defvals
1d10: 20 20 60 28 28 22 73 74 61 72 74 2d 64 69 72 22 `(("start-dir"
1d20: 20 2e 20 2c 28 6f 72 20 72 75 6e 2d 61 72 65 61 . ,(or run-area
1d30: 20 20 3b 3b 20 64 65 66 61 75 6c 74 20 76 61 6c ;; default val
1d40: 75 65 73 20 69 66 20 6e 6f 74 20 73 70 65 63 69 ues if not speci
1d50: 66 69 65 64 20 69 6e 20 73 75 62 72 75 6e 20 73 fied in subrun s
1d60: 65 63 74 69 6f 6e 20 6f 66 20 74 63 6f 6e 66 0a ection of tconf.
1d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 65 (ge
1da0: 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 t-environment-va
1db0: 72 69 61 62 6c 65 20 22 4d 54 5f 52 55 4e 5f 41 riable "MT_RUN_A
1dc0: 52 45 41 5f 48 4f 4d 45 22 29 0a 20 20 20 20 20 REA_HOME").
1dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df0: 20 20 20 20 20 20 20 20 22 2f 6e 6f 2f 72 75 6e "/no/run
1e00: 64 69 72 2f 66 6f 75 6e 64 22 29 29 20 0a 20 20 dir/found")) .
1e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e20: 20 20 20 20 20 20 20 28 22 72 75 6e 2d 6e 61 6d ("run-nam
1e30: 65 22 20 20 2e 20 2c 28 6f 72 20 28 67 65 74 2d e" . ,(or (get-
1e40: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 69 environment-vari
1e50: 61 62 6c 65 20 22 4d 54 5f 52 55 4e 4e 41 4d 45 able "MT_RUNNAME
1e60: 22 29 20 22 4e 4f 2d 52 55 4e 4e 41 4d 45 22 29 ") "NO-RUNNAME")
1e70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1e80: 20 20 20 20 20 20 20 20 20 20 20 28 22 74 61 72 ("tar
1e90: 67 65 74 22 20 20 20 20 2e 20 2c 28 6f 72 20 28 get" . ,(or (
1ea0: 67 65 74 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d get-environment-
1eb0: 76 61 72 69 61 62 6c 65 20 22 4d 54 5f 54 41 52 variable "MT_TAR
1ec0: 47 45 54 22 29 20 20 22 4e 4f 2d 54 41 52 47 45 GET") "NO-TARGE
1ed0: 54 22 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 T")))).
1ee0: 28 73 77 69 74 63 68 2d 61 6c 69 73 74 2d 70 72 (switch-alist-pr
1ef0: 65 20 20 28 66 69 6c 74 65 72 2d 6d 61 70 20 28 e (filter-map (
1f00: 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 20 20 lambda (item).
1f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f30: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
1f40: 63 6f 6e 66 69 67 2d 6b 65 79 20 28 63 61 72 20 config-key (car
1f50: 69 74 65 6d 29 29 0a 20 20 20 20 20 20 20 20 20 item)).
1f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f80: 20 20 20 20 20 20 20 20 28 73 77 69 74 63 68 20 (switch
1f90: 20 20 20 20 28 63 64 72 20 69 74 65 6d 29 29 0a (cdr item)).
1fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fd0: 20 28 64 65 66 76 61 6c 20 20 20 20 20 28 61 6c (defval (al
1fe0: 69 73 74 2d 72 65 66 20 63 6f 6e 66 69 67 2d 6b ist-ref config-k
1ff0: 65 79 20 64 65 66 76 61 6c 73 20 65 71 75 61 6c ey defvals equal
2000: 3f 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 ? #f)).
2010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2030: 20 20 20 20 20 20 20 20 28 76 61 6c 20 20 20 20 (val
2040: 20 20 20 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 (or (configf
2050: 3a 6c 6f 6f 6b 75 70 20 73 75 62 72 75 6e 63 6f :lookup subrunco
2060: 6e 66 69 67 20 22 73 75 62 72 75 6e 22 20 63 6f nfig "subrun" co
2070: 6e 66 69 67 2d 6b 65 79 29 0a 20 20 20 20 20 20 nfig-key).
2080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20b0: 20 20 20 20 20 20 20 20 20 20 20 64 65 66 76 61 defva
20c0: 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 l))).
20d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20f0: 20 28 69 66 20 76 61 6c 0a 20 20 20 20 20 20 20 (if val.
2100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2120: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 73 (cons s
2130: 77 69 74 63 68 20 76 61 6c 29 0a 20 20 20 20 20 witch val).
2140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2160: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 #f)))
2170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2190: 20 20 20 20 20 20 20 20 20 73 77 69 74 63 68 2d switch-
21a0: 64 65 66 2d 61 6c 69 73 74 29 29 0a 0a 20 20 20 def-alist))..
21b0: 20 20 20 20 20 20 3b 3b 20 74 65 73 74 70 61 74 ;; testpat
21c0: 74 20 6d 61 79 20 62 65 20 6d 6f 64 69 66 69 65 t may be modifie
21d0: 64 20 69 66 20 61 6c 6c 20 74 68 72 65 65 20 6f d if all three o
21e0: 66 20 6d 6f 64 65 2d 70 61 74 74 2c 20 74 61 67 f mode-patt, tag
21f0: 2d 65 78 70 72 2c 20 61 6e 64 20 74 65 73 74 70 -expr, and testp
2200: 61 74 74 20 61 72 65 20 6e 75 6c 6c 0a 20 20 20 att are null.
2210: 20 20 20 20 20 20 28 6d 6f 64 65 2d 70 61 74 74 (mode-patt
2220: 20 20 20 20 20 28 61 6c 69 73 74 2d 72 65 66 20 (alist-ref
2230: 22 2d 6d 6f 64 65 70 61 74 74 22 20 73 77 69 74 "-modepatt" swit
2240: 63 68 2d 61 6c 69 73 74 2d 70 72 65 20 65 71 75 ch-alist-pre equ
2250: 61 6c 3f 20 23 66 29 29 0a 20 20 20 20 20 20 20 al? #f)).
2260: 20 20 28 74 61 67 2d 65 78 70 72 20 20 20 20 20 (tag-expr
2270: 20 28 61 6c 69 73 74 2d 72 65 66 20 22 2d 74 61 (alist-ref "-ta
2280: 67 65 78 70 72 22 20 73 77 69 74 63 68 2d 61 6c gexpr" switch-al
2290: 69 73 74 2d 70 72 65 20 65 71 75 61 6c 3f 20 23 ist-pre equal? #
22a0: 66 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 65 f)). (te
22b0: 73 74 70 61 74 74 20 20 20 20 20 20 28 61 6c 69 stpatt (ali
22c0: 73 74 2d 72 65 66 20 22 2d 74 65 73 74 70 61 74 st-ref "-testpat
22d0: 74 22 20 73 77 69 74 63 68 2d 61 6c 69 73 74 2d t" switch-alist-
22e0: 70 72 65 20 65 71 75 61 6c 3f 0a 20 20 20 20 20 pre equal?.
22f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
2310: 66 20 28 6e 6f 74 20 28 6f 72 20 6d 6f 64 65 2d f (not (or mode-
2320: 70 61 74 74 20 74 61 67 2d 65 78 70 72 29 29 20 patt tag-expr))
2330: 22 25 22 20 23 66 29 29 29 20 3b 3b 20 74 65 73 "%" #f))) ;; tes
2340: 74 70 61 74 74 20 69 73 20 25 20 69 66 20 6e 6f tpatt is % if no
2350: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
2360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a0: 20 3b 3b 20 6f 74 68 65 72 77 69 73 65 20 73 70 ;; otherwise sp
23b0: 65 63 69 66 69 65 64 0a 0a 20 20 20 20 20 20 20 ecified..
23c0: 20 20 3b 3b 20 64 65 66 69 6e 65 20 63 6f 6d 70 ;; define comp
23d0: 61 63 74 2d 73 74 65 6d 20 66 6f 72 20 6c 6f 67 act-stem for log
23e0: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 28 74 file. (t
23f0: 61 72 67 65 74 20 20 20 20 20 20 20 20 28 61 6c arget (al
2400: 69 73 74 2d 72 65 66 20 22 2d 74 61 72 67 65 74 ist-ref "-target
2410: 22 20 73 77 69 74 63 68 2d 61 6c 69 73 74 2d 70 " switch-alist-p
2420: 72 65 20 65 71 75 61 6c 3f 20 23 66 29 29 20 3b re equal? #f)) ;
2430: 3b 20 77 61 6e 74 20 64 61 74 61 2d 73 74 72 75 ; want data-stru
2440: 63 74 75 72 65 73 20 61 6c 69 73 74 2d 72 65 66 ctures alist-ref
2450: 2c 20 6e 6f 74 20 61 6c 69 73 74 2d 6c 69 62 20 , not alist-lib
2460: 61 6c 69 73 74 2d 72 65 66 0a 20 20 20 20 20 20 alist-ref.
2470: 20 20 20 28 72 75 6e 6e 61 6d 65 20 20 20 20 20 (runname
2480: 20 20 28 61 6c 69 73 74 2d 72 65 66 20 22 2d 72 (alist-ref "-r
2490: 75 6e 6e 61 6d 65 22 20 73 77 69 74 63 68 2d 61 unname" switch-a
24a0: 6c 69 73 74 2d 70 72 65 20 65 71 75 61 6c 3f 20 list-pre equal?
24b0: 23 66 29 29 0a 0a 0a 20 20 20 20 20 20 20 20 20 #f))...
24c0: 28 63 6f 6d 70 61 63 74 2d 73 74 65 6d 20 20 28 (compact-stem (
24d0: 73 75 62 72 75 6e 3a 73 61 6e 69 74 69 7a 65 2d subrun:sanitize-
24e0: 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 path.
24f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
2500: 6f 6e 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 onc.
2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 61 ta
2520: 72 67 65 74 0a 20 20 20 20 20 20 20 20 20 20 20 rget.
2530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
2540: 2d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 -".
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 75 6e run
2560: 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 name.
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
2580: 2d 22 20 28 6f 72 20 74 65 73 74 70 61 74 74 20 -" (or testpatt
2590: 6d 6f 64 65 2d 70 61 74 74 20 74 61 67 2d 65 78 mode-patt tag-ex
25a0: 70 72 20 22 4e 4f 2d 54 45 53 54 50 41 54 54 22 pr "NO-TESTPATT"
25b0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c )))). (l
25c0: 6f 67 66 69 6c 65 20 20 20 20 20 20 20 28 63 6f ogfile (co
25d0: 6e 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nc.
25e0: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 test
25f0: 2d 72 75 6e 2d 64 69 72 20 22 2f 22 0a 20 20 20 -run-dir "/".
2600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2610: 20 20 20 20 20 20 28 69 66 20 6c 6f 67 2d 70 72 (if log-pr
2620: 65 66 69 78 0a 20 20 20 20 20 20 20 20 20 20 20 efix.
2630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2640: 20 20 28 63 6f 6e 63 20 28 73 75 62 72 75 6e 3a (conc (subrun:
2650: 73 61 6e 69 74 69 7a 65 2d 70 61 74 68 20 6c 6f sanitize-path lo
2660: 67 2d 70 72 65 66 69 78 29 20 22 2d 22 29 0a 20 g-prefix) "-").
2670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2680: 20 20 20 20 20 20 20 20 20 20 20 20 22 22 29 0a "").
2690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26a0: 20 20 20 20 20 20 20 20 20 63 6f 6d 70 61 63 74 compact
26b0: 2d 73 74 65 6d 0a 20 20 20 20 20 20 20 20 20 20 -stem.
26c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
26d0: 2e 6c 6f 67 22 29 29 0a 20 20 20 20 20 20 20 20 .log")).
26e0: 20 3b 3b 20 73 77 61 70 20 6f 75 74 20 74 65 73 ;; swap out tes
26f0: 74 70 61 74 74 20 77 69 74 68 20 6d 6f 64 69 66 tpatt with modif
2700: 69 65 64 20 74 65 73 74 2d 70 61 74 74 20 61 6e ied test-patt an
2710: 64 20 61 64 64 20 2d 6c 6f 67 0a 20 20 20 20 20 d add -log.
2720: 20 20 20 20 28 73 77 69 74 63 68 2d 61 6c 69 73 (switch-alis
2730: 74 20 20 28 63 6f 6e 73 0a 20 20 20 20 20 20 20 t (cons.
2740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2750: 20 20 28 63 6f 6e 73 20 22 2d 6c 6f 67 22 20 6c (cons "-log" l
2760: 6f 67 66 69 6c 65 29 0a 20 20 20 20 20 20 20 20 ogfile).
2770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2780: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 69 (map (lambda (i
2790: 74 65 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 tem).
27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27b0: 20 20 20 20 20 28 69 66 20 28 65 71 75 61 6c 3f (if (equal?
27c0: 20 28 63 61 72 20 69 74 65 6d 29 20 22 2d 74 65 (car item) "-te
27d0: 73 74 70 61 74 74 22 29 0a 20 20 20 20 20 20 20 stpatt").
27e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
2800: 6e 73 20 22 2d 74 65 73 74 70 61 74 74 22 20 74 ns "-testpatt" t
2810: 65 73 74 70 61 74 74 29 0a 20 20 20 20 20 20 20 estpatt).
2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2830: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 74 65 ite
2840: 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 m)).
2850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2860: 20 20 20 20 73 77 69 74 63 68 2d 61 6c 69 73 74 switch-alist
2870: 2d 70 72 65 29 29 29 29 0a 20 20 20 20 28 77 69 -pre)))). (wi
2880: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
2890: 65 20 22 73 75 62 72 75 6e 2d 63 6f 6d 6d 61 6e e "subrun-comman
28a0: 64 2d 70 61 72 74 73 2e 73 65 78 70 22 0a 20 20 d-parts.sexp".
28b0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
28c0: 28 70 70 20 73 77 69 74 63 68 2d 61 6c 69 73 74 (pp switch-alist
28d0: 29 29 29 0a 20 20 20 20 73 77 69 74 63 68 2d 61 ))). switch-a
28e0: 6c 69 73 74 29 29 0a 20 20 20 20 3b 3b 20 6e 6f list)). ;; no
28f0: 74 65 20 2d 20 67 65 74 20 70 72 65 63 6d 64 20 te - get precmd
2900: 66 72 6f 6d 20 73 75 62 72 75 6e 20 73 65 63 74 from subrun sect
2910: 69 6f 6e 0a 20 20 20 20 3b 3b 20 20 20 61 70 70 ion. ;; app
2920: 6c 79 20 74 6f 20 73 75 62 6d 65 67 61 74 65 73 ly to submegates
2930: 74 20 63 6f 6d 6d 61 6e 64 73 0a 0a 28 64 65 66 t commands..(def
2940: 69 6e 65 20 28 73 75 62 72 75 6e 3a 67 65 74 2d ine (subrun:get-
2950: 6c 6f 67 2d 70 61 74 68 20 74 65 73 74 2d 72 75 log-path test-ru
2960: 6e 2d 64 69 72 20 6c 6f 67 2d 70 72 65 66 69 78 n-dir log-prefix
2970: 29 0a 20 20 28 6c 65 74 2a 20 28 28 61 6c 69 73 ). (let* ((alis
2980: 74 20 28 73 75 62 72 75 6e 3a 73 65 6c 65 63 74 t (subrun:select
2990: 6f 72 2b 6c 6f 67 2d 61 6c 69 73 74 20 74 65 73 or+log-alist tes
29a0: 74 2d 72 75 6e 2d 64 69 72 20 6c 6f 67 2d 70 72 t-run-dir log-pr
29b0: 65 66 69 78 29 29 0a 20 20 20 20 20 20 20 20 20 efix)).
29c0: 28 72 65 73 20 20 20 28 61 6c 69 73 74 2d 72 65 (res (alist-re
29d0: 66 20 22 2d 6c 6f 67 22 20 61 6c 69 73 74 20 65 f "-log" alist e
29e0: 71 75 61 6c 3f 20 23 66 29 29 29 0a 20 20 20 20 qual? #f))).
29f0: 72 65 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 res))..(define (
2a00: 73 75 62 72 75 6e 3a 73 65 6c 65 63 74 6f 72 2b subrun:selector+
2a10: 6c 6f 67 2d 73 77 69 74 63 68 65 73 20 74 65 73 log-switches tes
2a20: 74 2d 72 75 6e 2d 64 69 72 20 6c 6f 67 2d 70 72 t-run-dir log-pr
2a30: 65 66 69 78 29 0a 20 20 28 6c 65 74 2a 20 28 28 efix). (let* ((
2a40: 73 77 69 74 63 68 2d 61 6c 69 73 74 20 28 73 75 switch-alist (su
2a50: 62 72 75 6e 3a 73 65 6c 65 63 74 6f 72 2b 6c 6f brun:selector+lo
2a60: 67 2d 61 6c 69 73 74 20 74 65 73 74 2d 72 75 6e g-alist test-run
2a70: 2d 64 69 72 20 6c 6f 67 2d 70 72 65 66 69 78 29 -dir log-prefix)
2a80: 29 0a 20 20 20 20 20 20 20 20 20 28 72 65 73 0a ). (res.
2a90: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
2aa0: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 0a 20 20 g-intersperse.
2ab0: 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 0a (apply.
2ac0: 20 20 20 20 20 20 20 20 20 20 20 20 61 70 70 65 appe
2ad0: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 nd. (
2ae0: 6d 61 70 0a 20 20 20 20 20 20 20 20 20 20 20 20 map.
2af0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
2b00: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
2b10: 74 20 28 63 61 72 20 78 29 20 28 63 64 72 20 78 t (car x) (cdr x
2b20: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
2b30: 20 73 77 69 74 63 68 2d 61 6c 69 73 74 29 29 0a switch-alist)).
2b40: 20 20 20 20 20 20 20 20 20 20 20 22 20 22 29 29 " "))
2b50: 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 28 64 65 ). res))..(de
2b60: 66 69 6e 65 20 28 73 75 62 72 75 6e 3a 65 78 65 fine (subrun:exe
2b70: 63 2d 73 75 62 2d 6d 65 67 61 74 65 73 74 20 74 c-sub-megatest t
2b80: 65 73 74 2d 72 75 6e 2d 64 69 72 20 61 63 74 69 est-run-dir acti
2b90: 6f 6e 2d 73 77 69 74 63 68 65 73 2d 73 74 72 20 on-switches-str
2ba0: 6c 6f 67 2d 70 72 65 66 69 78 29 0a 20 20 28 6c log-prefix). (l
2bb0: 65 74 2a 20 28 28 73 65 6c 65 63 74 6f 72 2d 73 et* ((selector-s
2bc0: 77 69 74 63 68 65 73 20 20 28 73 75 62 72 75 6e witches (subrun
2bd0: 3a 73 65 6c 65 63 74 6f 72 2b 6c 6f 67 2d 73 77 :selector+log-sw
2be0: 69 74 63 68 65 73 20 74 65 73 74 2d 72 75 6e 2d itches test-run-
2bf0: 64 69 72 20 6c 6f 67 2d 70 72 65 66 69 78 29 29 dir log-prefix))
2c00: 0a 20 20 20 20 20 20 20 20 20 28 63 6d 64 20 28 . (cmd (
2c10: 63 6f 6e 63 20 22 6d 65 67 61 74 65 73 74 20 22 conc "megatest "
2c20: 20 73 65 6c 65 63 74 6f 72 2d 73 77 69 74 63 68 selector-switch
2c30: 65 73 20 22 20 22 20 61 63 74 69 6f 6e 2d 73 77 es " " action-sw
2c40: 69 74 63 68 65 73 2d 73 74 72 20 29 29 0a 20 20 itches-str )).
2c50: 20 20 20 20 20 20 20 28 70 69 64 20 23 66 29 0a (pid #f).
2c60: 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 20 28 (proc (
2c70: 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
2c80: 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 75 (debu
2c90: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a g:print-info 0 *
2ca0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2cb0: 2a 20 22 52 75 6e 6e 69 6e 67 20 73 75 62 20 6d * "Running sub m
2cc0: 65 67 61 74 65 73 74 20 63 6f 6d 6d 61 6e 64 3a egatest command:
2cd0: 20 22 63 6d 64 29 0a 20 20 20 20 20 20 20 20 20 "cmd).
2ce0: 20 20 20 20 20 20 20 20 3b 3b 28 73 65 74 21 20 ;;(set!
2cf0: 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e pid (process-run
2d00: 20 22 2f 75 73 72 2f 62 69 6e 2f 78 74 65 72 6d "/usr/bin/xterm
2d10: 22 20 28 6c 69 73 74 20 29 29 29 29 29 29 0a 20 " (list )))))).
2d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d30: 28 73 65 74 21 20 70 69 64 20 28 70 72 6f 63 65 (set! pid (proce
2d40: 73 73 2d 72 75 6e 20 22 2f 62 69 6e 2f 62 61 73 ss-run "/bin/bas
2d50: 68 22 20 28 6c 69 73 74 20 22 2d 63 22 20 63 6d h" (list "-c" cm
2d60: 64 29 29 29 29 29 29 0a 20 20 20 20 28 63 61 6c d)))))). (cal
2d70: 6c 2d 77 69 74 68 2d 65 6e 76 69 72 6f 6e 6d 65 l-with-environme
2d80: 6e 74 2d 76 61 72 69 61 62 6c 65 73 20 0a 20 20 nt-variables .
2d90: 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 22 (list (cons "
2da0: 50 41 54 48 22 20 28 63 6f 6e 63 20 28 67 65 74 PATH" (conc (get
2db0: 2d 65 6e 76 69 72 6f 6e 6d 65 6e 74 2d 76 61 72 -environment-var
2dc0: 69 61 62 6c 65 20 22 50 41 54 48 22 29 20 22 3a iable "PATH") ":
2dd0: 2e 22 29 29 29 0a 20 20 20 20 20 28 6c 61 6d 62 ."))). (lamb
2de0: 64 61 20 20 28 29 0a 20 20 20 20 20 20 20 28 63 da (). (c
2df0: 6f 6d 6d 6f 6e 3a 77 69 74 68 6f 75 74 2d 76 61 ommon:without-va
2e00: 72 73 20 70 72 6f 63 20 22 5e 4d 54 5f 2e 2a 22 rs proc "^MT_.*"
2e10: 29 29 29 0a 20 20 20 20 28 6c 65 74 20 70 72 6f ))). (let pro
2e20: 63 65 73 73 6c 6f 6f 70 20 28 28 69 20 30 29 29 cessloop ((i 0))
2e30: 0a 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 . (let-valu
2e40: 65 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 es (((pid-val ex
2e50: 69 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 it-status exit-c
2e60: 6f 64 65 29 28 70 72 6f 63 65 73 73 2d 77 61 69 ode)(process-wai
2e70: 74 20 70 69 64 20 23 74 29 29 29 0a 20 20 20 20 t pid #t))).
2e80: 20 20 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 (if (eq? pid
2e90: 2d 76 61 6c 20 30 29 0a 20 20 20 20 20 20 20 20 -val 0).
2ea0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
2eb0: 20 20 20 20 20 20 20 20 20 28 74 68 72 65 61 64 (thread
2ec0: 2d 73 6c 65 65 70 21 20 32 29 0a 20 20 20 20 20 -sleep! 2).
2ed0: 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 65 73 (proces
2ee0: 73 6c 6f 6f 70 20 28 2b 20 69 20 31 29 29 29 0a sloop (+ i 1))).
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 (beg
2f00: 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 in.
2f10: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e (debug:print-in
2f20: 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f fo 0 *default-lo
2f30: 67 2d 70 6f 72 74 2a 20 22 73 75 62 20 6d 65 67 g-port* "sub meg
2f40: 61 74 65 73 74 20 22 20 61 63 74 69 6f 6e 2d 73 atest " action-s
2f50: 77 69 74 63 68 65 73 2d 73 74 72 20 22 20 63 6f witches-str " co
2f60: 6d 70 6c 65 74 65 64 20 77 69 74 68 20 65 78 69 mpleted with exi
2f70: 74 20 63 6f 64 65 20 22 20 65 78 69 74 2d 63 6f t code " exit-co
2f80: 64 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 de).
2f90: 20 20 28 69 66 20 28 65 71 3f 20 30 20 65 78 69 (if (eq? 0 exi
2fa0: 74 2d 63 6f 64 65 29 0a 20 20 20 20 20 20 20 20 t-code).
2fb0: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
2fc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2fd0: 20 20 20 20 20 23 74 29 0a 20 20 20 20 20 20 20 #t).
2fe0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi
2ff0: 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
3000: 20 20 20 20 20 20 23 66 29 29 29 29 29 29 29 29 #f))))))))
3010: 0a 0a 0a 0a 3b 3b 20 28 73 75 62 72 75 6e 3a 65 ....;; (subrun:e
3020: 78 65 63 2d 73 75 62 2d 6d 65 67 61 74 65 73 74 xec-sub-megatest
3030: 20 22 2f 6e 66 73 2f 70 64 78 2f 64 69 73 6b 73 "/nfs/pdx/disks
3040: 2f 69 63 66 5f 65 6e 76 5f 64 69 73 6b 30 30 31 /icf_env_disk001
3050: 2f 62 6a 62 61 72 63 6c 61 2f 67 77 61 2f 69 73 /bjbarcla/gwa/is
3060: 73 75 65 73 2f 6d 74 64 65 76 2f 31 36 35 2f 6d sues/mtdev/165/m
3070: 65 67 61 74 65 73 74 2f 65 78 74 2d 74 65 73 74 egatest/ext-test
3080: 73 2f 74 65 73 74 73 2f 73 75 62 72 75 6e 2d 75 s/tests/subrun-u
3090: 73 65 63 61 73 65 73 2f 74 6f 70 61 72 65 61 2f secases/toparea/
30a0: 6c 69 6e 6b 73 2f 53 59 53 54 45 4d 5f 76 61 6c links/SYSTEM_val
30b0: 2f 52 45 4c 45 41 53 45 5f 76 61 6c 2f 67 6f 2f /RELEASE_val/go/
30c0: 74 6f 70 74 65 73 74 22 20 22 2d 66 6f 6f 22 20 toptest" "-foo"
30d0: 22 66 6f 6f 22 29 0a "foo").