Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-try3 |
Files: | files | file ages | folders |
SHA1: |
792cf5fe01f5cf08c1c69bcc242b5ff0 |
User & Date: | matt on 2019-11-03 19:22:00 |
Other Links: | branch diff | manifest | tags |
Context
2019-11-03
| ||
19:40 | wip check-in: 016c7dba29 user: matt tags: v1.65-try3 | |
19:22 | wip check-in: 792cf5fe01 user: matt tags: v1.65-try3 | |
19:06 | wip check-in: cfaa83fc70 user: matt tags: v1.65-try3 | |
Changes
Modified dashboard-tests-inc.scm from [cb59811621] to [263d67388a].
︙ | ︙ | |||
998 999 1000 1001 1002 1003 1004 1005 | " -testpatt " test-patt states-str statuses-str ))) (else (set! full-cmd " no valid command "))) (iup:attribute-set! cmd-tb "VALUE" full-cmd))) | > > > > > > > > > > > > > > > > > > > > > > > | 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | " -testpatt " test-patt states-str statuses-str ))) (else (set! full-cmd " no valid command "))) (iup:attribute-set! cmd-tb "VALUE" full-cmd))) (define (iuplistbox-fill-list lb items #!key (selected-item #f)) (let ((i 1)) (for-each (lambda (item) (iup:attribute-set! lb (number->string i) item) (if selected-item (if (equal? selected-item item) (iup:attribute-set! lb "VALUE" i))) ;; (number->string i)))) (set! i (+ i 1))) items) ;; (iup:attribute-set! lb "VALUE" (if selected-item selected-item "")) i)) ;; if tab-num passed in then use it, otherwise look in commondat at curr-tab-num ;; adds the updater passed in the updaters list at that hashkey ;; (define (dboard:commondat-add-updater commondat updater #!key (tab-num #f)) (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) (hash-table-set! (dboard:commondat-updaters commondat) tnum (cons updater curr-updaters)))) |
Modified dashboard.scm from [e75db03c6f] to [e589faed2f].
︙ | ︙ | |||
177 178 179 180 181 182 183 | ;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn") ;; (if (not (args:get-arg "-use-db-cache")) ;; (begin ;; (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db") ;; (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;) ;;) | < < < < < < < < < < < < < < < < < < < < < < < < | 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | ;;(debug:print-info 13 *default-log-port* "After common:watchdog spawn") ;; (if (not (args:get-arg "-use-db-cache")) ;; (begin ;; (debug:print-info 0 *default-log-port* "Forcing db-cache mode due to read-only access to megatest.db") ;; (hash-table-set! args:arg-hash "-use-db-cache" #t)));;;) ;;) ;; RA => returns the tabdat stored at hashkey passed in commondat-tabdats table (e.g. 0 gives summary) ;; (define (dboard:common-get-tabdat commondat #!key (tab-num #f)) (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat) 0)) ;; tab-num value is curr-tab-num value in passed commondat (ht (dboard:commondat-tabdats commondat)) |
︙ | ︙ | |||
237 238 239 240 241 242 243 | (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum) (for-each ;; perform the function calls for the complete updaters list (lambda (updater) ;; (debug:print 3 *default-log-port* "Running " updater) (updater)) updaters)))) | < < < < < < < < < < < | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | (debug:print 4 *default-log-port* "Found these updaters: " updaters " for tab-num: " tnum) (for-each ;; perform the function calls for the complete updaters list (lambda (updater) ;; (debug:print 3 *default-log-port* "Running " updater) (updater)) updaters)))) ;; register tabdat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle (hash-table-set! *BBpp_custom_expanders_list* TABDAT: (cons dboard:tabdat? (lambda (tabdat-item) (filter (lambda (alist-entry) |
︙ | ︙ | |||
284 285 286 287 288 289 290 | (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) ) | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 | (dboard:tabdat-ro-set! tabdat (not (file-read-access? (dboard:tabdat-dbfpath tabdat)))) (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) ) ;; register dboard:rundat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle (hash-table-set! *BBpp_custom_expanders_list* RUNDAT: (cons dboard:rundat? (lambda (tabdat-item) (filter (lambda (alist-entry) |
︙ | ︙ | |||
415 416 417 418 419 420 421 | (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) (define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1)) (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"))) | < < < < < < < < < < < < | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 | (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) (define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1)) (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 (pad-list l n)(append l (make-list (- n (length l))))) (define (dboard:compare-tests test1 test2) (let* ((test-name1 (db:test-get-testname test1)) (item-path1 (db:test-get-item-path test1)) (eventtime1 (db:test-get-event_time test1)) (test-name2 (db:test-get-testname test2)) |
︙ | ︙ |
Modified dcommon-inc.scm from [2470a83b63] to [921af03e54].
︙ | ︙ | |||
22 23 24 25 26 27 28 29 30 31 32 33 34 35 | (define dashboard:update-summary-tab #f) (define dashboard:update-servers-table #f) ;;====================================================================== ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;;====================================================================== ;; D O T F I L E ;;====================================================================== (define (dcommon:write-dotfile fname dat) (with-output-to-file fname | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | (define dashboard:update-summary-tab #f) (define dashboard:update-servers-table #f) ;;====================================================================== ;; C O M M O N D A T A S T R U C T U R E ;;====================================================================== ;; ;; data common to all tabs goes here ;; (defstruct dboard:commondat ((curr-tab-num 0) : number) 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 )) ;; RADT => Matrix defstruct addition (defstruct dboard:graph-dat ((id #f) : string) ((color #f) : vector) ((flag #t) : boolean) ((cell #f) : number) ) ;; data for runs, tests etc. was used in run summary? ;; (defstruct dboard:runsdat ;; new system runs-index ;; target/runname => colnum tests-index ;; testname/itempath => rownum matrix-dat ;; vector of vectors rows/cols ) (define (dboard:runsdat-make-init) (make-dboard:runsdat runs-index: (make-hash-table) tests-index: (make-hash-table) matrix-dat: (make-sparse-array))) ;; used to keep the rundata from rmt:get-tests-for-run ;; in sync. ;; (defstruct dboard:rundat run tests-drawn ;; list of id's already drawn on screen tests-notdrawn ;; list of id's NOT already drawn rowsused ;; hash of lists covering what areas used - replace with quadtree hierdat ;; put hierarchial sorted list here tests ;; hash of id => testdat ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat key-vals ((last-update 0) : number) ;; last query to db got records from before last-update ((last-db-time 0) : number) ;; last timestamp on megatest.db ((data-changed #f) : boolean) ((run-data-offset 0) : number) ;; get only 100 items per call, set back to zero when received less than 100 items (db-path #f)) ;;====================================================================== ;; D O T F I L E ;;====================================================================== (define (dcommon:write-dotfile fname dat) (with-output-to-file fname |
︙ | ︙ | |||
427 428 429 430 431 432 433 | (if (not testdat) (begin (debug:print 2 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) (let* ((rundir (if testdat (db:test-get-rundir testdat) | | | 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 | (if (not testdat) (begin (debug:print 2 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) (let* ((rundir (if testdat (db:test-get-rundir testdat) (current-directory))) ;; logfile)) (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) (xterm (lambda () (if (directory-exists? rundir) (let* ((shell (if (get-environment-variable "SHELL") (conc "-e " (get-environment-variable "SHELL")) "")) (command (conc "cd " rundir |
︙ | ︙ |
Modified env-inc.scm from [67e61aff12] to [b0c2daedc8].
︙ | ︙ | |||
62 63 64 65 66 67 68 | (lambda (context) (query (for-each-row (lambda (row) (let ((var (car row)) (val (cadr row))) (hash-table-set! result var | | | | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | (lambda (context) (query (for-each-row (lambda (row) (let ((var (car row)) (val (cadr row))) (hash-table-set! result var (if (and (hash-table-ref/default result var #f) (assoc var paths)) ;; this var is a path and there is a previous path (let ((sep (cadr (assoc var paths)))) (env:merge-path-envvar sep (hash-table-ref result var) val)) val))))) (sql db "SELECT var,val FROM envvars WHERE context=?") context)) contexts) result)) ;; get list of removed variables between two contexts |
︙ | ︙ |
Modified megamod.scm from [13b90bf40e] to [2ea01930dd].
︙ | ︙ | |||
53 54 55 56 57 58 59 60 61 62 63 64 65 66 | (import (prefix base64 base64:) (prefix dbi dbi:) (prefix nanomsg nmsg:) (prefix sqlite3 sqlite3:) call-with-environment-variables canvas-draw csv csv-xml data-structures directory-utils dot-locking extras files | > | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | (import (prefix base64 base64:) (prefix dbi dbi:) (prefix nanomsg nmsg:) (prefix sqlite3 sqlite3:) call-with-environment-variables canvas-draw canvas-draw-iup csv csv-xml data-structures directory-utils dot-locking extras files |
︙ | ︙ |