blob: 681a7c0a810b62a9894064a7fd16f7fd1a238d9a (
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
(import (scheme base)
(only (csc testing)
subtest
define-test
errorf)
(csc vec))
(define-test (test-vec t)
(define-record-type <test-case>
(test-case desc args want)
test-case?
(desc desc)
(args args)
(want want))
(let ((tests (list
(test-case
"empty"
'()
'())
(test-case
"singleton"
'(1)
'(1)))))
(for-each
(lambda (tc)
(subtest t (desc tc)
(let ((got (apply vec (args tc))))
(unless (equal? (vec->list got) (want tc))
(errorf t "(apply vec {}) = {}, want {}." (args tc) got (want tc)))
(unless (equal? (vec-length got) (length (want tc)))
(errorf t "(apply vec {}) length = {}, want {}." (args tc) (vec-length got) (length (want tc)))))))
tests)))
(define-test (test-vec-append t)
(define-record-type <test-case>
(test-case desc in arg want)
test-case?
(desc desc)
(in in)
(arg arg)
(want want))
(let ((tests (list
(test-case
"append to empty"
'()
1
'(1))
(test-case
"append to singleton"
'(1)
2
'(1 2))
(test-case
"append to 2-elem"
'(1 2)
3
'(1 2 3)))))
(for-each
(lambda (tc)
(subtest t (desc tc)
(let* ((v (list->vec (in tc)))
(got (vec-append v (arg tc))))
(unless (equal? (vec->list got) (want tc))
(errorf t "(vec-append {} {}) = {}, want {}." v (arg tc) got (want tc))))))
tests)))
(define-test (test-vec-ref t)
(define-record-type <test-case>
(test-case desc xs k want)
test-case?
(desc desc)
(xs xs)
(k k)
(want want))
(let ((tests (list
(test-case
"1"
'(1 2)
1
2)
(test-case
"singleton"
'(1)
0
1))))
(for-each
(lambda (tc)
(let ((got (vec-ref (list->vec (xs tc)) (k tc))))
(unless (= got (want tc))
(errorf t "(vec-ref {} {}) = {}, want {}." (xs tc) (k tc) got (want tc)))))
tests)))
|
