29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all)
(let* ((test-search-path (cons (conc *toppath* "/tests") ;; the default
(tests:get-tests-search-path *configdat*))))
(tests:get-valid-tests (make-hash-table) test-search-path)))
(define (tests:get-tests-search-path cfgdat)
(let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
(cons (conc *toppath* "/tests") paths)))
(define (tests:get-valid-tests test-registry tests-paths)
|
<
|
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
;; Call this one to do all the work and get a standardized list of tests
(define (tests:get-all)
(let* ((test-search-path (tests:get-tests-search-path *configdat*)))
(tests:get-valid-tests (make-hash-table) test-search-path)))
(define (tests:get-tests-search-path cfgdat)
(let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))
(cons (conc *toppath* "/tests") paths)))
(define (tests:get-valid-tests test-registry tests-paths)
|
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
|
(tests:testqueue-set-priority! b-record b-priority)
(if (and a-waitons (member (tests:testqueue-get-testname b-record) a-waitons))
#f ;; cannot have a which is waiting on b happening before b
(if (and b-waitons (member (tests:testqueue-get-testname a-record) b-waitons))
#t ;; this is the correct order, b is waiting on a and b is before a
(if (> a-priority b-priority)
#t ;; if a is a higher priority than b then we are good to go
#f))))))))
;; for each test:
;;
(define (tests:filter-non-runnable run-id testkeynames testrecordshash)
(let ((runnables '()))
(for-each
(lambda (testkeyname)
|
|
|
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
|
(tests:testqueue-set-priority! b-record b-priority)
(if (and a-waitons (member (tests:testqueue-get-testname b-record) a-waitons))
#f ;; cannot have a which is waiting on b happening before b
(if (and b-waitons (member (tests:testqueue-get-testname a-record) b-waitons))
#t ;; this is the correct order, b is waiting on a and b is before a
(if (> a-priority b-priority)
#t ;; if a is a higher priority than b then we are good to go
(string-compare3 a b)))))))))
;; for each test:
;;
(define (tests:filter-non-runnable run-id testkeynames testrecordshash)
(let ((runnables '()))
(for-each
(lambda (testkeyname)
|