Return #f from testbench of no test procedures available
This commit is contained in:
parent
2cd32319fc
commit
b5d2b12863
19
utest.scm
19
utest.scm
@ -620,12 +620,23 @@
|
|||||||
(define (collect-test-procs files)
|
(define (collect-test-procs files)
|
||||||
(fold
|
(fold
|
||||||
(lambda (f procs)
|
(lambda (f procs)
|
||||||
(let ((f (path->absolute f)))
|
(let* ((f (path->absolute f))
|
||||||
|
(base (dirname f)))
|
||||||
(append
|
(append
|
||||||
procs
|
procs
|
||||||
(map (lambda (proc) (list proc (dirname f) (basename f)))
|
(filter
|
||||||
(let ((procs (load f)))
|
car
|
||||||
(if (list? procs) procs (list procs)))))))
|
(map (lambda (proc) (list proc base (basename f)))
|
||||||
|
(let ((procs
|
||||||
|
(parameterize ((utest/base-path base)
|
||||||
|
(utest/work-path #f))
|
||||||
|
(load f))))
|
||||||
|
(if procs
|
||||||
|
(if (list? procs) procs
|
||||||
|
(if (procedure? procs)
|
||||||
|
(list procs)
|
||||||
|
'(#f)))
|
||||||
|
'(#f))))))))
|
||||||
'() files))
|
'() files))
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user