nendo 0.6.8 → 0.7.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -1,178 +0,0 @@
1
- ;;-*- mode: nendo; syntax: scheme -*-;;
2
- ;;
3
- ;; util-list-test.nnd - test suite for util.list
4
- ;;
5
- ;; Copyright (c) 2000-2010 Shiro Kawai <shiro@acm.org>
6
- ;;
7
- ;; Redistribution and use in source and binary forms, with or without
8
- ;; modification, are permitted provided that the following conditions
9
- ;; are met:
10
- ;;
11
- ;; 1. Redistributions of source code must retain the above copyright
12
- ;; notice, this list of conditions and the following disclaimer.
13
- ;;
14
- ;; 2. Redistributions in binary form must reproduce the above copyright
15
- ;; notice, this list of conditions and the following disclaimer in the
16
- ;; documentation and/or other materials provided with the distribution.
17
- ;;
18
- ;; 3. Neither the name of the authors nor the names of its contributors
19
- ;; may be used to endorse or promote products derived from this
20
- ;; software without specific prior written permission.
21
- ;;
22
- ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23
- ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24
- ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
25
- ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
26
- ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
27
- ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
28
- ;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29
- ;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30
- ;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31
- ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32
- ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33
-
34
-
35
- (use nendo.test)
36
- (test-start "util")
37
-
38
- ;;===================================================================
39
- ;;-------------------------------------------------------------------
40
-
41
- (test-section "util.list")
42
- (use util.list)
43
- (test-module 'util.list)
44
-
45
- (test* "split-at* (normal)" '((a b c) (d))
46
- (receive r (split-at* '(a b c d) 3) r))
47
- (test* "split-at* (boundary)" '(() (a b c d))
48
- (receive r (split-at* '(a b c d) 0) r))
49
- (test* "split-at* (boundary)" '((a b c d) ())
50
- (receive r (split-at* '(a b c d) 4) r))
51
- (test* "split-at* (error)" (test-error)
52
- (receive r (split-at* '(a b c d) -1) r))
53
- (test* "split-at* (shorten)" '((a b c d) ())
54
- (receive r (split-at* '(a b c d) 5) r))
55
- (test* "split-at* (fill)" '((a b c d #f #f) ())
56
- (receive r (split-at* '(a b c d) 6 #t) r))
57
- (test* "split-at* (fill)" '((a b c d z z) ())
58
- (receive r (split-at* '(a b c d) 6 #t 'z) r))
59
-
60
- (test* "take* (normal)" '(a b c) (take* '(a b c d) 3))
61
- (test* "take* (boundary)" '() (take* '(a b c d) 0))
62
- (test* "take* (boundary)" '(a b c d) (take* '(a b c d) 4))
63
- (test* "take* (error)" (test-error) (take* '(a b c d) -1))
64
- (test* "take* (shorten)" '(a b c d) (take* '(a b c d) 5))
65
- (test* "take* (fill)" '(a b c d #f #f) (take* '(a b c d) 6 #t))
66
- (test* "take* (fill)" '(a b c d z z) (take* '(a b c d) 6 #t 'z))
67
-
68
- (test* "drop* (normal)" '(c d) (drop* '(a b c d) 2))
69
- (test* "drop* (boundary)" '(a b c d) (drop* '(a b c d) 0))
70
- (test* "drop* (boundary)" '() (drop* '(a b c d) 4))
71
- (test* "drop* (error)" (test-error) (drop* '(a b c d) -3))
72
- (test* "drop* (past)" '() (drop* '(a b c d) 5))
73
-
74
- (test* "take-right* (normal)" '(b c d) (take-right* '(a b c d) 3))
75
- (test* "take-right* (boundary)" '() (take-right* '(a b c d) 0))
76
- (test* "take-right* (boundary)" '(a b c d) (take-right* '(a b c d) 4))
77
- (test* "take-right* (error)" (test-error) (take-right* '(a b c d) -1))
78
- (test* "take-right* (shorten)" '(a b c d) (take-right* '(a b c d) 6))
79
- (test* "take-right* (fill)" '(z z a b c d) (take-right* '(a b c d) 6 #t 'z))
80
-
81
- (test* "drop-right* (normal)" '(a b c) (drop-right* '(a b c d) 1))
82
- (test* "drop-right* (boundary)" '() (drop-right* '(a b c d) 4))
83
- (test* "drop-right* (boundary)" '(a b c d) (drop-right* '(a b c d) 0))
84
- (test* "drop-right* (error)" (test-error) (drop-right* '(a b c d) -1))
85
- (test* "drop-right* (past)" '() (drop-right* '(a b c d) 7))
86
-
87
- (test* "slices (normal)" '((0 1 2 3) (4 5 6 7) (8 9 10 11) (12 13 14 15))
88
- (slices (iota 16) 4))
89
- (test* "slices (boundary)" '()
90
- (slices '() 4))
91
- (test* "slices (short)" '((0 1 2 3) (4 5 6 7) (8 9 10 11) (12))
92
- (slices (iota 13) 4))
93
- (test* "slices (short)" '((0 1))
94
- (slices (iota 2) 4))
95
- (test* "slices (fill)" '((0 1 2 3) (4 5 6 7) (8 9 10 11) (12 #f #f #f))
96
- (slices (iota 13) 4 #t))
97
- (test* "slices (fill)" '((0 1 2 3) (4 5 6 7) (8 9 10 11) (12 -1 -1 -1))
98
- (slices (iota 13) 4 #t -1))
99
-
100
- (test* "intersperse" '(1 + 2 + 3) (intersperse '+ '(1 2 3)))
101
- (test* "intersperse" '(1 + 2) (intersperse '+ '(1 2)))
102
- (test* "intersperse" '(1) (intersperse '+ '(1)))
103
- (test* "intersperse" '() (intersperse '+ '()))
104
-
105
- (test* "cond-list" '() (cond-list))
106
- (test* "cond-list" '(a) (cond-list ('a)))
107
- (test* "cond-list" '(a) (cond-list (#t 'a) (#f 'b)))
108
- (test* "cond-list" '(b) (cond-list (#f 'a) (#t 'b)))
109
- (test* "cond-list" '(a b d) (cond-list (#t 'a) (#t 'b) (#f 'c) (#t 'd)))
110
- (test* "cond-list" '((b)) (cond-list (#f 'a) ('b => list)))
111
- (test* "cond-list" '(a b c d x)
112
- (cond-list (#t @ '(a b)) (#t @ '(c d)) (#f @ '(e f))
113
- ('x => @ list)))
114
-
115
- (test* "alist->hash-table" '(a b)
116
- (let ((ht (alist->hash-table '((5 . b) (3 . a)) 'eqv?)))
117
- (list (hash-table-get ht 3)
118
- (hash-table-get ht 5))))
119
- (when #f
120
- ;; Nendo does not support equal? for hash-table key compare
121
- (test* "hash-table->alist" '(("a" . 3) ("b" . 5))
122
- (let ((a (hash-table->alist
123
- (hash-table 'equal? '("a" . 3) '("b" . 5)))))
124
- (list (assoc "a" a)
125
- (assoc "b" a)))))
126
-
127
- (test* "rassoc" '(5 . "b")
128
- (rassoc "b" '((3 . "a") (5 . "b"))))
129
- (test* "rassq" '(5 . b)
130
- (rassq 'b '((3 . a) (5 . b))))
131
- (test* "rassv" '("b" . 5)
132
- (rassoc 5 '(("a" . 3) ("b" . 5))))
133
-
134
- (when #f
135
- ;; Nendo does not support (XassX alist obj) argument sequences.
136
- (test* "assoc-ref" 5
137
- (assoc-ref '(("a" . 3) ("b" . 5)) "b"))
138
- (test* "assoc-ref" 7
139
- (assoc-ref '(("a" . 3) ("b" . 5)) "c" 7))
140
- (test* "assq-ref" 5
141
- (assq-ref '((a . 3) (b . 5)) 'b))
142
- (test* "assq-ref" 7
143
- (assq-ref '((a . 3) (b . 5)) 'c 7))
144
- (test* "assv-ref" 'b
145
- (assv-ref '((3 . a) (5 . b)) 5))
146
- (test* "assv-ref" 'c
147
- (assv-ref '((3 . a) (5 . b)) 7 'c))
148
-
149
- (test* "rassoc-ref" 5
150
- (rassoc-ref '((3 . "a") (5 . "b")) "b"))
151
- (test* "rassoc-ref" 7
152
- (rassoc-ref '((3 . "a") (5 . "b")) "c" 7))
153
- (test* "rassq-ref" 5
154
- (rassq-ref '((3 . a) (5 . b)) 'b))
155
- (test* "rassq-ref" #f
156
- (rassq-ref '((3 . a) (5 . b)) 'c))
157
- (test* "rassv-ref" 'b
158
- (rassv-ref '((a . 3) (b . 5)) 5))
159
- (test* "rassv-ref" #f
160
- (rassv-ref '((a . 3) (b . 5)) 7))
161
-
162
- (test* "assoc-set!" '(("a" . 3) ("b" . 9))
163
- (assoc-set! (list (cons "a" 3) (cons "b" 5)) "b" 9))
164
- (test* "assoc-set!" '(("c" . 9) ("a" . 3) ("b" . 5))
165
- (assoc-set! (list (cons "a" 3) (cons "b" 5)) "c" 9))
166
- (test* "assq-set!" '((a . 3) (b . 9))
167
- (assq-set! (list (cons 'a 3) (cons 'b 5)) 'b 9))
168
- (test* "assq-set!" '((c . 9) (a . 3) (b . 5))
169
- (assq-set! (list (cons 'a 3) (cons 'b 5)) 'c 9))
170
- (test* "assv-set!" '((3 . a) (5 . c))
171
- (assv-set! (list (cons 3 'a) (cons 5 'b)) 5 'c))
172
- (test* "assv-set!" '((9 . c) (3 . a) (5 . b))
173
- (assv-set! (list (cons 3 'a) (cons 5 'b)) 9 'c)))
174
-
175
-
176
-
177
- ;;===================================================================
178
- (test-end)