Artifact
c06e686d883f1124fe287f0ff6f83d0df729bab8:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 This file is par
0040: 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a 3b t of Megatest..;
0050: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
0060: 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 st is free softw
0070: 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 are: you can red
0080: 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 istribute it and
0090: 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 20 /or modify.;;
00a0: 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 it under the t
00b0: 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 erms of the GNU
00c0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
00d0: 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 icense as publis
00e0: 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 68 hed by.;; th
00f0: 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 e Free Software
0100: 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 Foundation, eith
0110: 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 er version 3 of
0120: 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a the License, or.
0130: 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 20 ;; (at your
0140: 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 option) any late
0150: 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b r version..;; .;
0160: 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 ; Megatest i
0170: 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e s distributed in
0180: 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 the hope that i
0190: 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c t will be useful
01a0: 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 54 ,.;; but WIT
01b0: 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 HOUT ANY WARRANT
01c0: 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 Y; without even
01d0: 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 the implied warr
01e0: 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 4d anty of.;; M
01f0: 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f ERCHANTABILITY o
0200: 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 r FITNESS FOR A
0210: 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f PARTICULAR PURPO
0220: 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b 20 SE. See the.;;
0230: 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 GNU General
0240: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 Public License f
0250: 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e or more details.
0260: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 20 .;; .;; You
0270: 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 should have rece
0280: 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 ived a copy of t
0290: 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 he GNU General P
02a0: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b 3b ublic License.;;
02b0: 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 20 along with
02c0: 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e 6f Megatest. If no
02d0: 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 t, see <http://w
02e0: 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e ww.gnu.org/licen
02f0: 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ses/>...;;======
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0340: 0a 3b 3b 0a 3b 3b 20 57 72 61 70 70 65 72 20 74 .;;.;; Wrapper t
0350: 6f 20 65 6e 61 62 6c 65 20 72 75 6e 6e 69 6e 67 o enable running
0360: 20 4d 65 67 61 74 65 73 74 20 66 6c 6f 77 73 20 Megatest flows
0370: 75 6e 64 65 72 20 74 65 61 6d 63 69 74 79 0a 3b under teamcity.;
0380: 3b 0a 3b 3b 20 20 31 2e 20 52 75 6e 20 74 68 65 ;.;; 1. Run the
0390: 20 6d 65 67 61 74 65 73 74 20 70 72 6f 63 65 73 megatest proces
03a0: 73 20 61 6e 64 20 70 61 73 73 20 69 74 20 61 6c s and pass it al
03b0: 6c 20 74 68 65 20 6e 65 65 64 65 64 20 70 61 72 l the needed par
03c0: 61 6d 65 74 65 72 73 0a 3b 3b 20 20 32 2e 20 45 ameters.;; 2. E
03d0: 76 65 72 79 20 66 69 76 65 20 73 65 63 6f 6e 64 very five second
03e0: 73 20 63 68 65 63 6b 20 66 6f 72 20 73 74 61 74 s check for stat
03f0: 65 2f 73 74 61 74 75 73 20 63 68 61 6e 67 65 73 e/status changes
0400: 20 61 6e 64 20 70 72 69 6e 74 20 74 68 65 20 69 and print the i
0410: 6e 66 6f 0a 3b 3b 0a 0a 28 75 73 65 20 73 72 66 nfo.;;..(use srf
0420: 69 2d 31 20 70 6f 73 69 78 20 73 72 66 69 2d 36 i-1 posix srfi-6
0430: 39 20 73 72 66 69 2d 31 38 20 72 65 67 65 78 20 9 srfi-18 regex
0440: 64 65 66 73 74 72 75 63 74 29 0a 0a 28 75 73 65 defstruct)..(use
0450: 20 74 72 61 63 65 29 0a 3b 3b 20 28 74 72 61 63 trace).;; (trac
0460: 65 2d 63 61 6c 6c 2d 73 69 74 65 73 20 23 74 29 e-call-sites #t)
0470: 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ..(declare (uses
0480: 20 6d 61 72 67 73 29 29 0a 28 64 65 63 6c 61 72 margs)).(declar
0490: 65 20 28 75 73 65 73 20 72 6d 74 29 29 0a 28 64 e (uses rmt)).(d
04a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 63 6f 6d eclare (uses com
04b0: 6d 6f 6e 29 29 0a 0a 28 69 6e 63 6c 75 64 65 20 mon))..(include
04c0: 22 6d 65 67 61 74 65 73 74 2d 76 65 72 73 69 6f "megatest-versio
04d0: 6e 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 n.scm").(include
04e0: 20 22 6d 65 67 61 74 65 73 74 2d 66 6f 73 73 69 "megatest-fossi
04f0: 6c 2d 68 61 73 68 2e 73 63 6d 22 29 0a 28 69 6e l-hash.scm").(in
0500: 63 6c 75 64 65 20 22 64 62 5f 72 65 63 6f 72 64 clude "db_record
0510: 73 2e 73 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 s.scm")..(define
0520: 20 6f 72 69 67 61 72 67 73 20 28 63 64 72 20 28 origargs (cdr (
0530: 61 72 67 76 29 29 29 0a 28 64 65 66 69 6e 65 20 argv))).(define
0540: 72 65 6d 61 72 67 73 20 28 61 72 67 73 3a 67 65 remargs (args:ge
0550: 74 2d 61 72 67 73 0a 09 09 20 28 61 72 67 76 29 t-args... (argv)
0560: 0a 09 09 20 60 28 20 22 2d 74 61 72 67 65 74 22 ... `( "-target"
0570: 0a 09 09 20 20 20 20 22 2d 72 65 71 74 61 72 67 ... "-reqtarg
0580: 22 0a 09 09 20 20 20 20 22 2d 72 75 6e 6e 61 6d "... "-runnam
0590: 65 22 0a 09 09 20 20 20 20 22 2d 64 65 6c 61 79 e"... "-delay
05a0: 22 20 20 20 3b 3b 20 68 6f 77 20 6c 6f 6e 67 20 " ;; how long
05b0: 74 6f 20 77 61 69 74 20 66 6f 72 20 75 6e 65 78 to wait for unex
05c0: 70 65 63 74 65 64 20 63 68 61 6e 67 65 73 20 74 pected changes t
05d0: 6f 20 0a 09 09 20 20 20 20 29 0a 09 09 20 60 28 o ... )... `(
05e0: 22 2d 74 63 2d 72 65 70 6c 22 0a 09 09 20 20 20 "-tc-repl"...
05f0: 29 0a 09 09 20 61 72 67 73 3a 61 72 67 2d 68 61 )... args:arg-ha
0600: 73 68 0a 09 09 20 30 29 29 0a 0a 28 64 65 66 73 sh... 0))..(defs
0610: 74 72 75 63 74 20 74 65 73 74 64 61 74 0a 20 20 truct testdat.
0620: 28 74 63 2d 74 79 70 65 20 23 66 29 0a 20 20 28 (tc-type #f). (
0630: 73 74 61 74 65 20 20 20 23 66 29 0a 20 20 28 73 state #f). (s
0640: 74 61 74 75 73 20 20 23 66 29 0a 20 20 28 6f 76 tatus #f). (ov
0650: 65 72 61 6c 6c 20 23 66 29 0a 20 20 28 66 6c 6f erall #f). (flo
0660: 77 69 64 20 20 23 66 29 0a 20 20 74 63 74 6e 61 wid #f). tctna
0670: 6d 65 0a 20 20 74 6e 61 6d 65 0a 20 20 28 65 76 me. tname. (ev
0680: 65 6e 74 2d 74 69 6d 65 20 23 66 29 0a 20 20 64 ent-time #f). d
0690: 65 74 61 69 6c 73 0a 20 20 63 6f 6d 6d 65 6e 74 etails. comment
06a0: 0a 20 20 64 75 72 61 74 69 6f 6e 0a 20 20 28 73 . duration. (s
06b0: 74 61 72 74 2d 70 72 69 6e 74 65 64 20 23 66 29 tart-printed #f)
06c0: 0a 20 20 28 65 6e 64 2d 70 72 69 6e 74 65 64 20 . (end-printed
06d0: 20 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d #f))..;;======
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0720: 0a 3b 3b 20 47 4c 4f 42 41 4c 53 0a 3b 3b 3d 3d .;; GLOBALS.;;==
0730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0770: 3d 3d 3d 3d 0a 0a 3b 3b 20 47 6f 74 74 61 20 68 ====..;; Gotta h
0780: 61 76 65 20 61 20 67 6c 6f 62 61 6c 3f 20 53 74 ave a global? St
0790: 61 73 68 20 69 74 20 69 6e 20 74 68 65 20 2a 67 ash it in the *g
07a0: 6c 6f 62 61 6c 2a 20 68 61 73 68 20 74 61 62 6c lobal* hash tabl
07b0: 65 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 67 e..;;.(define *g
07c0: 6c 6f 62 61 6c 2a 20 28 6d 61 6b 65 2d 68 61 73 lobal* (make-has
07d0: 68 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 66 69 h-table))..(defi
07e0: 6e 65 20 28 74 63 6d 74 3a 70 72 69 6e 74 20 74 ne (tcmt:print t
07f0: 64 61 74 20 66 6c 75 73 68 2d 6d 6f 64 65 29 0a dat flush-mode).
0800: 20 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 65 6e (let* ((commen
0810: 74 20 20 28 69 66 20 28 74 65 73 74 64 61 74 2d t (if (testdat-
0820: 63 6f 6d 6d 65 6e 74 20 74 64 61 74 29 0a 09 09 comment tdat)...
0830: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 6d (conc " m
0840: 65 73 73 61 67 65 3d 27 22 20 28 74 65 73 74 64 essage='" (testd
0850: 61 74 2d 63 6f 6d 6d 65 6e 74 20 74 64 61 74 29 at-comment tdat)
0860: 20 22 27 22 29 0a 09 09 20 20 20 20 20 20 20 22 "'")... "
0870: 22 29 29 0a 09 20 28 64 65 74 61 69 6c 73 20 20 ")).. (details
0880: 28 69 66 20 28 74 65 73 74 64 61 74 2d 64 65 74 (if (testdat-det
0890: 61 69 6c 73 20 74 64 61 74 29 0a 09 09 20 20 20 ails tdat)...
08a0: 20 20 20 20 28 63 6f 6e 63 20 22 20 64 65 74 61 (conc " deta
08b0: 69 6c 73 3d 27 22 20 28 74 65 73 74 64 61 74 2d ils='" (testdat-
08c0: 64 65 74 61 69 6c 73 20 74 64 61 74 29 20 22 27 details tdat) "'
08d0: 22 29 0a 09 09 20 20 20 20 20 20 20 22 22 29 29 ")... ""))
08e0: 0a 09 20 28 66 6c 6f 77 69 64 20 20 20 28 63 6f .. (flowid (co
08f0: 6e 63 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 28 nc " flowId='" (
0900: 74 65 73 74 64 61 74 2d 66 6c 6f 77 69 64 20 20 testdat-flowid
0910: 20 74 64 61 74 29 20 22 27 22 29 29 0a 09 20 28 tdat) "'")).. (
0920: 64 75 72 61 74 69 6f 6e 20 28 63 6f 6e 63 20 22 duration (conc "
0930: 20 64 75 72 61 74 69 6f 6e 3d 27 22 20 28 2a 20 duration='" (*
0940: 31 65 33 20 28 74 65 73 74 64 61 74 2d 64 75 72 1e3 (testdat-dur
0950: 61 74 69 6f 6e 20 74 64 61 74 29 29 20 22 27 22 ation tdat)) "'"
0960: 29 29 0a 09 20 28 74 63 6e 61 6d 65 20 20 20 28 )).. (tcname (
0970: 63 6f 6e 63 20 22 20 6e 61 6d 65 3d 27 22 20 28 conc " name='" (
0980: 74 65 73 74 64 61 74 2d 74 63 74 6e 61 6d 65 20 testdat-tctname
0990: 20 74 64 61 74 29 20 22 27 22 29 29 0a 09 20 28 tdat) "'")).. (
09a0: 73 74 61 74 65 20 20 20 20 28 73 74 72 69 6e 67 state (string
09b0: 2d 3e 73 79 6d 62 6f 6c 20 28 74 65 73 74 64 61 ->symbol (testda
09c0: 74 2d 73 74 61 74 65 20 74 64 61 74 29 29 29 0a t-state tdat))).
09d0: 09 20 28 73 74 61 74 75 73 20 20 20 28 73 74 72 . (status (str
09e0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 74 65 73 ing->symbol (tes
09f0: 74 64 61 74 2d 73 74 61 74 75 73 20 74 64 61 74 tdat-status tdat
0a00: 29 29 29 0a 09 20 28 73 74 61 72 74 70 20 20 20 ))).. (startp
0a10: 28 74 65 73 74 64 61 74 2d 73 74 61 72 74 2d 70 (testdat-start-p
0a20: 72 69 6e 74 65 64 20 74 64 61 74 29 29 0a 09 20 rinted tdat))..
0a30: 28 65 6e 64 70 20 20 20 20 20 28 74 65 73 74 64 (endp (testd
0a40: 61 74 2d 65 6e 64 2d 70 72 69 6e 74 65 64 20 20 at-end-printed
0a50: 20 74 64 61 74 29 29 0a 09 20 28 65 74 69 6d 65 tdat)).. (etime
0a60: 20 20 20 20 28 74 65 73 74 64 61 74 2d 65 76 65 (testdat-eve
0a70: 6e 74 2d 74 69 6d 65 20 20 20 20 74 64 61 74 29 nt-time tdat)
0a80: 29 0a 09 20 28 6f 76 65 72 61 6c 6c 20 20 28 63 ).. (overall (c
0a90: 61 73 65 20 73 74 61 74 65 0a 09 09 20 20 20 20 ase state...
0aa0: 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 73 74 ((RUNNING) st
0ab0: 61 74 65 29 0a 09 09 20 20 20 20 20 28 28 43 4f ate)... ((CO
0ac0: 4d 50 4c 45 54 45 44 29 20 73 74 61 74 65 29 0a MPLETED) state).
0ad0: 09 09 20 20 20 20 20 28 65 6c 73 65 20 27 55 4e .. (else 'UN
0ae0: 4b 29 29 29 0a 09 20 28 74 73 74 6d 70 20 20 20 K))).. (tstmp
0af0: 20 28 63 6f 6e 63 20 22 20 74 69 6d 65 73 74 61 (conc " timesta
0b00: 6d 70 3d 27 22 20 28 74 69 6d 65 2d 3e 73 74 72 mp='" (time->str
0b10: 69 6e 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f ing (seconds->lo
0b20: 63 61 6c 2d 74 69 6d 65 20 65 74 69 6d 65 29 20 cal-time etime)
0b30: 22 25 46 54 25 54 2e 30 30 30 22 29 20 22 27 22 "%FT%T.000") "'"
0b40: 29 29 29 0a 20 20 20 20 28 63 61 73 65 20 6f 76 ))). (case ov
0b50: 65 72 61 6c 6c 0a 20 20 20 20 20 20 28 28 52 55 erall. ((RU
0b60: 4e 4e 49 4e 47 29 0a 20 20 20 20 20 20 20 28 69 NNING). (i
0b70: 66 20 28 6e 6f 74 20 73 74 61 72 74 70 29 0a 09 f (not startp)..
0b80: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
0b90: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
0ba0: 74 79 5b 74 65 73 74 53 74 61 72 74 65 64 20 22 ty[testStarted "
0bb0: 20 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 tcname flowid
0bc0: 74 73 74 6d 70 20 22 5d 22 29 0a 09 20 20 20 20 tstmp "]")..
0bd0: 20 28 74 65 73 74 64 61 74 2d 73 74 61 72 74 2d (testdat-start-
0be0: 70 72 69 6e 74 65 64 2d 73 65 74 21 20 74 64 61 printed-set! tda
0bf0: 74 20 23 74 29 29 29 29 0a 20 20 20 20 20 20 28 t #t)))). (
0c00: 28 43 4f 4d 50 4c 45 54 45 44 29 0a 20 20 20 20 (COMPLETED).
0c10: 20 20 20 28 69 66 20 28 6e 6f 74 20 73 74 61 72 (if (not star
0c20: 74 70 29 20 3b 3b 20 73 74 61 72 74 20 73 74 61 tp) ;; start sta
0c30: 6e 7a 61 20 6e 65 76 65 72 20 70 72 69 6e 74 65 nza never printe
0c40: 64 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 d.. (begin..
0c50: 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 61 (print "##tea
0c60: 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 65 mcity[testStarte
0c70: 64 20 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 d " tcname flowi
0c80: 64 20 74 73 74 6d 70 20 22 5d 22 29 0a 09 20 20 d tstmp "]")..
0c90: 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 72 (testdat-star
0ca0: 74 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 20 74 t-printed-set! t
0cb0: 64 61 74 20 23 74 29 29 29 0a 20 20 20 20 20 20 dat #t))).
0cc0: 20 28 69 66 20 28 6e 6f 74 20 65 6e 64 70 29 0a (if (not endp).
0cd0: 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 . (begin..
0ce0: 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 65 (if (not (membe
0cf0: 72 20 73 74 61 74 75 73 20 27 28 50 41 53 53 20 r status '(PASS
0d00: 57 41 52 4e 20 53 4b 49 50 20 57 41 49 56 45 44 WARN SKIP WAIVED
0d10: 29 29 29 0a 09 09 20 28 70 72 69 6e 74 20 22 23 )))... (print "#
0d20: 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 61 #teamcity[testFa
0d30: 69 6c 65 64 20 20 22 20 74 63 6e 61 6d 65 20 66 iled " tcname f
0d40: 6c 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 64 65 lowid comment de
0d50: 74 61 69 6c 73 20 22 5d 22 29 29 0a 20 20 20 20 tails "]")).
0d60: 20 20 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 (print
0d70: 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 "##teamcity[test
0d80: 46 69 6e 69 73 68 65 64 22 20 74 63 6e 61 6d 65 Finished" tcname
0d90: 20 66 6c 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 flowid comment
0da0: 64 65 74 61 69 6c 73 20 64 75 72 61 74 69 6f 6e details duration
0db0: 20 22 5d 22 29 0a 09 20 20 20 20 20 28 74 65 73 "]").. (tes
0dc0: 74 64 61 74 2d 65 6e 64 2d 70 72 69 6e 74 65 64 tdat-end-printed
0dd0: 2d 73 65 74 21 20 74 64 61 74 20 23 74 29 29 29 -set! tdat #t)))
0de0: 29 0a 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 ). (else.
0df0: 20 20 20 20 20 28 69 66 20 66 6c 75 73 68 2d 6d (if flush-m
0e00: 6f 64 65 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 ode.. (begin..
0e10: 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 74 (if (not st
0e20: 61 72 74 70 29 0a 09 09 20 28 62 65 67 69 6e 0a artp)... (begin.
0e30: 09 09 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 .. (print "##t
0e40: 65 61 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 eamcity[testStar
0e50: 74 65 64 20 22 20 74 63 6e 61 6d 65 20 66 6c 6f ted " tcname flo
0e60: 77 69 64 20 74 73 74 6d 70 20 22 5d 22 29 0a 09 wid tstmp "]")..
0e70: 09 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 . (testdat-sta
0e80: 72 74 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 20 rt-printed-set!
0e90: 74 64 61 74 20 23 74 29 29 29 0a 09 20 20 20 20 tdat #t)))..
0ea0: 20 28 69 66 20 28 6e 6f 74 20 65 6e 64 70 29 0a (if (not endp).
0eb0: 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 .. (begin... (
0ec0: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
0ed0: 79 5b 74 65 73 74 46 61 69 6c 65 64 20 20 22 20 y[testFailed "
0ee0: 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 63 6f tcname flowid co
0ef0: 6d 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 22 5d mment details "]
0f00: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
0f10: 20 20 20 20 20 20 28 70 72 69 6e 74 20 22 23 23 (print "##
0f20: 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 69 6e teamcity[testFin
0f30: 69 73 68 65 64 22 20 74 63 6e 61 6d 65 20 66 6c ished" tcname fl
0f40: 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 64 65 74 owid comment det
0f50: 61 69 6c 73 20 64 75 72 61 74 69 6f 6e 20 22 5d ails duration "]
0f60: 22 29 0a 09 09 20 20 20 28 74 65 73 74 64 61 74 ")... (testdat
0f70: 2d 65 6e 64 2d 70 72 69 6e 74 65 64 2d 73 65 74 -end-printed-set
0f80: 21 20 74 64 61 74 20 23 74 29 29 29 29 29 29 29 ! tdat #t)))))))
0f90: 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
0fa0: 45 52 52 4f 52 3a 20 74 63 2d 74 79 70 65 20 5c ERROR: tc-type \
0fb0: 22 22 20 28 74 65 73 74 64 61 74 2d 74 63 2d 74 "" (testdat-tc-t
0fc0: 79 70 65 20 74 64 61 74 29 20 22 5c 22 20 6e 6f ype tdat) "\" no
0fd0: 74 20 72 65 63 6f 67 6e 69 73 65 64 20 66 6f 72 t recognised for
0fe0: 20 22 20 74 63 6e 61 6d 65 29 29 29 0a 20 20 20 " tcname))).
0ff0: 20 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 29 29 (flush-output))
1000: 29 0a 0a 3b 3b 20 3b 3b 20 72 65 74 75 72 6e 73 )..;; ;; returns
1010: 20 76 61 6c 75 65 73 3a 20 66 6c 61 67 20 6e 65 values: flag ne
1020: 77 6c 73 74 0a 3b 3b 20 28 64 65 66 69 6e 65 20 wlst.;; (define
1030: 28 72 65 6d 6f 76 65 2d 64 75 70 6c 69 63 61 74 (remove-duplicat
1040: 65 2d 63 6f 6d 70 6c 65 74 65 64 20 20 74 64 61 e-completed tda
1050: 74 73 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 28 ts).;; (let* (
1060: 28 66 6c 61 67 20 20 20 20 20 20 20 23 66 29 0a (flag #f).
1070: 3b 3b 20 20 20 20 20 20 20 20 20 20 28 73 74 61 ;; (sta
1080: 74 65 20 20 20 20 20 20 28 74 65 73 74 64 61 74 te (testdat
1090: 2d 73 74 61 74 65 20 20 20 20 20 20 74 64 61 74 -state tdat
10a0: 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 28 )).;; (
10b0: 73 74 61 74 75 73 20 20 20 20 20 28 74 65 73 74 status (test
10c0: 64 61 74 2d 73 74 61 74 75 73 20 20 20 20 20 74 dat-status t
10d0: 64 61 74 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 dat)).;;
10e0: 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 28 74 (event-time (t
10f0: 65 73 74 64 61 74 2d 65 76 65 6e 74 2d 74 69 6d estdat-event-tim
1100: 65 20 74 64 61 74 29 29 0a 3b 3b 20 20 20 20 20 e tdat)).;;
1110: 20 20 20 20 20 28 74 6e 61 6d 65 20 20 20 20 20 (tname
1120: 20 28 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 (testdat-tname
1130: 20 20 20 20 20 74 64 61 74 29 29 29 0a 3b 3b 20 tdat))).;;
1140: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 (let loop ((
1150: 68 65 64 20 28 63 61 72 20 74 64 61 74 73 29 29 hed (car tdats))
1160: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
1170: 20 20 20 28 74 61 6c 20 28 63 64 72 20 74 64 61 (tal (cdr tda
1180: 74 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 ts)).;;
1190: 20 20 20 20 20 20 20 28 6e 65 77 20 27 28 29 29 (new '())
11a0: 29 0a 3b 3b 20 20 20 20 20 20 20 28 69 66 20 28 ).;; (if (
11b0: 61 6e 64 20 28 65 71 75 61 6c 3f 20 73 74 61 74 and (equal? stat
11c0: 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 3b e "COMPLETED").;
11d0: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
11e0: 20 28 65 71 75 61 6c 3f 20 74 6e 61 6d 65 20 28 (equal? tname (
11f0: 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 68 65 testdat-tname he
1200: 64 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 d)).;;
1210: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 (equal? st
1220: 61 74 65 20 28 74 65 73 74 64 61 74 2d 73 74 61 ate (testdat-sta
1230: 74 65 20 68 65 64 29 29 29 20 3b 3b 20 77 65 20 te hed))) ;; we
1240: 68 61 76 65 20 61 20 64 75 70 6c 69 63 61 74 65 have a duplicate
1250: 20 43 4f 4d 50 4c 45 54 45 44 20 63 61 6c 6c 0a COMPLETED call.
1260: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 28 62 65 ;; (be
1270: 67 69 6e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 gin.;;
1280: 20 20 20 28 73 65 74 21 20 66 6c 61 67 20 23 74 (set! flag #t
1290: 29 20 3b 3b 20 41 20 63 68 61 6e 67 65 64 20 63 ) ;; A changed c
12a0: 6f 6d 70 6c 65 74 65 64 0a 20 20 20 20 20 20 20 ompleted.
12b0: 20 20 20 20 20 0a 3b 3b 20 70 72 6f 63 65 73 73 .;; process
12c0: 20 74 68 65 20 71 75 65 75 65 20 6f 66 20 74 65 the queue of te
12d0: 73 74 73 20 67 61 74 68 65 72 65 64 20 73 6f 20 sts gathered so
12e0: 66 61 72 2e 20 4c 69 73 74 20 69 6e 63 6c 75 64 far. List includ
12f0: 65 73 20 6f 6e 65 20 65 6e 74 72 79 20 66 6f 72 es one entry for
1300: 20 65 76 65 72 79 20 74 65 73 74 20 73 6f 20 66 every test so f
1310: 61 72 20 73 65 65 6e 0a 3b 3b 20 74 68 65 20 6c ar seen.;; the l
1320: 61 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 61 ast record for a
1330: 20 74 65 73 74 20 69 73 20 70 72 65 73 65 72 76 test is preserv
1340: 65 64 2e 20 49 74 65 6d 73 20 61 72 65 20 6f 6e ed. Items are on
1350: 6c 79 20 72 65 6d 6f 76 65 64 20 66 72 6f 6d 20 ly removed from
1360: 74 68 65 20 6c 69 73 74 20 69 66 20 6f 76 65 72 the list if over
1370: 20 31 35 20 73 65 63 6f 6e 64 73 0a 3b 3b 20 68 15 seconds.;; h
1380: 61 76 65 20 70 61 73 73 65 64 20 73 69 6e 63 65 ave passed since
1390: 20 69 74 20 68 61 70 70 65 6e 65 64 2e 20 54 68 it happened. Th
13a0: 69 73 20 61 6c 6c 6f 77 73 20 66 6f 72 20 63 6f is allows for co
13b0: 6d 70 72 65 73 73 69 6f 6e 20 6f 66 20 43 4f 4d mpression of COM
13c0: 50 4c 45 54 45 44 2f 46 41 49 4c 20 66 6f 6c 6c PLETED/FAIL foll
13d0: 6f 77 65 64 20 62 79 20 73 6f 6d 65 20 6f 74 68 owed by some oth
13e0: 65 72 0a 3b 3b 20 73 74 61 74 65 2f 73 74 61 74 er.;; state/stat
13f0: 75 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 us.;;.(define (p
1400: 72 6f 63 65 73 73 2d 71 75 65 75 65 20 64 61 74 rocess-queue dat
1410: 61 20 61 67 65 20 66 6c 75 73 68 2d 6d 6f 64 65 a age flush-mode
1420: 29 0a 20 20 3b 3b 20 68 65 72 65 20 77 65 20 70 ). ;; here we p
1430: 72 6f 63 65 73 73 20 74 71 75 65 75 65 20 61 6e rocess tqueue an
1440: 64 20 67 61 74 68 65 72 20 74 68 6f 73 65 20 6f d gather those o
1450: 76 65 72 20 31 35 20 73 65 63 6f 6e 64 73 20 28 ver 15 seconds (
1460: 63 6f 6e 66 69 67 75 72 61 62 6c 65 3f 29 20 6f configurable?) o
1470: 6c 64 0a 20 20 28 6c 65 74 2a 20 28 28 70 72 69 ld. (let* ((pri
1480: 6e 74 2d 74 69 6d 65 20 28 2d 20 28 63 75 72 72 nt-time (- (curr
1490: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 20 61 67 65 ent-seconds) age
14a0: 29 29 20 3b 3b 20 70 72 69 6e 74 20 73 74 75 66 )) ;; print stuf
14b0: 66 20 6f 76 65 72 20 31 35 20 73 65 63 6f 6e 64 f over 15 second
14c0: 73 20 6f 6c 64 0a 20 20 20 20 20 20 20 20 20 28 s old. (
14d0: 74 71 75 65 75 65 2d 72 61 77 20 28 68 61 73 68 tqueue-raw (hash
14e0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
14f0: 6c 74 20 64 61 74 61 20 27 74 71 75 65 75 65 20 lt data 'tqueue
1500: 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 '())). (
1510: 74 71 75 65 75 65 20 20 20 20 20 28 72 65 76 65 tqueue (reve
1520: 72 73 65 20 28 64 65 6c 65 74 65 2d 64 75 70 6c rse (delete-dupl
1530: 69 63 61 74 65 73 20 74 71 75 65 75 65 2d 72 61 icates tqueue-ra
1540: 77 20 20 20 20 20 3b 3b 20 52 45 4d 4f 56 45 20 w ;; REMOVE
1550: 64 75 70 6c 69 63 61 74 65 73 20 62 79 20 74 65 duplicates by te
1560: 73 74 6e 61 6d 65 20 61 6e 64 20 73 74 61 74 65 stname and state
1570: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a0: 20 20 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a (lambda (a b).
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e0: 20 20 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 (and (equal?
15f0: 28 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 61 (testdat-tname a
1600: 29 28 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 )(testdat-tname
1610: 62 29 29 20 20 20 20 20 20 20 20 3b 3b 20 6e 65 b)) ;; ne
1620: 65 64 20 6f 6c 64 65 73 74 20 74 6f 20 6e 65 77 ed oldest to new
1630: 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 est.
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1660: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 (equ
1670: 61 6c 3f 20 28 74 65 73 74 64 61 74 2d 73 74 61 al? (testdat-sta
1680: 74 65 20 61 29 20 28 74 65 73 74 64 61 74 2d 73 te a) (testdat-s
1690: 74 61 74 65 20 62 29 29 29 29 29 29 29 29 20 3b tate b)))))))) ;
16a0: 3b 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 20 ; "COMPLETED").
16b0: 20 20 20 3b 3b 20 28 65 71 75 61 6c 3f 20 28 74 ;; (equal? (t
16c0: 65 73 74 64 61 74 2d 73 74 61 74 65 20 62 29 20 estdat-state b)
16d0: 22 43 4f 4d 50 4c 45 54 45 44 22 29 29 29 29 29 "COMPLETED")))))
16e0: 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
16f0: 28 6e 75 6c 6c 3f 20 74 71 75 65 75 65 29 29 0a (null? tqueue)).
1700: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
1710: 62 6c 65 2d 73 65 74 21 0a 20 20 20 20 20 20 20 ble-set!.
1720: 20 20 64 61 74 61 0a 20 20 20 20 20 20 20 20 20 data.
1730: 27 74 71 75 65 75 65 0a 20 20 20 20 20 20 20 20 'tqueue.
1740: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 (let loop ((hed
1750: 20 28 63 61 72 20 74 71 75 65 75 65 29 29 20 3b (car tqueue)) ;
1760: 3b 20 62 79 20 74 68 69 73 20 70 6f 69 6e 74 20 ; by this point
1770: 61 6c 6c 20 64 75 70 6c 69 63 61 74 65 73 20 62 all duplicates b
1780: 79 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 y state COMPLETE
1790: 44 20 61 72 65 20 72 65 6d 6f 76 65 64 0a 20 20 D are removed.
17a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b0: 20 20 28 74 61 6c 20 28 63 64 72 20 74 71 75 65 (tal (cdr tque
17c0: 75 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ue)).
17d0: 20 20 20 20 20 20 20 20 20 28 72 65 6d 20 27 28 (rem '(
17e0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
17f0: 69 66 20 28 3e 20 70 72 69 6e 74 2d 74 69 6d 65 if (> print-time
1800: 20 28 74 65 73 74 64 61 74 2d 65 76 65 6e 74 2d (testdat-event-
1810: 74 69 6d 65 20 68 65 64 29 29 20 3b 3b 20 65 76 time hed)) ;; ev
1820: 65 6e 74 20 68 61 70 70 65 6e 65 64 20 6f 76 65 ent happened ove
1830: 72 20 31 35 20 73 65 63 6f 6e 64 73 20 61 67 6f r 15 seconds ago
1840: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1850: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
1860: 20 20 20 20 20 20 20 20 28 74 63 6d 74 3a 70 72 (tcmt:pr
1870: 69 6e 74 20 68 65 64 20 66 6c 75 73 68 2d 6d 6f int hed flush-mo
1880: 64 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 de).
1890: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
18a0: 74 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 tal).
18b0: 20 20 20 20 20 20 20 20 20 20 72 65 6d 20 3b 3b rem ;;
18c0: 20 72 65 74 75 72 6e 20 72 65 6d 20 74 6f 20 62 return rem to b
18d0: 65 20 70 72 6f 63 65 73 73 65 64 20 69 6e 20 74 e processed in t
18e0: 68 65 20 66 75 74 75 72 65 0a 20 20 20 20 20 20 he future.
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1900: 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 loop (car tal)(c
1910: 64 72 20 74 61 6c 29 20 72 65 6d 29 29 29 0a 20 dr tal) rem))).
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1930: 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 20 20 f (null? tal).
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1950: 20 28 63 6f 6e 73 20 68 65 64 20 72 65 6d 29 20 (cons hed rem)
1960: 3b 3b 20 72 65 74 75 72 6e 20 72 65 6d 20 2b 20 ;; return rem +
1970: 68 65 64 20 66 6f 72 20 66 75 74 75 72 65 20 70 hed for future p
1980: 72 6f 63 65 73 73 69 6e 67 0a 20 20 20 20 20 20 rocessing.
1990: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
19a0: 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 op (car tal)(cdr
19b0: 20 74 61 6c 29 28 63 6f 6e 73 20 68 65 64 20 72 tal)(cons hed r
19c0: 65 6d 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 20 em)))))))))..;;
19d0: 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 53 ##teamcity[testS
19e0: 74 61 72 74 65 64 20 6e 61 6d 65 3d 27 73 75 69 tarted name='sui
19f0: 74 65 2e 74 65 73 74 4e 61 6d 65 27 5d 0a 3b 3b te.testName'].;;
1a00: 20 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 ##teamcity[test
1a10: 53 74 64 4f 75 74 20 6e 61 6d 65 3d 27 73 75 69 StdOut name='sui
1a20: 74 65 2e 74 65 73 74 4e 61 6d 65 27 20 6f 75 74 te.testName' out
1a30: 3d 27 74 65 78 74 27 5d 0a 3b 3b 20 23 23 74 65 ='text'].;; ##te
1a40: 61 6d 63 69 74 79 5b 74 65 73 74 53 74 64 45 72 amcity[testStdEr
1a50: 72 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 r name='suite.te
1a60: 73 74 4e 61 6d 65 27 20 6f 75 74 3d 27 65 72 72 stName' out='err
1a70: 6f 72 20 74 65 78 74 27 5d 0a 3b 3b 20 23 23 74 or text'].;; ##t
1a80: 65 61 6d 63 69 74 79 5b 74 65 73 74 46 61 69 6c eamcity[testFail
1a90: 65 64 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 ed name='suite.t
1aa0: 65 73 74 4e 61 6d 65 27 20 6d 65 73 73 61 67 65 estName' message
1ab0: 3d 27 66 61 69 6c 75 72 65 20 6d 65 73 73 61 67 ='failure messag
1ac0: 65 27 20 64 65 74 61 69 6c 73 3d 27 6d 65 73 73 e' details='mess
1ad0: 61 67 65 20 61 6e 64 20 73 74 61 63 6b 20 74 72 age and stack tr
1ae0: 61 63 65 27 5d 0a 3b 3b 20 23 23 74 65 61 6d 63 ace'].;; ##teamc
1af0: 69 74 79 5b 74 65 73 74 46 69 6e 69 73 68 65 64 ity[testFinished
1b00: 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 73 name='suite.tes
1b10: 74 4e 61 6d 65 27 20 64 75 72 61 74 69 6f 6e 3d tName' duration=
1b20: 27 35 30 27 5d 0a 3b 3b 20 0a 3b 3b 20 66 6c 75 '50'].;; .;; flu
1b30: 73 68 3b 20 23 66 2c 20 6e 6f 72 6d 61 6c 20 63 sh; #f, normal c
1b40: 61 6c 6c 2e 20 23 74 2c 20 6c 61 73 74 20 63 61 all. #t, last ca
1b50: 6c 6c 2c 20 70 72 69 6e 74 20 6f 75 74 20 73 6f ll, print out so
1b60: 6d 65 74 68 69 6e 67 20 66 6f 72 20 4e 4f 54 5f mething for NOT_
1b70: 53 54 41 52 54 45 44 2c 20 65 74 63 2e 0a 3b 3b STARTED, etc..;;
1b80: 0a 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 28 62 65 67 ..;;;;;;; (beg
1b90: 69 6e 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 28 in.;;;;;;; (
1ba0: 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 79 case (string->sy
1bb0: 6d 62 6f 6c 20 6e 65 77 73 74 61 74 29 0a 3b 3b mbol newstat).;;
1bc0: 3b 3b 3b 3b 3b 20 20 20 20 20 20 20 28 28 55 4e ;;;;; ((UN
1bd0: 4b 29 20 20 20 20 20 20 20 29 20 3b 3b 20 64 6f K) ) ;; do
1be0: 20 6e 6f 74 68 69 6e 67 0a 3b 3b 3b 3b 3b 3b 3b nothing.;;;;;;;
1bf0: 20 20 20 20 20 20 20 28 28 52 55 4e 4e 49 4e 47 ((RUNNING
1c00: 29 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 ) (print "##te
1c10: 61 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 amcity[testStart
1c20: 65 64 20 6e 61 6d 65 3d 27 22 20 74 63 74 6e 61 ed name='" tctna
1c30: 6d 65 20 22 27 20 66 6c 6f 77 49 64 3d 27 22 20 me "' flowId='"
1c40: 66 6c 6f 77 69 64 20 22 27 5d 22 29 29 0a 3b 3b flowid "']")).;;
1c50: 3b 3b 3b 3b 3b 20 20 20 20 20 20 20 28 28 50 41 ;;;;; ((PA
1c60: 53 53 20 53 4b 49 50 20 57 41 52 4e 20 57 41 49 SS SKIP WARN WAI
1c70: 56 45 44 29 20 28 70 72 69 6e 74 20 22 23 23 74 VED) (print "##t
1c80: 65 61 6d 63 69 74 79 5b 74 65 73 74 46 69 6e 69 eamcity[testFini
1c90: 73 68 65 64 20 6e 61 6d 65 3d 27 22 20 74 63 74 shed name='" tct
1ca0: 6e 61 6d 65 20 22 27 20 64 75 72 61 74 69 6f 6e name "' duration
1cb0: 3d 27 22 20 28 2a 20 31 65 33 20 64 75 72 61 74 ='" (* 1e3 durat
1cc0: 69 6f 6e 29 20 22 27 22 20 63 6d 74 73 74 72 20 ion) "'" cmtstr
1cd0: 64 65 74 61 69 6c 73 20 22 20 66 6c 6f 77 49 64 details " flowId
1ce0: 3d 27 22 20 66 6c 6f 77 69 64 20 22 27 5d 22 29 ='" flowid "']")
1cf0: 29 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 20 20 ).;;;;;;;
1d00: 28 65 6c 73 65 0a 3b 3b 3b 3b 3b 3b 3b 20 09 28 (else.;;;;;;; .(
1d10: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
1d20: 79 5b 74 65 73 74 46 61 69 6c 65 64 20 6e 61 6d y[testFailed nam
1d30: 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 22 27 20 e='" tctname "'
1d40: 22 20 63 6d 74 73 74 72 20 64 65 74 61 69 6c 73 " cmtstr details
1d50: 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 66 6c 6f " flowId='" flo
1d60: 77 69 64 20 22 27 5d 22 29 29 29 0a 3b 3b 3b 3b wid "']"))).;;;;
1d70: 3b 3b 3b 20 20 20 20 20 28 66 6c 75 73 68 2d 6f ;;; (flush-o
1d80: 75 74 70 75 74 29 0a 0a 3b 3b 20 28 74 72 61 63 utput)..;; (trac
1d90: 65 20 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 2d e rmt:get-tests-
1da0: 66 6f 72 2d 72 75 6e 29 0a 0a 28 64 65 66 69 6e for-run)..(defin
1db0: 65 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d e (update-queue-
1dc0: 73 69 6e 63 65 20 64 61 74 61 20 72 75 6e 2d 69 since data run-i
1dd0: 64 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 74 ds last-update t
1de0: 73 6e 61 6d 65 20 74 61 72 67 65 74 20 72 75 6e sname target run
1df0: 6e 61 6d 65 20 66 6c 6f 77 69 64 20 66 6c 75 73 name flowid flus
1e00: 68 20 23 21 6b 65 79 20 28 64 65 6c 61 79 2d 66 h #!key (delay-f
1e10: 6c 61 67 20 23 74 29 29 20 3b 3b 20 0a 20 20 28 lag #t)) ;; . (
1e20: 6c 65 74 20 28 28 6e 6f 77 20 20 20 20 20 20 20 let ((now
1e30: 20 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 (current-sec
1e40: 6f 6e 64 73 29 29 0a 09 28 73 74 69 6c 6c 2d 72 onds))..(still-r
1e50: 75 6e 6e 69 6e 67 20 23 66 29 29 0a 3b 3b 20 28 unning #f)).;; (
1e60: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
1e70: 73 0a 3b 3b 20 09 65 78 6e 0a 3b 3b 20 09 28 62 s.;; .exn.;; .(b
1e80: 65 67 69 6e 20 28 70 72 69 6e 74 2d 63 61 6c 6c egin (print-call
1e90: 2d 63 68 61 69 6e 29 20 28 70 72 69 6e 74 20 22 -chain) (print "
1ea0: 45 72 72 6f 72 20 6d 65 73 73 61 67 65 3a 20 22 Error message: "
1eb0: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
1ec0: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
1ed0: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
1ee0: 6e 29 29 29 0a 20 20 20 20 20 20 28 66 6f 72 2d n))). (for-
1ef0: 65 61 63 68 0a 20 20 20 20 20 20 20 28 6c 61 6d each. (lam
1f00: 62 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 20 28 bda (run-id).. (
1f10: 6c 65 74 2a 20 28 28 74 65 73 74 73 20 28 72 6d let* ((tests (rm
1f20: 74 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d t:get-tests-for-
1f30: 72 75 6e 20 72 75 6e 2d 69 64 20 22 25 22 20 27 run run-id "%" '
1f40: 28 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 () '() #f #f #f
1f50: 23 66 20 23 66 20 23 66 20 6c 61 73 74 2d 75 70 #f #f #f last-up
1f60: 64 61 74 65 20 23 66 29 29 29 0a 09 20 20 20 3b date #f))).. ;
1f70: 3b 20 28 70 72 69 6e 74 20 22 44 45 42 55 47 3a ; (print "DEBUG:
1f80: 20 67 6f 74 20 74 65 73 74 73 3d 22 20 74 65 73 got tests=" tes
1f90: 74 73 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 ts).. (for-eac
1fa0: 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h.. (lambda (
1fb0: 74 65 73 74 2d 72 65 63 29 0a 09 20 20 20 20 20 test-rec)..
1fc0: 20 28 6c 65 74 2a 20 28 28 74 71 75 65 75 65 20 (let* ((tqueue
1fd0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
1fe0: 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 27 f/default data '
1ff0: 74 71 75 65 75 65 20 27 28 29 29 29 20 3b 3b 20 tqueue '())) ;;
2000: 4e 4f 54 45 3a 20 74 68 65 20 6b 65 79 20 69 73 NOTE: the key is
2010: 20 61 20 73 79 6d 62 6f 6c 21 20 54 68 69 73 20 a symbol! This
2020: 61 6c 6c 6f 77 73 20 6b 65 65 70 69 6e 67 20 64 allows keeping d
2030: 69 73 70 61 72 61 74 65 20 69 6e 66 6f 20 69 6e isparate info in
2040: 20 74 68 65 20 6f 6e 65 20 68 61 73 68 2c 20 6c the one hash, l
2050: 61 7a 79 20 62 75 74 20 61 20 71 75 69 63 6b 20 azy but a quick
2060: 73 6f 6c 75 74 69 6f 6e 20 66 6f 72 20 72 69 67 solution for rig
2070: 68 74 20 6e 6f 77 2e 0a 09 09 20 20 20 20 20 28 ht now.... (
2080: 69 73 2d 74 6f 70 20 20 20 28 64 62 3a 74 65 73 is-top (db:tes
2090: 74 2d 67 65 74 2d 69 73 2d 74 6f 70 6c 65 76 65 t-get-is-topleve
20a0: 6c 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 l test-rec))...
20b0: 20 20 20 20 20 28 74 6e 61 6d 65 20 20 20 20 28 (tname (
20c0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c db:test-get-full
20d0: 6e 61 6d 65 20 20 20 20 20 74 65 73 74 2d 72 65 name test-re
20e0: 63 29 29 0a 09 09 20 20 20 20 20 28 74 65 73 74 c))... (test
20f0: 6e 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 name (db:test-ge
2100: 74 2d 74 65 73 74 6e 61 6d 65 20 20 20 20 20 74 t-testname t
2110: 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 est-rec))...
2120: 20 28 69 74 65 6d 70 61 74 68 20 28 64 62 3a 74 (itempath (db:t
2130: 65 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 est-get-item-pat
2140: 68 20 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a h test-rec)).
2150: 09 09 20 20 20 20 20 28 74 63 74 6e 61 6d 65 20 .. (tctname
2160: 20 28 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 69 (if (string=? i
2170: 74 65 6d 70 61 74 68 20 22 22 29 20 74 65 73 74 tempath "") test
2180: 6e 61 6d 65 20 28 63 6f 6e 63 20 74 65 73 74 6e name (conc testn
2190: 61 6d 65 20 22 2e 22 20 28 73 74 72 69 6e 67 2d ame "." (string-
21a0: 74 72 61 6e 73 6c 61 74 65 20 69 74 65 6d 70 61 translate itempa
21b0: 74 68 20 22 2f 22 20 22 2e 22 29 29 29 29 0a 09 th "/" "."))))..
21c0: 09 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 . (state
21d0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
21e0: 74 65 20 20 20 20 20 20 20 20 74 65 73 74 2d 72 te test-r
21f0: 65 63 29 29 0a 09 09 20 20 20 20 20 28 73 74 61 ec))... (sta
2200: 74 75 73 20 20 20 28 64 62 3a 74 65 73 74 2d 67 tus (db:test-g
2210: 65 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 et-status
2220: 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 test-rec))...
2230: 20 20 28 65 74 69 6d 65 20 20 20 20 28 64 62 3a (etime (db:
2240: 74 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 test-get-event_t
2250: 69 6d 65 20 20 20 74 65 73 74 2d 72 65 63 29 29 ime test-rec))
2260: 0a 09 09 20 20 20 20 20 28 64 75 72 61 74 69 6f ... (duratio
2270: 6e 20 28 6f 72 20 28 61 6e 79 2d 3e 6e 75 6d 62 n (or (any->numb
2280: 65 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d er (db:test-get-
2290: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 run_duration tes
22a0: 74 2d 72 65 63 29 29 20 30 29 29 0a 09 09 20 20 t-rec)) 0))...
22b0: 20 20 20 28 63 6f 6d 6d 65 6e 74 20 20 28 64 62 (comment (db
22c0: 3a 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e :test-get-commen
22d0: 74 20 20 20 20 20 20 74 65 73 74 2d 72 65 63 29 t test-rec)
22e0: 29 0a 09 09 20 20 20 20 20 28 6c 6f 67 66 69 6c )... (logfil
22f0: 65 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d e (db:test-get-
2300: 66 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 74 65 73 final_logf tes
2310: 74 2d 72 65 63 29 29 0a 20 20 20 20 20 20 20 20 t-rec)).
2320: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 6f (ho
2330: 73 74 6e 20 20 20 20 28 64 62 3a 74 65 73 74 2d stn (db:test-
2340: 67 65 74 2d 68 6f 73 74 20 20 20 20 20 20 20 20 get-host
2350: 20 74 65 73 74 2d 72 65 63 29 29 0a 20 20 20 20 test-rec)).
2360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2370: 20 28 70 69 64 20 20 20 20 20 20 28 64 62 3a 74 (pid (db:t
2380: 65 73 74 2d 67 65 74 2d 70 72 6f 63 65 73 73 5f est-get-process_
2390: 69 64 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a id test-rec)).
23a0: 09 09 20 20 20 20 20 28 74 65 73 74 2d 63 6f 6e .. (test-con
23b0: 74 20 28 3e 20 28 2b 20 65 74 69 6d 65 20 64 75 t (> (+ etime du
23c0: 72 61 74 69 6f 6e 20 34 30 29 20 28 63 75 72 72 ration 40) (curr
23d0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 29 20 3b ent-seconds))) ;
23e0: 3b 20 74 65 73 74 20 68 61 73 20 6e 6f 74 20 62 ; test has not b
23f0: 65 65 6e 20 6f 76 65 72 20 66 6f 72 20 6d 6f 72 een over for mor
2400: 65 20 74 68 61 6e 20 32 30 20 73 65 63 6f 6e 64 e than 20 second
2410: 73 0a 09 09 20 20 20 20 20 28 61 64 6a 2d 73 74 s... (adj-st
2420: 61 74 65 20 28 69 66 20 64 65 6c 61 79 2d 66 6c ate (if delay-fl
2430: 61 67 0a 09 09 09 09 20 20 20 20 28 69 66 20 74 ag..... (if t
2440: 65 73 74 2d 63 6f 6e 74 0a 09 09 09 09 09 28 62 est-cont......(b
2450: 65 67 69 6e 0a 09 09 09 09 09 20 20 28 73 65 74 egin...... (set
2460: 21 20 73 74 69 6c 6c 2d 72 75 6e 6e 69 6e 67 20 ! still-running
2470: 23 74 29 0a 09 09 09 09 09 20 20 22 52 55 4e 4e #t)...... "RUNN
2480: 49 4e 47 22 29 0a 09 09 09 09 09 73 74 61 74 65 ING")......state
2490: 29 0a 09 09 09 09 20 20 20 20 73 74 61 74 65 29 )..... state)
24a0: 29 0a 09 09 20 20 20 20 20 28 6e 65 77 73 74 61 )... (newsta
24b0: 74 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 t (cond.
24c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24d0: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 28 6f 72 ;; ((or
24e0: 20 28 6e 6f 74 20 64 65 6c 61 79 2d 66 6c 61 67 (not delay-flag
24f0: 29 0a 09 09 09 09 3b 3b 20 20 20 20 20 20 28 3c ).....;; (<
2500: 20 28 2b 20 65 74 69 6d 65 20 64 75 72 61 74 69 (+ etime durati
2510: 6f 6e 29 0a 09 09 09 09 3b 3b 20 09 28 2d 20 28 on).....;; .(- (
2520: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
2530: 20 31 30 29 29 29 0a 09 09 09 09 3b 3b 20 09 28 10))).....;; .(
2540: 70 72 69 6e 74 20 22 53 6b 69 70 70 69 6e 67 20 print "Skipping
2550: 61 73 20 64 65 6c 61 79 20 68 61 73 6e 27 74 20 as delay hasn't
2560: 68 69 74 22 29 20 22 52 55 4e 4e 49 4e 47 22 29 hit") "RUNNING")
2570: 20 0a 09 09 09 09 28 28 65 71 75 61 6c 3f 20 61 .....((equal? a
2580: 64 6a 2d 73 74 61 74 65 20 22 52 55 4e 4e 49 4e dj-state "RUNNIN
2590: 47 22 29 0a 09 09 09 09 20 28 73 65 74 21 20 73 G")..... (set! s
25a0: 74 69 6c 6c 2d 72 75 6e 6e 69 6e 67 20 23 74 29 till-running #t)
25b0: 0a 09 09 09 09 20 22 52 55 4e 4e 49 4e 47 22 29 ..... "RUNNING")
25c0: 0a 09 09 09 09 28 28 65 71 75 61 6c 3f 20 61 64 .....((equal? ad
25d0: 6a 2d 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 j-state "COMPLET
25e0: 45 44 22 29 0a 09 09 09 09 20 73 74 61 74 75 73 ED")..... status
25f0: 29 0a 09 09 09 09 28 66 6c 75 73 68 20 20 20 28 ).....(flush (
2600: 63 6f 6e 63 20 73 74 61 74 65 20 22 2f 22 20 73 conc state "/" s
2610: 74 61 74 75 73 29 29 0a 09 09 09 09 28 65 6c 73 tatus)).....(els
2620: 65 20 22 55 4e 4b 22 29 29 29 0a 09 09 20 20 20 e "UNK")))...
2630: 20 20 28 63 6d 74 73 74 72 20 20 20 28 69 66 20 (cmtstr (if
2640: 28 61 6e 64 20 28 6e 6f 74 20 66 6c 75 73 68 29 (and (not flush)
2650: 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 20 20 comment).....
2660: 20 63 6f 6d 6d 65 6e 74 0a 09 09 09 09 20 20 20 comment.....
2670: 28 69 66 20 66 6c 75 73 68 0a 09 09 09 09 20 20 (if flush.....
2680: 20 20 20 20 20 28 63 6f 6e 63 20 22 54 65 73 74 (conc "Test
2690: 20 65 6e 64 65 64 20 69 6e 20 73 74 61 74 65 2f ended in state/
26a0: 73 74 61 74 75 73 3d 22 0a 09 09 09 09 09 20 20 status="......
26b0: 20 20 20 73 74 61 74 65 20 22 2f 22 20 73 74 61 state "/" sta
26c0: 74 75 73 0a 09 09 09 09 09 20 20 20 20 20 28 69 tus...... (i
26d0: 66 20 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 f (string-match
26e0: 20 22 5e 5c 5c 73 2a 24 22 20 63 6f 6d 6d 65 6e "^\\s*$" commen
26f0: 74 29 0a 09 09 09 09 09 09 20 20 22 2c 20 6e 6f t)....... ", no
2700: 20 4d 65 67 61 74 65 73 74 20 63 6f 6d 6d 65 6e Megatest commen
2710: 74 20 66 6f 75 6e 64 2e 22 0a 09 09 09 09 09 09 t found.".......
2720: 20 20 28 63 6f 6e 63 20 22 2c 20 4d 65 67 61 74 (conc ", Megat
2730: 65 73 74 20 63 6f 6d 6d 65 6e 74 3d 5c 22 22 20 est comment=\""
2740: 63 6f 6d 6d 65 6e 74 20 22 5c 22 22 29 29 29 20 comment "\"")))
2750: 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 2c ;; special case,
2760: 20 77 65 20 61 72 65 20 68 61 6e 64 6c 69 6e 67 we are handling
2770: 20 73 74 72 61 67 67 6c 65 72 73 0a 09 09 09 09 stragglers.....
2780: 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 20 #f)))...
2790: 20 20 20 20 28 64 65 74 61 69 6c 73 20 20 28 69 (details (i
27a0: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
27b0: 22 2e 2a 68 74 6d 6c 24 22 20 6c 6f 67 66 69 6c ".*html$" logfil
27c0: 65 29 0a 09 09 09 09 20 20 20 28 63 6f 6e 63 20 e)..... (conc
27d0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6c 74 2f 22 *toppath* "/lt/"
27e0: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
27f0: 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ame "/" testname
2800: 0a 09 09 09 09 09 20 28 69 66 20 28 65 71 75 61 ...... (if (equa
2810: 6c 3f 20 69 74 65 6d 70 61 74 68 20 22 22 29 20 l? itempath "")
2820: 22 2f 22 20 28 63 6f 6e 63 20 22 2f 22 20 69 74 "/" (conc "/" it
2830: 65 6d 70 61 74 68 20 22 2f 22 29 29 0a 09 09 09 empath "/"))....
2840: 09 09 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 09 .. logfile).....
2850: 20 20 20 23 66 29 29 0a 09 09 20 20 20 20 20 28 #f))... (
2860: 70 72 65 76 2d 74 64 61 74 20 28 68 61 73 68 2d prev-tdat (hash-
2870: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
2880: 74 20 64 61 74 61 20 74 6e 61 6d 65 20 23 66 29 t data tname #f)
2890: 29 20 0a 09 09 20 20 20 20 20 28 74 64 61 74 20 ) ... (tdat
28a0: 20 20 20 20 20 28 69 66 20 69 73 2d 74 6f 70 0a (if is-top.
28b0: 09 09 09 09 20 20 20 20 23 66 0a 09 09 09 09 20 .... #f.....
28c0: 20 20 20 28 6c 65 74 20 28 28 6e 65 77 20 28 6f (let ((new (o
28d0: 72 20 70 72 65 76 2d 74 64 61 74 20 28 6d 61 6b r prev-tdat (mak
28e0: 65 2d 74 65 73 74 64 61 74 29 29 29 29 20 3b 3b e-testdat)))) ;;
28f0: 20 72 65 63 79 63 6c 65 20 74 68 65 20 72 65 63 recycle the rec
2900: 6f 72 64 20 73 6f 20 77 65 20 6b 65 65 70 20 74 ord so we keep t
2910: 72 61 63 6b 20 6f 66 20 61 6c 72 65 61 64 79 20 rack of already
2920: 70 72 69 6e 74 65 64 20 69 74 65 6d 73 0a 09 09 printed items...
2930: 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 .. (testdat
2940: 2d 66 6c 6f 77 69 64 2d 73 65 74 21 20 20 20 20 -flowid-set!
2950: 20 6e 65 77 20 28 6f 72 20 28 74 65 73 74 64 61 new (or (testda
2960: 74 2d 66 6c 6f 77 69 64 20 6e 65 77 29 0a 20 20 t-flowid new).
2970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29b0: 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 70 69 (if (eq? pi
29c0: 64 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 d 0).
29d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a10: 74 63 74 6e 61 6d 65 0a 20 20 20 20 20 20 20 20 tctname.
2a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a60: 20 20 20 28 63 6f 6e 63 20 68 6f 73 74 6e 20 22 (conc hostn "
2a70: 2d 22 20 70 69 64 29 29 29 29 0a 09 09 09 09 20 -" pid)))).....
2a80: 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 74 63 (testdat-tc
2a90: 74 6e 61 6d 65 2d 73 65 74 21 20 20 20 20 6e 65 tname-set! ne
2aa0: 77 20 74 63 74 6e 61 6d 65 29 0a 09 09 09 09 20 w tctname).....
2ab0: 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 74 6e (testdat-tn
2ac0: 61 6d 65 2d 73 65 74 21 20 20 20 20 20 20 6e 65 ame-set! ne
2ad0: 77 20 74 6e 61 6d 65 29 0a 09 09 09 09 20 20 20 w tname).....
2ae0: 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 (testdat-stat
2af0: 65 2d 73 65 74 21 20 20 20 20 20 20 6e 65 77 20 e-set! new
2b00: 61 64 6a 2d 73 74 61 74 65 29 0a 09 09 09 09 20 adj-state).....
2b10: 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 (testdat-st
2b20: 61 74 75 73 2d 73 65 74 21 20 20 20 20 20 6e 65 atus-set! ne
2b30: 77 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 w status).....
2b40: 20 20 20 20 28 74 65 73 74 64 61 74 2d 63 6f 6d (testdat-com
2b50: 6d 65 6e 74 2d 73 65 74 21 20 20 20 20 6e 65 77 ment-set! new
2b60: 20 63 6d 74 73 74 72 29 0a 09 09 09 09 20 20 20 cmtstr).....
2b70: 20 20 20 28 74 65 73 74 64 61 74 2d 64 65 74 61 (testdat-deta
2b80: 69 6c 73 2d 73 65 74 21 20 20 20 20 6e 65 77 20 ils-set! new
2b90: 64 65 74 61 69 6c 73 29 0a 09 09 09 09 20 20 20 details).....
2ba0: 20 20 20 28 74 65 73 74 64 61 74 2d 64 75 72 61 (testdat-dura
2bb0: 74 69 6f 6e 2d 73 65 74 21 20 20 20 6e 65 77 20 tion-set! new
2bc0: 64 75 72 61 74 69 6f 6e 29 0a 09 09 09 09 20 20 duration).....
2bd0: 20 20 20 20 28 74 65 73 74 64 61 74 2d 65 76 65 (testdat-eve
2be0: 6e 74 2d 74 69 6d 65 2d 73 65 74 21 20 6e 65 77 nt-time-set! new
2bf0: 20 65 74 69 6d 65 29 20 3b 3b 20 28 63 75 72 72 etime) ;; (curr
2c00: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 ent-seconds))...
2c10: 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 .. (testdat
2c20: 2d 6f 76 65 72 61 6c 6c 2d 73 65 74 21 20 20 20 -overall-set!
2c30: 20 6e 65 77 20 6e 65 77 73 74 61 74 29 0a 09 09 new newstat)...
2c40: 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta
2c50: 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 74 6e ble-set! data tn
2c60: 61 6d 65 20 6e 65 77 29 0a 09 09 09 09 20 20 20 ame new).....
2c70: 20 20 20 6e 65 77 29 29 29 29 0a 09 09 28 69 66 new))))...(if
2c80: 20 28 6e 6f 74 20 69 73 2d 74 6f 70 29 0a 09 09 (not is-top)...
2c90: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2ca0: 73 65 74 21 20 64 61 74 61 20 27 74 71 75 65 75 set! data 'tqueu
2cb0: 65 20 28 63 6f 6e 73 20 74 64 61 74 20 74 71 75 e (cons tdat tqu
2cc0: 65 75 65 29 29 29 20 0a 20 20 20 20 20 20 20 20 eue))) .
2cd0: 20 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 (hash-ta
2ce0: 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 74 6e ble-set! data tn
2cf0: 61 6d 65 20 74 64 61 74 29 0a 20 20 20 20 20 20 ame tdat).
2d00: 20 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 20 )).
2d10: 20 20 20 20 20 20 20 20 20 74 65 73 74 73 29 29 tests))
2d20: 29 0a 20 20 20 20 20 20 20 72 75 6e 2d 69 64 73 ). run-ids
2d30: 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 6e 6f ). (list no
2d40: 77 20 73 74 69 6c 6c 2d 72 75 6e 6e 69 6e 67 29 w still-running)
2d50: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 6f 6e ))..(define (mon
2d60: 69 74 6f 72 20 70 69 64 29 0a 20 20 28 6c 65 74 itor pid). (let
2d70: 2a 20 28 28 72 75 6e 2d 69 64 73 20 27 28 29 29 * ((run-ids '())
2d80: 0a 09 20 28 74 65 73 74 64 61 74 73 20 28 6d 61 .. (testdats (ma
2d90: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
2da0: 20 3b 3b 20 65 61 63 68 20 65 6e 74 72 79 20 69 ;; each entry i
2db0: 73 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 s a list of test
2dc0: 64 61 74 20 73 74 72 75 63 74 73 0a 09 20 28 6b dat structs.. (k
2dd0: 65 79 73 20 20 20 20 23 66 29 0a 09 20 28 6c 61 eys #f).. (la
2de0: 73 74 2d 75 70 64 61 74 65 20 30 29 0a 09 20 28 st-update 0).. (
2df0: 74 61 72 67 65 74 20 20 28 6f 72 20 28 61 72 67 target (or (arg
2e00: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
2e10: 65 74 22 29 0a 09 09 20 20 20 20 20 20 28 61 72 et")... (ar
2e20: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 gs:get-arg "-req
2e30: 74 61 72 67 22 29 29 29 0a 09 20 28 72 75 6e 6e targ"))).. (runn
2e40: 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
2e50: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g "-runname"))..
2e60: 20 28 74 73 6e 61 6d 65 20 20 23 66 29 0a 09 20 (tsname #f)..
2e70: 28 66 6c 6f 77 69 64 20 20 28 63 6f 6e 63 20 74 (flowid (conc t
2e80: 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d arget "/" runnam
2e90: 65 29 29 0a 09 20 28 74 64 65 6c 61 79 20 20 28 e)).. (tdelay (
2ea0: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
2eb0: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
2ec0: 20 22 2d 64 65 6c 61 79 22 29 20 22 31 35 22 29 "-delay") "15")
2ed0: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 ))). (if (and
2ee0: 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 target runname)
2ef0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 61 75 ..(begin.. (lau
2f00: 6e 63 68 3a 73 65 74 75 70 29 0a 09 20 20 28 73 nch:setup).. (s
2f10: 65 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 65 et! keys (rmt:ge
2f20: 74 2d 6b 65 79 73 29 29 29 29 0a 20 20 20 20 28 t-keys)))). (
2f30: 73 65 74 21 20 74 73 6e 61 6d 65 20 20 28 63 6f set! tsname (co
2f40: 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 mmon:get-testsui
2f50: 74 65 2d 6e 61 6d 65 29 29 0a 20 20 20 20 28 70 te-name)). (p
2f60: 72 69 6e 74 20 22 54 43 4d 54 3a 20 66 6f 72 20 rint "TCMT: for
2f70: 74 65 73 74 73 75 69 74 65 3d 22 20 74 73 6e 61 testsuite=" tsna
2f80: 6d 65 20 22 20 66 6f 75 6e 64 20 72 75 6e 6e 61 me " found runna
2f90: 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 20 22 2c 20 me=" runname ",
2fa0: 74 61 72 67 65 74 3d 22 20 74 61 72 67 65 74 20 target=" target
2fb0: 22 2c 20 6b 65 79 73 3d 22 20 6b 65 79 73 20 22 ", keys=" keys "
2fc0: 20 61 6e 64 20 73 75 63 63 65 73 73 66 75 6c 6c and successfull
2fd0: 79 20 72 61 6e 20 6c 61 75 6e 63 68 3a 73 65 74 y ran launch:set
2fe0: 75 70 2e 20 55 73 69 6e 67 20 22 20 66 6c 6f 77 up. Using " flow
2ff0: 69 64 20 22 20 61 73 20 74 68 65 20 66 6c 6f 77 id " as the flow
3000: 49 64 2e 22 29 0a 20 20 20 20 28 6c 65 74 20 6c Id."). (let l
3010: 6f 6f 70 20 28 29 0a 20 20 20 20 20 20 3b 3b 3b oop (). ;;;
3020: 3b 3b 3b 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 ;;; (handle-exce
3030: 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 3b 3b 3b ptions. ;;;
3040: 3b 3b 3b 20 20 65 78 6e 0a 20 20 20 20 20 20 3b ;;; exn. ;
3050: 3b 3b 3b 3b 3b 20 20 3b 3b 20 28 70 72 69 6e 74 ;;;;; ;; (print
3060: 20 22 50 72 6f 63 65 73 73 20 64 6f 6e 65 2e 22 "Process done."
3070: 29 0a 20 20 20 20 20 20 3b 3b 3b 3b 3b 3b 20 20 ). ;;;;;;
3080: 28 62 65 67 69 6e 20 28 70 72 69 6e 74 2d 63 61 (begin (print-ca
3090: 6c 6c 2d 63 68 61 69 6e 29 20 28 70 72 69 6e 74 ll-chain) (print
30a0: 20 22 45 72 72 6f 72 20 6d 65 73 73 61 67 65 3a "Error message:
30b0: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
30c0: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
30d0: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
30e0: 65 78 6e 29 29 29 0a 20 20 20 20 20 20 20 28 6c exn))). (l
30f0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 et-values (((pid
3100: 72 65 73 20 65 78 69 74 74 79 70 65 20 65 78 69 res exittype exi
3110: 74 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 20 tstatus)...
3120: 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 (process-wait pi
3130: 64 20 23 74 29 29 29 0a 09 20 28 69 66 20 28 61 d #t))).. (if (a
3140: 6e 64 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 nd keys... (or
3150: 28 6e 6f 74 20 72 75 6e 2d 69 64 73 29 0a 09 09 (not run-ids)...
3160: 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 72 75 6e (null? run
3170: 2d 69 64 73 29 29 29 0a 09 20 20 20 20 20 28 6c -ids))).. (l
3180: 65 74 2a 20 28 28 72 75 6e 73 20 28 72 6d 74 3a et* ((runs (rmt:
3190: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
31a0: 20 6b 65 79 73 0a 09 09 09 09 09 09 72 75 6e 6e keys.......runn
31b0: 61 6d 65 20 0a 09 09 09 09 09 09 74 61 72 67 65 ame .......targe
31c0: 74 0a 09 09 09 09 09 09 23 66 20 3b 3b 20 6f 66 t.......#f ;; of
31d0: 66 73 65 74 0a 09 09 09 09 09 09 23 66 20 3b 3b fset.......#f ;;
31e0: 20 6c 69 6d 69 74 0a 09 09 09 09 09 09 23 66 20 limit.......#f
31f0: 3b 3b 20 66 69 65 6c 64 73 0a 09 09 09 09 09 09 ;; fields.......
3200: 30 20 20 3b 3b 20 6c 61 73 74 2d 75 70 64 61 74 0 ;; last-updat
3210: 65 0a 09 09 09 09 09 09 29 29 0a 09 09 20 20 20 e.......))...
3220: 20 28 68 65 61 64 65 72 20 28 64 62 3a 67 65 74 (header (db:get
3230: 2d 68 65 61 64 65 72 20 72 75 6e 73 29 29 0a 09 -header runs))..
3240: 09 20 20 20 20 28 72 6f 77 73 20 20 20 28 64 62 . (rows (db
3250: 3a 67 65 74 2d 72 6f 77 73 20 20 20 72 75 6e 73 :get-rows runs
3260: 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 64 ))... (run-id
3270: 73 2d 69 6e 20 28 6d 61 70 20 28 6c 61 6d 62 64 s-in (map (lambd
3280: 61 20 28 72 6f 77 29 0a 09 09 09 09 20 20 20 20 a (row).....
3290: 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 (db:get-value
32a0: 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 -by-header row h
32b0: 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 eader "id"))....
32c0: 09 20 20 20 20 20 72 6f 77 73 29 29 29 0a 09 20 . rows)))..
32d0: 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 2d (set! run-
32e0: 69 64 73 20 72 75 6e 2d 69 64 73 2d 69 6e 29 29 ids run-ids-in))
32f0: 29 0a 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 ).. ;; (print "T
3300: 43 4d 54 3a 20 70 69 64 72 65 73 3d 22 20 70 69 CMT: pidres=" pi
3310: 64 72 65 73 20 22 20 65 78 69 74 74 79 70 65 3d dres " exittype=
3320: 22 20 65 78 69 74 74 79 70 65 20 22 20 65 78 69 " exittype " exi
3330: 74 73 74 61 74 75 73 3d 22 20 65 78 69 74 73 74 tstatus=" exitst
3340: 61 74 75 73 20 22 20 72 75 6e 2d 69 64 73 3d 22 atus " run-ids="
3350: 20 72 75 6e 2d 69 64 73 29 0a 09 20 28 69 66 20 run-ids).. (if
3360: 28 65 71 3f 20 70 69 64 72 65 73 20 30 29 0a 09 (eq? pidres 0)..
3370: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 (begin..
3380: 20 20 20 20 28 69 66 20 6b 65 79 73 0a 20 20 20 (if keys.
3390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
33a0: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
33b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
33c0: 21 20 6c 61 73 74 2d 75 70 64 61 74 65 20 28 2d ! last-update (-
33d0: 20 28 63 61 72 20 28 75 70 64 61 74 65 2d 71 75 (car (update-qu
33e0: 65 75 65 2d 73 69 6e 63 65 20 74 65 73 74 64 61 eue-since testda
33f0: 74 73 20 72 75 6e 2d 69 64 73 20 6c 61 73 74 2d ts run-ids last-
3400: 75 70 64 61 74 65 20 74 73 6e 61 6d 65 20 74 61 update tsname ta
3410: 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6c 6f rget runname flo
3420: 77 69 64 20 23 66 20 64 65 6c 61 79 2d 66 6c 61 wid #f delay-fla
3430: 67 3a 20 23 74 29 29 20 35 29 29 0a 20 20 20 20 g: #t)) 5)).
3440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3450: 20 28 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 (process-queue
3460: 74 65 73 74 64 61 74 73 20 74 64 65 6c 61 79 20 testdats tdelay
3470: 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f))).
3480: 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 (thread-sle
3490: 65 70 21 20 33 29 0a 09 20 20 20 20 20 20 20 28 ep! 3).. (
34a0: 6c 6f 6f 70 29 29 29 29 29 0a 20 20 20 20 3b 3b loop))))). ;;
34b0: 20 74 68 65 20 6d 65 67 61 74 65 73 74 20 72 75 the megatest ru
34c0: 6e 6e 65 72 20 69 73 20 64 6f 6e 65 20 2d 20 6e nner is done - n
34d0: 6f 77 20 77 61 69 74 20 66 6f 72 20 61 6c 6c 20 ow wait for all
34e0: 70 72 6f 63 65 73 73 65 73 20 74 6f 20 62 65 20 processes to be
34f0: 43 4f 4d 50 4c 45 54 45 44 20 6f 72 20 4e 4f 20 COMPLETED or NO
3500: 50 72 6f 63 65 73 73 65 73 20 74 6f 20 62 65 20 Processes to be
3510: 52 55 4e 4e 49 4e 47 20 3e 20 31 20 6d 69 6e 75 RUNNING > 1 minu
3520: 74 65 0a 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 te. (let loop
3530: 20 28 29 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 (). (let*
3540: 28 28 6e 65 77 2d 6c 61 73 74 2d 75 70 64 61 74 ((new-last-updat
3550: 65 2d 69 6e 66 6f 20 28 75 70 64 61 74 65 2d 71 e-info (update-q
3560: 75 65 75 65 2d 73 69 6e 63 65 20 74 65 73 74 64 ueue-since testd
3570: 61 74 73 20 72 75 6e 2d 69 64 73 20 6c 61 73 74 ats run-ids last
3580: 2d 75 70 64 61 74 65 20 74 73 6e 61 6d 65 20 74 -update tsname t
3590: 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6c arget runname fl
35a0: 6f 77 69 64 20 23 66 20 64 65 6c 61 79 2d 66 6c owid #f delay-fl
35b0: 61 67 3a 20 23 74 29 29 0a 09 20 20 20 20 20 28 ag: #t)).. (
35c0: 73 74 69 6c 6c 2d 72 75 6e 6e 69 6e 67 20 20 20 still-running
35d0: 20 20 20 20 20 28 63 61 64 72 20 6e 65 77 2d 6c (cadr new-l
35e0: 61 73 74 2d 75 70 64 61 74 65 2d 69 6e 66 6f 29 ast-update-info)
35f0: 29 0a 09 20 20 20 20 20 28 6e 65 77 2d 6c 61 73 ).. (new-las
3600: 74 2d 75 70 64 61 74 65 20 20 20 20 20 20 28 2d t-update (-
3610: 20 28 63 61 72 20 6e 65 77 2d 6c 61 73 74 2d 75 (car new-last-u
3620: 70 64 61 74 65 2d 69 6e 66 6f 29 20 35 29 29 29 pdate-info) 5)))
3630: 0a 09 28 70 72 6f 63 65 73 73 2d 71 75 65 75 65 ..(process-queue
3640: 20 74 65 73 74 64 61 74 73 20 74 64 65 6c 61 79 testdats tdelay
3650: 20 23 66 29 0a 09 28 69 66 20 73 74 69 6c 6c 2d #f)..(if still-
3660: 72 75 6e 6e 69 6e 67 0a 09 20 20 20 20 28 62 65 running.. (be
3670: 67 69 6e 0a 09 20 20 20 20 20 20 28 70 72 69 6e gin.. (prin
3680: 74 20 22 54 43 4d 54 3a 20 54 65 73 74 73 20 73 t "TCMT: Tests s
3690: 74 69 6c 6c 20 72 75 6e 6e 69 6e 67 2c 20 6b 65 till running, ke
36a0: 65 70 20 77 61 74 63 68 69 6e 67 2e 2e 2e 22 29 ep watching...")
36b0: 0a 09 20 20 20 20 20 20 28 74 68 72 65 61 64 2d .. (thread-
36c0: 73 6c 65 65 70 21 20 33 29 0a 09 20 20 20 20 20 sleep! 3)..
36d0: 20 28 6c 6f 6f 70 29 29 29 29 29 0a 20 20 20 20 (loop))))).
36e0: 0a 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 . ;; (print "
36f0: 54 43 4d 54 3a 20 70 69 64 72 65 73 3d 22 20 70 TCMT: pidres=" p
3700: 69 64 72 65 73 20 22 20 65 78 69 74 74 79 70 65 idres " exittype
3710: 3d 22 20 65 78 69 74 74 79 70 65 20 22 20 65 78 =" exittype " ex
3720: 69 74 73 74 61 74 75 73 3d 22 20 65 78 69 74 73 itstatus=" exits
3730: 74 61 74 75 73 20 22 20 72 75 6e 2d 69 64 73 3d tatus " run-ids=
3740: 22 20 72 75 6e 2d 69 64 73 29 0a 20 20 20 20 28 " run-ids). (
3750: 70 72 69 6e 74 20 22 54 43 4d 54 3a 20 70 72 6f print "TCMT: pro
3760: 63 65 73 73 69 6e 67 20 61 6e 79 20 74 65 73 74 cessing any test
3770: 73 20 74 68 61 74 20 64 69 64 20 6e 6f 74 20 66 s that did not f
3780: 6f 72 6d 61 6c 6c 79 20 63 6f 6d 70 6c 65 74 65 ormally complete
3790: 2e 22 29 0a 20 20 20 20 28 75 70 64 61 74 65 2d ."). (update-
37a0: 71 75 65 75 65 2d 73 69 6e 63 65 20 74 65 73 74 queue-since test
37b0: 64 61 74 73 20 72 75 6e 2d 69 64 73 20 30 20 74 dats run-ids 0 t
37c0: 73 6e 61 6d 65 20 74 61 72 67 65 74 20 72 75 6e sname target run
37d0: 6e 61 6d 65 20 66 6c 6f 77 69 64 20 23 74 20 23 name flowid #t #
37e0: 66 20 64 65 6c 61 79 2d 66 6c 61 67 3a 20 23 66 f delay-flag: #f
37f0: 29 20 3b 3b 20 63 61 6c 6c 20 69 6e 20 66 6c 75 ) ;; call in flu
3800: 73 68 20 6d 6f 64 65 0a 20 20 20 20 28 70 72 6f sh mode. (pro
3810: 63 65 73 73 2d 71 75 65 75 65 20 74 65 73 74 64 cess-queue testd
3820: 61 74 73 20 30 20 23 74 29 0a 20 20 20 20 28 70 ats 0 #t). (p
3830: 72 69 6e 74 20 22 54 43 4d 54 3a 20 41 6c 6c 20 rint "TCMT: All
3840: 64 6f 6e 65 2e 22 29 0a 20 20 20 20 29 29 0a 0a done."). ))..
3850: 3b 3b 3b 3b 3b 20 29 0a 0a 3b 3b 20 28 74 72 61 ;;;;; )..;; (tra
3860: 63 65 20 70 72 69 6e 74 2d 63 68 61 6e 67 65 73 ce print-changes
3870: 2d 73 69 6e 63 65 29 0a 0a 3b 3b 20 28 69 66 20 -since)..;; (if
3880: 28 6e 6f 74 20 28 65 71 3f 20 70 69 64 72 65 73 (not (eq? pidres
3890: 20 30 29 29 09 20 20 3b 3b 20 28 6e 6f 74 20 65 0)). ;; (not e
38a0: 78 69 74 73 74 61 74 75 73 29 29 0a 3b 3b 20 09 xitstatus)).;; .
38b0: 20 20 28 62 65 67 69 6e 0a 3b 3b 20 09 20 20 20 (begin.;; .
38c0: 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 (thread-sleep!
38d0: 33 29 0a 3b 3b 20 09 20 20 20 20 28 6c 6f 6f 70 3).;; . (loop
38e0: 29 29 0a 3b 3b 20 09 20 20 28 70 72 69 6e 74 20 )).;; . (print
38f0: 22 50 72 6f 63 65 73 73 3a 20 6d 65 67 61 74 65 "Process: megate
3900: 73 74 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 st " (string-int
3910: 65 72 73 70 65 72 73 65 20 6f 72 69 67 61 72 67 ersperse origarg
3920: 73 20 22 20 22 29 20 22 20 69 73 20 64 6f 6e 65 s " ") " is done
3930: 2e 22 29 29 29 29 29 0a 0a 28 69 66 20 28 66 69 .")))))..(if (fi
3940: 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e 74 63 6d le-exists? ".tcm
3950: 74 72 63 22 29 0a 20 20 20 20 28 6c 6f 61 64 20 trc"). (load
3960: 22 2e 74 63 6d 74 72 63 22 29 29 0a 0a 28 64 65 ".tcmtrc"))..(de
3970: 66 69 6e 65 20 28 6d 61 69 6e 29 0a 20 20 28 6c fine (main). (l
3980: 65 74 2a 20 28 28 6d 74 2d 64 6f 6e 65 20 23 66 et* ((mt-done #f
3990: 29 0a 09 20 28 70 69 64 20 20 20 20 20 23 66 29 ).. (pid #f)
39a0: 0a 09 20 28 74 68 31 20 20 20 20 20 28 6d 61 6b .. (th1 (mak
39b0: 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 e-thread (lambda
39c0: 20 28 29 0a 09 09 09 09 20 28 70 72 69 6e 74 20 ()..... (print
39d0: 22 52 75 6e 6e 69 6e 67 20 6d 65 67 61 74 65 73 "Running megates
39e0: 74 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 t " (string-inte
39f0: 72 73 70 65 72 73 65 20 6f 72 69 67 61 72 67 73 rsperse origargs
3a00: 20 22 20 22 29 29 0a 09 09 09 09 20 28 73 65 74 " "))..... (set
3a10: 21 20 70 69 64 20 28 70 72 6f 63 65 73 73 2d 72 ! pid (process-r
3a20: 75 6e 20 22 6d 65 67 61 74 65 73 74 22 20 6f 72 un "megatest" or
3a30: 69 67 61 72 67 73 29 29 29 0a 09 09 09 20 20 20 igargs)))....
3a40: 20 20 20 20 22 4d 65 67 61 74 65 73 74 20 6a 6f "Megatest jo
3a50: 62 22 29 29 0a 09 20 28 74 68 32 20 20 20 20 20 b")).. (th2
3a60: 28 6d 61 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 (make-thread (la
3a70: 6d 62 64 61 20 28 29 0a 09 09 09 09 20 28 6d 6f mbda ()..... (mo
3a80: 6e 69 74 6f 72 20 70 69 64 29 29 0a 09 09 09 20 nitor pid))....
3a90: 20 20 20 20 20 20 22 4d 6f 6e 69 74 6f 72 20 6a "Monitor j
3aa0: 6f 62 22 29 29 29 0a 20 20 20 20 28 74 68 72 65 ob"))). (thre
3ab0: 61 64 2d 73 74 61 72 74 21 20 74 68 31 29 0a 20 ad-start! th1).
3ac0: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
3ad0: 21 20 31 29 20 3b 3b 20 67 69 76 65 20 74 68 65 ! 1) ;; give the
3ae0: 20 70 72 6f 63 65 73 73 20 74 69 6d 65 20 74 6f process time to
3af0: 20 67 65 74 20 67 6f 69 6e 67 0a 20 20 20 20 28 get going. (
3b00: 74 68 72 65 61 64 2d 73 74 61 72 74 21 20 74 68 thread-start! th
3b10: 32 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d 6a 2). (thread-j
3b20: 6f 69 6e 21 20 74 68 32 29 29 29 0a 0a 28 69 66 oin! th2)))..(if
3b30: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
3b40: 2d 74 63 2d 72 65 70 6c 22 29 0a 20 20 20 20 28 -tc-repl"). (
3b50: 72 65 70 6c 29 0a 20 20 20 20 28 6d 61 69 6e 29 repl). (main)
3b60: 29 0a 0a 3b 3b 20 28 70 72 6f 63 65 73 73 2d 77 )..;; (process-w
3b70: 61 69 74 29 0a 0a ait)..