Artifact
d2f01548ef1f08b4b2b692cfe624c1b3c85e2ed7:
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 66 6c 6f 77 69 64 0a 20 20 74 63 74 6e 61 6d flowid. tctnam
04c0: 65 0a 20 20 74 6e 61 6d 65 0a 20 20 28 65 76 65 e. tname. (eve
04d0: 6e 74 2d 74 69 6d 65 20 23 66 29 0a 20 20 64 65 nt-time #f). de
04e0: 74 61 69 6c 73 0a 20 20 63 6f 6d 6d 65 6e 74 0a tails. comment.
04f0: 20 20 64 75 72 61 74 69 6f 6e 0a 20 20 28 73 74 duration. (st
0500: 61 72 74 2d 70 72 69 6e 74 65 64 20 23 66 29 0a art-printed #f).
0510: 20 20 28 65 6e 64 2d 70 72 69 6e 74 65 64 20 20 (end-printed
0520: 20 23 66 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d #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 0a ===============.
0570: 3b 3b 20 47 4c 4f 42 41 4c 53 0a 3b 3b 3d 3d 3d ;; GLOBALS.;;===
0580: 3d 3d 3d 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 0a 0a 3b 3b 20 47 6f 74 74 61 20 68 61 ===..;; Gotta ha
05d0: 76 65 20 61 20 67 6c 6f 62 61 6c 3f 20 53 74 61 ve a global? Sta
05e0: 73 68 20 69 74 20 69 6e 20 74 68 65 20 2a 67 6c sh it in the *gl
05f0: 6f 62 61 6c 2a 20 68 61 73 68 20 74 61 62 6c 65 obal* hash table
0600: 2e 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 2a 67 6c ..;;.(define *gl
0610: 6f 62 61 6c 2a 20 28 6d 61 6b 65 2d 68 61 73 68 obal* (make-hash
0620: 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 66 69 6e -table))..(defin
0630: 65 20 28 74 63 6d 74 3a 70 72 69 6e 74 20 74 64 e (tcmt:print td
0640: 61 74 20 66 6c 75 73 68 2d 6d 6f 64 65 29 0a 20 at flush-mode).
0650: 20 28 6c 65 74 2a 20 28 28 63 6f 6d 6d 65 6e 74 (let* ((comment
0660: 20 20 28 69 66 20 28 74 65 73 74 64 61 74 2d 63 (if (testdat-c
0670: 6f 6d 6d 65 6e 74 20 74 64 61 74 29 0a 09 09 20 omment tdat)...
0680: 20 20 20 20 20 20 28 63 6f 6e 63 20 22 20 6d 65 (conc " me
0690: 73 73 61 67 65 3d 27 22 20 28 74 65 73 74 64 61 ssage='" (testda
06a0: 74 2d 63 6f 6d 6d 65 6e 74 20 74 64 61 74 29 20 t-comment tdat)
06b0: 22 27 22 29 0a 09 09 20 20 20 20 20 20 20 22 22 "'")... ""
06c0: 29 29 0a 09 20 28 64 65 74 61 69 6c 73 20 20 28 )).. (details (
06d0: 69 66 20 28 74 65 73 74 64 61 74 2d 64 65 74 61 if (testdat-deta
06e0: 69 6c 73 20 74 64 61 74 29 0a 09 09 20 20 20 20 ils tdat)...
06f0: 20 20 20 28 63 6f 6e 63 20 22 20 64 65 74 61 69 (conc " detai
0700: 6c 73 3d 27 22 20 28 74 65 73 74 64 61 74 2d 64 ls='" (testdat-d
0710: 65 74 61 69 6c 73 20 74 64 61 74 29 20 22 27 22 etails tdat) "'"
0720: 29 0a 09 09 20 20 20 20 20 20 20 22 22 29 29 0a )... "")).
0730: 09 20 28 66 6c 6f 77 69 64 20 20 20 28 63 6f 6e . (flowid (con
0740: 63 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 28 74 c " flowId='" (t
0750: 65 73 74 64 61 74 2d 66 6c 6f 77 69 64 20 20 20 estdat-flowid
0760: 74 64 61 74 29 20 22 27 22 29 29 0a 09 20 28 64 tdat) "'")).. (d
0770: 75 72 61 74 69 6f 6e 20 28 63 6f 6e 63 20 22 20 uration (conc "
0780: 64 75 72 61 74 69 6f 6e 3d 27 22 20 28 2a 20 31 duration='" (* 1
0790: 65 33 20 28 74 65 73 74 64 61 74 2d 64 75 72 61 e3 (testdat-dura
07a0: 74 69 6f 6e 20 74 64 61 74 29 29 20 22 27 22 29 tion tdat)) "'")
07b0: 29 0a 09 20 28 74 63 6e 61 6d 65 20 20 20 28 63 ).. (tcname (c
07c0: 6f 6e 63 20 22 20 6e 61 6d 65 3d 27 22 20 28 74 onc " name='" (t
07d0: 65 73 74 64 61 74 2d 74 63 74 6e 61 6d 65 20 20 estdat-tctname
07e0: 74 64 61 74 29 20 22 27 22 29 29 0a 09 20 28 73 tdat) "'")).. (s
07f0: 74 61 74 65 20 20 20 20 28 73 74 72 69 6e 67 2d tate (string-
0800: 3e 73 79 6d 62 6f 6c 20 28 74 65 73 74 64 61 74 >symbol (testdat
0810: 2d 73 74 61 74 65 20 74 64 61 74 29 29 29 0a 09 -state tdat)))..
0820: 20 28 73 74 61 74 75 73 20 20 20 28 73 74 72 69 (status (stri
0830: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 74 65 73 74 ng->symbol (test
0840: 64 61 74 2d 73 74 61 74 75 73 20 74 64 61 74 29 dat-status tdat)
0850: 29 29 0a 09 20 28 73 74 61 72 74 70 20 20 20 28 )).. (startp (
0860: 74 65 73 74 64 61 74 2d 73 74 61 72 74 2d 70 72 testdat-start-pr
0870: 69 6e 74 65 64 20 74 64 61 74 29 29 0a 09 20 28 inted tdat)).. (
0880: 65 6e 64 70 20 20 20 20 20 28 74 65 73 74 64 61 endp (testda
0890: 74 2d 65 6e 64 2d 70 72 69 6e 74 65 64 20 20 20 t-end-printed
08a0: 74 64 61 74 29 29 0a 09 20 28 65 74 69 6d 65 20 tdat)).. (etime
08b0: 20 20 20 28 74 65 73 74 64 61 74 2d 65 76 65 6e (testdat-even
08c0: 74 2d 74 69 6d 65 20 20 20 20 74 64 61 74 29 29 t-time tdat))
08d0: 0a 09 20 28 6f 76 65 72 61 6c 6c 20 20 28 63 61 .. (overall (ca
08e0: 73 65 20 73 74 61 74 65 0a 09 09 20 20 20 20 20 se state...
08f0: 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 73 74 61 ((RUNNING) sta
0900: 74 65 29 0a 09 09 20 20 20 20 20 28 28 43 4f 4d te)... ((COM
0910: 50 4c 45 54 45 44 29 20 73 74 61 74 65 29 0a 09 PLETED) state)..
0920: 09 20 20 20 20 20 28 65 6c 73 65 20 27 55 4e 4b . (else 'UNK
0930: 29 29 29 0a 09 20 28 74 73 74 6d 70 20 20 20 20 ))).. (tstmp
0940: 28 63 6f 6e 63 20 22 20 74 69 6d 65 73 74 61 6d (conc " timestam
0950: 70 3d 27 22 20 28 74 69 6d 65 2d 3e 73 74 72 69 p='" (time->stri
0960: 6e 67 20 28 73 65 63 6f 6e 64 73 2d 3e 6c 6f 63 ng (seconds->loc
0970: 61 6c 2d 74 69 6d 65 20 65 74 69 6d 65 29 20 22 al-time etime) "
0980: 25 46 54 25 54 2e 30 30 30 22 29 20 22 27 22 29 %FT%T.000") "'")
0990: 29 29 0a 20 20 20 20 28 63 61 73 65 20 6f 76 65 )). (case ove
09a0: 72 61 6c 6c 0a 20 20 20 20 20 20 28 28 52 55 4e rall. ((RUN
09b0: 4e 49 4e 47 29 0a 20 20 20 20 20 20 20 28 69 66 NING). (if
09c0: 20 28 6e 6f 74 20 73 74 61 72 74 70 29 0a 09 20 (not startp)..
09d0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 (begin.. (
09e0: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
09f0: 79 5b 74 65 73 74 53 74 61 72 74 65 64 20 22 20 y[testStarted "
0a00: 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 74 tcname flowid t
0a10: 73 74 6d 70 20 22 5d 22 29 0a 09 20 20 20 20 20 stmp "]")..
0a20: 28 74 65 73 74 64 61 74 2d 73 74 61 72 74 2d 70 (testdat-start-p
0a30: 72 69 6e 74 65 64 2d 73 65 74 21 20 74 64 61 74 rinted-set! tdat
0a40: 20 23 74 29 29 29 29 0a 20 20 20 20 20 20 28 28 #t)))). ((
0a50: 43 4f 4d 50 4c 45 54 45 44 29 0a 20 20 20 20 20 COMPLETED).
0a60: 20 20 28 69 66 20 28 6e 6f 74 20 73 74 61 72 74 (if (not start
0a70: 70 29 20 3b 3b 20 73 74 61 72 74 20 73 74 61 6e p) ;; start stan
0a80: 7a 61 20 6e 65 76 65 72 20 70 72 69 6e 74 65 64 za never printed
0a90: 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 .. (begin..
0aa0: 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d (print "##team
0ab0: 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 65 64 city[testStarted
0ac0: 20 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 " tcname flowid
0ad0: 20 74 73 74 6d 70 20 22 5d 22 29 0a 09 20 20 20 tstmp "]")..
0ae0: 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 72 74 (testdat-start
0af0: 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 20 74 64 -printed-set! td
0b00: 61 74 20 23 74 29 29 29 0a 20 20 20 20 20 20 20 at #t))).
0b10: 28 69 66 20 28 6e 6f 74 20 65 6e 64 70 29 0a 09 (if (not endp)..
0b20: 20 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 (begin..
0b30: 28 69 66 20 28 6d 65 6d 62 65 72 20 73 74 61 74 (if (member stat
0b40: 75 73 20 27 28 50 41 53 53 20 57 41 52 4e 20 53 us '(PASS WARN S
0b50: 4b 49 50 20 57 41 49 56 45 44 29 29 0a 09 09 20 KIP WAIVED))...
0b60: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
0b70: 74 79 5b 74 65 73 74 46 69 6e 69 73 68 65 64 22 ty[testFinished"
0b80: 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 63 tcname flowid c
0b90: 6f 6d 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 64 omment details d
0ba0: 75 72 61 74 69 6f 6e 20 22 5d 22 29 0a 09 09 20 uration "]")...
0bb0: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
0bc0: 74 79 5b 74 65 73 74 46 61 69 6c 65 64 20 20 22 ty[testFailed "
0bd0: 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 63 tcname flowid c
0be0: 6f 6d 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 22 omment details "
0bf0: 5d 22 29 29 0a 09 20 20 20 20 20 28 74 65 73 74 ]")).. (test
0c00: 64 61 74 2d 65 6e 64 2d 70 72 69 6e 74 65 64 2d dat-end-printed-
0c10: 73 65 74 21 20 74 64 61 74 20 23 74 29 29 29 29 set! tdat #t))))
0c20: 0a 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 . (else.
0c30: 20 20 20 20 28 69 66 20 66 6c 75 73 68 2d 6d 6f (if flush-mo
0c40: 64 65 0a 09 20 20 20 28 62 65 67 69 6e 0a 09 20 de.. (begin..
0c50: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 73 74 61 (if (not sta
0c60: 72 74 70 29 0a 09 09 20 28 62 65 67 69 6e 0a 09 rtp)... (begin..
0c70: 09 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 . (print "##te
0c80: 61 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 amcity[testStart
0c90: 65 64 20 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 ed " tcname flow
0ca0: 69 64 20 74 73 74 6d 70 20 22 5d 22 29 0a 09 09 id tstmp "]")...
0cb0: 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 72 (testdat-star
0cc0: 74 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 20 74 t-printed-set! t
0cd0: 64 61 74 20 23 74 29 29 29 0a 09 20 20 20 20 20 dat #t)))..
0ce0: 28 69 66 20 28 6e 6f 74 20 65 6e 64 70 29 0a 09 (if (not endp)..
0cf0: 09 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 70 . (begin... (p
0d00: 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 79 rint "##teamcity
0d10: 5b 74 65 73 74 46 61 69 6c 65 64 20 20 22 20 74 [testFailed " t
0d20: 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 63 6f 6d cname flowid com
0d30: 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 22 5d 22 ment details "]"
0d40: 29 0a 09 09 20 20 20 28 74 65 73 74 64 61 74 2d )... (testdat-
0d50: 65 6e 64 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 end-printed-set!
0d60: 20 74 64 61 74 20 23 74 29 29 29 29 29 29 29 0a tdat #t))))))).
0d70: 20 20 20 20 3b 3b 20 28 70 72 69 6e 74 20 22 45 ;; (print "E
0d80: 52 52 4f 52 3a 20 74 63 2d 74 79 70 65 20 5c 22 RROR: tc-type \"
0d90: 22 20 28 74 65 73 74 64 61 74 2d 74 63 2d 74 79 " (testdat-tc-ty
0da0: 70 65 20 74 64 61 74 29 20 22 5c 22 20 6e 6f 74 pe tdat) "\" not
0db0: 20 72 65 63 6f 67 6e 69 73 65 64 20 66 6f 72 20 recognised for
0dc0: 22 20 74 63 6e 61 6d 65 29 29 29 0a 20 20 20 20 " tcname))).
0dd0: 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 29 29 29 (flush-output)))
0de0: 0a 0a 3b 3b 20 3b 3b 20 72 65 74 75 72 6e 73 20 ..;; ;; returns
0df0: 76 61 6c 75 65 73 3a 20 66 6c 61 67 20 6e 65 77 values: flag new
0e00: 6c 73 74 0a 3b 3b 20 28 64 65 66 69 6e 65 20 28 lst.;; (define (
0e10: 72 65 6d 6f 76 65 2d 64 75 70 6c 69 63 61 74 65 remove-duplicate
0e20: 2d 63 6f 6d 70 6c 65 74 65 64 20 20 74 64 61 74 -completed tdat
0e30: 73 29 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 28 28 s).;; (let* ((
0e40: 66 6c 61 67 20 20 20 20 20 20 20 23 66 29 0a 3b flag #f).;
0e50: 3b 20 20 20 20 20 20 20 20 20 20 28 73 74 61 74 ; (stat
0e60: 65 20 20 20 20 20 20 28 74 65 73 74 64 61 74 2d e (testdat-
0e70: 73 74 61 74 65 20 20 20 20 20 20 74 64 61 74 29 state tdat)
0e80: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 28 73 ).;; (s
0e90: 74 61 74 75 73 20 20 20 20 20 28 74 65 73 74 64 tatus (testd
0ea0: 61 74 2d 73 74 61 74 75 73 20 20 20 20 20 74 64 at-status td
0eb0: 61 74 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 at)).;;
0ec0: 20 28 65 76 65 6e 74 2d 74 69 6d 65 20 28 74 65 (event-time (te
0ed0: 73 74 64 61 74 2d 65 76 65 6e 74 2d 74 69 6d 65 stdat-event-time
0ee0: 20 74 64 61 74 29 29 0a 3b 3b 20 20 20 20 20 20 tdat)).;;
0ef0: 20 20 20 20 28 74 6e 61 6d 65 20 20 20 20 20 20 (tname
0f00: 28 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 20 (testdat-tname
0f10: 20 20 20 20 74 64 61 74 29 29 29 0a 3b 3b 20 20 tdat))).;;
0f20: 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 (let loop ((h
0f30: 65 64 20 28 63 61 72 20 74 64 61 74 73 29 29 0a ed (car tdats)).
0f40: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
0f50: 20 20 28 74 61 6c 20 28 63 64 72 20 74 64 61 74 (tal (cdr tdat
0f60: 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 s)).;;
0f70: 20 20 20 20 20 20 28 6e 65 77 20 27 28 29 29 29 (new '()))
0f80: 0a 3b 3b 20 20 20 20 20 20 20 28 69 66 20 28 61 .;; (if (a
0f90: 6e 64 20 28 65 71 75 61 6c 3f 20 73 74 61 74 65 nd (equal? state
0fa0: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 3b 3b "COMPLETED").;;
0fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fc0: 28 65 71 75 61 6c 3f 20 74 6e 61 6d 65 20 28 74 (equal? tname (t
0fd0: 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 68 65 64 estdat-tname hed
0fe0: 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 )).;;
0ff0: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 73 74 61 (equal? sta
1000: 74 65 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 te (testdat-stat
1010: 65 20 68 65 64 29 29 29 20 3b 3b 20 77 65 20 68 e hed))) ;; we h
1020: 61 76 65 20 61 20 64 75 70 6c 69 63 61 74 65 20 ave a duplicate
1030: 43 4f 4d 50 4c 45 54 45 44 20 63 61 6c 6c 0a 3b COMPLETED call.;
1040: 3b 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 ; (beg
1050: 69 6e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 in.;;
1060: 20 20 28 73 65 74 21 20 66 6c 61 67 20 23 74 29 (set! flag #t)
1070: 20 3b 3b 20 41 20 63 68 61 6e 67 65 64 20 63 6f ;; A changed co
1080: 6d 70 6c 65 74 65 64 0a 20 20 20 20 20 20 20 20 mpleted.
1090: 20 20 20 20 0a 3b 3b 20 70 72 6f 63 65 73 73 20 .;; process
10a0: 74 68 65 20 71 75 65 75 65 20 6f 66 20 74 65 73 the queue of tes
10b0: 74 73 20 67 61 74 68 65 72 65 64 20 73 6f 20 66 ts gathered so f
10c0: 61 72 2e 20 4c 69 73 74 20 69 6e 63 6c 75 64 65 ar. List include
10d0: 73 20 6f 6e 65 20 65 6e 74 72 79 20 66 6f 72 20 s one entry for
10e0: 65 76 65 72 79 20 74 65 73 74 20 73 6f 20 66 61 every test so fa
10f0: 72 20 73 65 65 6e 0a 3b 3b 20 74 68 65 20 6c 61 r seen.;; the la
1100: 73 74 20 72 65 63 6f 72 64 20 66 6f 72 20 61 20 st record for a
1110: 74 65 73 74 20 69 73 20 70 72 65 73 65 72 76 65 test is preserve
1120: 64 2e 20 49 74 65 6d 73 20 61 72 65 20 6f 6e 6c d. Items are onl
1130: 79 20 72 65 6d 6f 76 65 64 20 66 72 6f 6d 20 74 y removed from t
1140: 68 65 20 6c 69 73 74 20 69 66 20 6f 76 65 72 20 he list if over
1150: 31 35 20 73 65 63 6f 6e 64 73 0a 3b 3b 20 68 61 15 seconds.;; ha
1160: 76 65 20 70 61 73 73 65 64 20 73 69 6e 63 65 20 ve passed since
1170: 69 74 20 68 61 70 70 65 6e 65 64 2e 20 54 68 69 it happened. Thi
1180: 73 20 61 6c 6c 6f 77 73 20 66 6f 72 20 63 6f 6d s allows for com
1190: 70 72 65 73 73 69 6f 6e 20 6f 66 20 43 4f 4d 50 pression of COMP
11a0: 4c 45 54 45 44 2f 46 41 49 4c 20 66 6f 6c 6c 6f LETED/FAIL follo
11b0: 77 65 64 20 62 79 20 73 6f 6d 65 20 6f 74 68 65 wed by some othe
11c0: 72 0a 3b 3b 20 73 74 61 74 65 2f 73 74 61 74 75 r.;; state/statu
11d0: 73 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 72 s.;;.(define (pr
11e0: 6f 63 65 73 73 2d 71 75 65 75 65 20 64 61 74 61 ocess-queue data
11f0: 20 61 67 65 20 66 6c 75 73 68 2d 6d 6f 64 65 29 age flush-mode)
1200: 0a 20 20 3b 3b 20 68 65 72 65 20 77 65 20 70 72 . ;; here we pr
1210: 6f 63 65 73 73 20 74 71 75 65 75 65 20 61 6e 64 ocess tqueue and
1220: 20 67 61 74 68 65 72 20 74 68 6f 73 65 20 6f 76 gather those ov
1230: 65 72 20 31 35 20 73 65 63 6f 6e 64 73 20 28 63 er 15 seconds (c
1240: 6f 6e 66 69 67 75 72 61 62 6c 65 3f 29 20 6f 6c onfigurable?) ol
1250: 64 0a 20 20 28 6c 65 74 2a 20 28 28 70 72 69 6e d. (let* ((prin
1260: 74 2d 74 69 6d 65 20 28 2d 20 28 63 75 72 72 65 t-time (- (curre
1270: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 61 67 65 29 nt-seconds) age)
1280: 29 20 3b 3b 20 70 72 69 6e 74 20 73 74 75 66 66 ) ;; print stuff
1290: 20 6f 76 65 72 20 31 35 20 73 65 63 6f 6e 64 73 over 15 seconds
12a0: 20 6f 6c 64 0a 20 20 20 20 20 20 20 20 20 28 74 old. (t
12b0: 71 75 65 75 65 2d 72 61 77 20 28 68 61 73 68 2d queue-raw (hash-
12c0: 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c table-ref/defaul
12d0: 74 20 64 61 74 61 20 27 74 71 75 65 75 65 20 27 t data 'tqueue '
12e0: 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 74 ())). (t
12f0: 71 75 65 75 65 20 20 20 20 20 28 72 65 76 65 72 queue (rever
1300: 73 65 20 28 64 65 6c 65 74 65 2d 64 75 70 6c 69 se (delete-dupli
1310: 63 61 74 65 73 20 74 71 75 65 75 65 2d 72 61 77 cates tqueue-raw
1320: 20 20 20 20 20 3b 3b 20 52 45 4d 4f 56 45 20 64 ;; REMOVE d
1330: 75 70 6c 69 63 61 74 65 73 20 62 79 20 74 65 73 uplicates by tes
1340: 74 6e 61 6d 65 20 61 6e 64 20 73 74 61 74 65 0a tname and state.
1350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 6c 61 6d 62 64 61 20 28 61 20 62 29 0a 20 (lambda (a b).
1390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 28 (and (equal? (
13d0: 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 61 29 testdat-tname a)
13e0: 28 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 20 62 (testdat-tname b
13f0: 29 29 20 20 20 20 20 20 20 20 3b 3b 20 6e 65 65 )) ;; nee
1400: 64 20 6f 6c 64 65 73 74 20 74 6f 20 6e 65 77 65 d oldest to newe
1410: 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 st.
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 28 65 71 75 61 (equa
1450: 6c 3f 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 l? (testdat-stat
1460: 65 20 61 29 20 28 74 65 73 74 64 61 74 2d 73 74 e a) (testdat-st
1470: 61 74 65 20 62 29 29 29 29 29 29 29 29 20 3b 3b ate b)))))))) ;;
1480: 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 20 20 "COMPLETED").
1490: 20 20 3b 3b 20 28 65 71 75 61 6c 3f 20 28 74 65 ;; (equal? (te
14a0: 73 74 64 61 74 2d 73 74 61 74 65 20 62 29 20 22 stdat-state b) "
14b0: 43 4f 4d 50 4c 45 54 45 44 22 29 29 29 29 29 29 COMPLETED"))))))
14c0: 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
14d0: 6e 75 6c 6c 3f 20 74 71 75 65 75 65 29 29 0a 20 null? tqueue)).
14e0: 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 (hash-tab
14f0: 6c 65 2d 73 65 74 21 0a 20 20 20 20 20 20 20 20 le-set!.
1500: 20 64 61 74 61 0a 20 20 20 20 20 20 20 20 20 27 data. '
1510: 74 71 75 65 75 65 0a 20 20 20 20 20 20 20 20 20 tqueue.
1520: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 (let loop ((hed
1530: 28 63 61 72 20 74 71 75 65 75 65 29 29 20 3b 3b (car tqueue)) ;;
1540: 20 62 79 20 74 68 69 73 20 70 6f 69 6e 74 20 61 by this point a
1550: 6c 6c 20 64 75 70 6c 69 63 61 74 65 73 20 62 79 ll duplicates by
1560: 20 73 74 61 74 65 20 43 4f 4d 50 4c 45 54 45 44 state COMPLETED
1570: 20 61 72 65 20 72 65 6d 6f 76 65 64 0a 20 20 20 are removed.
1580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1590: 20 28 74 61 6c 20 28 63 64 72 20 74 71 75 65 75 (tal (cdr tqueu
15a0: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
15b0: 20 20 20 20 20 20 20 20 28 72 65 6d 20 27 28 29 (rem '()
15c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 )). (i
15d0: 66 20 28 3e 20 70 72 69 6e 74 2d 74 69 6d 65 20 f (> print-time
15e0: 28 74 65 73 74 64 61 74 2d 65 76 65 6e 74 2d 74 (testdat-event-t
15f0: 69 6d 65 20 68 65 64 29 29 20 3b 3b 20 65 76 65 ime hed)) ;; eve
1600: 6e 74 20 68 61 70 70 65 6e 65 64 20 6f 76 65 72 nt happened over
1610: 20 31 35 20 73 65 63 6f 6e 64 73 20 61 67 6f 0a 15 seconds ago.
1620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1630: 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
1640: 20 20 20 20 20 20 20 28 74 63 6d 74 3a 70 72 69 (tcmt:pri
1650: 6e 74 20 68 65 64 20 66 6c 75 73 68 2d 6d 6f 64 nt hed flush-mod
1660: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
1670: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
1680: 61 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 al).
1690: 20 20 20 20 20 20 20 20 20 72 65 6d 20 3b 3b 20 rem ;;
16a0: 72 65 74 75 72 6e 20 72 65 6d 20 74 6f 20 62 65 return rem to be
16b0: 20 70 72 6f 63 65 73 73 65 64 20 69 6e 20 74 68 processed in th
16c0: 65 20 66 75 74 75 72 65 0a 20 20 20 20 20 20 20 e future.
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
16e0: 6f 6f 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 oop (car tal)(cd
16f0: 72 20 74 61 6c 29 20 72 65 6d 29 29 29 0a 20 20 r tal) rem))).
1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
1710: 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 20 20 20 (null? tal).
1720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1730: 28 63 6f 6e 73 20 68 65 64 20 72 65 6d 29 20 3b (cons hed rem) ;
1740: 3b 20 72 65 74 75 72 6e 20 72 65 6d 20 2b 20 68 ; return rem + h
1750: 65 64 20 66 6f 72 20 66 75 74 75 72 65 20 70 72 ed for future pr
1760: 6f 63 65 73 73 69 6e 67 0a 20 20 20 20 20 20 20 ocessing.
1770: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f (loo
1780: 70 20 28 63 61 72 20 74 61 6c 29 28 63 64 72 20 p (car tal)(cdr
1790: 74 61 6c 29 28 63 6f 6e 73 20 68 65 64 20 72 65 tal)(cons hed re
17a0: 6d 29 29 29 29 29 29 29 29 29 0a 0a 20 20 20 20 m)))))))))..
17b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c0: 20 20 20 20 20 20 20 20 3b 3b 20 23 23 74 65 61 ;; ##tea
17d0: 6d 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 65 mcity[testStarte
17e0: 64 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 d name='suite.te
17f0: 73 74 4e 61 6d 65 27 5d 0a 3b 3b 20 23 23 74 65 stName'].;; ##te
1800: 61 6d 63 69 74 79 5b 74 65 73 74 53 74 64 4f 75 amcity[testStdOu
1810: 74 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 t name='suite.te
1820: 73 74 4e 61 6d 65 27 20 6f 75 74 3d 27 74 65 78 stName' out='tex
1830: 74 27 5d 0a 3b 3b 20 23 23 74 65 61 6d 63 69 74 t'].;; ##teamcit
1840: 79 5b 74 65 73 74 53 74 64 45 72 72 20 6e 61 6d y[testStdErr nam
1850: 65 3d 27 73 75 69 74 65 2e 74 65 73 74 4e 61 6d e='suite.testNam
1860: 65 27 20 6f 75 74 3d 27 65 72 72 6f 72 20 74 65 e' out='error te
1870: 78 74 27 5d 0a 3b 3b 20 23 23 74 65 61 6d 63 69 xt'].;; ##teamci
1880: 74 79 5b 74 65 73 74 46 61 69 6c 65 64 20 6e 61 ty[testFailed na
1890: 6d 65 3d 27 73 75 69 74 65 2e 74 65 73 74 4e 61 me='suite.testNa
18a0: 6d 65 27 20 6d 65 73 73 61 67 65 3d 27 66 61 69 me' message='fai
18b0: 6c 75 72 65 20 6d 65 73 73 61 67 65 27 20 64 65 lure message' de
18c0: 74 61 69 6c 73 3d 27 6d 65 73 73 61 67 65 20 61 tails='message a
18d0: 6e 64 20 73 74 61 63 6b 20 74 72 61 63 65 27 5d nd stack trace']
18e0: 0a 3b 3b 20 23 23 74 65 61 6d 63 69 74 79 5b 74 .;; ##teamcity[t
18f0: 65 73 74 46 69 6e 69 73 68 65 64 20 6e 61 6d 65 estFinished name
1900: 3d 27 73 75 69 74 65 2e 74 65 73 74 4e 61 6d 65 ='suite.testName
1910: 27 20 64 75 72 61 74 69 6f 6e 3d 27 35 30 27 5d ' duration='50']
1920: 0a 3b 3b 20 0a 3b 3b 20 66 6c 75 73 68 3b 20 23 .;; .;; flush; #
1930: 66 2c 20 6e 6f 72 6d 61 6c 20 63 61 6c 6c 2e 20 f, normal call.
1940: 23 74 2c 20 6c 61 73 74 20 63 61 6c 6c 2c 20 70 #t, last call, p
1950: 72 69 6e 74 20 6f 75 74 20 73 6f 6d 65 74 68 69 rint out somethi
1960: 6e 67 20 66 6f 72 20 4e 4f 54 5f 53 54 41 52 54 ng for NOT_START
1970: 45 44 2c 20 65 74 63 2e 0a 3b 3b 0a 0a 3b 3b 3b ED, etc..;;..;;;
1980: 3b 3b 3b 3b 20 20 20 28 62 65 67 69 6e 0a 3b 3b ;;;; (begin.;;
1990: 3b 3b 3b 3b 3b 20 20 20 20 20 28 63 61 73 65 20 ;;;;; (case
19a0: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
19b0: 6e 65 77 73 74 61 74 29 0a 3b 3b 3b 3b 3b 3b 3b newstat).;;;;;;;
19c0: 20 20 20 20 20 20 20 28 28 55 4e 4b 29 20 20 20 ((UNK)
19d0: 20 20 20 20 29 20 3b 3b 20 64 6f 20 6e 6f 74 68 ) ;; do noth
19e0: 69 6e 67 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 ing.;;;;;;;
19f0: 20 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 28 ((RUNNING) (
1a00: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
1a10: 79 5b 74 65 73 74 53 74 61 72 74 65 64 20 6e 61 y[testStarted na
1a20: 6d 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 22 27 me='" tctname "'
1a30: 20 66 6c 6f 77 49 64 3d 27 22 20 66 6c 6f 77 69 flowId='" flowi
1a40: 64 20 22 27 5d 22 29 29 0a 3b 3b 3b 3b 3b 3b 3b d "']")).;;;;;;;
1a50: 20 20 20 20 20 20 20 28 28 50 41 53 53 20 53 4b ((PASS SK
1a60: 49 50 20 57 41 52 4e 20 57 41 49 56 45 44 29 20 IP WARN WAIVED)
1a70: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
1a80: 74 79 5b 74 65 73 74 46 69 6e 69 73 68 65 64 20 ty[testFinished
1a90: 6e 61 6d 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 name='" tctname
1aa0: 22 27 20 64 75 72 61 74 69 6f 6e 3d 27 22 20 28 "' duration='" (
1ab0: 2a 20 31 65 33 20 64 75 72 61 74 69 6f 6e 29 20 * 1e3 duration)
1ac0: 22 27 22 20 63 6d 74 73 74 72 20 64 65 74 61 69 "'" cmtstr detai
1ad0: 6c 73 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 66 ls " flowId='" f
1ae0: 6c 6f 77 69 64 20 22 27 5d 22 29 29 0a 3b 3b 3b lowid "']")).;;;
1af0: 3b 3b 3b 3b 20 20 20 20 20 20 20 28 65 6c 73 65 ;;;; (else
1b00: 0a 3b 3b 3b 3b 3b 3b 3b 20 09 28 70 72 69 6e 74 .;;;;;;; .(print
1b10: 20 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 "##teamcity[tes
1b20: 74 46 61 69 6c 65 64 20 6e 61 6d 65 3d 27 22 20 tFailed name='"
1b30: 74 63 74 6e 61 6d 65 20 22 27 20 22 20 63 6d 74 tctname "' " cmt
1b40: 73 74 72 20 64 65 74 61 69 6c 73 20 22 20 66 6c str details " fl
1b50: 6f 77 49 64 3d 27 22 20 66 6c 6f 77 69 64 20 22 owId='" flowid "
1b60: 27 5d 22 29 29 29 0a 3b 3b 3b 3b 3b 3b 3b 20 20 ']"))).;;;;;;;
1b70: 20 20 20 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 (flush-output
1b80: 29 0a 0a 3b 3b 20 28 74 72 61 63 65 20 72 6d 74 )..;; (trace rmt
1b90: 3a 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 :get-tests-for-r
1ba0: 75 6e 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 un)..(define (up
1bb0: 64 61 74 65 2d 71 75 65 75 65 2d 73 69 6e 63 65 date-queue-since
1bc0: 20 64 61 74 61 20 72 75 6e 2d 69 64 73 20 6c 61 data run-ids la
1bd0: 73 74 2d 75 70 64 61 74 65 20 74 73 6e 61 6d 65 st-update tsname
1be0: 20 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 target runname
1bf0: 66 6c 6f 77 69 64 20 66 6c 75 73 68 29 20 3b 3b flowid flush) ;;
1c00: 20 0a 20 20 28 6c 65 74 20 28 28 6e 6f 77 20 20 . (let ((now
1c10: 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 (current-second
1c20: 73 29 29 29 0a 3b 3b 20 28 68 61 6e 64 6c 65 2d s))).;; (handle-
1c30: 65 78 63 65 70 74 69 6f 6e 73 0a 3b 3b 20 09 65 exceptions.;; .e
1c40: 78 6e 0a 3b 3b 20 09 28 62 65 67 69 6e 20 28 70 xn.;; .(begin (p
1c50: 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 rint-call-chain)
1c60: 20 28 70 72 69 6e 74 20 22 45 72 72 6f 72 20 6d (print "Error m
1c70: 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 essage: " ((cond
1c80: 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 ition-property-a
1c90: 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 ccessor 'exn 'me
1ca0: 73 73 61 67 65 29 20 65 78 6e 29 29 29 0a 20 20 ssage) exn))).
1cb0: 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 (for-each.
1cc0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 75 (lambda (ru
1cd0: 6e 2d 69 64 29 0a 09 20 28 6c 65 74 2a 20 28 28 n-id).. (let* ((
1ce0: 74 65 73 74 73 20 28 72 6d 74 3a 67 65 74 2d 74 tests (rmt:get-t
1cf0: 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 6e ests-for-run run
1d00: 2d 69 64 20 22 25 22 20 27 28 29 20 27 28 29 20 -id "%" '() '()
1d10: 23 66 20 23 66 20 23 66 20 23 66 20 23 66 20 23 #f #f #f #f #f #
1d20: 66 20 6c 61 73 74 2d 75 70 64 61 74 65 20 23 66 f last-update #f
1d30: 29 29 29 0a 09 20 20 20 3b 3b 20 28 70 72 69 6e ))).. ;; (prin
1d40: 74 20 22 44 45 42 55 47 3a 20 67 6f 74 20 74 65 t "DEBUG: got te
1d50: 73 74 73 3d 22 20 74 65 73 74 73 29 0a 09 20 20 sts=" tests)..
1d60: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 20 (for-each..
1d70: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 72 65 (lambda (test-re
1d80: 63 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a 20 c).. (let*
1d90: 28 28 74 71 75 65 75 65 20 20 20 28 68 61 73 68 ((tqueue (hash
1da0: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
1db0: 6c 74 20 64 61 74 61 20 27 74 71 75 65 75 65 20 lt data 'tqueue
1dc0: 27 28 29 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 74 '())) ;; NOTE: t
1dd0: 68 65 20 6b 65 79 20 69 73 20 61 20 73 79 6d 62 he key is a symb
1de0: 6f 6c 21 20 54 68 69 73 20 61 6c 6c 6f 77 73 20 ol! This allows
1df0: 6b 65 65 70 69 6e 67 20 64 69 73 70 61 72 61 74 keeping disparat
1e00: 65 20 69 6e 66 6f 20 69 6e 20 74 68 65 20 6f 6e e info in the on
1e10: 65 20 68 61 73 68 2c 20 6c 61 7a 79 20 62 75 74 e hash, lazy but
1e20: 20 61 20 71 75 69 63 6b 20 73 6f 6c 75 74 69 6f a quick solutio
1e30: 6e 20 66 6f 72 20 72 69 67 68 74 20 6e 6f 77 2e n for right now.
1e40: 0a 09 09 20 20 20 20 20 28 69 73 2d 74 6f 70 20 ... (is-top
1e50: 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 69 (db:test-get-i
1e60: 73 2d 74 6f 70 6c 65 76 65 6c 20 20 74 65 73 74 s-toplevel test
1e70: 2d 72 65 63 29 29 0a 09 09 20 20 20 20 20 28 74 -rec))... (t
1e80: 6e 61 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 name (db:test
1e90: 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 20 20 -get-fullname
1ea0: 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 test-rec))...
1eb0: 20 20 20 20 28 74 65 73 74 6e 61 6d 65 20 28 64 (testname (d
1ec0: 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 6e b:test-get-testn
1ed0: 61 6d 65 20 20 20 20 20 74 65 73 74 2d 72 65 63 ame test-rec
1ee0: 29 29 0a 09 09 20 20 20 20 20 28 69 74 65 6d 70 ))... (itemp
1ef0: 61 74 68 20 28 64 62 3a 74 65 73 74 2d 67 65 74 ath (db:test-get
1f00: 2d 69 74 65 6d 2d 70 61 74 68 20 20 20 20 74 65 -item-path te
1f10: 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 20 st-rec))...
1f20: 28 74 63 74 6e 61 6d 65 20 20 28 69 66 20 28 73 (tctname (if (s
1f30: 74 72 69 6e 67 3d 3f 20 69 74 65 6d 70 61 74 68 tring=? itempath
1f40: 20 22 22 29 20 74 65 73 74 6e 61 6d 65 20 28 63 "") testname (c
1f50: 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2e 22 onc testname "."
1f60: 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c 61 (string-transla
1f70: 74 65 20 69 74 65 6d 70 61 74 68 20 22 2f 22 20 te itempath "/"
1f80: 22 2e 22 29 29 29 29 0a 09 09 20 20 20 20 20 28 "."))))... (
1f90: 73 74 61 74 65 20 20 20 20 28 64 62 3a 74 65 73 state (db:tes
1fa0: 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 20 t-get-state
1fb0: 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 test-rec))...
1fc0: 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 28 (status (
1fd0: 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 74 db:test-get-stat
1fe0: 75 73 20 20 20 20 20 20 20 74 65 73 74 2d 72 65 us test-re
1ff0: 63 29 29 0a 09 09 20 20 20 20 20 28 65 74 69 6d c))... (etim
2000: 65 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 e (db:test-ge
2010: 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 20 20 74 t-event_time t
2020: 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 est-rec))...
2030: 20 28 64 75 72 61 74 69 6f 6e 20 28 6f 72 20 28 (duration (or (
2040: 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 3a any->number (db:
2050: 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 72 test-get-run_dur
2060: 61 74 69 6f 6e 20 74 65 73 74 2d 72 65 63 29 29 ation test-rec))
2070: 20 30 29 29 0a 09 09 20 20 20 20 20 28 63 6f 6d 0))... (com
2080: 6d 65 6e 74 20 20 28 64 62 3a 74 65 73 74 2d 67 ment (db:test-g
2090: 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 20 20 et-comment
20a0: 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 test-rec))...
20b0: 20 20 28 6c 6f 67 66 69 6c 65 20 20 28 64 62 3a (logfile (db:
20c0: 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f 6c test-get-final_l
20d0: 6f 67 66 20 20 20 74 65 73 74 2d 72 65 63 29 29 ogf test-rec))
20e0: 0a 09 09 20 20 20 20 20 28 6e 65 77 73 74 61 74 ... (newstat
20f0: 20 20 28 63 6f 6e 64 0a 09 09 09 09 28 28 65 71 (cond.....((eq
2100: 75 61 6c 3f 20 73 74 61 74 65 20 22 52 55 4e 4e ual? state "RUNN
2110: 49 4e 47 22 29 20 20 20 22 52 55 4e 4e 49 4e 47 ING") "RUNNING
2120: 22 29 0a 09 09 09 09 28 28 65 71 75 61 6c 3f 20 ").....((equal?
2130: 73 74 61 74 65 20 22 43 4f 4d 50 4c 45 54 45 44 state "COMPLETED
2140: 22 29 20 73 74 61 74 75 73 29 0a 09 09 09 09 28 ") status).....(
2150: 66 6c 75 73 68 20 20 20 28 63 6f 6e 63 20 73 74 flush (conc st
2160: 61 74 65 20 22 2f 22 20 73 74 61 74 75 73 29 29 ate "/" status))
2170: 0a 09 09 09 09 28 65 6c 73 65 20 22 55 4e 4b 22 .....(else "UNK"
2180: 29 29 29 0a 09 09 20 20 20 20 20 28 63 6d 74 73 )))... (cmts
2190: 74 72 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e tr (if (and (n
21a0: 6f 74 20 66 6c 75 73 68 29 20 63 6f 6d 6d 65 6e ot flush) commen
21b0: 74 29 0a 09 09 09 09 20 20 20 63 6f 6d 6d 65 6e t)..... commen
21c0: 74 0a 09 09 09 09 20 20 20 28 69 66 20 66 6c 75 t..... (if flu
21d0: 73 68 0a 09 09 09 09 20 20 20 20 20 20 20 28 63 sh..... (c
21e0: 6f 6e 63 20 22 54 65 73 74 20 65 6e 64 65 64 20 onc "Test ended
21f0: 69 6e 20 73 74 61 74 65 2f 73 74 61 74 75 73 3d in state/status=
2200: 22 20 73 74 61 74 65 20 22 2f 22 20 73 74 61 74 " state "/" stat
2210: 75 73 20 20 28 69 66 20 20 28 73 74 72 69 6e 67 us (if (string
2220: 2d 6d 61 74 63 68 20 22 5e 5c 5c 73 2a 24 22 20 -match "^\\s*$"
2230: 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 09 09 09 09 comment)........
2240: 09 09 09 09 09 20 20 22 2c 20 6e 6f 20 4d 65 67 ..... ", no Meg
2250: 61 74 65 73 74 20 63 6f 6d 6d 65 6e 74 20 66 6f atest comment fo
2260: 75 6e 64 2e 22 0a 09 09 09 09 09 09 09 09 09 09 und."...........
2270: 09 09 20 20 28 63 6f 6e 63 20 22 2c 20 4d 65 67 .. (conc ", Meg
2280: 61 74 65 73 74 20 63 6f 6d 6d 65 6e 74 3d 5c 22 atest comment=\"
2290: 22 20 63 6f 6d 6d 65 6e 74 20 22 5c 22 22 29 29 " comment "\""))
22a0: 29 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 73 ) ;; special cas
22b0: 65 2c 20 77 65 20 61 72 65 20 68 61 6e 64 6c 69 e, we are handli
22c0: 6e 67 20 73 74 72 61 67 67 6c 65 72 73 0a 09 09 ng stragglers...
22d0: 09 09 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 .. #f)))..
22e0: 09 20 20 20 20 20 28 64 65 74 61 69 6c 73 20 20 . (details
22f0: 28 69 66 20 28 73 74 72 69 6e 67 2d 6d 61 74 63 (if (string-matc
2300: 68 20 22 2e 2a 68 74 6d 6c 24 22 20 6c 6f 67 66 h ".*html$" logf
2310: 69 6c 65 29 0a 09 09 09 09 20 20 20 28 63 6f 6e ile)..... (con
2320: 63 20 2a 74 6f 70 70 61 74 68 2a 20 22 2f 6c 74 c *toppath* "/lt
2330: 2f 22 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 /" target "/" ru
2340: 6e 6e 61 6d 65 20 22 2f 22 20 74 65 73 74 6e 61 nname "/" testna
2350: 6d 65 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 me (if (equal? i
2360: 74 65 6d 70 61 74 68 20 22 22 29 20 22 2f 22 20 tempath "") "/"
2370: 28 63 6f 6e 63 20 22 2f 22 20 69 74 65 6d 70 61 (conc "/" itempa
2380: 74 68 20 22 2f 22 29 29 20 6c 6f 67 66 69 6c 65 th "/")) logfile
2390: 29 0a 09 09 09 09 20 20 20 23 66 29 29 0a 09 09 )..... #f))...
23a0: 20 20 20 20 20 28 70 72 65 76 2d 74 64 61 74 20 (prev-tdat
23b0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f (hash-table-ref/
23c0: 64 65 66 61 75 6c 74 20 64 61 74 61 20 74 6e 61 default data tna
23d0: 6d 65 20 23 66 29 29 20 0a 09 09 20 20 20 20 20 me #f)) ...
23e0: 28 74 64 61 74 20 20 20 20 20 20 28 69 66 20 69 (tdat (if i
23f0: 73 2d 74 6f 70 0a 09 09 09 09 20 20 20 20 23 66 s-top..... #f
2400: 0a 09 09 09 09 20 20 20 20 28 6c 65 74 20 28 28 ..... (let ((
2410: 6e 65 77 20 28 6f 72 20 70 72 65 76 2d 74 64 61 new (or prev-tda
2420: 74 20 28 6d 61 6b 65 2d 74 65 73 74 64 61 74 29 t (make-testdat)
2430: 29 29 29 20 3b 3b 20 72 65 63 79 63 6c 65 20 74 ))) ;; recycle t
2440: 68 65 20 72 65 63 6f 72 64 20 73 6f 20 77 65 20 he record so we
2450: 6b 65 65 70 20 74 72 61 63 6b 20 6f 66 20 61 6c keep track of al
2460: 72 65 61 64 79 20 70 72 69 6e 74 65 64 20 69 74 ready printed it
2470: 65 6d 73 0a 09 09 09 09 20 20 20 20 20 20 28 74 ems..... (t
2480: 65 73 74 64 61 74 2d 66 6c 6f 77 69 64 2d 73 65 estdat-flowid-se
2490: 74 21 20 20 20 20 20 6e 65 77 20 66 6c 6f 77 69 t! new flowi
24a0: 64 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 d)..... (te
24b0: 73 74 64 61 74 2d 74 63 74 6e 61 6d 65 2d 73 65 stdat-tctname-se
24c0: 74 21 20 20 20 20 6e 65 77 20 74 63 74 6e 61 6d t! new tctnam
24d0: 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 e)..... (te
24e0: 73 74 64 61 74 2d 74 6e 61 6d 65 2d 73 65 74 21 stdat-tname-set!
24f0: 20 20 20 20 20 20 6e 65 77 20 74 6e 61 6d 65 29 new tname)
2500: 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 73 74 ..... (test
2510: 64 61 74 2d 73 74 61 74 65 2d 73 65 74 21 20 20 dat-state-set!
2520: 20 20 20 20 6e 65 77 20 73 74 61 74 65 29 0a 09 new state)..
2530: 09 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 ... (testda
2540: 74 2d 73 74 61 74 75 73 2d 73 65 74 21 20 20 20 t-status-set!
2550: 20 20 6e 65 77 20 73 74 61 74 75 73 29 0a 09 09 new status)...
2560: 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 .. (testdat
2570: 2d 63 6f 6d 6d 65 6e 74 2d 73 65 74 21 20 20 20 -comment-set!
2580: 20 6e 65 77 20 63 6d 74 73 74 72 29 0a 09 09 09 new cmtstr)....
2590: 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 2d . (testdat-
25a0: 64 65 74 61 69 6c 73 2d 73 65 74 21 20 20 20 20 details-set!
25b0: 6e 65 77 20 64 65 74 61 69 6c 73 29 0a 09 09 09 new details)....
25c0: 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 2d . (testdat-
25d0: 64 75 72 61 74 69 6f 6e 2d 73 65 74 21 20 20 20 duration-set!
25e0: 6e 65 77 20 64 75 72 61 74 69 6f 6e 29 0a 09 09 new duration)...
25f0: 09 09 20 20 20 20 20 20 28 74 65 73 74 64 61 74 .. (testdat
2600: 2d 65 76 65 6e 74 2d 74 69 6d 65 2d 73 65 74 21 -event-time-set!
2610: 20 6e 65 77 20 65 74 69 6d 65 29 20 3b 3b 20 28 new etime) ;; (
2620: 63 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 current-seconds)
2630: 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 73 )..... (tes
2640: 74 64 61 74 2d 6f 76 65 72 61 6c 6c 2d 73 65 74 tdat-overall-set
2650: 21 20 20 20 20 6e 65 77 20 6e 65 77 73 74 61 74 ! new newstat
2660: 29 0a 09 09 09 09 20 20 20 20 20 20 28 68 61 73 )..... (has
2670: 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 h-table-set! dat
2680: 61 20 74 6e 61 6d 65 20 6e 65 77 29 0a 09 09 09 a tname new)....
2690: 09 20 20 20 20 20 20 6e 65 77 29 29 29 29 0a 09 . new))))..
26a0: 09 28 69 66 20 28 6e 6f 74 20 69 73 2d 74 6f 70 .(if (not is-top
26b0: 29 0a 09 09 20 20 20 20 28 68 61 73 68 2d 74 61 )... (hash-ta
26c0: 62 6c 65 2d 73 65 74 21 20 64 61 74 61 20 27 74 ble-set! data 't
26d0: 71 75 65 75 65 20 28 63 6f 6e 73 20 74 64 61 74 queue (cons tdat
26e0: 20 74 71 75 65 75 65 29 29 29 0a 20 20 20 20 20 tqueue))).
26f0: 20 20 20 20 20 20 20 20 20 20 20 28 68 61 73 68 (hash
2700: 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 61 74 61 -table-set! data
2710: 20 74 6e 61 6d 65 20 74 64 61 74 29 0a 20 20 20 tname tdat).
2720: 20 20 20 20 20 20 20 20 20 20 20 20 20 29 29 0a )).
2730: 20 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 test
2740: 73 29 29 29 0a 20 20 20 20 20 20 20 72 75 6e 2d s))). run-
2750: 69 64 73 29 0a 20 20 20 20 20 20 6e 6f 77 29 29 ids). now))
2760: 0a 20 20 20 20 20 20 0a 28 64 65 66 69 6e 65 20 . .(define
2770: 28 6d 6f 6e 69 74 6f 72 20 70 69 64 29 0a 20 20 (monitor pid).
2780: 28 6c 65 74 2a 20 28 28 72 75 6e 2d 69 64 73 20 (let* ((run-ids
2790: 27 28 29 29 0a 09 20 28 74 65 73 74 64 61 74 73 '()).. (testdats
27a0: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
27b0: 65 29 29 20 20 3b 3b 20 65 61 63 68 20 65 6e 74 e)) ;; each ent
27c0: 72 79 20 69 73 20 61 20 6c 69 73 74 20 6f 66 20 ry is a list of
27d0: 74 65 73 74 64 61 74 20 73 74 72 75 63 74 73 0a testdat structs.
27e0: 09 20 28 6b 65 79 73 20 20 20 20 23 66 29 0a 09 . (keys #f)..
27f0: 20 28 6c 61 73 74 2d 75 70 64 61 74 65 20 30 29 (last-update 0)
2800: 0a 09 20 28 74 61 72 67 65 74 20 20 28 6f 72 20 .. (target (or
2810: 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d (args:get-arg "-
2820: 74 61 72 67 65 74 22 29 0a 09 09 20 20 20 20 20 target")...
2830: 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 20 22 (args:get-arg "
2840: 2d 72 65 71 74 61 72 67 22 29 29 29 0a 09 20 28 -reqtarg"))).. (
2850: 72 75 6e 6e 61 6d 65 20 28 61 72 67 73 3a 67 65 runname (args:ge
2860: 74 2d 61 72 67 20 22 2d 72 75 6e 6e 61 6d 65 22 t-arg "-runname"
2870: 29 29 0a 09 20 28 74 73 6e 61 6d 65 20 20 23 66 )).. (tsname #f
2880: 29 0a 09 20 28 66 6c 6f 77 69 64 20 20 28 63 6f ).. (flowid (co
2890: 6e 63 20 74 61 72 67 65 74 20 22 2f 22 20 72 75 nc target "/" ru
28a0: 6e 6e 61 6d 65 29 29 0a 09 20 28 74 64 65 6c 61 nname)).. (tdela
28b0: 79 20 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 y (string->numb
28c0: 65 72 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 er (or (args:get
28d0: 2d 61 72 67 20 22 2d 64 65 6c 61 79 22 29 20 22 -arg "-delay") "
28e0: 31 35 22 29 29 29 29 0a 20 20 20 20 28 69 66 20 15")))). (if
28f0: 28 61 6e 64 20 74 61 72 67 65 74 20 72 75 6e 6e (and target runn
2900: 61 6d 65 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 ame)..(begin..
2910: 28 6c 61 75 6e 63 68 3a 73 65 74 75 70 29 0a 09 (launch:setup)..
2920: 20 20 28 73 65 74 21 20 6b 65 79 73 20 28 72 6d (set! keys (rm
2930: 74 3a 67 65 74 2d 6b 65 79 73 29 29 29 29 0a 20 t:get-keys)))).
2940: 20 20 20 28 73 65 74 21 20 74 73 6e 61 6d 65 20 (set! tsname
2950: 20 28 63 6f 6d 6d 6f 6e 3a 67 65 74 2d 74 65 73 (common:get-tes
2960: 74 73 75 69 74 65 2d 6e 61 6d 65 29 29 0a 20 20 tsuite-name)).
2970: 20 20 28 70 72 69 6e 74 20 22 54 43 4d 54 3a 20 (print "TCMT:
2980: 66 6f 72 20 74 65 73 74 73 75 69 74 65 3d 22 20 for testsuite="
2990: 74 73 6e 61 6d 65 20 22 20 66 6f 75 6e 64 20 72 tsname " found r
29a0: 75 6e 6e 61 6d 65 3d 22 20 72 75 6e 6e 61 6d 65 unname=" runname
29b0: 20 22 2c 20 74 61 72 67 65 74 3d 22 20 74 61 72 ", target=" tar
29c0: 67 65 74 20 22 2c 20 6b 65 79 73 3d 22 20 6b 65 get ", keys=" ke
29d0: 79 73 20 22 20 61 6e 64 20 73 75 63 63 65 73 73 ys " and success
29e0: 66 75 6c 6c 79 20 72 61 6e 20 6c 61 75 6e 63 68 fully ran launch
29f0: 3a 73 65 74 75 70 2e 20 55 73 69 6e 67 20 22 20 :setup. Using "
2a00: 66 6c 6f 77 69 64 20 22 20 61 73 20 74 68 65 20 flowid " as the
2a10: 66 6c 6f 77 49 64 2e 22 29 0a 20 20 20 20 28 6c flowId."). (l
2a20: 65 74 20 6c 6f 6f 70 20 28 29 0a 20 20 20 20 20 et loop ().
2a30: 20 3b 3b 3b 3b 3b 3b 20 28 68 61 6e 64 6c 65 2d ;;;;;; (handle-
2a40: 65 78 63 65 70 74 69 6f 6e 73 0a 20 20 20 20 20 exceptions.
2a50: 20 3b 3b 3b 3b 3b 3b 20 20 65 78 6e 0a 20 20 20 ;;;;;; exn.
2a60: 20 20 20 3b 3b 3b 3b 3b 3b 20 20 3b 3b 20 28 70 ;;;;;; ;; (p
2a70: 72 69 6e 74 20 22 50 72 6f 63 65 73 73 20 64 6f rint "Process do
2a80: 6e 65 2e 22 29 0a 20 20 20 20 20 20 3b 3b 3b 3b ne."). ;;;;
2a90: 3b 3b 20 20 28 62 65 67 69 6e 20 28 70 72 69 6e ;; (begin (prin
2aa0: 74 2d 63 61 6c 6c 2d 63 68 61 69 6e 29 20 28 70 t-call-chain) (p
2ab0: 72 69 6e 74 20 22 45 72 72 6f 72 20 6d 65 73 73 rint "Error mess
2ac0: 61 67 65 3a 20 22 20 28 28 63 6f 6e 64 69 74 69 age: " ((conditi
2ad0: 6f 6e 2d 70 72 6f 70 65 72 74 79 2d 61 63 63 65 on-property-acce
2ae0: 73 73 6f 72 20 27 65 78 6e 20 27 6d 65 73 73 61 ssor 'exn 'messa
2af0: 67 65 29 20 65 78 6e 29 29 29 0a 20 20 20 20 20 ge) exn))).
2b00: 20 20 28 6c 65 74 2d 76 61 6c 75 65 73 20 28 28 (let-values ((
2b10: 28 70 69 64 72 65 73 20 65 78 69 74 74 79 70 65 (pidres exittype
2b20: 20 65 78 69 74 73 74 61 74 75 73 29 0a 09 09 20 exitstatus)...
2b30: 20 20 20 20 28 70 72 6f 63 65 73 73 2d 77 61 69 (process-wai
2b40: 74 20 70 69 64 20 23 74 29 29 29 0a 09 20 28 69 t pid #t))).. (i
2b50: 66 20 28 61 6e 64 20 6b 65 79 73 0a 09 09 20 20 f (and keys...
2b60: 28 6f 72 20 28 6e 6f 74 20 72 75 6e 2d 69 64 73 (or (not run-ids
2b70: 29 0a 09 09 20 20 20 20 20 20 28 6e 75 6c 6c 3f )... (null?
2b80: 20 72 75 6e 2d 69 64 73 29 29 29 0a 09 20 20 20 run-ids)))..
2b90: 20 20 28 6c 65 74 2a 20 28 28 72 75 6e 73 20 28 (let* ((runs (
2ba0: 72 6d 74 3a 67 65 74 2d 72 75 6e 73 2d 62 79 2d rmt:get-runs-by-
2bb0: 70 61 74 74 20 6b 65 79 73 0a 09 09 09 09 09 09 patt keys.......
2bc0: 72 75 6e 6e 61 6d 65 20 0a 09 09 09 09 09 09 74 runname .......t
2bd0: 61 72 67 65 74 0a 09 09 09 09 09 09 23 66 20 3b arget.......#f ;
2be0: 3b 20 6f 66 66 73 65 74 0a 09 09 09 09 09 09 23 ; offset.......#
2bf0: 66 20 3b 3b 20 6c 69 6d 69 74 0a 09 09 09 09 09 f ;; limit......
2c00: 09 23 66 20 3b 3b 20 66 69 65 6c 64 73 0a 09 09 .#f ;; fields...
2c10: 09 09 09 09 30 20 20 3b 3b 20 6c 61 73 74 2d 75 ....0 ;; last-u
2c20: 70 64 61 74 65 0a 09 09 09 09 09 09 29 29 0a 09 pdate.......))..
2c30: 09 20 20 20 20 28 68 65 61 64 65 72 20 28 64 62 . (header (db
2c40: 3a 67 65 74 2d 68 65 61 64 65 72 20 72 75 6e 73 :get-header runs
2c50: 29 29 0a 09 09 20 20 20 20 28 72 6f 77 73 20 20 ))... (rows
2c60: 20 28 64 62 3a 67 65 74 2d 72 6f 77 73 20 20 20 (db:get-rows
2c70: 72 75 6e 73 29 29 0a 09 09 20 20 20 20 28 72 75 runs))... (ru
2c80: 6e 2d 69 64 73 2d 69 6e 20 28 6d 61 70 20 28 6c n-ids-in (map (l
2c90: 61 6d 62 64 61 20 28 72 6f 77 29 0a 09 09 09 09 ambda (row).....
2ca0: 20 20 20 20 20 20 20 28 64 62 3a 67 65 74 2d 76 (db:get-v
2cb0: 61 6c 75 65 2d 62 79 2d 68 65 61 64 65 72 20 72 alue-by-header r
2cc0: 6f 77 20 68 65 61 64 65 72 20 22 69 64 22 29 29 ow header "id"))
2cd0: 0a 09 09 09 09 20 20 20 20 20 72 6f 77 73 29 29 ..... rows))
2ce0: 29 0a 09 20 20 20 20 20 20 20 28 73 65 74 21 20 ).. (set!
2cf0: 72 75 6e 2d 69 64 73 20 72 75 6e 2d 69 64 73 2d run-ids run-ids-
2d00: 69 6e 29 29 29 0a 09 20 3b 3b 20 28 70 72 69 6e in))).. ;; (prin
2d10: 74 20 22 54 43 4d 54 3a 20 70 69 64 72 65 73 3d t "TCMT: pidres=
2d20: 22 20 70 69 64 72 65 73 20 22 20 65 78 69 74 74 " pidres " exitt
2d30: 79 70 65 3d 22 20 65 78 69 74 74 79 70 65 20 22 ype=" exittype "
2d40: 20 65 78 69 74 73 74 61 74 75 73 3d 22 20 65 78 exitstatus=" ex
2d50: 69 74 73 74 61 74 75 73 20 22 20 72 75 6e 2d 69 itstatus " run-i
2d60: 64 73 3d 22 20 72 75 6e 2d 69 64 73 29 0a 09 20 ds=" run-ids)..
2d70: 28 69 66 20 28 65 71 3f 20 70 69 64 72 65 73 20 (if (eq? pidres
2d80: 30 29 0a 09 20 20 20 20 20 28 62 65 67 69 6e 0a 0).. (begin.
2d90: 09 20 20 20 20 20 20 20 28 69 66 20 6b 65 79 73 . (if keys
2da0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2db0: 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 (begin.
2dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dd0: 28 73 65 74 21 20 6c 61 73 74 2d 75 70 64 61 74 (set! last-updat
2de0: 65 20 28 2d 20 28 75 70 64 61 74 65 2d 71 75 65 e (- (update-que
2df0: 75 65 2d 73 69 6e 63 65 20 74 65 73 74 64 61 74 ue-since testdat
2e00: 73 20 72 75 6e 2d 69 64 73 20 6c 61 73 74 2d 75 s run-ids last-u
2e10: 70 64 61 74 65 20 74 73 6e 61 6d 65 20 74 61 72 pdate tsname tar
2e20: 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 6c 6f 77 get runname flow
2e30: 69 64 20 23 66 29 20 35 29 29 0a 20 20 20 20 20 id #f) 5)).
2e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2e50: 28 70 72 6f 63 65 73 73 2d 71 75 65 75 65 20 74 (process-queue t
2e60: 65 73 74 64 61 74 73 20 74 64 65 6c 61 79 20 23 estdats tdelay #
2e70: 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
2e80: 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 (thread-slee
2e90: 70 21 20 33 29 0a 09 20 20 20 20 20 20 20 28 6c p! 3).. (l
2ea0: 6f 6f 70 29 29 0a 09 20 20 20 20 20 28 62 65 67 oop)).. (beg
2eb0: 69 6e 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 70 in.. ;; (p
2ec0: 72 69 6e 74 20 22 54 43 4d 54 3a 20 70 69 64 72 rint "TCMT: pidr
2ed0: 65 73 3d 22 20 70 69 64 72 65 73 20 22 20 65 78 es=" pidres " ex
2ee0: 69 74 74 79 70 65 3d 22 20 65 78 69 74 74 79 70 ittype=" exittyp
2ef0: 65 20 22 20 65 78 69 74 73 74 61 74 75 73 3d 22 e " exitstatus="
2f00: 20 65 78 69 74 73 74 61 74 75 73 20 22 20 72 75 exitstatus " ru
2f10: 6e 2d 69 64 73 3d 22 20 72 75 6e 2d 69 64 73 29 n-ids=" run-ids)
2f20: 0a 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 .. (print
2f30: 22 54 43 4d 54 3a 20 70 72 6f 63 65 73 73 69 6e "TCMT: processin
2f40: 67 20 61 6e 79 20 74 65 73 74 73 20 74 68 61 74 g any tests that
2f50: 20 64 69 64 20 6e 6f 74 20 66 6f 72 6d 61 6c 6c did not formall
2f60: 79 20 63 6f 6d 70 6c 65 74 65 2e 22 29 0a 09 20 y complete.")..
2f70: 20 20 20 20 20 20 28 75 70 64 61 74 65 2d 71 75 (update-qu
2f80: 65 75 65 2d 73 69 6e 63 65 20 74 65 73 74 64 61 eue-since testda
2f90: 74 73 20 72 75 6e 2d 69 64 73 20 30 20 74 73 6e ts run-ids 0 tsn
2fa0: 61 6d 65 20 74 61 72 67 65 74 20 72 75 6e 6e 61 ame target runna
2fb0: 6d 65 20 66 6c 6f 77 69 64 20 23 74 29 20 3b 3b me flowid #t) ;;
2fc0: 20 63 61 6c 6c 20 69 6e 20 66 6c 75 73 68 20 6d call in flush m
2fd0: 6f 64 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ode.
2fe0: 20 20 20 28 70 72 6f 63 65 73 73 2d 71 75 65 75 (process-queu
2ff0: 65 20 74 65 73 74 64 61 74 73 20 30 20 23 74 29 e testdats 0 #t)
3000: 0a 09 20 20 20 20 20 20 20 28 70 72 69 6e 74 20 .. (print
3010: 22 54 43 4d 54 3a 20 41 6c 6c 20 64 6f 6e 65 2e "TCMT: All done.
3020: 22 29 0a 09 20 20 20 20 20 20 20 29 29 29 29 29 ").. )))))
3030: 29 0a 3b 3b 3b 3b 3b 20 29 0a 0a 3b 3b 20 28 74 ).;;;;; )..;; (t
3040: 72 61 63 65 20 70 72 69 6e 74 2d 63 68 61 6e 67 race print-chang
3050: 65 73 2d 73 69 6e 63 65 29 0a 0a 3b 3b 20 28 69 es-since)..;; (i
3060: 66 20 28 6e 6f 74 20 28 65 71 3f 20 70 69 64 72 f (not (eq? pidr
3070: 65 73 20 30 29 29 09 20 20 3b 3b 20 28 6e 6f 74 es 0)). ;; (not
3080: 20 65 78 69 74 73 74 61 74 75 73 29 29 0a 3b 3b exitstatus)).;;
3090: 20 09 20 20 28 62 65 67 69 6e 0a 3b 3b 20 09 20 . (begin.;; .
30a0: 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 (thread-sleep
30b0: 21 20 33 29 0a 3b 3b 20 09 20 20 20 20 28 6c 6f ! 3).;; . (lo
30c0: 6f 70 29 29 0a 3b 3b 20 09 20 20 28 70 72 69 6e op)).;; . (prin
30d0: 74 20 22 50 72 6f 63 65 73 73 3a 20 6d 65 67 61 t "Process: mega
30e0: 74 65 73 74 20 22 20 28 73 74 72 69 6e 67 2d 69 test " (string-i
30f0: 6e 74 65 72 73 70 65 72 73 65 20 6f 72 69 67 61 ntersperse origa
3100: 72 67 73 20 22 20 22 29 20 22 20 69 73 20 64 6f rgs " ") " is do
3110: 6e 65 2e 22 29 29 29 29 29 0a 28 64 65 66 69 6e ne."))))).(defin
3120: 65 20 28 6d 61 69 6e 29 0a 20 20 28 6c 65 74 2a e (main). (let*
3130: 20 28 28 6d 74 2d 64 6f 6e 65 20 23 66 29 0a 09 ((mt-done #f)..
3140: 20 28 70 69 64 20 20 20 20 20 23 66 29 0a 09 20 (pid #f)..
3150: 28 74 68 31 20 20 20 20 20 28 6d 61 6b 65 2d 74 (th1 (make-t
3160: 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 29 hread (lambda ()
3170: 0a 09 09 09 09 20 28 70 72 69 6e 74 20 22 52 75 ..... (print "Ru
3180: 6e 6e 69 6e 67 20 6d 65 67 61 74 65 73 74 20 22 nning megatest "
3190: 20 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 (string-intersp
31a0: 65 72 73 65 20 6f 72 69 67 61 72 67 73 20 22 20 erse origargs "
31b0: 22 29 29 0a 09 09 09 09 20 28 73 65 74 21 20 70 "))..... (set! p
31c0: 69 64 20 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 id (process-run
31d0: 22 6d 65 67 61 74 65 73 74 22 20 6f 72 69 67 61 "megatest" origa
31e0: 72 67 73 29 29 29 0a 09 09 09 20 20 20 20 20 20 rgs)))....
31f0: 20 22 4d 65 67 61 74 65 73 74 20 6a 6f 62 22 29 "Megatest job")
3200: 29 0a 09 20 28 74 68 32 20 20 20 20 20 28 6d 61 ).. (th2 (ma
3210: 6b 65 2d 74 68 72 65 61 64 20 28 6c 61 6d 62 64 ke-thread (lambd
3220: 61 20 28 29 0a 09 09 09 09 20 28 6d 6f 6e 69 74 a ()..... (monit
3230: 6f 72 20 70 69 64 29 29 0a 09 09 09 20 20 20 20 or pid))....
3240: 20 20 20 22 4d 6f 6e 69 74 6f 72 20 6a 6f 62 22 "Monitor job"
3250: 29 29 29 0a 20 20 20 20 28 74 68 72 65 61 64 2d ))). (thread-
3260: 73 74 61 72 74 21 20 74 68 31 29 0a 20 20 20 20 start! th1).
3270: 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 31 (thread-sleep! 1
3280: 29 20 3b 3b 20 67 69 76 65 20 74 68 65 20 70 72 ) ;; give the pr
3290: 6f 63 65 73 73 20 74 69 6d 65 20 74 6f 20 67 65 ocess time to ge
32a0: 74 20 67 6f 69 6e 67 0a 20 20 20 20 28 74 68 72 t going. (thr
32b0: 65 61 64 2d 73 74 61 72 74 21 20 74 68 32 29 0a ead-start! th2).
32c0: 20 20 20 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e (thread-join
32d0: 21 20 74 68 32 29 29 29 0a 0a 28 69 66 20 28 61 ! th2)))..(if (a
32e0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 74 63 rgs:get-arg "-tc
32f0: 2d 72 65 70 6c 22 29 0a 20 20 20 20 28 72 65 70 -repl"). (rep
3300: 6c 29 0a 20 20 20 20 28 6d 61 69 6e 29 29 0a 0a l). (main))..
3310: 3b 3b 20 28 70 72 6f 63 65 73 73 2d 77 61 69 74 ;; (process-wait
3320: 29 0a 0a )..