11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;; 1. Run the megatest process and pass it all the needed parameters
;; 2. Every five seconds check for state/status changes and print the info
;;
(use srfi-1 posix srfi-69 srfi-18)
(declare (uses margs))
(declare (uses rmt))
(declare (uses common))
(declare (uses megatest-version))
(include "megatest-fossil-hash.scm")
|
|
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;
;; Wrapper to enable running Megatest flows under teamcity
;;
;; 1. Run the megatest process and pass it all the needed parameters
;; 2. Every five seconds check for state/status changes and print the info
;;
(use srfi-1 posix srfi-69 srfi-18 regex)
(declare (uses margs))
(declare (uses rmt))
(declare (uses common))
(declare (uses megatest-version))
(include "megatest-fossil-hash.scm")
|
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
|
(let* ((tests (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f last-update #f)))
;; (print "DEBUG: got tests=" tests)
(for-each
(lambda (testdat)
(let* ((testn (db:test-get-fullname testdat))
(testname (db:test-get-testname testdat))
(itempath (db:test-get-item-path testdat))
(tctname (if (string=? itempath "") testname (conc testname "." itempath)))
(state (db:test-get-state testdat))
(status (db:test-get-status testdat))
(duration (db:test-get-run_duration testdat))
(comment (db:test-get-comment testdat))
(logfile (db:test-get-final_logf testdat))
(prevstat (hash-table-ref/default data testn #f))
(newstat (if (equal? state "RUNNING")
"RUNNING"
(if (equal? state "COMPLETED")
status
"UNK"))))
;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat)
(if (or (not prevstat)
(not (equal? prevstat newstat)))
(begin
(case (string->symbol newstat)
((UNK) ) ;; do nothing
((RUNNING) (print "##teamcity[testStarted name='" tctname "']"))
((PASS SKIP) (print "##teamcity[testFinished name='" tctname "' duration='" duration "']"))
(else
(print "##teamcity[testFailed name='" tctname "' message='" comment "' details='" logfile "']")))
(flush-output)
(hash-table-set! data testn newstat)))))
tests)))
run-ids))
now))
(define (monitor pid)
|
|
|
|
>
>
>
>
>
>
>
|
|
|
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
|
(let* ((tests (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f last-update #f)))
;; (print "DEBUG: got tests=" tests)
(for-each
(lambda (testdat)
(let* ((testn (db:test-get-fullname testdat))
(testname (db:test-get-testname testdat))
(itempath (db:test-get-item-path testdat))
(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))
(prevstat (hash-table-ref/default data testn #f))
(newstat (if (equal? state "RUNNING")
"RUNNING"
(if (equal? state "COMPLETED")
status
"UNK")))
(cmtstr (if comment
(conc " message='" comment "' ")
" "))
(details (if (string-match ".*html$" logfile)
(conc " details='" *toppath* "/lt/" target "/" runname "/" testname (if (equal? itempath "") "/" (conc "/" itempath "/")) logfile "' ")
"")))
;; (print "DEBUG: testn=" testn " state=" state " status=" status " prevstat=" prevstat " newstat=" newstat)
(if (or (not prevstat)
(not (equal? prevstat newstat)))
(begin
(case (string->symbol newstat)
((UNK) ) ;; do nothing
((RUNNING) (print "##teamcity[testStarted name='" tctname "']"))
((PASS SKIP) (print "##teamcity[testFinished name='" tctname "' duration='" (* 1e3 duration) "'" cmtstr details " ]"))
(else
(print "##teamcity[testFailed name='" tctname "' " cmtstr details " ]")))
(flush-output)
(hash-table-set! data testn newstat)))))
tests)))
run-ids))
now))
(define (monitor pid)
|