26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(define (tests:get-valid-tests testsdir test-patts) ;; #!key (test-names '()))
(let ((tests (glob (conc testsdir "/tests/*")))) ;; " (string-translate patt "%" "*")))))
(set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
(delete-duplicates
(filter (lambda (testname)
(tests:match test-patts testname #f))
(map (lambda (testp)
(last (string-split testp "/")))
tests)))))
;; tests:glob-like-match
(define (tests:glob-like-match patt str)
(let ((like (substring-index "%" patt)))
(let* ((notpatt (equal? (substring-index "~" patt) 0))
|
|
>
>
>
>
>
|
|
|
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")
(define (tests:get-valid-tests testsdir test-patts) ;; #!key (test-names '()))
(let ((tests (glob (conc testsdir "/tests/*"))) ;; " (string-translate patt "%" "*")))))
;; strip off all itempatt portions
(modpat (string-intersperse
(map
(lambda (x)(first (string-split x "/")))
(string-split test-patts ",")) ",")))
(set! tests (filter (lambda (test)(file-exists? (conc test "/testconfig"))) tests))
(delete-duplicates
(filter (lambda (testname)
(tests:match modpat testname #f))
(map (lambda (testp) ;; extract the testname from <test>/testconfig
(last (string-split testp "/")))
tests)))))
;; tests:glob-like-match
(define (tests:glob-like-match patt str)
(let ((like (substring-index "%" patt)))
(let* ((notpatt (equal? (substring-index "~" patt) 0))
|