Artifact
5f5e90a4867edc280f4f93929ad1505500d6eee6:
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: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0040: 20 6d 61 64 65 20 61 76 61 69 6c 61 62 6c 65 20 made available
0050: 75 6e 64 65 72 20 74 68 65 20 47 4e 55 20 47 50 under the GNU GP
0060: 4c 20 76 65 72 73 69 6f 6e 20 32 2e 30 20 6f 72 L version 2.0 or
0070: 0a 3b 3b 20 20 67 72 65 61 74 65 72 2e 20 53 65 .;; greater. Se
0080: 65 20 74 68 65 20 61 63 63 6f 6d 70 61 6e 79 69 e the accompanyi
0090: 6e 67 20 66 69 6c 65 20 43 4f 50 59 49 4e 47 20 ng file COPYING
00a0: 66 6f 72 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 for details..;;
00b0: 0a 3b 3b 20 20 54 68 69 73 20 70 72 6f 67 72 61 .;; This progra
00c0: 6d 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 m is distributed
00d0: 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 52 WITHOUT ANY WAR
00e0: 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 65 RANTY; without e
00f0: 76 65 6e 20 74 68 65 0a 3b 3b 20 20 69 6d 70 6c ven the.;; impl
0100: 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 20 ied warranty of
0110: 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 MERCHANTABILITY
0120: 6f 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 or FITNESS FOR A
0130: 20 50 41 52 54 49 43 55 4c 41 52 0a 3b 3b 20 20 PARTICULAR.;;
0140: 50 55 52 50 4f 53 45 2e 0a 3b 3b 0a 3b 3b 3d 3d PURPOSE..;;.;;==
0150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0170: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0180: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0190: 3d 3d 3d 3d 0a 3b 3b 0a 3b 3b 20 57 72 61 70 70 ====.;;.;; Wrapp
01a0: 65 72 20 74 6f 20 65 6e 61 62 6c 65 20 72 75 6e er to enable run
01b0: 6e 69 6e 67 20 4d 65 67 61 74 65 73 74 20 66 6c ning Megatest fl
01c0: 6f 77 73 20 75 6e 64 65 72 20 74 65 61 6d 63 69 ows under teamci
01d0: 74 79 0a 3b 3b 0a 3b 3b 20 20 31 2e 20 52 75 6e ty.;;.;; 1. Run
01e0: 20 74 68 65 20 6d 65 67 61 74 65 73 74 20 70 72 the megatest pr
01f0: 6f 63 65 73 73 20 61 6e 64 20 70 61 73 73 20 69 ocess and pass i
0200: 74 20 61 6c 6c 20 74 68 65 20 6e 65 65 64 65 64 t all the needed
0210: 20 70 61 72 61 6d 65 74 65 72 73 0a 3b 3b 20 20 parameters.;;
0220: 32 2e 20 45 76 65 72 79 20 66 69 76 65 20 73 65 2. Every five se
0230: 63 6f 6e 64 73 20 63 68 65 63 6b 20 66 6f 72 20 conds check for
0240: 73 74 61 74 65 2f 73 74 61 74 75 73 20 63 68 61 state/status cha
0250: 6e 67 65 73 20 61 6e 64 20 70 72 69 6e 74 20 74 nges and print t
0260: 68 65 20 69 6e 66 6f 0a 3b 3b 0a 0a 28 75 73 65 he info.;;..(use
0270: 20 73 72 66 69 2d 31 20 70 6f 73 69 78 20 73 72 srfi-1 posix sr
0280: 66 69 2d 36 39 20 73 72 66 69 2d 31 38 20 72 65 fi-69 srfi-18 re
0290: 67 65 78 20 64 65 66 73 74 72 75 63 74 29 0a 0a gex defstruct)..
02a0: 28 75 73 65 20 74 72 61 63 65 29 0a 3b 3b 20 28 (use trace).;; (
02b0: 74 72 61 63 65 2d 63 61 6c 6c 2d 73 69 74 65 73 trace-call-sites
02c0: 20 23 74 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 #t)..(declare (
02d0: 75 73 65 73 20 6d 61 72 67 73 29 29 0a 28 64 65 uses margs)).(de
02e0: 63 6c 61 72 65 20 28 75 73 65 73 20 72 6d 74 29 clare (uses rmt)
02f0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0300: 20 63 6f 6d 6d 6f 6e 29 29 0a 28 64 65 63 6c 61 common)).(decla
0310: 72 65 20 28 75 73 65 73 20 6d 65 67 61 74 65 73 re (uses megates
0320: 74 2d 76 65 72 73 69 6f 6e 29 29 0a 0a 28 69 6e t-version))..(in
0330: 63 6c 75 64 65 20 22 6d 65 67 61 74 65 73 74 2d clude "megatest-
0340: 66 6f 73 73 69 6c 2d 68 61 73 68 2e 73 63 6d 22 fossil-hash.scm"
0350: 29 0a 28 69 6e 63 6c 75 64 65 20 22 64 62 5f 72 ).(include "db_r
0360: 65 63 6f 72 64 73 2e 73 63 6d 22 29 0a 0a 28 64 ecords.scm")..(d
0370: 65 66 69 6e 65 20 6f 72 69 67 61 72 67 73 20 28 efine origargs (
0380: 63 64 72 20 28 61 72 67 76 29 29 29 0a 28 64 65 cdr (argv))).(de
0390: 66 69 6e 65 20 72 65 6d 61 72 67 73 20 28 61 72 fine remargs (ar
03a0: 67 73 3a 67 65 74 2d 61 72 67 73 0a 09 09 20 28 gs:get-args... (
03b0: 61 72 67 76 29 0a 09 09 20 60 28 20 22 2d 74 61 argv)... `( "-ta
03c0: 72 67 65 74 22 0a 09 09 20 20 20 20 22 2d 72 65 rget"... "-re
03d0: 71 74 61 72 67 22 0a 09 09 20 20 20 20 22 2d 72 qtarg"... "-r
03e0: 75 6e 6e 61 6d 65 22 0a 09 09 20 20 20 20 22 2d unname"... "-
03f0: 64 65 6c 61 79 22 20 20 20 3b 3b 20 68 6f 77 20 delay" ;; how
0400: 6c 6f 6e 67 20 74 6f 20 77 61 69 74 20 66 6f 72 long to wait for
0410: 20 75 6e 65 78 70 65 63 74 65 64 20 63 68 61 6e unexpected chan
0420: 67 65 73 20 74 6f 20 0a 09 09 20 20 20 20 29 0a ges to ... ).
0430: 09 09 20 60 28 22 2d 74 63 2d 72 65 70 6c 22 0a .. `("-tc-repl".
0440: 09 09 20 20 20 29 0a 09 09 20 61 72 67 73 3a 61 .. )... args:a
0450: 72 67 2d 68 61 73 68 0a 09 09 20 30 29 29 0a 0a rg-hash... 0))..
0460: 28 64 65 66 73 74 72 75 63 74 20 74 65 73 74 64 (defstruct testd
0470: 61 74 0a 20 20 28 74 63 2d 74 79 70 65 20 23 66 at. (tc-type #f
0480: 29 0a 20 20 28 73 74 61 74 65 20 20 20 23 66 29 ). (state #f)
0490: 0a 20 20 28 73 74 61 74 75 73 20 20 23 66 29 0a . (status #f).
04a0: 20 20 28 6f 76 65 72 61 6c 6c 20 23 66 29 0a 20 (overall #f).
04b0: 20 28 66 6c 6f 77 69 64 20 20 23 66 29 0a 20 20 (flowid #f).
04c0: 74 63 74 6e 61 6d 65 0a 20 20 74 6e 61 6d 65 0a tctname. tname.
04d0: 20 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 23 66 (event-time #f
04e0: 29 0a 20 20 64 65 74 61 69 6c 73 0a 20 20 63 6f ). details. co
04f0: 6d 6d 65 6e 74 0a 20 20 64 75 72 61 74 69 6f 6e mment. duration
0500: 0a 20 20 28 73 74 61 72 74 2d 70 72 69 6e 74 65 . (start-printe
0510: 64 20 23 66 29 0a 20 20 28 65 6e 64 2d 70 72 69 d #f). (end-pri
0520: 6e 74 65 64 20 20 20 23 66 29 29 0a 0a 3b 3b 3d nted #f))..;;=
0530: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0540: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0550: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0570: 3d 3d 3d 3d 3d 0a 3b 3b 20 47 4c 4f 42 41 4c 53 =====.;; GLOBALS
0580: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
05c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 47 6f =========..;; Go
05d0: 74 74 61 20 68 61 76 65 20 61 20 67 6c 6f 62 61 tta have a globa
05e0: 6c 3f 20 53 74 61 73 68 20 69 74 20 69 6e 20 74 l? Stash it in t
05f0: 68 65 20 2a 67 6c 6f 62 61 6c 2a 20 68 61 73 68 he *global* hash
0600: 20 74 61 62 6c 65 2e 0a 3b 3b 0a 28 64 65 66 69 table..;;.(defi
0610: 6e 65 20 2a 67 6c 6f 62 61 6c 2a 20 28 6d 61 6b ne *global* (mak
0620: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 0a e-hash-table))..
0630: 28 64 65 66 69 6e 65 20 28 74 63 6d 74 3a 70 72 (define (tcmt:pr
0640: 69 6e 74 20 74 64 61 74 20 66 6c 75 73 68 2d 6d int tdat flush-m
0650: 6f 64 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 ode). (let* ((c
0660: 6f 6d 6d 65 6e 74 20 20 28 69 66 20 28 74 65 73 omment (if (tes
0670: 74 64 61 74 2d 63 6f 6d 6d 65 6e 74 20 74 64 61 tdat-comment tda
0680: 74 29 0a 09 09 20 20 20 20 20 20 20 28 63 6f 6e t)... (con
0690: 63 20 22 20 6d 65 73 73 61 67 65 3d 27 22 20 28 c " message='" (
06a0: 74 65 73 74 64 61 74 2d 63 6f 6d 6d 65 6e 74 20 testdat-comment
06b0: 74 64 61 74 29 20 22 27 22 29 0a 09 09 20 20 20 tdat) "'")...
06c0: 20 20 20 20 22 22 29 29 0a 09 20 28 64 65 74 61 "")).. (deta
06d0: 69 6c 73 20 20 28 69 66 20 28 74 65 73 74 64 61 ils (if (testda
06e0: 74 2d 64 65 74 61 69 6c 73 20 74 64 61 74 29 0a t-details tdat).
06f0: 09 09 20 20 20 20 20 20 20 28 63 6f 6e 63 20 22 .. (conc "
0700: 20 64 65 74 61 69 6c 73 3d 27 22 20 28 74 65 73 details='" (tes
0710: 74 64 61 74 2d 64 65 74 61 69 6c 73 20 74 64 61 tdat-details tda
0720: 74 29 20 22 27 22 29 0a 09 09 20 20 20 20 20 20 t) "'")...
0730: 20 22 22 29 29 0a 09 20 28 66 6c 6f 77 69 64 20 "")).. (flowid
0740: 20 20 28 63 6f 6e 63 20 22 20 66 6c 6f 77 49 64 (conc " flowId
0750: 3d 27 22 20 28 74 65 73 74 64 61 74 2d 66 6c 6f ='" (testdat-flo
0760: 77 69 64 20 20 20 74 64 61 74 29 20 22 27 22 29 wid tdat) "'")
0770: 29 0a 09 20 28 64 75 72 61 74 69 6f 6e 20 28 63 ).. (duration (c
0780: 6f 6e 63 20 22 20 64 75 72 61 74 69 6f 6e 3d 27 onc " duration='
0790: 22 20 28 2a 20 31 65 33 20 28 74 65 73 74 64 61 " (* 1e3 (testda
07a0: 74 2d 64 75 72 61 74 69 6f 6e 20 74 64 61 74 29 t-duration tdat)
07b0: 29 20 22 27 22 29 29 0a 09 20 28 74 63 6e 61 6d ) "'")).. (tcnam
07c0: 65 20 20 20 28 63 6f 6e 63 20 22 20 6e 61 6d 65 e (conc " name
07d0: 3d 27 22 20 28 74 65 73 74 64 61 74 2d 74 63 74 ='" (testdat-tct
07e0: 6e 61 6d 65 20 20 74 64 61 74 29 20 22 27 22 29 name tdat) "'")
07f0: 29 0a 09 20 28 73 74 61 74 65 20 20 20 20 28 73 ).. (state (s
0800: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 74 tring->symbol (t
0810: 65 73 74 64 61 74 2d 73 74 61 74 65 20 74 64 61 estdat-state tda
0820: 74 29 29 29 0a 09 20 28 73 74 61 74 75 73 20 20 t))).. (status
0830: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
0840: 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 75 73 (testdat-status
0850: 20 74 64 61 74 29 29 29 0a 09 20 28 73 74 61 72 tdat))).. (star
0860: 74 70 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 tp (testdat-st
0870: 61 72 74 2d 70 72 69 6e 74 65 64 20 74 64 61 74 art-printed tdat
0880: 29 29 0a 09 20 28 65 6e 64 70 20 20 20 20 20 28 )).. (endp (
0890: 74 65 73 74 64 61 74 2d 65 6e 64 2d 70 72 69 6e testdat-end-prin
08a0: 74 65 64 20 20 20 74 64 61 74 29 29 0a 09 20 28 ted tdat)).. (
08b0: 65 74 69 6d 65 20 20 20 20 28 74 65 73 74 64 61 etime (testda
08c0: 74 2d 65 76 65 6e 74 2d 74 69 6d 65 20 20 20 20 t-event-time
08d0: 74 64 61 74 29 29 0a 09 20 28 6f 76 65 72 61 6c tdat)).. (overal
08e0: 6c 20 20 28 63 61 73 65 20 73 74 61 74 65 0a 09 l (case state..
08f0: 09 20 20 20 20 20 28 28 52 55 4e 4e 49 4e 47 29 . ((RUNNING)
0900: 20 20 20 73 74 61 74 65 29 0a 09 09 20 20 20 20 state)...
0910: 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 20 73 74 ((COMPLETED) st
0920: 61 74 65 29 0a 09 09 20 20 20 20 20 28 65 6c 73 ate)... (els
0930: 65 20 27 55 4e 4b 29 29 29 0a 09 20 28 74 73 74 e 'UNK))).. (tst
0940: 6d 70 20 20 20 20 28 63 6f 6e 63 20 22 20 74 69 mp (conc " ti
0950: 6d 65 73 74 61 6d 70 3d 27 22 20 28 74 69 6d 65 mestamp='" (time
0960: 2d 3e 73 74 72 69 6e 67 20 28 73 65 63 6f 6e 64 ->string (second
0970: 73 2d 3e 6c 6f 63 61 6c 2d 74 69 6d 65 20 65 74 s->local-time et
0980: 69 6d 65 29 20 22 25 46 54 25 54 2e 30 30 30 22 ime) "%FT%T.000"
0990: 29 20 22 27 22 29 29 29 0a 20 20 20 20 28 63 61 ) "'"))). (ca
09a0: 73 65 20 6f 76 65 72 61 6c 6c 0a 20 20 20 20 20 se overall.
09b0: 20 28 28 52 55 4e 4e 49 4e 47 29 0a 20 20 20 20 ((RUNNING).
09c0: 20 20 20 28 69 66 20 28 6e 6f 74 20 73 74 61 72 (if (not star
09d0: 74 70 29 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 tp).. (begin..
09e0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 (print "##t
09f0: 65 61 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 eamcity[testStar
0a00: 74 65 64 20 22 20 20 74 63 6e 61 6d 65 20 66 6c ted " tcname fl
0a10: 6f 77 69 64 20 74 73 74 6d 70 20 22 5d 22 29 0a owid tstmp "]").
0a20: 09 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 73 . (testdat-s
0a30: 74 61 72 74 2d 70 72 69 6e 74 65 64 2d 73 65 74 tart-printed-set
0a40: 21 20 74 64 61 74 20 23 74 29 29 29 29 0a 20 20 ! tdat #t)))).
0a50: 20 20 20 20 28 28 43 4f 4d 50 4c 45 54 45 44 29 ((COMPLETED)
0a60: 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 . (if (not
0a70: 20 73 74 61 72 74 70 29 20 3b 3b 20 73 74 61 72 startp) ;; star
0a80: 74 20 73 74 61 6e 7a 61 20 6e 65 76 65 72 20 70 t stanza never p
0a90: 72 69 6e 74 65 64 0a 09 20 20 20 28 62 65 67 69 rinted.. (begi
0aa0: 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 20 22 n.. (print "
0ab0: 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 53 ##teamcity[testS
0ac0: 74 61 72 74 65 64 20 22 20 74 63 6e 61 6d 65 20 tarted " tcname
0ad0: 66 6c 6f 77 69 64 20 74 73 74 6d 70 20 22 5d 22 flowid tstmp "]"
0ae0: 29 0a 09 20 20 20 20 20 28 74 65 73 74 64 61 74 ).. (testdat
0af0: 2d 73 74 61 72 74 2d 70 72 69 6e 74 65 64 2d 73 -start-printed-s
0b00: 65 74 21 20 74 64 61 74 20 23 74 29 29 29 0a 20 et! tdat #t))).
0b10: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 65 (if (not e
0b20: 6e 64 70 29 0a 09 20 20 20 28 62 65 67 69 6e 0a ndp).. (begin.
0b30: 09 20 20 20 20 20 28 69 66 20 28 6d 65 6d 62 65 . (if (membe
0b40: 72 20 73 74 61 74 75 73 20 27 28 50 41 53 53 20 r status '(PASS
0b50: 57 41 52 4e 20 53 4b 49 50 20 57 41 49 56 45 44 WARN SKIP WAIVED
0b60: 29 29 0a 09 09 20 28 70 72 69 6e 74 20 22 23 23 ))... (print "##
0b70: 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 69 6e teamcity[testFin
0b80: 69 73 68 65 64 22 20 74 63 6e 61 6d 65 20 66 6c ished" tcname fl
0b90: 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 64 65 74 owid comment det
0ba0: 61 69 6c 73 20 64 75 72 61 74 69 6f 6e 20 22 5d ails duration "]
0bb0: 22 29 0a 09 09 20 28 70 72 69 6e 74 20 22 23 23 ")... (print "##
0bc0: 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 61 69 teamcity[testFai
0bd0: 6c 65 64 20 20 22 20 74 63 6e 61 6d 65 20 66 6c led " tcname fl
0be0: 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 64 65 74 owid comment det
0bf0: 61 69 6c 73 20 22 5d 22 29 29 0a 09 20 20 20 20 ails "]"))..
0c00: 20 28 74 65 73 74 64 61 74 2d 65 6e 64 2d 70 72 (testdat-end-pr
0c10: 69 6e 74 65 64 2d 73 65 74 21 20 74 64 61 74 20 inted-set! tdat
0c20: 23 74 29 29 29 29 0a 20 20 20 20 20 20 28 65 6c #t)))). (el
0c30: 73 65 0a 20 20 20 20 20 20 20 28 69 66 20 66 6c se. (if fl
0c40: 75 73 68 2d 6d 6f 64 65 0a 09 20 20 20 28 62 65 ush-mode.. (be
0c50: 67 69 6e 0a 09 20 20 20 20 20 28 69 66 20 28 6e gin.. (if (n
0c60: 6f 74 20 73 74 61 72 74 70 29 0a 09 09 20 28 62 ot startp)... (b
0c70: 65 67 69 6e 0a 09 09 20 20 20 28 70 72 69 6e 74 egin... (print
0c80: 20 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 "##teamcity[tes
0c90: 74 53 74 61 72 74 65 64 20 22 20 74 63 6e 61 6d tStarted " tcnam
0ca0: 65 20 66 6c 6f 77 69 64 20 74 73 74 6d 70 20 22 e flowid tstmp "
0cb0: 5d 22 29 0a 09 09 20 20 20 28 74 65 73 74 64 61 ]")... (testda
0cc0: 74 2d 73 74 61 72 74 2d 70 72 69 6e 74 65 64 2d t-start-printed-
0cd0: 73 65 74 21 20 74 64 61 74 20 23 74 29 29 29 0a set! tdat #t))).
0ce0: 09 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 65 . (if (not e
0cf0: 6e 64 70 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 ndp)... (begin..
0d00: 09 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 . (print "##te
0d10: 61 6d 63 69 74 79 5b 74 65 73 74 46 61 69 6c 65 amcity[testFaile
0d20: 64 20 20 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 d " tcname flow
0d30: 69 64 20 63 6f 6d 6d 65 6e 74 20 64 65 74 61 69 id comment detai
0d40: 6c 73 20 22 5d 22 29 0a 09 09 20 20 20 28 74 65 ls "]")... (te
0d50: 73 74 64 61 74 2d 65 6e 64 2d 70 72 69 6e 74 65 stdat-end-printe
0d60: 64 2d 73 65 74 21 20 74 64 61 74 20 23 74 29 29 d-set! tdat #t))
0d70: 29 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 70 72 ))))). ;; (pr
0d80: 69 6e 74 20 22 45 52 52 4f 52 3a 20 74 63 2d 74 int "ERROR: tc-t
0d90: 79 70 65 20 5c 22 22 20 28 74 65 73 74 64 61 74 ype \"" (testdat
0da0: 2d 74 63 2d 74 79 70 65 20 74 64 61 74 29 20 22 -tc-type tdat) "
0db0: 5c 22 20 6e 6f 74 20 72 65 63 6f 67 6e 69 73 65 \" not recognise
0dc0: 64 20 66 6f 72 20 22 20 74 63 6e 61 6d 65 29 29 d for " tcname))
0dd0: 29 0a 20 20 20 20 28 66 6c 75 73 68 2d 6f 75 74 ). (flush-out
0de0: 70 75 74 29 29 29 0a 0a 3b 3b 20 3b 3b 20 72 65 put)))..;; ;; re
0df0: 74 75 72 6e 73 20 76 61 6c 75 65 73 3a 20 66 6c turns values: fl
0e00: 61 67 20 6e 65 77 6c 73 74 0a 3b 3b 20 28 64 65 ag newlst.;; (de
0e10: 66 69 6e 65 20 28 72 65 6d 6f 76 65 2d 64 75 70 fine (remove-dup
0e20: 6c 69 63 61 74 65 2d 63 6f 6d 70 6c 65 74 65 64 licate-completed
0e30: 20 20 74 64 61 74 73 29 0a 3b 3b 20 20 20 28 6c tdats).;; (l
0e40: 65 74 2a 20 28 28 66 6c 61 67 20 20 20 20 20 20 et* ((flag
0e50: 20 23 66 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 #f).;;
0e60: 20 28 73 74 61 74 65 20 20 20 20 20 20 28 74 65 (state (te
0e70: 73 74 64 61 74 2d 73 74 61 74 65 20 20 20 20 20 stdat-state
0e80: 20 74 64 61 74 29 29 0a 3b 3b 20 20 20 20 20 20 tdat)).;;
0e90: 20 20 20 20 28 73 74 61 74 75 73 20 20 20 20 20 (status
0ea0: 28 74 65 73 74 64 61 74 2d 73 74 61 74 75 73 20 (testdat-status
0eb0: 20 20 20 20 74 64 61 74 29 29 0a 3b 3b 20 20 20 tdat)).;;
0ec0: 20 20 20 20 20 20 20 28 65 76 65 6e 74 2d 74 69 (event-ti
0ed0: 6d 65 20 28 74 65 73 74 64 61 74 2d 65 76 65 6e me (testdat-even
0ee0: 74 2d 74 69 6d 65 20 74 64 61 74 29 29 0a 3b 3b t-time tdat)).;;
0ef0: 20 20 20 20 20 20 20 20 20 20 28 74 6e 61 6d 65 (tname
0f00: 20 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 74 (testdat-t
0f10: 6e 61 6d 65 20 20 20 20 20 20 74 64 61 74 29 29 name tdat))
0f20: 29 0a 3b 3b 20 20 20 20 20 28 6c 65 74 20 6c 6f ).;; (let lo
0f30: 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 74 64 op ((hed (car td
0f40: 61 74 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 ats)).;;
0f50: 20 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 (tal (cd
0f60: 72 20 74 64 61 74 73 29 29 0a 3b 3b 20 20 20 20 r tdats)).;;
0f70: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 (new
0f80: 20 27 28 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 '())).;;
0f90: 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f (if (and (equal?
0fa0: 20 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 state "COMPLETE
0fb0: 44 22 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 D").;;
0fc0: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 74 6e (equal? tn
0fd0: 61 6d 65 20 28 74 65 73 74 64 61 74 2d 74 6e 61 ame (testdat-tna
0fe0: 6d 65 20 68 65 64 29 29 0a 3b 3b 20 20 20 20 20 me hed)).;;
0ff0: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa
1000: 6c 3f 20 73 74 61 74 65 20 28 74 65 73 74 64 61 l? state (testda
1010: 74 2d 73 74 61 74 65 20 68 65 64 29 29 29 20 3b t-state hed))) ;
1020: 3b 20 77 65 20 68 61 76 65 20 61 20 64 75 70 6c ; we have a dupl
1030: 69 63 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 20 icate COMPLETED
1040: 63 61 6c 6c 0a 3b 3b 20 20 20 20 20 20 20 20 20 call.;;
1050: 20 20 28 62 65 67 69 6e 0a 3b 3b 20 20 20 20 20 (begin.;;
1060: 20 20 20 20 20 20 20 20 28 73 65 74 21 20 66 6c (set! fl
1070: 61 67 20 23 74 29 20 3b 3b 20 41 20 63 68 61 6e ag #t) ;; A chan
1080: 67 65 64 20 63 6f 6d 70 6c 65 74 65 64 0a 20 20 ged completed.
1090: 20 20 20 20 20 20 20 20 20 20 0a 3b 3b 20 70 72 .;; pr
10a0: 6f 63 65 73 73 20 74 68 65 20 71 75 65 75 65 20 ocess the queue
10b0: 6f 66 20 74 65 73 74 73 20 67 61 74 68 65 72 65 of tests gathere
10c0: 64 20 73 6f 20 66 61 72 2e 20 4c 69 73 74 20 69 d so far. List i
10d0: 6e 63 6c 75 64 65 73 20 6f 6e 65 20 65 6e 74 72 ncludes one entr
10e0: 79 20 66 6f 72 20 65 76 65 72 79 20 74 65 73 74 y for every test
10f0: 20 73 6f 20 66 61 72 20 73 65 65 6e 0a 3b 3b 20 so far seen.;;
1100: 74 68 65 20 6c 61 73 74 20 72 65 63 6f 72 64 20 the last record
1110: 66 6f 72 20 61 20 74 65 73 74 20 69 73 20 70 72 for a test is pr
1120: 65 73 65 72 76 65 64 2e 20 49 74 65 6d 73 20 61 eserved. Items a
1130: 72 65 20 6f 6e 6c 79 20 72 65 6d 6f 76 65 64 20 re only removed
1140: 66 72 6f 6d 20 74 68 65 20 6c 69 73 74 20 69 66 from the list if
1150: 20 6f 76 65 72 20 31 35 20 73 65 63 6f 6e 64 73 over 15 seconds
1160: 0a 3b 3b 20 68 61 76 65 20 70 61 73 73 65 64 20 .;; have passed
1170: 73 69 6e 63 65 20 69 74 20 68 61 70 70 65 6e 65 since it happene
1180: 64 2e 20 54 68 69 73 20 61 6c 6c 6f 77 73 20 66 d. This allows f
1190: 6f 72 20 63 6f 6d 70 72 65 73 73 69 6f 6e 20 6f or compression o
11a0: 66 20 43 4f 4d 50 4c 45 54 45 44 2f 46 41 49 4c f COMPLETED/FAIL
11b0: 20 66 6f 6c 6c 6f 77 65 64 20 62 79 20 73 6f 6d followed by som
11c0: 65 20 6f 74 68 65 72 0a 3b 3b 20 73 74 61 74 65 e other.;; state
11d0: 2f 73 74 61 74 75 73 0a 3b 3b 0a 28 64 65 66 69 /status.;;.(defi
11e0: 6e 65 20 28 70 72 6f 63 65 73 73 2d 71 75 65 75 ne (process-queu
11f0: 65 20 64 61 74 61 20 61 67 65 20 66 6c 75 73 68 e data age flush
1200: 2d 6d 6f 64 65 29 0a 20 20 3b 3b 20 68 65 72 65 -mode). ;; here
1210: 20 77 65 20 70 72 6f 63 65 73 73 20 74 71 75 65 we process tque
1220: 75 65 20 61 6e 64 20 67 61 74 68 65 72 20 74 68 ue and gather th
1230: 6f 73 65 20 6f 76 65 72 20 31 35 20 73 65 63 6f ose over 15 seco
1240: 6e 64 73 20 28 63 6f 6e 66 69 67 75 72 61 62 6c nds (configurabl
1250: 65 3f 29 20 6f 6c 64 0a 20 20 28 6c 65 74 2a 20 e?) old. (let*
1260: 28 28 70 72 69 6e 74 2d 74 69 6d 65 20 28 2d 20 ((print-time (-
1270: 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 (current-seconds
1280: 29 20 61 67 65 29 29 20 3b 3b 20 70 72 69 6e 74 ) age)) ;; print
1290: 20 73 74 75 66 66 20 6f 76 65 72 20 31 35 20 73 stuff over 15 s
12a0: 65 63 6f 6e 64 73 20 6f 6c 64 0a 20 20 20 20 20 econds old.
12b0: 20 20 20 20 28 74 71 75 65 75 65 2d 72 61 77 20 (tqueue-raw
12c0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
12d0: 64 65 66 61 75 6c 74 20 64 61 74 61 20 27 74 71 default data 'tq
12e0: 75 65 75 65 20 27 28 29 29 29 0a 20 20 20 20 20 ueue '())).
12f0: 20 20 20 20 28 74 71 75 65 75 65 20 20 20 20 20 (tqueue
1300: 28 72 65 76 65 72 73 65 20 28 64 65 6c 65 74 65 (reverse (delete
1310: 2d 64 75 70 6c 69 63 61 74 65 73 20 74 71 75 65 -duplicates tque
1320: 75 65 2d 72 61 77 20 20 20 20 20 3b 3b 20 52 45 ue-raw ;; RE
1330: 4d 4f 56 45 20 64 75 70 6c 69 63 61 74 65 73 20 MOVE duplicates
1340: 62 79 20 74 65 73 74 6e 61 6d 65 20 61 6e 64 20 by testname and
1350: 73 74 61 74 65 0a 20 20 20 20 20 20 20 20 20 20 state.
1360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1380: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
1390: 61 20 62 29 0a 20 20 20 20 20 20 20 20 20 20 20 a b).
13a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13c0: 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 65 71 (and (eq
13d0: 75 61 6c 3f 20 28 74 65 73 74 64 61 74 2d 74 6e ual? (testdat-tn
13e0: 61 6d 65 20 61 29 28 74 65 73 74 64 61 74 2d 74 ame a)(testdat-t
13f0: 6e 61 6d 65 20 62 29 29 20 20 20 20 20 20 20 20 name b))
1400: 3b 3b 20 6e 65 65 64 20 6f 6c 64 65 73 74 20 74 ;; need oldest t
1410: 6f 20 6e 65 77 65 73 74 0a 20 20 20 20 20 20 20 o newest.
1420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1450: 20 28 65 71 75 61 6c 3f 20 28 74 65 73 74 64 61 (equal? (testda
1460: 74 2d 73 74 61 74 65 20 61 29 20 28 74 65 73 74 t-state a) (test
1470: 64 61 74 2d 73 74 61 74 65 20 62 29 29 29 29 29 dat-state b)))))
1480: 29 29 29 20 3b 3b 20 22 43 4f 4d 50 4c 45 54 45 ))) ;; "COMPLETE
1490: 44 22 29 0a 20 20 20 20 3b 3b 20 28 65 71 75 61 D"). ;; (equa
14a0: 6c 3f 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 l? (testdat-stat
14b0: 65 20 62 29 20 22 43 4f 4d 50 4c 45 54 45 44 22 e b) "COMPLETED"
14c0: 29 29 29 29 29 29 29 0a 20 20 20 20 28 69 66 20 ))))))). (if
14d0: 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 71 75 65 (not (null? tque
14e0: 75 65 29 29 0a 20 20 20 20 20 20 20 20 28 68 61 ue)). (ha
14f0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 0a 20 20 sh-table-set!.
1500: 20 20 20 20 20 20 20 64 61 74 61 0a 20 20 20 20 data.
1510: 20 20 20 20 20 27 74 71 75 65 75 65 0a 20 20 20 'tqueue.
1520: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
1530: 28 28 68 65 64 20 28 63 61 72 20 74 71 75 65 75 ((hed (car tqueu
1540: 65 29 29 20 3b 3b 20 62 79 20 74 68 69 73 20 70 e)) ;; by this p
1550: 6f 69 6e 74 20 61 6c 6c 20 64 75 70 6c 69 63 61 oint all duplica
1560: 74 65 73 20 62 79 20 73 74 61 74 65 20 43 4f 4d tes by state COM
1570: 50 4c 45 54 45 44 20 61 72 65 20 72 65 6d 6f 76 PLETED are remov
1580: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ed.
1590: 20 20 20 20 20 20 20 28 74 61 6c 20 28 63 64 72 (tal (cdr
15a0: 20 74 71 75 65 75 65 29 29 0a 20 20 20 20 20 20 tqueue)).
15b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
15c0: 65 6d 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 em '())).
15d0: 20 20 20 20 28 69 66 20 28 3e 20 70 72 69 6e 74 (if (> print
15e0: 2d 74 69 6d 65 20 28 74 65 73 74 64 61 74 2d 65 -time (testdat-e
15f0: 76 65 6e 74 2d 74 69 6d 65 20 68 65 64 29 29 20 vent-time hed))
1600: 3b 3b 20 65 76 65 6e 74 20 68 61 70 70 65 6e 65 ;; event happene
1610: 64 20 6f 76 65 72 20 31 35 20 73 65 63 6f 6e 64 d over 15 second
1620: 73 20 61 67 6f 0a 20 20 20 20 20 20 20 20 20 20 s ago.
1630: 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 (begin.
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 63 (tc
1650: 6d 74 3a 70 72 69 6e 74 20 68 65 64 20 66 6c 75 mt:print hed flu
1660: 73 68 2d 6d 6f 64 65 29 0a 20 20 20 20 20 20 20 sh-mode).
1670: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
1680: 75 6c 6c 3f 20 74 61 6c 29 0a 20 20 20 20 20 20 ull? tal).
1690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
16a0: 65 6d 20 3b 3b 20 72 65 74 75 72 6e 20 72 65 6d em ;; return rem
16b0: 20 74 6f 20 62 65 20 70 72 6f 63 65 73 73 65 64 to be processed
16c0: 20 69 6e 20 74 68 65 20 66 75 74 75 72 65 0a 20 in the future.
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e0: 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 (loop (car t
16f0: 61 6c 29 28 63 64 72 20 74 61 6c 29 20 72 65 6d al)(cdr tal) rem
1700: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1710: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
1720: 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
1730: 20 20 20 20 20 20 28 63 6f 6e 73 20 68 65 64 20 (cons hed
1740: 72 65 6d 29 20 3b 3b 20 72 65 74 75 72 6e 20 72 rem) ;; return r
1750: 65 6d 20 2b 20 68 65 64 20 66 6f 72 20 66 75 74 em + hed for fut
1760: 75 72 65 20 70 72 6f 63 65 73 73 69 6e 67 0a 20 ure processing.
1770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1780: 20 20 28 6c 6f 6f 70 20 28 63 61 72 20 74 61 6c (loop (car tal
1790: 29 28 63 64 72 20 74 61 6c 29 28 63 6f 6e 73 20 )(cdr tal)(cons
17a0: 68 65 64 20 72 65 6d 29 29 29 29 29 29 29 29 29 hed rem)))))))))
17b0: 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
17c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
17d0: 20 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 ##teamcity[test
17e0: 53 74 61 72 74 65 64 20 6e 61 6d 65 3d 27 73 75 Started name='su
17f0: 69 74 65 2e 74 65 73 74 4e 61 6d 65 27 5d 0a 3b ite.testName'].;
1800: 3b 20 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 ; ##teamcity[tes
1810: 74 53 74 64 4f 75 74 20 6e 61 6d 65 3d 27 73 75 tStdOut name='su
1820: 69 74 65 2e 74 65 73 74 4e 61 6d 65 27 20 6f 75 ite.testName' ou
1830: 74 3d 27 74 65 78 74 27 5d 0a 3b 3b 20 23 23 74 t='text'].;; ##t
1840: 65 61 6d 63 69 74 79 5b 74 65 73 74 53 74 64 45 eamcity[testStdE
1850: 72 72 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 rr name='suite.t
1860: 65 73 74 4e 61 6d 65 27 20 6f 75 74 3d 27 65 72 estName' out='er
1870: 72 6f 72 20 74 65 78 74 27 5d 0a 3b 3b 20 23 23 ror text'].;; ##
1880: 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 61 69 teamcity[testFai
1890: 6c 65 64 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e led name='suite.
18a0: 74 65 73 74 4e 61 6d 65 27 20 6d 65 73 73 61 67 testName' messag
18b0: 65 3d 27 66 61 69 6c 75 72 65 20 6d 65 73 73 61 e='failure messa
18c0: 67 65 27 20 64 65 74 61 69 6c 73 3d 27 6d 65 73 ge' details='mes
18d0: 73 61 67 65 20 61 6e 64 20 73 74 61 63 6b 20 74 sage and stack t
18e0: 72 61 63 65 27 5d 0a 3b 3b 20 23 23 74 65 61 6d race'].;; ##team
18f0: 63 69 74 79 5b 74 65 73 74 46 69 6e 69 73 68 65 city[testFinishe
1900: 64 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 d name='suite.te
1910: 73 74 4e 61 6d 65 27 20 64 75 72 61 74 69 6f 6e stName' duration
1920: 3d 27 35 30 27 5d 0a 3b 3b 20 0a 3b 3b 20 66 6c ='50'].;; .;; fl
1930: 75 73 68 3b 20 23 66 2c 20 6e 6f 72 6d 61 6c 20 ush; #f, normal
1940: 63 61 6c 6c 2e 20 23 74 2c 20 6c 61 73 74 20 63 call. #t, last c
1950: 61 6c 6c 2c 20 70 72 69 6e 74 20 6f 75 74 20 73 all, print out s
1960: 6f 6d 65 74 68 69 6e 67 20 66 6f 72 20 4e 4f 54 omething for NOT
1970: 5f 53 54 41 52 54 45 44 2c 20 65 74 63 2e 0a 3b _STARTED, etc..;
1980: 3b 0a 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 28 62 65 ;..;;;;;;; (be
1990: 67 69 6e 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 gin.;;;;;;;
19a0: 28 63 61 73 65 20 28 73 74 72 69 6e 67 2d 3e 73 (case (string->s
19b0: 79 6d 62 6f 6c 20 6e 65 77 73 74 61 74 29 0a 3b ymbol newstat).;
19c0: 3b 3b 3b 3b 3b 3b 20 20 20 20 20 20 20 28 28 55 ;;;;;; ((U
19d0: 4e 4b 29 20 20 20 20 20 20 20 29 20 3b 3b 20 64 NK) ) ;; d
19e0: 6f 20 6e 6f 74 68 69 6e 67 0a 3b 3b 3b 3b 3b 3b o nothing.;;;;;;
19f0: 3b 20 20 20 20 20 20 20 28 28 52 55 4e 4e 49 4e ; ((RUNNIN
1a00: 47 29 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 G) (print "##t
1a10: 65 61 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 eamcity[testStar
1a20: 74 65 64 20 6e 61 6d 65 3d 27 22 20 74 63 74 6e ted name='" tctn
1a30: 61 6d 65 20 22 27 20 66 6c 6f 77 49 64 3d 27 22 ame "' flowId='"
1a40: 20 66 6c 6f 77 69 64 20 22 27 5d 22 29 29 0a 3b flowid "']")).;
1a50: 3b 3b 3b 3b 3b 3b 20 20 20 20 20 20 20 28 28 50 ;;;;;; ((P
1a60: 41 53 53 20 53 4b 49 50 20 57 41 52 4e 20 57 41 ASS SKIP WARN WA
1a70: 49 56 45 44 29 20 28 70 72 69 6e 74 20 22 23 23 IVED) (print "##
1a80: 74 65 61 6d 63 69 74 79 5b 74 65 73 74 46 69 6e teamcity[testFin
1a90: 69 73 68 65 64 20 6e 61 6d 65 3d 27 22 20 74 63 ished name='" tc
1aa0: 74 6e 61 6d 65 20 22 27 20 64 75 72 61 74 69 6f tname "' duratio
1ab0: 6e 3d 27 22 20 28 2a 20 31 65 33 20 64 75 72 61 n='" (* 1e3 dura
1ac0: 74 69 6f 6e 29 20 22 27 22 20 63 6d 74 73 74 72 tion) "'" cmtstr
1ad0: 20 64 65 74 61 69 6c 73 20 22 20 66 6c 6f 77 49 details " flowI
1ae0: 64 3d 27 22 20 66 6c 6f 77 69 64 20 22 27 5d 22 d='" flowid "']"
1af0: 29 29 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 20 )).;;;;;;;
1b00: 20 28 65 6c 73 65 0a 3b 3b 3b 3b 3b 3b 3b 20 09 (else.;;;;;;; .
1b10: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
1b20: 74 79 5b 74 65 73 74 46 61 69 6c 65 64 20 6e 61 ty[testFailed na
1b30: 6d 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 22 27 me='" tctname "'
1b40: 20 22 20 63 6d 74 73 74 72 20 64 65 74 61 69 6c " cmtstr detail
1b50: 73 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 66 6c s " flowId='" fl
1b60: 6f 77 69 64 20 22 27 5d 22 29 29 29 0a 3b 3b 3b owid "']"))).;;;
1b70: 3b 3b 3b 3b 20 20 20 20 20 28 66 6c 75 73 68 2d ;;;; (flush-
1b80: 6f 75 74 70 75 74 29 0a 0a 3b 3b 20 28 74 72 61 output)..;; (tra
1b90: 63 65 20 72 6d 74 3a 67 65 74 2d 74 65 73 74 73 ce rmt:get-tests
1ba0: 2d 66 6f 72 2d 72 75 6e 29 0a 0a 28 64 65 66 69 -for-run)..(defi
1bb0: 6e 65 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 ne (update-queue
1bc0: 2d 73 69 6e 63 65 20 64 61 74 61 20 72 75 6e 2d -since data run-
1bd0: 69 64 73 20 6c 61 73 74 2d 75 70 64 61 74 65 20 ids last-update
1be0: 74 73 6e 61 6d 65 20 74 61 72 67 65 74 20 72 75 tsname target ru
1bf0: 6e 6e 61 6d 65 20 66 6c 6f 77 69 64 20 66 6c 75 nname flowid flu
1c00: 73 68 29 20 3b 3b 20 0a 20 20 28 6c 65 74 20 28 sh) ;; . (let (
1c10: 28 6e 6f 77 20 20 20 28 63 75 72 72 65 6e 74 2d (now (current-
1c20: 73 65 63 6f 6e 64 73 29 29 29 0a 3b 3b 20 28 68 seconds))).;; (h
1c30: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
1c40: 0a 3b 3b 20 09 65 78 6e 0a 3b 3b 20 09 28 62 65 .;; .exn.;; .(be
1c50: 67 69 6e 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d gin (print-call-
1c60: 63 68 61 69 6e 29 20 28 70 72 69 6e 74 20 22 45 chain) (print "E
1c70: 72 72 6f 72 20 6d 65 73 73 61 67 65 3a 20 22 20 rror message: "
1c80: 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 ((condition-prop
1c90: 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 erty-accessor 'e
1ca0: 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e xn 'message) exn
1cb0: 29 29 29 0a 20 20 20 20 20 20 28 66 6f 72 2d 65 ))). (for-e
1cc0: 61 63 68 0a 20 20 20 20 20 20 20 28 6c 61 6d 62 ach. (lamb
1cd0: 64 61 20 28 72 75 6e 2d 69 64 29 0a 09 20 28 6c da (run-id).. (l
1ce0: 65 74 2a 20 28 28 74 65 73 74 73 20 28 72 6d 74 et* ((tests (rmt
1cf0: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
1d00: 75 6e 20 72 75 6e 2d 69 64 20 22 25 22 20 27 28 un run-id "%" '(
1d10: 29 20 27 28 29 20 23 66 20 23 66 20 23 66 20 23 ) '() #f #f #f #
1d20: 66 20 23 66 20 23 66 20 6c 61 73 74 2d 75 70 64 f #f #f last-upd
1d30: 61 74 65 20 23 66 29 29 29 0a 09 20 20 20 3b 3b ate #f))).. ;;
1d40: 20 28 70 72 69 6e 74 20 22 44 45 42 55 47 3a 20 (print "DEBUG:
1d50: 67 6f 74 20 74 65 73 74 73 3d 22 20 74 65 73 74 got tests=" test
1d60: 73 29 0a 09 20 20 20 28 66 6f 72 2d 65 61 63 68 s).. (for-each
1d70: 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 .. (lambda (t
1d80: 65 73 74 2d 72 65 63 29 0a 09 20 20 20 20 20 20 est-rec)..
1d90: 28 6c 65 74 2a 20 28 28 74 71 75 65 75 65 20 20 (let* ((tqueue
1da0: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
1db0: 2f 64 65 66 61 75 6c 74 20 64 61 74 61 20 27 74 /default data 't
1dc0: 71 75 65 75 65 20 27 28 29 29 29 20 3b 3b 20 4e queue '())) ;; N
1dd0: 4f 54 45 3a 20 74 68 65 20 6b 65 79 20 69 73 20 OTE: the key is
1de0: 61 20 73 79 6d 62 6f 6c 21 20 54 68 69 73 20 61 a symbol! This a
1df0: 6c 6c 6f 77 73 20 6b 65 65 70 69 6e 67 20 64 69 llows keeping di
1e00: 73 70 61 72 61 74 65 20 69 6e 66 6f 20 69 6e 20 sparate info in
1e10: 74 68 65 20 6f 6e 65 20 68 61 73 68 2c 20 6c 61 the one hash, la
1e20: 7a 79 20 62 75 74 20 61 20 71 75 69 63 6b 20 73 zy but a quick s
1e30: 6f 6c 75 74 69 6f 6e 20 66 6f 72 20 72 69 67 68 olution for righ
1e40: 74 20 6e 6f 77 2e 0a 09 09 20 20 20 20 20 28 69 t now.... (i
1e50: 73 2d 74 6f 70 20 20 20 28 64 62 3a 74 65 73 74 s-top (db:test
1e60: 2d 67 65 74 2d 69 73 2d 74 6f 70 6c 65 76 65 6c -get-is-toplevel
1e70: 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 test-rec))...
1e80: 20 20 20 20 28 74 6e 61 6d 65 20 20 20 20 28 64 (tname (d
1e90: 62 3a 74 65 73 74 2d 67 65 74 2d 66 75 6c 6c 6e b:test-get-fulln
1ea0: 61 6d 65 20 20 20 20 20 74 65 73 74 2d 72 65 63 ame test-rec
1eb0: 29 29 0a 09 09 20 20 20 20 20 28 74 65 73 74 6e ))... (testn
1ec0: 61 6d 65 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ame (db:test-get
1ed0: 2d 74 65 73 74 6e 61 6d 65 20 20 20 20 20 74 65 -testname te
1ee0: 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 20 st-rec))...
1ef0: 28 69 74 65 6d 70 61 74 68 20 28 64 62 3a 74 65 (itempath (db:te
1f00: 73 74 2d 67 65 74 2d 69 74 65 6d 2d 70 61 74 68 st-get-item-path
1f10: 20 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 test-rec))..
1f20: 09 20 20 20 20 20 28 74 63 74 6e 61 6d 65 20 20 . (tctname
1f30: 28 69 66 20 28 73 74 72 69 6e 67 3d 3f 20 69 74 (if (string=? it
1f40: 65 6d 70 61 74 68 20 22 22 29 20 74 65 73 74 6e empath "") testn
1f50: 61 6d 65 20 28 63 6f 6e 63 20 74 65 73 74 6e 61 ame (conc testna
1f60: 6d 65 20 22 2e 22 20 28 73 74 72 69 6e 67 2d 74 me "." (string-t
1f70: 72 61 6e 73 6c 61 74 65 20 69 74 65 6d 70 61 74 ranslate itempat
1f80: 68 20 22 2f 22 20 22 2e 22 29 29 29 29 0a 09 09 h "/" "."))))...
1f90: 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 28 (state (
1fa0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
1fb0: 65 20 20 20 20 20 20 20 20 74 65 73 74 2d 72 65 e test-re
1fc0: 63 29 29 0a 09 09 20 20 20 20 20 28 73 74 61 74 c))... (stat
1fd0: 75 73 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 us (db:test-ge
1fe0: 74 2d 73 74 61 74 75 73 20 20 20 20 20 20 20 74 t-status t
1ff0: 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 est-rec))...
2000: 20 28 65 74 69 6d 65 20 20 20 20 28 64 62 3a 74 (etime (db:t
2010: 65 73 74 2d 67 65 74 2d 65 76 65 6e 74 5f 74 69 est-get-event_ti
2020: 6d 65 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a me test-rec)).
2030: 09 09 20 20 20 20 20 28 64 75 72 61 74 69 6f 6e .. (duration
2040: 20 28 6f 72 20 28 61 6e 79 2d 3e 6e 75 6d 62 65 (or (any->numbe
2050: 72 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 r (db:test-get-r
2060: 75 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 un_duration test
2070: 2d 72 65 63 29 29 20 30 29 29 0a 09 09 20 20 20 -rec)) 0))...
2080: 20 20 28 63 6f 6d 6d 65 6e 74 20 20 28 64 62 3a (comment (db:
2090: 74 65 73 74 2d 67 65 74 2d 63 6f 6d 6d 65 6e 74 test-get-comment
20a0: 20 20 20 20 20 20 74 65 73 74 2d 72 65 63 29 29 test-rec))
20b0: 0a 09 09 20 20 20 20 20 28 6c 6f 67 66 69 6c 65 ... (logfile
20c0: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 66 (db:test-get-f
20d0: 69 6e 61 6c 5f 6c 6f 67 66 20 20 20 74 65 73 74 inal_logf test
20e0: 2d 72 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 -rec)).
20f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 68 6f 73 (hos
2100: 74 6e 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 tn (db:test-g
2110: 65 74 2d 68 6f 73 74 20 20 20 20 20 20 20 20 20 et-host
2120: 74 65 73 74 2d 72 65 63 29 29 0a 20 20 20 20 20 test-rec)).
2130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2140: 28 70 69 64 20 20 20 20 20 20 28 64 62 3a 74 65 (pid (db:te
2150: 73 74 2d 67 65 74 2d 70 72 6f 63 65 73 73 5f 69 st-get-process_i
2160: 64 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 d test-rec))..
2170: 09 20 20 20 20 20 28 6e 65 77 73 74 61 74 20 20 . (newstat
2180: 28 63 6f 6e 64 0a 09 09 09 09 28 28 65 71 75 61 (cond.....((equa
2190: 6c 3f 20 73 74 61 74 65 20 22 52 55 4e 4e 49 4e l? state "RUNNIN
21a0: 47 22 29 20 20 20 22 52 55 4e 4e 49 4e 47 22 29 G") "RUNNING")
21b0: 0a 09 09 09 09 28 28 65 71 75 61 6c 3f 20 73 74 .....((equal? st
21c0: 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 ate "COMPLETED")
21d0: 20 73 74 61 74 75 73 29 0a 09 09 09 09 28 66 6c status).....(fl
21e0: 75 73 68 20 20 20 28 63 6f 6e 63 20 73 74 61 74 ush (conc stat
21f0: 65 20 22 2f 22 20 73 74 61 74 75 73 29 29 0a 09 e "/" status))..
2200: 09 09 09 28 65 6c 73 65 20 22 55 4e 4b 22 29 29 ...(else "UNK"))
2210: 29 0a 09 09 20 20 20 20 20 28 63 6d 74 73 74 72 )... (cmtstr
2220: 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 (if (and (not
2230: 20 66 6c 75 73 68 29 20 63 6f 6d 6d 65 6e 74 29 flush) comment)
2240: 0a 09 09 09 09 20 20 20 63 6f 6d 6d 65 6e 74 0a ..... comment.
2250: 09 09 09 09 20 20 20 28 69 66 20 66 6c 75 73 68 .... (if flush
2260: 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e ..... (con
2270: 63 20 22 54 65 73 74 20 65 6e 64 65 64 20 69 6e c "Test ended in
2280: 20 73 74 61 74 65 2f 73 74 61 74 75 73 3d 22 20 state/status="
2290: 73 74 61 74 65 20 22 2f 22 20 73 74 61 74 75 73 state "/" status
22a0: 20 20 28 69 66 20 20 28 73 74 72 69 6e 67 2d 6d (if (string-m
22b0: 61 74 63 68 20 22 5e 5c 5c 73 2a 24 22 20 63 6f atch "^\\s*$" co
22c0: 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 09 09 09 mment)..........
22d0: 09 09 09 20 20 22 2c 20 6e 6f 20 4d 65 67 61 74 ... ", no Megat
22e0: 65 73 74 20 63 6f 6d 6d 65 6e 74 20 66 6f 75 6e est comment foun
22f0: 64 2e 22 0a 09 09 09 09 09 09 09 09 09 09 09 09 d.".............
2300: 20 20 28 63 6f 6e 63 20 22 2c 20 4d 65 67 61 74 (conc ", Megat
2310: 65 73 74 20 63 6f 6d 6d 65 6e 74 3d 5c 22 22 20 est comment=\""
2320: 63 6f 6d 6d 65 6e 74 20 22 5c 22 22 29 29 29 20 comment "\"")))
2330: 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 2c ;; special case,
2340: 20 77 65 20 61 72 65 20 68 61 6e 64 6c 69 6e 67 we are handling
2350: 20 73 74 72 61 67 67 6c 65 72 73 0a 09 09 09 09 stragglers.....
2360: 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 09 20 #f)))...
2370: 20 20 20 20 28 64 65 74 61 69 6c 73 20 20 28 69 (details (i
2380: 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 68 20 f (string-match
2390: 22 2e 2a 68 74 6d 6c 24 22 20 6c 6f 67 66 69 6c ".*html$" logfil
23a0: 65 29 0a 09 09 09 09 20 20 20 28 63 6f 6e 63 20 e)..... (conc
23b0: 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6c 74 2f 22 *toppath* "/lt/"
23c0: 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e target "/" runn
23d0: 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 6d 65 ame "/" testname
23e0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 (if (equal? ite
23f0: 6d 70 61 74 68 20 22 22 29 20 22 2f 22 20 28 63 mpath "") "/" (c
2400: 6f 6e 63 20 22 2f 22 20 69 74 65 6d 70 61 74 68 onc "/" itempath
2410: 20 22 2f 22 29 29 20 6c 6f 67 66 69 6c 65 29 0a "/")) logfile).
2420: 09 09 09 09 20 20 20 23 66 29 29 0a 09 09 20 20 .... #f))...
2430: 20 20 20 28 70 72 65 76 2d 74 64 61 74 20 28 68 (prev-tdat (h
2440: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
2450: 66 61 75 6c 74 20 64 61 74 61 20 74 6e 61 6d 65 fault data tname
2460: 20 23 66 29 29 20 0a 09 09 20 20 20 20 20 28 74 #f)) ... (t
2470: 64 61 74 20 20 20 20 20 20 28 69 66 20 69 73 2d dat (if is-
2480: 74 6f 70 0a 09 09 09 09 20 20 20 20 23 66 0a 09 top..... #f..
2490: 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 6e 65 ... (let ((ne
24a0: 77 20 28 6f 72 20 70 72 65 76 2d 74 64 61 74 20 w (or prev-tdat
24b0: 28 6d 61 6b 65 2d 74 65 73 74 64 61 74 29 29 29 (make-testdat)))
24c0: 29 20 3b 3b 20 72 65 63 79 63 6c 65 20 74 68 65 ) ;; recycle the
24d0: 20 72 65 63 6f 72 64 20 73 6f 20 77 65 20 6b 65 record so we ke
24e0: 65 70 20 74 72 61 63 6b 20 6f 66 20 61 6c 72 65 ep track of alre
24f0: 61 64 79 20 70 72 69 6e 74 65 64 20 69 74 65 6d ady printed item
2500: 73 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 73 s..... (tes
2510: 74 64 61 74 2d 66 6c 6f 77 69 64 2d 73 65 74 21 tdat-flowid-set!
2520: 20 20 20 20 20 6e 65 77 20 28 6f 72 20 28 74 65 new (or (te
2530: 73 74 64 61 74 2d 66 6c 6f 77 69 64 20 6e 65 77 stdat-flowid new
2540: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 (if (eq
2590: 3f 20 70 69 64 20 30 29 0a 20 20 20 20 20 20 20 ? pid 0).
25a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25e0: 20 20 20 20 74 63 74 6e 61 6d 65 0a 20 20 20 20 tctname.
25f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2630: 20 20 20 20 20 20 20 28 63 6f 6e 63 20 68 6f 73 (conc hos
2640: 74 6e 20 22 2d 22 20 70 69 64 29 29 29 29 0a 09 tn "-" pid))))..
2650: 09 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 ... (testda
2660: 74 2d 74 63 74 6e 61 6d 65 2d 73 65 74 21 20 20 t-tctname-set!
2670: 20 20 6e 65 77 20 74 63 74 6e 61 6d 65 29 0a 09 new tctname)..
2680: 09 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 ... (testda
2690: 74 2d 74 6e 61 6d 65 2d 73 65 74 21 20 20 20 20 t-tname-set!
26a0: 20 20 6e 65 77 20 74 6e 61 6d 65 29 0a 09 09 09 new tname)....
26b0: 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 2d . (testdat-
26c0: 73 74 61 74 65 2d 73 65 74 21 20 20 20 20 20 20 state-set!
26d0: 6e 65 77 20 73 74 61 74 65 29 0a 09 09 09 09 20 new state).....
26e0: 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 (testdat-st
26f0: 61 74 75 73 2d 73 65 74 21 20 20 20 20 20 6e 65 atus-set! ne
2700: 77 20 73 74 61 74 75 73 29 0a 09 09 09 09 20 20 w status).....
2710: 20 20 20 20 28 74 65 73 74 64 61 74 2d 63 6f 6d (testdat-com
2720: 6d 65 6e 74 2d 73 65 74 21 20 20 20 20 6e 65 77 ment-set! new
2730: 20 63 6d 74 73 74 72 29 0a 09 09 09 09 20 20 20 cmtstr).....
2740: 20 20 20 28 74 65 73 74 64 61 74 2d 64 65 74 61 (testdat-deta
2750: 69 6c 73 2d 73 65 74 21 20 20 20 20 6e 65 77 20 ils-set! new
2760: 64 65 74 61 69 6c 73 29 0a 09 09 09 09 20 20 20 details).....
2770: 20 20 20 28 74 65 73 74 64 61 74 2d 64 75 72 61 (testdat-dura
2780: 74 69 6f 6e 2d 73 65 74 21 20 20 20 6e 65 77 20 tion-set! new
2790: 64 75 72 61 74 69 6f 6e 29 0a 09 09 09 09 20 20 duration).....
27a0: 20 20 20 20 28 74 65 73 74 64 61 74 2d 65 76 65 (testdat-eve
27b0: 6e 74 2d 74 69 6d 65 2d 73 65 74 21 20 6e 65 77 nt-time-set! new
27c0: 20 65 74 69 6d 65 29 20 3b 3b 20 28 63 75 72 72 etime) ;; (curr
27d0: 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 0a 09 09 ent-seconds))...
27e0: 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 .. (testdat
27f0: 2d 6f 76 65 72 61 6c 6c 2d 73 65 74 21 20 20 20 -overall-set!
2800: 20 6e 65 77 20 6e 65 77 73 74 61 74 29 0a 09 09 new newstat)...
2810: 09 09 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 .. (hash-ta
2820: 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 74 6e ble-set! data tn
2830: 61 6d 65 20 6e 65 77 29 0a 09 09 09 09 20 20 20 ame new).....
2840: 20 20 20 6e 65 77 29 29 29 29 0a 09 09 28 69 66 new))))...(if
2850: 20 28 6e 6f 74 20 69 73 2d 74 6f 70 29 0a 09 09 (not is-top)...
2860: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
2870: 73 65 74 21 20 64 61 74 61 20 27 74 71 75 65 75 set! data 'tqueu
2880: 65 20 28 63 6f 6e 73 20 74 64 61 74 20 74 71 75 e (cons tdat tqu
2890: 65 75 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 eue))).
28a0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
28b0: 6c 65 2d 73 65 74 21 20 64 61 74 61 20 74 6e 61 le-set! data tna
28c0: 6d 65 20 74 64 61 74 29 0a 20 20 20 20 20 20 20 me tdat).
28d0: 20 20 20 20 20 20 20 20 20 29 29 0a 20 20 20 20 )).
28e0: 20 20 20 20 20 20 20 20 74 65 73 74 73 29 29 29 tests)))
28f0: 0a 20 20 20 20 20 20 20 72 75 6e 2d 69 64 73 29 . run-ids)
2900: 0a 20 20 20 20 20 20 6e 6f 77 29 29 0a 20 20 20 . now)).
2910: 20 20 20 0a 28 64 65 66 69 6e 65 20 28 6d 6f 6e .(define (mon
2920: 69 74 6f 72 20 70 69 64 29 0a 20 20 28 6c 65 74 itor pid). (let
2930: 2a 20 28 28 72 75 6e 2d 69 64 73 20 27 28 29 29 * ((run-ids '())
2940: 0a 09 20 28 74 65 73 74 64 61 74 73 20 28 6d 61 .. (testdats (ma
2950: 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 ke-hash-table))
2960: 20 3b 3b 20 65 61 63 68 20 65 6e 74 72 79 20 69 ;; each entry i
2970: 73 20 61 20 6c 69 73 74 20 6f 66 20 74 65 73 74 s a list of test
2980: 64 61 74 20 73 74 72 75 63 74 73 0a 09 20 28 6b dat structs.. (k
2990: 65 79 73 20 20 20 20 23 66 29 0a 09 20 28 6c 61 eys #f).. (la
29a0: 73 74 2d 75 70 64 61 74 65 20 30 29 0a 09 20 28 st-update 0).. (
29b0: 74 61 72 67 65 74 20 20 28 6f 72 20 28 61 72 67 target (or (arg
29c0: 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 61 72 67 s:get-arg "-targ
29d0: 65 74 22 29 0a 09 09 20 20 20 20 20 20 28 61 72 et")... (ar
29e0: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 65 71 gs:get-arg "-req
29f0: 74 61 72 67 22 29 29 29 0a 09 20 28 72 75 6e 6e targ"))).. (runn
2a00: 61 6d 65 20 28 61 72 67 73 3a 67 65 74 2d 61 72 ame (args:get-ar
2a10: 67 20 22 2d 72 75 6e 6e 61 6d 65 22 29 29 0a 09 g "-runname"))..
2a20: 20 28 74 73 6e 61 6d 65 20 20 23 66 29 0a 09 20 (tsname #f)..
2a30: 28 66 6c 6f 77 69 64 20 20 28 63 6f 6e 63 20 74 (flowid (conc t
2a40: 61 72 67 65 74 20 22 2f 22 20 72 75 6e 6e 61 6d arget "/" runnam
2a50: 65 29 29 0a 09 20 28 74 64 65 6c 61 79 20 20 28 e)).. (tdelay (
2a60: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 string->number (
2a70: 6f 72 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 or (args:get-arg
2a80: 20 22 2d 64 65 6c 61 79 22 29 20 22 31 35 22 29 "-delay") "15")
2a90: 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 6e 64 ))). (if (and
2aa0: 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 29 target runname)
2ab0: 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 6c 61 75 ..(begin.. (lau
2ac0: 6e 63 68 3a 73 65 74 75 70 29 0a 09 20 20 28 73 nch:setup).. (s
2ad0: 65 74 21 20 6b 65 79 73 20 28 72 6d 74 3a 67 65 et! keys (rmt:ge
2ae0: 74 2d 6b 65 79 73 29 29 29 29 0a 20 20 20 20 28 t-keys)))). (
2af0: 73 65 74 21 20 74 73 6e 61 6d 65 20 20 28 63 6f set! tsname (co
2b00: 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 74 73 75 69 mmon:get-testsui
2b10: 74 65 2d 6e 61 6d 65 29 29 0a 20 20 20 20 28 70 te-name)). (p
2b20: 72 69 6e 74 20 22 54 43 4d 54 3a 20 66 6f 72 20 rint "TCMT: for
2b30: 74 65 73 74 73 75 69 74 65 3d 22 20 74 73 6e 61 testsuite=" tsna
2b40: 6d 65 20 22 20 66 6f 75 6e 64 20 72 75 6e 6e 61 me " found runna
2b50: 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 20 22 2c 20 me=" runname ",
2b60: 74 61 72 67 65 74 3d 22 20 74 61 72 67 65 74 20 target=" target
2b70: 22 2c 20 6b 65 79 73 3d 22 20 6b 65 79 73 20 22 ", keys=" keys "
2b80: 20 61 6e 64 20 73 75 63 63 65 73 73 66 75 6c 6c and successfull
2b90: 79 20 72 61 6e 20 6c 61 75 6e 63 68 3a 73 65 74 y ran launch:set
2ba0: 75 70 2e 20 55 73 69 6e 67 20 22 20 66 6c 6f 77 up. Using " flow
2bb0: 69 64 20 22 20 61 73 20 74 68 65 20 66 6c 6f 77 id " as the flow
2bc0: 49 64 2e 22 29 0a 20 20 20 20 28 6c 65 74 20 6c Id."). (let l
2bd0: 6f 6f 70 20 28 29 0a 20 20 20 20 20 20 3b 3b 3b oop (). ;;;
2be0: 3b 3b 3b 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 ;;; (handle-exce
2bf0: 70 74 69 6f 6e 73 0a 20 20 20 20 20 20 3b 3b 3b ptions. ;;;
2c00: 3b 3b 3b 20 20 65 78 6e 0a 20 20 20 20 20 20 3b ;;; exn. ;
2c10: 3b 3b 3b 3b 3b 20 20 3b 3b 20 28 70 72 69 6e 74 ;;;;; ;; (print
2c20: 20 22 50 72 6f 63 65 73 73 20 64 6f 6e 65 2e 22 "Process done."
2c30: 29 0a 20 20 20 20 20 20 3b 3b 3b 3b 3b 3b 20 20 ). ;;;;;;
2c40: 28 62 65 67 69 6e 20 28 70 72 69 6e 74 2d 63 61 (begin (print-ca
2c50: 6c 6c 2d 63 68 61 69 6e 29 20 28 70 72 69 6e 74 ll-chain) (print
2c60: 20 22 45 72 72 6f 72 20 6d 65 73 73 61 67 65 3a "Error message:
2c70: 20 22 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 " ((condition-p
2c80: 72 6f 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 roperty-accessor
2c90: 20 27 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 'exn 'message)
2ca0: 65 78 6e 29 29 29 0a 20 20 20 20 20 20 20 28 6c exn))). (l
2cb0: 65 74 2d 76 61 6c 75 65 73 20 28 28 28 70 69 64 et-values (((pid
2cc0: 72 65 73 20 65 78 69 74 74 79 70 65 20 65 78 69 res exittype exi
2cd0: 74 73 74 61 74 75 73 29 0a 09 09 20 20 20 20 20 tstatus)...
2ce0: 28 70 72 6f 63 65 73 73 2d 77 61 69 74 20 70 69 (process-wait pi
2cf0: 64 20 23 74 29 29 29 0a 09 20 28 69 66 20 28 61 d #t))).. (if (a
2d00: 6e 64 20 6b 65 79 73 0a 09 09 20 20 28 6f 72 20 nd keys... (or
2d10: 28 6e 6f 74 20 72 75 6e 2d 69 64 73 29 0a 09 09 (not run-ids)...
2d20: 20 20 20 20 20 20 28 6e 75 6c 6c 3f 20 72 75 6e (null? run
2d30: 2d 69 64 73 29 29 29 0a 09 20 20 20 20 20 28 6c -ids))).. (l
2d40: 65 74 2a 20 28 28 72 75 6e 73 20 28 72 6d 74 3a et* ((runs (rmt:
2d50: 67 65 74 2d 72 75 6e 73 2d 62 79 2d 70 61 74 74 get-runs-by-patt
2d60: 20 6b 65 79 73 0a 09 09 09 09 09 09 72 75 6e 6e keys.......runn
2d70: 61 6d 65 20 0a 09 09 09 09 09 09 74 61 72 67 65 ame .......targe
2d80: 74 0a 09 09 09 09 09 09 23 66 20 3b 3b 20 6f 66 t.......#f ;; of
2d90: 66 73 65 74 0a 09 09 09 09 09 09 23 66 20 3b 3b fset.......#f ;;
2da0: 20 6c 69 6d 69 74 0a 09 09 09 09 09 09 23 66 20 limit.......#f
2db0: 3b 3b 20 66 69 65 6c 64 73 0a 09 09 09 09 09 09 ;; fields.......
2dc0: 30 20 20 3b 3b 20 6c 61 73 74 2d 75 70 64 61 74 0 ;; last-updat
2dd0: 65 0a 09 09 09 09 09 09 29 29 0a 09 09 20 20 20 e.......))...
2de0: 20 28 68 65 61 64 65 72 20 28 64 62 3a 67 65 74 (header (db:get
2df0: 2d 68 65 61 64 65 72 20 72 75 6e 73 29 29 0a 09 -header runs))..
2e00: 09 20 20 20 20 28 72 6f 77 73 20 20 20 28 64 62 . (rows (db
2e10: 3a 67 65 74 2d 72 6f 77 73 20 20 20 72 75 6e 73 :get-rows runs
2e20: 29 29 0a 09 09 20 20 20 20 28 72 75 6e 2d 69 64 ))... (run-id
2e30: 73 2d 69 6e 20 28 6d 61 70 20 28 6c 61 6d 62 64 s-in (map (lambd
2e40: 61 20 28 72 6f 77 29 0a 09 09 09 09 20 20 20 20 a (row).....
2e50: 20 20 20 28 64 62 3a 67 65 74 2d 76 61 6c 75 65 (db:get-value
2e60: 2d 62 79 2d 68 65 61 64 65 72 20 72 6f 77 20 68 -by-header row h
2e70: 65 61 64 65 72 20 22 69 64 22 29 29 0a 09 09 09 eader "id"))....
2e80: 09 20 20 20 20 20 72 6f 77 73 29 29 29 0a 09 20 . rows)))..
2e90: 20 20 20 20 20 20 28 73 65 74 21 20 72 75 6e 2d (set! run-
2ea0: 69 64 73 20 72 75 6e 2d 69 64 73 2d 69 6e 29 29 ids run-ids-in))
2eb0: 29 0a 09 20 3b 3b 20 28 70 72 69 6e 74 20 22 54 ).. ;; (print "T
2ec0: 43 4d 54 3a 20 70 69 64 72 65 73 3d 22 20 70 69 CMT: pidres=" pi
2ed0: 64 72 65 73 20 22 20 65 78 69 74 74 79 70 65 3d dres " exittype=
2ee0: 22 20 65 78 69 74 74 79 70 65 20 22 20 65 78 69 " exittype " exi
2ef0: 74 73 74 61 74 75 73 3d 22 20 65 78 69 74 73 74 tstatus=" exitst
2f00: 61 74 75 73 20 22 20 72 75 6e 2d 69 64 73 3d 22 atus " run-ids="
2f10: 20 72 75 6e 2d 69 64 73 29 0a 09 20 28 69 66 20 run-ids).. (if
2f20: 28 65 71 3f 20 70 69 64 72 65 73 20 30 29 0a 09 (eq? pidres 0)..
2f30: 20 20 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 (begin..
2f40: 20 20 20 20 28 69 66 20 6b 65 79 73 0a 20 20 20 (if keys.
2f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f60: 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 (begin.
2f70: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set
2f80: 21 20 6c 61 73 74 2d 75 70 64 61 74 65 20 28 2d ! last-update (-
2f90: 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d 73 (update-queue-s
2fa0: 69 6e 63 65 20 74 65 73 74 64 61 74 73 20 72 75 ince testdats ru
2fb0: 6e 2d 69 64 73 20 6c 61 73 74 2d 75 70 64 61 74 n-ids last-updat
2fc0: 65 20 74 73 6e 61 6d 65 20 74 61 72 67 65 74 20 e tsname target
2fd0: 72 75 6e 6e 61 6d 65 20 66 6c 6f 77 69 64 20 23 runname flowid #
2fe0: 66 29 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 f) 5)).
2ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f (pro
3000: 63 65 73 73 2d 71 75 65 75 65 20 74 65 73 74 64 cess-queue testd
3010: 61 74 73 20 74 64 65 6c 61 79 20 23 66 29 29 29 ats tdelay #f)))
3020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3030: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 (thread-sleep! 3
3040: 29 0a 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 29 ).. (loop)
3050: 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 ).. (begin..
3060: 20 20 20 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 ;; (print
3070: 20 22 54 43 4d 54 3a 20 70 69 64 72 65 73 3d 22 "TCMT: pidres="
3080: 20 70 69 64 72 65 73 20 22 20 65 78 69 74 74 79 pidres " exitty
3090: 70 65 3d 22 20 65 78 69 74 74 79 70 65 20 22 20 pe=" exittype "
30a0: 65 78 69 74 73 74 61 74 75 73 3d 22 20 65 78 69 exitstatus=" exi
30b0: 74 73 74 61 74 75 73 20 22 20 72 75 6e 2d 69 64 tstatus " run-id
30c0: 73 3d 22 20 72 75 6e 2d 69 64 73 29 0a 09 20 20 s=" run-ids)..
30d0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 54 43 4d (print "TCM
30e0: 54 3a 20 70 72 6f 63 65 73 73 69 6e 67 20 61 6e T: processing an
30f0: 79 20 74 65 73 74 73 20 74 68 61 74 20 64 69 64 y tests that did
3100: 20 6e 6f 74 20 66 6f 72 6d 61 6c 6c 79 20 63 6f not formally co
3110: 6d 70 6c 65 74 65 2e 22 29 0a 09 20 20 20 20 20 mplete.")..
3120: 20 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d (update-queue-
3130: 73 69 6e 63 65 20 74 65 73 74 64 61 74 73 20 72 since testdats r
3140: 75 6e 2d 69 64 73 20 30 20 74 73 6e 61 6d 65 20 un-ids 0 tsname
3150: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 target runname f
3160: 6c 6f 77 69 64 20 23 74 29 20 3b 3b 20 63 61 6c lowid #t) ;; cal
3170: 6c 20 69 6e 20 66 6c 75 73 68 20 6d 6f 64 65 0a l in flush mode.
3180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3190: 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 74 65 process-queue te
31a0: 73 74 64 61 74 73 20 30 20 23 74 29 0a 09 20 20 stdats 0 #t)..
31b0: 20 20 20 20 20 28 70 72 69 6e 74 20 22 54 43 4d (print "TCM
31c0: 54 3a 20 41 6c 6c 20 64 6f 6e 65 2e 22 29 0a 09 T: All done.")..
31d0: 20 20 20 20 20 20 20 29 29 29 29 29 29 0a 3b 3b )))))).;;
31e0: 3b 3b 3b 20 29 0a 0a 3b 3b 20 28 74 72 61 63 65 ;;; )..;; (trace
31f0: 20 70 72 69 6e 74 2d 63 68 61 6e 67 65 73 2d 73 print-changes-s
3200: 69 6e 63 65 29 0a 0a 3b 3b 20 28 69 66 20 28 6e ince)..;; (if (n
3210: 6f 74 20 28 65 71 3f 20 70 69 64 72 65 73 20 30 ot (eq? pidres 0
3220: 29 29 09 20 20 3b 3b 20 28 6e 6f 74 20 65 78 69 )). ;; (not exi
3230: 74 73 74 61 74 75 73 29 29 0a 3b 3b 20 09 20 20 tstatus)).;; .
3240: 28 62 65 67 69 6e 0a 3b 3b 20 09 20 20 20 20 28 (begin.;; . (
3250: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 29 thread-sleep! 3)
3260: 0a 3b 3b 20 09 20 20 20 20 28 6c 6f 6f 70 29 29 .;; . (loop))
3270: 0a 3b 3b 20 09 20 20 28 70 72 69 6e 74 20 22 50 .;; . (print "P
3280: 72 6f 63 65 73 73 3a 20 6d 65 67 61 74 65 73 74 rocess: megatest
3290: 20 22 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 " (string-inter
32a0: 73 70 65 72 73 65 20 6f 72 69 67 61 72 67 73 20 sperse origargs
32b0: 22 20 22 29 20 22 20 69 73 20 64 6f 6e 65 2e 22 " ") " is done."
32c0: 29 29 29 29 29 0a 28 64 65 66 69 6e 65 20 28 6d ))))).(define (m
32d0: 61 69 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 6d ain). (let* ((m
32e0: 74 2d 64 6f 6e 65 20 23 66 29 0a 09 20 28 70 69 t-done #f).. (pi
32f0: 64 20 20 20 20 20 23 66 29 0a 09 20 28 74 68 31 d #f).. (th1
3300: 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 61 (make-threa
3310: 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 d (lambda ()....
3320: 09 20 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 6e . (print "Runnin
3330: 67 20 6d 65 67 61 74 65 73 74 20 22 20 28 73 74 g megatest " (st
3340: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
3350: 20 6f 72 69 67 61 72 67 73 20 22 20 22 29 29 0a origargs " ")).
3360: 09 09 09 09 20 28 73 65 74 21 20 70 69 64 20 28 .... (set! pid (
3370: 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6d 65 67 process-run "meg
3380: 61 74 65 73 74 22 20 6f 72 69 67 61 72 67 73 29 atest" origargs)
3390: 29 29 0a 09 09 09 20 20 20 20 20 20 20 22 4d 65 )).... "Me
33a0: 67 61 74 65 73 74 20 6a 6f 62 22 29 29 0a 09 20 gatest job"))..
33b0: 28 74 68 32 20 20 20 20 20 28 6d 61 6b 65 2d 74 (th2 (make-t
33c0: 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 hread (lambda ()
33d0: 0a 09 09 09 09 20 28 6d 6f 6e 69 74 6f 72 20 70 ..... (monitor p
33e0: 69 64 29 29 0a 09 09 09 20 20 20 20 20 20 20 22 id)).... "
33f0: 4d 6f 6e 69 74 6f 72 20 6a 6f 62 22 29 29 29 0a Monitor job"))).
3400: 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 72 (thread-star
3410: 74 21 20 74 68 31 29 0a 20 20 20 20 28 74 68 72 t! th1). (thr
3420: 65 61 64 2d 73 6c 65 65 70 21 20 31 29 20 3b 3b ead-sleep! 1) ;;
3430: 20 67 69 76 65 20 74 68 65 20 70 72 6f 63 65 73 give the proces
3440: 73 20 74 69 6d 65 20 74 6f 20 67 65 74 20 67 6f s time to get go
3450: 69 6e 67 0a 20 20 20 20 28 74 68 72 65 61 64 2d ing. (thread-
3460: 73 74 61 72 74 21 20 74 68 32 29 0a 20 20 20 20 start! th2).
3470: 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 68 (thread-join! th
3480: 32 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 3a 2)))..(if (args:
3490: 67 65 74 2d 61 72 67 20 22 2d 74 63 2d 72 65 70 get-arg "-tc-rep
34a0: 6c 22 29 0a 20 20 20 20 28 72 65 70 6c 29 0a 20 l"). (repl).
34b0: 20 20 20 28 6d 61 69 6e 29 29 0a 0a 3b 3b 20 28 (main))..;; (
34c0: 70 72 6f 63 65 73 73 2d 77 61 69 74 29 0a 0a process-wait)..