Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -601,23 +601,23 @@ ;;====================================================================== ;; 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)) +(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 Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -402,11 +402,11 @@ (debug:print 1 "INFO: Skipping " (tests:testqueue-get-testname test-record) " " item-path " as it doesn't match " item-patts) (thread-sleep! *global-delta*) (if (not (null? tal)) (loop (car tal)(cdr tal) reruns))) ((not (hash-table-ref/default test-registery (runs:make-full-test-name test-name item-path) #f)) - (rdb:tests-register-test run-id test-name item-path) + (open-run-close db:tests-register-test #f run-id test-name item-path) (hash-table-set! test-registery (runs:make-full-test-name test-name item-path) #t) (thread-sleep! *global-delta*) (loop (car newtal)(cdr newtal) reruns)) ((not have-resources) ;; simply try again after waiting a second (thread-sleep! (+ 1 *global-delta*)) @@ -614,11 +614,11 @@ ;; (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)) (if (not test-id) (begin (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id) - (rdb:tests-register-test run-id test-name item-path) + (open-run-close db:tests-register-test #f run-id test-name item-path) (set! test-id (open-run-close db:get-test-id db run-id test-name item-path)))) (debug:print 4 "INFO: test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"") (set! testdat (open-run-close db:get-test-info-by-id db test-id)))) (set! test-id (db:test-get-id testdat)) (change-directory test-path)