3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
|
-1 "-" "-"))
;;
;; 1. cache tests-match-qry
;; 2. compile qry and store in hash
;; 3. convert for-each-row to fold
;;
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
(db:with-db
dbstruct run-id #f
(lambda (db)
(let* ((res '())
(stmt-cache (dbr:dbstruct-stmt-cache dbstruct))
(stmth (let* ((sh (db:hoh-get stmt-cache db testpatt)))
(or sh
(let* ((tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))
(newsh (sqlite3:prepare db qry)))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
(db:hoh-set! stmt-cache db testpatt newsh)
newsh)))))
(reverse
(sqlite3:fold-row
(lambda (res id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
(cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))
'()
stmth
run-id))))))
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0))
(let* ((res '())
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? "
" AND last_update > ? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
|
-1 "-" "-"))
;;
;; 1. cache tests-match-qry
;; 2. compile qry and store in hash
;; 3. convert for-each-row to fold
;;
;; (define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
;; (db:with-db
;; dbstruct run-id #f
;; (lambda (db)
;; (let* ((res '())
;; (stmt-cache (dbr:dbstruct-stmt-cache dbstruct))
;; (stmth (let* ((sh (db:hoh-get stmt-cache db testpatt)))
;; (or sh
;; (let* ((tests-match-qry (tests:match->sqlqry testpatt))
;; (qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? "
;; (if tests-match-qry (conc " AND (" tests-match-qry ") ") "")))
;; (newsh (sqlite3:prepare db qry)))
;; (debug:print-info 8 *default-log-port* "db:get-tests-for-run qry=" qry)
;; (db:hoh-set! stmt-cache db testpatt newsh)
;; newsh)))))
;; (reverse
;; (sqlite3:fold-row
;; (lambda (res id testname item-path state status)
;; ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
;; (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res))
;; '()
;; stmth
;; run-id))))))
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt #!optional (last-update 0))
(let* ((res '())
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status,event_time,run_duration FROM tests WHERE run_id=? "
" AND last_update > ? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
|
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
|
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
(define (db:get-test-times dbstruct run-name target)
(let ((res `())
(qry (conc "select testname, item_path, run_duration, " (string-join (db:get-keys dbstruct) " || '/' || ") " as target from tests inner join runs on tests.run_id = runs.id where runs.runname = ? and target = ? ;")))
(db:with-db
dbstruct
#f ;; this is for the main runs db
#f ;; does not modify db
(lambda (db)
(sqlite3:for-each-row
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
|
(lambda (test-name item-path test-time target )
(set! res (cons (vector test-name item-path test-time) res)))
db
qry
run-name target)
res))))
;;======================================================================
;; S T E P S
;;======================================================================
(define (db:teststep-set-status! dbstruct run-id test-id teststep-name state-in status-in comment logfile)
(db:with-db
dbstruct
|
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
|
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
db
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(reverse res)))))
;; This routine moved from tdb.scm, :read-test-data
;;
(define (db:read-test-data* dbstruct run-id test-id categorypatt varpatt)
(let* ((res '()))
(db:with-db
dbstruct #f #f
(lambda (db)
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
|
|
|
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
|
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
db
"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
(reverse res)))))
;; This routine moved from tdb.scm, :read-test-data
;;
(define (db:read-test-data-varpatt dbstruct run-id test-id categorypatt varpatt)
(let* ((res '()))
(db:with-db
dbstruct #f #f
(lambda (db)
(sqlite3:for-each-row
(lambda (id test_id category variable value expected tol units comment status type)
(set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
|