Overview
Comment: | Got basic newdashboard functionality back |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
3f669a2c30fc7cd1d73e2df552659d21 |
User & Date: | matt on 2014-12-27 23:44:53 |
Other Links: | branch diff | manifest | tags |
Context
2014-12-29
| ||
15:57 | Fixed typo check-in: a1dfc62a4e user: mrwellan tags: v1.60 | |
2014-12-28
| ||
18:39 | Removing reliance on globals in prep for multi-testsuite support in dashboard check-in: f8db475db1 user: matt tags: multi-testsuite-support | |
2014-12-27
| ||
23:44 | Got basic newdashboard functionality back check-in: 3f669a2c30 user: matt tags: v1.60 | |
2014-12-23
| ||
23:20 | sketched out restore check-in: d36fddcc33 user: matt tags: v1.60 | |
Changes
Modified api.scm from [502389005b] to [030af4fe6b].
︙ | ︙ | |||
45 46 47 48 49 50 51 52 53 54 55 56 57 58 | get-prev-run-ids get-run-ids-matching-target get-runs-by-patt get-steps-data login testmeta-get-record have-incompletes? )) (define api:write-queries '( ;; SERVERS start-server kill-server | > | 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 | get-prev-run-ids get-run-ids-matching-target get-runs-by-patt get-steps-data login testmeta-get-record have-incompletes? synchash-get )) (define api:write-queries '( ;; SERVERS start-server kill-server |
︙ | ︙ | |||
186 187 188 189 190 191 192 193 194 195 196 197 198 199 | ((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params)) ((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params)) ((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params)) ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) ;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) ((get-tests-for-run) (apply db:get-tests-for-run dbstruct params)) ((get-test-id) (apply db:get-test-id dbstruct params)) | > | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | ((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params)) ((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params)) ((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params)) ((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params)) ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params)) ((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params)) ((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params)) ((synchash-get) (apply synchash:server-get dbstruct params)) ;; RUNS ((get-run-info) (apply db:get-run-info dbstruct params)) ((get-run-status) (apply db:get-run-status dbstruct params)) ((set-run-status) (apply db:set-run-status dbstruct params)) ((get-tests-for-run) (apply db:get-tests-for-run dbstruct params)) ((get-test-id) (apply db:get-test-id dbstruct params)) |
︙ | ︙ |
Modified dcommon.scm from [cd3454dabd] to [ea99b44dfd].
︙ | ︙ | |||
134 135 136 137 138 139 140 | ;; the synchash calls modify the "data" hash (get-runs-sig (conc (client:get-signature) " get-runs")) (get-tests-sig (conc (client:get-signature) " get-tests")) (get-details-sig (conc (client:get-signature) " get-test-details")) ;; test-ids to get and display are indexed on window-id in curr-test-ids hash (test-ids (hash-table-values (dboard:data-get-curr-test-ids *data*))) | | | > > > | > > | 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 | ;; the synchash calls modify the "data" hash (get-runs-sig (conc (client:get-signature) " get-runs")) (get-tests-sig (conc (client:get-signature) " get-tests")) (get-details-sig (conc (client:get-signature) " get-test-details")) ;; test-ids to get and display are indexed on window-id in curr-test-ids hash (test-ids (hash-table-values (dboard:data-get-curr-test-ids *data*))) ;; run-id is #f in next line to send the query to server 0 (run-changes (synchash:client-get 'db:get-runs get-runs-sig (length keypatts) data #f runname #f #f keypatts)) (tests-detail-changes (if (not (null? test-ids)) (synchash:client-get 'db:get-test-info-by-ids get-details-sig 0 data #f test-ids) '())) ;; Now can calculate the run-ids (run-hash (hash-table-ref/default data get-runs-sig #f)) (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) (all-test-changes (let ((res (make-hash-table))) (for-each (lambda (run-id) (if (> run-id 0) (hash-table-set! res run-id (synchash:client-get 'db:get-tests-for-run-mindata get-tests-sig 0 data run-id 1 testpatt states statuses #f)))) run-ids) res)) (runs-hash (hash-table-ref/default data get-runs-sig #f)) (header (hash-table-ref/default runs-hash "header" #f)) (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 header "event_time")) |
︙ | ︙ | |||
190 191 192 193 194 195 196 197 198 199 200 201 202 203 | (set! colnum (+ colnum 1)))) run-ids) ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table ;; Do this analysis in the order of the run-ids, the most recent run wins (for-each (lambda (run-id) (let* ((run-path (hash-table-ref (dboard:data-get-run-keys *data*) run-id)) (new-test-dat (car test-changes)) (removed-tests (cadr test-changes)) (tests (sort (map cadr (filter (lambda (testrec) (eq? run-id (db:mintest-get-run_id (cadr testrec)))) new-test-dat)) (lambda (a b) (let ((time-a (db:mintest-get-event_time a)) | > | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | (set! colnum (+ colnum 1)))) run-ids) ;; Scan all tests to be displayed and organise all the test names, respecting what is in the hash table ;; Do this analysis in the order of the run-ids, the most recent run wins (for-each (lambda (run-id) (let* ((run-path (hash-table-ref (dboard:data-get-run-keys *data*) run-id)) (test-changes (hash-table-ref all-test-changes run-id)) (new-test-dat (car test-changes)) (removed-tests (cadr test-changes)) (tests (sort (map cadr (filter (lambda (testrec) (eq? run-id (db:mintest-get-run_id (cadr testrec)))) new-test-dat)) (lambda (a b) (let ((time-a (db:mintest-get-event_time a)) |
︙ | ︙ | |||
267 268 269 270 271 272 273 | (let ((updater (hash-table-ref/default (dboard:data-get-updaters *data*) window-id #f))) (if updater (updater (hash-table-ref/default data get-details-sig #f)))) (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL") ;; (debug:print 2 "run-changes: " run-changes) ;; (debug:print 2 "test-changes: " test-changes) | | | 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 | (let ((updater (hash-table-ref/default (dboard:data-get-updaters *data*) window-id #f))) (if updater (updater (hash-table-ref/default data get-details-sig #f)))) (iup:attribute-set! (dboard:data-get-runs-matrix *data*) "REDRAW" "ALL") ;; (debug:print 2 "run-changes: " run-changes) ;; (debug:print 2 "test-changes: " test-changes) (list run-changes all-test-changes))) ;;====================================================================== ;; TESTS DATA ;;====================================================================== ;; Produce a list of lists ready for common:sparse-list-generate-index ;; |
︙ | ︙ |
Modified launch.scm from [df9137345e] to [c63840475d].
︙ | ︙ | |||
796 797 798 799 800 801 802 | (set! mt-bindir-path (pathname-directory remote-megatest)) (if launcher (set! launcher (string-split launcher))) ;; set up the run work area for this test (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir (begin (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path) | | | 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 | (set! mt-bindir-path (pathname-directory remote-megatest)) (if launcher (set! launcher (string-split launcher))) ;; set up the run work area for this test (if (and (args:get-arg "-preclean") ;; user has requested to preclean for this run (not (member (db:test-get-rundir testinfo)(list "n/a" "/tmp/badname")))) ;; n/a is a placeholder and thus not a read dir (begin (debug:print-info 0 "attempting to preclean directory " (db:test-get-rundir testinfo) " for test " test-name "/" item-path) (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record ;; prevent overlapping actions - set to LAUNCHED as early as possible ;; (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED")) (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED") (set! diskpath (get-best-disk *configdat*)) (if diskpath |
︙ | ︙ |
Modified rmt.scm from [3e7f6c01ce] to [6e9129f161].
︙ | ︙ | |||
379 380 381 382 383 384 385 386 387 388 389 390 391 392 | (if (number? run-id) (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) (begin (debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id) (print-call-chain (current-error-port)) '()))) ;; IDEA: Threadify these - they spend a lot of time waiting ... ;; (define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) (let ((multi-run-mutex (make-mutex)) (run-id-list (if run-ids run-ids (rmt:get-all-run-ids))) | > > > > | 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 | (if (number? run-id) (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)) (begin (debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id) (print-call-chain (current-error-port)) '()))) ;; get stuff via synchash (define (rmt:synchash-get run-id proc synckey keynum params) (rmt:send-receive 'synchash-get run-id (list run-id proc synckey keynum params))) ;; IDEA: Threadify these - they spend a lot of time waiting ... ;; (define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) (let ((multi-run-mutex (make-mutex)) (run-id-list (if run-ids run-ids (rmt:get-all-run-ids))) |
︙ | ︙ |
Modified synchash.scm from [9881f5a738] to [67fbbc1d0f].
︙ | ︙ | |||
60 61 62 63 64 65 66 | ;; (cdb:remote-run db:get-keys #f) ;; (cdb:remote-run db:get-num-runs #f "%") ;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts) ;; ;; keynum => the field to use as the unique key (usually 0 but can be other field) ;; | | < | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | ;; (cdb:remote-run db:get-keys #f) ;; (cdb:remote-run db:get-num-runs #f "%") ;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts) ;; ;; keynum => the field to use as the unique key (usually 0 but can be other field) ;; (define (synchash:client-get proc synckey keynum synchash run-id . params) (let* ((data (rmt:synchash-get run-id proc synckey keynum params)) (newdat (car data)) (removs (cadr data)) (myhash (hash-table-ref/default synchash synckey #f))) (if (not myhash) (begin (set! myhash (make-hash-table)) (hash-table-set! synchash synckey myhash))) |
︙ | ︙ | |||
87 88 89 90 91 92 93 | removs) ;; WHICH ONE!? ;; data)) ;; return the changed and deleted list (list newdat removs))) ;; synchash)) (define *synchashes* (make-hash-table)) | | > | | | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | removs) ;; WHICH ONE!? ;; data)) ;; return the changed and deleted list (list newdat removs))) ;; synchash)) (define *synchashes* (make-hash-table)) (define (synchash:server-get dbstruct run-id proc synckey keynum params) ;; (debug:print-info 2 "synckey: " synckey ", keynum: " keynum ", params: " params) (let* ((dbdat (db:get-db dbstruct run-id)) (db (db:dbdat-get-db dbdat)) (synchash (hash-table-ref/default *synchashes* synckey #f)) (newdat (apply (case proc ((db:get-runs) db:get-runs) ((db:get-tests-for-run-mindata) db:get-tests-for-run-mindata) ((db:get-test-info-by-ids) db:get-test-info-by-ids) (else (print "ERROR: sync for hash " proc " not setup! Edits needed in synchash.scm") print)) db params)) (postdat #f) (make-indexed (lambda (x) |
︙ | ︙ |