1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
|
(list item-path ""))))
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
(define (cdb:flush-queue serverdat)
(cdb:client-call serverdat 'flush #f *default-numtries*))
(define (cdb:kill-server serverdat)
(cdb:client-call serverdat 'killserver #f *default-numtries*))
(define (cdb:roll-up-pass-fail-counts serverdat run-id test-name item-path status)
(cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status))
(define (cdb:get-test-info serverdat run-id test-name item-path)
(cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info #f run-id test-name item-path))
|
|
|
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
|
(list item-path ""))))
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
(define (cdb:flush-queue serverdat)
(cdb:client-call serverdat 'flush #f *default-numtries*))
(define (cdb:kill-server serverdat)
(cdb:client-call serverdat 'killserver #t *default-numtries*))
(define (cdb:roll-up-pass-fail-counts serverdat run-id test-name item-path status)
(cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status))
(define (cdb:get-test-info serverdat run-id test-name item-path)
(cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info #f run-id test-name item-path))
|
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
|
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate
flush
sync
set-verbosity
killserver))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
(define (db:process-cached-writes db)
(let ((queries (make-hash-table))
(data #f))
|
|
>
|
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
|
(define db:special-queries '(rollup-tests-pass-fail
db:roll-up-pass-fail-counts
login
immediate
flush
sync
set-verbosity
killserver
))
;; not used, intended to indicate to run in calling process
(define db:run-local-queries '()) ;; rollup-tests-pass-fail))
(define (db:process-cached-writes db)
(let ((queries (make-hash-table))
(data #f))
|
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
|
(debug:print-info 7 "Received " response " from wrapped write")
(server:reply return-address qry-sig response response))
;; otherwise if appropriate flush the queue (this is a read or complex query)
(begin
(cond
((member stmt-key db:special-queries)
(let ((starttime (current-milliseconds)))
(debug:print-info 11 "Handling special statement " stmt-key)
(case stmt-key
((immediate)
;; This is a read or mixed read-write query, must clear the cache
(case *transport-type*
((http)
(mutex-lock! *db:process-queue-mutex*)
(db:process-cached-writes db)
|
|
|
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
|
(debug:print-info 7 "Received " response " from wrapped write")
(server:reply return-address qry-sig response response))
;; otherwise if appropriate flush the queue (this is a read or complex query)
(begin
(cond
((member stmt-key db:special-queries)
(let ((starttime (current-milliseconds)))
(debug:print-info 9 "Handling special statement " stmt-key)
(case stmt-key
((immediate)
;; This is a read or mixed read-write query, must clear the cache
(case *transport-type*
((http)
(mutex-lock! *db:process-queue-mutex*)
(db:process-cached-writes db)
|