| ︙ | | | ︙ | |
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
|
(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))
(overall (case state
((RUNNING) state)
((COMPLETED) state)
(else 'UNK))))
(case overall
((RUNNING)
(if (not startp)
(begin
(print "##teamcity[testStarted " tcname flowid "]")
(testdat-start-printed-set! tdat #t))))
((COMPLETED)
(if (not startp) ;; start stanza never printed
(begin
(print "##teamcity[testStarted " tcname flowid "]")
(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 "]")
(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)))
|
>
|
>
|
|
|
|
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)))
(tstmp (conc " timestamp='" etime "'")))
(case overall
((RUNNING)
(if (not startp)
(begin
(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 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 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
|
'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)
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']
|
|
|
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? 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
|
(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))
(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))
|
>
|
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
|
(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-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)
))
|
|
|
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 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)
))
|
| ︙ | | | ︙ | |