1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
|
(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))
|
|
|
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
|
(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))
|
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
|
(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))
|
|
>
|
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
|
(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))
|
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
|
(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)
|
|
|
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
|
(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)
|