549
550
551
552
553
554
555
556
557
558
559
560
561
562
|
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
(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 itempatt states statuses
#!key (not-in #t)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
|
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
(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 4 "INFO: db:tests-register-test 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)
#f))
;; 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 itempatt states statuses
#!key (not-in #t)
|
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
|
(let* ((res #f))
(sqlite3:for-each-row
(lambda (id) ;; run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
(set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
db
"SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
run-id testname item-path)
res)
#f)
;; given a test-info record, patch in the latest data from the testdat.db file
;; found in the test run directory
(define (db:patch-tdb-data-into-test-info db test-id res)
(let ((tdb (db:open-test-db-by-test-id db test-id)))
;; get state and status from megatest.db in real time
;; other fields that perhaps should be updated:
|
|
<
|
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
|
(let* ((res #f))
(sqlite3:for-each-row
(lambda (id) ;; run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )
(set! res id)) ;; (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment )))
db
"SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;"
run-id testname item-path)
res))
;; given a test-info record, patch in the latest data from the testdat.db file
;; found in the test run directory
(define (db:patch-tdb-data-into-test-info db test-id res)
(let ((tdb (db:open-test-db-by-test-id db test-id)))
;; get state and status from megatest.db in real time
;; other fields that perhaps should be updated:
|