1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
|
(db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs
;;
(define (db:delete-test-records dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id)))
(db:general-call db 'delete-test-step-records (list test-id))
(db:general-call db 'delete-test-data-records (list test-id))
(sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id))
(define (db:delete-tests-for-run dbdbstruct run-id)
(let ((db (db:get-db dbstruct run-id)))
(sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id)))
(define (db:delete-old-deleted-test-records dbstruct)
(let ((run-ids (db:get-all-run-ids dbstruct))
|
|
|
|
|
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
|
(db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path"))
;; Convert calling routines to get list of run-ids and loop, do not use the get-tests-for-runs
;;
(define (db:delete-test-records dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id)))
(db:general-call db 'delete-test-step-records (list test-id))
(db:general-call db 'delete-test-data-records (list test-id))
(sqlite3:execute db "UPDATE tests SET state='DELETED',status='n/a',comment='' WHERE id=?;" test-id)))
(define (db:delete-tests-for-run dbdbstruct run-id)
(let ((db (db:get-db dbstruct run-id)))
(sqlite3:execute db "DELETE FROM tests WHERE run_id=?;" run-id)))
(define (db:delete-old-deleted-test-records dbstruct)
(let ((run-ids (db:get-all-run-ids dbstruct))
|
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
|
testnames))
;; speed up for common cases with a little logic
;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
(define (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus newcomment)
(let ((db (db:get-db dbstruct run-id)))
(cond
((and newstate newstatus newcomment)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))))
(mt:process-triggers test-id newstate newstatus))
;; Never used, but should be?
(define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state status run-id test-name item-path))
;; NEW BEHAVIOR: Count tests running in only one run!
|
|
|
|
|
|
|
|
|
|
|
|
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
|
testnames))
;; speed up for common cases with a little logic
;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
(define (db:test-set-state-status-by-id dbstruct run-id test-id newstate newstatus newcomment)
(let ((db (db:get-db dbstruct run-id)))
(cond
((and newstate newstatus newcomment)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id))
((and newstate newstatus)
(sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
(else
(if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id))
(if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id))
(if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id))))
(mt:process-triggers test-id newstate newstatus)))
;; Never used, but should be?
(define (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;"
state status run-id test-name item-path))
;; NEW BEHAVIOR: Count tests running in only one run!
|
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
|
(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")))
(let ((db (db:get-db dbstruct rid)))
(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))
|
<
<
<
<
<
<
<
<
|
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
|
(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")))
(let ((db (db:get-db dbstruct rid)))
(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))
|