Megatest: Diff

Differences From Artifact [a779400c71]:

File dashboard.scm — part of check-in [7a7ceab729] at 2016-10-03 15:49:19 on branch v1.62 — Fixed read-only access issues. However it still fails if the db is old (i.e. is missing last_update field). (user: mrwellan, size: 144818) [annotate] [blame] [check-ins using]

To Artifact [e734d4686f]:

File dashboard.scm — part of check-in [18599e811e] at 2016-10-06 11:28:13 on branch v1.62 — Merged partial implementation of graph controls and added remote support for load detection (user: mrwellan, size: 147832) [annotate] [blame] [check-ins using] [more...]

︙
206 207 208 209 210 211 212 213 214 215 216 217 218 219	206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227	+ + + + + + + +	((max-row 0) : number) ((running-layout #f) : boolean) (originx #f) (originy #f) ((layout-update-ok #t) : boolean) ((compact-layout #t) : boolean) ;; Run times layout (graph-button-box #f) (graph-matrix #f) ((graph-matrix-table (make-hash-table)) : hash-table) ((graph-matrix-row 1) : number) ((graph-matrix-col 1) : number) ;; ((graph-button-dat (make-hash-table)) : hash-table) ;;RA=> Deprecating buttons as of now ;; Controls used to launch runs etc. ((command "") : string) ;; for run control this is the command being built up (command-tb #f) (key-listboxes #f) (key-lbs #f) run-name ;; from run name setting widget states ;; states for -state s1,s2 ...
︙
249 250 251 252 253 254 255 ~~256~~ 257 258 259 260 261 262 263	257 258 259 260 261 262 263 264 265 266 267 268 269 270	-	((path-run-ids (make-hash-table)) : hash-table) ;; path (target / runname) => id (runs-tree #f) ;; tab data ((view-changed #t) : boolean) ((xadj 0) : number) ;; x slider number (if using canvas) ((yadj 0) : number) ;; y slider number (if using canvas) ;; runs-summary tab state ((runs-summary-modes '((one-run . "Show One Run") (xor-two-runs . "XOR Two Runs") (xor-two-runs-hide-clean . "XOR; Hide Clean")) ) : list) ((runs-summary-mode-buttons '()) : list) ((runs-summary-mode 'one-run) : symbol) ((runs-summary-mode-change-callbacks '()) : list) (runs-summary-source-runname-label #f) (runs-summary-dest-runname-label #f)
︙
927 928 929 930 931 932 933 ~~934~~ 935 936 937 938 939 940 941	934 935 936 937 938 939 940 941 942 943 944 945 946 947	-	(color (car (gutils:get-color-for-state-status teststate teststatus))) (curr-color (vector-ref buttondat 1)) ;; (iup:attribute button "BGCOLOR")) (curr-title (vector-ref buttondat 2))) ;; (iup:attribute button "TITLE"))) (if (not (equal? curr-color color)) (iup:attribute-set! button "BGCOLOR" color)) (if (not (equal? curr-title buttontxt)) (iup:attribute-set! button "TITLE" buttontxt)) ;;(print "RA => testdat " testdat " teststate " teststate " teststatus " teststatus " buttondat " buttondat " curr-color " curr-color " curr-title " curr-title "buttontxt" buttontxt " title " curr-title ) (vector-set! buttondat 0 run-id) (vector-set! buttondat 1 color) (vector-set! buttondat 2 buttontxt) (vector-set! buttondat 3 testdat) (vector-set! buttondat 4 run-key))) (set! rown (+ rown 1)))) (dboard:tabdat-all-test-names tabdat)))
︙
1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365	1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374	+ + +	(dboard:tabdat-compact-layout-set! tabdat #t)) (dboard:tabdat-last-filter-str-set! tabdat "") ) "text-list-toggle-box")))) (dcommon:command-runname-selector commondat tabdat tab-num: tab-num) (dcommon:command-testname-selector commondat tabdat update-keyvals)) (iup:vbox (iup:split #:orientation "HORIZONTAL" #:value 800 (let* ((cnv-obj (iup:canvas ;; #:size "500x400" #:expand "YES" #:scrollbar "YES" #:posx "0.5" #:posy "0.5" #:action (make-canvas-action
︙
1392 1393 1394 1395 1396 1397 1398 ~~1399~~ 1400 1401 1402 1403 1404 1405 1406	1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444	- + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +	(vg:drawing-scalex-set! drawing (+ scalex (if (> step 0) (* scalex 0.02) (* scalex -0.02)))))) "wheel-cb")) ))) ~~cnv-obj)~~))))~~~~ cnv-obj) (let* ((hb1 (iup:hbox)) (graph-matrix-table (dboard:tabdat-graph-matrix-table tabdat)) (curr-column-num 0) (graph-matrix (iup:matrix #:alignment1 "ALEFT" #:expand "YES" ;; "HORIZONTAL" #:numcol 10 #:numlin 20 #:numcol-visible (min 10) #:numlin-visible 1))) (dboard:tabdat-graph-matrix-set! tabdat graph-matrix) (iup:attribute-set! graph-matrix "WIDTH0" 0) (iup:attribute-set! graph-matrix "HEIGHT0" 0) graph-matrix)) ;;(hash-table-set! graph-matrix-table 'graph1 "color1") ;;(hash-table-set! graph-matrix-table 'graph2 "color2") ;; (for-each ;; (lambda (name-key) ;; (print "hash-table-key : " name-key) ;; (iup:attribute-set! graph-matrix (conc "0:" curr-column-num) name-key) ;; ;; set the color to the value of mame-key in the table ;; (set! curr-column-num (+ 1 curr-column-num))) ;; (hash-table-keys graph-matrix-table)) ;; (iup:split ;; #:orientation "HORIZONTAL" ;; "HORIZONTAL" ;; #:value 50 ;; (iup:label "Graph") ;; graph-matrix)) )))) ;;====================================================================== ;; R U N ;;====================================================================== ;; ;; display and manage a single run at a time
︙
1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631	1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670	+	(col-num (cadr (assoc col-name col-indices))) (key (conc row-num ":" col-num))) (hash-table-set! cell-lookup key test-id) (if (not (equal? (iup:attribute run-matrix key) (cadr value))) (begin (set! changed #t) (iup:attribute-set! run-matrix key (cadr value)) (print "RA=> value" (car value)) (iup:attribute-set! run-matrix (conc "BGCOLOR" key) (car value)))))) matrix-content) ;; Col labels - do after setting Cell contents so they are accounted for in the size calc. (for-each (lambda (ind) (let* ((name (car ind))
︙
2170 2171 2172 2173 2174 2175 2176 ~~2177~~ 2178 2179 2180 2181 2182 2183 2184	2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223	- +	"Clean Complete Run" #:action (lambda (obj) (common:run-a-command (conc "megatest -remove-runs -target " target " -runname " runname " -testpatt % ")))) ~~(iup:menu-item ~~;; RADT => itemize this run lists before merging with v1.61~~~~ (iup:menu-item "Kill Complete Run" #:action (lambda (obj) (common:run-a-command (conc "megatest -set-state-status KILLREQ,n/a -target " target " -runname " runname " -testpatt % "
︙
2815 2816 2817 2818 2819 2820 2821 ~~2822~~ 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 ~~2834~~ 2835 2836 2837 2838 2839 2840 2841	2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883	- + - + + + +	fieldname (cons (apply vector tstart (cdr zeropt)) (hash-table-ref/default res-ht fieldname '()))))))) fields) res-ht) #f))))) ;; graph data ;; tsc=timescale, tfn=function; time->x ;; (define (dboard:graph commondat tabdat tabnum llx lly ulx uly tstart tend tsc tfn compname cmargin) (let* ((dwg (dboard:tabdat-drawing tabdat)) (lib (vg:get/create-lib dwg "runslib")) (cnv (dboard:tabdat-cnv tabdat)) (dur (- tstart tend)) ;; time duration (cmp (vg:get-component dwg "runslib" compname)) (cfg (configf:get-section configdat "graph")) (stdcolor (vg:rgb->number 120 130 140)) ~~(delta-y (- uly lly)))~~ (delta-y (- uly lly)) (graph-matrix-table (dboard:tabdat-graph-matrix-table tabdat)) (graph-matrix (dboard:tabdat-graph-matrix tabdat)) (changed #f)) (vg:add-obj-to-comp cmp (vg:make-rect-obj llx lly ulx uly)) (vg:add-obj-to-comp cmp (vg:make-text-obj (- (tfn tstart) 10)(- lly 10)(seconds->year-week/day-time tstart))) (let*-values (((span timeunit time-blk first timesym) (common:find-start-mark-and-mark-delta tstart tend)))
︙
2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 ~~2872 2873~~ 2874 2875 2876 2877 2878 2879 2880	2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940	+ + + + + + + + + + + + + + + + + + - - + +	(lambda (cf) (let* ((alldat (dboard:graph-read-data (cadr cf) tstart tend))) (if alldat (for-each (lambda (fieldn) (let* ((dat (hash-table-ref alldat fieldn)) (vals (map (lambda (x)(vector-ref x 2)) dat))) (if (not (hash-table-exists? graph-matrix-table fieldn)) ;;(print fieldn "exists") (begin (let* ((graph-color-rgb (vg:generate-color-rgb)) (graph-color (vg:iup-color->number graph-color-rgb)) (graph-matrix-col (dboard:tabdat-graph-matrix-col tabdat)) (graph-matrix-row (dboard:tabdat-graph-matrix-row tabdat))) (hash-table-set! graph-matrix-table fieldn graph-color) (print "Graph data " graph-matrix-row " " graph-matrix-col " " fieldn " " graph-color " " graph-color-rgb) (set! changed #t) (iup:attribute-set! graph-matrix (conc graph-matrix-row ":" graph-matrix-col) fieldn) (iup:attribute-set! graph-matrix (conc "BGCOLOR" (conc graph-matrix-row ":" graph-matrix-col)) graph-color-rgb) (if (> graph-matrix-col 10) (begin (dboard:tabdat-graph-matrix-col-set! tabdat 1) (dboard:tabdat-graph-matrix-row-set! tabdat (+ graph-matrix-row 1))) (dboard:tabdat-graph-matrix-col-set! tabdat (+ graph-matrix-col 1))) ))) (if (not (null? vals)) (let* ((maxval (apply max vals)) (minval (min 0 (apply min vals))) (yoff (- minval lly)) ;; minval)) (deltaval (- maxval minval)) (yscale (/ delta-y (if (zero? deltaval) 1 deltaval))) (yfunc (lambda (y)(+ lly (* yscale (- y minval))))) ;; (lambda (y)(* (+ y yoff) yscale)))) ~~(graph-color (vg~~:gene~~rate~~-co~~lor))) ;; ~~(prin~~t (car ~~cf) "; max~~val~~: " maxval " minval: " minval " d~~el~~taval: " deltaval " yscale: " yscale)~~~~ (graph-color (hash-table-ref graph-matrix-table fieldn))) ;; set to hash-table value for fieldn (vg:add-obj-to-comp cmp (vg:make-text-obj (- llx 10)(yfunc maxval) (conc maxval))) (vg:add-obj-to-comp cmp (vg:make-text-obj (- llx 10)(yfunc minval) (conc minval))) (fold
︙
2913 2914 2915 2916 2917 2918 2919 ~~2920~~ 2921 2922 2923 2924 2925 2926 2927	2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988	- + +	;; (vg:add-obj-to-comp ;; cmp ;; (vg:make-rect-obj (- stval 2) lly (+ stval 2)(+ lly (* yval yscale)) ;; fill-color: stdcolor)))) ;; dat) )))) ;; for each data point in the series (hash-table-keys alldat))))) ~~cfg)))~~ cfg) (if changed (iup:attribute-set! graph-matrix "REDRAW" "ALL")))) ;; run times tab ;; (define (dashboard:run-times-tab-layout-updater commondat tabdat tab-num) ;; each test is an object in the run component ;; each run is a component ;; all runs stored in runslib library
︙
3274 3275 3276 3277 3278 3279 3280 ~~3281~~ 3282 3283 3284 3285 3286 3287 3288	3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349	- +	(if (> megatest-version (common:get-last-run-version-number)) (debug:print-info 0 default-log-port "Version bump detected, blocking until db sync complete") (thread-join! th1))))) (let* ((commondat (dboard:commondat-make))) ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... (cond ((args:get-arg "-test") ;; run-id,test-id ~~(let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) ~~;; RADT couldn't find string->number, though it works~~~~ (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) (if (> (length d) 1) d (list #f #f)))) (run-id (car dat)) (test-id (cadr dat))) (if (and (number? run-id) (number? test-id)
︙