Overview
Comment: | Merged onerun fix and added mutex to prevent segfaults |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.61 |
Files: | files | file ages | folders |
SHA1: |
89eaa12a3e9665f794e2d71e68aca564 |
User & Date: | mrwellan on 2016-09-08 09:42:59 |
Other Links: | branch diff | manifest | tags |
Context
2016-09-08
| ||
10:30 | Re-applied DISPLAY check change check-in: f75cadf6c3 user: mrwellan tags: v1.61 | |
09:42 | Merged onerun fix and added mutex to prevent segfaults check-in: 89eaa12a3e user: mrwellan tags: v1.61 | |
09:34 | Merged v1.61 into one-run fix Closed-Leaf check-in: 3aa6a5cfef user: mrwellan tags: v1.61_onerun | |
09:19 | Merged fork check-in: 96ced4478b user: mrwellan tags: v1.61 | |
Changes
Modified Makefile from [de0e63d091] to [b470f5a249].
︙ | ︙ | |||
74 75 76 77 78 79 80 | if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi $(OFILES) $(GOFILES) : common_records.scm %.o : %.scm csc $(CSCOPTS) -c $< | | | | | 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 | if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi $(OFILES) $(GOFILES) : common_records.scm %.o : %.scm csc $(CSCOPTS) -c $< $(PREFIX)/bin/.$(ARCHSTR)/mtest : mtest @echo Installing to PREFIX=$(PREFIX) $(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/mtest utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest chmod a+x $(PREFIX)/bin/megatest $(PREFIX)/bin/.$(ARCHSTR)/ndboard : ndboard $(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/ndboard $(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard chmod a+x $(PREFIX)/bin/newdashboard $(PREFIX)/bin/.$(ARCHSTR)/mdboard : multi-dboard $(INSTALL) multi-dboard $(PREFIX)/bin/.$(ARCHSTR)/mdboard $(PREFIX)/bin/mdboard : $(PREFIX)/bin/.$(ARCHSTR)/mdboard utils/mk_wrapper $(PREFIX) mdboard $(PREFIX)/bin/mdboard chmod a+x $(PREFIX)/bin/mdboard # $(HELPERS) : utils/% # $(INSTALL) $< $@ # chmod a+x $@ |
︙ | ︙ | |||
140 141 142 143 144 145 146 | deploytarg/nbfind : utils/nbfind $(INSTALL) $< $@ chmod a+x $@ # install dashboard as dboard so wrapper script can be called dashboard | | | 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | deploytarg/nbfind : utils/nbfind $(INSTALL) $< $@ chmod a+x $@ # install dashboard as dboard so wrapper script can be called dashboard $(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard chmod a+x $(PREFIX)/bin/dashboard $(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \ $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \ $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/mt_xterm \ |
︙ | ︙ | |||
248 249 250 251 252 253 254 | else \ echo "(define *use-new-readline* #t)" > readline-fix.scm;\ fi altdb.scm : echo ";; optional alternate db setup" > altdb.scm echo "(define *available-db* (make-hash-table))" >> altdb.scm | | | | 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 | else \ echo "(define *use-new-readline* #t)" > readline-fix.scm;\ fi altdb.scm : echo ";; optional alternate db setup" > altdb.scm echo "(define *available-db* (make-hash-table))" >> altdb.scm if csi -ne '(use mysql-client)';then \ echo "(use mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \ fi if csi -ne '(use postgresql)';then \ echo "(use postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\ fi portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o daemon.o dashboard-tests.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o nmsg-transport.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o daemon.o dashboard-tests.o db.o dcommon.o ezsteps.o filedb.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o megatest-version.o mt.o nmsg-transport.o ods.o portlogger.o process.o rmt.o rpc-transport.o runconfig.o runs.o sdb.o server.o synchash.o tasks.o tdb.o tests.o tree.o |
Modified dashboard.scm from [ec1185cec5] to [b9a9bc3aa7].
︙ | ︙ | |||
97 98 99 100 101 102 103 | (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; data common to all tabs goes here ;; (defstruct dboard:commondat | | > | < | | | | > > > > > > > > > > > | 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 | (begin (print "Failed to find megatest.config, exiting") (exit 1))) ;; data common to all tabs goes here ;; (defstruct dboard:commondat curr-tab-num please-update tabdats update-mutex updaters updating uidat ;; needs to move to tabdat at some time hide-not-hide-tabs ) (define (dboard:commondat-make) (make-dboard:commondat curr-tab-num: 0 tabdats: (make-hash-table) please-update: #t update-mutex: (make-mutex) updaters: (make-hash-table) updating: #f hide-not-hide-tabs: #f )) (define (dboard:common-get-tabdat commondat #!key (tab-num #f)) (hash-table-ref/default (dboard:commondat-tabdats commondat) (or tab-num (dboard:commondat-curr-tab-num commondat)) #f)) |
︙ | ︙ | |||
158 159 160 161 162 163 164 | (header #f) ;; header for decoding the run records (keys #f) ;; keys for this run (i.e. target components) ((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;; ((tot-runs 0) : number) ((last-data-update 0) : number) ;; last time the data in allruns was updated (runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects ((run-update-times (make-hash-table)) : hash-table) ;; update times indexed by run-id | < | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | (header #f) ;; header for decoding the run records (keys #f) ;; keys for this run (i.e. target components) ((numruns (string->number (or (args:get-arg "-cols") "8"))) : number) ;; ((tot-runs 0) : number) ((last-data-update 0) : number) ;; last time the data in allruns was updated (runs-mutex (make-mutex)) ;; use to prevent parallel access to draw objects ((run-update-times (make-hash-table)) : hash-table) ;; update times indexed by run-id ((last-test-dat (make-hash-table)) : hash-table) ;; cache last tests dat by run-id ((run-db-paths (make-hash-table)) : hash-table) ;; cache the paths to the run db files ;; Runs view ((buttondat (make-hash-table)) : hash-table) ;; ((item-test-names '()) : list) ;; list of itemized tests ((run-keys (make-hash-table)) : hash-table) (runs-matrix #f) ;; used in newdashboard |
︙ | ︙ | |||
458 459 460 461 462 463 464 | ;; This is roughly the same as dboard:get-tests-dat, should merge them if possible ;; ;; gets all the tests for run-id that match testnamepatt and key-vals, merges them ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) | | | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 | ;; This is roughly the same as dboard:get-tests-dat, should merge them if possible ;; ;; gets all the tests for run-id that match testnamepatt and key-vals, merges them ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) (let* ((num-to-get 20) (states (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat))) (statuses (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat))) (sort-info (get-curr-sort)) (sort-by (vector-ref sort-info 1)) (sort-order (vector-ref sort-info 2)) (bubble-type (if (member sort-order '(testname)) 'testname |
︙ | ︙ | |||
905 906 907 908 909 910 911 | (dboard:tabdat-filters-changed-set! tabdat #t))) (define (update-search commondat tabdat x val) (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val) (dboard:tabdat-filters-changed-set! tabdat #t) (set-bg-on-filter commondat tabdat)) | | < | < < | 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 | (dboard:tabdat-filters-changed-set! tabdat #t))) (define (update-search commondat tabdat x val) (hash-table-set! (dboard:tabdat-searchpatts tabdat) x val) (dboard:tabdat-filters-changed-set! tabdat #t) (set-bg-on-filter commondat tabdat)) (define (mark-for-update tabdat) (dboard:tabdat-filters-changed-set! tabdat #t) (dboard:tabdat-last-db-update-set! tabdat 0)) ;;====================================================================== ;; R U N C O N T R O L ;;====================================================================== ;; target populating logic ;; |
︙ | ︙ | |||
1206 1207 1208 1209 1210 1211 1212 | ;; #:title "Logs" ;; To be replaced with tabs ;; (let ((logs-tb (iup:textbox #:expand "YES" ;; #:multiline "YES"))) ;; (dboard:tabdat-logs-textbox-set! tabdat logs-tb) ;; logs-tb)) (define (dboard:runs-tree-browser commondat tabdat) | < | > | < | 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 | ;; #:title "Logs" ;; To be replaced with tabs ;; (let ((logs-tb (iup:textbox #:expand "YES" ;; #:multiline "YES"))) ;; (dboard:tabdat-logs-textbox-set! tabdat logs-tb) ;; logs-tb)) (define (dboard:runs-tree-browser commondat tabdat) (let* ((tb (iup:treebox #:value 0 #:name "Runs" #:expand "YES" #:addexpanded "NO" #:selection-cb (lambda (obj id state) (debug:catch-and-dump (lambda () (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) ;; (dboard:tabdat-view-changed-set! tabdat #t) ;; ?? done below when run-id is a number (dboard:tabdat-target-set! tabdat (cdr run-path)) ;; (print "run-path: " run-path) (dboard:tabdat-layout-update-ok-set! tabdat #f) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) (dboard:tabdat-view-changed-set! tabdat #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:tabdat-runs-tree-set! tabdat tb) |
︙ | ︙ | |||
1376 1377 1378 1379 1380 1381 1382 | (define (dashboard:safe-cadr-assoc name lst) (let ((res (assoc name lst))) (if (and res (> (length res) 1)) (cadr res) #f))) | < < | 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 | (define (dashboard:safe-cadr-assoc name lst) (let ((res (assoc name lst))) (if (and res (> (length res) 1)) (cadr res) #f))) (define (dboard:update-tree tabdat runs-hash runs-header tb) (let* ((run-ids (sort (filter number? (hash-table-keys runs-hash)) (lambda (a b) (let* ((record-a (hash-table-ref runs-hash a)) (record-b (hash-table-ref runs-hash b)) (time-a (db:get-value-by-header record-a runs-header "event_time")) (time-b (db:get-value-by-header record-b runs-header "event_time"))) |
︙ | ︙ | |||
1409 1410 1411 1412 1413 1414 1415 | ;; Here we update the tests treebox and tree keys (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name)) userdata: (conc "run-id: " run-id)) (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id) ;; (set! colnum (+ colnum 1)) )))) run-ids))) | | < < | | | | 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 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 | ;; Here we update the tests treebox and tree keys (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name)) userdata: (conc "run-id: " run-id)) (hash-table-set! (dboard:tabdat-path-run-ids tabdat) run-path run-id) ;; (set! colnum (+ colnum 1)) )))) run-ids))) (define (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix) (let* ((runs-dat (rmt:get-runs-by-patt (dboard:tabdat-keys tabdat) "%" #f #f #f #f)) (runs-header (vector-ref runs-dat 0)) ;; 0 is header, 1 is list of records (run-id (dboard:tabdat-curr-run-id tabdat)) (last-update (hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0)) (db-path (or (hash-table-ref/default (dboard:tabdat-run-db-paths tabdat) run-id #f) (let* ((db-dir (tasks:get-task-db-path)) (db-pth (conc db-dir "/" run-id ".db"))) (hash-table-set! (dboard:tabdat-run-db-paths tabdat) run-id db-pth) db-pth))) (tests-dat (if (or (not run-id) (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps") (not (hash-table-exists? (dboard:tabdat-last-test-dat tabdat) run-id)) (>= (file-modification-time db-path) last-update)) (dboard:get-tests-dat tabdat run-id last-update) (hash-table-ref (dboard:tabdat-last-test-dat tabdat) run-id))) (tests-mindat (dcommon:minimize-test-data tests-dat)) (indices (common:sparse-list-generate-index tests-mindat)) ;; proc: set-cell)) (row-indices (cadr indices)) (col-indices (car indices)) (max-row (if (null? row-indices) 1 (common:max (map cadr row-indices)))) (max-col (if (null? col-indices) 1 (common:max (map cadr col-indices)))) (max-visible (max (- (dboard:tabdat-num-tests tabdat) 15) 3)) ;; (dboard:tabdat-num-tests tabdat) is proportional to the size of the window (numrows 1) (numcols 1) (changed #f) (runs-hash (let ((ht (make-hash-table))) (for-each (lambda (run) (hash-table-set! ht (db:get-value-by-header run runs-header "id") run)) (vector-ref runs-dat 1)) ht))) (hash-table-set! (dboard:tabdat-last-test-dat tabdat) run-id tests-dat) (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- (current-seconds) 10)) (dboard:tabdat-filters-changed-set! tabdat #f) (let loop ((pass-num 0) (changed #f)) ;; Update the runs tree (dboard:update-tree tabdat runs-hash runs-header tb) |
︙ | ︙ | |||
1578 1579 1580 1581 1582 1583 1584 | (debug:catch-and-dump (lambda () ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin | < | > > > > | > > > > | > > > | < | | | | | | | | | | | 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 | (debug:catch-and-dump (lambda () ;; (print "obj: " obj ", id: " id ", state: " state) (let* ((run-path (tree:node->path obj id)) (run-id (tree-path->run-id tabdat (cdr run-path)))) (if (number? run-id) (begin (dboard:tabdat-curr-run-id-set! tabdat run-id) (dboard:tabdat-layout-update-ok-set! tabdat #f) ;; (dashboard:update-run-summary-tab) ) ;; (debug:print-error 0 *default-log-port* "tree-path->run-id returned non-number " run-id) ))) "selection-cb in one-run") ;; (print "path: " (tree:node->path obj id) " run-id: " run-id) ))) (cell-lookup (make-hash-table)) (run-matrix (iup:matrix #:expand "YES" #:click-cb (lambda (obj lin col status) (let* ((toolpath (car (argv))) (key (conc lin ":" col)) (test-id (hash-table-ref/default cell-lookup key -1)) (cmd (conc toolpath " -test " (dboard:tabdat-curr-run-id tabdat) "," test-id "&"))) (system cmd))))) (one-run-updater (lambda () (mutex-lock! update-mutex) (when (not run-matrix) (print "BB> What?? run-matrix is #f")) (if (or (dashboard:database-changed? commondat tabdat) (dboard:tabdat-view-changed tabdat)) (debug:catch-and-dump (lambda () ;; check that run-matrix is initialized before calling the updater (if run-matrix (dashboard:one-run-updater commondat tabdat tb cell-lookup run-matrix))) "dashboard:one-run-updater") ) (mutex-unlock! update-mutex)))) (dboard:commondat-add-updater commondat one-run-updater tab-num: tab-num) (dboard:tabdat-runs-tree-set! tabdat tb) (iup:vbox (iup:split tb run-matrix) (dboard:make-controls commondat tabdat)))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (dboard:make-controls commondat tabdat) (let ((btn-fontsz (dboard:tabdat-runs-btn-fontsz tabdat))) (iup:hbox (iup:vbox (iup:frame #:title "filter test and items" (iup:hbox (iup:vbox (iup:textbox #:size "120x15" #:fontsize "10" #:value "%" #:expand "NO" #:action (lambda (obj unk val) (debug:catch-and-dump (lambda () (mark-for-update tabdat) (update-search commondat tabdat "test-name" val)) "make-controls"))) (iup:hbox (iup:button "Quit" #:action (lambda (obj) ;; (if (dboard:tabdat-dblocal tabdat) (db:close-all (dboard:tabdat-dblocal tabdat))) (exit)) #:expand "NO" #:size "40x15") (iup:button "Refresh" #:action (lambda (obj) (mark-for-update tabdat)) #:expand "NO" #:size "40x15") (iup:button "Collapse" #:action (lambda (obj) (debug:catch-and-dump (lambda () (let ((myname (iup:attribute obj "TITLE"))) (if (equal? myname "Collapse") (begin (for-each (lambda (tname) (hash-table-set! *collapsed* tname #t)) (dboard:tabdat-item-test-names tabdat)) (iup:attribute-set! obj "TITLE" "Expand")) (begin (for-each (lambda (tname) (hash-table-delete! *collapsed* tname)) (hash-table-keys *collapsed*)) (iup:attribute-set! obj "TITLE" "Collapse")))) (mark-for-update tabdat)) "make-controls collapse button")) #:expand "NO" #:size "40x15"))) (iup:vbox ;; (iup:button "Sort -t" #:action (lambda (obj) ;; (next-sort-option) ;; (iup:attribute-set! obj "TITLE" (vector-ref (vector-ref *tests-sort-options* *tests-sort-reverse*) 0)) ;; (mark-for-update tabdat))) (let* ((hide #f) (show #f) (hide-empty #f) (sel-color "180 100 100") (nonsel-color "170 170 170") (cmds-list '("+testname" "-testname" "+event_time" "-event_time" "+statestatus" "-statestatus")) (sort-lb (iup:listbox #:expand "NO" ;; "HORIZONTAL" #:size "80x15" #:dropdown "YES" #:action (lambda (obj val index lbstate) (set! *tests-sort-reverse* index) (mark-for-update tabdat)))) (default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*)))) (iuplistbox-fill-list sort-lb cmds-list selected-item: default-cmd) (set! hide-empty (iup:button "HideEmpty" ;; #:expand HORIZONTAL" #:expand "NO" #:size "80x15" #:action (lambda (obj) (dboard:tabdat-hide-empty-runs-set! tabdat (not (dboard:tabdat-hide-empty-runs tabdat))) (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-empty-runs tabdat) "+HideE" "-HideE")) (mark-for-update tabdat)))) (set! hide (iup:button "Hide" #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL" #:action (lambda (obj) (dboard:tabdat-hide-not-hide-set! tabdat #t) ;; (not (dboard:tabdat-hide-not-hide tabdat))) ;; (iup:attribute-set! obj "TITLE" (if (dboard:tabdat-hide-not-hide tabdat) "HideTests" "NotHide")) (iup:attribute-set! hide "BGCOLOR" sel-color) (iup:attribute-set! show "BGCOLOR" nonsel-color) (mark-for-update tabdat)))) (set! show (iup:button "Show" #:expand "NO" #:size "40x15" ;; #:expand "HORIZONTAL" #:action (lambda (obj) (dboard:tabdat-hide-not-hide-set! tabdat #f) ;; (not (dboard:tabdat-hide-not-hide tabdat))) (iup:attribute-set! show "BGCOLOR" sel-color) (iup:attribute-set! hide "BGCOLOR" nonsel-color) (mark-for-update tabdat)))) (iup:attribute-set! hide "BGCOLOR" sel-color) (iup:attribute-set! show "BGCOLOR" nonsel-color) ;; (dboard:tabdat-hide-not-hide-button-set! tabdat hideit) ;; never used, can eliminate ... (iup:vbox (iup:hbox hide show) hide-empty sort-lb))) ))) (iup:frame #:title "state/status filter" (iup:vbox (apply iup:hbox (map (lambda (status) (iup:toggle (conc status " ") #:fontsize btn-fontsz ;; "10" #:expand "HORIZONTAL" #:action (lambda (obj val) (mark-for-update tabdat) (if (eq? val 1) (hash-table-set! (dboard:tabdat-status-ignore-hash tabdat) status #t) (hash-table-delete! (dboard:tabdat-status-ignore-hash tabdat) status)) (set-bg-on-filter commondat tabdat)))) (map cadr *common:std-statuses*))) ;; '("PASS" "FAIL" "WARN" "CHECK" "WAIVED" "STUCK/DEAD" "n/a" "SKIP"))) (apply iup:hbox (map (lambda (state) (iup:toggle (conc state " ") #:fontsize btn-fontsz #:expand "HORIZONTAL" #:action (lambda (obj val) (mark-for-update tabdat) (if (eq? val 1) (hash-table-set! (dboard:tabdat-state-ignore-hash tabdat) state #t) (hash-table-delete! (dboard:tabdat-state-ignore-hash tabdat) state)) (set-bg-on-filter commondat tabdat)))) (map cadr *common:std-states*))) ;; '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED" "DELETED"))) (iup:valuator #:valuechanged_cb (lambda (obj) (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10)))) (oldmax (string->number (iup:attribute obj "MAX"))) (maxruns (dboard:tabdat-tot-runs tabdat))) (dboard:tabdat-start-run-offset-set! tabdat val) (mark-for-update tabdat) (debug:print 6 *default-log-port* "(dboard:tabdat-start-run-offset tabdat) " (dboard:tabdat-start-run-offset tabdat) " maxruns: " maxruns ", val: " val " oldmax: " oldmax) (iup:attribute-set! obj "MAX" (* maxruns 10)))) #:expand "HORIZONTAL" #:max (* 10 (length (dboard:tabdat-allruns tabdat))) #:min 0 #:step 0.01))) ;(iup:button "inc rows" #:action (lambda (obj)(dboard:tabdat-num-tests-set! tabdat (+ (dboard:tabdat-num-tests tabdat) 1)))) |
︙ | ︙ | |||
1861 1862 1863 1864 1865 1866 1867 | (lftlst '()) (hdrlst '()) (bdylst '()) (result '()) (i 0) (btn-height (dboard:tabdat-runs-btn-height runs-dat)) (btn-fontsz (dboard:tabdat-runs-btn-fontsz runs-dat)) | | < | | | | 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 | (lftlst '()) (hdrlst '()) (bdylst '()) (result '()) (i 0) (btn-height (dboard:tabdat-runs-btn-height runs-dat)) (btn-fontsz (dboard:tabdat-runs-btn-fontsz runs-dat)) (cell-width (dboard:tabdat-runs-cell-width runs-dat))) ;; controls (along bottom) ;; (set! controls (dboard:make-controls commondat runs-dat)) ;; create the left most column for the run key names and the test names (set! lftlst (list (iup:hbox (iup:label) ;; (iup:valuator) (apply iup:vbox (map (lambda (x) (let ((res (iup:hbox #:expand "HORIZONTAL" (iup:label x #:size (conc 40 btn-height) #:fontsize btn-fontsz #:expand "NO") ;; "HORIZONTAL") (iup:textbox #:size (conc 35 btn-height) #:fontsize btn-fontsz #:value "%" #:expand "NO" ;; "HORIZONTAL" #:action (lambda (obj unk val) (mark-for-update runs-dat) (update-search commondat runs-dat x val)))))) (set! i (+ i 1)) res)) keynames))))) (let loop ((testnum 0) (res '())) (cond ((>= testnum ntests) ;; now lftlst will be an hbox with the test keys and the test name labels (set! lftlst (append lftlst (list (iup:hbox #:expand "HORIZONTAL" (iup:valuator #:valuechanged_cb (lambda (obj) (let ((val (string->number (iup:attribute obj "VALUE"))) (oldmax (string->number (iup:attribute obj "MAX"))) (newmax (* 10 (length (dboard:tabdat-all-test-names runs-dat))))) (dboard:commondat-please-update-set! commondat #t) (dboard:tabdat-start-test-offset-set! runs-dat (inexact->exact (round (/ val 10)))) (debug:print 6 *default-log-port* "(dboard:tabdat-start-test-offset runs-dat) " (dboard:tabdat-start-test-offset runs-dat) " val: " val " newmax: " newmax " oldmax: " oldmax) (if (< val 10) (iup:attribute-set! obj "MAX" newmax)) )) #:expand "VERTICAL" #:orientation "VERTICAL" #:min 0 #:step 0.01) (apply iup:vbox (reverse res))))))) (else (let ((labl (iup:button "" ;; the testname labels #:flat "YES" #:alignment "ALEFT" ; #:image img1 ; #:impress img2 #:size (conc cell-width btn-height) #:expand "HORIZONTAL" #:fontsize btn-fontsz #:action (lambda (obj) (mark-for-update runs-dat) (toggle-hide testnum (dboard:commondat-uidat commondat)))))) ;; (iup:attribute obj "TITLE")))) (vector-set! lftcol testnum labl) (loop (+ testnum 1)(cons labl res)))))) ;; These are the headers for each row (let loop ((runnum 0) (keynum 0) (keyvec (make-vector nkeys)) |
︙ | ︙ | |||
2017 2018 2019 2020 2021 2022 2023 | (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))) | | | 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 | (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 (dashboard:one-run commondat onerun-dat tab-num: 2) ;; (dashboard:new-view db data new-view-dat tab-num: 3) (dashboard:run-controls commondat runcontrols-dat tab-num: 3) |
︙ | ︙ | |||
2108 2109 2110 2111 2112 2113 2114 | (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) #t) #f))) (define (dashboard:database-changed? commondat tabdat) (let* ((run-update-time (current-seconds)) (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! | | | < < | 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 | (set! *last-monitor-update-time* run-update-time) ;; monitor-modtime) #t) #f))) (define (dashboard:database-changed? commondat tabdat) (let* ((run-update-time (current-seconds)) (modtime (dashboard:get-youngest-run-db-mod-time tabdat)) ;; NOTE: ensure this is tabdat!! (recalc (dashboard:recalc modtime (dboard:commondat-please-update commondat) (dboard:tabdat-last-db-update tabdat)))) (dboard:commondat-please-update-set! commondat #f) recalc)) ;; point inside line ;; (define-inline (dashboard:px-between px lx1 lx2) (and (< lx1 px)(> lx2 px))) ;; can a bar be placed in row "rownum" covering x1 to x2 without overlapping with existing ;; bars? Use num-rows to check that a block will fit from rownum to (+ rownum num-rows) ;; (define (dashboard:row-collision rowhash rownum x1 x2 #!key (num-rows #f)) (let ((lastrow (if num-rows (+ rownum num-rows) rownum))) (let loop ((i 0) (rowdat (hash-table-ref/default rowhash rownum '()))) |
︙ | ︙ | |||
2758 2759 2760 2761 2762 2763 2764 | ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (define (main) (if (not (args:get-arg "-skip-version-check"))(common:exit-on-version-changed)) | | | 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 | ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) (define (main) (if (not (args:get-arg "-skip-version-check"))(common:exit-on-version-changed)) (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") ",")))) (if (> (length d) 1) d (list #f #f)))) |
︙ | ︙ |
Modified utils/mk_wrapper from [4b9a0dffa4] to [a9a7628aaa].
︙ | ︙ | |||
22 23 24 25 26 27 28 | # echo "#!/bin/bash" > $target # if [ "$LD_LIBRARY_PATH" != "" ];then # echo "source $prefix/bin/.\$(lsb_release -sr)/cfg.sh" >> $target # fi # echo "exec $prefix/bin/.\$(lsb_release -sr)/$cmd \"\$@\"" >> $target echo "#!/bin/bash" > $target | < < < < < < < < < < < < < < < < < < < < < | 22 23 24 25 26 27 28 29 30 31 | # echo "#!/bin/bash" > $target # if [ "$LD_LIBRARY_PATH" != "" ];then # echo "source $prefix/bin/.\$(lsb_release -sr)/cfg.sh" >> $target # fi # echo "exec $prefix/bin/.\$(lsb_release -sr)/$cmd \"\$@\"" >> $target echo "#!/bin/bash" > $target echo "lsbr=\$(lsb_release -sr)" >> $target echo "if [[ -e \$lsbr ]];then source \$lsbr;fi" >> $target echo "exec $prefix/bin/.\$lsbr/$cmd \"\$@\"" >> $target |