732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
|
(hash-table-set! *target* run-id thekey)
thekey))))
;;======================================================================
;; T E S T S
;;======================================================================
(define (db:tests-register-test db run-id test-name item-path)
(debug:print-info 11 "db:tests-register-test START db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(for-each
(lambda (pth)
(sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');"
run-id
test-name
pth))
item-paths)
(debug:print-info 11 "db:tests-register-test END db=" db ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"")
#f))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
732
733
734
735
736
737
738
739
740
741
742
743
744
745
|
(hash-table-set! *target* run-id thekey)
thekey))))
;;======================================================================
;; T E S T S
;;======================================================================
;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
(define (db:get-tests-for-run db run-id testpatt states statuses
#!key (not-in #t)
(sort-by #f) ;; 'rundir 'event_time
|
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
|
(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
(cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))
(define (cdb:tests-register-test serverdat run-id test-name item-path)
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path)))
|
>
|
>
|
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
|
(define (cdb:pass-fail-counts serverdat test-id fail-count pass-count)
(cdb:client-call serverdat 'pass-fail-counts #t *default-numtries* fail-count pass-count test-id))
(define (cdb:tests-register-test serverdat run-id test-name item-path)
(let ((item-paths (if (equal? item-path "")
(list item-path)
(list item-path ""))))
(for-each (lambda (pth)
(cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name pth))
item-paths)))
(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*))
|
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
|
(if (directory? path)
(debug:print 2 "Found path: " path)
(debug:print 2 "No such path: " path)))
db
"SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name)
res))
(define db:queries
(list '(register-test "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
'(state-status "UPDATE tests SET state=?,status=? WHERE id=?;")
'(state-status-msg "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
'(pass-fail-counts "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")
;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps
|
>
>
>
>
|
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
|
(if (directory? path)
(debug:print 2 "Found path: " path)
(debug:print 2 "No such path: " path)))
db
"SELECT rundir,final_logf FROM tests WHERE run_id=? AND testname=? AND item_path='';"
run-id test-name)
res))
;;======================================================================
;; A G R E G A T E D T R A N S A C T I O N D B W R I T E S
;;======================================================================
(define db:queries
(list '(register-test "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');")
'(state-status "UPDATE tests SET state=?,status=? WHERE id=?;")
'(state-status-msg "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;")
'(pass-fail-counts "UPDATE tests SET fail_count=?,pass_count=? WHERE id=?;")
;; test_data-pf-rollup is used to set a tests PASS/FAIL based on the pass/fail info from the steps
|