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

(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
                   "simple"
                   (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
                   "ignore"
                   (match '(1 2 3)
                     ((_ _ _ _) 0)
                     ((2 _ _) 1)
                     ((1 _ _) 2)
                     (_ 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)))