Changes In Branch v1.6569-new-view Excluding Merge-Ins
This is equivalent to a diff from 2769e4b7c9 to fd85f0d7b7
2021-03-02
| ||
07:59 | Patched in remaining changes from new-view branch but it still doesn't work Closed-Leaf check-in: fd85f0d7b7 user: mrwellan tags: v1.6569-new-view | |
2021-03-01
| ||
19:26 | wip check-in: b3df55613b user: mrwellan tags: v1.6569-new-view | |
17:42 | Manually patched in the new view check-in: f5206150ee user: mrwellan tags: v1.6569-new-view | |
2021-01-26
| ||
14:00 | Fix for the > crash. Maybe... Leaf check-in: 5a05fc04ff user: matt tags: v1.6569-gt-crash-fix | |
2021-01-25
| ||
12:03 | rebased lazy-queue rollup check-in: 07ab120544 user: matt tags: v1.65-lazyqueue-items-rollup | |
2021-01-15
| ||
22:46 | begin diet check-in: badd71f3b3 user: matt tags: v1.6569-diet | |
21:34 | eval-string-in-environment if was disabled, re-enabled check-in: 9564772564 user: matt tags: v1.6569-reenable-eval-if | |
2021-01-08
| ||
11:42 | enable custom value for max delay between archive time and test last update time Leaf check-in: 86a3d1148e user: pjhatwal tags: v1.6569-refactor | |
2020-11-25
| ||
12:00 | Fixed issues in server gating code Leaf check-in: 063273e8cb user: mrwellan tags: v1.6569-server-gate-fix | |
2020-11-24
| ||
22:27 | Added support for resetting run - allows to reload tests-paths to add tests to a run part way though. Just run megatest -clean-cache -runname $MT_RUNNAME Leaf check-in: 213021e02d user: mrwellan tags: v1.6596-reload-tests-paths | |
2020-10-13
| ||
16:46 | Changed version from 69 to 76. No other changes. Will compile with chicken 13 check-in: 87ca35010f user: mmgraham tags: v1.65, v1.6576 | |
2020-10-12
| ||
16:49 | Reduced message from failed to info. Reverted a delay which seems to help pass full stack ext-tests. Leaf check-in: 9e35b1252c user: mrwellan tags: v1.65-minor-patch | |
10:18 | Safe vector access in rmt. check-in: 58bb6d997a user: mrwellan tags: v1.65-side2 | |
2020-10-11
| ||
22:46 | Patched forward adjutant code. check-in: f936717bfa user: matt tags: v1.65-adjutant-again | |
2020-10-05
| ||
22:49 | Do not exit on failure to create directory - race conditons on NFS cause false fail scenarios - just keep going and cross your fingers... (cherrypicked from v1.6572) check-in: 05b253a452 user: matt tags: v1.65-sidework | |
22:46 | run duration testdat check-in: 4a0b43f3c6 user: matt tags: v1.65-test-rundat2 | |
2020-09-21
| ||
15:36 | merged in 1.65-test-rundat branch ==/FAIL/orion,mars/== check-in: cfd25d66e9 user: mmgraham tags: v1.6571, v1.65-failed-testdat | |
07:00 | Added get-testsuite-name all over launch:setup and still not set when needed! This did NOT work. Closed-Leaf check-in: 2efe8ad422 user: mrwellan tags: v1.65-get-testsuitename | |
2020-09-19
| ||
04:21 | Start moving test_rundat to no-sync db. ==/20/2/WARN/1203/mars/== check-in: abfabdb839 user: matt tags: v1.65-test-rundat | |
2020-09-18
| ||
17:30 | added check for file existence before file delete ==/14/1.9/WARN/orion,mars/== NOTE: This is the last v1.65 before the split off. I.e code from before this point IS in the far future v1.65 branch. Code from this point to that branch might NOT be in the branch. check-in: 2769e4b7c9 user: mmgraham tags: v1.65, v1.6569 | |
12:27 | cherry picked 2 fixes, changed version to 1.6569 ==/7.2/2.0/PASS/1201/mars/== check-in: d145d0eb02 user: mmgraham tags: v1.65 | |
Modified Makefile from [0dc94ad098] to [3bc35c6cb9].
︙ | ︙ | |||
85 86 87 88 89 90 91 | mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) $(MOIMPFILES) megatest-version.scm csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest showmtesthash: @echo $(MTESTHASH) | | | 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES) $(MOIMPFILES) megatest-version.scm csc $(CSCOPTS) $(OFILES) $(MOFILES) $(MOIMPFILES) megatest.o -o mtest showmtesthash: @echo $(MTESTHASH) dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm dashboard-new-runs-view.scm csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut # include makefile.inc |
︙ | ︙ | |||
178 179 180 181 182 183 184 185 186 187 188 189 190 191 | # configf.o : mofiles/commonmod.o vg.o dashboard.o : vg_records.scm megatest-version.scm dcommon.o : run_records.scm mofiles/stml2.o : mofiles/cookie.o # # special include based modules # mofiles/pkts.o : pkts/pkts.scm # mofiles/stml2.o : cookie.o # # mofiles/mtargs.o : mtargs/mtargs.scm # # mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm # mofiles/ulex.o : ulex/ulex.scm | > > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 | # configf.o : mofiles/commonmod.o vg.o dashboard.o : vg_records.scm megatest-version.scm dcommon.o : run_records.scm mofiles/stml2.o : mofiles/cookie.o dashboard.scm : # # special include based modules # mofiles/pkts.o : pkts/pkts.scm # mofiles/stml2.o : cookie.o # # mofiles/mtargs.o : mtargs/mtargs.scm # # mofiles/mtconfigf.o : mtconfigf/mtconfigf.scm # mofiles/ulex.o : ulex/ulex.scm |
︙ | ︙ |
Added dashboard-new-runs-view.scm version [98e44d893e].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 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 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 | ;:rdat;====================================================================== ;; Extracting the data to display for runs ;; ;; This needs to be re-entrant such that it does one column per call ;; on the zeroeth call update runs data ;; on each subsequent call update one run (configurable - could do two, three ... or update until tdelta exceeded ;; on last run reset to zeroeth ;; ;; 1. select with run filters; area, target, runname, runstate, runstatus, starttime, duration ;; - put this information into two data structures: ;; a. hash of area/target/runname => runstruct #< ordernun, id, area, target, runname, state, ;; status, starttime, duration, non-deleted testcount> ;; ordernum reflects order as received from sql query ;; b. sparsevec of id => runstruct ;; 2. for each run in runshash ordered by ordernum do: ;; retrieve data since last update for that run ;; if there is a deleted test - retrieve full data ;; if there are non-deleted tests register this run in the columns sparsevec ;; if this is the zeroeth column regenerate the rows sparsevec ;; if this column is in the visible zone update visible cells ;; ;; Other factors: ;; 1. left index handling: ;; - add test/itempaths to left index as discovered, re-order and ;; update row -> test/itempath mapping on each read run ;;====================================================================== ;; runs is <vec header runs> ;; get ALL runs info ;; update rdat-targ-run-id ;; update rdat-runs ;; (define (dashboard:update-runs-data rdat) (let* ((tb (dboard:rdat-runs-tree rdat)) (targ-sql-filt (dboard:rdat-targ-sql-filt rdat)) (runname-sql-filt (dboard:rdat-runname-sql-filt rdat)) (state-sql-filt (dboard:rdat-run-state-sql-filt rdat)) (status-sql-filt (dboard:rdat-run-status-sql-filt rdat)) (offset (dboard:rdat-runs-offset rdat)) (count (dboard:rdat-runs-count rdat)) ;; Use (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) (data #;(rmt:simple-get-runs runname-sql-filt count offset targ-sql-filt #f) (rmt:simple-get-runs runname-sql-filt #f #f targ-sql-filt #f)) (numruns (length data))) (print "Scan runs, offset: "offset" numruns: "numruns" count: "count) #;(if (< numruns count) ;; i.e. there are no more runs to get (begin (dboard:rdat-runs-offset-set! rdat 0)) ;; start over (dboard:rdat-runs-offset-set! rdat (+ (dboard:rdat-runs-offset rdat) numruns))) ;; store in the runsbynum vector (dboard:rdat-runsbynum-set! rdat (list->vector data)) ;; update runs id => runrec ;; update targ-runid target/runname => run-id (for-each (lambda (runrec) (let* ((run-id (simple-run-id runrec)) (full-targ-runname (conc (simple-run-target runrec) "/" (simple-run-runname runrec)))) ;; (debug:print 0 *default-log-port* "Update run " run-id) (sparse-vector-set! (dboard:rdat-runs rdat) run-id runrec) (hash-table-set! (dboard:rdat-targ-runid rdat) full-targ-runname run-id) (tree:add-node tb "Runs" (string-split full-targ-runname "/")) )) data) numruns)) ;;====================================================================== ;; The "new" runs browser, this one sets up the view and registers the ;; updater ;; (define (dashboard:runs-browse commondat tabdat #!key (tab-num 5)) (let* ((rdat (make-dboard:rdat)) (runsmtx (dboard:runs-new-matrix commondat rdat)) (itemsmtx (dboard:runs-new-matrix commondat rdat))) (dboard:rdat-runs-mtx-set! rdat runsmtx) (dboard:rdat-items-mtx-set! rdat itemsmtx) (dboard:commondat-add-updater commondat (lambda () (dashboard:new-runs-updater commondat tabdat rdat)) tab-num: tab-num) (iup:split #:orientation "VERTICAL" #:value 100 #:shrink "YES" (iup:vbox (dboard:runs-tree-new-view-browser commondat rdat)) (iup:split #:orientation "VERTICAL" #:value 100 (iup:vbox runsmtx) (iup:vbox (iup:split #:orientation "VERTICAL" #:value 500 itemsmtx (dboard:test-info-matrix commondat rdat) )))))) (define (dashboard:new-runs-updater commondat tabdat rdat) (let* ((runnum (dboard:rdat-runnum rdat)) (start-time (current-milliseconds)) (tot-runs #f)) (if (eq? runnum 0)(dashboard:update-runs-data rdat)) (set! tot-runs (vector-length (dboard:rdat-runsbynum rdat))) (let loop ((rn runnum)) (if (and (< (- (current-milliseconds) start-time) 250) (< rn tot-runs)) (let* ((newrn (if (>= runnum (vector-length (dboard:rdat-runsbynum rdat))) 0 ;; start over (+ rn 1)))) ;; (+ runnum 1))) (dashboard:update-run-data rn rdat) (dboard:rdat-runnum-set! rdat newrn) (if (> newrn 0) (loop newrn))))) (if (>= (dboard:rdat-runnum rdat) tot-runs) (dboard:rdat-runnum-set! rdat 0)) ;; (dboard:rdat-runnum-set! rdat rn))) ;; not needed as it is set above ;; (dboard:rdat-last-update-set! rdat (- (current-seconds) 10)) (dashboard:update-new-runs-view-runs-matrix commondat rdat) '())) ;; NOTE: runnum is NOT the run-id, it is a pointer into the runsbynum vector ;; (define (dashboard:update-run-data runnum rdat) (let* ((curr-time (current-seconds)) (runrec (vector-ref (dboard:rdat-runsbynum rdat) runnum)) (run-id (simple-run-id runrec)) (last-update (sparse-vector-ref (dboard:rdat-last-updates rdat) run-id)) ;; filters (testname-sql-filt (dboard:rdat-testname-sql-filt rdat)) ;; (itempath-sql-filt (dboard:rdat-itempath-sql-filt rdat)) (test-state-sql-filt (dboard:rdat-test-state-sql-filt rdat)) ;; not used yet (test-status-sql-filt (dboard:rdat-test-status-sql-filt rdat)) ;; not used yet (tests (rmt:get-tests-for-run-state-status run-id testname-sql-filt last-update ;; last-update ))) ;; (debug:print 0 *default-log-port* "tests: " tests) (sparse-vector-set! (dboard:rdat-last-updates rdat) run-id (- curr-time 1)) (sparse-vector-set! (dboard:rdat-run-tests rdat) run-id (delete-duplicates (append tests (sparse-vector-ref (dboard:rdat-run-tests rdat) run-id)) (lambda (a b) (eq? (vector-ref a 0)(vector-ref b 0))))) ;; de-duplicate based on test id #;(debug:print 0 *default-log-port* "Got " (length tests) " tests for run-id " run-id " testname-sql-filt " testname-sql-filt " and last-update " last-update " first test info: " tests) ;; (if (not (null? tests))(car tests) '())) (length tests))) ;; NB// start at 1. ;; (define (dashboard:get-row-num mtrx rownames tname) (or (hash-table-ref/default rownames tname #f) (let* ((numentries (hash-table-size rownames)) (nextnum (+ numentries 1))) (hash-table-set! rownames tname nextnum) (iup:attribute-set! mtrx (conc nextnum ":0") tname) nextnum))) (define (dashboard:update-new-runs-view-runs-matrix commondat rdat) (let* ((run-tests-data (dboard:rdat-run-tests rdat)) ;; from dbmod.scm (define-record simple-run target id runname state status owner event_time) (run-tests-mtx (dboard:rdat-runs-mtx rdat)) (runs-by-num (dboard:rdat-runsbynum rdat)) ;; this is the sequence num (num-runs (vector-length runs-by-num)) ) (debug:print 0 *default-log-port* "num-runs: " num-runs) (let loop ((col-num 1)) (print "col-num: "col-num) (let* ((runrec (vector-ref runs-by-num (- col-num 1))) (run-id (simple-run-id runrec)) (target (simple-run-target runrec)) (runname (simple-run-runname runrec)) (vert-targ (string-translate (conc target "/" runname) "/" "\n")) (run-tests (sparse-vector-ref run-tests-data run-id)) (changed #f)) ;; manage redraws on a column by column basis (debug:print 0 *default-log-port* "num-runs: "num-runs" run-tests: "run-tests) (if (null? run-tests) ;; empty run (if (< col-num num-runs) ;; NOT CORRECT (begin (print "Empty run, num-runs: "num-runs" col-num: "col-num) (loop (+ col-num 1)))) (begin (set! changed (dcommon:modifiy-if-different ;; set the col header run-tests-mtx (conc "0:" col-num) vert-targ changed)) (let testloop ((inum 0) (tail run-tests)) (let* ((test-dat (car tail)) (tname (db:test-get-testname test-dat)) (state (db:test-get-state test-dat)) (status (db:test-get-status test-dat)) (item-path (db:test-get-item-path test-dat)) (color (gutils:get-color-for-state-status state status)) (is-deleted (equal? state "DELETED")) (row-num (if is-deleted #f (dashboard:get-row-num run-tests-mtx (dboard:rdat-rownames rdat) tname))) (cell-name (conc row-num ":" col-num))) (if (or (not is-deleted) (equal? item-path "")) (begin (set! changed (dcommon:modifiy-if-different run-tests-mtx (conc "BGCOLOR" row-num ":" col-num) (car color) changed)) (set! changed (dcommon:modifiy-if-different run-tests-mtx cell-name (cadr color) changed)))) (if (not (null? (cdr tail))) (testloop (+ inum 1)(cdr tail)) (begin (iup:attribute-set! run-tests-mtx (conc "C" col-num) "REDRAW") (if (< col-num num-runs) (loop (+ col-num 1))))))))))))) (define (dboard:runs-new-matrix commondat rdat) (iup:matrix #:alignment1 "ALEFT" #:expand "YES" ;; "HORIZONTAL" #:scrollbar "YES" #:numcol 100 #:numlin 200 #:numcol-visible 3 ;; (min 8) #:numlin-visible 10 #:widthdef 20 #:click-cb (lambda (obj row col status) (let* ((cell (conc row ":" col))) #f)) )) ;; run info, test info (define (dboard:test-info-matrix commondat rdat) (let* ((run-fields '(("Run Info" . 1) ("Fields" . 2) ("Target" . 3) ("Runname" . 4) ("Run-id" . 5) ("Run-date" . 6))) (test-fields '(("Test Info" . 1) ("Testname" . 2) ("Item path" . 3) ("State" . 4) ("Status" . 5) ("Comment" . 6) ("Test-id" . 7) ("Test-date" . 8))) (test-meta-fields '(("Test Meta Data" . 1) ("Author" . 2) ("Owner" . 3) ("Reviewed" . 4) ("Tags" . 5) ("Description" . 6))) (remhost-run-info-fields '(("Host/run info" . 1) ("Hostname" . 2) ("Disk free" . 3) ("CPU Load" . 4) ("Run duration" . 5) ("Logfile" . 6) ("Process ID" . 7) ("Machine info" . 8))) (mk-matrix (lambda (cfgdat) (let ((mtx (iup:matrix #:alignment1 "ALEFT" ;; #:expand "YES" ;; "HORIZONTAL" #:scrollbar "YES" #:numcol 1 #:numlin (length cfgdat) #:numcol-visible 1 ;; (min 8) #:numlin-visible (length cfgdat) #:widthdef 50 #:width0 50 #:click-cb (lambda (obj row col status) (let* ((cell (conc row ":" col))) #f))))) (for-each (lambda (finfo) (match finfo ((fieldname . rownum) (iup:attribute-set! mtx (conc rownum":0") fieldname)) (else (debug:print 0 *default-log-port* "ERROR: bad finfo "finfo)))) cfgdat) mtx))) (runmtx (mk-matrix run-fields)) (testmtx (mk-matrix test-fields)) (metamtx (mk-matrix test-meta-fields)) (remhostmtx (mk-matrix remhost-run-info-fields))) ;; (dboard:rdat-runs-mtx-set! rdat runmtx) ;; (dboard:rdat-items-mtx-set! rdat testmtx) ;; ( (iup:vbox #:expandchildren #t #:expand #f runmtx testmtx metamtx remhostmtx ))) ;; browse runs as a tree. Used in both "Runs" tab and ;; in the runs control panel. ;; ;; THIS IS THE NEW ONE ;; (define (dboard:runs-tree-new-view-browser commondat rdat) (let* ((txtbox (iup:textbox #:action (lambda (val a b) (debug:catch-and-dump (lambda () ;; for the Runs view we put the list ;; of keyvals into tabdat target for ;; the Run Controls we put then update ;; the run-command (if b (dboard:rdat-targ-sql-filt-set! rdat (string-split b "/"))) #;(dashboard:update-run-command tabdat)) "command-testname-selector tb action")) ;; #:value (dboard:test-patt->lines ;; This seems like it was wrong, BUG in code where it was copied from? ;; (dboard:tabdat-test-patts-use tabdat)) #:expand "HORIZONTAL" ;; #:size "10x" )) (tb (iup:treebox #:value 0 #:title "Runs" ;; was #:name -- iup 3.19 changed ;; this... "Changed: [DEPRECATED ;; REMOVED] removed the old attribute ;; NAMEid from IupTree to avoid ;; conflict with the common attribute ;; NAME. Use the TITLEid attribute." #:expand "YES" #:addexpanded "YES" #:size "120x" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (new-tree-path->run-id rdat (cdr run-path)))) ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? ;; done below when run-id is a number (dboard:rdat-targ-sql-filt-set! rdat (cdr run-path)) ;; (print ;; "run-path: ;; " ;; run-path) (iup:attribute-set! txtbox "VALUE" (string-intersperse (cdr run-path) "/")) #;(dashboard:update-run-command tabdat) #;(dboard:tabdat-layout-update-ok-set! tabdat #f) (if (number? run-id) (begin ;; capture last two in tabdat. (dboard:rdat-push-run-id rdat run-id) (dboard:rdat-view-changed-set! rdat #t)) (debug:print-error 5 *default-log-port* "tree-path->run-id returned non-number " run-id)))) "treebox")) ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (dboard:rdat-runs-tree-set! rdat tb) (iup:detachbox (iup:vbox txtbox tb )))) |
Modified dashboard.scm from [935bf4d2df] to [54d0d0890b].
︙ | ︙ | |||
22 23 24 25 26 27 28 | (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (import canvas-draw-iup) (use ducttape-lib) | | | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | (require-library iup) (import (prefix iup iup:)) (use canvas-draw) (import canvas-draw-iup) (use ducttape-lib) (use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors matchable) ;; defstruct (import (prefix sqlite3 sqlite3:)) (declare (uses common)) (declare (uses margs)) (declare (uses keys)) (declare (uses items)) (declare (uses db)) |
︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") (include "megatest-version.scm") (include "megatest-fossil-hash.scm") (include "vg_records.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " license GPL, Copyright (C) Matt Welland 2012-2017 Usage: dashboard [options] | > > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") (include "megatest-version.scm") (include "megatest-fossil-hash.scm") (include "vg_records.scm") ;; This is the new runs view (include "dashboard-new-runs-view.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " license GPL, Copyright (C) Matt Welland 2012-2017 Usage: dashboard [options] |
︙ | ︙ | |||
447 448 449 450 451 452 453 454 455 456 457 458 459 460 | (toprow 0) ;; topmost visible row (numcols 24) ;; number of columns visible (numrows 20) ;; number of rows visible ;; data from sql db (keys (rmt:get-keys)) ;; to be removed when targets handling is refactored (runs (make-sparse-vector)) ;; id => runrec (runsbynum (make-vector 100 #f)) ;; vector num => runrec (targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed (tests (make-hash-table)) ;; test[/itempath] => list of test rec ;; run sql filters (targ-sql-filt "%") (runname-sql-filt "%") | > > > | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 | (toprow 0) ;; topmost visible row (numcols 24) ;; number of columns visible (numrows 20) ;; number of rows visible ;; data from sql db (keys (rmt:get-keys)) ;; to be removed when targets handling is refactored (runs (make-sparse-vector)) ;; id => runrec (runs-offset 0) ;; paginator pointer (used for offset) (runs-count 5) ;; how many runs to get on each call (run-tests (make-sparse-vector '())) ;; id => list of tests (runsbynum (make-vector 100 #f)) ;; vector num => runrec (targ-runid (make-hash-table)) ;; area/target/runname => run-id ;; not sure this will be needed (tests (make-hash-table)) ;; test[/itempath] => list of test rec ;; run sql filters (targ-sql-filt "%") (runname-sql-filt "%") |
︙ | ︙ | |||
476 477 478 479 480 481 482 483 484 485 486 487 488 489 | ;; various (prev-run-ids '()) ;; push previously looked at runs on this (view-changed #f) ;; widgets (runs-tree #f) ;; ) (define (dboard:rdat-push-run-id rdat run-id) (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat)))) (defstruct dboard:runrec id | > > > | 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 | ;; various (prev-run-ids '()) ;; push previously looked at runs on this (view-changed #f) ;; widgets (runs-tree #f) ;; (runs-mtx #f) ;; runs displayed here (items-mtx #f) ;; items displayed here ) (define (dboard:rdat-push-run-id rdat run-id) (dboard:rdat-prev-run-ids-set! rdat (cons run-id (dboard:rdat-prev-run-ids rdat)))) (defstruct dboard:runrec id |
︙ | ︙ | |||
589 590 591 592 593 594 595 596 597 598 599 600 601 602 | (define-inline (dboard:uidat-get-header vec)(vector-ref vec 2)) (define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3)) (if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME"))) (define (message-window msg) (iup:show (iup:dialog (iup:vbox (iup:label msg #:margin "40x40"))))) (define (iuplistbox-fill-list lb items #!key (selected-item #f)) (let ((i 1)) (for-each (lambda (item) | > | 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 | (define-inline (dboard:uidat-get-header vec)(vector-ref vec 2)) (define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3)) (if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME"))) (define (message-window msg) (iup:show #:shrink "YES" (iup:dialog (iup:vbox (iup:label msg #:margin "40x40"))))) (define (iuplistbox-fill-list lb items #!key (selected-item #f)) (let ((i 1)) (for-each (lambda (item) |
︙ | ︙ | |||
2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 | (define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat) (let* ((stats-dat (dboard:tabdat-make-data)) (runs-dat (dboard:tabdat-make-data)) (runs2-dat (make-dboard:rdat)) ;; (dboard:tabdat-make-data)) (onerun-dat (dboard:tabdat-make-data)) ;; name for run-summary structure (runcontrols-dat (dboard:tabdat-make-data)) (runtimes-dat (dboard:tabdat-make-data)) (nruns (dboard:tabdat-numruns runs-dat)) (ntests (dboard:tabdat-num-tests runs-dat)) (keynames (dboard:tabdat-dbkeys runs-dat)) (nkeys (length keynames)) (runsvec (make-vector nruns)) (header (make-vector nruns)) (lftcol (make-vector ntests)) | > | 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 | (define (make-dashboard-buttons commondat) ;; runs-sum-dat new-view-dat) (let* ((stats-dat (dboard:tabdat-make-data)) (runs-dat (dboard:tabdat-make-data)) (runs2-dat (make-dboard:rdat)) ;; (dboard:tabdat-make-data)) (onerun-dat (dboard:tabdat-make-data)) ;; name for run-summary structure (runcontrols-dat (dboard:tabdat-make-data)) (runtimes-dat (dboard:tabdat-make-data)) (runs-browse-dat (dboard:tabdat-make-data)) (nruns (dboard:tabdat-numruns runs-dat)) (ntests (dboard:tabdat-num-tests runs-dat)) (keynames (dboard:tabdat-dbkeys runs-dat)) (nkeys (length keynames)) (runsvec (make-vector nruns)) (header (make-vector nruns)) (lftcol (make-vector ntests)) |
︙ | ︙ | |||
2932 2933 2934 2935 2936 2937 2938 | (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) | | | 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 | (apply iup:hbox (reverse hdrlst)) (apply iup:hbox (reverse bdylst)) (dashboard:runs-horizontal-slider runs-dat)))) controls )) (views-cfgdat (common:load-views-config)) (additional-tabnames '()) (tab-start-num 6) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW ;; (data (dboard:tabdat-init (make-d:data))) (additional-views ;; process views-dat (let ((tab-num tab-start-num) (result '())) (for-each (lambda (view-name) (debug:print 0 *default-log-port* "Adding view " view-name) |
︙ | ︙ | |||
2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 | (sort (hash-table-keys views-cfgdat) (lambda (a b) (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999)) (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999))) (> order-a order-b))))) result)) (tabs (apply iup:tabs #:tabchangepos-cb (lambda (obj curr prev) (debug:catch-and-dump (lambda () (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:tabdat-layout-update-ok-set! tabdat #f)) (dboard:commondat-curr-tab-num-set! commondat curr) (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:commondat-please-update-set! commondat #t) (dboard:tabdat-layout-update-ok-set! tabdat #t))) "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view ;; (make-runs-view commondat runs2-dat 2) (dashboard:runs-summary commondat onerun-dat tab-num: 2) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) additional-views))) ;; (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" "Runs2") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") ;; (iup:attribute-set! tabs "TABTITLE3" "New View") ;; (iup:attribute-set! tabs "TABTITLE4" "Run Control") ;; set the tab names for user added tabs (for-each (lambda (tab-info) (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info))) additional-tabnames) (iup:attribute-set! tabs "BGCOLOR" "190 190 190") ;; make the iup tabs object available (for changing color for example) (dboard:commondat-hide-not-hide-tabs-set! commondat tabs) ;; now set up the tabdat lookup (dboard:common-set-tabdat! commondat 0 stats-dat) (dboard:common-set-tabdat! commondat 1 runs-dat) ;;(dboard:common-set-tabdat! commondat 2 runs2-dat) (dboard:common-set-tabdat! commondat 2 onerun-dat) (dboard:common-set-tabdat! commondat 3 runcontrols-dat) (dboard:common-set-tabdat! commondat 4 runtimes-dat) (iup:vbox tabs ;; controls )))) (vector keycol lftcol header runsvec))) | > > > > | 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 | (sort (hash-table-keys views-cfgdat) (lambda (a b) (let ((order-a (or (any->number (configf:lookup views-cfgdat a "order")) 999)) (order-b (or (any->number (configf:lookup views-cfgdat b "order")) 999))) (> order-a order-b))))) result)) (tabs (apply iup:tabs #:shrink "YES" #:tabchangepos-cb (lambda (obj curr prev) (debug:catch-and-dump (lambda () (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:tabdat-layout-update-ok-set! tabdat #f)) (dboard:commondat-curr-tab-num-set! commondat curr) (let* ((tab-num (dboard:commondat-curr-tab-num commondat)) (tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))) (dboard:commondat-please-update-set! commondat #t) (dboard:tabdat-layout-update-ok-set! tabdat #t))) "tabchangepos")) (dashboard:summary commondat stats-dat tab-num: 0) runs-view ;; (make-runs-view commondat runs2-dat 2) (dashboard:runs-summary commondat onerun-dat tab-num: 2) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) (dashboard:run-times commondat runtimes-dat tab-num: 4) (dashboard:runs-browse commondat runs-browse-dat tab-num: 5) additional-views))) ;; (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" "Runs2") (iup:attribute-set! tabs "TABTITLE2" "Run Summary") (iup:attribute-set! tabs "TABTITLE3" "Run Control") (iup:attribute-set! tabs "TABTITLE4" "Run Times") ;; (iup:attribute-set! tabs "TABTITLE3" "New View") ;; (iup:attribute-set! tabs "TABTITLE4" "Run Control") (iup:attribute-set! tabs "TABTITLE5" "Runs Browse") ;; set the tab names for user added tabs (for-each (lambda (tab-info) (iup:attribute-set! tabs (conc "TABTITLE" (car tab-info)) (cdr tab-info))) additional-tabnames) (iup:attribute-set! tabs "BGCOLOR" "190 190 190") ;; make the iup tabs object available (for changing color for example) (dboard:commondat-hide-not-hide-tabs-set! commondat tabs) ;; now set up the tabdat lookup (dboard:common-set-tabdat! commondat 0 stats-dat) (dboard:common-set-tabdat! commondat 1 runs-dat) ;;(dboard:common-set-tabdat! commondat 2 runs2-dat) (dboard:common-set-tabdat! commondat 2 onerun-dat) (dboard:common-set-tabdat! commondat 3 runcontrols-dat) (dboard:common-set-tabdat! commondat 4 runtimes-dat) (dboard:common-set-tabdat! commondat 5 runs-browse-dat) (iup:vbox tabs ;; controls )))) (vector keycol lftcol header runsvec))) |
︙ | ︙ |