Artifact
b166d59095feb2582707a1fe943d02279c17f7e6:
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 32 2c 20 4d 61 74 74 68 65 77 06-2012, 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 3b 3b 0a 0a 3b 3b 20 20 nses/>..;;..;;
0300: 73 74 72 66 74 69 6d 65 28 27 25 6d 2f 25 64 2f strftime('%m/%d/
0310: 25 59 20 25 48 3a 25 4d 3a 25 53 27 2c 27 6e 6f %Y %H:%M:%S','no
0320: 77 27 2c 27 6c 6f 63 61 6c 74 69 6d 65 27 29 0a w','localtime').
0330: 0a 28 75 73 65 20 73 72 66 69 2d 31 20 70 6f 73 .(use srfi-1 pos
0340: 69 78 20 72 65 67 65 78 20 73 72 66 69 2d 36 39 ix regex srfi-69
0350: 20 64 69 72 65 63 74 6f 72 79 2d 75 74 69 6c 73 directory-utils
0360: 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e 69 )..(declare (uni
0370: 74 20 65 7a 73 74 65 70 73 29 29 0a 28 64 65 63 t ezsteps)).(dec
0380: 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 29 0a lare (uses db)).
0390: 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 (declare (uses c
03a0: 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 72 65 ommon)).(declare
03b0: 20 28 75 73 65 73 20 69 74 65 6d 73 29 29 0a 28 (uses items)).(
03c0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 72 75 declare (uses ru
03d0: 6e 63 6f 6e 66 69 67 29 29 0a 3b 3b 20 28 64 65 nconfig)).;; (de
03e0: 63 6c 61 72 65 20 28 75 73 65 73 20 73 64 62 29 clare (uses sdb)
03f0: 29 0a 3b 3b 20 28 64 65 63 6c 61 72 65 20 28 75 ).;; (declare (u
0400: 73 65 73 20 66 69 6c 65 64 62 29 29 0a 0a 28 69 ses filedb))..(i
0410: 6e 63 6c 75 64 65 20 22 63 6f 6d 6d 6f 6e 5f 72 nclude "common_r
0420: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 28 69 6e ecords.scm").(in
0430: 63 6c 75 64 65 20 22 6b 65 79 5f 72 65 63 6f 72 clude "key_recor
0440: 64 73 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 ds.scm").(includ
0450: 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 e "db_records.sc
0460: 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 22 72 75 m").(include "ru
0470: 6e 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a n_records.scm").
0480: 0a 0a 3b 3b 28 72 6d 74 3a 67 65 74 2d 74 65 73 ..;;(rmt:get-tes
0490: 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 20 72 75 6e t-info-by-id run
04a0: 2d 69 64 20 74 65 73 74 2d 69 64 29 20 2d 3e 20 -id test-id) ->
04b0: 74 65 73 74 64 61 74 0a 0a 0a 0a 28 64 65 66 69 testdat....(defi
04c0: 6e 65 20 28 65 7a 73 74 65 70 73 3a 72 75 6e 2d ne (ezsteps:run-
04d0: 66 72 6f 6d 20 74 65 73 74 64 61 74 20 73 74 61 from testdat sta
04e0: 72 74 2d 73 74 65 70 2d 6e 61 6d 65 20 72 75 6e rt-step-name run
04f0: 2d 6f 6e 65 29 0a 20 20 3b 3b 23 20 54 4f 44 4f -one). ;;# TODO
0500: 20 2d 20 72 65 63 61 70 74 75 72 65 20 69 74 65 - recapture ite
0510: 6d 20 76 61 72 69 61 62 6c 65 73 2c 20 64 65 62 m variables, deb
0520: 75 67 20 72 65 70 65 61 74 65 64 20 73 74 65 70 ug repeated step
0530: 20 65 76 61 6c 3b 20 72 65 67 65 6e 20 6c 6f 67 eval; regen log
0540: 70 72 6f 20 66 72 6f 6d 20 74 65 73 74 0a 20 20 pro from test.
0550: 28 6c 65 74 2a 20 28 28 64 6f 2d 75 70 64 61 74 (let* ((do-updat
0560: 65 2d 74 65 73 74 2d 73 74 61 74 65 2d 73 74 61 e-test-state-sta
0570: 74 75 73 20 23 66 29 0a 20 20 20 20 20 20 20 20 tus #f).
0580: 20 28 74 65 73 74 2d 72 75 6e 2d 64 69 72 20 20 (test-run-dir
0590: 3b 3b 20 28 66 69 6c 65 64 62 3a 67 65 74 2d 70 ;; (filedb:get-p
05a0: 61 74 68 20 2a 66 64 62 2a 20 0a 09 20 20 28 64 ath *fdb* .. (d
05b0: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 64 69 b:test-get-rundi
05c0: 72 20 74 65 73 74 64 61 74 29 29 20 3b 3b 20 29 r testdat)) ;; )
05d0: 0a 09 20 28 74 65 73 74 63 6f 6e 66 69 67 20 20 .. (testconfig
05e0: 20 20 28 72 65 61 64 2d 63 6f 6e 66 69 67 20 28 (read-config (
05f0: 63 6f 6e 63 20 74 65 73 74 2d 72 75 6e 2d 64 69 conc test-run-di
0600: 72 20 22 2f 74 65 73 74 63 6f 6e 66 69 67 22 29 r "/testconfig")
0610: 20 23 66 20 23 74 20 65 6e 76 69 72 6f 6e 2d 70 #f #t environ-p
0620: 61 74 74 3a 20 22 70 72 65 2d 6c 61 75 6e 63 68 att: "pre-launch
0630: 2d 65 6e 76 2d 76 61 72 73 22 29 29 0a 09 20 28 -env-vars")).. (
0640: 65 7a 73 74 65 70 73 6c 73 74 20 20 20 20 28 68 ezstepslst (h
0650: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
0660: 66 61 75 6c 74 20 74 65 73 74 63 6f 6e 66 69 67 fault testconfig
0670: 20 22 65 7a 73 74 65 70 73 22 20 27 28 29 29 29 "ezsteps" '()))
0680: 0a 09 20 28 72 75 6e 2d 6d 75 74 65 78 20 20 20 .. (run-mutex
0690: 20 20 28 6d 61 6b 65 2d 6d 75 74 65 78 29 29 0a (make-mutex)).
06a0: 09 20 28 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 . (rollup-status
06b0: 20 30 29 0a 20 20 20 20 20 20 20 20 20 28 72 6f 0). (ro
06c0: 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 74 72 69 llup-status-stri
06d0: 6e 67 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 ng #f).
06e0: 28 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 (rollup-status-s
06f0: 79 6d 20 23 66 29 0a 09 20 28 65 78 69 74 2d 69 ym #f).. (exit-i
0700: 6e 66 6f 20 20 20 20 20 28 76 65 63 74 6f 72 20 nfo (vector
0710: 23 74 20 23 74 20 23 74 29 29 0a 09 20 28 74 65 #t #t #t)).. (te
0720: 73 74 2d 69 64 20 20 20 20 20 20 20 28 64 62 3a st-id (db:
0730: 74 65 73 74 2d 67 65 74 2d 69 64 20 20 20 20 20 test-get-id
0740: 20 20 20 74 65 73 74 64 61 74 29 29 0a 09 20 28 testdat)).. (
0750: 72 75 6e 2d 69 64 20 20 20 20 20 20 20 20 28 64 run-id (d
0760: 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 69 b:test-get-run_i
0770: 64 20 20 20 20 74 65 73 74 64 61 74 29 29 0a 09 d testdat))..
0780: 20 28 74 65 73 74 2d 6e 61 6d 65 20 20 20 20 20 (test-name
0790: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 (db:test-get-tes
07a0: 74 6e 61 6d 65 20 20 74 65 73 74 64 61 74 29 29 tname testdat))
07b0: 0a 20 20 20 20 20 20 20 20 20 28 6f 72 69 67 2d . (orig-
07c0: 74 65 73 74 2d 73 74 61 74 65 20 28 64 62 3a 74 test-state (db:t
07d0: 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 est-get-state
07e0: 74 65 73 74 64 61 74 29 29 0a 20 20 20 20 20 20 testdat)).
07f0: 20 20 20 28 6f 72 69 67 2d 74 65 73 74 2d 73 74 (orig-test-st
0800: 61 74 75 73 20 28 64 62 3a 74 65 73 74 2d 67 65 atus (db:test-ge
0810: 74 2d 73 74 61 74 75 73 20 74 65 73 74 64 61 74 t-status testdat
0820: 29 29 0a 09 20 28 6b 69 6c 6c 2d 6a 6f 62 20 20 )).. (kill-job
0830: 20 20 20 20 23 66 29 29 20 3b 3b 20 66 6f 72 20 #f)) ;; for
0840: 66 75 74 75 72 65 20 75 73 65 20 28 6f 6e 20 72 future use (on r
0850: 65 2d 66 61 63 74 6f 72 69 6e 67 20 77 69 74 68 e-factoring with
0860: 20 6c 61 75 6e 63 68 2e 73 63 6d 20 63 6f 64 65 launch.scm code
0870: 0a 0a 20 20 20 20 3b 3b 20 6b 65 65 70 20 74 72 .. ;; keep tr
0880: 79 69 6e 67 20 74 69 6c 6c 20 4e 46 53 20 64 65 ying till NFS de
0890: 69 67 6e 73 20 74 6f 20 70 6f 70 75 6c 61 74 65 igns to populate
08a0: 20 74 65 73 74 20 72 75 6e 20 64 69 72 20 6f 6e test run dir on
08b0: 20 74 68 69 73 20 68 6f 73 74 0a 20 20 20 20 28 this host. (
08c0: 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 6e 74 let loop ((count
08d0: 20 35 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 5)). (if (
08e0: 6e 6f 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 not (common:file
08f0: 2d 65 78 69 73 74 73 3f 20 74 65 73 74 2d 72 75 -exists? test-ru
0900: 6e 2d 64 69 72 29 29 0a 09 20 20 3b 3b 28 70 75 n-dir)).. ;;(pu
0910: 73 68 2d 64 69 72 65 63 74 6f 72 79 20 74 65 73 sh-directory tes
0920: 74 2d 72 75 6e 2d 64 69 72 29 0a 09 20 20 28 69 t-run-dir).. (i
0930: 66 20 28 3e 20 63 6f 75 6e 74 20 30 29 0a 09 20 f (> count 0)..
0940: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 28 64 (begin...(d
0950: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
0960: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
0970: 22 57 41 52 4e 49 4e 47 3a 20 65 7a 73 74 65 70 "WARNING: ezstep
0980: 73 20 61 74 74 65 6d 70 74 69 6e 67 20 74 6f 20 s attempting to
0990: 72 75 6e 20 62 75 74 20 74 65 73 74 20 72 75 6e run but test run
09a0: 20 64 69 72 65 63 74 6f 72 79 20 22 20 74 65 73 directory " tes
09b0: 74 2d 72 75 6e 2d 64 69 72 20 22 20 69 73 20 6e t-run-dir " is n
09c0: 6f 74 20 74 68 65 72 65 2e 20 57 61 69 74 69 6e ot there. Waitin
09d0: 67 20 61 6e 64 20 74 72 79 69 6e 67 20 61 67 61 g and trying aga
09e0: 69 6e 20 22 20 63 6f 75 6e 74 20 22 20 6d 6f 72 in " count " mor
09f0: 65 20 74 69 6d 65 73 22 29 0a 09 09 28 73 6c 65 e times")...(sle
0a00: 65 70 20 33 29 0a 09 09 28 6c 6f 6f 70 20 28 2d ep 3)...(loop (-
0a10: 20 63 6f 75 6e 74 20 31 29 29 29 29 29 29 0a 20 count 1)))))).
0a20: 20 20 20 0a 20 20 20 20 28 64 65 62 75 67 3a 70 . (debug:p
0a30: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
0a40: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
0a50: 52 75 6e 6e 69 6e 67 20 69 6e 20 64 69 72 65 63 Running in direc
0a60: 74 6f 72 79 20 22 20 74 65 73 74 2d 72 75 6e 2d tory " test-run-
0a70: 64 69 72 29 0a 20 20 20 20 28 69 66 20 28 6e 6f dir). (if (no
0a80: 74 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 t (common:file-e
0a90: 78 69 73 74 73 3f 20 22 2e 65 7a 73 74 65 70 73 xists? ".ezsteps
0aa0: 22 29 29 28 63 72 65 61 74 65 2d 64 69 72 65 63 "))(create-direc
0ab0: 74 6f 72 79 20 22 2e 65 7a 73 74 65 70 73 22 29 tory ".ezsteps")
0ac0: 29 0a 20 20 20 20 3b 3b 20 69 66 20 65 7a 73 74 ). ;; if ezst
0ad0: 65 70 73 20 77 61 73 20 64 65 66 69 6e 65 64 20 eps was defined
0ae0: 74 68 65 6e 20 77 65 20 61 72 65 20 73 75 72 65 then we are sure
0af0: 20 74 6f 20 68 61 76 65 20 61 74 20 6c 65 61 73 to have at leas
0b00: 74 20 6f 6e 65 20 73 74 65 70 20 62 75 74 20 63 t one step but c
0b10: 68 65 63 6b 20 61 6e 79 77 61 79 0a 20 20 20 20 heck anyway.
0b20: 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 3e . (if (not (>
0b30: 20 28 6c 65 6e 67 74 68 20 65 7a 73 74 65 70 73 (length ezsteps
0b40: 6c 73 74 29 20 30 29 29 0a 09 28 6d 65 73 73 61 lst) 0))..(messa
0b50: 67 65 2d 77 69 6e 64 6f 77 20 22 45 52 52 4f 52 ge-window "ERROR
0b60: 3a 20 59 6f 75 20 63 61 6e 20 6f 6e 6c 79 20 72 : You can only r
0b70: 65 2d 72 75 6e 20 73 74 65 70 73 20 64 65 66 69 e-run steps defi
0b80: 6e 65 64 20 76 69 61 20 65 7a 73 74 65 70 73 22 ned via ezsteps"
0b90: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 65 )..(begin.. (le
0ba0: 74 20 6c 6f 6f 70 20 28 28 65 7a 73 74 65 70 20 t loop ((ezstep
0bb0: 20 20 28 63 61 72 20 65 7a 73 74 65 70 73 6c 73 (car ezstepsls
0bc0: 74 29 29 0a 09 09 20 20 20 20 20 28 74 61 6c 20 t))... (tal
0bd0: 20 20 20 20 20 28 63 64 72 20 65 7a 73 74 65 70 (cdr ezstep
0be0: 73 6c 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 slst)).
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
0c00: 74 75 73 2d 73 79 6d 2d 73 6f 2d 66 61 72 20 27 tus-sym-so-far '
0c10: 70 61 73 73 29 0a 09 09 20 20 20 20 20 3b 3b 28 pass)... ;;(
0c20: 72 75 6e 66 6c 61 67 20 20 23 66 29 0a 20 20 20 runflag #f).
0c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c40: 20 20 28 73 61 77 2d 73 74 61 72 74 2d 73 74 65 (saw-start-ste
0c50: 70 2d 6e 61 6d 65 20 23 66 29 29 20 3b 3b 20 66 p-name #f)) ;; f
0c60: 6c 61 67 20 75 73 65 64 20 74 6f 20 73 6b 69 70 lag used to skip
0c70: 20 73 74 65 70 73 20 77 68 65 6e 20 6e 6f 74 20 steps when not
0c80: 73 74 61 72 74 69 6e 67 20 61 74 20 74 68 65 20 starting at the
0c90: 62 65 67 69 6e 6e 69 6e 67 0a 09 20 20 20 20 28 beginning.. (
0ca0: 69 66 20 28 76 65 63 74 6f 72 2d 72 65 66 20 65 if (vector-ref e
0cb0: 78 69 74 2d 69 6e 66 6f 20 31 29 0a 09 09 28 6c xit-info 1)...(l
0cc0: 65 74 2a 20 28 28 73 74 65 70 6e 61 6d 65 20 20 et* ((stepname
0cd0: 20 20 28 63 61 72 20 65 7a 73 74 65 70 29 29 20 (car ezstep))
0ce0: 20 3b 3b 20 64 6f 20 73 74 75 66 66 20 74 6f 20 ;; do stuff to
0cf0: 72 75 6e 20 74 68 65 20 73 74 65 70 0a 20 20 20 run the step.
0d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d10: 20 20 20 20 28 6c 6f 67 70 72 6f 2d 75 73 65 64 (logpro-used
0d20: 20 28 63 6f 6d 6d 6f 6e 3a 66 69 6c 65 2d 65 78 (common:file-ex
0d30: 69 73 74 73 3f 20 28 63 6f 6e 63 20 74 65 73 74 ists? (conc test
0d40: 2d 72 75 6e 2d 64 69 72 20 22 2f 22 20 73 74 65 -run-dir "/" ste
0d50: 70 6e 61 6d 65 20 22 2e 6c 6f 67 70 72 6f 22 29 pname ".logpro")
0d60: 29 29 0a 09 09 20 20 20 20 20 20 20 28 73 74 65 ))... (ste
0d70: 70 69 6e 66 6f 20 20 20 20 28 63 61 64 72 20 65 pinfo (cadr e
0d80: 7a 73 74 65 70 29 29 0a 09 09 20 20 20 20 20 20 zstep))...
0d90: 20 28 73 74 65 70 70 61 72 74 73 20 20 20 28 73 (stepparts (s
0da0: 74 72 69 6e 67 2d 6d 61 74 63 68 20 28 72 65 67 tring-match (reg
0db0: 65 78 70 20 22 5e 28 5c 5c 7b 28 5b 5e 5c 5c 7d exp "^(\\{([^\\}
0dc0: 5d 2a 29 5c 5c 7d 5c 5c 73 2a 7c 29 28 2e 2a 29 ]*)\\}\\s*|)(.*)
0dd0: 24 22 29 20 73 74 65 70 69 6e 66 6f 29 29 0a 09 $") stepinfo))..
0de0: 09 20 20 20 20 20 20 20 28 73 74 65 70 70 61 72 . (steppar
0df0: 6d 73 20 20 20 28 6c 69 73 74 2d 72 65 66 20 73 ms (list-ref s
0e00: 74 65 70 70 61 72 74 73 20 32 29 29 20 3b 3b 20 tepparts 2)) ;;
0e10: 66 6f 72 20 66 75 74 75 72 65 20 75 73 65 2c 20 for future use,
0e20: 7b 56 41 52 3d 31 2c 32 2c 33 7d 2c 20 72 75 6e {VAR=1,2,3}, run
0e30: 20 73 74 65 70 20 66 6f 72 20 65 61 63 68 20 0a step for each .
0e40: 09 09 20 20 20 20 20 20 20 28 73 74 65 70 63 6d .. (stepcm
0e50: 64 20 20 20 20 20 28 6c 69 73 74 2d 72 65 66 20 d (list-ref
0e60: 73 74 65 70 70 61 72 74 73 20 33 29 29 0a 09 09 stepparts 3))...
0e70: 20 20 20 20 20 20 20 28 73 63 72 69 70 74 20 20 (script
0e80: 20 20 20 20 28 63 6f 6e 63 20 22 6d 74 5f 65 7a (conc "mt_ez
0e90: 73 74 65 70 20 27 22 74 65 73 74 2d 72 75 6e 2d step '"test-run-
0ea0: 64 69 72 22 27 20 27 22 73 74 65 70 6e 61 6d 65 dir"' '"stepname
0eb0: 22 27 20 27 22 73 74 65 70 63 6d 64 22 27 22 29 "' '"stepcmd"'")
0ec0: 29 20 3b 3b 20 63 61 6c 6c 20 74 68 65 20 63 6f ) ;; call the co
0ed0: 6d 6d 61 6e 64 20 75 73 69 6e 67 20 6d 74 5f 65 mmand using mt_e
0ee0: 7a 73 74 65 70 0a 20 20 20 20 20 20 20 20 20 20 zstep.
0ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 61 (sa
0f00: 77 2d 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d w-start-step-nam
0f10: 65 2d 6e 65 78 74 20 28 6f 72 20 73 61 77 2d 73 e-next (or saw-s
0f20: 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d 65 20 28 tart-step-name (
0f30: 65 71 75 61 6c 3f 20 73 74 65 70 6e 61 6d 65 20 equal? stepname
0f40: 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d 65 29 start-step-name)
0f50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
0f60: 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 65 (proce
0f70: 65 64 2d 77 69 74 68 2d 74 68 69 73 2d 73 74 65 ed-with-this-ste
0f80: 70 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 p.
0f90: 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 6e (or (n
0fa0: 6f 74 20 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 ot start-step-na
0fb0: 6d 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 me).
0fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fd0: 28 65 71 75 61 6c 3f 20 73 74 65 70 6e 61 6d 65 (equal? stepname
0fe0: 20 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d 65 start-step-name
0ff0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
1010: 6e 64 20 73 61 77 2d 73 74 61 72 74 2d 73 74 65 nd saw-start-ste
1020: 70 2d 6e 61 6d 65 20 28 6e 6f 74 20 72 75 6e 2d p-name (not run-
1030: 6f 6e 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 one)).
1040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1050: 20 20 73 61 77 2d 73 74 61 72 74 2d 73 74 65 70 saw-start-step
1060: 2d 6e 61 6d 65 2d 6e 65 78 74 0a 20 20 20 20 20 -name-next.
1070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1080: 20 20 20 20 20 20 20 28 61 6e 64 20 73 74 61 72 (and star
1090: 74 2d 73 74 65 70 2d 6e 61 6d 65 20 28 65 71 75 t-step-name (equ
10a0: 61 6c 3f 20 73 74 65 70 6e 61 6d 65 20 73 74 61 al? stepname sta
10b0: 72 74 2d 73 74 65 70 2d 6e 61 6d 65 29 29 29 29 rt-step-name))))
10c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
10d0: 20 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 ).
10e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
10f0: 21 20 64 6f 2d 75 70 64 61 74 65 2d 74 65 73 74 ! do-update-test
1100: 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 28 61 -state-status (a
1110: 6e 64 20 70 72 6f 63 65 65 64 2d 77 69 74 68 2d nd proceed-with-
1120: 74 68 69 73 2d 73 74 65 70 20 28 6e 75 6c 6c 3f this-step (null?
1130: 20 74 61 6c 29 29 29 0a 20 20 20 20 20 20 20 20 tal))).
1140: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 42 42 3e ;;(BB>
1150: 20 22 73 74 65 70 6e 61 6d 65 3d 22 73 74 65 70 "stepname="step
1160: 6e 61 6d 65 22 20 70 72 6f 63 65 65 64 2d 77 69 name" proceed-wi
1170: 74 68 2d 74 68 69 73 2d 73 74 65 70 3d 22 70 72 th-this-step="pr
1180: 6f 63 65 65 64 2d 77 69 74 68 2d 74 68 69 73 2d oceed-with-this-
1190: 73 74 65 70 20 22 20 64 6f 2d 75 70 64 61 74 65 step " do-update
11a0: 2d 74 65 73 74 2d 73 74 61 74 65 2d 73 74 61 74 -test-state-stat
11b0: 75 73 3d 22 64 6f 2d 75 70 64 61 74 65 2d 74 65 us="do-update-te
11c0: 73 74 2d 73 74 61 74 65 2d 73 74 61 74 75 73 20 st-state-status
11d0: 22 20 6f 72 69 67 2d 74 65 73 74 2d 73 74 61 74 " orig-test-stat
11e0: 65 3d 22 6f 72 69 67 2d 74 65 73 74 2d 73 74 61 e="orig-test-sta
11f0: 74 65 22 20 6f 72 69 67 2d 74 65 73 74 2d 73 74 te" orig-test-st
1200: 61 74 75 73 3d 22 6f 72 69 67 2d 74 65 73 74 2d atus="orig-test-
1210: 73 74 61 74 75 73 29 0a 20 20 20 20 20 20 20 20 status).
1220: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
1230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1240: 20 20 20 28 28 61 6e 64 20 28 6e 6f 74 20 70 72 ((and (not pr
1250: 6f 63 65 65 64 2d 77 69 74 68 2d 74 68 69 73 2d oceed-with-this-
1260: 73 74 65 70 29 20 28 6e 75 6c 6c 3f 20 74 61 6c step) (null? tal
1270: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1280: 20 20 20 20 20 20 20 27 64 6f 6e 65 29 0a 20 20 'done).
1290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12a0: 20 28 28 6e 6f 74 20 70 72 6f 63 65 65 64 2d 77 ((not proceed-w
12b0: 69 74 68 2d 74 68 69 73 2d 73 74 65 70 29 0a 20 ith-this-step).
12c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d0: 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 (loop (car
12e0: 74 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 tal).
12f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1300: 20 28 63 64 72 20 74 61 6c 29 0a 20 20 20 20 20 (cdr tal).
1310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1320: 20 20 20 20 20 20 20 73 74 61 74 75 73 2d 73 79 status-sy
1330: 6d 2d 73 6f 2d 66 61 72 0a 20 20 20 20 20 20 20 m-so-far.
1340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1350: 20 20 20 20 20 73 61 77 2d 73 74 61 72 74 2d 73 saw-start-s
1360: 74 65 70 2d 6e 61 6d 65 2d 6e 65 78 74 29 29 0a tep-name-next)).
1370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1380: 20 20 20 28 65 6c 73 65 0a 09 09 20 20 20 20 28 (else... (
1390: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
13a0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
13b0: 20 22 65 7a 73 74 65 70 73 3a 5c 6e 20 73 74 65 "ezsteps:\n ste
13c0: 70 6e 61 6d 65 3a 20 22 20 73 74 65 70 6e 61 6d pname: " stepnam
13d0: 65 20 22 20 73 74 65 70 69 6e 66 6f 3a 20 22 20 e " stepinfo: "
13e0: 73 74 65 70 69 6e 66 6f 20 22 20 73 74 65 70 70 stepinfo " stepp
13f0: 61 72 74 73 3a 20 22 20 73 74 65 70 70 61 72 74 arts: " steppart
1400: 73 0a 09 09 09 20 20 20 20 20 20 20 20 20 22 20 s.... "
1410: 73 74 65 70 70 61 72 6d 73 3a 20 22 20 73 74 65 stepparms: " ste
1420: 70 70 61 72 6d 73 20 22 20 73 74 65 70 63 6d 64 pparms " stepcmd
1430: 3a 20 22 20 73 74 65 70 63 6d 64 29 0a 09 09 20 : " stepcmd)...
1440: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
1450: 34 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 4 *default-log-p
1460: 6f 72 74 2a 20 22 73 63 72 69 70 74 3a 20 22 20 ort* "script: "
1470: 73 63 72 69 70 74 29 0a 09 09 20 20 20 20 28 72 script)... (r
1480: 6d 74 3a 74 65 73 74 73 74 65 70 2d 73 65 74 2d mt:teststep-set-
1490: 73 74 61 74 75 73 21 20 72 75 6e 2d 69 64 20 74 status! run-id t
14a0: 65 73 74 2d 69 64 20 73 74 65 70 6e 61 6d 65 20 est-id stepname
14b0: 22 73 74 61 72 74 22 20 22 2d 22 20 23 66 20 23 "start" "-" #f #
14c0: 66 29 0a 0a 09 09 20 20 20 20 3b 3b 20 6e 6f 77 f).... ;; now
14d0: 20 6c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 launch the scri
14e0: 70 74 0a 09 09 20 20 20 20 28 6c 65 74 20 28 28 pt... (let ((
14f0: 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e pid (process-run
1500: 20 73 63 72 69 70 74 29 29 29 0a 09 09 20 20 20 script)))...
1510: 20 20 20 28 6c 65 74 20 70 72 6f 63 65 73 73 6c (let processl
1520: 6f 6f 70 20 28 28 69 20 30 29 29 0a 09 09 20 20 oop ((i 0))...
1530: 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c 75 65 (let-value
1540: 73 20 28 28 28 70 69 64 2d 76 61 6c 20 65 78 69 s (((pid-val exi
1550: 74 2d 73 74 61 74 75 73 20 65 78 69 74 2d 63 6f t-status exit-co
1560: 64 65 29 28 70 72 6f 63 65 73 73 2d 77 61 69 74 de)(process-wait
1570: 20 70 69 64 20 23 74 29 29 29 0a 09 09 09 20 20 pid #t)))....
1580: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 72 75 6e (mutex-lock! run
1590: 2d 6d 75 74 65 78 29 0a 09 09 09 20 20 28 76 65 -mutex).... (ve
15a0: 63 74 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 ctor-set! exit-i
15b0: 6e 66 6f 20 30 20 70 69 64 29 0a 09 09 09 20 20 nfo 0 pid)....
15c0: 28 76 65 63 74 6f 72 2d 73 65 74 21 20 65 78 69 (vector-set! exi
15d0: 74 2d 69 6e 66 6f 20 31 20 65 78 69 74 2d 73 74 t-info 1 exit-st
15e0: 61 74 75 73 29 0a 09 09 09 20 20 28 76 65 63 74 atus).... (vect
15f0: 6f 72 2d 73 65 74 21 20 65 78 69 74 2d 69 6e 66 or-set! exit-inf
1600: 6f 20 32 20 65 78 69 74 2d 63 6f 64 65 29 0a 09 o 2 exit-code)..
1610: 09 09 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 .. (mutex-unloc
1620: 6b 21 20 72 75 6e 2d 6d 75 74 65 78 29 0a 09 09 k! run-mutex)...
1630: 09 20 20 28 69 66 20 28 65 71 3f 20 70 69 64 2d . (if (eq? pid-
1640: 76 61 6c 20 30 29 0a 09 09 09 20 20 20 20 20 20 val 0)....
1650: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 (begin....
1660: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
1670: 20 31 29 0a 09 09 09 20 20 20 20 20 20 20 20 28 1).... (
1680: 70 72 6f 63 65 73 73 6c 6f 6f 70 20 28 2b 20 69 processloop (+ i
1690: 20 31 29 29 29 29 0a 09 09 09 20 20 29 29 0a 09 1)))).... ))..
16a0: 09 20 20 20 20 20 20 28 6c 65 74 20 28 28 65 78 . (let ((ex
16b0: 69 6e 66 6f 20 28 76 65 63 74 6f 72 2d 72 65 66 info (vector-ref
16c0: 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 0a 09 exit-info 2))..
16d0: 09 09 20 20 20 20 28 6c 6f 67 66 6e 61 20 28 69 .. (logfna (i
16e0: 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 28 63 f logpro-used (c
16f0: 6f 6e 63 20 73 74 65 70 6e 61 6d 65 20 22 2e 68 onc stepname ".h
1700: 74 6d 6c 22 29 20 22 22 29 29 29 0a 09 09 20 20 tml") "")))...
1710: 20 20 20 20 20 20 28 72 6d 74 3a 74 65 73 74 73 (rmt:tests
1720: 74 65 70 2d 73 65 74 2d 73 74 61 74 75 73 21 20 tep-set-status!
1730: 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 73 run-id test-id s
1740: 74 65 70 6e 61 6d 65 20 22 65 6e 64 22 20 65 78 tepname "end" ex
1750: 69 6e 66 6f 20 23 66 20 6c 6f 67 66 6e 61 29 29 info #f logfna))
1760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1770: 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 20 20 ...
1780: 28 69 66 20 6c 6f 67 70 72 6f 2d 75 73 65 64 0a (if logpro-used.
1790: 09 09 09 20 20 28 72 6d 74 3a 74 65 73 74 2d 73 ... (rmt:test-s
17a0: 65 74 2d 6c 6f 67 21 20 72 75 6e 2d 69 64 20 74 et-log! run-id t
17b0: 65 73 74 2d 69 64 20 28 63 6f 6e 63 20 73 74 65 est-id (conc ste
17c0: 70 6e 61 6d 65 20 22 2e 68 74 6d 6c 22 29 29 29 pname ".html")))
17d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17e0: 20 20 20 20 20 20 20 0a 09 09 20 20 20 20 20 20 ...
17f0: 3b 3b 20 73 65 74 20 74 68 65 20 74 65 73 74 20 ;; set the test
1800: 66 69 6e 61 6c 20 73 74 61 74 75 73 0a 09 09 20 final status...
1810: 20 20 20 20 20 28 6c 65 74 2a 20 28 28 74 68 69 (let* ((thi
1820: 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 20 20 s-step-status
1830: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
1840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1870: 6f 67 70 72 6f 2d 75 73 65 64 0a 20 20 20 20 20 ogpro-used.
1880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b0: 20 28 63 6f 6d 6d 6f 6e 3a 6c 6f 67 70 72 6f 2d (common:logpro-
18c0: 65 78 69 74 2d 63 6f 64 65 2d 3e 73 74 61 74 75 exit-code->statu
18d0: 73 2d 73 79 6d 20 28 76 65 63 74 6f 72 2d 72 65 s-sym (vector-re
18e0: 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 29 29 f exit-info 2)))
18f0: 0a 09 09 09 09 09 20 20 20 20 20 20 20 20 20 20 ......
1900: 20 20 20 28 28 65 71 3f 20 28 76 65 63 74 6f 72 ((eq? (vector
1910: 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 -ref exit-info 2
1920: 29 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 0).
1930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1950: 20 20 20 20 20 20 20 20 20 20 20 27 70 61 73 73 'pass
1960: 29 0a 09 09 09 09 09 20 20 20 20 20 20 20 20 20 )......
1970: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
1980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b0: 27 66 61 69 6c 29 29 29 0a 09 09 09 20 20 20 20 'fail)))....
19c0: 20 28 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 (overall-status
19d0: 2d 73 79 6d 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a -sym (common:
19e0: 77 6f 72 73 65 2d 73 74 61 74 75 73 2d 73 79 6d worse-status-sym
19f0: 20 74 68 69 73 2d 73 74 65 70 2d 73 74 61 74 75 this-step-statu
1a00: 73 20 73 74 61 74 75 73 2d 73 79 6d 2d 73 6f 2d s status-sym-so-
1a10: 66 61 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 far)).
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a30: 20 20 20 28 6f 76 65 72 61 6c 6c 2d 73 74 61 74 (overall-stat
1a40: 75 73 2d 73 74 72 69 6e 67 20 28 73 74 61 74 75 us-string (statu
1a50: 73 2d 73 79 6d 2d 3e 73 74 72 69 6e 67 20 6f 76 s-sym->string ov
1a60: 65 72 61 6c 6c 2d 73 74 61 74 75 73 2d 73 79 6d erall-status-sym
1a70: 29 29 29 0a 09 09 20 20 20 20 20 20 20 20 28 64 )))... (d
1a80: 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 65 ebug:print 4 *de
1a90: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
1aa0: 22 45 78 69 74 20 76 61 6c 75 65 20 72 65 63 65 "Exit value rece
1ab0: 69 76 65 64 3a 20 22 20 28 76 65 63 74 6f 72 2d ived: " (vector-
1ac0: 72 65 66 20 65 78 69 74 2d 69 6e 66 6f 20 32 29 ref exit-info 2)
1ad0: 20 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 3a 20 " logpro-used:
1ae0: 22 20 6c 6f 67 70 72 6f 2d 75 73 65 64 20 0a 09 " logpro-used ..
1af0: 09 09 09 20 20 20 20 20 22 20 74 68 69 73 2d 73 ... " this-s
1b00: 74 65 70 2d 73 74 61 74 75 73 3a 20 22 20 74 68 tep-status: " th
1b10: 69 73 2d 73 74 65 70 2d 73 74 61 74 75 73 20 22 is-step-status "
1b20: 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 73 3a overall-status:
1b30: 20 22 20 6f 76 65 72 61 6c 6c 2d 73 74 61 74 75 " overall-statu
1b40: 73 2d 73 79 6d 29 20 0a 09 09 20 20 20 20 20 20 s-sym) ...
1b50: 20 20 3b 3b 22 20 6e 65 78 74 2d 73 74 61 74 75 ;;" next-statu
1b60: 73 3a 20 22 20 6e 65 78 74 2d 73 74 61 74 75 73 s: " next-status
1b70: 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 " rollup-status
1b80: 3a 20 22 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 : " rollup-statu
1b90: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
1ba0: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
1bb0: 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 rollup-status-s
1bc0: 74 72 69 6e 67 20 6f 76 65 72 61 6c 6c 2d 73 74 tring overall-st
1bd0: 61 74 75 73 2d 73 74 72 69 6e 67 29 0a 20 20 20 atus-string).
1be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf0: 20 20 20 20 20 28 73 65 74 21 20 72 6f 6c 6c 75 (set! rollu
1c00: 70 2d 73 74 61 74 75 73 2d 73 79 6d 20 6f 76 65 p-status-sym ove
1c10: 72 61 6c 6c 2d 73 74 61 74 75 73 2d 73 79 6d 29 rall-status-sym)
1c20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c30: 20 20 20 20 20 20 20 20 20 28 74 65 73 74 73 3a (tests:
1c40: 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 21 test-set-status!
1c50: 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 20 run-id test-id
1c60: 22 52 55 4e 4e 49 4e 47 22 20 6f 76 65 72 61 6c "RUNNING" overal
1c70: 6c 2d 73 74 61 74 75 73 2d 73 74 72 69 6e 67 20 l-status-string
1c80: 23 66 20 23 66 29 29 29 0a 0a 20 20 20 20 20 20 #f #f)))..
1c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1ca0: 66 20 28 61 6e 64 0a 20 20 20 20 20 20 20 20 20 f (and.
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cc0: 28 6e 6f 74 20 72 75 6e 2d 6f 6e 65 29 0a 20 20 (not run-one).
1cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ce0: 20 20 20 20 20 20 20 28 63 6f 6d 6d 6f 6e 3a 73 (common:s
1cf0: 74 65 70 73 2d 63 61 6e 2d 70 72 6f 63 65 65 64 teps-can-proceed
1d00: 2d 67 69 76 65 6e 2d 73 74 61 74 75 73 2d 73 79 -given-status-sy
1d10: 6d 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d m rollup-status-
1d20: 73 79 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 sym).
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
1d40: 6f 74 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 29 29 ot (null? tal)))
1d50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d60: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
1d70: 63 61 72 20 74 61 6c 29 0a 20 20 20 20 20 20 20 car tal).
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 28 63 64 72 20 74 61 6c 29 (cdr tal)
1da0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1dc0: 6f 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 79 6d ollup-status-sym
1dd0: 0a 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 73 s
1df0: 61 77 2d 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 aw-start-step-na
1e00: 6d 65 2d 6e 65 78 74 29 29 29 29 29 0a 09 09 28 me-next)))))...(
1e10: 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a 64 debug:print 4 *d
1e20: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
1e30: 20 22 57 41 52 4e 49 4e 47 3a 20 61 20 70 72 69 "WARNING: a pri
1e40: 6f 72 20 73 74 65 70 20 66 61 69 6c 65 64 2c 20 or step failed,
1e50: 73 74 6f 70 70 69 6e 67 20 61 74 20 22 20 65 7a stopping at " ez
1e60: 73 74 65 70 29 29 29 0a 09 20 20 0a 09 20 20 3b step))).. .. ;
1e70: 3b 20 4f 6e 63 65 20 64 6f 6e 65 20 77 69 74 68 ; Once done with
1e80: 20 73 74 65 70 2f 73 74 65 70 73 20 75 70 64 61 step/steps upda
1e90: 74 65 20 74 68 65 20 74 65 73 74 20 72 65 63 6f te the test reco
1ea0: 72 64 0a 09 20 20 3b 3b 0a 09 20 20 28 6c 65 74 rd.. ;;.. (let
1eb0: 2a 20 28 28 69 74 65 6d 2d 70 61 74 68 20 28 64 * ((item-path (d
1ec0: 62 3a 74 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d b:test-get-item-
1ed0: 70 61 74 68 20 74 65 73 74 64 61 74 29 29 20 3b path testdat)) ;
1ee0: 3b 20 28 69 74 65 6d 2d 6c 69 73 74 2d 3e 70 61 ; (item-list->pa
1ef0: 74 68 20 69 74 65 6d 64 61 74 29 29 0a 09 09 20 th itemdat))...
1f00: 28 74 65 73 74 69 6e 66 6f 20 20 28 72 6d 74 3a (testinfo (rmt:
1f10: 67 65 74 2d 74 65 73 74 69 6e 66 6f 2d 73 74 61 get-testinfo-sta
1f20: 74 65 2d 73 74 61 74 75 73 20 72 75 6e 2d 69 64 te-status run-id
1f30: 20 74 65 73 74 2d 69 64 29 29 29 20 3b 3b 20 72 test-id))) ;; r
1f40: 65 66 72 65 73 68 20 74 68 65 20 74 65 73 74 64 efresh the testd
1f50: 61 74 2c 20 63 61 6c 6c 20 69 74 20 69 74 65 6d at, call it item
1f60: 69 6e 66 6f 20 69 6e 20 63 61 73 65 20 6e 65 65 info in case nee
1f70: 64 20 70 72 65 76 2f 63 75 72 72 0a 09 20 20 20 d prev/curr..
1f80: 20 3b 3b 20 41 6d 20 49 20 63 6f 6d 70 6c 65 74 ;; Am I complet
1f90: 65 64 3f 0a 09 20 20 20 20 28 69 66 20 28 65 71 ed?.. (if (eq
1fa0: 75 61 6c 3f 20 28 64 62 3a 74 65 73 74 2d 67 65 ual? (db:test-ge
1fb0: 74 2d 73 74 61 74 65 20 74 65 73 74 69 6e 66 6f t-state testinfo
1fc0: 29 20 22 52 55 4e 4e 49 4e 47 22 29 20 3b 3b 20 ) "RUNNING") ;;
1fd0: 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 64 62 (not (equal? (db
1fe0: 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 65 20 :test-get-state
1ff0: 74 65 73 74 69 6e 66 6f 29 20 22 43 4f 4d 50 4c testinfo) "COMPL
2000: 45 54 45 44 22 29 29 0a 09 09 28 6c 65 74 20 28 ETED"))...(let (
2010: 28 6e 65 77 2d 73 74 61 74 65 20 20 28 69 66 20 (new-state (if
2020: 6b 69 6c 6c 2d 6a 6f 62 20 22 4b 49 4c 4c 45 44 kill-job "KILLED
2030: 22 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 20 3b " "COMPLETED") ;
2040: 3b 20 28 69 66 20 28 65 71 3f 20 28 76 65 63 74 ; (if (eq? (vect
2050: 6f 72 2d 72 65 66 20 65 78 69 74 2d 69 6e 66 6f or-ref exit-info
2060: 20 32 29 20 30 29 20 3b 3b 20 65 78 69 74 65 64 2) 0) ;; exited
2070: 20 77 69 74 68 20 22 67 6f 6f 64 22 20 73 74 61 with "good" sta
2080: 74 75 73 0a 09 09 09 09 20 20 3b 3b 20 22 43 4f tus..... ;; "CO
2090: 4d 50 4c 45 54 45 44 22 0a 09 09 09 09 20 20 3b MPLETED"..... ;
20a0: 3b 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 ; (db:test-get-s
20b0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 29 29 tate testinfo)))
20c0: 20 20 20 3b 3b 20 65 6c 73 65 20 70 72 65 73 65 ;; else prese
20d0: 76 65 20 74 68 65 20 73 74 61 74 65 20 61 73 20 ve the state as
20e0: 73 65 74 20 77 69 74 68 69 6e 20 74 68 65 20 74 set within the t
20f0: 65 73 74 0a 09 09 09 09 20 20 29 0a 20 20 20 20 est..... ).
2100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2110: 20 20 28 6e 65 77 2d 73 74 61 74 75 73 20 72 6f (new-status ro
2120: 6c 6c 75 70 2d 73 74 61 74 75 73 2d 73 74 72 69 llup-status-stri
2130: 6e 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ng).
2140: 20 20 20 20 20 20 20 20 20 20 29 20 3b 3b 20 28 ) ;; (
2150: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
2160: 75 73 20 74 65 73 74 69 6e 66 6f 29 29 29 0a 09 us testinfo)))..
2170: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
2180: 69 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d info 2 *default-
2190: 6c 6f 67 2d 70 6f 72 74 2a 20 22 54 65 73 74 20 log-port* "Test
21a0: 4e 4f 54 20 6c 6f 67 67 65 64 20 61 73 20 43 4f NOT logged as CO
21b0: 4d 50 4c 45 54 45 44 2c 20 28 73 74 61 74 65 3d MPLETED, (state=
21c0: 22 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 " (db:test-get-s
21d0: 74 61 74 65 20 74 65 73 74 69 6e 66 6f 29 20 22 tate testinfo) "
21e0: 29 2c 20 75 70 64 61 74 69 6e 67 20 72 65 73 75 ), updating resu
21f0: 6c 74 2c 20 72 6f 6c 6c 75 70 2d 73 74 61 74 75 lt, rollup-statu
2200: 73 20 69 73 20 22 20 72 6f 6c 6c 75 70 2d 73 74 s is " rollup-st
2210: 61 74 75 73 29 0a 09 09 20 20 28 74 65 73 74 73 atus)... (tests
2220: 3a 74 65 73 74 2d 73 65 74 2d 73 74 61 74 75 73 :test-set-status
2230: 21 20 72 75 6e 2d 69 64 20 74 65 73 74 2d 69 64 ! run-id test-id
2240: 20 0a 09 09 09 09 09 20 20 28 69 66 20 64 6f 2d ...... (if do-
2250: 75 70 64 61 74 65 2d 74 65 73 74 2d 73 74 61 74 update-test-stat
2260: 65 2d 73 74 61 74 75 73 20 6e 65 77 2d 73 74 61 e-status new-sta
2270: 74 65 20 6f 72 69 67 2d 74 65 73 74 2d 73 74 61 te orig-test-sta
2280: 74 65 29 0a 09 09 09 09 09 20 20 28 69 66 20 64 te)...... (if d
2290: 6f 2d 75 70 64 61 74 65 2d 74 65 73 74 2d 73 74 o-update-test-st
22a0: 61 74 65 2d 73 74 61 74 75 73 20 6e 65 77 2d 73 ate-status new-s
22b0: 74 61 74 75 73 20 6f 72 69 67 2d 74 65 73 74 2d tatus orig-test-
22c0: 73 74 61 74 75 73 29 0a 09 09 09 09 09 20 20 28 status)...... (
22d0: 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 6d args:get-arg "-m
22e0: 22 29 20 23 66 29 0a 09 09 20 20 3b 3b 20 6e 65 ") #f)... ;; ne
22f0: 65 64 20 74 6f 20 75 70 64 61 74 65 20 74 68 65 ed to update the
2300: 20 74 6f 70 20 74 65 73 74 20 72 65 63 6f 72 64 top test record
2310: 20 69 66 20 50 41 53 53 20 6f 72 20 46 41 49 4c if PASS or FAIL
2320: 20 61 6e 64 20 74 68 69 73 20 69 73 20 61 20 73 and this is a s
2330: 75 62 74 65 73 74 0a 09 09 20 20 28 69 66 20 28 ubtest... (if (
2340: 61 6e 64 20 28 6e 6f 74 20 28 65 71 75 61 6c 3f and (not (equal?
2350: 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 20 item-path ""))
2360: 64 6f 2d 75 70 64 61 74 65 2d 74 65 73 74 2d 73 do-update-test-s
2370: 74 61 74 65 2d 73 74 61 74 75 73 29 0a 20 20 20 tate-status).
2380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2390: 20 20 20 28 72 6d 74 3a 73 65 74 2d 73 74 61 74 (rmt:set-stat
23a0: 65 2d 73 74 61 74 75 73 2d 61 6e 64 2d 72 6f 6c e-status-and-rol
23b0: 6c 2d 75 70 2d 69 74 65 6d 73 20 72 75 6e 2d 69 l-up-items run-i
23c0: 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 6d d test-name item
23d0: 2d 70 61 74 68 20 6e 65 77 2d 73 74 61 74 65 20 -path new-state
23e0: 6e 65 77 2d 73 74 61 74 75 73 20 23 66 29 29 29 new-status #f)))
23f0: 29 0a 09 20 20 20 20 3b 3b 20 66 6f 72 20 61 75 ).. ;; for au
2400: 74 6f 6d 61 74 65 64 20 63 72 65 61 74 69 6f 6e tomated creation
2410: 20 6f 66 20 74 68 65 20 72 6f 6c 6c 75 70 20 68 of the rollup h
2420: 74 6d 6c 20 66 69 6c 65 20 74 68 69 73 20 69 73 tml file this is
2430: 20 61 20 67 6f 6f 64 20 70 6c 61 63 65 2e 2e 2e a good place...
2440: 0a 09 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 .. (if (not (
2450: 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 61 74 68 equal? item-path
2460: 20 22 22 29 29 0a 09 20 20 20 20 20 20 28 74 65 "")).. (te
2470: 73 74 73 3a 73 75 6d 6d 61 72 69 7a 65 2d 69 74 sts:summarize-it
2480: 65 6d 73 20 72 75 6e 2d 69 64 20 74 65 73 74 2d ems run-id test-
2490: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 23 66 29 id test-name #f)
24a0: 29 20 3b 3b 20 64 6f 6e 27 74 20 66 6f 72 63 65 ) ;; don't force
24b0: 20 2d 20 6a 75 73 74 20 75 70 64 61 74 65 20 69 - just update i
24c0: 66 20 6e 6f 0a 09 20 20 20 20 29 29 29 0a 20 20 f no.. ))).
24d0: 20 20 3b 3b 28 70 6f 70 2d 64 69 72 65 63 74 6f ;;(pop-directo
24e0: 72 79 29 0a 20 20 20 20 72 6f 6c 6c 75 70 2d 73 ry). rollup-s
24f0: 74 61 74 75 73 2d 73 74 72 69 6e 67 29 29 0a 0a tatus-string))..
2500: 28 64 65 66 69 6e 65 20 28 65 7a 73 74 65 70 73 (define (ezsteps
2510: 3a 73 70 61 77 6e 2d 72 75 6e 2d 66 72 6f 6d 20 :spawn-run-from
2520: 74 65 73 74 64 61 74 20 73 74 61 72 74 2d 73 74 testdat start-st
2530: 65 70 2d 6e 61 6d 65 20 72 75 6e 2d 6f 6e 65 29 ep-name run-one)
2540: 0a 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 74 . (thread-start
2550: 21 20 0a 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 ! . (make-thre
2560: 61 64 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 ad. (lambda (
2570: 29 0a 20 20 20 20 20 20 28 65 7a 73 74 65 70 73 ). (ezsteps
2580: 3a 72 75 6e 2d 66 72 6f 6d 20 74 65 73 74 64 61 :run-from testda
2590: 74 20 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d t start-step-nam
25a0: 65 20 72 75 6e 2d 6f 6e 65 29 29 0a 20 20 20 20 e run-one)).
25b0: 28 63 6f 6e 63 20 22 65 7a 73 74 65 70 20 72 75 (conc "ezstep ru
25c0: 6e 20 73 69 6e 67 6c 65 20 73 74 65 70 20 22 20 n single step "
25d0: 73 74 61 72 74 2d 73 74 65 70 2d 6e 61 6d 65 20 start-step-name
25e0: 22 20 72 75 6e 2d 6f 6e 65 3d 22 72 75 6e 2d 6f " run-one="run-o
25f0: 6e 65 29 29 29 0a 20 20 29 0a 0a ne))). )..