match-test.csc


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
61
62
63

(import (scheme base)
        (only (csc testing) define-test errorf subtest)
        (csc match))


(define-test (test-match t)
  (define-record-type <test-case>
    (test-case name expr want)
    test-case?
    (name name)
    (expr expr)
    (want want))
  (let ((tests (list
                 (test-case
                   "cond"
                   (match 3
                     ((! 0) 0)
                     ((! 1) 1)
                     ((! 2) 2)
                     ((! 3) 3)
                     (_ 4))
                   3)
                 (test-case
                   "match-list"
                   (match '(1 2 3)
                     ('() 0)
                     (((! 1) (! 2)) 1)
                     (((! 1) (! 2) (! 3)) 2)
                     (((! 1) (! 2) (! 3) (! 4)) 3)
                     (_ 4))
                   2)
                 (test-case
                   "binding"
                   (match '(1 2 3)
                     (((! 1) x (! 3)) x))
                   2)
                 (test-case
                   "destructuring"
                   (match '(1 2 3)
                     ('() 0)
                     ((head . _) head))
                   1)
                 (test-case
                   "ignore"
                   (match '(1 2 3)
                     ((_ _ _ _) 0)
                     (((! 2) _ _) 1)
                     (((! 1) _ _) 2)
                     (_ 3))
                   2)
                 (test-case
                   "improper list"
                   (match '(1 2 3)
                     (((! 2) . _) 1)
                     (((! 1) . x) (car x))
                     (_ 3))
                   2))))
    (for-each
      (lambda (tc)
        (subtest t (name tc)
          (unless (equal? (expr tc) (want tc))
            (errorf t "match = {}, want {}." (expr tc) (want tc)))))
      tests)))