214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
(define (compare-tests test1 test2)
(let* ((test-name1 (db:test-testname test1))
(item-path1 (db:test-item-path test1))
(eventtime1 (db:test-event_time test1))
(test-name2 (db:test-testname test2))
(item-path2 (db:test-item-path test2))
(eventtime2 (db:test-event_time test2))
(same-name (equal? test-name1 test-name2))
(test1-top (equal? item-path1 ""))
(test2-top (equal? item-path2 ""))
(test1-older (> eventtime1 eventtime2))
(same-time (equal? eventtime1 eventtime2)))
(if same-name
|
|
|
|
|
|
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
(define (colors-similar? color1 color2)
(let* ((c1 (map string->number (string-split color1)))
(c2 (map string->number (string-split color2)))
(delta (map (lambda (a b)(abs (- a b))) c1 c2)))
(null? (filter (lambda (x)(> x 3)) delta))))
(define (compare-tests test1 test2)
(let* ((test-name1 (or (db:test-testname test1) ""))
(item-path1 (or (db:test-item-path test1) ""))
(eventtime1 (db:test-event_time test1))
(test-name2 (or (db:test-testname test2) ""))
(item-path2 (or (db:test-item-path test2) ""))
(eventtime2 (db:test-event_time test2))
(same-name (equal? test-name1 test-name2))
(test1-top (equal? item-path1 ""))
(test2-top (equal? item-path2 ""))
(test1-older (> eventtime1 eventtime2))
(same-time (equal? eventtime1 eventtime2)))
(if same-name
|
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
(if (< i maxn)
(loop (+ i 1)))))))
;;
(define (get-itemized-tests test-dats)
(let ((tnames '()))
(for-each (lambda (tdat)
(let ((tname (db:test-testname tdat)) ;; (db:test-get-testname tdat))
(ipath (db:test-item-path tdat) ) ) ;; (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)))))))
test-dats)
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 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
(itemized (get-itemized-tests test-dats)))
(for-each
(lambda (testdat)
(let* ((tname (db:test-testname tdat)) ;; (db:test-get-testname tdat))
(ipath (db:test-item-path tdat))) ;; (db:test-get-item-path tdat)))
;; (seen (hash-table-ref/default tests 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)))
|
|
|
|
|
|
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
(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-testname tdat)) ;; (db:test-get-testname tdat))
(ipath (vector-ref tdat 1))) ;; (db:test-item-path tdat) ) ) ;; (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)))))))
test-dats)
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 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
(itemized (get-itemized-tests test-dats)))
(for-each
(lambda (testdat)
(let* ((tname (vector-ref testdat 0)) ;; (db:test-testname tdat)) ;; (db:test-get-testname tdat))
(ipath (vector-ref testdat 1))) ;; (db:test-item-path tdat))) ;; (db:test-get-item-path tdat)))
;; (seen (hash-table-ref/default tests 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)))
|
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
|
(lambda (testname)
(let ((buttondat (hash-table-ref/default *buttondat* (mkstr coln rown) #f)))
(if buttondat
(let* ((test (let ((matching (filter
(lambda (x)(equal? (test:test-get-fullname x) testname))
testsdat)))
(if (null? matching)
(vector -1 -1 "" "" "" 0 "" "" 0 "" "" "" 0 "" "")
(car matching))))
(testname (db:test-testname test))
(itempath (db:test-item-path test))
(testfullname (test:test-get-fullname test))
(teststatus (db:test-status test))
(teststate (db:test-state test))
;;(teststart (db:test-event_time test))
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
|
(lambda (testname)
(let ((buttondat (hash-table-ref/default *buttondat* (mkstr coln rown) #f)))
(if buttondat
(let* ((test (let ((matching (filter
(lambda (x)(equal? (test:test-get-fullname x) testname))
testsdat)))
(if (null? matching)
(make-db:test id: -1
run_id: -1
testname: ""
state: ""
status: ""
event_time: 0
host: ""
cpuload: ""
diskfree: 0
uname: ""
rundir: ""
item-path: ""
run_duration: 0
final_logf: ""
comment: "")
(car matching))))
(testname (db:test-testname test))
(itempath (db:test-item-path test))
(testfullname (test:test-get-fullname test))
(teststatus (db:test-status test))
(teststate (db:test-state test))
;;(teststart (db:test-event_time test))
|