| ︙ | | |
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
|
-
+
|
;; all of it, i.e. the node-depth went from deep to less deep
(if (> depth node-depth) ;; (+ 1 node-depth))
#f
(loop hed tal depth (+ nodenum 1)))))
#f))))
;; top is the top node name zeroeth node VALUE=0
(define (tree-add-node obj top nodelst)
(define (tree-add-node obj top nodelst #!key (userdata #f))
(if (not (iup:attribute obj "TITLE0"))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (string=? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
|
| ︙ | | |
354
355
356
357
358
359
360
361
362
363
364
365
366
367
|
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
|
+
+
|
(let* ((newpath (append pathl (list hed)))
(parentnode (tree-find-node obj pathl))
(nodenum (tree-find-node obj newpath)))
;; Add the branch under lastnode if not found
(if (not nodenum)
(begin
(iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
(if userdata
(iup:attribute-set! obj (conc "USERDATA" parentnode) userdata))
(if (null? tal)
#t
;; reset to top
(loop (car nodelst)(cdr nodelst) 1 (list top))))
(if (null? tal) ;; if null here then this path has already been added
#t
(loop (car tal)(cdr tal)(+ depth 1) newpath))))))))
|
| ︙ | | |
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
|
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
-
+
+
|
(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)))
(tree-add-node (dboard:data-get-tests-tree *data*) "Runs" (append key-vals (list run-name))
userdata: (conc "run-id: " run-id))
(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))
|
| ︙ | | |
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
|
+
-
+
-
+
+
|
;; for each test name get the slot if it exists and fill in the cell
;; or take the next slot and fill in the cell, deal with items in the
;; run view panel? The run view panel can have a tree selector for
;; browsing the tests/items
;; SWITCH THIS TO USING CHANGED TESTS ONLY
(for-each (lambda (test)
(let* ((test-id (db:mintest-get-id test))
(let* ((state (db:mintest-get-state test))
(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))))
(list testname itempath)))
userdata: (conc "test-id: " test-id))
(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
|
| ︙ | | |