Megatest

Check-in [f57fc9e1d1]
Login
Overview
Comment:Added first pass on timestamp
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-tcintegration
Files: files | file ages | folders
SHA1: f57fc9e1d1893af738935eb372ef5d1693cd1e58
User & Date: matt on 2017-08-07 22:59:33
Other Links: branch diff | manifest | tags
Context
2017-08-07
23:03
Merged teamcity changes into v1.64 check-in: ae54a2b85c user: matt tags: v1.64
22:59
Added first pass on timestamp Closed-Leaf check-in: f57fc9e1d1 user: matt tags: v1.64-tcintegration
21:51
Clean up cases where start or end is double reported. check-in: 9b0c71a9e2 user: matt tags: v1.64-tcintegration
Changes

Modified tcmt.scm from [54c6fac113] to [243cf2565a].

74
75
76
77
78
79
80

81
82
83
84


85
86
87
88
89

90
91
92
93
94

95
96
97
98
99
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114
74
75
76
77
78
79
80
81
82
83
84

85
86
87
88
89
90

91
92
93
94
95

96
97
98
99
100
101
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







+



-
+
+




-
+




-
+












-
+







	 (flowid   (conc " flowId='" (testdat-flowid   tdat) "'"))
	 (duration (conc " duration='" (* 1e3 (testdat-duration tdat)) "'"))
	 (tcname   (conc " name='" (testdat-tctname  tdat) "'"))
	 (state    (string->symbol (testdat-state tdat)))
	 (status   (string->symbol (testdat-status tdat)))
	 (startp   (testdat-start-printed tdat))
	 (endp     (testdat-end-printed   tdat))
	 (etime    (testdat-event-time    tdat))
	 (overall  (case state
		     ((RUNNING)   state)
		     ((COMPLETED) state)
		     (else 'UNK))))
		     (else 'UNK)))
	 (tstmp    (conc " timestamp='" etime "'")))
    (case overall
      ((RUNNING)
       (if (not startp)
	   (begin
	     (print "##teamcity[testStarted "  tcname flowid "]")
	     (print "##teamcity[testStarted "  tcname flowid tstmp "]")
	     (testdat-start-printed-set! tdat #t))))
      ((COMPLETED)
       (if (not startp) ;; start stanza never printed
	   (begin
	     (print "##teamcity[testStarted " tcname flowid "]")
	     (print "##teamcity[testStarted " tcname flowid tstmp "]")
	     (testdat-start-printed-set! tdat #t)))
       (if (not endp)
	   (begin
	     (if (member status '(PASS WARN SKIP WAIVED))
		 (print "##teamcity[testFinished" tcname flowid comment details duration "]")
		 (print "##teamcity[testFailed  " tcname flowid comment details "]"))
	     (testdat-end-printed-set! tdat #t))))
      (else
       (if flush-mode
	   (begin
	     (if (not startp)
		 (begin
		   (print "##teamcity[testStarted " tcname flowid "]")
		   (print "##teamcity[testStarted " tcname flowid tstmp "]")
		   (testdat-started-printed-set! tdat #t)))
	     (if (not endp)
		 (begin
		   (print "##teamcity[testFailed  " tcname flowid comment details "]")
		   (testdat-end-printed-set! tdat #t)))))))
    ;; (print "ERROR: tc-type \"" (testdat-tc-type tdat) "\" not recognised for " tcname)))
    (flush-output)))
150
151
152
153
154
155
156
157

158
159
160
161
162
163
164
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166







-
+







         'tqueue
         (let loop ((hed (car tqueue)) ;; by this point all duplicates by state COMPLETED are removed
                    (tal (cdr tqueue))
                    (rem '()))
           (if (> print-time (testdat-event-time hed)) ;; event happened over 15 seconds ago
               (begin
                 (tcmt:print hed flush-mode)
                 (if (null? tqueue)
                 (if (null? tal)
                     rem ;; return rem to be processed in the future
                     (loop (car tal)(cdr tal) rem)))
               (if (null? tal)
                   (cons hed rem) ;; return rem + hed for future processing
                   (loop (car tal)(cdr tal)(cons hed rem)))))))))

                            ;; ##teamcity[testStarted name='suite.testName']
196
197
198
199
200
201
202

203
204
205
206
207
208
209
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212







+







		     (is-top   (db:test-get-is-toplevel  test-rec))
		     (tname    (db:test-get-fullname     test-rec))
		     (testname (db:test-get-testname     test-rec))
		     (itempath (db:test-get-item-path    test-rec))
		     (tctname  (if (string=? itempath "") testname (conc testname "." (string-translate itempath "/" "."))))
		     (state    (db:test-get-state        test-rec))
		     (status   (db:test-get-status       test-rec))
		     (etime    (db:test-get-event_time   test-rec))
		     (duration (or (any->number (db:test-get-run_duration test-rec)) 0))
		     (comment  (db:test-get-comment      test-rec))
		     (logfile  (db:test-get-final_logf   test-rec))
		     (newstat  (cond
				((equal? state "RUNNING")   "RUNNING")
				((equal? state "COMPLETED") status)
				(flush   (conc state "/" status))
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243







-
+







				      (testdat-tctname-set!    new tctname)
				      (testdat-tname-set!      new tname)
				      (testdat-state-set!      new state)
				      (testdat-status-set!     new status)
				      (testdat-comment-set!    new cmtstr)
				      (testdat-details-set!    new details)
				      (testdat-duration-set!   new duration)
				      (testdat-event-time-set! new (current-seconds))
				      (testdat-event-time-set! new etime) ;; (current-seconds))
				      (testdat-overall-set!    new newstat)
				      (hash-table-set! data tname new)
				      new))))
		(if (not is-top)
		    (hash-table-set! data 'tqueue (cons tdat tqueue)))
                (hash-table-set! data tname tdat)
                ))