Artifact
b9b4d16e513ce4128f175b577260e955b9b69d0e:
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 32 30 30 ;; Copyright 200
0010: 36 2d 32 30 31 37 2c 20 4d 61 74 74 68 65 77 20 6-2017, Matthew
0020: 57 65 6c 6c 61 6e 64 2e 0a 3b 3b 20 0a 3b 3b 20 Welland..;; .;;
0030: 54 68 69 73 20 66 69 6c 65 20 69 73 20 70 61 72 This file is par
0040: 74 20 6f 66 20 4d 65 67 61 74 65 73 74 2e 0a 3b t of Megatest..;
0050: 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 65 ; .;; Megate
0060: 73 74 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 st is free softw
0070: 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 are: you can red
0080: 69 73 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 istribute it and
0090: 2f 6f 72 20 6d 6f 64 69 66 79 0a 3b 3b 20 20 20 /or modify.;;
00a0: 20 20 69 74 20 75 6e 64 65 72 20 74 68 65 20 74 it under the t
00b0: 65 72 6d 73 20 6f 66 20 74 68 65 20 47 4e 55 20 erms of the GNU
00c0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
00d0: 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 icense as publis
00e0: 68 65 64 20 62 79 0a 3b 3b 20 20 20 20 20 74 68 hed by.;; th
00f0: 65 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 e Free Software
0100: 46 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 Foundation, eith
0110: 65 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 er version 3 of
0120: 74 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a the License, or.
0130: 3b 3b 20 20 20 20 20 28 61 74 20 79 6f 75 72 20 ;; (at your
0140: 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 74 65 option) any late
0150: 72 20 76 65 72 73 69 6f 6e 2e 0a 3b 3b 20 0a 3b r version..;; .;
0160: 3b 20 20 20 20 20 4d 65 67 61 74 65 73 74 20 69 ; Megatest i
0170: 73 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e s distributed in
0180: 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 the hope that i
0190: 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c t will be useful
01a0: 2c 0a 3b 3b 20 20 20 20 20 62 75 74 20 57 49 54 ,.;; but WIT
01b0: 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e 54 HOUT ANY WARRANT
01c0: 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e 20 Y; without even
01d0: 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 72 the implied warr
01e0: 61 6e 74 79 20 6f 66 0a 3b 3b 20 20 20 20 20 4d anty of.;; M
01f0: 45 52 43 48 41 4e 54 41 42 49 4c 49 54 59 20 6f ERCHANTABILITY o
0200: 72 20 46 49 54 4e 45 53 53 20 46 4f 52 20 41 20 r FITNESS FOR A
0210: 50 41 52 54 49 43 55 4c 41 52 20 50 55 52 50 4f PARTICULAR PURPO
0220: 53 45 2e 20 20 53 65 65 20 74 68 65 0a 3b 3b 20 SE. See the.;;
0230: 20 20 20 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 GNU General
0240: 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 Public License f
0250: 6f 72 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e or more details.
0260: 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 59 6f 75 20 .;; .;; You
0270: 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 should have rece
0280: 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 ived a copy of t
0290: 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 he GNU General P
02a0: 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 0a 3b 3b ublic License.;;
02b0: 20 20 20 20 20 61 6c 6f 6e 67 20 77 69 74 68 20 along with
02c0: 4d 65 67 61 74 65 73 74 2e 20 20 49 66 20 6e 6f Megatest. If no
02d0: 74 2c 20 73 65 65 20 3c 68 74 74 70 3a 2f 2f 77 t, see <http://w
02e0: 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e ww.gnu.org/licen
02f0: 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ses/>...;;======
0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0340: 0a 3b 3b 0a 3b 3b 20 57 72 61 70 70 65 72 20 74 .;;.;; Wrapper t
0350: 6f 20 65 6e 61 62 6c 65 20 72 75 6e 6e 69 6e 67 o enable running
0360: 20 4d 65 67 61 74 65 73 74 20 66 6c 6f 77 73 20 Megatest flows
0370: 75 6e 64 65 72 20 74 65 61 6d 63 69 74 79 0a 3b under teamcity.;
0380: 3b 0a 3b 3b 20 20 31 2e 20 52 75 6e 20 74 68 65 ;.;; 1. Run the
0390: 20 6d 65 67 61 74 65 73 74 20 70 72 6f 63 65 73 megatest proces
03a0: 73 20 61 6e 64 20 70 61 73 73 20 69 74 20 61 6c s and pass it al
03b0: 6c 20 74 68 65 20 6e 65 65 64 65 64 20 70 61 72 l the needed par
03c0: 61 6d 65 74 65 72 73 0a 3b 3b 20 20 32 2e 20 45 ameters.;; 2. E
03d0: 76 65 72 79 20 66 69 76 65 20 73 65 63 6f 6e 64 very five second
03e0: 73 20 63 68 65 63 6b 20 66 6f 72 20 73 74 61 74 s check for stat
03f0: 65 2f 73 74 61 74 75 73 20 63 68 61 6e 67 65 73 e/status changes
0400: 20 61 6e 64 20 70 72 69 6e 74 20 74 68 65 20 69 and print the i
0410: 6e 66 6f 0a 3b 3b 0a 0a 28 75 73 65 20 73 72 66 nfo.;;..(use srf
0420: 69 2d 31 20 70 6f 73 69 78 20 73 72 66 69 2d 36 i-1 posix srfi-6
0430: 39 20 73 72 66 69 2d 31 38 20 72 65 67 65 78 20 9 srfi-18 regex
0440: 64 65 66 73 74 72 75 63 74 29 0a 0a 28 75 73 65 defstruct)..(use
0450: 20 74 72 61 63 65 29 0a 3b 3b 20 28 74 72 61 63 trace).;; (trac
0460: 65 2d 63 61 6c 6c 2d 73 69 74 65 73 20 23 74 29 e-call-sites #t)
0470: 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ..(declare (uses
0480: 20 72 6d 74 29 29 0a 28 64 65 63 6c 61 72 65 20 rmt)).(declare
0490: 28 75 73 65 73 20 63 6f 6d 6d 6f 6e 29 29 0a 28 (uses common)).(
04a0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 61 declare (uses ma
04b0: 72 67 73 6d 6f 64 29 29 0a 28 69 6d 70 6f 72 74 rgsmod)).(import
04c0: 20 6d 61 72 67 73 6d 6f 64 29 0a 0a 3b 3b 20 28 margsmod)..;; (
04d0: 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 6d 65 declare (uses me
04e0: 67 61 74 65 73 74 2d 76 65 72 73 69 6f 6e 29 29 gatest-version))
04f0: 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ..(declare (uses
0500: 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 0a 28 64 65 commonmod)).(de
0510: 63 6c 61 72 65 20 28 75 73 65 73 20 64 65 62 75 clare (uses debu
0520: 67 70 72 69 6e 74 29 29 0a 28 69 6d 70 6f 72 74 gprint)).(import
0530: 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 0a 28 69 6d 70 commonmod).(imp
0540: 6f 72 74 20 64 65 62 75 67 70 72 69 6e 74 29 0a ort debugprint).
0550: 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 74 .(include "megat
0560: 65 73 74 2d 76 65 72 73 69 6f 6e 2e 73 63 6d 22 est-version.scm"
0570: 29 0a 28 69 6e 63 6c 75 64 65 20 22 6d 65 67 61 ).(include "mega
0580: 74 65 73 74 2d 66 6f 73 73 69 6c 2d 68 61 73 68 test-fossil-hash
0590: 2e 73 63 6d 22 29 0a 28 69 6e 63 6c 75 64 65 20 .scm").(include
05a0: 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 63 6d 22 "db_records.scm"
05b0: 29 0a 0a 28 64 65 66 69 6e 65 20 6f 72 69 67 61 )..(define origa
05c0: 72 67 73 20 28 63 64 72 20 28 61 72 67 76 29 29 rgs (cdr (argv))
05d0: 29 0a 28 64 65 66 69 6e 65 20 72 65 6d 61 72 67 ).(define remarg
05e0: 73 20 28 61 72 67 73 3a 67 65 74 2d 61 72 67 73 s (args:get-args
05f0: 0a 09 09 20 28 61 72 67 76 29 0a 09 09 20 60 28 ... (argv)... `(
0600: 20 22 2d 74 61 72 67 65 74 22 0a 09 09 20 20 20 "-target"...
0610: 20 22 2d 72 65 71 74 61 72 67 22 0a 09 09 20 20 "-reqtarg"...
0620: 20 20 22 2d 72 75 6e 6e 61 6d 65 22 0a 09 09 20 "-runname"...
0630: 20 20 20 22 2d 64 65 6c 61 79 22 20 20 20 3b 3b "-delay" ;;
0640: 20 68 6f 77 20 6c 6f 6e 67 20 74 6f 20 77 61 69 how long to wai
0650: 74 20 66 6f 72 20 75 6e 65 78 70 65 63 74 65 64 t for unexpected
0660: 20 63 68 61 6e 67 65 73 20 74 6f 20 0a 09 09 20 changes to ...
0670: 20 20 20 29 0a 09 09 20 60 28 22 2d 74 63 2d 72 )... `("-tc-r
0680: 65 70 6c 22 0a 09 09 20 20 20 29 0a 09 09 20 61 epl"... )... a
0690: 72 67 73 3a 61 72 67 2d 68 61 73 68 0a 09 09 20 rgs:arg-hash...
06a0: 30 29 29 0a 0a 28 64 65 66 73 74 72 75 63 74 20 0))..(defstruct
06b0: 74 65 73 74 64 61 74 0a 20 20 28 74 63 2d 74 79 testdat. (tc-ty
06c0: 70 65 20 23 66 29 0a 20 20 28 73 74 61 74 65 20 pe #f). (state
06d0: 20 20 23 66 29 0a 20 20 28 73 74 61 74 75 73 20 #f). (status
06e0: 20 23 66 29 0a 20 20 28 6f 76 65 72 61 6c 6c 20 #f). (overall
06f0: 23 66 29 0a 20 20 28 66 6c 6f 77 69 64 20 20 23 #f). (flowid #
0700: 66 29 0a 20 20 74 63 74 6e 61 6d 65 0a 20 20 74 f). tctname. t
0710: 6e 61 6d 65 0a 20 20 28 65 76 65 6e 74 2d 74 69 name. (event-ti
0720: 6d 65 20 23 66 29 0a 20 20 64 65 74 61 69 6c 73 me #f). details
0730: 0a 20 20 63 6f 6d 6d 65 6e 74 0a 20 20 64 75 72 . comment. dur
0740: 61 74 69 6f 6e 0a 20 20 28 73 74 61 72 74 2d 70 ation. (start-p
0750: 72 69 6e 74 65 64 20 23 66 29 0a 20 20 28 65 6e rinted #f). (en
0760: 64 2d 70 72 69 6e 74 65 64 20 20 20 23 66 29 29 d-printed #f))
0770: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
0780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 47 4c ==========.;; GL
07c0: 4f 42 41 4c 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d OBALS.;;========
07d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
07f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0800: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
0810: 3b 3b 20 47 6f 74 74 61 20 68 61 76 65 20 61 20 ;; Gotta have a
0820: 67 6c 6f 62 61 6c 3f 20 53 74 61 73 68 20 69 74 global? Stash it
0830: 20 69 6e 20 74 68 65 20 2a 67 6c 6f 62 61 6c 2a in the *global*
0840: 20 68 61 73 68 20 74 61 62 6c 65 2e 0a 3b 3b 0a hash table..;;.
0850: 28 64 65 66 69 6e 65 20 2a 67 6c 6f 62 61 6c 2a (define *global*
0860: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0870: 65 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 63 e))..(define (tc
0880: 6d 74 3a 70 72 69 6e 74 20 74 64 61 74 20 66 6c mt:print tdat fl
0890: 75 73 68 2d 6d 6f 64 65 29 0a 20 20 28 6c 65 74 ush-mode). (let
08a0: 2a 20 28 28 63 6f 6d 6d 65 6e 74 20 20 28 69 66 * ((comment (if
08b0: 20 28 74 65 73 74 64 61 74 2d 63 6f 6d 6d 65 6e (testdat-commen
08c0: 74 20 74 64 61 74 29 0a 09 09 20 20 20 20 20 20 t tdat)...
08d0: 20 28 63 6f 6e 63 20 22 20 6d 65 73 73 61 67 65 (conc " message
08e0: 3d 27 22 20 28 74 65 73 74 64 61 74 2d 63 6f 6d ='" (testdat-com
08f0: 6d 65 6e 74 20 74 64 61 74 29 20 22 27 22 29 0a ment tdat) "'").
0900: 09 09 20 20 20 20 20 20 20 22 22 29 29 0a 09 20 .. ""))..
0910: 28 64 65 74 61 69 6c 73 20 20 28 69 66 20 28 74 (details (if (t
0920: 65 73 74 64 61 74 2d 64 65 74 61 69 6c 73 20 74 estdat-details t
0930: 64 61 74 29 0a 09 09 20 20 20 20 20 20 20 28 63 dat)... (c
0940: 6f 6e 63 20 22 20 64 65 74 61 69 6c 73 3d 27 22 onc " details='"
0950: 20 28 74 65 73 74 64 61 74 2d 64 65 74 61 69 6c (testdat-detail
0960: 73 20 74 64 61 74 29 20 22 27 22 29 0a 09 09 20 s tdat) "'")...
0970: 20 20 20 20 20 20 22 22 29 29 0a 09 20 28 66 6c "")).. (fl
0980: 6f 77 69 64 20 20 20 28 63 6f 6e 63 20 22 20 66 owid (conc " f
0990: 6c 6f 77 49 64 3d 27 22 20 28 74 65 73 74 64 61 lowId='" (testda
09a0: 74 2d 66 6c 6f 77 69 64 20 20 20 74 64 61 74 29 t-flowid tdat)
09b0: 20 22 27 22 29 29 0a 09 20 28 64 75 72 61 74 69 "'")).. (durati
09c0: 6f 6e 20 28 63 6f 6e 63 20 22 20 64 75 72 61 74 on (conc " durat
09d0: 69 6f 6e 3d 27 22 20 28 2a 20 31 65 33 20 28 74 ion='" (* 1e3 (t
09e0: 65 73 74 64 61 74 2d 64 75 72 61 74 69 6f 6e 20 estdat-duration
09f0: 74 64 61 74 29 29 20 22 27 22 29 29 0a 09 20 28 tdat)) "'")).. (
0a00: 74 63 6e 61 6d 65 20 20 20 28 63 6f 6e 63 20 22 tcname (conc "
0a10: 20 6e 61 6d 65 3d 27 22 20 28 74 65 73 74 64 61 name='" (testda
0a20: 74 2d 74 63 74 6e 61 6d 65 20 20 74 64 61 74 29 t-tctname tdat)
0a30: 20 22 27 22 29 29 0a 09 20 28 73 74 61 74 65 20 "'")).. (state
0a40: 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 (string->symb
0a50: 6f 6c 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 ol (testdat-stat
0a60: 65 20 74 64 61 74 29 29 29 0a 09 20 28 73 74 61 e tdat))).. (sta
0a70: 74 75 73 20 20 20 28 73 74 72 69 6e 67 2d 3e 73 tus (string->s
0a80: 79 6d 62 6f 6c 20 28 74 65 73 74 64 61 74 2d 73 ymbol (testdat-s
0a90: 74 61 74 75 73 20 74 64 61 74 29 29 29 0a 09 20 tatus tdat)))..
0aa0: 28 73 74 61 72 74 70 20 20 20 28 74 65 73 74 64 (startp (testd
0ab0: 61 74 2d 73 74 61 72 74 2d 70 72 69 6e 74 65 64 at-start-printed
0ac0: 20 74 64 61 74 29 29 0a 09 20 28 65 6e 64 70 20 tdat)).. (endp
0ad0: 20 20 20 20 28 74 65 73 74 64 61 74 2d 65 6e 64 (testdat-end
0ae0: 2d 70 72 69 6e 74 65 64 20 20 20 74 64 61 74 29 -printed tdat)
0af0: 29 0a 09 20 28 65 74 69 6d 65 20 20 20 20 28 74 ).. (etime (t
0b00: 65 73 74 64 61 74 2d 65 76 65 6e 74 2d 74 69 6d estdat-event-tim
0b10: 65 20 20 20 20 74 64 61 74 29 29 0a 09 20 28 6f e tdat)).. (o
0b20: 76 65 72 61 6c 6c 20 20 28 63 61 73 65 20 73 74 verall (case st
0b30: 61 74 65 0a 09 09 20 20 20 20 20 28 28 52 55 4e ate... ((RUN
0b40: 4e 49 4e 47 29 20 20 20 73 74 61 74 65 29 0a 09 NING) state)..
0b50: 09 20 20 20 20 20 28 28 43 4f 4d 50 4c 45 54 45 . ((COMPLETE
0b60: 44 29 20 73 74 61 74 65 29 0a 09 09 20 20 20 20 D) state)...
0b70: 20 28 65 6c 73 65 20 27 55 4e 4b 29 29 29 0a 09 (else 'UNK)))..
0b80: 20 28 74 73 74 6d 70 20 20 20 20 28 63 6f 6e 63 (tstmp (conc
0b90: 20 22 20 74 69 6d 65 73 74 61 6d 70 3d 27 22 20 " timestamp='"
0ba0: 28 74 69 6d 65 2d 3e 73 74 72 69 6e 67 20 28 73 (time->string (s
0bb0: 65 63 6f 6e 64 73 2d 3e 6c 6f 63 61 6c 2d 74 69 econds->local-ti
0bc0: 6d 65 20 65 74 69 6d 65 29 20 22 25 46 54 25 54 me etime) "%FT%T
0bd0: 2e 30 30 30 22 29 20 22 27 22 29 29 29 0a 20 20 .000") "'"))).
0be0: 20 20 28 63 61 73 65 20 6f 76 65 72 61 6c 6c 0a (case overall.
0bf0: 20 20 20 20 20 20 28 28 52 55 4e 4e 49 4e 47 29 ((RUNNING)
0c00: 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 . (if (not
0c10: 20 73 74 61 72 74 70 29 0a 09 20 20 20 28 62 65 startp).. (be
0c20: 67 69 6e 0a 09 20 20 20 20 20 28 70 72 69 6e 74 gin.. (print
0c30: 20 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 "##teamcity[tes
0c40: 74 53 74 61 72 74 65 64 20 22 20 20 74 63 6e 61 tStarted " tcna
0c50: 6d 65 20 66 6c 6f 77 69 64 20 74 73 74 6d 70 20 me flowid tstmp
0c60: 22 5d 22 29 0a 09 20 20 20 20 20 28 74 65 73 74 "]").. (test
0c70: 64 61 74 2d 73 74 61 72 74 2d 70 72 69 6e 74 65 dat-start-printe
0c80: 64 2d 73 65 74 21 20 74 64 61 74 20 23 74 29 29 d-set! tdat #t))
0c90: 29 29 0a 20 20 20 20 20 20 28 28 43 4f 4d 50 4c )). ((COMPL
0ca0: 45 54 45 44 29 0a 20 20 20 20 20 20 20 28 69 66 ETED). (if
0cb0: 20 28 6e 6f 74 20 73 74 61 72 74 70 29 20 3b 3b (not startp) ;;
0cc0: 20 73 74 61 72 74 20 73 74 61 6e 7a 61 20 6e 65 start stanza ne
0cd0: 76 65 72 20 70 72 69 6e 74 65 64 0a 09 20 20 20 ver printed..
0ce0: 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 70 72 (begin.. (pr
0cf0: 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 79 5b int "##teamcity[
0d00: 74 65 73 74 53 74 61 72 74 65 64 20 22 20 74 63 testStarted " tc
0d10: 6e 61 6d 65 20 66 6c 6f 77 69 64 20 74 73 74 6d name flowid tstm
0d20: 70 20 22 5d 22 29 0a 09 20 20 20 20 20 28 74 65 p "]").. (te
0d30: 73 74 64 61 74 2d 73 74 61 72 74 2d 70 72 69 6e stdat-start-prin
0d40: 74 65 64 2d 73 65 74 21 20 74 64 61 74 20 23 74 ted-set! tdat #t
0d50: 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 ))). (if (
0d60: 6e 6f 74 20 65 6e 64 70 29 0a 09 20 20 20 28 62 not endp).. (b
0d70: 65 67 69 6e 0a 09 20 20 20 20 20 28 69 66 20 28 egin.. (if (
0d80: 6e 6f 74 20 28 6d 65 6d 62 65 72 20 73 74 61 74 not (member stat
0d90: 75 73 20 27 28 50 41 53 53 20 57 41 52 4e 20 53 us '(PASS WARN S
0da0: 4b 49 50 20 57 41 49 56 45 44 29 29 29 0a 09 09 KIP WAIVED)))...
0db0: 20 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 (print "##teamc
0dc0: 69 74 79 5b 74 65 73 74 46 61 69 6c 65 64 20 20 ity[testFailed
0dd0: 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 " tcname flowid
0de0: 63 6f 6d 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 comment details
0df0: 22 5d 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 "]")).
0e00: 20 20 20 28 70 72 69 6e 74 20 22 23 23 74 65 61 (print "##tea
0e10: 6d 63 69 74 79 5b 74 65 73 74 46 69 6e 69 73 68 mcity[testFinish
0e20: 65 64 22 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 ed" tcname flowi
0e30: 64 20 63 6f 6d 6d 65 6e 74 20 64 65 74 61 69 6c d comment detail
0e40: 73 20 64 75 72 61 74 69 6f 6e 20 22 5d 22 29 0a s duration "]").
0e50: 09 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 65 . (testdat-e
0e60: 6e 64 2d 70 72 69 6e 74 65 64 2d 73 65 74 21 20 nd-printed-set!
0e70: 74 64 61 74 20 23 74 29 29 29 29 0a 20 20 20 20 tdat #t)))).
0e80: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 28 (else. (
0e90: 69 66 20 66 6c 75 73 68 2d 6d 6f 64 65 0a 09 20 if flush-mode..
0ea0: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 (begin.. (
0eb0: 69 66 20 28 6e 6f 74 20 73 74 61 72 74 70 29 0a if (not startp).
0ec0: 09 09 20 28 62 65 67 69 6e 0a 09 09 20 20 20 28 .. (begin... (
0ed0: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
0ee0: 79 5b 74 65 73 74 53 74 61 72 74 65 64 20 22 20 y[testStarted "
0ef0: 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 74 73 tcname flowid ts
0f00: 74 6d 70 20 22 5d 22 29 0a 09 09 20 20 20 28 74 tmp "]")... (t
0f10: 65 73 74 64 61 74 2d 73 74 61 72 74 2d 70 72 69 estdat-start-pri
0f20: 6e 74 65 64 2d 73 65 74 21 20 74 64 61 74 20 23 nted-set! tdat #
0f30: 74 29 29 29 0a 09 20 20 20 20 20 28 69 66 20 28 t))).. (if (
0f40: 6e 6f 74 20 65 6e 64 70 29 0a 09 09 20 28 62 65 not endp)... (be
0f50: 67 69 6e 0a 09 09 20 20 20 28 70 72 69 6e 74 20 gin... (print
0f60: 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 "##teamcity[test
0f70: 46 61 69 6c 65 64 20 20 22 20 74 63 6e 61 6d 65 Failed " tcname
0f80: 20 66 6c 6f 77 69 64 20 63 6f 6d 6d 65 6e 74 20 flowid comment
0f90: 64 65 74 61 69 6c 73 20 22 5d 22 29 0a 20 20 20 details "]").
0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0fb0: 28 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 (print "##teamci
0fc0: 74 79 5b 74 65 73 74 46 69 6e 69 73 68 65 64 22 ty[testFinished"
0fd0: 20 74 63 6e 61 6d 65 20 66 6c 6f 77 69 64 20 63 tcname flowid c
0fe0: 6f 6d 6d 65 6e 74 20 64 65 74 61 69 6c 73 20 64 omment details d
0ff0: 75 72 61 74 69 6f 6e 20 22 5d 22 29 0a 09 09 20 uration "]")...
1000: 20 20 28 74 65 73 74 64 61 74 2d 65 6e 64 2d 70 (testdat-end-p
1010: 72 69 6e 74 65 64 2d 73 65 74 21 20 74 64 61 74 rinted-set! tdat
1020: 20 23 74 29 29 29 29 29 29 29 0a 20 20 20 20 3b #t))))))). ;
1030: 3b 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a ; (print "ERROR:
1040: 20 74 63 2d 74 79 70 65 20 5c 22 22 20 28 74 65 tc-type \"" (te
1050: 73 74 64 61 74 2d 74 63 2d 74 79 70 65 20 74 64 stdat-tc-type td
1060: 61 74 29 20 22 5c 22 20 6e 6f 74 20 72 65 63 6f at) "\" not reco
1070: 67 6e 69 73 65 64 20 66 6f 72 20 22 20 74 63 6e gnised for " tcn
1080: 61 6d 65 29 29 29 0a 20 20 20 20 28 66 6c 75 73 ame))). (flus
1090: 68 2d 6f 75 74 70 75 74 29 29 29 0a 0a 3b 3b 20 h-output)))..;;
10a0: 3b 3b 20 72 65 74 75 72 6e 73 20 76 61 6c 75 65 ;; returns value
10b0: 73 3a 20 66 6c 61 67 20 6e 65 77 6c 73 74 0a 3b s: flag newlst.;
10c0: 3b 20 28 64 65 66 69 6e 65 20 28 72 65 6d 6f 76 ; (define (remov
10d0: 65 2d 64 75 70 6c 69 63 61 74 65 2d 63 6f 6d 70 e-duplicate-comp
10e0: 6c 65 74 65 64 20 20 74 64 61 74 73 29 0a 3b 3b leted tdats).;;
10f0: 20 20 20 28 6c 65 74 2a 20 28 28 66 6c 61 67 20 (let* ((flag
1100: 20 20 20 20 20 20 23 66 29 0a 3b 3b 20 20 20 20 #f).;;
1110: 20 20 20 20 20 20 28 73 74 61 74 65 20 20 20 20 (state
1120: 20 20 28 74 65 73 74 64 61 74 2d 73 74 61 74 65 (testdat-state
1130: 20 20 20 20 20 20 74 64 61 74 29 29 0a 3b 3b 20 tdat)).;;
1140: 20 20 20 20 20 20 20 20 20 28 73 74 61 74 75 73 (status
1150: 20 20 20 20 20 28 74 65 73 74 64 61 74 2d 73 74 (testdat-st
1160: 61 74 75 73 20 20 20 20 20 74 64 61 74 29 29 0a atus tdat)).
1170: 3b 3b 20 20 20 20 20 20 20 20 20 20 28 65 76 65 ;; (eve
1180: 6e 74 2d 74 69 6d 65 20 28 74 65 73 74 64 61 74 nt-time (testdat
1190: 2d 65 76 65 6e 74 2d 74 69 6d 65 20 74 64 61 74 -event-time tdat
11a0: 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 28 )).;; (
11b0: 74 6e 61 6d 65 20 20 20 20 20 20 28 74 65 73 74 tname (test
11c0: 64 61 74 2d 74 6e 61 6d 65 20 20 20 20 20 20 74 dat-tname t
11d0: 64 61 74 29 29 29 0a 3b 3b 20 20 20 20 20 28 6c dat))).;; (l
11e0: 65 74 20 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 et loop ((hed (c
11f0: 61 72 20 74 64 61 74 73 29 29 0a 3b 3b 20 20 20 ar tdats)).;;
1200: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 (ta
1210: 6c 20 28 63 64 72 20 74 64 61 74 73 29 29 0a 3b l (cdr tdats)).;
1220: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1230: 20 28 6e 65 77 20 27 28 29 29 29 0a 3b 3b 20 20 (new '())).;;
1240: 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 (if (and (e
1250: 71 75 61 6c 3f 20 73 74 61 74 65 20 22 43 4f 4d qual? state "COM
1260: 50 4c 45 54 45 44 22 29 0a 3b 3b 20 20 20 20 20 PLETED").;;
1270: 20 20 20 20 20 20 20 20 20 20 20 28 65 71 75 61 (equa
1280: 6c 3f 20 74 6e 61 6d 65 20 28 74 65 73 74 64 61 l? tname (testda
1290: 74 2d 74 6e 61 6d 65 20 68 65 64 29 29 0a 3b 3b t-tname hed)).;;
12a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12b0: 28 65 71 75 61 6c 3f 20 73 74 61 74 65 20 28 74 (equal? state (t
12c0: 65 73 74 64 61 74 2d 73 74 61 74 65 20 68 65 64 estdat-state hed
12d0: 29 29 29 20 3b 3b 20 77 65 20 68 61 76 65 20 61 ))) ;; we have a
12e0: 20 64 75 70 6c 69 63 61 74 65 20 43 4f 4d 50 4c duplicate COMPL
12f0: 45 54 45 44 20 63 61 6c 6c 0a 3b 3b 20 20 20 20 ETED call.;;
1300: 20 20 20 20 20 20 20 28 62 65 67 69 6e 0a 3b 3b (begin.;;
1310: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
1320: 74 21 20 66 6c 61 67 20 23 74 29 20 3b 3b 20 41 t! flag #t) ;; A
1330: 20 63 68 61 6e 67 65 64 20 63 6f 6d 70 6c 65 74 changed complet
1340: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 0a ed. .
1350: 3b 3b 20 70 72 6f 63 65 73 73 20 74 68 65 20 71 ;; process the q
1360: 75 65 75 65 20 6f 66 20 74 65 73 74 73 20 67 61 ueue of tests ga
1370: 74 68 65 72 65 64 20 73 6f 20 66 61 72 2e 20 4c thered so far. L
1380: 69 73 74 20 69 6e 63 6c 75 64 65 73 20 6f 6e 65 ist includes one
1390: 20 65 6e 74 72 79 20 66 6f 72 20 65 76 65 72 79 entry for every
13a0: 20 74 65 73 74 20 73 6f 20 66 61 72 20 73 65 65 test so far see
13b0: 6e 0a 3b 3b 20 74 68 65 20 6c 61 73 74 20 72 65 n.;; the last re
13c0: 63 6f 72 64 20 66 6f 72 20 61 20 74 65 73 74 20 cord for a test
13d0: 69 73 20 70 72 65 73 65 72 76 65 64 2e 20 49 74 is preserved. It
13e0: 65 6d 73 20 61 72 65 20 6f 6e 6c 79 20 72 65 6d ems are only rem
13f0: 6f 76 65 64 20 66 72 6f 6d 20 74 68 65 20 6c 69 oved from the li
1400: 73 74 20 69 66 20 6f 76 65 72 20 31 35 20 73 65 st if over 15 se
1410: 63 6f 6e 64 73 0a 3b 3b 20 68 61 76 65 20 70 61 conds.;; have pa
1420: 73 73 65 64 20 73 69 6e 63 65 20 69 74 20 68 61 ssed since it ha
1430: 70 70 65 6e 65 64 2e 20 54 68 69 73 20 61 6c 6c ppened. This all
1440: 6f 77 73 20 66 6f 72 20 63 6f 6d 70 72 65 73 73 ows for compress
1450: 69 6f 6e 20 6f 66 20 43 4f 4d 50 4c 45 54 45 44 ion of COMPLETED
1460: 2f 46 41 49 4c 20 66 6f 6c 6c 6f 77 65 64 20 62 /FAIL followed b
1470: 79 20 73 6f 6d 65 20 6f 74 68 65 72 0a 3b 3b 20 y some other.;;
1480: 73 74 61 74 65 2f 73 74 61 74 75 73 0a 3b 3b 0a state/status.;;.
1490: 28 64 65 66 69 6e 65 20 28 70 72 6f 63 65 73 73 (define (process
14a0: 2d 71 75 65 75 65 20 64 61 74 61 20 61 67 65 20 -queue data age
14b0: 66 6c 75 73 68 2d 6d 6f 64 65 29 0a 20 20 3b 3b flush-mode). ;;
14c0: 20 68 65 72 65 20 77 65 20 70 72 6f 63 65 73 73 here we process
14d0: 20 74 71 75 65 75 65 20 61 6e 64 20 67 61 74 68 tqueue and gath
14e0: 65 72 20 74 68 6f 73 65 20 6f 76 65 72 20 31 35 er those over 15
14f0: 20 73 65 63 6f 6e 64 73 20 28 63 6f 6e 66 69 67 seconds (config
1500: 75 72 61 62 6c 65 3f 29 20 6f 6c 64 0a 20 20 28 urable?) old. (
1510: 6c 65 74 2a 20 28 28 70 72 69 6e 74 2d 74 69 6d let* ((print-tim
1520: 65 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 e (- (current-se
1530: 63 6f 6e 64 73 29 20 61 67 65 29 29 20 3b 3b 20 conds) age)) ;;
1540: 70 72 69 6e 74 20 73 74 75 66 66 20 6f 76 65 72 print stuff over
1550: 20 31 35 20 73 65 63 6f 6e 64 73 20 6f 6c 64 0a 15 seconds old.
1560: 20 20 20 20 20 20 20 20 20 28 74 71 75 65 75 65 (tqueue
1570: 2d 72 61 77 20 28 68 61 73 68 2d 74 61 62 6c 65 -raw (hash-table
1580: 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 -ref/default dat
1590: 61 20 27 74 71 75 65 75 65 20 27 28 29 29 29 0a a 'tqueue '())).
15a0: 20 20 20 20 20 20 20 20 20 28 74 71 75 65 75 65 (tqueue
15b0: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 28 64 (reverse (d
15c0: 65 6c 65 74 65 2d 64 75 70 6c 69 63 61 74 65 73 elete-duplicates
15d0: 20 74 71 75 65 75 65 2d 72 61 77 20 20 20 20 20 tqueue-raw
15e0: 3b 3b 20 52 45 4d 4f 56 45 20 64 75 70 6c 69 63 ;; REMOVE duplic
15f0: 61 74 65 73 20 62 79 20 74 65 73 74 6e 61 6d 65 ates by testname
1600: 20 61 6e 64 20 73 74 61 74 65 0a 20 20 20 20 20 and state.
1610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1630: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
1640: 62 64 61 20 28 61 20 62 29 0a 20 20 20 20 20 20 bda (a b).
1650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
1680: 64 20 28 65 71 75 61 6c 3f 20 28 74 65 73 74 64 d (equal? (testd
1690: 61 74 2d 74 6e 61 6d 65 20 61 29 28 74 65 73 74 at-tname a)(test
16a0: 64 61 74 2d 74 6e 61 6d 65 20 62 29 29 20 20 20 dat-tname b))
16b0: 20 20 20 20 20 3b 3b 20 6e 65 65 64 20 6f 6c 64 ;; need old
16c0: 65 73 74 20 74 6f 20 6e 65 77 65 73 74 0a 20 20 est to newest.
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1700: 20 20 20 20 20 20 28 65 71 75 61 6c 3f 20 28 74 (equal? (t
1710: 65 73 74 64 61 74 2d 73 74 61 74 65 20 61 29 20 estdat-state a)
1720: 28 74 65 73 74 64 61 74 2d 73 74 61 74 65 20 62 (testdat-state b
1730: 29 29 29 29 29 29 29 29 20 3b 3b 20 22 43 4f 4d )))))))) ;; "COM
1740: 50 4c 45 54 45 44 22 29 0a 20 20 20 20 3b 3b 20 PLETED"). ;;
1750: 28 65 71 75 61 6c 3f 20 28 74 65 73 74 64 61 74 (equal? (testdat
1760: 2d 73 74 61 74 65 20 62 29 20 22 43 4f 4d 50 4c -state b) "COMPL
1770: 45 54 45 44 22 29 29 29 29 29 29 29 0a 20 20 20 ETED"))))))).
1780: 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f (if (not (null?
1790: 20 74 71 75 65 75 65 29 29 0a 20 20 20 20 20 20 tqueue)).
17a0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
17b0: 74 21 0a 20 20 20 20 20 20 20 20 20 64 61 74 61 t!. data
17c0: 0a 20 20 20 20 20 20 20 20 20 27 74 71 75 65 75 . 'tqueu
17d0: 65 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 e. (let
17e0: 6c 6f 6f 70 20 28 28 68 65 64 20 28 63 61 72 20 loop ((hed (car
17f0: 74 71 75 65 75 65 29 29 20 3b 3b 20 62 79 20 74 tqueue)) ;; by t
1800: 68 69 73 20 70 6f 69 6e 74 20 61 6c 6c 20 64 75 his point all du
1810: 70 6c 69 63 61 74 65 73 20 62 79 20 73 74 61 74 plicates by stat
1820: 65 20 43 4f 4d 50 4c 45 54 45 44 20 61 72 65 20 e COMPLETED are
1830: 72 65 6d 6f 76 65 64 0a 20 20 20 20 20 20 20 20 removed.
1840: 20 20 20 20 20 20 20 20 20 20 20 20 28 74 61 6c (tal
1850: 20 28 63 64 72 20 74 71 75 65 75 65 29 29 0a 20 (cdr tqueue)).
1860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1870: 20 20 20 28 72 65 6d 20 27 28 29 29 29 0a 20 20 (rem '())).
1880: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 (if (>
1890: 70 72 69 6e 74 2d 74 69 6d 65 20 28 74 65 73 74 print-time (test
18a0: 64 61 74 2d 65 76 65 6e 74 2d 74 69 6d 65 20 68 dat-event-time h
18b0: 65 64 29 29 20 3b 3b 20 65 76 65 6e 74 20 68 61 ed)) ;; event ha
18c0: 70 70 65 6e 65 64 20 6f 76 65 72 20 31 35 20 73 ppened over 15 s
18d0: 65 63 6f 6e 64 73 20 61 67 6f 0a 20 20 20 20 20 econds ago.
18e0: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
18f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1900: 20 20 28 74 63 6d 74 3a 70 72 69 6e 74 20 68 65 (tcmt:print he
1910: 64 20 66 6c 75 73 68 2d 6d 6f 64 65 29 0a 20 20 d flush-mode).
1920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1930: 69 66 20 28 6e 75 6c 6c 3f 20 74 61 6c 29 0a 20 if (null? tal).
1940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1950: 20 20 20 20 72 65 6d 20 3b 3b 20 72 65 74 75 72 rem ;; retur
1960: 6e 20 72 65 6d 20 74 6f 20 62 65 20 70 72 6f 63 n rem to be proc
1970: 65 73 73 65 64 20 69 6e 20 74 68 65 20 66 75 74 essed in the fut
1980: 75 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ure.
1990: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
19a0: 63 61 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c car tal)(cdr tal
19b0: 29 20 72 65 6d 29 29 29 0a 20 20 20 20 20 20 20 ) rem))).
19c0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
19d0: 6c 3f 20 74 61 6c 29 0a 20 20 20 20 20 20 20 20 l? tal).
19e0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
19f0: 20 68 65 64 20 72 65 6d 29 20 3b 3b 20 72 65 74 hed rem) ;; ret
1a00: 75 72 6e 20 72 65 6d 20 2b 20 68 65 64 20 66 6f urn rem + hed fo
1a10: 72 20 66 75 74 75 72 65 20 70 72 6f 63 65 73 73 r future process
1a20: 69 6e 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 ing.
1a30: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 61 (loop (ca
1a40: 72 20 74 61 6c 29 28 63 64 72 20 74 61 6c 29 28 r tal)(cdr tal)(
1a50: 63 6f 6e 73 20 68 65 64 20 72 65 6d 29 29 29 29 cons hed rem))))
1a60: 29 29 29 29 29 0a 0a 3b 3b 20 23 23 74 65 61 6d )))))..;; ##team
1a70: 63 69 74 79 5b 74 65 73 74 53 74 61 72 74 65 64 city[testStarted
1a80: 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 73 name='suite.tes
1a90: 74 4e 61 6d 65 27 5d 0a 3b 3b 20 23 23 74 65 61 tName'].;; ##tea
1aa0: 6d 63 69 74 79 5b 74 65 73 74 53 74 64 4f 75 74 mcity[testStdOut
1ab0: 20 6e 61 6d 65 3d 27 73 75 69 74 65 2e 74 65 73 name='suite.tes
1ac0: 74 4e 61 6d 65 27 20 6f 75 74 3d 27 74 65 78 74 tName' out='text
1ad0: 27 5d 0a 3b 3b 20 23 23 74 65 61 6d 63 69 74 79 '].;; ##teamcity
1ae0: 5b 74 65 73 74 53 74 64 45 72 72 20 6e 61 6d 65 [testStdErr name
1af0: 3d 27 73 75 69 74 65 2e 74 65 73 74 4e 61 6d 65 ='suite.testName
1b00: 27 20 6f 75 74 3d 27 65 72 72 6f 72 20 74 65 78 ' out='error tex
1b10: 74 27 5d 0a 3b 3b 20 23 23 74 65 61 6d 63 69 74 t'].;; ##teamcit
1b20: 79 5b 74 65 73 74 46 61 69 6c 65 64 20 6e 61 6d y[testFailed nam
1b30: 65 3d 27 73 75 69 74 65 2e 74 65 73 74 4e 61 6d e='suite.testNam
1b40: 65 27 20 6d 65 73 73 61 67 65 3d 27 66 61 69 6c e' message='fail
1b50: 75 72 65 20 6d 65 73 73 61 67 65 27 20 64 65 74 ure message' det
1b60: 61 69 6c 73 3d 27 6d 65 73 73 61 67 65 20 61 6e ails='message an
1b70: 64 20 73 74 61 63 6b 20 74 72 61 63 65 27 5d 0a d stack trace'].
1b80: 3b 3b 20 23 23 74 65 61 6d 63 69 74 79 5b 74 65 ;; ##teamcity[te
1b90: 73 74 46 69 6e 69 73 68 65 64 20 6e 61 6d 65 3d stFinished name=
1ba0: 27 73 75 69 74 65 2e 74 65 73 74 4e 61 6d 65 27 'suite.testName'
1bb0: 20 64 75 72 61 74 69 6f 6e 3d 27 35 30 27 5d 0a duration='50'].
1bc0: 3b 3b 20 0a 3b 3b 20 66 6c 75 73 68 3b 20 23 66 ;; .;; flush; #f
1bd0: 2c 20 6e 6f 72 6d 61 6c 20 63 61 6c 6c 2e 20 23 , normal call. #
1be0: 74 2c 20 6c 61 73 74 20 63 61 6c 6c 2c 20 70 72 t, last call, pr
1bf0: 69 6e 74 20 6f 75 74 20 73 6f 6d 65 74 68 69 6e int out somethin
1c00: 67 20 66 6f 72 20 4e 4f 54 5f 53 54 41 52 54 45 g for NOT_STARTE
1c10: 44 2c 20 65 74 63 2e 0a 3b 3b 0a 0a 3b 3b 3b 3b D, etc..;;..;;;;
1c20: 3b 3b 3b 20 20 20 28 62 65 67 69 6e 0a 3b 3b 3b ;;; (begin.;;;
1c30: 3b 3b 3b 3b 20 20 20 20 20 28 63 61 73 65 20 28 ;;;; (case (
1c40: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6e string->symbol n
1c50: 65 77 73 74 61 74 29 0a 3b 3b 3b 3b 3b 3b 3b 20 ewstat).;;;;;;;
1c60: 20 20 20 20 20 20 28 28 55 4e 4b 29 20 20 20 20 ((UNK)
1c70: 20 20 20 29 20 3b 3b 20 64 6f 20 6e 6f 74 68 69 ) ;; do nothi
1c80: 6e 67 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 20 20 20 ng.;;;;;;;
1c90: 20 28 28 52 55 4e 4e 49 4e 47 29 20 20 20 28 70 ((RUNNING) (p
1ca0: 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 79 rint "##teamcity
1cb0: 5b 74 65 73 74 53 74 61 72 74 65 64 20 6e 61 6d [testStarted nam
1cc0: 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 22 27 20 e='" tctname "'
1cd0: 66 6c 6f 77 49 64 3d 27 22 20 66 6c 6f 77 69 64 flowId='" flowid
1ce0: 20 22 27 5d 22 29 29 0a 3b 3b 3b 3b 3b 3b 3b 20 "']")).;;;;;;;
1cf0: 20 20 20 20 20 20 28 28 50 41 53 53 20 53 4b 49 ((PASS SKI
1d00: 50 20 57 41 52 4e 20 57 41 49 56 45 44 29 20 28 P WARN WAIVED) (
1d10: 70 72 69 6e 74 20 22 23 23 74 65 61 6d 63 69 74 print "##teamcit
1d20: 79 5b 74 65 73 74 46 69 6e 69 73 68 65 64 20 6e y[testFinished n
1d30: 61 6d 65 3d 27 22 20 74 63 74 6e 61 6d 65 20 22 ame='" tctname "
1d40: 27 20 64 75 72 61 74 69 6f 6e 3d 27 22 20 28 2a ' duration='" (*
1d50: 20 31 65 33 20 64 75 72 61 74 69 6f 6e 29 20 22 1e3 duration) "
1d60: 27 22 20 63 6d 74 73 74 72 20 64 65 74 61 69 6c '" cmtstr detail
1d70: 73 20 22 20 66 6c 6f 77 49 64 3d 27 22 20 66 6c s " flowId='" fl
1d80: 6f 77 69 64 20 22 27 5d 22 29 29 0a 3b 3b 3b 3b owid "']")).;;;;
1d90: 3b 3b 3b 20 20 20 20 20 20 20 28 65 6c 73 65 0a ;;; (else.
1da0: 3b 3b 3b 3b 3b 3b 3b 20 09 28 70 72 69 6e 74 20 ;;;;;;; .(print
1db0: 22 23 23 74 65 61 6d 63 69 74 79 5b 74 65 73 74 "##teamcity[test
1dc0: 46 61 69 6c 65 64 20 6e 61 6d 65 3d 27 22 20 74 Failed name='" t
1dd0: 63 74 6e 61 6d 65 20 22 27 20 22 20 63 6d 74 73 ctname "' " cmts
1de0: 74 72 20 64 65 74 61 69 6c 73 20 22 20 66 6c 6f tr details " flo
1df0: 77 49 64 3d 27 22 20 66 6c 6f 77 69 64 20 22 27 wId='" flowid "'
1e00: 5d 22 29 29 29 0a 3b 3b 3b 3b 3b 3b 3b 20 20 20 ]"))).;;;;;;;
1e10: 20 20 28 66 6c 75 73 68 2d 6f 75 74 70 75 74 29 (flush-output)
1e20: 0a 0a 3b 3b 20 28 74 72 61 63 65 20 72 6d 74 3a ..;; (trace rmt:
1e30: 67 65 74 2d 74 65 73 74 73 2d 66 6f 72 2d 72 75 get-tests-for-ru
1e40: 6e 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 70 64 n)..(define (upd
1e50: 61 74 65 2d 71 75 65 75 65 2d 73 69 6e 63 65 20 ate-queue-since
1e60: 64 61 74 61 20 72 75 6e 2d 69 64 73 20 6c 61 73 data run-ids las
1e70: 74 2d 75 70 64 61 74 65 20 74 73 6e 61 6d 65 20 t-update tsname
1e80: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 target runname f
1e90: 6c 6f 77 69 64 20 66 6c 75 73 68 20 23 21 6b 65 lowid flush #!ke
1ea0: 79 20 28 64 65 6c 61 79 2d 66 6c 61 67 20 23 74 y (delay-flag #t
1eb0: 29 29 20 3b 3b 20 0a 20 20 28 6c 65 74 20 28 28 )) ;; . (let ((
1ec0: 6e 6f 77 20 20 20 20 20 20 20 20 20 20 20 28 63 now (c
1ed0: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 29 urrent-seconds))
1ee0: 0a 09 28 73 74 69 6c 6c 2d 72 75 6e 6e 69 6e 67 ..(still-running
1ef0: 20 23 66 29 29 0a 3b 3b 20 28 68 61 6e 64 6c 65 #f)).;; (handle
1f00: 2d 65 78 63 65 70 74 69 6f 6e 73 0a 3b 3b 20 09 -exceptions.;; .
1f10: 65 78 6e 0a 3b 3b 20 09 28 62 65 67 69 6e 20 28 exn.;; .(begin (
1f20: 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 6e print-call-chain
1f30: 29 20 28 70 72 69 6e 74 20 22 45 72 72 6f 72 20 ) (print "Error
1f40: 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 6f 6e message: " ((con
1f50: 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 2d dition-property-
1f60: 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 6d accessor 'exn 'm
1f70: 65 73 73 61 67 65 29 20 65 78 6e 29 29 29 0a 20 essage) exn))).
1f80: 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 (for-each.
1f90: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 (lambda (r
1fa0: 75 6e 2d 69 64 29 0a 09 20 28 6c 65 74 2a 20 28 un-id).. (let* (
1fb0: 28 74 65 73 74 73 20 28 72 6d 74 3a 67 65 74 2d (tests (rmt:get-
1fc0: 74 65 73 74 73 2d 66 6f 72 2d 72 75 6e 20 72 75 tests-for-run ru
1fd0: 6e 2d 69 64 20 22 25 22 20 27 28 29 20 27 28 29 n-id "%" '() '()
1fe0: 20 23 66 20 23 66 20 23 66 20 23 66 20 23 66 20 #f #f #f #f #f
1ff0: 23 66 20 6c 61 73 74 2d 75 70 64 61 74 65 20 23 #f last-update #
2000: 66 29 29 29 0a 09 20 20 20 3b 3b 20 28 70 72 69 f))).. ;; (pri
2010: 6e 74 20 22 44 45 42 55 47 3a 20 67 6f 74 20 74 nt "DEBUG: got t
2020: 65 73 74 73 3d 22 20 74 65 73 74 73 29 0a 09 20 ests=" tests)..
2030: 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 (for-each..
2040: 20 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 72 (lambda (test-r
2050: 65 63 29 0a 09 20 20 20 20 20 20 28 6c 65 74 2a ec).. (let*
2060: 20 28 28 74 71 75 65 75 65 20 20 20 28 68 61 73 ((tqueue (has
2070: 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 h-table-ref/defa
2080: 75 6c 74 20 64 61 74 61 20 27 74 71 75 65 75 65 ult data 'tqueue
2090: 20 27 28 29 29 29 20 3b 3b 20 4e 4f 54 45 3a 20 '())) ;; NOTE:
20a0: 74 68 65 20 6b 65 79 20 69 73 20 61 20 73 79 6d the key is a sym
20b0: 62 6f 6c 21 20 54 68 69 73 20 61 6c 6c 6f 77 73 bol! This allows
20c0: 20 6b 65 65 70 69 6e 67 20 64 69 73 70 61 72 61 keeping dispara
20d0: 74 65 20 69 6e 66 6f 20 69 6e 20 74 68 65 20 6f te info in the o
20e0: 6e 65 20 68 61 73 68 2c 20 6c 61 7a 79 20 62 75 ne hash, lazy bu
20f0: 74 20 61 20 71 75 69 63 6b 20 73 6f 6c 75 74 69 t a quick soluti
2100: 6f 6e 20 66 6f 72 20 72 69 67 68 74 20 6e 6f 77 on for right now
2110: 2e 0a 09 09 20 20 20 20 20 28 69 73 2d 74 6f 70 .... (is-top
2120: 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d (db:test-get-
2130: 69 73 2d 74 6f 70 6c 65 76 65 6c 20 20 74 65 73 is-toplevel tes
2140: 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 20 28 t-rec))... (
2150: 74 6e 61 6d 65 20 20 20 20 28 64 62 3a 74 65 73 tname (db:tes
2160: 74 2d 67 65 74 2d 66 75 6c 6c 6e 61 6d 65 20 20 t-get-fullname
2170: 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 test-rec))...
2180: 20 20 20 20 20 28 74 65 73 74 6e 61 6d 65 20 28 (testname (
2190: 64 62 3a 74 65 73 74 2d 67 65 74 2d 74 65 73 74 db:test-get-test
21a0: 6e 61 6d 65 20 20 20 20 20 74 65 73 74 2d 72 65 name test-re
21b0: 63 29 29 0a 09 09 20 20 20 20 20 28 69 74 65 6d c))... (item
21c0: 70 61 74 68 20 28 64 62 3a 74 65 73 74 2d 67 65 path (db:test-ge
21d0: 74 2d 69 74 65 6d 2d 70 61 74 68 20 20 20 20 74 t-item-path t
21e0: 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 est-rec))...
21f0: 20 28 74 63 74 6e 61 6d 65 20 20 28 69 66 20 28 (tctname (if (
2200: 73 74 72 69 6e 67 3d 3f 20 69 74 65 6d 70 61 74 string=? itempat
2210: 68 20 22 22 29 20 74 65 73 74 6e 61 6d 65 20 28 h "") testname (
2220: 63 6f 6e 63 20 74 65 73 74 6e 61 6d 65 20 22 2e conc testname ".
2230: 22 20 28 73 74 72 69 6e 67 2d 74 72 61 6e 73 6c " (string-transl
2240: 61 74 65 20 69 74 65 6d 70 61 74 68 20 22 2f 22 ate itempath "/"
2250: 20 22 2e 22 29 29 29 29 0a 09 09 20 20 20 20 20 "."))))...
2260: 28 73 74 61 74 65 20 20 20 20 28 64 62 3a 74 65 (state (db:te
2270: 73 74 2d 67 65 74 2d 73 74 61 74 65 20 20 20 20 st-get-state
2280: 20 20 20 20 74 65 73 74 2d 72 65 63 29 29 0a 09 test-rec))..
2290: 09 20 20 20 20 20 28 73 74 61 74 75 73 20 20 20 . (status
22a0: 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 73 74 61 (db:test-get-sta
22b0: 74 75 73 20 20 20 20 20 20 20 74 65 73 74 2d 72 tus test-r
22c0: 65 63 29 29 0a 09 09 20 20 20 20 20 28 65 74 69 ec))... (eti
22d0: 6d 65 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 me (db:test-g
22e0: 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 20 20 et-event_time
22f0: 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 test-rec))...
2300: 20 20 28 64 75 72 61 74 69 6f 6e 20 28 6f 72 20 (duration (or
2310: 28 61 6e 79 2d 3e 6e 75 6d 62 65 72 20 28 64 62 (any->number (db
2320: 3a 74 65 73 74 2d 67 65 74 2d 72 75 6e 5f 64 75 :test-get-run_du
2330: 72 61 74 69 6f 6e 20 74 65 73 74 2d 72 65 63 29 ration test-rec)
2340: 29 20 30 29 29 0a 09 09 20 20 20 20 20 28 63 6f ) 0))... (co
2350: 6d 6d 65 6e 74 20 20 28 64 62 3a 74 65 73 74 2d mment (db:test-
2360: 67 65 74 2d 63 6f 6d 6d 65 6e 74 20 20 20 20 20 get-comment
2370: 20 74 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 test-rec))...
2380: 20 20 20 28 6c 6f 67 66 69 6c 65 20 20 28 64 62 (logfile (db
2390: 3a 74 65 73 74 2d 67 65 74 2d 66 69 6e 61 6c 5f :test-get-final_
23a0: 6c 6f 67 66 20 20 20 74 65 73 74 2d 72 65 63 29 logf test-rec)
23b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
23c0: 20 20 20 20 20 20 20 28 68 6f 73 74 6e 20 20 20 (hostn
23d0: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 68 6f (db:test-get-ho
23e0: 73 74 20 20 20 20 20 20 20 20 20 74 65 73 74 2d st test-
23f0: 72 65 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 rec)).
2400: 20 20 20 20 20 20 20 20 20 20 20 28 70 69 64 20 (pid
2410: 20 20 20 20 20 28 64 62 3a 74 65 73 74 2d 67 65 (db:test-ge
2420: 74 2d 70 72 6f 63 65 73 73 5f 69 64 20 20 20 74 t-process_id t
2430: 65 73 74 2d 72 65 63 29 29 0a 09 09 20 20 20 20 est-rec))...
2440: 20 28 74 65 73 74 2d 63 6f 6e 74 20 28 3e 20 28 (test-cont (> (
2450: 2b 20 65 74 69 6d 65 20 64 75 72 61 74 69 6f 6e + etime duration
2460: 20 34 30 29 20 28 63 75 72 72 65 6e 74 2d 73 65 40) (current-se
2470: 63 6f 6e 64 73 29 29 29 20 3b 3b 20 74 65 73 74 conds))) ;; test
2480: 20 68 61 73 20 6e 6f 74 20 62 65 65 6e 20 6f 76 has not been ov
2490: 65 72 20 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e er for more than
24a0: 20 32 30 20 73 65 63 6f 6e 64 73 0a 09 09 20 20 20 seconds...
24b0: 20 20 20 28 61 64 6a 2d 73 74 61 74 65 20 28 69 (adj-state (i
24c0: 66 20 64 65 6c 61 79 2d 66 6c 61 67 0a 09 09 09 f delay-flag....
24d0: 09 20 20 20 20 28 69 66 20 74 65 73 74 2d 63 6f . (if test-co
24e0: 6e 74 0a 09 09 09 09 09 28 62 65 67 69 6e 0a 09 nt......(begin..
24f0: 09 09 09 09 20 20 28 73 65 74 21 20 73 74 69 6c .... (set! stil
2500: 6c 2d 72 75 6e 6e 69 6e 67 20 23 74 29 0a 09 09 l-running #t)...
2510: 09 09 09 20 20 22 52 55 4e 4e 49 4e 47 22 29 0a ... "RUNNING").
2520: 09 09 09 09 09 73 74 61 74 65 29 0a 09 09 09 09 .....state).....
2530: 20 20 20 20 73 74 61 74 65 29 29 0a 09 09 20 20 state))...
2540: 20 20 20 28 6e 65 77 73 74 61 74 20 20 28 63 6f (newstat (co
2550: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2570: 20 20 20 3b 3b 20 28 28 6f 72 20 28 6e 6f 74 20 ;; ((or (not
2580: 64 65 6c 61 79 2d 66 6c 61 67 29 0a 09 09 09 09 delay-flag).....
2590: 3b 3b 20 20 20 20 20 20 28 3c 20 28 2b 20 65 74 ;; (< (+ et
25a0: 69 6d 65 20 64 75 72 61 74 69 6f 6e 29 0a 09 09 ime duration)...
25b0: 09 09 3b 3b 20 09 28 2d 20 28 63 75 72 72 65 6e ..;; .(- (curren
25c0: 74 2d 73 65 63 6f 6e 64 73 29 20 31 30 29 29 29 t-seconds) 10)))
25d0: 0a 09 09 09 09 3b 3b 20 09 28 70 72 69 6e 74 20 .....;; .(print
25e0: 22 53 6b 69 70 70 69 6e 67 20 61 73 20 64 65 6c "Skipping as del
25f0: 61 79 20 68 61 73 6e 27 74 20 68 69 74 22 29 20 ay hasn't hit")
2600: 22 52 55 4e 4e 49 4e 47 22 29 20 0a 09 09 09 09 "RUNNING") .....
2610: 28 28 65 71 75 61 6c 3f 20 61 64 6a 2d 73 74 61 ((equal? adj-sta
2620: 74 65 20 22 52 55 4e 4e 49 4e 47 22 29 0a 09 09 te "RUNNING")...
2630: 09 09 20 28 73 65 74 21 20 73 74 69 6c 6c 2d 72 .. (set! still-r
2640: 75 6e 6e 69 6e 67 20 23 74 29 0a 09 09 09 09 20 unning #t).....
2650: 22 52 55 4e 4e 49 4e 47 22 29 0a 09 09 09 09 28 "RUNNING").....(
2660: 28 65 71 75 61 6c 3f 20 61 64 6a 2d 73 74 61 74 (equal? adj-stat
2670: 65 20 22 43 4f 4d 50 4c 45 54 45 44 22 29 0a 09 e "COMPLETED")..
2680: 09 09 09 20 73 74 61 74 75 73 29 0a 09 09 09 09 ... status).....
2690: 28 66 6c 75 73 68 20 20 20 28 63 6f 6e 63 20 73 (flush (conc s
26a0: 74 61 74 65 20 22 2f 22 20 73 74 61 74 75 73 29 tate "/" status)
26b0: 29 0a 09 09 09 09 28 65 6c 73 65 20 22 55 4e 4b ).....(else "UNK
26c0: 22 29 29 29 0a 09 09 20 20 20 20 20 28 63 6d 74 ")))... (cmt
26d0: 73 74 72 20 20 20 28 69 66 20 28 61 6e 64 20 28 str (if (and (
26e0: 6e 6f 74 20 66 6c 75 73 68 29 20 63 6f 6d 6d 65 not flush) comme
26f0: 6e 74 29 0a 09 09 09 09 20 20 20 63 6f 6d 6d 65 nt)..... comme
2700: 6e 74 0a 09 09 09 09 20 20 20 28 69 66 20 66 6c nt..... (if fl
2710: 75 73 68 0a 09 09 09 09 20 20 20 20 20 20 20 28 ush..... (
2720: 63 6f 6e 63 20 22 54 65 73 74 20 65 6e 64 65 64 conc "Test ended
2730: 20 69 6e 20 73 74 61 74 65 2f 73 74 61 74 75 73 in state/status
2740: 3d 22 0a 09 09 09 09 09 20 20 20 20 20 73 74 61 ="...... sta
2750: 74 65 20 22 2f 22 20 73 74 61 74 75 73 0a 09 09 te "/" status...
2760: 09 09 09 20 20 20 20 20 28 69 66 20 20 28 73 74 ... (if (st
2770: 72 69 6e 67 2d 6d 61 74 63 68 20 22 5e 5c 5c 73 ring-match "^\\s
2780: 2a 24 22 20 63 6f 6d 6d 65 6e 74 29 0a 09 09 09 *$" comment)....
2790: 09 09 09 20 20 22 2c 20 6e 6f 20 4d 65 67 61 74 ... ", no Megat
27a0: 65 73 74 20 63 6f 6d 6d 65 6e 74 20 66 6f 75 6e est comment foun
27b0: 64 2e 22 0a 09 09 09 09 09 09 20 20 28 63 6f 6e d."....... (con
27c0: 63 20 22 2c 20 4d 65 67 61 74 65 73 74 20 63 6f c ", Megatest co
27d0: 6d 6d 65 6e 74 3d 5c 22 22 20 63 6f 6d 6d 65 6e mment=\"" commen
27e0: 74 20 22 5c 22 22 29 29 29 20 3b 3b 20 73 70 65 t "\""))) ;; spe
27f0: 63 69 61 6c 20 63 61 73 65 2c 20 77 65 20 61 72 cial case, we ar
2800: 65 20 68 61 6e 64 6c 69 6e 67 20 73 74 72 61 67 e handling strag
2810: 67 6c 65 72 73 0a 09 09 09 09 20 20 20 20 20 20 glers.....
2820: 20 23 66 29 29 29 0a 09 09 20 20 20 20 20 28 64 #f)))... (d
2830: 65 74 61 69 6c 73 20 20 28 69 66 20 28 73 74 72 etails (if (str
2840: 69 6e 67 2d 6d 61 74 63 68 20 22 2e 2a 68 74 6d ing-match ".*htm
2850: 6c 24 22 20 6c 6f 67 66 69 6c 65 29 0a 09 09 09 l$" logfile)....
2860: 09 20 20 20 28 63 6f 6e 63 20 2a 74 6f 70 70 61 . (conc *toppa
2870: 74 68 2a 20 22 2f 6c 74 2f 22 20 74 61 72 67 65 th* "/lt/" targe
2880: 74 20 22 2f 22 20 72 75 6e 6e 61 6d 65 20 22 2f t "/" runname "/
2890: 22 20 74 65 73 74 6e 61 6d 65 0a 09 09 09 09 09 " testname......
28a0: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 69 74 65 (if (equal? ite
28b0: 6d 70 61 74 68 20 22 22 29 20 22 2f 22 20 28 63 mpath "") "/" (c
28c0: 6f 6e 63 20 22 2f 22 20 69 74 65 6d 70 61 74 68 onc "/" itempath
28d0: 20 22 2f 22 29 29 0a 09 09 09 09 09 20 6c 6f 67 "/"))...... log
28e0: 66 69 6c 65 29 0a 09 09 09 09 20 20 20 23 66 29 file)..... #f)
28f0: 29 0a 09 09 20 20 20 20 20 28 70 72 65 76 2d 74 )... (prev-t
2900: 64 61 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d dat (hash-table-
2910: 72 65 66 2f 64 65 66 61 75 6c 74 20 64 61 74 61 ref/default data
2920: 20 74 6e 61 6d 65 20 23 66 29 29 20 0a 09 09 20 tname #f)) ...
2930: 20 20 20 20 28 74 64 61 74 20 20 20 20 20 20 28 (tdat (
2940: 69 66 20 69 73 2d 74 6f 70 0a 09 09 09 09 20 20 if is-top.....
2950: 20 20 23 66 0a 09 09 09 09 20 20 20 20 28 6c 65 #f..... (le
2960: 74 20 28 28 6e 65 77 20 28 6f 72 20 70 72 65 76 t ((new (or prev
2970: 2d 74 64 61 74 20 28 6d 61 6b 65 2d 74 65 73 74 -tdat (make-test
2980: 64 61 74 29 29 29 29 20 3b 3b 20 72 65 63 79 63 dat)))) ;; recyc
2990: 6c 65 20 74 68 65 20 72 65 63 6f 72 64 20 73 6f le the record so
29a0: 20 77 65 20 6b 65 65 70 20 74 72 61 63 6b 20 6f we keep track o
29b0: 66 20 61 6c 72 65 61 64 79 20 70 72 69 6e 74 65 f already printe
29c0: 64 20 69 74 65 6d 73 0a 09 09 09 09 20 20 20 20 d items.....
29d0: 20 20 28 74 65 73 74 64 61 74 2d 66 6c 6f 77 69 (testdat-flowi
29e0: 64 2d 73 65 74 21 20 20 20 20 20 6e 65 77 20 28 d-set! new (
29f0: 6f 72 20 28 74 65 73 74 64 61 74 2d 66 6c 6f 77 or (testdat-flow
2a00: 69 64 20 6e 65 77 29 0a 20 20 20 20 20 20 20 20 id new).
2a10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2a50: 69 66 20 28 65 71 3f 20 70 69 64 20 30 29 0a 20 if (eq? pid 0).
2a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2aa0: 20 20 20 20 20 20 20 20 20 20 74 63 74 6e 61 6d tctnam
2ab0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
2ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
2b00: 6e 63 20 68 6f 73 74 6e 20 22 2d 22 20 70 69 64 nc hostn "-" pid
2b10: 29 29 29 29 0a 09 09 09 09 20 20 20 20 20 20 28 ))))..... (
2b20: 74 65 73 74 64 61 74 2d 74 63 74 6e 61 6d 65 2d testdat-tctname-
2b30: 73 65 74 21 20 20 20 20 6e 65 77 20 74 63 74 6e set! new tctn
2b40: 61 6d 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 ame)..... (
2b50: 74 65 73 74 64 61 74 2d 74 6e 61 6d 65 2d 73 65 testdat-tname-se
2b60: 74 21 20 20 20 20 20 20 6e 65 77 20 74 6e 61 6d t! new tnam
2b70: 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 e)..... (te
2b80: 73 74 64 61 74 2d 73 74 61 74 65 2d 73 65 74 21 stdat-state-set!
2b90: 20 20 20 20 20 20 6e 65 77 20 61 64 6a 2d 73 74 new adj-st
2ba0: 61 74 65 29 0a 09 09 09 09 20 20 20 20 20 20 28 ate)..... (
2bb0: 74 65 73 74 64 61 74 2d 73 74 61 74 75 73 2d 73 testdat-status-s
2bc0: 65 74 21 20 20 20 20 20 6e 65 77 20 73 74 61 74 et! new stat
2bd0: 75 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 us)..... (t
2be0: 65 73 74 64 61 74 2d 63 6f 6d 6d 65 6e 74 2d 73 estdat-comment-s
2bf0: 65 74 21 20 20 20 20 6e 65 77 20 63 6d 74 73 74 et! new cmtst
2c00: 72 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 r)..... (te
2c10: 73 74 64 61 74 2d 64 65 74 61 69 6c 73 2d 73 65 stdat-details-se
2c20: 74 21 20 20 20 20 6e 65 77 20 64 65 74 61 69 6c t! new detail
2c30: 73 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 65 s)..... (te
2c40: 73 74 64 61 74 2d 64 75 72 61 74 69 6f 6e 2d 73 stdat-duration-s
2c50: 65 74 21 20 20 20 6e 65 77 20 64 75 72 61 74 69 et! new durati
2c60: 6f 6e 29 0a 09 09 09 09 20 20 20 20 20 20 28 74 on)..... (t
2c70: 65 73 74 64 61 74 2d 65 76 65 6e 74 2d 74 69 6d estdat-event-tim
2c80: 65 2d 73 65 74 21 20 6e 65 77 20 65 74 69 6d 65 e-set! new etime
2c90: 29 20 3b 3b 20 28 63 75 72 72 65 6e 74 2d 73 65 ) ;; (current-se
2ca0: 63 6f 6e 64 73 29 29 0a 09 09 09 09 20 20 20 20 conds)).....
2cb0: 20 20 28 74 65 73 74 64 61 74 2d 6f 76 65 72 61 (testdat-overa
2cc0: 6c 6c 2d 73 65 74 21 20 20 20 20 6e 65 77 20 6e ll-set! new n
2cd0: 65 77 73 74 61 74 29 0a 09 09 09 09 20 20 20 20 ewstat).....
2ce0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
2cf0: 74 21 20 64 61 74 61 20 74 6e 61 6d 65 20 6e 65 t! data tname ne
2d00: 77 29 0a 09 09 09 09 20 20 20 20 20 20 6e 65 77 w)..... new
2d10: 29 29 29 29 0a 09 09 28 69 66 20 28 6e 6f 74 20 ))))...(if (not
2d20: 69 73 2d 74 6f 70 29 0a 09 09 20 20 20 20 28 68 is-top)... (h
2d30: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 64 ash-table-set! d
2d40: 61 74 61 20 27 74 71 75 65 75 65 20 28 63 6f 6e ata 'tqueue (con
2d50: 73 20 74 64 61 74 20 74 71 75 65 75 65 29 29 29 s tdat tqueue)))
2d60: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d70: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 (hash-table-se
2d80: 74 21 20 64 61 74 61 20 74 6e 61 6d 65 20 74 64 t! data tname td
2d90: 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 at).
2da0: 20 20 20 20 29 29 0a 20 20 20 20 20 20 20 20 20 )).
2db0: 20 20 20 74 65 73 74 73 29 29 29 0a 20 20 20 20 tests))).
2dc0: 20 20 20 72 75 6e 2d 69 64 73 29 0a 20 20 20 20 run-ids).
2dd0: 20 20 28 6c 69 73 74 20 6e 6f 77 20 73 74 69 6c (list now stil
2de0: 6c 2d 72 75 6e 6e 69 6e 67 29 29 29 0a 0a 28 64 l-running)))..(d
2df0: 65 66 69 6e 65 20 28 6d 6f 6e 69 74 6f 72 20 70 efine (monitor p
2e00: 69 64 29 0a 20 20 28 6c 65 74 2a 20 28 28 72 75 id). (let* ((ru
2e10: 6e 2d 69 64 73 20 27 28 29 29 0a 09 20 28 74 65 n-ids '()).. (te
2e20: 73 74 64 61 74 73 20 28 6d 61 6b 65 2d 68 61 73 stdats (make-has
2e30: 68 2d 74 61 62 6c 65 29 29 20 20 3b 3b 20 65 61 h-table)) ;; ea
2e40: 63 68 20 65 6e 74 72 79 20 69 73 20 61 20 6c 69 ch entry is a li
2e50: 73 74 20 6f 66 20 74 65 73 74 64 61 74 20 73 74 st of testdat st
2e60: 72 75 63 74 73 0a 09 20 28 6b 65 79 73 20 20 20 ructs.. (keys
2e70: 20 23 66 29 0a 09 20 28 6c 61 73 74 2d 75 70 64 #f).. (last-upd
2e80: 61 74 65 20 30 29 0a 09 20 28 74 61 72 67 65 74 ate 0).. (target
2e90: 20 20 28 6f 72 20 28 61 72 67 73 3a 67 65 74 2d (or (args:get-
2ea0: 61 72 67 20 22 2d 74 61 72 67 65 74 22 29 0a 09 arg "-target")..
2eb0: 09 20 20 20 20 20 20 28 61 72 67 73 3a 67 65 74 . (args:get
2ec0: 2d 61 72 67 20 22 2d 72 65 71 74 61 72 67 22 29 -arg "-reqtarg")
2ed0: 29 29 0a 09 20 28 72 75 6e 6e 61 6d 65 20 28 61 )).. (runname (a
2ee0: 72 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 72 75 rgs:get-arg "-ru
2ef0: 6e 6e 61 6d 65 22 29 29 0a 09 20 28 74 73 6e 61 nname")).. (tsna
2f00: 6d 65 20 20 23 66 29 0a 09 20 28 66 6c 6f 77 69 me #f).. (flowi
2f10: 64 20 20 28 63 6f 6e 63 20 74 61 72 67 65 74 20 d (conc target
2f20: 22 2f 22 20 72 75 6e 6e 61 6d 65 29 29 0a 09 20 "/" runname))..
2f30: 28 74 64 65 6c 61 79 20 20 28 73 74 72 69 6e 67 (tdelay (string
2f40: 2d 3e 6e 75 6d 62 65 72 20 28 6f 72 20 28 61 72 ->number (or (ar
2f50: 67 73 3a 67 65 74 2d 61 72 67 20 22 2d 64 65 6c gs:get-arg "-del
2f60: 61 79 22 29 20 22 31 35 22 29 29 29 29 0a 20 20 ay") "15")))).
2f70: 20 20 28 69 66 20 28 61 6e 64 20 74 61 72 67 65 (if (and targe
2f80: 74 20 72 75 6e 6e 61 6d 65 29 0a 09 28 62 65 67 t runname)..(beg
2f90: 69 6e 0a 09 20 20 28 6c 61 75 6e 63 68 3a 73 65 in.. (launch:se
2fa0: 74 75 70 29 0a 09 20 20 28 73 65 74 21 20 6b 65 tup).. (set! ke
2fb0: 79 73 20 28 72 6d 74 3a 67 65 74 2d 6b 65 79 73 ys (rmt:get-keys
2fc0: 29 29 29 29 0a 20 20 20 20 28 73 65 74 21 20 74 )))). (set! t
2fd0: 73 6e 61 6d 65 20 20 28 63 6f 6d 6d 6f 6e 3a 67 sname (common:g
2fe0: 65 74 2d 74 65 73 74 73 75 69 74 65 2d 6e 61 6d et-testsuite-nam
2ff0: 65 29 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 e)). (print "
3000: 54 43 4d 54 3a 20 66 6f 72 20 74 65 73 74 73 75 TCMT: for testsu
3010: 69 74 65 3d 22 20 74 73 6e 61 6d 65 20 22 20 66 ite=" tsname " f
3020: 6f 75 6e 64 20 72 75 6e 6e 61 6d 65 3d 22 20 72 ound runname=" r
3030: 75 6e 6e 61 6d 65 20 22 2c 20 74 61 72 67 65 74 unname ", target
3040: 3d 22 20 74 61 72 67 65 74 20 22 2c 20 6b 65 79 =" target ", key
3050: 73 3d 22 20 6b 65 79 73 20 22 20 61 6e 64 20 73 s=" keys " and s
3060: 75 63 63 65 73 73 66 75 6c 6c 79 20 72 61 6e 20 uccessfully ran
3070: 6c 61 75 6e 63 68 3a 73 65 74 75 70 2e 20 55 73 launch:setup. Us
3080: 69 6e 67 20 22 20 66 6c 6f 77 69 64 20 22 20 61 ing " flowid " a
3090: 73 20 74 68 65 20 66 6c 6f 77 49 64 2e 22 29 0a s the flowId.").
30a0: 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 (let loop ()
30b0: 0a 20 20 20 20 20 20 3b 3b 3b 3b 3b 3b 20 28 68 . ;;;;;; (h
30c0: 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 andle-exceptions
30d0: 0a 20 20 20 20 20 20 3b 3b 3b 3b 3b 3b 20 20 65 . ;;;;;; e
30e0: 78 6e 0a 20 20 20 20 20 20 3b 3b 3b 3b 3b 3b 20 xn. ;;;;;;
30f0: 20 3b 3b 20 28 70 72 69 6e 74 20 22 50 72 6f 63 ;; (print "Proc
3100: 65 73 73 20 64 6f 6e 65 2e 22 29 0a 20 20 20 20 ess done.").
3110: 20 20 3b 3b 3b 3b 3b 3b 20 20 28 62 65 67 69 6e ;;;;;; (begin
3120: 20 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 (print-call-cha
3130: 69 6e 29 20 28 70 72 69 6e 74 20 22 45 72 72 6f in) (print "Erro
3140: 72 20 6d 65 73 73 61 67 65 3a 20 22 20 28 28 63 r message: " ((c
3150: 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 ondition-propert
3160: 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 y-accessor 'exn
3170: 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 29 'message) exn)))
3180: 0a 20 20 20 20 20 20 20 28 6c 65 74 2d 76 61 6c . (let-val
3190: 75 65 73 20 28 28 28 70 69 64 72 65 73 20 65 78 ues (((pidres ex
31a0: 69 74 74 79 70 65 20 65 78 69 74 73 74 61 74 75 ittype exitstatu
31b0: 73 29 0a 09 09 20 20 20 20 20 28 70 72 6f 63 65 s)... (proce
31c0: 73 73 2d 77 61 69 74 20 70 69 64 20 23 74 29 29 ss-wait pid #t))
31d0: 29 0a 09 20 28 69 66 20 28 61 6e 64 20 6b 65 79 ).. (if (and key
31e0: 73 0a 09 09 20 20 28 6f 72 20 28 6e 6f 74 20 72 s... (or (not r
31f0: 75 6e 2d 69 64 73 29 0a 09 09 20 20 20 20 20 20 un-ids)...
3200: 28 6e 75 6c 6c 3f 20 72 75 6e 2d 69 64 73 29 29 (null? run-ids))
3210: 29 0a 09 20 20 20 20 20 28 6c 65 74 2a 20 28 28 ).. (let* ((
3220: 72 75 6e 73 20 28 72 6d 74 3a 67 65 74 2d 72 75 runs (rmt:get-ru
3230: 6e 73 2d 62 79 2d 70 61 74 74 20 6b 65 79 73 0a ns-by-patt keys.
3240: 09 09 09 09 09 09 72 75 6e 6e 61 6d 65 20 0a 09 ......runname ..
3250: 09 09 09 09 09 74 61 72 67 65 74 0a 09 09 09 09 .....target.....
3260: 09 09 23 66 20 3b 3b 20 6f 66 66 73 65 74 0a 09 ..#f ;; offset..
3270: 09 09 09 09 09 23 66 20 3b 3b 20 6c 69 6d 69 74 .....#f ;; limit
3280: 0a 09 09 09 09 09 09 23 66 20 3b 3b 20 66 69 65 .......#f ;; fie
3290: 6c 64 73 0a 09 09 09 09 09 09 30 20 20 3b 3b 20 lds.......0 ;;
32a0: 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 09 09 09 last-update.....
32b0: 09 09 29 29 0a 09 09 20 20 20 20 28 68 65 61 64 ..))... (head
32c0: 65 72 20 28 64 62 3a 67 65 74 2d 68 65 61 64 65 er (db:get-heade
32d0: 72 20 72 75 6e 73 29 29 0a 09 09 20 20 20 20 28 r runs))... (
32e0: 72 6f 77 73 20 20 20 28 64 62 3a 67 65 74 2d 72 rows (db:get-r
32f0: 6f 77 73 20 20 20 72 75 6e 73 29 29 0a 09 09 20 ows runs))...
3300: 20 20 20 28 72 75 6e 2d 69 64 73 2d 69 6e 20 28 (run-ids-in (
3310: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 72 6f 77 map (lambda (row
3320: 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 64 62 )..... (db
3330: 3a 67 65 74 2d 76 61 6c 75 65 2d 62 79 2d 68 65 :get-value-by-he
3340: 61 64 65 72 20 72 6f 77 20 68 65 61 64 65 72 20 ader row header
3350: 22 69 64 22 29 29 0a 09 09 09 09 20 20 20 20 20 "id")).....
3360: 72 6f 77 73 29 29 29 0a 09 20 20 20 20 20 20 20 rows)))..
3370: 28 73 65 74 21 20 72 75 6e 2d 69 64 73 20 72 75 (set! run-ids ru
3380: 6e 2d 69 64 73 2d 69 6e 29 29 29 0a 09 20 3b 3b n-ids-in))).. ;;
3390: 20 28 70 72 69 6e 74 20 22 54 43 4d 54 3a 20 70 (print "TCMT: p
33a0: 69 64 72 65 73 3d 22 20 70 69 64 72 65 73 20 22 idres=" pidres "
33b0: 20 65 78 69 74 74 79 70 65 3d 22 20 65 78 69 74 exittype=" exit
33c0: 74 79 70 65 20 22 20 65 78 69 74 73 74 61 74 75 type " exitstatu
33d0: 73 3d 22 20 65 78 69 74 73 74 61 74 75 73 20 22 s=" exitstatus "
33e0: 20 72 75 6e 2d 69 64 73 3d 22 20 72 75 6e 2d 69 run-ids=" run-i
33f0: 64 73 29 0a 09 20 28 69 66 20 28 65 71 3f 20 70 ds).. (if (eq? p
3400: 69 64 72 65 73 20 30 29 0a 09 20 20 20 20 20 28 idres 0).. (
3410: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 28 69 begin.. (i
3420: 66 20 6b 65 79 73 0a 20 20 20 20 20 20 20 20 20 f keys.
3430: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
3440: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3450: 20 20 20 20 20 20 28 73 65 74 21 20 6c 61 73 74 (set! last
3460: 2d 75 70 64 61 74 65 20 28 2d 20 28 63 61 72 20 -update (- (car
3470: 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d 73 69 (update-queue-si
3480: 6e 63 65 20 74 65 73 74 64 61 74 73 20 72 75 6e nce testdats run
3490: 2d 69 64 73 20 6c 61 73 74 2d 75 70 64 61 74 65 -ids last-update
34a0: 20 74 73 6e 61 6d 65 20 74 61 72 67 65 74 20 72 tsname target r
34b0: 75 6e 6e 61 6d 65 20 66 6c 6f 77 69 64 20 23 66 unname flowid #f
34c0: 20 64 65 6c 61 79 2d 66 6c 61 67 3a 20 23 74 29 delay-flag: #t)
34d0: 29 20 35 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) 5)).
34e0: 20 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 (proc
34f0: 65 73 73 2d 71 75 65 75 65 20 74 65 73 74 64 61 ess-queue testda
3500: 74 73 20 74 64 65 6c 61 79 20 23 66 29 29 29 0a ts tdelay #f))).
3510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3520: 74 68 72 65 61 64 2d 73 6c 65 65 70 21 20 33 29 thread-sleep! 3)
3530: 0a 09 20 20 20 20 20 20 20 28 6c 6f 6f 70 29 29 .. (loop))
3540: 29 29 29 0a 20 20 20 20 3b 3b 20 74 68 65 20 6d ))). ;; the m
3550: 65 67 61 74 65 73 74 20 72 75 6e 6e 65 72 20 69 egatest runner i
3560: 73 20 64 6f 6e 65 20 2d 20 6e 6f 77 20 77 61 69 s done - now wai
3570: 74 20 66 6f 72 20 61 6c 6c 20 70 72 6f 63 65 73 t for all proces
3580: 73 65 73 20 74 6f 20 62 65 20 43 4f 4d 50 4c 45 ses to be COMPLE
3590: 54 45 44 20 6f 72 20 4e 4f 20 50 72 6f 63 65 73 TED or NO Proces
35a0: 73 65 73 20 74 6f 20 62 65 20 52 55 4e 4e 49 4e ses to be RUNNIN
35b0: 47 20 3e 20 31 20 6d 69 6e 75 74 65 0a 20 20 20 G > 1 minute.
35c0: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 29 0a 20 20 (let loop ().
35d0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 65 77 2d (let* ((new-
35e0: 6c 61 73 74 2d 75 70 64 61 74 65 2d 69 6e 66 6f last-update-info
35f0: 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d 73 (update-queue-s
3600: 69 6e 63 65 20 74 65 73 74 64 61 74 73 20 72 75 ince testdats ru
3610: 6e 2d 69 64 73 20 6c 61 73 74 2d 75 70 64 61 74 n-ids last-updat
3620: 65 20 74 73 6e 61 6d 65 20 74 61 72 67 65 74 20 e tsname target
3630: 72 75 6e 6e 61 6d 65 20 66 6c 6f 77 69 64 20 23 runname flowid #
3640: 66 20 64 65 6c 61 79 2d 66 6c 61 67 3a 20 23 74 f delay-flag: #t
3650: 29 29 0a 09 20 20 20 20 20 28 73 74 69 6c 6c 2d )).. (still-
3660: 72 75 6e 6e 69 6e 67 20 20 20 20 20 20 20 20 28 running (
3670: 63 61 64 72 20 6e 65 77 2d 6c 61 73 74 2d 75 70 cadr new-last-up
3680: 64 61 74 65 2d 69 6e 66 6f 29 29 0a 09 20 20 20 date-info))..
3690: 20 20 28 6e 65 77 2d 6c 61 73 74 2d 75 70 64 61 (new-last-upda
36a0: 74 65 20 20 20 20 20 20 28 2d 20 28 63 61 72 20 te (- (car
36b0: 6e 65 77 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d new-last-update-
36c0: 69 6e 66 6f 29 20 35 29 29 29 0a 09 28 70 72 6f info) 5)))..(pro
36d0: 63 65 73 73 2d 71 75 65 75 65 20 74 65 73 74 64 cess-queue testd
36e0: 61 74 73 20 74 64 65 6c 61 79 20 23 66 29 0a 09 ats tdelay #f)..
36f0: 28 69 66 20 73 74 69 6c 6c 2d 72 75 6e 6e 69 6e (if still-runnin
3700: 67 0a 09 20 20 20 20 28 62 65 67 69 6e 0a 09 20 g.. (begin..
3710: 20 20 20 20 20 28 70 72 69 6e 74 20 22 54 43 4d (print "TCM
3720: 54 3a 20 54 65 73 74 73 20 73 74 69 6c 6c 20 72 T: Tests still r
3730: 75 6e 6e 69 6e 67 2c 20 6b 65 65 70 20 77 61 74 unning, keep wat
3740: 63 68 69 6e 67 2e 2e 2e 22 29 0a 09 20 20 20 20 ching...")..
3750: 20 20 28 74 68 72 65 61 64 2d 73 6c 65 65 70 21 (thread-sleep!
3760: 20 33 29 0a 09 20 20 20 20 20 20 28 6c 6f 6f 70 3).. (loop
3770: 29 29 29 29 29 0a 20 20 20 20 0a 20 20 20 20 3b ))))). . ;
3780: 3b 20 28 70 72 69 6e 74 20 22 54 43 4d 54 3a 20 ; (print "TCMT:
3790: 70 69 64 72 65 73 3d 22 20 70 69 64 72 65 73 20 pidres=" pidres
37a0: 22 20 65 78 69 74 74 79 70 65 3d 22 20 65 78 69 " exittype=" exi
37b0: 74 74 79 70 65 20 22 20 65 78 69 74 73 74 61 74 ttype " exitstat
37c0: 75 73 3d 22 20 65 78 69 74 73 74 61 74 75 73 20 us=" exitstatus
37d0: 22 20 72 75 6e 2d 69 64 73 3d 22 20 72 75 6e 2d " run-ids=" run-
37e0: 69 64 73 29 0a 20 20 20 20 28 70 72 69 6e 74 20 ids). (print
37f0: 22 54 43 4d 54 3a 20 70 72 6f 63 65 73 73 69 6e "TCMT: processin
3800: 67 20 61 6e 79 20 74 65 73 74 73 20 74 68 61 74 g any tests that
3810: 20 64 69 64 20 6e 6f 74 20 66 6f 72 6d 61 6c 6c did not formall
3820: 79 20 63 6f 6d 70 6c 65 74 65 2e 22 29 0a 20 20 y complete.").
3830: 20 20 28 75 70 64 61 74 65 2d 71 75 65 75 65 2d (update-queue-
3840: 73 69 6e 63 65 20 74 65 73 74 64 61 74 73 20 72 since testdats r
3850: 75 6e 2d 69 64 73 20 30 20 74 73 6e 61 6d 65 20 un-ids 0 tsname
3860: 74 61 72 67 65 74 20 72 75 6e 6e 61 6d 65 20 66 target runname f
3870: 6c 6f 77 69 64 20 23 74 20 23 66 20 64 65 6c 61 lowid #t #f dela
3880: 79 2d 66 6c 61 67 3a 20 23 66 29 20 3b 3b 20 63 y-flag: #f) ;; c
3890: 61 6c 6c 20 69 6e 20 66 6c 75 73 68 20 6d 6f 64 all in flush mod
38a0: 65 0a 20 20 20 20 28 70 72 6f 63 65 73 73 2d 71 e. (process-q
38b0: 75 65 75 65 20 74 65 73 74 64 61 74 73 20 30 20 ueue testdats 0
38c0: 23 74 29 0a 20 20 20 20 28 70 72 69 6e 74 20 22 #t). (print "
38d0: 54 43 4d 54 3a 20 41 6c 6c 20 64 6f 6e 65 2e 22 TCMT: All done."
38e0: 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 3b 3b 3b 20 ). ))..;;;;;
38f0: 29 0a 0a 3b 3b 20 28 74 72 61 63 65 20 70 72 69 )..;; (trace pri
3900: 6e 74 2d 63 68 61 6e 67 65 73 2d 73 69 6e 63 65 nt-changes-since
3910: 29 0a 0a 3b 3b 20 28 69 66 20 28 6e 6f 74 20 28 )..;; (if (not (
3920: 65 71 3f 20 70 69 64 72 65 73 20 30 29 29 09 20 eq? pidres 0)).
3930: 20 3b 3b 20 28 6e 6f 74 20 65 78 69 74 73 74 61 ;; (not exitsta
3940: 74 75 73 29 29 0a 3b 3b 20 09 20 20 28 62 65 67 tus)).;; . (beg
3950: 69 6e 0a 3b 3b 20 09 20 20 20 20 28 74 68 72 65 in.;; . (thre
3960: 61 64 2d 73 6c 65 65 70 21 20 33 29 0a 3b 3b 20 ad-sleep! 3).;;
3970: 09 20 20 20 20 28 6c 6f 6f 70 29 29 0a 3b 3b 20 . (loop)).;;
3980: 09 20 20 28 70 72 69 6e 74 20 22 50 72 6f 63 65 . (print "Proce
3990: 73 73 3a 20 6d 65 67 61 74 65 73 74 20 22 20 28 ss: megatest " (
39a0: 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 string-intersper
39b0: 73 65 20 6f 72 69 67 61 72 67 73 20 22 20 22 29 se origargs " ")
39c0: 20 22 20 69 73 20 64 6f 6e 65 2e 22 29 29 29 29 " is done."))))
39d0: 29 0a 0a 28 69 66 20 28 66 69 6c 65 2d 65 78 69 )..(if (file-exi
39e0: 73 74 73 3f 20 22 2e 74 63 6d 74 72 63 22 29 0a sts? ".tcmtrc").
39f0: 20 20 20 20 28 6c 6f 61 64 20 22 2e 74 63 6d 74 (load ".tcmt
3a00: 72 63 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rc"))..(define (
3a10: 6d 61 69 6e 29 0a 20 20 28 6c 65 74 2a 20 28 28 main). (let* ((
3a20: 6d 74 2d 64 6f 6e 65 20 23 66 29 0a 09 20 28 70 mt-done #f).. (p
3a30: 69 64 20 20 20 20 20 23 66 29 0a 09 20 28 74 68 id #f).. (th
3a40: 31 20 20 20 20 20 28 6d 61 6b 65 2d 74 68 72 65 1 (make-thre
3a50: 61 64 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 ad (lambda ()...
3a60: 09 09 20 28 70 72 69 6e 74 20 22 52 75 6e 6e 69 .. (print "Runni
3a70: 6e 67 20 6d 65 67 61 74 65 73 74 20 22 20 28 73 ng megatest " (s
3a80: 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 tring-interspers
3a90: 65 20 6f 72 69 67 61 72 67 73 20 22 20 22 29 29 e origargs " "))
3aa0: 0a 09 09 09 09 20 28 73 65 74 21 20 70 69 64 20 ..... (set! pid
3ab0: 28 70 72 6f 63 65 73 73 2d 72 75 6e 20 22 6d 65 (process-run "me
3ac0: 67 61 74 65 73 74 22 20 6f 72 69 67 61 72 67 73 gatest" origargs
3ad0: 29 29 29 0a 09 09 09 20 20 20 20 20 20 20 22 4d ))).... "M
3ae0: 65 67 61 74 65 73 74 20 6a 6f 62 22 29 29 0a 09 egatest job"))..
3af0: 20 28 74 68 32 20 20 20 20 20 28 6d 61 6b 65 2d (th2 (make-
3b00: 74 68 72 65 61 64 20 28 6c 61 6d 62 64 61 20 28 thread (lambda (
3b10: 29 0a 09 09 09 09 20 28 6d 6f 6e 69 74 6f 72 20 )..... (monitor
3b20: 70 69 64 29 29 0a 09 09 09 20 20 20 20 20 20 20 pid))....
3b30: 22 4d 6f 6e 69 74 6f 72 20 6a 6f 62 22 29 29 29 "Monitor job")))
3b40: 0a 20 20 20 20 28 74 68 72 65 61 64 2d 73 74 61 . (thread-sta
3b50: 72 74 21 20 74 68 31 29 0a 20 20 20 20 28 74 68 rt! th1). (th
3b60: 72 65 61 64 2d 73 6c 65 65 70 21 20 31 29 20 3b read-sleep! 1) ;
3b70: 3b 20 67 69 76 65 20 74 68 65 20 70 72 6f 63 65 ; give the proce
3b80: 73 73 20 74 69 6d 65 20 74 6f 20 67 65 74 20 67 ss time to get g
3b90: 6f 69 6e 67 0a 20 20 20 20 28 74 68 72 65 61 64 oing. (thread
3ba0: 2d 73 74 61 72 74 21 20 74 68 32 29 0a 20 20 20 -start! th2).
3bb0: 20 28 74 68 72 65 61 64 2d 6a 6f 69 6e 21 20 74 (thread-join! t
3bc0: 68 32 29 29 29 0a 0a 28 69 66 20 28 61 72 67 73 h2)))..(if (args
3bd0: 3a 67 65 74 2d 61 72 67 20 22 2d 74 63 2d 72 65 :get-arg "-tc-re
3be0: 70 6c 22 29 0a 20 20 20 20 28 72 65 70 6c 29 0a pl"). (repl).
3bf0: 20 20 20 20 28 6d 61 69 6e 29 29 0a 0a 3b 3b 20 (main))..;;
3c00: 28 70 72 6f 63 65 73 73 2d 77 61 69 74 29 0a 0a (process-wait)..