Overview
| Comment: | Fixed fallout from refactoring |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
66a0b5821be17025b4da9941ebb346c3 |
| User & Date: | mrwellan on 2016-07-22 16:34:59 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-07-22
| ||
| 17:57 | more incremental draw check-in: 4d158f878f user: mrwellan tags: v1.61 | |
| 16:34 | Fixed fallout from refactoring check-in: 66a0b5821b user: mrwellan tags: v1.61 | |
| 15:09 | Added hash of fulltestname => testdat check-in: 082dea7a8d user: mrwellan tags: v1.61 | |
Changes
Modified dashboard.scm from [f3f796ec5e] to [1d8470c8da].
| ︙ | ︙ | |||
1104 1105 1106 1107 1108 1109 1110 | ;; R U N C O N T R O L S ;;====================================================================== ;; ;; A gui for launching tests ;; (define (dashboard:run-times commondat tabdat #!key (tab-num #f)) (let ((drawing (vg:drawing-new)) | | > | | | | | | 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 |
;; R U N C O N T R O L S
;;======================================================================
;;
;; A gui for launching tests
;;
(define (dashboard:run-times commondat tabdat #!key (tab-num #f))
(let ((drawing (vg:drawing-new))
(run-times-tab-updater (lambda ()
(debug:catch-and-dump
(lambda ()
(let ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num)))
(if tabdat
(dashboard:run-times-tab-updater commondat tabdat tab-num))))
"dashboard:run-times-tab-updater"))))
(dboard:tabdat-drawing-set! tabdat drawing)
(dboard:commondat-add-updater commondat run-times-tab-updater tab-num: tab-num)
(iup:split
#:orientation "VERTICAL" ;; "HORIZONTAL"
#:value 200
(let* ((tb (iup:treebox
#:value 0
|
| ︙ | ︙ | |||
2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 |
(if (null? lst)
#f ;; better than an exception for my needs
(fold (lambda (a b)
(if (comp a b) a b))
(car lst)
lst)))
(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))))))
;; first group items into lists, then sort by time
| > > | 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 |
(if (null? lst)
#f ;; better than an exception for my needs
(fold (lambda (a b)
(if (comp a b) a b))
(car lst)
lst)))
;; 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))))))
;; first group items into lists, then sort by time
|
| ︙ | ︙ | |||
2394 2395 2396 2397 2398 2399 2400 | (let ((tests-id-lst (hash-table-ref test-ids-by-name testname))) (if (> (length tests-id-lst) 1) ;; must be iterated (let ((item-tests (filter (lambda (tid) ;; filter out toplevel tests (let ((tdat (hash-table-ref testsdat tid))) (not (equal? (db:test-get-item-path tdat) "")))) tests-id-lst))) (if (not (null? item-tests)) ;; resist bad data, generally should not fail this condition | | > | 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 | (let ((tests-id-lst (hash-table-ref test-ids-by-name testname))) (if (> (length tests-id-lst) 1) ;; must be iterated (let ((item-tests (filter (lambda (tid) ;; filter out toplevel tests (let ((tdat (hash-table-ref testsdat tid))) (not (equal? (db:test-get-item-path tdat) "")))) tests-id-lst))) (if (not (null? item-tests)) ;; resist bad data, generally should not fail this condition (hash-table-set! test-ids-by-name testname (dboard:sort-testsdat-by-event-time item-tests testsdat))))))) (hash-table-keys test-ids-by-name)) ;; finally sort by the event time of the first test (sort (hash-table-values test-ids-by-name) (lambda (a b) (< (db:test-get-event_time (hash-table-ref testsdat (car a))) (db:test-get-event_time (hash-table-ref testsdat (car b)))))))))) (define (dashboard:run-times-tab-updater commondat tabdat tab-num) ;; each test is an object in the run component |
| ︙ | ︙ |