1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
|
(list fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data)))
(define (cdb:tests-register-test run-id test-name item-path #!key (force-write #f))
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(debug:print 4 "INFO: Adding " run-id ", " test-name "/" item-path " for setting pass/fail counts to the queue")
(mutex-lock! *incoming-mutex*)
(set! *last-db-access* (current-seconds))
(set! *incoming-data* (cons (vector 'register-test
(current-milliseconds)
(list run-id test-name item-path)) ;; fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if (and (not force-write) *cache-on*)
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data))))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
;;
|
|
|
|
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
|
(list fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data)))
(define (cdb:tests-register-test run-id test-name item-path)
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(debug:print 4 "INFO: Adding " run-id ", " test-name "/" item-path " for setting pass/fail counts to the queue")
(mutex-lock! *incoming-mutex*)
(set! *last-db-access* (current-seconds))
(set! *incoming-data* (cons (vector 'register-test
(current-milliseconds)
(list run-id test-name item-path)) ;; fail-count pass-count test-id))
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write")
(db:write-cached-data))))
;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of
;; values to be applied
;;
|
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
|
(cdb:pass-fail-counts test-id fail-count pass-count)))
;; currently forces a flush of the queue
(define (rdb:tests-register-test run-id test-name item-path)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:tests-register-test host port) run-id test-name item-path force-write: #t))
(cdb:tests-register-test run-id test-name item-path force-write: #t)))
(define (rdb:flush-queue)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:flush-queue host port)))
(cdb:flush-queue)))
|
|
|
|
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
|
(cdb:pass-fail-counts test-id fail-count pass-count)))
;; currently forces a flush of the queue
(define (rdb:tests-register-test run-id test-name item-path)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:tests-register-test host port) run-id test-name item-path))
(cdb:tests-register-test run-id test-name item-path)))
(define (rdb:flush-queue)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'cdb:flush-queue host port)))
(cdb:flush-queue)))
|