︙ | | | ︙ | |
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
|
"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;"
run-id))))
;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
(mutex-lock! *db-transaction-mutex*)
(db:with-db
dbstruct
#f
#f
(lambda (db)
;; remove previous data
|
|
|
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
|
"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;;"
run-id))))
;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
;; (mutex-lock! *db-transaction-mutex*)
(db:with-db
dbstruct
#f
#f
(lambda (db)
;; remove previous data
|
︙ | | | ︙ | |
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
|
(for-each
(lambda (dat)
(sqlite3:execute stmt1 run-id (car dat)(cadr dat))
(apply sqlite3:execute stmt2 run-id dat))
stats)))))
(sqlite3:finalize! stmt1)
(sqlite3:finalize! stmt2)
(mutex-unlock! *db-transaction-mutex*)
res))))
(define (db:get-main-run-stats dbstruct run-id)
(db:with-db
dbstruct
#f ;; this data comes from main
#f
|
|
|
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
|
(for-each
(lambda (dat)
(sqlite3:execute stmt1 run-id (car dat)(cadr dat))
(apply sqlite3:execute stmt2 run-id dat))
stats)))))
(sqlite3:finalize! stmt1)
(sqlite3:finalize! stmt2)
;; (mutex-unlock! *db-transaction-mutex*)
res))))
(define (db:get-main-run-stats dbstruct run-id)
(db:with-db
dbstruct
#f ;; this data comes from main
#f
|
︙ | | | ︙ | |
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
|
(db:with-db
dbstruct
run-id
#t
(lambda (db)
(let ((test-id (db:get-test-id dbstruct run-id testname "")))
(sqlite3:execute db qry newstate newstatus run-id testname)
(if test-id (mt:process-triggers run-id test-id newstate newstatus)))
))))
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)
|
|
>
|
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
|
(db:with-db
dbstruct
run-id
#t
(lambda (db)
(let ((test-id (db:get-test-id dbstruct run-id testname "")))
(sqlite3:execute db qry newstate newstatus run-id testname)
(if test-id (mt:process-triggers dbstruct run-id test-id newstate newstatus))
)
))))
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)
|
︙ | | | ︙ | |
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
|
((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 ;; (sdb:qry 'getid newcomment)
test-id))))
(mt:process-triggers run-id test-id newstate newstatus))))
;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
(db:with-db
dbstruct
run-id
|
|
|
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
|
((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 ;; (sdb:qry 'getid newcomment)
test-id))))
(mt:process-triggers dbstruct run-id test-id newstate newstatus))))
;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
(db:with-db
dbstruct
run-id
|
︙ | | | ︙ | |
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
|
;; (if msg
;; (db:general-call dbdat 'state-status-msg (list state status msg test-id))
;; (db:general-call dbdat 'state-status (list state status test-id)))
(db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
;; process the test_data table
(if (and test-id state status (equal? status "AUTO"))
(db:test-data-rollup dbstruct run-id test-id status))
(mt:process-triggers run-id test-id state status)))
;; state is the priority rollup of all states
;; status is the priority rollup of all completed statesfu
;;
;; if test-name is an integer work off that instead of test-name test-path
;;
(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
;; establish info on incoming test followed by info on top level test
(let* ((db (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
(testdat (if (number? test-name)
(db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
(db:get-test-info dbstruct run-id test-name item-path)))
(test-id (db:test-get-id testdat))
(test-name (if (number? test-name)
(db:test-get-testname testdat)
test-name))
(item-path (db:test-get-item-path testdat))
(tl-testdat (db:get-test-info dbstruct run-id test-name ""))
(tl-test-id (db:test-get-id tl-testdat)))
(mutex-lock! *db-transaction-mutex*)
(let ((tr-res
(sqlite3:with-transaction
db
(lambda ()
(db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
(if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
(let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
|
|
|
|
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
|
;; (if msg
;; (db:general-call dbdat 'state-status-msg (list state status msg test-id))
;; (db:general-call dbdat 'state-status (list state status test-id)))
(db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
;; process the test_data table
(if (and test-id state status (equal? status "AUTO"))
(db:test-data-rollup dbstruct run-id test-id status))
(mt:process-triggers dbstruct run-id test-id state status)))
;; state is the priority rollup of all states
;; status is the priority rollup of all completed statesfu
;;
;; if test-name is an integer work off that instead of test-name test-path
;;
(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
;; establish info on incoming test followed by info on top level test
(let* ((db (db:dbdat-get-db (dbr:dbstruct-tmpdb dbstruct)))
(testdat (if (number? test-name)
(db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
(db:get-test-info dbstruct run-id test-name item-path)))
(test-id (db:test-get-id testdat))
(test-name (if (number? test-name)
(db:test-get-testname testdat)
test-name))
(item-path (db:test-get-item-path testdat))
(tl-testdat (db:get-test-info dbstruct run-id test-name ""))
(tl-test-id (db:test-get-id tl-testdat)))
;; (mutex-lock! *db-transaction-mutex*)
(let ((tr-res
(sqlite3:with-transaction
db
(lambda ()
(db:test-set-state-status-by-id dbstruct run-id test-id state status comment)
(if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
(let* ((state-status-counts (db:get-all-state-status-counts-for-test db run-id test-name item-path)) ;; item-path is used to exclude current state/status of THIS test
|
︙ | | | ︙ | |
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
|
"COMPLETED"
(car all-curr-states))))
(newstatus (if (> bad-not-started 0)
"CHECK"
(car all-curr-statuses))))
;; (print "Setting toplevel to: " newstate "/" newstatus)
(db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f))))))
(mutex-unlock! *db-transaction-mutex*))
tr-res)))
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)
;; call with state = #f to roll up with out accounting for state/status of this item
;;
;; (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
|
|
>
|
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
|
"COMPLETED"
(car all-curr-states))))
(newstatus (if (> bad-not-started 0)
"CHECK"
(car all-curr-statuses))))
;; (print "Setting toplevel to: " newstate "/" newstatus)
(db:test-set-state-status-by-id dbstruct run-id tl-test-id newstate newstatus #f))))))
;;(mutex-unlock! *db-transaction-mutex*)
)
tr-res)))
(define db:roll-up-pass-fail-counts db:set-state-status-and-roll-up-items)
;; call with state = #f to roll up with out accounting for state/status of this item
;;
;; (define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
|
︙ | | | ︙ | |