34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
|
)
`("-tc-repl"
)
args:arg-hash
0))
(defstruct testdat
tc-type
state
status
(tc-type #f)
(state #f)
(status #f)
(overall #f)
flowid
tctname
event_time
details
comment
duration)
(define (tcmt:print tdat)
(let ((comment (if (testdat-comment tdat)
(conc " message='" (testdat-comment tdat))
""))
(details (if (testdat-details tdat)
(conc " details='" (testdat-details tdat))
"")))
(let ((comment (if (testdat-comment tdat)
(conc " message='" (testdat-comment tdat))
""))
(details (if (testdat-details tdat)
(conc " details='" (testdat-details tdat))
""))
(flowid (conc " flowId='" (testdat-flowid tdat) "'"))
(duration (conc " duration='" (* 1e3 (testdat-duration tdat)) "'"))
(tcname (conc " name='" (testdat-tctname tdat) "'")))
(case (testdat-tc-type tdat)
((test-start)
((test-start) (print "##teamcity[testStarted " tctname flowid "]"))
(print "##teamcity[testStarted name='" (testdat-tctname tdat) "' flowId='" (testdat-flowid tdat) "']"))
((test-end)
(print "##teamcity[testFinished name='" (testdat-tctname tdat) "' duration='" (* 1e3 (testdat-duration tdat)) "'"
comment
details
" flowId='" flowid "']"))
((test-failed)
(print "##teamcity[testFailed name='" (testdat-tctname tdat) "' " comment details " flowId='" flowid "']")))))
(lambda (testdat)
(let* ((testn (db:test-get-fullname testdat))
(testname (db:test-get-testname testdat))
(itempath (db:test-get-item-path testdat))
(lambda (test-rec)
(let* ((testn (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 testdat))
(status (db:test-get-status testdat))
(duration (or (any->number (db:test-get-run_duration testdat)) 0))
(comment (db:test-get-comment testdat))
(logfile (db:test-get-final_logf testdat))
(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))
(prevstat (hash-table-ref/default data testn #f))
(conc " message='" comment "' ")
comment
(if flush
(conc "message='Test ended in state/status=" state "/" status (if (string-match "^\\s*$" comment)
", no Megatest comment found.' "
(conc ", Megatest comment='" comment "' "))) ;; special case, we are handling stragglers
" ")))
(conc "Test ended in state/status=" state "/" status (if (string-match "^\\s*$" comment)
", no Megatest comment found."
(conc ", Megatest comment=\"" comment "\""))) ;; special case, we are handling stragglers
#f)))
(details (if (string-match ".*html$" logfile)
(conc " details='" *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile "' ")
"")))
(conc *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile)
#f))
(tdat (hash-table-ref/default data testn
(let ((new (make-testdat)))
(testdat-flowid-set! new flowid)
(testdat-tctname-set! new tctname)
(testdat-event_time-set! new (current-seconds))
(hash-table-set! data testn new))))
(prevstat (testdat-overall tdat)))
;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat)
(cond
((and (not (testdat-state tdat)) ;; first time through
(equal? state "COMPLETED")) ;;
(if (or (not prevstat)
(not (equal? prevstat newstat)))
(begin
(case (string->symbol newstat)
((UNK) ) ;; do nothing
((RUNNING) (print "##teamcity[testStarted name='" tctname "' flowId='" flowid "']"))
((PASS SKIP WARN WAIVED) (print "##teamcity[testFinished name='" tctname "' duration='" (* 1e3 duration) "'" cmtstr details " flowId='" flowid "']"))
(else
(print "##teamcity[testFailed name='" tctname "' " cmtstr details " flowId='" flowid "']")))
(flush-output)
(hash-table-set! data testn newstat)))))
tests)))
run-ids))
now))
(define (monitor pid)
(let* ((run-ids #f)
(testdat (make-hash-table))
(let* ((run-ids '())
(testdats (make-hash-table)) ;; each entry is a list of testdat structs
(keys #f)
(last-update 0)
(target (or (args:get-arg "-target")
(args:get-arg "-reqtarg")))
(runname (args:get-arg "-runname"))
(tsname #f)
(flowid (conc target "/" runname)))
|
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
-
+
-
+
|
(db:get-value-by-header row header "id"))
rows)))
(set! run-ids run-ids-in)))
;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids)
(if (eq? pidres 0)
(begin
(if keys
(set! last-update (print-changes-since testdat run-ids last-update tsname target runname flowid #f)))
(set! last-update (print-changes-since testdats run-ids last-update tsname target runname flowid #f)))
(thread-sleep! 3)
(loop))
(begin
;; (print "TCMT: pidres=" pidres " exittype=" exittype " exitstatus=" exitstatus " run-ids=" run-ids)
(print "TCMT: processing any tests that did not formally complete.")
(print-changes-since testdat run-ids 0 tsname target runname flowid #t) ;; call in flush mode
(print-changes-since testdats run-ids 0 tsname target runname flowid #t) ;; call in flush mode
(print "TCMT: All done.")
)))))))
;; (if (not (eq? pidres 0)) ;; (not exitstatus))
;; (begin
;; (thread-sleep! 3)
;; (loop))
|