Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -92,10 +92,12 @@ (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) +(define *status-ignore-hash* (make-hash-table)) +(define *state-ignore-hash* (make-hash-table)) (define *verbosity* (cond ((args:get-arg "-debug")(string->number (args:get-arg "-debug"))) ((args:get-arg "-v") 2) ((args:get-arg "-q") 0) @@ -183,18 +185,20 @@ (define (update-rundat runnamepatt numruns testnamepatt itemnamepatt keypatts) (let* ((allruns (db:get-runs *db* runnamepatt numruns *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) - (maxtests 0)) + (maxtests 0) + (states (hash-table-keys *state-ignore-hash*)) + (statuses (hash-table-keys *status-ignore-hash*))) (if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes (begin (set! *last-update* (current-seconds)) (set! *tot-run-count* (db:get-num-runs *db* runnamepatt)))) (for-each (lambda (run) (let* ((run-id (db:get-value-by-header run header "id")) - (tests (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt)) + (tests (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses)) (key-vals (get-key-vals *db* run-id))) (if (> (length tests) maxtests) (set! maxtests (length tests))) (set! result (cons (vector run tests key-vals) result)))) runs) @@ -424,21 +428,57 @@ (result '()) (i 0)) ;; controls (along bottom) (set! controls (iup:hbox - (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" - #:action (lambda (obj unk val) - (update-search "test-name" val))) - (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" - #:action (lambda (obj unk val) - (update-search "item-name" val))) + (iup:frame + #:title "filter test and items" + (iup:hbox + (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" + #:action (lambda (obj unk val) + (update-search "test-name" val))) + (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" + #:action (lambda (obj unk val) + (update-search "item-name" val))))) (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit))) - (iup:button "<- Left" #:action (lambda (obj)(set! *start-run-offset* (+ *start-run-offset* 1)))) - (iup:button "Up ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0)))) - (iup:button "Down v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1))))) - (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset* (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0)))) + ;; (iup:button "<- Left" #:action (lambda (obj)(set! *start-run-offset* (+ *start-run-offset* 1)))) + ;; (iup:button "Up ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0)))) + ;; (iup:button "Down v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1))))) + ;; (iup:button "Right ->" #:action (lambda (obj)(set! *start-run-offset* (if (> *start-run-offset* 0)(- *start-run-offset* 1) 0)))) + (iup:frame + #:title "hide" + (iup:vbox + (iup:hbox + (iup:toggle "PASS" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *status-ignore-hash* "PASS" #t) + (hash-table-delete! *status-ignore-hash* "PASS")))) + (iup:toggle "FAIL" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *status-ignore-hash* "FAIL" #t) + (hash-table-delete! *status-ignore-hash* "FAIL")))) + (iup:toggle "WARN" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *status-ignore-hash* "WARN" #t) + (hash-table-delete! *status-ignore-hash* "WARN")))) + (iup:toggle "WAIVED" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *status-ignore-hash* "WAIVED" #t) + (hash-table-delete! *status-ignore-hash* "WAIVED"))))) + (iup:hbox + (iup:toggle "RUNNING" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *state-ignore-hash* "RUNNING" #t) + (hash-table-delete! *state-ignore-hash* "RUNNING")))) + (iup:toggle "COMPLETED" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *state-ignore-hash* "COMPLETED" #t) + (hash-table-delete! *state-ignore-hash* "COMPLETED")))) + (iup:toggle "KILLED" #:action (lambda (obj val) + (if (eq? val 1) + (hash-table-set! *state-ignore-hash* "KILLED" #t) + (hash-table-delete! *state-ignore-hash* "KILLED"))))))) (iup:valuator #:valuechanged_cb (lambda (obj) (let ((val (inexact->exact (round (string->number (iup:attribute obj "VALUE"))))) (maxruns *tot-run-count*)) ;;; (+ *num-runs* (length *allruns*)))) (set! *start-run-offset* val) (debug:print 3 "maxruns: " maxruns ", val: " val) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -133,10 +133,11 @@ expected REAL, tol REAL, units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', + type TEXT DEFAULT '', CONSTRAINT test_data UNIQUE (test_id,category,variable));") ;; Must do this *after* running patch db !! No more. (db:set-var db "MEGATEST_VERSION" megatest-version) )) db)) @@ -206,12 +207,16 @@ units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', CONSTRAINT test_data UNIQUE (test_id,category,variable));") (patch-db)) - ((< mver megatest-version) - (db:set-var db "MEGATEST_VERSION" megatest-version)))))) + ((< mver 1.27) + (db:set-var db "MEGATEST_VERSION" 1.27) + (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';") + (patch-db)) + ((< mver megatest-version) + (db:set-var db "MEGATEST_VERSION" megatest-version)))))) ;;====================================================================== ;; meta get and set vars ;;====================================================================== @@ -347,17 +352,26 @@ ;;====================================================================== ;; T E S T S ;;====================================================================== -(define (db-get-tests-for-run db run-id testpatt itempatt) - (let ((res '())) +;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN +;; i.e. these lists define what to NOT show. +(define (db-get-tests-for-run db run-id testpatt itempatt states statuses) + (let ((res '()) + (states-str (if (and states (not (null? states))) + (conc " AND state NOT IN ('" (string-intersperse states "','") "')") "")) + (statuses-str (if (and statuses (not (null? statuses))) + (conc " AND status NOT IN ('" (string-intersperse statuses "','") "')") ""))) (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 first-err first-warn) (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn) res))) db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? ORDER BY id DESC;" + (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn " + " FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? " + states-str statuses-str + " ORDER BY id DESC;") run-id (if testpatt testpatt "%") (if itempatt itempatt "%")) res)) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,6 +1,6 @@ ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.26) +(define megatest-version 1.27) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -253,11 +253,11 @@ (db:get-value-by-header run header x)) keynames) "/") "/" (db:get-value-by-header run header "runname")) (let ((run-id (db:get-value-by-header run header "id"))) - (let ((tests (db-get-tests-for-run db run-id testpatt itempatt))) + (let ((tests (db-get-tests-for-run db run-id testpatt itempatt #f #f))) ;; Each test (for-each (lambda (test) (format #t " Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n" Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -128,11 +128,11 @@ ;; if found then return that matching test record (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids) (if (null? prev-run-ids) #f (let loop ((hed (car prev-run-ids)) (tal (cdr prev-run-ids))) - (let ((results (db-get-tests-for-run db hed test-name item-path))) + (let ((results (db-get-tests-for-run db hed test-name item-path #f #f))) (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results) (if (and (null? results) (not (null? tal))) (loop (car tal)(cdr tal)) (if (null? results) #f @@ -166,11 +166,11 @@ (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids) (if (null? prev-run-ids) '() ;; no previous runs? return null (let loop ((hed (car prev-run-ids)) (tal (cdr prev-run-ids))) - (let ((results (db-get-tests-for-run db hed test-name item-path))) + (let ((results (db-get-tests-for-run db hed test-name item-path #f #f))) (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path " results: " (intersperse results "\n")) ;; Keep only the youngest of any test/item combination (for-each (lambda (testdat) @@ -750,11 +750,11 @@ (lambda (run) (let ((runkey (string-intersperse (map (lambda (k) (db:get-value-by-header run header (vector-ref k 0))) keys) "/")) (dirs-to-remove (make-hash-table))) (let* ((run-id (db:get-value-by-header run header "id") ) - (tests (db-get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt)) + (tests (db-get-tests-for-run db (db:get-value-by-header run header "id") testpatt itempatt #f #f)) (lasttpath "/does/not/exist/I/hope")) (if (not (null? tests)) (begin (debug:print 1 "Removing tests for run: " runkey " " (db:get-value-by-header run header "runname")) @@ -801,11 +801,11 @@ (hash-table-delete! dirs-to-remove dir-to-remove)) (debug:print 2 "Skipping removal of " dir-to-remove " for now as it still has references in the database"))))) (sort (hash-table-keys dirs-to-remove) (lambda (a b)(> (string-length a)(string-length b))))) ;; remove the run if zero tests remain - (let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id") #f #f))) + (let ((remtests (db-get-tests-for-run db (db:get-value-by-header run header "id") #f #f #f #f))) (if (null? remtests) ;; no more tests remaining (let* ((dparts (string-split lasttpath "/")) (runpath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))) @@ -887,11 +887,11 @@ ;; This could probably be refactored into one complex query ... (define (runs:rollup-run db keys) (let* ((new-run-id (register-run db keys)) (prev-tests (test:get-matching-previous-test-run-records db new-run-id "%" "%")) - (curr-tests (db-get-tests-for-run db new-run-id "%" "%")) + (curr-tests (db-get-tests-for-run db new-run-id "%" "%" #f #f)) (curr-tests-hash (make-hash-table))) ;; index the already saved tests by testname and itempath in curr-tests-hash (for-each (lambda (testdat) (let* ((testname (db:test-get-testname testdat)) @@ -914,11 +914,11 @@ (apply sqlite3:execute db (conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn) " "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);") new-run-id (cddr (vector->list testdat))) - (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path))) + (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path #f #f))) (hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table? ;; Now duplicate the test steps (debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat)) (sqlite3:execute db