Overview
| Comment: | Fixed divide by zero problem |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
cfdbfe1a4300c1cb9acd11a1651018f8 |
| User & Date: | mrwellan on 2015-10-08 08:47:57 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-10-08
| ||
| 09:13 | Added check for directory availability (to handle NFS quirk) before executing a test check-in: a22586ca18 user: mrwellan tags: v1.60 | |
| 08:47 | Fixed divide by zero problem check-in: cfdbfe1a43 user: mrwellan tags: v1.60 | |
|
2015-10-06
| ||
| 23:59 | Added some primitive arrows to dashboard tests display, played with different options on sort by waiton/priority but it seems to not be respected ... check-in: 01ebfc1ba9 user: matt tags: v1.60 | |
Changes
Modified dcommon.scm from [626e737efc] to [edd2f9b1a7].
| ︙ | ︙ | |||
593 594 595 596 597 598 599 | (define (dcommon:draw-arrow cnv test-box-center waiton-center) (let* ((test-box-center-x (vector-ref test-box-center 0)) (test-box-center-y (vector-ref test-box-center 1)) (waiton-center-x (vector-ref waiton-center 0)) (waiton-center-y (vector-ref waiton-center 1)) (delta-y (- waiton-center-y test-box-center-y)) (delta-x (- waiton-center-x test-box-center-x)) | > > | | | > > > > | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 | (define (dcommon:draw-arrow cnv test-box-center waiton-center) (let* ((test-box-center-x (vector-ref test-box-center 0)) (test-box-center-y (vector-ref test-box-center 1)) (waiton-center-x (vector-ref waiton-center 0)) (waiton-center-y (vector-ref waiton-center 1)) (delta-y (- waiton-center-y test-box-center-y)) (delta-x (- waiton-center-x test-box-center-x)) (abs-delta-x (abs delta-x)) (abs-delta-y (abs delta-y)) (use-delta-x (> abs-delta-x abs-delta-y)) ;; use the larger one (delta-ratio (if use-delta-x (if (> abs-delta-x 0) (/ abs-delta-y abs-delta-x) 1) (if (> abs-delta-y 0) (/ abs-delta-x abs-delta-y) 1))) (x-adj (if use-delta-x 8 (* delta-ratio 8))) (y-adj (if use-delta-x (* x-adj delta-ratio) 8)) (new-waiton-x (inexact->exact |
| ︙ | ︙ |
Modified tests.scm from [ed3dfc9807] to [86ae662ea5].
| ︙ | ︙ | |||
765 766 767 768 769 770 771 772 773 774 775 | ;; Move test specific stuff to a test unit FIXME one of these days (define (tests:sort-by-priority-and-waiton test-records) (let* ((mungepriority (lambda (priority) (if priority (let ((tmp (any->number priority))) (if tmp tmp (begin (debug:print 0 "ERROR: bad priority value " priority ", using 0") 0))) 0))) (sort-fn1 (lambda (a b) (let* ((a-record (hash-table-ref test-records a)) (b-record (hash-table-ref test-records b)) | > > > > > > > > > | | > > > > > > > > > > | > > > > > > > | > > > > > > > > < < < | < < < < | 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 |
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-records)
(let* ((mungepriority (lambda (priority)
(if priority
(let ((tmp (any->number priority)))
(if tmp tmp (begin (debug:print 0 "ERROR: bad priority value " priority ", using 0") 0)))
0)))
(all-tests (hash-table-keys test-records))
(all-waited-on (let loop ((hed (car all-tests))
(tal (cdr all-tests))
(res '()))
(let* ((trec (hash-table-ref test-records hed))
(waitons (or (tests:testqueue-get-waitons trec) '())))
(if (null? tal)
(append res waitons)
(loop (car tal)(cdr tal)(append res waitons))))))
(sort-fn1
(lambda (a b)
(let* ((a-record (hash-table-ref test-records a))
(b-record (hash-table-ref test-records b))
(a-waitons (or (tests:testqueue-get-waitons a-record) '()))
(b-waitons (or (tests:testqueue-get-waitons b-record) '()))
(a-config (tests:testqueue-get-testconfig a-record))
(b-config (tests:testqueue-get-testconfig b-record))
(a-raw-pri (config-lookup a-config "requirements" "priority"))
(b-raw-pri (config-lookup b-config "requirements" "priority"))
(a-priority (mungepriority a-raw-pri))
(b-priority (mungepriority b-raw-pri)))
(tests:testqueue-set-priority! a-record a-priority)
(tests:testqueue-set-priority! b-record b-priority)
(debug:print 0 "a=" a ", b=" b ", a-waitons=" a-waitons ", b-waitons=" b-waitons)
(cond
;; is
((member a b-waitons) ;; is b waiting on a?
(debug:print 0 "case1")
#t)
((member b a-waitons) ;; is a waiting on b?
(debug:print 0 "case2")
#f)
((and (not (null? a-waitons)) ;; both have waitons - do not disturb
(not (null? b-waitons)))
(debug:print 0 "case2.1")
#t)
((and (null? a-waitons) ;; no waitons for a but b has waitons
(not (null? b-waitons)))
(debug:print 0 "case3")
#f)
((and (not (null? a-waitons)) ;; a has waitons but b does not
(null? b-waitons))
(debug:print 0 "case4")
#t)
((not (eq? a-priority b-priority)) ;; use
(> a-priority b-priority))
(else
(debug:print 0 "case5")
(string>? a b))))))
(sort-fn2
(lambda (a b)
(> (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records a)))
(mungepriority (tests:testqueue-get-priority (hash-table-ref test-records b)))))))
(sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table
;; for each test:
;;
(define (tests:filter-non-runnable run-id testkeynames testrecordshash)
(let ((runnables '()))
(for-each
(lambda (testkeyname)
|
| ︙ | ︙ |