Overview
Comment: | Replaced apply max with common:max in few places |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.62 |
Files: | files | file ages | folders |
SHA1: |
8b35992868546d46c01b2a1f716ec18b |
User & Date: | matt on 2016-10-18 23:25:38 |
Other Links: | branch diff | manifest | tags |
Context
2016-10-19
| ||
00:10 | Added the beginnings of a quick start check-in: ceaf296125 user: matt tags: v1.62 | |
2016-10-18
| ||
23:25 | Replaced apply max with common:max in few places check-in: 8b35992868 user: matt tags: v1.62 | |
2016-10-17
| ||
14:36 | Fixed missing [logpro] section in create-megatest-area. check-in: c74d681e4f user: mrwellan tags: v1.62, v1.6204 | |
Changes
Modified common.scm from [8514527bdb] to [5874d3df51].
︙ | ︙ | |||
617 618 619 620 621 622 623 624 625 626 627 628 629 630 | (hed (car inlst)) (tal (cdr inlst))) (if (not (null? tal)) (loop (max hed max-val) (car tal) (cdr tal)) (max hed max-val)))) ;; path list to hash-table tree ;; ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c)))) ;; (define (common:list->htree lst) (let ((resh (make-hash-table))) (for-each | > > > > > > > > > > | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 | (hed (car inlst)) (tal (cdr inlst))) (if (not (null? tal)) (loop (max hed max-val) (car tal) (cdr tal)) (max hed max-val)))) ;; get min or max, use > for max and < for min, this works around the limits on apply ;; (define (common:min-max comp lst) (if (null? lst) #f ;; better than an exception for my needs (fold (lambda (a b) (if (comp a b) a b)) (car lst) lst))) ;; path list to hash-table tree ;; ((a b c)(a b d)(e b c)) => ((a (b (d) (c))) (e (b (c)))) ;; (define (common:list->htree lst) (let ((resh (make-hash-table))) (for-each |
︙ | ︙ |
Modified dashboard.scm from [6bac3ad2ce] to [929e1f3c0c].
︙ | ︙ | |||
2567 2568 2569 2570 2571 2572 2573 | (define (dashboard:get-youngest-run-db-mod-time tabdat) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds | | | 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 | (define (dashboard:get-youngest-run-db-mod-time tabdat) (handle-exceptions exn (begin (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn)) (current-seconds)) ;; something went wrong - just print an error and return current-seconds (common:max (map (lambda (filen) (file-modification-time filen)) (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db")))))) (define (dashboard:monitor-changed? commondat tabdat) (let* ((run-update-time (current-seconds)) (monitor-db-path (dboard:tabdat-monitor-db-path tabdat)) (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path)) |
︙ | ︙ | |||
2644 2645 2646 2647 2648 2649 2650 | (hash-table-set! rowhash (+ i rownum) (cons (cons x1 x2) (hash-table-ref/default rowhash (+ i rownum) '()))) (if (< i num-rows) (loop (+ i 1))))) | < < < < < < < < < < | 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 | (hash-table-set! rowhash (+ i rownum) (cons (cons x1 x2) (hash-table-ref/default rowhash (+ i rownum) '()))) (if (< i num-rows) (loop (+ i 1))))) ;; sort a list of test-ids by the event _time using a hash table of id => testdat ;; (define-inline (dboard:sort-testsdat-by-event-time test-ids tests-ht) (sort test-ids (lambda (a b) (< (db:test-get-event_time (hash-table-ref tests-ht a)) (db:test-get-event_time (hash-table-ref tests-ht b)))))) |
︙ | ︙ | |||
3078 3079 3080 3081 3082 3083 3084 | (dboard:rundat-hierdat rundat))) (tests-ht (dboard:rundat-tests rundat)) (all-tids (hash-table-keys tests-ht)) ;; (apply append hierdat)) ;; was testsdat (testsdat (hash-table-values tests-ht)) (runcomp (vg:comp-new));; new component for this run (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...) ;; (row-height 4) | | | | 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 | (dboard:rundat-hierdat rundat))) (tests-ht (dboard:rundat-tests rundat)) (all-tids (hash-table-keys tests-ht)) ;; (apply append hierdat)) ;; was testsdat (testsdat (hash-table-values tests-ht)) (runcomp (vg:comp-new));; new component for this run (rows-used (make-hash-table)) ;; keep track of what parts of the rows are used here row1 = (obj1 obj2 ...) ;; (row-height 4) (run-start (common:min-max < (map db:test-get-event_time testsdat))) (run-end (let ((re (common:min-max > (map (lambda (t)(+ (db:test-get-event_time t)(db:test-get-run_duration t))) testsdat)))) (max re (+ 1 run-start)))) ;; use run-start+1 if run-start == run-end so delta is not zero (timeoffset (- run-start)) ;; (+ fixed-originx canvas-margin) run-start)) (run-duration (- run-end run-start)) (timescale (/ (- sizex (* 2 canvas-margin)) (if (> run-duration 0) run-duration (current-seconds)))) ;; a least lously guess |
︙ | ︙ |
Modified dcommon.scm from [adcc5f42ce] to [eb6ea73393].
︙ | ︙ | |||
214 215 216 217 218 219 220 | ;; (iup:attribute-set! tb (conc "COLOR" node-num) color) ) (hash-table-set! (dboard:tabdat-path-test-ids data) test-path test-id) (if (not rownum) (let ((rownums (hash-table-values testname-to-row))) (set! rownum (if (null? rownums) 1 | | | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 | ;; (iup:attribute-set! tb (conc "COLOR" node-num) color) ) (hash-table-set! (dboard:tabdat-path-test-ids data) test-path test-id) (if (not rownum) (let ((rownums (hash-table-values testname-to-row))) (set! rownum (if (null? rownums) 1 (+ 1 (common:max rownums)))) (hash-table-set! testname-to-row fullname rownum) ;; create the label (set! changed (dcommon:modifiy-if-different (dboard:tabdat-runs-matrix data) (conc rownum ":" 0) dispname changed)) |
︙ | ︙ | |||
266 267 268 269 270 271 272 | (define (dcommon:runsdat-get-col-num dat target runname force-set) (let* ((runs-index (dboard:runsdat-runs-index dat)) (col-name (conc target "/" runname)) (res (hash-table-ref/default runs-index col-name #f))) (if res res (if force-set | | | | 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 | (define (dcommon:runsdat-get-col-num dat target runname force-set) (let* ((runs-index (dboard:runsdat-runs-index dat)) (col-name (conc target "/" runname)) (res (hash-table-ref/default runs-index col-name #f))) (if res res (if force-set (let ((max-col-num (+ 1 (common:max (cons-1 (hash-table-values runs-index)))))) (hash-table-set! runs-index col-name max-col-num) max-col-num))))) (define (dcommon:runsdat-get-row-num dat testname itempath force-set) (let* ((tests-index (dboard:runsdat-runs-index dat)) (row-name (conc testname "/" itempath)) (res (hash-table-ref/default runs-index row-name #f))) (if res res (if force-set (let ((max-row-num (+ 1 (common:max (cons -1 (hash-table-values tests-index)))))) (hash-table-set! runs-index row-name max-row-num) max-row-num))))) (define (dcommon:rundat-copy-tests-to-by-name rundat) (let ((src-ht (dboard:rundat-tests rundat)) (trg-ht (dboard:rundat-tests-by-name rundat))) (if (and (hash-table? src-ht)(hash-table? trg-ht)) |
︙ | ︙ | |||
546 547 548 549 550 551 552 | (changed #f) (stats-updater (lambda () (if (dashboard:database-changed? commondat tabdat context-key: 'run-stats) (let* ((run-stats (rmt:get-run-stats)) (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) (row-indices (car indices)) (col-indices (cadr indices)) | | | | 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 | (changed #f) (stats-updater (lambda () (if (dashboard:database-changed? commondat tabdat context-key: 'run-stats) (let* ((run-stats (rmt:get-run-stats)) (indices (common:sparse-list-generate-index run-stats)) ;; proc: set-cell)) (row-indices (car indices)) (col-indices (cadr 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)) (max-col-vis (if (> max-col 10) 10 max-col)) (numrows 1) (numcols 1)) (iup:attribute-set! stats-matrix "CLEARVALUE" "CONTENTS") (iup:attribute-set! stats-matrix "NUMCOL" max-col ) (iup:attribute-set! stats-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 |
︙ | ︙ |
Modified runs.scm from [fb07c27494] to [9f66bcb951].
︙ | ︙ | |||
1542 1543 1544 1545 1546 1547 1548 | ((and skip-check (configf:lookup test-conf "skip" "rundelay")) ;; run-ids = #f means *all* runs (let* ((numseconds (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay"))) (running-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f)) (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex (last-run-times (map db:mintest-get-event_time completed-tests)) | | | 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 | ((and skip-check (configf:lookup test-conf "skip" "rundelay")) ;; run-ids = #f means *all* runs (let* ((numseconds (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay"))) (running-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f)) (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex (last-run-times (map db:mintest-get-event_time completed-tests)) (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (common:max last-run-times))))) (if (or (not (null? running-tests)) ;; have to skip if test is running (> numseconds time-since-last)) (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago")))))) (if skip-test (begin (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "SKIP" skip-test) |
︙ | ︙ |