implementation/srfi-64-minimal.scm


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)))))