1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
|
(if msg
(db:general-call db 'state-status-msg (list state status msg test-id))
(db:general-call db 'state-status (list state status test-id))))
(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
(if (and (not (equal? item-path ""))
(member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
(handle-exceptions
exn
(begin
(debug:print 0 "Problem with call to cdb:remote-run, database may be locked and read-only, waiting and trying again ...")
(thread-sleep! 10)
(apply cdb:remote-run proc db params))
(apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))
(begin
(db:general-call db 'update-pass-fail-counts (list run-id test-name run-id test-name run-id test-name))
(if (equal? status "RUNNING")
(db:general-call db 'top-test-set-running (list run-id test-name))
(db:general-call db 'top-test-set-per-pf-counts (list run-id test-name run-id test-name run-id test-name)))
#f)
#f))
|
<
<
<
<
<
<
<
|
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
|
(if msg
(db:general-call db 'state-status-msg (list state status msg test-id))
(db:general-call db 'state-status (list state status test-id))))
(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
(if (and (not (equal? item-path ""))
(member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
(begin
(db:general-call db 'update-pass-fail-counts (list run-id test-name run-id test-name run-id test-name))
(if (equal? status "RUNNING")
(db:general-call db 'top-test-set-running (list run-id test-name))
(db:general-call db 'top-test-set-per-pf-counts (list run-id test-name run-id test-name run-id test-name)))
#f)
#f))
|