blob: c024f3a9f38e47c45c17325730c7f172880f771a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
51
52
53
54
55
56
57
58
59
60
|
#!/usr/bin/guile \
-s
!#
(eval-when (compile load)
(define here (dirname (current-filename))))
(format #t "current filename = ~a~%" here)
(add-to-load-path (format #f "~a/module"
(dirname here)))
(use-modules (ice-9 ftw)
(ice-9 sandbox)
(srfi srfi-64)
((util) :select (for)))
(define files
(scandir here
(lambda (name)
(and (< 2 (string-length name))
(not (string=? name (basename (current-filename))))
(string=? "scm" (string-take-right name 3))))))
;; Load tests
(define (read-multiple)
(let loop ((done '()))
(let ((sexp (read)))
(if (eof-object? sexp)
(reverse done)
(loop (cons sexp done))))))
;; TODO test-group fails if called before any test begin, since
;; (test-runner-current) needs to be a test-runner (dead or not),
;; but is initially bound to #f.
(test-begin "tests")
(for fname in files
(format (current-error-port) "Running test ~a~%" fname)
(test-group
fname
(with-input-from-file (string-append here "/" fname)
(lambda ()
(let ((modules (read)))
(eval-in-sandbox
`(begin ,@(read-multiple))
#:module (make-sandbox-module
(append modules
'(((srfi srfi-64) test-assert test-equal test-error)
((ice-9 ports) call-with-input-string)
((guile) make-struct/no-tail)
)
all-pure-bindings))))))))
(test-end "tests")
|
