Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -679,11 +679,11 @@ (dboard:rundat-run-data-offset run-dat) ;; query offset num-to-get (dboard:tabdat-hide-not-hide tabdat) ;; no-in sort-by ;; sort-by sort-order ;; sort-order - #f ;; 'shortlist ;; qrytype + 'shortlist ;; qrytype (was #f) last-update ;; last-update *dashboard-mode*) ;; use dashboard mode '())) (use-new (dboard:tabdat-hide-not-hide tabdat)) (tests-ht (if (dboard:tabdat-filters-changed tabdat) @@ -691,11 +691,11 @@ (dboard:rundat-tests-set! run-dat ht) ht) (dboard:rundat-tests run-dat))) (got-all (< (length tmptests) num-to-get)) ;; got all for this round ) - + ;; (debug:print-info 0 *default-log-port* "got-all="got-all", (hash-table-size tests-ht)="(hash-table-size tests-ht)) ;; if we saw the db modified, reset it (the signal has already been used) (if (and got-all ;; (not multi-get) db-modified) (dboard:rundat-last-db-time-set! run-dat (- start-time 2))) @@ -990,65 +990,86 @@ (iup:attribute-set! lbl "TITLE" munged-val))) (iup:attribute-set! lbl "FGCOLOR" (if (hash-table-ref/default *collapsed* newval #f) "0 112 112" "0 0 0")) (if (< i maxn) (loop (+ i 1))))))) -;; + (define (get-itemized-tests test-dats) (let ((tnames '())) (for-each (lambda (tdat) (let ((tname (vector-ref tdat 0)) ;; (db:test-get-testname tdat)) (ipath (vector-ref tdat 1))) ;; (db:test-get-item-path tdat))) (if (not (equal? ipath "")) (if (and (list? tnames) (string? tname) (not (member tname tnames))) - (set! tnames (append tnames (list tname))))))) + (set! tnames (cons tname tnames)))))) test-dats) - tnames)) + (reverse tnames))) ;; Bubble up the top tests to above the items, collect the items underneath ;; all while preserving the sort order from the SQL query as best as possible. ;; (define (bubble-up tabdat test-dats #!key (priority 'itempath)) (if (null? test-dats) test-dats (begin (let* ((tnames '()) ;; list of names used to reserve order - (tests (make-hash-table)) ;; hash of lists, used to build as we go + (tests-ht (make-hash-table)) ;; hash of lists, used to build as we go (itemized (get-itemized-tests test-dats))) - (for-each + #;(for-each (lambda (testdat) (let* ((tname (vector-ref testdat 0)) ;; db:test-get-testname testdat)) (ipath (vector-ref testdat 1))) ;; db:test-get-item-path testdat))) - ;; (seen (hash-table-ref/default tests tname #f))) + ;; (seen (hash-table-ref/default tests-th tname #f))) (if (not (member tname tnames)) (if (or (and (eq? priority 'itempath) (not (equal? ipath ""))) (and (eq? priority 'testname) (equal? ipath "")) (not (member tname itemized))) (set! tnames (append tnames (list tname))))) (if (equal? ipath "") ;; This a top level, prepend it - (hash-table-set! tests tname (cons testdat (hash-table-ref/default tests tname '()))) + (hash-table-set! tests-ht tname (cons testdat (hash-table-ref/default tests-ht tname '()))) ;; This is item, append it - (hash-table-set! tests tname (append (hash-table-ref/default tests tname '())(list testdat)))))) + (hash-table-set! tests-ht tname (append (hash-table-ref/default tests-ht tname '())(list testdat)))))) + test-dats) + ;; 1. put all test/items into lists in tests-ht + (for-each + (lambda (testdat) + (let* ((tname (vector-ref testdat 0)) ;; db:test-get-testname testdat)) + (ipath (vector-ref testdat 1))) ;; db:test-get-item-path testdat))) + ;; (seen (hash-table-ref/default tests-ht tname #f))) + (if (not (member tname tnames)) + (if (or (and (eq? priority 'itempath) + (not (equal? ipath ""))) + (and (eq? priority 'testname) + (equal? ipath "")) + (not (member tname itemized))) + (set! tnames (append tnames (list tname))))) + (hash-table-set! tests-ht tname (cons testdat (hash-table-ref/default tests-ht tname '()))))) test-dats) + ;; now bubble up the non-item test in itemized tests + (hash-table-for-each + tests-ht + (lambda (k v) + (if (> (length v) 1) ;; must be itemized, push the no-item to the front + (hash-table-set! tests-ht k (sort v (lambda (a b)(not (equal? (vector-ref b 1) "")))))))) ;; Set all tests with items (dboard:tabdat-item-test-names-set! tabdat (append (if (null? tnames) '() (filter (lambda (tname) - (let ((tlst (hash-table-ref tests tname))) + (let ((tlst (hash-table-ref tests-ht tname))) (and (list tlst) (> (length tlst) 1)))) tnames)) (dboard:tabdat-item-test-names tabdat))) (let loop ((hed (car tnames)) (tal (cdr tnames)) (res '())) - (let ((newres (append res (hash-table-ref tests hed)))) + (let ((newres (append res (hash-table-ref tests-ht hed)))) (if (null? tal) newres (loop (car tal)(cdr tal) newres)))))))) ;; optimized to get runs constrained by what is visible on the screen