| ︙ | | | ︙ | |
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
(define *ord* #f)
(define *data* (make-vector 6 #f))
(define-inline (dboard:data-get-runs vec) (vector-ref vec 0))
(define-inline (dboard:data-get-tests vec) (vector-ref vec 1))
(define-inline (dboard:data-get-runs-matrix vec) (vector-ref vec 2))
(define-inline (dboard:data-get-tests-tree vec) (vector-ref vec 3))
(define-inline (dboard:data-get-tree-keys vec) (vector-ref vec 4))
(define-inline (dboard:data-set-runs! vec val)(vector-set! vec 0 val))
(define-inline (dboard:data-set-tests! vec val)(vector-set! vec 1 val))
(define-inline (dboard:data-set-runs-matrix! vec val)(vector-set! vec 2 val))
(define-inline (dboard:data-set-tests-tree! vec val)(vector-set! vec 3 val))
(define-inline (dboard:data-set-tree-keys! vec val)(vector-set! vec 4 val))
(dboard:data-set-tree-keys! *data* (make-hash-table))
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")
(define (message-window msg)
(iup:show
(iup:dialog
|
|
|
|
|
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
(define *ord* #f)
(define *data* (make-vector 6 #f))
(define-inline (dboard:data-get-runs vec) (vector-ref vec 0))
(define-inline (dboard:data-get-tests vec) (vector-ref vec 1))
(define-inline (dboard:data-get-runs-matrix vec) (vector-ref vec 2))
(define-inline (dboard:data-get-tests-tree vec) (vector-ref vec 3))
(define-inline (dboard:data-get-run-keys vec) (vector-ref vec 4))
(define-inline (dboard:data-set-runs! vec val)(vector-set! vec 0 val))
(define-inline (dboard:data-set-tests! vec val)(vector-set! vec 1 val))
(define-inline (dboard:data-set-runs-matrix! vec val)(vector-set! vec 2 val))
(define-inline (dboard:data-set-tests-tree! vec val)(vector-set! vec 3 val))
(define-inline (dboard:data-set-run-keys! vec val)(vector-set! vec 4 val))
(dboard:data-set-run-keys! *data* (make-hash-table))
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")
(define (message-window msg)
(iup:show
(iup:dialog
|
| ︙ | | | ︙ | |
371
372
373
374
375
376
377
378
379
380
381
382
383
384
|
(define (tests)
(iup:hbox
(let* ((tb (iup:treebox
#:selection_cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
(dboard:data-set-tests-tree! *data* tb)
tb)
(iup:vbox
)))
;; Overall runs browser
;;
|
>
|
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
|
(define (tests)
(iup:hbox
(let* ((tb (iup:treebox
#:selection_cb (lambda (obj id state)
(print "obj: " obj ", id: " id ", state: " state)))))
(iup:attribute-set! tb "VALUE" "0")
(iup:attribute-set! tb "NAME" "Runs")
(iup:attribute-set! tb "ADDEXPANDED" "NO")
(dboard:data-set-tests-tree! *data* tb)
tb)
(iup:vbox
)))
;; Overall runs browser
;;
|
| ︙ | | | ︙ | |
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
;; Given a run-id and testname/item_path calculate a cell R:C
;; NOTE: Also build the test tree browser and look up table
;;
;; Each run is unique on its keys and runname or run-id, store in hash on colnum
(for-each (lambda (run-id)
(let* (;; (run-id (db:get-value-by-header rundat header "id"))
(run-record (hash-table-ref/default runs-hash run-id #f))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name)))
(iup:attribute-set! (dboard:data-get-runs-matrix *data*)
(conc rownum ":" colnum) col-name)
(hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree-add-node (dboard:data-get-tests-tree *data*) "Runs" key-vals)
(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* ((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))
(time-b (db:mintest-get-event_time b)))
|
<
|
|
>
>
|
>
|
|
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
|
;; Given a run-id and testname/item_path calculate a cell R:C
;; NOTE: Also build the test tree browser and look up table
;;
;; Each run is unique on its keys and runname or run-id, store in hash on colnum
(for-each (lambda (run-id)
(let* ((run-record (hash-table-ref/default runs-hash run-id #f))
(key-vals (map (lambda (key)(db:get-value-by-header run-record header key))
(map key:get-fieldname keys)))
(run-name (db:get-value-by-header run-record header "runname"))
(col-name (conc (string-intersperse key-vals "\n") "\n" run-name))
(run-path (append key-vals (list run-name))))
(hash-table-set! (dboard:data-get-run-keys *data*) run-id run-path)
(iup:attribute-set! (dboard:data-get-runs-matrix *data*)
(conc rownum ":" colnum) col-name)
(hash-table-set! runid-to-col run-id (list colnum run-record))
;; Here we update the tests treebox and tree keys
(tree-add-node (dboard:data-get-tests-tree *data*) "Runs" (append key-vals (list run-name)))
(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))
(time-b (db:mintest-get-event_time b)))
|
| ︙ | | | ︙ | |
526
527
528
529
530
531
532
533
534
535
536
537
538
539
|
(let* ((state (db:mintest-get-state test))
(status (db:mintest-get-status test))
(testname (db:mintest-get-testname test))
(itempath (db:mintest-get-item_path test))
(fullname (conc testname "/" itempath))
(dispname (if (string=? itempath "") testname (conc " " itempath)))
(rownum (hash-table-ref/default testname-to-row fullname #f)))
(if (not rownum)
(let ((rownums (hash-table-values testname-to-row)))
(set! rownum (if (null? rownums)
1
(+ 1 (apply max rownums))))
(hash-table-set! testname-to-row fullname rownum)
;; create the label
|
>
>
>
>
|
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
(let* ((state (db:mintest-get-state test))
(status (db:mintest-get-status test))
(testname (db:mintest-get-testname test))
(itempath (db:mintest-get-item_path test))
(fullname (conc testname "/" itempath))
(dispname (if (string=? itempath "") testname (conc " " itempath)))
(rownum (hash-table-ref/default testname-to-row fullname #f)))
(tree-add-node (dboard:data-get-tests-tree *data*) "Runs"
(append run-path (if (equal? itempath "")
(list testname)
(list testname itempath))))
(if (not rownum)
(let ((rownums (hash-table-values testname-to-row)))
(set! rownum (if (null? rownums)
1
(+ 1 (apply max rownums))))
(hash-table-set! testname-to-row fullname rownum)
;; create the label
|
| ︙ | | | ︙ | |