Overview
Comment: | Update on db change working nicely. Added screen shot of summary tab |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dev | kind-db-access |
Files: | files | file ages | folders |
SHA1: |
de73d1abe8950c349c983b364485c0c1 |
User & Date: | matt on 2013-07-04 02:40:39 |
Other Links: | branch diff | manifest | tags |
Context
2013-07-04
| ||
02:59 | Removed unnecessary updates to gui on summary page to minimize flicker check-in: 3b514befe4 user: matt tags: dev, kind-db-access | |
02:40 | Update on db change working nicely. Added screen shot of summary tab check-in: de73d1abe8 user: matt tags: dev, kind-db-access | |
2013-07-03
| ||
21:24 | Partial fix of balanced db access with new tabs check-in: a68eb8288b user: matt tags: dev, kind-db-access | |
Changes
Modified dashboard.scm from [12aa3146bd] to [33dd3bfe52].
︙ | ︙ | |||
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (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)) | > > > > < < < < | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *last-db-update-time* 0) (define *please-update-buttons* #t) (define *delayed-update* 0) (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 *db-file-path* (conc *toppath* "/megatest.db")) (define *tests-sort-reverse* #f) (define *hide-empty-runs* #f) (define *current-tab-number* 0) |
︙ | ︙ | |||
173 174 175 176 177 178 179 | (define (colors-similar? color1 color2) (let* ((c1 (map string->number (string-split color1))) (c2 (map string->number (string-split color2))) (delta (map (lambda (a b)(abs (- a b))) c1 c2))) (null? (filter (lambda (x)(> x 3)) delta)))) ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) | | | < < < < < < < | < < < < < < | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | (define (colors-similar? color1 color2) (let* ((c1 (map string->number (string-split color1))) (c2 (map string->number (string-split color2))) (delta (map (lambda (a b)(abs (- a b))) c1 c2))) (null? (filter (lambda (x)(> x 3)) delta)))) ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) (define (update-rundat runnamepatt numruns testnamepatt keypatts) (let* ((referenced-run-ids '()) (allruns (cdb:remote-run db:get-runs #f runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) (maxtests 0) (states (hash-table-keys *state-ignore-hash*)) (statuses (hash-table-keys *status-ignore-hash*))) ;; ;; 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")) (tests (let ((tsts (mt:get-tests-for-run run-id testnamepatt states statuses))) (if *tests-sort-reverse* (reverse tsts) tsts))) |
︙ | ︙ | |||
219 220 221 222 223 224 225 | ;; 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) (set! result (cons dstruct result)))))) runs) | < < < < | < < < < < < | 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | ;; 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) (set! result (cons dstruct result)))))) runs) (set! *header* header) (set! *allruns* result) (debug:print-info 6 "*allruns* has " (length *allruns*) " runs") maxtests)) (define *collapsed* (make-hash-table)) ; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj) (define (toggle-hide lnum) ; fulltestname) (let* ((btn (vector-ref (dboard:uidat-get-lftcol uidat) lnum)) (fulltestname (iup:attribute btn "TITLE")) |
︙ | ︙ | |||
318 319 320 321 322 323 324 | (vector-set! keycol i newval) (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) (define (update-buttons uidat numruns numtests) | < < | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | (vector-set! keycol i newval) (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) (define (update-buttons uidat numruns numtests) (let* ((runs (if (> (length *allruns*) numruns) (take-right *allruns* numruns) (pad-list *allruns* numruns))) (lftcol (dboard:uidat-get-lftcol uidat)) (tableheader (dboard:uidat-get-header uidat)) (table (dboard:uidat-get-runsvec uidat)) (coln 0)) (set! *alltestnamelst* '()) ;; create a concise list of test names (for-each (lambda (rundat) (if (vector? rundat) (let* ((testdat (vector-ref rundat 1)) (testnames (map test:test-get-fullname testdat))) |
︙ | ︙ | |||
410 411 412 413 414 415 416 | (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 test) (vector-set! buttondat 4 run-key))) (set! rown (+ rown 1)))) *alltestnamelst*)) (set! coln (+ coln 1)))) | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 test) (vector-set! buttondat 4 run-key))) (set! rown (+ rown 1)))) *alltestnamelst*)) (set! coln (+ coln 1)))) runs))) (define (mkstr . x) (string-intersperse (map conc x) ",")) (define (update-search x val) ;; (print "Setting search for " x " to " val) (hash-table-set! *searchpatts* x val)) |
︙ | ︙ | |||
850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 | (iup:vbox ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)))))) controls)) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (set! *current-tab-number* curr)) (dashboard:summary) runs-view (dashboard:run-controls) ))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Control") tabs))) (vector keycol lftcol header runsvec))) (if (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS" )) (begin (set! *num-tests* (string->number (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS")))) | > | | > > > > > < | | > > > > | < | > | < < < | | > > > | > > > > | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 | (iup:vbox ;; the header (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)))))) controls)) (tabs (iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (set! *please-update-buttons* #t) (set! *current-tab-number* curr)) (dashboard:summary) runs-view (dashboard:run-controls) ))) ;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c))) (iup:attribute-set! tabs "TABTITLE0" "Summary") (iup:attribute-set! tabs "TABTITLE1" "Runs") (iup:attribute-set! tabs "TABTITLE2" "Run Control") tabs))) (vector keycol lftcol header runsvec))) (if (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS" )) (begin (set! *num-tests* (string->number (or (args:get-arg "-rows") (get-environment-variable "DASHBOARDROWS")))) (update-rundat "%" *num-runs* "%/%" '())) (set! *num-tests* (min (max (update-rundat "%" *num-runs* "%/%" '()) 8) 20))) (define *tim* (iup:timer)) (define *ord* #f) (iup:attribute-set! *tim* "TIME" 300) (iup:attribute-set! *tim* "RUN" "YES") ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... ;; (define *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db"))) (define (dashboard:been-changed) (> (file-modification-time (conc *toppath* "/megatest.db")) *last-db-update-time*)) (define (dashboard:set-db-update-time) (set! *last-db-update-time* (file-modification-time (conc *toppath* "/megatest.db")))) (define (dashboard:recalc modtime please-update-buttons last-db-update-time) (or please-update-buttons (and (> modtime last-db-update-time) (> (current-seconds)(+ last-db-update-time 1))))) (define (dashboard:run-update x) (let* ((modtime (file-modification-time *db-file-path*)) (run-update-time (current-seconds)) (recalc (dashboard:recalc modtime *please-update-buttons* *last-db-update-time*))) (if recalc (begin (case *current-tab-number* ((0) ;; (thread-sleep! 0.25) ;; (dashboard:update-summary-tab)) ((1) ;; The runs table is active (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs* (hash-table-ref/default *searchpatts* "test-name" "%/%") ;; (hash-table-ref/default *searchpatts* "item-name" "%") (let ((res '())) (for-each (lambda (key) (if (not (equal? key "runname")) (let ((val (hash-table-ref/default *searchpatts* key #f))) (if val (set! res (cons (list key val) res)))))) *dbkeys*) res)) (update-buttons uidat *num-runs* *num-tests*))) (set! *please-update-buttons* #f) (set! *last-db-update-time* modtime) (set! *last-update* run-update-time))))) ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== ;; ease debugging by loading ~/.megatestrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (cond ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid (begin (lambda (x) |
︙ | ︙ | |||
939 940 941 942 943 944 945 | ((args:get-arg "-guimonitor") (gui-monitor *db*)) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) | | | | 927 928 929 930 931 932 933 934 935 936 937 | ((args:get-arg "-guimonitor") (gui-monitor *db*)) (else (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*)) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) (dashboard:run-update x) 1)))) (iup:main-loop) |
Modified dcommon.scm from [771ef77c06] to [767aa214b9].
︙ | ︙ | |||
163 164 165 166 167 168 169 | (for-each (lambda (entry) (let* ((row-name (car entry)) (col-name (cadr entry)) (value (caddr entry)) (row-num (cadr (assoc row-name row-indices))) (col-num (cadr (assoc col-name col-indices)))) (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) | | > | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | (for-each (lambda (entry) (let* ((row-name (car entry)) (col-name (cadr entry)) (value (caddr entry)) (row-num (cadr (assoc row-name row-indices))) (col-num (cadr (assoc col-name col-indices)))) (iup:attribute-set! stats-matrix (conc row-num ":" col-num) value))) run-stats) (iup:attribute-set! stats-matrix "REDRAW" "ALL"))))) (updater) (set! dashboard:update-summary-tab updater) (iup:attribute-set! stats-matrix "WIDTHDEF" "40") (iup:vbox (iup:label "Run statistics" #:expand "HORIZONTAL") stats-matrix))) |
︙ | ︙ |
Added docs/dashboard-summary-tab.png version [f52b6628fb].
cannot compute difference between binary files