blob: e60632bd4bd53f24eb9deaded38834be0cf2cdba (
plain) (
blame)
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
|
; Just enough of SRFI 64 (unit tests) to run test.scm.
(define *test-failures* '())
(define (test-begin name)
(newline)
(display "Test group: ")
(display name)
(newline)
(newline))
(define (test-end name)
(newline)
(cond
((null? *test-failures*)
(display "All tests passed!")
(newline)
(newline)
(exit 0))
(else
(write (length *test-failures*))
(display " TEST(S) FAILED:")
(newline)
(for-each (lambda (x) (x)) (reverse *test-failures*))
(newline)
(exit 1))))
(define (%test-equal name expected actual)
(cond
((equal? expected actual)
(display "pass: "))
(else
(set! *test-failures*
(cons
(lambda ()
(display name)
(display ": Expected ")
(write expected)
(display ", got ")
(write actual)
(newline))
*test-failures*))
(display "FAIL: ")))
(display name)
(newline))
(define-syntax test-equal
(syntax-rules ()
((_ name expected actual)
(%test-equal name expected (guard (e (#t e)) actual)))))
|