Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -259,40 +259,49 @@ ;; ;; trim runs to only those that are changing often here ;; (for-each (lambda (run) (let* ((run-id (db:get-value-by-header run header "id")) + (key-vals (if *useserver* + (rmt:get-key-vals run-id) + (db:get-key-vals *dbstruct-local* run-id))) + (prev-dat (let ((rec (hash-table-ref/default *allruns-by-id* run-id -1))) + (if rec rec (vector run '() key-vals (- (current-seconds) 10))))) + (prev-tests (vector-ref prev-dat 1)) + (last-update (vector-ref prev-dat 3)) (tmptests (if *useserver* (rmt:get-tests-for-run run-id testnamepatt states statuses #f #f *hide-not-hide* sort-by sort-order - 'shortlist) + 'shortlist + last-update) (db:get-tests-for-run *dbstruct-local* run-id testnamepatt states statuses #f #f *hide-not-hide* sort-by sort-order - 'shortlist))) - (tests (if (eq? *tests-sort-reverse* 3) ;; +event_time - (sort tmptests compare-tests) - tmptests)) - ;; NOTE: bubble-up also sets the global *all-item-test-names* - ;; (tests (bubble-up tmptests priority: bubble-type)) - (key-vals (if *useserver* - (rmt:get-key-vals run-id) - (db:get-key-vals *dbstruct-local* run-id)))) + 'shortlist + last-update))) + (tests (let ((newdat (delete-duplicates (append tmptests prev-tests) + (lambda (a b) + (eq? (db:test-get-id a)(db:test-get-id b)))))) + (if (eq? *tests-sort-reverse* 3) ;; +event_time + (sort newdat compare-tests) + newdat)))) + ;; NOTE: bubble-up also sets the global *all-item-test-names* + ;; (tests (bubble-up tmptests priority: bubble-type)) ;; NOTE: 11/01/2013 This routine is *NOT* getting called excessively. ;; (debug:print 0 "Getting data for run " run-id " with key-vals=" key-vals) ;; Not sure this is needed? (set! referenced-run-ids (cons run-id referenced-run-ids)) (if (> (length tests) maxtests) (set! maxtests (length tests))) (if (or (not *hide-empty-runs*) ;; this reduces the data burden when set (not (null? tests))) - (let ((dstruct (vector run tests key-vals))) + (let ((dstruct (vector run tests key-vals last-update))) ;; ;; compare the tests with the tests in *allruns-by-id* same run-id ;; if different then increment value in *runchangerate* ;; (hash-table-set! *allruns-by-id* run-id dstruct) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2134,11 +2134,11 @@ ;; 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 dbstruct run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals) +(define (db:get-tests-for-run dbstruct run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update) (if (not (number? run-id)) (begin ;; no need to treat this as an error by default (debug:print 4 "WARNING: call to db:get-tests-for-run with bad run-id=" run-id) ;; (print-call-chain (current-error-port)) '()) @@ -2173,13 +2173,15 @@ (statuses-qry (conc " AND " statuses-qry)) (else ""))) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT " qryvalstr - " FROM tests WHERE run_id=? AND state != 'DELETED' " + " FROM tests WHERE run_id=? " + (if last-update " " " AND state != 'DELETED' ") ;; if using last-update we want deleted tests? states-statuses-qry (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") + (if last-update (conc " AND last_update > " last-update " ") "") (case sort-by ((rundir) " ORDER BY length(rundir) ") ((testname) (conc " ORDER BY testname " (if sort-order (conc sort-order ",") "") " item_path ")) ((statestatus) (conc " ORDER BY state " (if sort-order (conc sort-order ",") "") " status ")) ((event_time) " ORDER BY event_time ") @@ -2257,11 +2259,11 @@ ) ;; get a useful subset of the tests data (used in dashboard ;; (define (db:get-tests-for-run-mindata dbstruct run-id testpatt states statuses not-in) - (db:get-tests-for-run dbstruct run-id testpatt states statuses #f #f not-in #f #f "id,run_id,testname,state,status,event_time,item_path")) + (db:get-tests-for-run dbstruct run-id testpatt states statuses #f #f not-in #f #f "id,run_id,testname,state,status,event_time,item_path" #f)) ;; do not use. ;; (define (db:get-tests-for-runs dbstruct run-ids testpatt states statuses #!key (not-in #f)(qryvals #f)) ;; (db:delay-if-busy) @@ -3202,11 +3204,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 dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f))) + (let ((results (db:get-tests-for-run dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #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) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -386,13 +386,13 @@ (rmt:send-receive 'test-set-state-status-by-id run-id (list run-id test-id newstate newstatus newcomment))) (define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) (rmt:send-receive 'set-tests-state-status run-id (list run-id testnames currstate currstatus newstate newstatus))) -(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals) +(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update) (if (number? run-id) - (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) + (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update)) (begin (debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id) (print-call-chain (current-error-port)) '())))