Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -707,10 +707,11 @@ ;; 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 states statuses #!key (not-in #t) (sort-by #f) ;; 'rundir 'event_time + (qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment") ) (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) (let* ((res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) @@ -726,11 +727,11 @@ (if not-in "NOT" "") " IN ('" (string-intersperse statuses "','") "')"))) (tests-match-qry (tests:match->sqlqry testpatt)) - (qry (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment " + (qry (conc "SELECT " qryvals " FROM tests WHERE run_id=? " (if states-qry (conc " AND " states-qry) "") (if statuses-qry (conc " AND " statuses-qry) "") (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by @@ -747,18 +748,27 @@ run-id ) (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) res)) +;; get a useful subset of the tests data (used in dashboard +;; use db:mintests-get-{id ,run_id,testname ...} +(define (db:get-tests-for-runs-mindata db run-ids testpatt states status) + (db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path")) + + +;; NB // This is get tests for "runs" (note the plural!!) +;; ;; 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 ;; run-ids is a list of run-ids or a single number (define (db:get-tests-for-runs db run-ids testpatt states statuses #!key (not-in #t) - (sort-by #f)) ;; 'rundir 'event_time + (sort-by #f) + (qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) (let* ((res '()) ;; if states or statuses are null then assume match all when not-in is false (states-qry (if (null? states) #f @@ -773,11 +783,11 @@ (if not-in "NOT" "") " IN ('" (string-intersperse statuses "','") "')"))) (tests-match-qry (tests:match->sqlqry testpatt)) - (qry (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment " + (qry (conc "SELECT " qryvals " FROM tests WHERE " (if run-ids (if (list? run-ids) (conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ") (conc "run_id=" run-ids " ")) Index: db_records.scm ================================================================== --- db_records.scm +++ db_records.scm @@ -29,10 +29,21 @@ (define-inline (db:test-set-final_logf! vec val)(vector-set! vec 13 val)) ;; get rows and header from (define-inline (db:get-header vec)(vector-ref vec 0)) (define-inline (db:get-rows vec)(vector-ref vec 1)) + +;; make-vector-record "" db mintest id run_id testname state status event_time item_path +;; +(define (make-db:mintest)(make-vector 7)) +(define-inline (db:mintest-get-id vec) (vector-ref vec 0)) +(define-inline (db:mintest-get-run_id vec) (vector-ref vec 1)) +(define-inline (db:mintest-get-testname vec) (vector-ref vec 2)) +(define-inline (db:mintest-get-state vec) (vector-ref vec 3)) +(define-inline (db:mintest-get-status vec) (vector-ref vec 4)) +(define-inline (db:mintest-get-event_time vec) (vector-ref vec 5)) +(define-inline (db:mintest-get-item_path vec) (vector-ref vec 6)) ;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk (define (make-db:testmeta)(make-vector 10 "")) (define-inline (db:testmeta-get-id vec) (vector-ref vec 0)) (define-inline (db:testmeta-get-testname vec) (vector-ref vec 1)) Index: newdashboard.scm ================================================================== --- newdashboard.scm +++ newdashboard.scm @@ -381,11 +381,11 @@ (get-tests-sig (conc (client:get-signature) " get-tests")) (run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data runname #f #f keypatts)) ;; Now can calculate the run-ids (run-hash (hash-table-ref/default data get-runs-sig #f)) (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) - (test-changes (synchash:client-get 'db:get-tests-for-runs get-tests-sig 0 data run-ids testpatt states statuses)) + (test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses)) (runs-hash (hash-table-ref/default data get-runs-sig #f)) (header (hash-table-ref/default runs-hash "header" #f)) (run-ids (sort (filter number? (hash-table-keys runs-hash)) (lambda (a b) (let* ((record-a (hash-table-ref runs-hash a)) @@ -421,21 +421,21 @@ ;; Do this analysis in the order of the run-ids, the most recent run wins (for-each (lambda (run-id) (let* ((new-test-dat (car test-changes)) (removed-tests (cadr test-changes)) (tests (sort (map cadr (filter (lambda (testrec) - (eq? run-id (db:test-get-run_id (cadr testrec)))) + (eq? run-id (db:mintest-get-run_id (cadr testrec)))) new-test-dat)) (lambda (a b) - (let ((time-a (db:test-get-event_time a)) - (time-b (db:test-get-event_time b))) + (let ((time-a (db:mintest-get-event_time a)) + (time-b (db:mintest-get-event_time b))) (> time-a time-b))))) ;; test-changes is a list of (( id record ) ... ) ;; Get list of test names sorted by time, remove tests (test-names (delete-duplicates (map (lambda (t) - (let ((i (db:test-get-item-path t)) - (n (db:test-get-testname t))) + (let ((i (db:mintest-get-item_path t)) + (n (db:mintest-get-testname t))) (if (string=? i "") (conc " " i) n))) tests))) (colnum (car (hash-table-ref runid-to-col run-id)))) @@ -444,14 +444,14 @@ ;; run view panel? The run view panel can have a tree selector for ;; browsing the tests/items ;; SWITCH THIS TO USING CHANGED TESTS ONLY (for-each (lambda (test) - (let* ((state (db:test-get-state test)) - (status (db:test-get-status test)) - (testname (db:test-get-testname test)) - (itempath (db:test-get-item-path test)) + (let* ((state (db:mintest-get-state test)) + (status (db:mintest-get-status test)) + (testname (db:mintest-get-testname test)) + (itempath (db:mintest-get-item_path test)) (fullname (conc testname "/" itempath)) (dispname (if (string=? itempath "") testname (conc " " itempath))) (rownum (hash-table-ref/default testname-to-row fullname #f))) (if (not rownum) (let ((rownums (hash-table-values testname-to-row))) Index: synchash.scm ================================================================== --- synchash.scm +++ synchash.scm @@ -92,11 +92,11 @@ (define (synchash:server-get db proc synckey keynum . params) ;; (debug:print-info 2 "synckey: " synckey ", keynum: " keynum ", params: " params) (let* ((synchash (hash-table-ref/default *synchashes* synckey #f)) (newdat (apply (case proc ((db:get-runs) db:get-runs) - ((db:get-tests-for-runs) db:get-tests-for-runs) + ((db:get-tests-for-runs-mindata) db:get-tests-for-runs-mindata) (else print)) db params)) (postdat #f) (make-indexed (lambda (x) (list (vector-ref x keynum) x))))