]> gitweb.factorcode.org Git - factor.git/blob - core/sequences/sequences-tests.factor
86624c0c19a0d0a1cd78b1eb1b4d12950b5c32af
[factor.git] / core / sequences / sequences-tests.factor
1 USING: arrays kernel math math.order math.parser namespaces
2 sequences kernel.private sequences.private strings sbufs
3 tools.test vectors assocs generic vocabs.loader ;
4 IN: sequences.tests
5
6 [ "empty" ] [ { } [ "empty" ] [ "not empty" ] if-empty ] unit-test
7 [ { 1 } "not empty" ] [ { 1 } [ "empty" ] [ "not empty" ] if-empty ] unit-test
8
9 [ V{ 1 2 3 4 } ] [ 1 5 dup iota <slice> >vector ] unit-test
10 [ 3 ] [ 1 4 dup iota <slice> length ] unit-test
11 [ 2 ] [ 1 3 { 1 2 3 4 } <slice> length ] unit-test
12 [ V{ 2 3 } ] [ 1 3 { 1 2 3 4 } <slice> >vector ] unit-test
13 [ V{ 4 5 } ] [ { 1 2 3 4 5 } 2 tail-slice* >vector ] unit-test
14 [ V{ 3 4 } ] [ 2 4 1 10 dup iota <slice> subseq >vector ] unit-test
15 [ V{ 3 4 } ] [ 0 2 2 4 1 10 dup iota <slice> <slice> subseq >vector ] unit-test
16 [ 0 10 "hello" <slice> ] must-fail
17 [ -10 3 "hello" <slice> ] must-fail
18 [ 2 1 "hello" <slice> ] must-fail
19
20 [ "cba" ] [ "abcdef" 3 head-slice reverse ] unit-test
21
22 [ 5040 ] [ [ 1 2 3 4 5 6 7 ] 1 [ * ] reduce ] unit-test
23
24 [ 5040 { 1 1 2 6 24 120 720 } ]
25 [ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate ] unit-test
26
27 [ 64 B{ 1 2 4 16 } ]
28 [ B{ 2 2 4 4 } 1 [ * ] accumulate ] unit-test
29
30 [ 5040 { 1 1 2 6 24 120 720 } ]
31 [ { 1 2 3 4 5 6 7 } 1 [ * ] accumulate! ] unit-test
32
33 [ t ]
34 [ { 1 2 3 4 5 6 7 } dup 1 [ * ] accumulate! nip eq? ] unit-test
35
36 [ f f ] [ [ ] [ ] find ] unit-test
37 [ 0 1 ] [ [ 1 ] [ ] find ] unit-test
38 [ 1 "world" ] [ [ "hello" "world" ] [ "world" = ] find ] unit-test
39 [ 2 3 ] [ [ 1 2 3 ] [ 2 > ] find ] unit-test
40 [ f f ] [ [ 1 2 3 ] [ 10 > ] find ] unit-test
41
42 [ 1 CHAR: e ]
43 [ "hello world" "aeiou" [ member? ] curry find ] unit-test
44
45 [ 4 CHAR: o ]
46 [ 3 "hello world" "aeiou" [ member? ] curry find-from ] unit-test
47
48 [ f f ] [ "abcd" [ 10 > nip ] find-index ] unit-test
49 [ f f ] [ "abcd" [ drop CHAR: e = ] find-index ] unit-test
50 [ 3 CHAR: d ] [ "abcdefg" [ 3 = nip ] find-index ] unit-test
51 [ 3 CHAR: d ] [ "abcdefg" [ drop CHAR: d = ] find-index ] unit-test
52
53 [ 0 CHAR: a ] [ 0 "abcdef" [ drop CHAR: a >= ] find-index-from ] unit-test
54 [ 1 CHAR: b ] [ 0 "abcdef" [ drop CHAR: a > ] find-index-from ] unit-test
55 [ 2 CHAR: c ] [ 1 "abcdef" [ drop CHAR: b > ] find-index-from ] unit-test
56
57 [ f ] [ 3 [ ]     member? ] unit-test
58 [ f ] [ 3 [ 1 2 ] member? ] unit-test
59 [ t ] [ 1 [ 1 2 ] member? ] unit-test
60 [ t ] [ 2 [ 1 2 ] member? ] unit-test
61
62 [ t ]
63 [ [ "hello" "world" ] [ second ] keep member-eq? ] unit-test
64
65 [ 4 ] [ CHAR: x "tuvwxyz" >vector index ] unit-test 
66
67 [ f ] [ CHAR: x 5 "tuvwxyz" >vector index-from ] unit-test 
68
69 [ f ] [ CHAR: a 0 "tuvwxyz" >vector index-from ] unit-test
70
71 [ f ] [ [ "Hello" { } 0.75 ] [ string? ] all? ] unit-test
72 [ t ] [ [ ] [ ] all? ] unit-test
73 [ t ] [ [ "hi" t 0.5 ] [ ] all? ] unit-test
74
75 [ [ 1 2 3 ] ] [ [ 1 4 2 5 3 6 ] [ 4 < ] filter ] unit-test
76 [ { 4 2 6 } ] [ { 1 4 2 5 3 6 } [ 2 mod 0 = ] filter ] unit-test
77
78 [ [ 3 ] ] [ [ 1 2 3 ] 2 [ swap < ] curry filter ] unit-test
79
80 [ V{ 1 2 3 } ] [ V{ 1 4 2 5 3 6 } clone [ 4 < ] filter! ] unit-test
81 [ V{ 4 2 6 } ] [ V{ 1 4 2 5 3 6 } clone [ 2 mod 0 = ] filter! ] unit-test
82
83 [ V{ 3 } ] [ V{ 1 2 3 } clone 2 [ swap < ] curry filter! ] unit-test
84
85 [ "hello world how are you" ]
86 [ { "hello" "world" "how" "are" "you" } " " join ]
87 unit-test
88
89 [ "" ] [ { } "" join ] unit-test
90
91 [ { } ] [ { } flip ] unit-test
92
93 [ { "b" "e" } ] [ 1 { { "a" "b" "c" } { "d" "e" "f" } } flip nth ] unit-test
94
95 [ { { 1 4 } { 2 5 } { 3 6 } } ]
96 [ { { 1 2 3 } { 4 5 6 } } flip ] unit-test
97
98 [ [ 2 3 4 ] ] [ [ 1 2 3 ] 1 [ + ] curry map ] unit-test
99
100 [ 1 ] [ 0 [ 1 2 ] nth ] unit-test
101 [ 2 ] [ 1 [ 1 2 ] nth ] unit-test
102
103 [ [ ]           ] [ [ ]   [ ]       append ] unit-test
104 [ [ 1 ]         ] [ [ 1 ] [ ]       append ] unit-test
105 [ [ 2 ]         ] [ [ ] [ 2 ]       append ] unit-test
106 [ [ 1 2 3 4 ]   ] [ [ 1 2 3 ] [ 4 ] append ] unit-test
107 [ [ 1 2 3 4 ]   ] [ [ 1 2 3 ] { 4 } append ] unit-test
108
109 [ "a" -1 append ] must-fail
110 [ -1 "a" append ] must-fail
111
112 [ [ ]       ] [ 1 [ ]           remove ] unit-test
113 [ [ ]       ] [ 1 [ 1 ]         remove ] unit-test
114 [ [ 3 1 1 ] ] [ 2 [ 3 2 1 2 1 ] remove ] unit-test
115
116 [ [ ]       ] [ [ ]       reverse ] unit-test
117 [ [ 1 ]     ] [ [ 1 ]     reverse ] unit-test
118 [ [ 3 2 1 ] ] [ [ 1 2 3 ] reverse ] unit-test
119
120 [ f ] [ f 0 head ] unit-test
121 [ [ ] ] [ [ 1 ] 0 head ] unit-test
122 [ [ 1 2 3 ] ] [ [ 1 2 3 4 ] 3 head ] unit-test
123 [ [ ] ] [ [ 1 2 3 ] 3 tail ] unit-test
124 [ [ 3 ] ] [ [ 1 2 3 ] 2 tail ] unit-test
125
126 [ "blah" ] [ "blahxx" 2 head* ] unit-test
127
128 [ "xx" ] [ "blahxx" 2 tail* ] unit-test
129
130 [ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice = ] unit-test
131 [ t ] [ "xxfoo" 2 head-slice "xxbar" 2 head-slice [ hashcode ] bi@ = ] unit-test
132
133 [ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* = ] unit-test
134 [ t ] [ "xxfoo" 2 head-slice SBUF" barxx" 2 tail-slice* [ hashcode ] bi@ = ] unit-test
135
136 [ t ] [ [ 1 2 3 ] [ 1 2 3 ] sequence= ] unit-test
137 [ t ] [ [ 1 2 3 ] { 1 2 3 } sequence= ] unit-test
138 [ t ] [ { 1 2 3 } [ 1 2 3 ] sequence= ] unit-test
139 [ f ] [ [ ] [ 1 2 3 ] sequence= ] unit-test
140
141 [ { 1 3 2 4 } ] [ { 1 2 3 4 } clone 1 2 pick exchange ] unit-test
142
143 [ { "" "a" "aa" "aaa" } ]
144 [ 4 [ CHAR: a <string> ] { } map-integers ]
145 unit-test
146
147 [ V{ } ] [ "f" V{ } clone remove! ] unit-test
148 [ V{ } ] [ "f" V{ "f" } clone remove! ] unit-test
149 [ V{ } ] [ "f" V{ "f" "f" } clone remove! ] unit-test
150 [ V{ "x" } ] [ "f" V{ "f" "x" "f" } clone remove! ] unit-test
151 [ V{ "y" "x" } ] [ "f" V{ "y" "f" "x" "f" } clone remove! ] unit-test
152
153 [ V{ 0 1 4 5 } ] [ 6 iota >vector 2 4 pick delete-slice ] unit-test
154
155 [ 6 >vector 2 8 pick delete-slice ] must-fail
156
157 [ V{ } ] [ 6 iota >vector 0 6 pick delete-slice ] unit-test
158
159 [ { 1 2 "a" "b" 5 6 7 } ] [
160     { "a" "b" } 2 4 { 1 2 3 4 5 6 7 }
161     replace-slice
162 ] unit-test
163
164 [ { 1 2 "a" "b" 6 7 } ] [
165     { "a" "b" } 2 5 { 1 2 3 4 5 6 7 }
166     replace-slice
167 ] unit-test
168
169 [ { 1 2 "a" "b" 4 5 6 7 } ] [
170     { "a" "b" } 2 3 { 1 2 3 4 5 6 7 }
171     replace-slice
172 ] unit-test
173
174 [ { 1 2 3 4 5 6 7 "a" "b" } ] [
175     { "a" "b" } 7 7 { 1 2 3 4 5 6 7 }
176     replace-slice
177 ] unit-test
178
179 [ { "a" 3 } ] [
180     { "a" } 0 2 { 1 2 3 } replace-slice
181 ] unit-test
182
183 [ { 1 4 9 } ] [ { 1 2 3 } clone [ sq ] map! ] unit-test
184
185 [ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
186 [ 5 ] [ 1 >bignum { 1 5 7 } nth-unsafe ] unit-test
187 [ 5 ] [ 1 >bignum "\u000001\u000005\u000007" nth-unsafe ] unit-test
188
189 [ SBUF" before&after" ] [
190     "&" 6 11 SBUF" before and after" replace-slice
191 ] unit-test
192
193 [ 3 "a" ] [ { "a" "b" "c" "a" "d" } [ "a" = ] find-last ] unit-test
194
195 [ f f ] [ 100 { 1 2 3 } [ 1 = ] find-from ] unit-test
196 [ f f ] [ 100 { 1 2 3 } [ 1 = ] find-last-from ] unit-test
197 [ f f ] [ -1 { 1 2 3 } [ 1 = ] find-from ] unit-test
198
199 [ 0 ] [ { "a" "b" "c" } { "A" "B" "C" } mismatch ] unit-test
200
201 [ 1 ] [ { "a" "b" "c" } { "a" "B" "C" } mismatch ] unit-test
202
203 [ f ] [ { "a" "b" "c" } { "a" "b" "c" } mismatch ] unit-test
204
205 [ V{ } V{ } ] [ { "a" "b" } { "a" "b" } drop-prefix [ >vector ] bi@ ] unit-test
206
207 [ V{ "C" } V{ "c" } ] [ { "a" "b" "C" } { "a" "b" "c" } drop-prefix [ >vector ] bi@ ] unit-test
208
209 [ -1 1 "abc" <slice> ] must-fail
210
211 [ V{ "a" "b" } V{ } ] [ { "X" "a" "b" } { "X" } drop-prefix [ >vector ] bi@ ] unit-test
212
213 [ 1 ] [ 0.5 { 1 2 3 } nth ] unit-test
214
215 ! Pathological case
216 [ "ihbye" ] [ "hi" <reversed> "bye" append ] unit-test
217
218 [ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
219
220 [ t ] [ "hi" <reversed> SBUF" hi" <reversed> = ] unit-test
221
222 [ t ] [ "hi" <reversed> SBUF" hi" <reversed> [ hashcode ] bi@ = ] unit-test
223
224 [ -10 "hi" "bye" copy ] must-fail
225 [ 10 "hi" "bye" copy ] must-fail
226
227 [ V{ 1 2 3 5 6 } ] [
228     3 V{ 1 2 3 4 5 6 } clone remove-nth!
229 ] unit-test
230
231 ! erg's random tester found this one
232 [ SBUF" 12341234" ] [
233     9 <sbuf> dup "1234" swap push-all dup dup swap push-all
234 ] unit-test
235
236 [ f ] [ f V{ } like f V{ } like eq? ] unit-test
237
238 [ V{ f f f } ] [ 3 V{ } new-sequence ] unit-test
239 [ SBUF" \0\0\0" ] [ 3 SBUF" " new-sequence ] unit-test
240
241 [ 0 ] [ f length ] unit-test
242 [ f first ] must-fail
243 [ 3 ] [ 3 10 iota nth ] unit-test
244 [ 3 ] [ 3 10 iota nth-unsafe ] unit-test
245 [ -3 10 iota nth ] must-fail
246 [ 11 10 iota nth ] must-fail
247
248 [ f ] [ f ?first ] unit-test
249 [ f ] [ { } ?first ] unit-test
250 [ 0 ] [ 10 iota ?first ] unit-test
251
252 [ f ] [ f ?last ] unit-test
253 [ f ] [ { } ?last ] unit-test
254 [ 9 ] [ 10 iota ?last ] unit-test
255
256 [ -1/0. 0 remove-nth! ] must-fail
257 [ "" ] [ "" [ CHAR: \s = ] trim ] unit-test
258 [ "" ] [ "" [ CHAR: \s = ] trim-head ] unit-test
259 [ "" ] [ "" [ CHAR: \s = ] trim-tail ] unit-test
260 [ "" ] [ "  " [ CHAR: \s = ] trim-head ] unit-test
261 [ "" ] [ "  " [ CHAR: \s = ] trim-tail ] unit-test
262 [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test
263 [ "asdf " ] [ " asdf " [ CHAR: \s = ] trim-head ] unit-test
264 [ " asdf" ] [ " asdf " [ CHAR: \s = ] trim-tail ] unit-test
265
266 [ 328350 ] [ 100 iota [ sq ] map-sum ] unit-test
267
268 [ 50 ] [ 100 iota [ even? ] count ] unit-test
269 [ 50 ] [ 100 iota [ odd?  ] count ] unit-test
270
271 [ { "b" "d" } ] [ { 1 3 } { "a" "b" "c" "d" } nths ] unit-test
272 [ { "a" "b" "c" "d" } ] [ { 0 1 2 3 } { "a" "b" "c" "d" } nths ] unit-test
273 [ { "d" "c" "b" "a" } ] [ { 3 2 1 0 } { "a" "b" "c" "d" } nths ] unit-test
274 [ { "d" "a" "b" "c" } ] [ { 3 0 1 2 } { "a" "b" "c" "d" } nths ] unit-test
275
276 [ "dac" ] [ { 3 0 2 } "abcd" nths ] unit-test
277                           
278 TUPLE: bogus-hashcode ;
279
280 M: bogus-hashcode hashcode* 2drop 0 >bignum ;
281
282 [ 0 ] [ { T{ bogus-hashcode } } hashcode ] unit-test
283
284 [ { 2 4 6 } { 1 3 5 7 } ] [ { 1 2 3 4 5 6 7 } [ even? ] partition ] unit-test
285
286 [ { 1 3 7 } ] [ 2 { 1 3 5 7 } remove-nth ] unit-test
287
288 [ { 1 3 "X" 5 7 } ] [ "X" 2 { 1 3 5 7 } insert-nth ] unit-test
289
290 [ V{ 0 2 } ] [ "a" { "a" "b" "a" } indices ] unit-test
291
292 [ "a,b" ] [ "a" "b" "," glue ] unit-test
293 [ "(abc)" ] [ "abc" "(" ")" surround ] unit-test
294
295 [ "HELLO" ] [
296     "HELLO" { -1 -1 -1 -1 -1 } { 2 2 2 2 2 2 }
297     [ * 2 + + ] 3map
298 ] unit-test
299
300 { 3 1 } [ [ 3array ] 3map ] must-infer-as
301
302 { 3 0 } [ [ 3drop ] 3each ] must-infer-as
303
304 [ V{ 0 3 } ] [ "A" { "A" "B" "C" "A" "D" } indices ] unit-test
305
306 [ "asdf" iota ] must-fail
307 [ T{ iota { n 10 } } ] [ 10 iota ] unit-test
308 [ 0 ] [ 10 iota first ] unit-test
309
310 [ "hi" 3 ] [
311     { 1 2 3 4 5 6 7 8 } [ H{ { 3 "hi" } } at ] map-find
312 ] unit-test
313
314 [ f f ] [
315     { 1 2 3 4 5 6 7 8 } [ H{ { 11 "hi" } } at ] map-find
316 ] unit-test
317
318 USE: make
319
320 [ { "a" 1 "b" 1 "c" } ]
321 [ 1 { "a" "b" "c" } [ [ dup , ] [ , ] interleave drop ] { } make ] unit-test
322
323 [ t ] [ 0 array-capacity? ] unit-test
324 [ f ] [ -1 array-capacity? ] unit-test
325
326 [ +lt+ ] [ { 0 0 0 } { 1 1 1 } <=> ] unit-test
327 [ +lt+ ] [ { 0 0 0 } { 0 1 1 } <=> ] unit-test
328 [ +lt+ ] [ { 0 0 0 } { 0 0 0 0 } <=> ] unit-test
329 [ +gt+ ] [ { 1 1 1 } { 0 0 0 } <=> ] unit-test
330 [ +gt+ ] [ { 0 1 1 } { 0 0 0 } <=> ] unit-test
331 [ +gt+ ] [ { 0 0 0 0 } { 0 0 0 } <=> ] unit-test
332 [ +eq+ ] [ { } { } <=> ] unit-test
333 [ +eq+ ] [ { 1 2 3 } { 1 2 3 } <=> ] unit-test
334
335 [ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
336 [ { 1 2 } { "a" "b" } cartesian-product ] unit-test
337
338 [ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
339 [ { } [ ] [ + ] map-reduce ] must-fail
340 [ 4 ] [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
341
342 [ { } { } [ [ string>digits product ] bi@ + ] [ + ] 2map-reduce ] must-infer
343 [ { } { } [ + ] [ + ] 2map-reduce ] must-fail
344 [ 24 ] [ { 1 2 } { 3 4 } [ + ] [ * ] 2map-reduce ] unit-test