Commit | Line | Data |
---|---|---|
50d08cd8 CJY |
1 | ;;; srfi-41.test -- test suite for SRFI 41 |
2 | ||
3 | ;; Copyright (c) 2007 Philip L. Bewig | |
4 | ;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc. | |
5 | ||
6 | ;; Permission is hereby granted, free of charge, to any person obtaining | |
7 | ;; a copy of this software and associated documentation files (the | |
8 | ;; "Software"), to deal in the Software without restriction, including | |
9 | ;; without limitation the rights to use, copy, modify, merge, publish, | |
10 | ;; distribute, sublicense, and/or sell copies of the Software, and to | |
11 | ;; permit persons to whom the Software is furnished to do so, subject to | |
12 | ;; the following conditions: | |
13 | ;; | |
14 | ;; The above copyright notice and this permission notice shall be | |
15 | ;; included in all copies or substantial portions of the Software. | |
16 | ;; | |
17 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, | |
18 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES | |
19 | ;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND | |
20 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS | |
21 | ;; BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER LIABILITY, WHETHER IN AN | |
22 | ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF, OR IN | |
23 | ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE | |
24 | ;; SOFTWARE. | |
25 | ||
26 | (define-module (test-srfi-41) | |
27 | #:use-module (srfi srfi-1) | |
28 | #:use-module (srfi srfi-8) | |
29 | #:use-module (srfi srfi-26) | |
30 | #:use-module (srfi srfi-31) | |
31 | #:use-module (srfi srfi-41) | |
32 | #:use-module (test-suite lib)) | |
33 | ||
34 | (define-stream (qsort lt? strm) | |
35 | (if (stream-null? strm) stream-null | |
36 | (let ((x (stream-car strm)) | |
37 | (xs (stream-cdr strm))) | |
38 | (stream-append | |
39 | (qsort lt? (stream-filter (cut lt? <> x) xs)) | |
40 | (stream x) | |
41 | (qsort lt? (stream-filter (cut (negate lt?) <> x) xs)))))) | |
42 | ||
43 | (define-stream (isort lt? strm) | |
44 | (define-stream (insert strm x) | |
45 | (stream-match strm | |
46 | (() (stream x)) | |
47 | ((y . ys) (if (lt? y x) | |
48 | (stream-cons y (insert ys x)) | |
49 | (stream-cons x strm))))) | |
50 | (stream-fold insert stream-null strm)) | |
51 | ||
52 | (define-stream (stream-merge lt? . strms) | |
53 | (stream-let loop ((strms strms)) | |
54 | (cond ((null? strms) stream-null) | |
55 | ((null? (cdr strms)) (car strms)) | |
56 | (else (stream-let merge ((xx (car strms)) | |
57 | (yy (loop (cdr strms)))) | |
58 | (stream-match xx | |
59 | (() yy) | |
60 | ((x . xs) | |
61 | (stream-match yy | |
62 | (() xx) | |
63 | ((y . ys) | |
64 | (if (lt? y x) | |
65 | (stream-cons y (merge xx ys)) | |
66 | (stream-cons x (merge xs yy)))))))))))) | |
67 | ||
68 | (define-stream (msort lt? strm) | |
69 | (let* ((n (quotient (stream-length strm) 2)) | |
70 | (ts (stream-take n strm)) | |
71 | (ds (stream-drop n strm))) | |
72 | (if (zero? n) strm | |
73 | (stream-merge lt? (msort < ts) (msort < ds))))) | |
74 | ||
75 | (define-stream (stream-unique eql? strm) | |
76 | (if (stream-null? strm) stream-null | |
77 | (stream-cons (stream-car strm) | |
78 | (stream-unique eql? | |
79 | (stream-drop-while (cut eql? (stream-car strm) <>) strm))))) | |
80 | ||
81 | (define nats | |
82 | (stream-cons 1 | |
83 | (stream-map 1+ nats))) | |
84 | ||
85 | (define hamming | |
86 | (stream-unique = | |
87 | (stream-cons 1 | |
88 | (stream-merge < | |
89 | (stream-map (cut * 2 <>) hamming) | |
90 | (stream-merge < | |
91 | (stream-map (cut * 3 <>) hamming) | |
92 | (stream-map (cut * 5 <>) hamming)))))) | |
93 | ||
94 | (define primes (let () | |
95 | (define-stream (next base mult strm) | |
96 | (let ((first (stream-car strm)) | |
97 | (rest (stream-cdr strm))) | |
98 | (cond ((< first mult) | |
99 | (stream-cons first | |
100 | (next base mult rest))) | |
101 | ((< mult first) | |
102 | (next base (+ base mult) strm)) | |
103 | (else (next base | |
104 | (+ base mult) rest))))) | |
105 | (define-stream (sift base strm) | |
106 | (next base (+ base base) strm)) | |
107 | (stream-let sieve ((strm (stream-from 2))) | |
108 | (let ((first (stream-car strm)) | |
109 | (rest (stream-cdr strm))) | |
110 | (stream-cons first (sieve (sift first rest))))))) | |
111 | ||
112 | (define strm123 (stream 1 2 3)) | |
113 | ||
114 | (define (stream-equal? s1 s2) | |
115 | (cond ((and (stream-null? s1) (stream-null? s2)) #t) | |
116 | ((or (stream-null? s1) (stream-null? s2)) #f) | |
117 | ((equal? (stream-car s1) (stream-car s2)) | |
118 | (stream-equal? (stream-cdr s1) (stream-cdr s2))) | |
119 | (else #f))) | |
120 | ||
121 | (with-test-prefix "stream-null" | |
122 | (pass-if "is a stream" (stream? stream-null)) | |
123 | (pass-if "is a null stream" (stream-null? stream-null)) | |
124 | (pass-if "is not a stream pair" (not (stream-pair? stream-null)))) | |
125 | ||
126 | (with-test-prefix "stream-cons" | |
127 | (pass-if "is a stream" (stream? (stream-cons 1 stream-null))) | |
128 | (pass-if "is not a null stream" (not (stream-null? (stream-cons 1 stream-null)))) | |
129 | (pass-if "is a stream pair" (stream-pair? (stream-cons 1 stream-null)))) | |
130 | ||
131 | (with-test-prefix "stream?" | |
132 | (pass-if "is true for null stream" (stream? stream-null)) | |
133 | (pass-if "is true for stream pair" (stream? (stream-cons 1 stream-null))) | |
134 | (pass-if "is false for non-stream" (not (stream? "four")))) | |
135 | ||
136 | (with-test-prefix "stream-null?" | |
137 | (pass-if "is true for null stream" (stream-null? stream-null)) | |
138 | (pass-if "is false for stream pair" (not (stream-null? (stream-cons 1 stream-null)))) | |
139 | (pass-if "is false for non-stream" (not (stream-null? "four")))) | |
140 | ||
141 | (with-test-prefix "stream-pair?" | |
142 | (pass-if "is false for null stream" (not (stream-pair? stream-null))) | |
143 | (pass-if "is true for stream pair" (stream-pair? (stream-cons 1 stream-null))) | |
144 | (pass-if "is false for non-stream" (not (stream-pair? "four")))) | |
145 | ||
146 | (with-test-prefix "stream-car" | |
147 | (pass-if-exception "throws for non-stream" | |
148 | '(wrong-type-arg . "non-stream") | |
149 | (stream-car "four")) | |
150 | (pass-if-exception "throws for null stream" | |
151 | '(wrong-type-arg . "null stream") | |
152 | (stream-car stream-null)) | |
153 | (pass-if "returns first of stream" (eqv? (stream-car strm123) 1))) | |
154 | ||
155 | (with-test-prefix "stream-cdr" | |
156 | (pass-if-exception "throws for non-stream" | |
157 | '(wrong-type-arg . "non-stream") | |
158 | (stream-cdr "four")) | |
159 | (pass-if-exception "throws for null stream" | |
160 | '(wrong-type-arg . "null stream") | |
161 | (stream-cdr stream-null)) | |
162 | (pass-if "returns rest of stream" (eqv? (stream-car (stream-cdr strm123)) 2))) | |
163 | ||
164 | (with-test-prefix "stream-lambda" | |
165 | (pass-if "returns correct result" | |
166 | (stream-equal? | |
167 | ((rec double (stream-lambda (strm) | |
168 | (if (stream-null? strm) stream-null | |
169 | (stream-cons (* 2 (stream-car strm)) | |
170 | (double (stream-cdr strm)))))) | |
171 | strm123) | |
172 | (stream 2 4 6)))) | |
173 | ||
174 | (with-test-prefix "define-stream" | |
175 | (pass-if "returns correct result" | |
176 | (stream-equal? | |
177 | (let () | |
178 | (define-stream (double strm) | |
179 | (if (stream-null? strm) stream-null | |
180 | (stream-cons (* 2 (stream-car strm)) | |
181 | (double (stream-cdr strm))))) | |
182 | (double strm123)) | |
183 | (stream 2 4 6)))) | |
184 | ||
185 | (with-test-prefix "list->stream" | |
186 | (pass-if-exception "throws for non-list" | |
187 | '(wrong-type-arg . "non-list argument") | |
188 | (list->stream "four")) | |
189 | (pass-if "returns empty stream for empty list" | |
190 | (stream-null? (list->stream '()))) | |
191 | (pass-if "returns stream with same content as given list" | |
192 | (stream-equal? (list->stream '(1 2 3)) strm123))) | |
193 | ||
194 | (with-test-prefix "port->stream" | |
195 | (pass-if-exception "throws for non-input-port" | |
196 | '(wrong-type-arg . "non-input-port argument") | |
197 | (port->stream "four")) | |
198 | (call-with-input-string "Hello, world!" | |
199 | (lambda (p) | |
200 | (pass-if-equal "reads input string correctly" | |
201 | "Hello, world!" | |
202 | (list->string (stream->list (port->stream p))))))) | |
203 | ||
204 | (with-test-prefix "stream" | |
205 | (pass-if-equal "with empty stream" | |
206 | '() | |
207 | (stream->list (stream))) | |
208 | (pass-if-equal "with one-element stream" | |
209 | '(1) | |
210 | (stream->list (stream 1))) | |
211 | (pass-if-equal "with three-element stream" | |
212 | '(1 2 3) | |
213 | (stream->list strm123))) | |
214 | ||
215 | (with-test-prefix "stream->list" | |
216 | (pass-if-exception "throws for non-stream" | |
217 | '(wrong-type-arg . "non-stream argument") | |
218 | (stream->list '())) | |
219 | (pass-if-exception "throws for non-integer count" | |
220 | '(wrong-type-arg . "non-integer count") | |
221 | (stream->list "four" strm123)) | |
222 | (pass-if-exception "throws for negative count" | |
223 | '(wrong-type-arg . "negative count") | |
224 | (stream->list -1 strm123)) | |
225 | (pass-if-equal "returns empty list for empty stream" | |
226 | '() | |
227 | (stream->list (stream))) | |
228 | (pass-if-equal "without count" | |
229 | '(1 2 3) | |
230 | (stream->list strm123)) | |
231 | (pass-if-equal "with count longer than stream" | |
232 | '(1 2 3) | |
233 | (stream->list 5 strm123)) | |
234 | (pass-if-equal "with count shorter than stream" | |
235 | '(1 2 3) | |
236 | (stream->list 3 (stream-from 1)))) | |
237 | ||
238 | (with-test-prefix "stream-append" | |
239 | (pass-if-exception "throws for non-stream" | |
240 | '(wrong-type-arg . "non-stream argument") | |
241 | (stream-append "four")) | |
242 | (pass-if "with one stream" | |
243 | (stream-equal? (stream-append strm123) strm123)) | |
244 | (pass-if "with two streams" | |
245 | (stream-equal? (stream-append strm123 strm123) (stream 1 2 3 1 2 3))) | |
246 | (pass-if "with three streams" | |
247 | (stream-equal? (stream-append strm123 strm123 strm123) | |
248 | (stream 1 2 3 1 2 3 1 2 3))) | |
249 | (pass-if "append with null is noop" | |
250 | (stream-equal? (stream-append strm123 stream-null) strm123)) | |
251 | (pass-if "prepend with null is noop" | |
252 | (stream-equal? (stream-append stream-null strm123) strm123))) | |
253 | ||
254 | (with-test-prefix "stream-concat" | |
255 | (pass-if-exception "throws for non-stream" | |
256 | '(wrong-type-arg . "non-stream argument") | |
257 | (stream-concat "four")) | |
258 | (pass-if "with one stream" | |
259 | (stream-equal? (stream-concat (stream strm123)) strm123)) | |
260 | (pass-if "with two streams" | |
261 | (stream-equal? (stream-concat (stream strm123 strm123)) | |
262 | (stream 1 2 3 1 2 3)))) | |
263 | ||
264 | (with-test-prefix "stream-constant" | |
265 | (pass-if "circular stream of 1 has >100 elements" | |
266 | (eqv? (stream-ref (stream-constant 1) 100) 1)) | |
267 | (pass-if "circular stream of 2 has >100 elements" | |
268 | (eqv? (stream-ref (stream-constant 1 2) 100) 1)) | |
269 | (pass-if "circular stream of 3 repeats after 3" | |
270 | (eqv? (stream-ref (stream-constant 1 2 3) 3) 1)) | |
271 | (pass-if "circular stream of 1 repeats at 1" | |
272 | (stream-equal? (stream-take 8 (stream-constant 1)) | |
273 | (stream 1 1 1 1 1 1 1 1))) | |
274 | (pass-if "circular stream of 2 repeats at 2" | |
275 | (stream-equal? (stream-take 8 (stream-constant 1 2)) | |
276 | (stream 1 2 1 2 1 2 1 2))) | |
277 | (pass-if "circular stream of 3 repeats at 3" | |
278 | (stream-equal? (stream-take 8 (stream-constant 1 2 3)) | |
279 | (stream 1 2 3 1 2 3 1 2)))) | |
280 | ||
281 | (with-test-prefix "stream-drop" | |
282 | (pass-if-exception "throws for non-integer count" | |
283 | '(wrong-type-arg . "non-integer argument") | |
284 | (stream-drop "four" strm123)) | |
285 | (pass-if-exception "throws for negative count" | |
286 | '(wrong-type-arg . "negative argument") | |
287 | (stream-drop -1 strm123)) | |
288 | (pass-if-exception "throws for non-stream" | |
289 | '(wrong-type-arg . "non-stream argument") | |
290 | (stream-drop 2 "four")) | |
291 | (pass-if "returns null when given null" | |
292 | (stream-null? (stream-drop 0 stream-null))) | |
293 | (pass-if "returns same stream when count is zero" | |
294 | (eq? (stream-drop 0 strm123) strm123)) | |
295 | (pass-if "returns dropped-by-one stream when count is one" | |
296 | (stream-equal? (stream-drop 1 strm123) (stream 2 3))) | |
297 | (pass-if "returns null if count is longer than stream" | |
298 | (stream-null? (stream-drop 5 strm123)))) | |
299 | ||
300 | (with-test-prefix "stream-drop-while" | |
301 | (pass-if-exception "throws for invalid predicate" | |
302 | '(wrong-type-arg . "non-procedural argument") | |
303 | (stream-drop-while "four" strm123)) | |
304 | (pass-if-exception "throws for non-stream" | |
305 | '(wrong-type-arg . "non-stream argument") | |
306 | (stream-drop-while odd? "four")) | |
307 | (pass-if "returns null when given null" | |
308 | (stream-null? (stream-drop-while odd? stream-null))) | |
309 | (pass-if "returns dropped stream when first element matches" | |
310 | (stream-equal? (stream-drop-while odd? strm123) (stream 2 3))) | |
311 | (pass-if "returns whole stream when first element doesn't match" | |
312 | (stream-equal? (stream-drop-while even? strm123) strm123)) | |
313 | (pass-if "returns empty stream if all elements match" | |
314 | (stream-null? (stream-drop-while positive? strm123))) | |
315 | (pass-if "return whole stream if no elements match" | |
316 | (stream-equal? (stream-drop-while negative? strm123) strm123))) | |
317 | ||
318 | (with-test-prefix "stream-filter" | |
319 | (pass-if-exception "throws for invalid predicate" | |
320 | '(wrong-type-arg . "non-procedural argument") | |
321 | (stream-filter "four" strm123)) | |
322 | (pass-if-exception "throws for non-stream" | |
323 | '(wrong-type-arg . "non-stream argument") | |
324 | (stream-filter odd? '())) | |
325 | (pass-if "returns null when given null" | |
326 | (stream-null? (stream-filter odd? (stream)))) | |
327 | (pass-if "filters out even numbers" | |
328 | (stream-equal? (stream-filter odd? strm123) (stream 1 3))) | |
329 | (pass-if "filters out odd numbers" | |
330 | (stream-equal? (stream-filter even? strm123) (stream 2))) | |
331 | (pass-if "returns all elements if predicate matches all" | |
332 | (stream-equal? (stream-filter positive? strm123) strm123)) | |
333 | (pass-if "returns null if predicate matches none" | |
334 | (stream-null? (stream-filter negative? strm123))) | |
335 | (pass-if "all elements of an odd-filtered stream are odd" | |
336 | (every odd? (stream->list 10 (stream-filter odd? (stream-from 0))))) | |
337 | (pass-if "no elements of an odd-filtered stream are even" | |
338 | (not (any even? (stream->list 10 (stream-filter odd? (stream-from 0))))))) | |
339 | ||
340 | (with-test-prefix "stream-fold" | |
341 | (pass-if-exception "throws for invalid function" | |
342 | '(wrong-type-arg . "non-procedural argument") | |
343 | (stream-fold "four" 0 strm123)) | |
344 | (pass-if-exception "throws for non-stream" | |
345 | '(wrong-type-arg . "non-stream argument") | |
346 | (stream-fold + 0 '())) | |
347 | (pass-if "returns the correct result" (eqv? (stream-fold + 0 strm123) 6))) | |
348 | ||
349 | (with-test-prefix "stream-for-each" | |
350 | (pass-if-exception "throws for invalid function" | |
351 | '(wrong-type-arg . "non-procedural argument") | |
352 | (stream-for-each "four" strm123)) | |
353 | (pass-if-exception "throws if given no streams" exception:wrong-num-args | |
354 | (stream-for-each display)) | |
355 | (pass-if-exception "throws for non-stream" | |
356 | '(wrong-type-arg . "non-stream argument") | |
357 | (stream-for-each display "four")) | |
358 | (pass-if "function is called for stream elements" | |
359 | (eqv? (let ((sum 0)) | |
360 | (stream-for-each (lambda (x) | |
361 | (set! sum (+ sum x))) | |
362 | strm123) | |
363 | sum) | |
364 | 6))) | |
365 | ||
366 | (with-test-prefix "stream-from" | |
367 | (pass-if-exception "throws for non-numeric start" | |
368 | '(wrong-type-arg . "non-numeric starting number") | |
369 | (stream-from "four")) | |
370 | (pass-if-exception "throws for non-numeric step" | |
371 | '(wrong-type-arg . "non-numeric step size") | |
372 | (stream-from 1 "four")) | |
373 | (pass-if "works for default values" | |
374 | (eqv? (stream-ref (stream-from 0) 100) 100)) | |
375 | (pass-if "works for non-default start and step" | |
376 | (eqv? (stream-ref (stream-from 1 2) 100) 201)) | |
377 | (pass-if "works for negative step" | |
378 | (eqv? (stream-ref (stream-from 0 -1) 100) -100))) | |
379 | ||
380 | (with-test-prefix "stream-iterate" | |
381 | (pass-if-exception "throws for invalid function" | |
382 | '(wrong-type-arg . "non-procedural argument") | |
383 | (stream-iterate "four" 0)) | |
384 | (pass-if "returns correct iterated stream with 1+" | |
385 | (stream-equal? (stream-take 3 (stream-iterate 1+ 1)) strm123)) | |
386 | (pass-if "returns correct iterated stream with exact-integer-sqrt" | |
387 | (stream-equal? (stream-take 5 (stream-iterate exact-integer-sqrt 65536)) | |
388 | (stream 65536 256 16 4 2)))) | |
389 | ||
390 | (with-test-prefix "stream-length" | |
391 | (pass-if-exception "throws for non-stream" | |
392 | '(wrong-type-arg . "non-stream argument") | |
393 | (stream-length "four")) | |
394 | (pass-if "returns 0 for empty stream" (zero? (stream-length (stream)))) | |
395 | (pass-if "returns correct stream length" (eqv? (stream-length strm123) 3))) | |
396 | ||
397 | (with-test-prefix "stream-let" | |
398 | (pass-if "returns correct result" | |
399 | (stream-equal? | |
400 | (stream-let loop ((strm strm123)) | |
401 | (if (stream-null? strm) | |
402 | stream-null | |
403 | (stream-cons (* 2 (stream-car strm)) | |
404 | (loop (stream-cdr strm))))) | |
405 | (stream 2 4 6)))) | |
406 | ||
407 | (with-test-prefix "stream-map" | |
408 | (pass-if-exception "throws for invalid function" | |
409 | '(wrong-type-arg . "non-procedural argument") | |
410 | (stream-map "four" strm123)) | |
411 | (pass-if-exception "throws if given no streams" exception:wrong-num-args | |
412 | (stream-map odd?)) | |
413 | (pass-if-exception "throws for non-stream" | |
414 | '(wrong-type-arg . "non-stream argument") | |
415 | (stream-map odd? "four")) | |
416 | (pass-if "works for one stream" | |
417 | (stream-equal? (stream-map - strm123) (stream -1 -2 -3))) | |
418 | (pass-if "works for two streams" | |
419 | (stream-equal? (stream-map + strm123 strm123) (stream 2 4 6))) | |
420 | (pass-if "returns finite stream for finite first stream" | |
421 | (stream-equal? (stream-map + strm123 (stream-from 1)) (stream 2 4 6))) | |
422 | (pass-if "returns finite stream for finite last stream" | |
423 | (stream-equal? (stream-map + (stream-from 1) strm123) (stream 2 4 6))) | |
424 | (pass-if "works for three streams" | |
425 | (stream-equal? (stream-map + strm123 strm123 strm123) (stream 3 6 9)))) | |
426 | ||
427 | (with-test-prefix "stream-match" | |
428 | (pass-if-exception "throws for non-stream" | |
429 | '(wrong-type-arg . "non-stream argument") | |
430 | (stream-match '(1 2 3) (_ 'ok))) | |
431 | (pass-if-exception "throws when no pattern matches" | |
432 | '(match-error . "no matching pattern") | |
433 | (stream-match strm123 (() 42))) | |
434 | (pass-if-equal "matches empty stream correctly" | |
435 | 'ok | |
436 | (stream-match stream-null (() 'ok))) | |
437 | (pass-if-equal "matches non-empty stream correctly" | |
438 | 'ok | |
439 | (stream-match strm123 (() 'no) (else 'ok))) | |
440 | (pass-if-equal "matches stream of one element" | |
441 | 1 | |
442 | (stream-match (stream 1) (() 'no) ((a) a))) | |
443 | (pass-if-equal "matches wildcard" | |
444 | 'ok | |
445 | (stream-match (stream 1) (() 'no) ((_) 'ok))) | |
446 | (pass-if-equal "matches stream of three elements" | |
447 | '(1 2 3) | |
448 | (stream-match strm123 ((a b c) (list a b c)))) | |
449 | (pass-if-equal "matches first element with wildcard rest" | |
450 | 1 | |
451 | (stream-match strm123 ((a . _) a))) | |
452 | (pass-if-equal "matches first two elements with wildcard rest" | |
453 | '(1 2) | |
454 | (stream-match strm123 ((a b . _) (list a b)))) | |
455 | (pass-if-equal "rest variable matches as stream" | |
456 | '(1 2 3) | |
457 | (stream-match strm123 ((a b . c) (list a b (stream-car c))))) | |
458 | (pass-if-equal "rest variable can match whole stream" | |
459 | '(1 2 3) | |
460 | (stream-match strm123 (s (stream->list s)))) | |
461 | (pass-if-equal "successful guard match" | |
462 | 'ok | |
463 | (stream-match strm123 ((a . _) (= a 1) 'ok))) | |
464 | (pass-if-equal "unsuccessful guard match" | |
465 | 'no | |
466 | (stream-match strm123 ((a . _) (= a 2) 'yes) (_ 'no))) | |
467 | (pass-if-equal "unsuccessful guard match with two variables" | |
468 | 'no | |
469 | (stream-match strm123 ((a b c) (= a b) 'yes) (_ 'no))) | |
470 | (pass-if-equal "successful guard match with two variables" | |
471 | 'yes | |
472 | (stream-match (stream 1 1 2) ((a b c) (= a b) 'yes) (_ 'no)))) | |
473 | ||
474 | (with-test-prefix "stream-of" | |
475 | (pass-if "all 3 clause types work" | |
476 | (stream-equal? (stream-of (+ y 6) | |
477 | (x in (stream-range 1 6)) | |
478 | (odd? x) | |
479 | (y is (* x x))) | |
480 | (stream 7 15 31))) | |
481 | (pass-if "using two streams creates cartesian product" | |
482 | (stream-equal? (stream-of (* x y) | |
483 | (x in (stream-range 1 4)) | |
484 | (y in (stream-range 1 5))) | |
485 | (stream 1 2 3 4 2 4 6 8 3 6 9 12))) | |
486 | (pass-if "using no clauses returns just the expression" | |
487 | (stream-equal? (stream-of 1) (stream 1)))) | |
488 | ||
489 | (with-test-prefix "stream-range" | |
490 | (pass-if-exception "throws for non-numeric start" | |
491 | '(wrong-type-arg . "non-numeric starting number") | |
492 | (stream-range "four" 0)) | |
493 | (pass-if-exception "throws for non-numeric end" | |
494 | '(wrong-type-arg . "non-numeric ending number") | |
495 | (stream-range 0 "four")) | |
496 | (pass-if-exception "throws for non-numeric step" | |
497 | '(wrong-type-arg . "non-numeric step size") | |
498 | (stream-range 1 2 "three")) | |
499 | (pass-if "returns increasing range if start < end" | |
500 | (stream-equal? (stream-range 0 5) (stream 0 1 2 3 4))) | |
501 | (pass-if "returns decreasing range if start > end" | |
502 | (stream-equal? (stream-range 5 0) (stream 5 4 3 2 1))) | |
503 | (pass-if "returns increasing range of step 2" | |
504 | (stream-equal? (stream-range 0 5 2) (stream 0 2 4))) | |
505 | (pass-if "returns decreasing range of step 2" | |
506 | (stream-equal? (stream-range 5 0 -2) (stream 5 3 1))) | |
507 | (pass-if "returns empty range if start is past end value" | |
508 | (stream-null? (stream-range 0 1 -1)))) | |
509 | ||
510 | (with-test-prefix "stream-ref" | |
511 | (pass-if-exception "throws for non-stream" | |
512 | '(wrong-type-arg . "non-stream argument") | |
513 | (stream-ref '() 4)) | |
514 | (pass-if-exception "throws for non-integer index" | |
515 | '(wrong-type-arg . "non-integer argument") | |
516 | (stream-ref nats 3.5)) | |
517 | (pass-if-exception "throws for negative index" | |
518 | '(wrong-type-arg . "negative argument") | |
519 | (stream-ref nats -3)) | |
520 | (pass-if-exception "throws if index goes past end of stream" | |
521 | '(wrong-type-arg . "beyond end of stream") | |
522 | (stream-ref strm123 5)) | |
523 | (pass-if-equal "returns first element when index = 0" | |
524 | 1 | |
525 | (stream-ref nats 0)) | |
526 | (pass-if-equal "returns second element when index = 1" | |
527 | 2 | |
528 | (stream-ref nats 1)) | |
529 | (pass-if-equal "returns third element when index = 2" | |
530 | 3 | |
531 | (stream-ref nats 2))) | |
532 | ||
533 | (with-test-prefix "stream-reverse" | |
534 | (pass-if-exception "throws for non-stream" | |
535 | '(wrong-type-arg . "non-stream argument") | |
536 | (stream-reverse '())) | |
537 | (pass-if "returns null when given null" | |
538 | (stream-null? (stream-reverse (stream)))) | |
539 | (pass-if "returns (3 2 1) for (1 2 3)" | |
540 | (stream-equal? (stream-reverse strm123) (stream 3 2 1)))) | |
541 | ||
542 | (with-test-prefix "stream-scan" | |
543 | (pass-if-exception "throws for invalid function" | |
544 | '(wrong-type-arg . "non-procedural argument") | |
545 | (stream-scan "four" 0 strm123)) | |
546 | (pass-if-exception "throws for non-stream" | |
547 | '(wrong-type-arg . "non-stream argument") | |
548 | (stream-scan + 0 '())) | |
549 | (pass-if "returns the correct result" | |
550 | (stream-equal? (stream-scan + 0 strm123) (stream 0 1 3 6)))) | |
551 | ||
552 | (with-test-prefix "stream-take" | |
553 | (pass-if-exception "throws for non-stream" | |
554 | '(wrong-type-arg . "non-stream argument") | |
555 | (stream-take 5 "four")) | |
556 | (pass-if-exception "throws for non-integer index" | |
557 | '(wrong-type-arg . "non-integer argument") | |
558 | (stream-take "four" strm123)) | |
559 | (pass-if-exception "throws for negative index" | |
560 | '(wrong-type-arg . "negative argument") | |
561 | (stream-take -4 strm123)) | |
562 | (pass-if "returns null for empty stream" | |
563 | (stream-null? (stream-take 5 stream-null))) | |
564 | (pass-if "using 0 index returns null for empty stream" | |
565 | (stream-null? (stream-take 0 stream-null))) | |
566 | (pass-if "using 0 index returns null for non-empty stream" | |
567 | (stream-null? (stream-take 0 strm123))) | |
568 | (pass-if "returns first 2 elements of stream" | |
569 | (stream-equal? (stream-take 2 strm123) (stream 1 2))) | |
570 | (pass-if "returns whole stream when index is same as length" | |
571 | (stream-equal? (stream-take 3 strm123) strm123)) | |
572 | (pass-if "returns whole stream when index exceeds length" | |
573 | (stream-equal? (stream-take 5 strm123) strm123))) | |
574 | ||
575 | (with-test-prefix "stream-take-while" | |
576 | (pass-if-exception "throws for non-stream" | |
577 | '(wrong-type-arg . "non-stream argument") | |
578 | (stream-take-while odd? "four")) | |
579 | (pass-if-exception "throws for invalid predicate" | |
580 | '(wrong-type-arg . "non-procedural argument") | |
581 | (stream-take-while "four" strm123)) | |
582 | (pass-if "returns stream up to first non-matching item" | |
583 | (stream-equal? (stream-take-while odd? strm123) (stream 1))) | |
584 | (pass-if "returns empty stream if first item doesn't match" | |
585 | (stream-null? (stream-take-while even? strm123))) | |
586 | (pass-if "returns whole stream if every item matches" | |
587 | (stream-equal? (stream-take-while positive? strm123) strm123)) | |
588 | (pass-if "return empty stream if no item matches" | |
589 | (stream-null? (stream-take-while negative? strm123)))) | |
590 | ||
591 | (with-test-prefix "stream-unfold" | |
592 | (pass-if-exception "throws for invalid mapper" | |
593 | '(wrong-type-arg . "non-procedural mapper") | |
594 | (stream-unfold "four" odd? + 0)) | |
595 | (pass-if-exception "throws for invalid predicate" | |
596 | '(wrong-type-arg . "non-procedural pred?") | |
597 | (stream-unfold + "four" + 0)) | |
598 | (pass-if-exception "throws for invalid generator" | |
599 | '(wrong-type-arg . "non-procedural generator") | |
600 | (stream-unfold + odd? "four" 0)) | |
601 | ||
602 | (pass-if "returns the correct result" | |
603 | (stream-equal? (stream-unfold (cut expt <> 2) (cut < <> 10) 1+ 0) | |
604 | (stream 0 1 4 9 16 25 36 49 64 81)))) | |
605 | ||
606 | (with-test-prefix "stream-unfolds" | |
607 | (pass-if "returns the correct result" | |
608 | (stream-equal? (stream-unfolds | |
609 | (lambda (x) | |
610 | (receive (n s) (car+cdr x) | |
611 | (if (zero? n) | |
612 | (values 'dummy '()) | |
613 | (values | |
614 | (cons (- n 1) (stream-cdr s)) | |
615 | (list (stream-car s)))))) | |
616 | (cons 5 (stream-from 0))) | |
617 | (stream 0 1 2 3 4))) | |
618 | (pass-if "handles returns of multiple elements correctly" | |
619 | (stream-equal? (stream-take 16 (stream-unfolds | |
620 | (lambda (n) | |
621 | (values (1+ n) (iota n))) | |
622 | 1)) | |
623 | (stream 0 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0))) | |
624 | (receive (p np) | |
625 | (stream-unfolds (lambda (x) | |
626 | (receive (n p) (car+cdr x) | |
627 | (if (= n (stream-car p)) | |
628 | (values (cons (1+ n) (stream-cdr p)) | |
629 | (list n) #f) | |
630 | (values (cons (1+ n) p) | |
631 | #f (list n))))) | |
632 | (cons 1 primes)) | |
633 | (pass-if "returns first stream correctly" | |
634 | (stream-equal? (stream-take 15 p) | |
635 | (stream 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47))) | |
636 | (pass-if "returns second stream correctly" | |
637 | (stream-equal? (stream-take 15 np) | |
638 | (stream 1 4 6 8 9 10 12 14 15 16 18 20 21 22 24))))) | |
639 | ||
640 | (with-test-prefix "stream-zip" | |
641 | (pass-if-exception "throws if given no streams" exception:wrong-num-args | |
642 | (stream-zip)) | |
643 | (pass-if-exception "throws for non-stream" | |
644 | '(wrong-type-arg . "non-stream argument") | |
645 | (stream-zip "four")) | |
646 | (pass-if-exception "throws if any argument is non-stream" | |
647 | '(wrong-type-arg . "non-stream argument") | |
648 | (stream-zip strm123 "four")) | |
649 | (pass-if "returns null when given null as any argument" | |
650 | (stream-null? (stream-zip strm123 stream-null))) | |
651 | (pass-if "returns single-element lists when given one stream" | |
652 | (stream-equal? (stream-zip strm123) (stream '(1) '(2) '(3)))) | |
653 | (pass-if "returns double-element lists when given two streams" | |
654 | (stream-equal? (stream-zip strm123 strm123) | |
655 | (stream '(1 1) '(2 2) '(3 3)))) | |
656 | (pass-if "returns finite stream if at least one given stream is" | |
657 | (stream-equal? (stream-zip strm123 (stream-from 1)) | |
658 | (stream '(1 1) '(2 2) '(3 3)))) | |
659 | (pass-if "returns triple-element lists when given three streams" | |
660 | (stream-equal? (stream-zip strm123 strm123 strm123) | |
661 | (stream '(1 1 1) '(2 2 2) '(3 3 3))))) | |
662 | ||
663 | (with-test-prefix "other tests" | |
664 | (pass-if-equal "returns biggest prime under 1000" | |
665 | 997 | |
666 | (stream-car | |
667 | (stream-reverse (stream-take-while (cut < <> 1000) primes)))) | |
668 | ||
669 | (pass-if "quicksort returns same result as insertion sort" | |
670 | (stream-equal? (qsort < (stream 3 1 5 2 4)) | |
671 | (isort < (stream 2 5 1 4 3)))) | |
672 | ||
673 | (pass-if "merge sort returns same result as insertion sort" | |
674 | (stream-equal? (msort < (stream 3 1 5 2 4)) | |
675 | (isort < (stream 2 5 1 4 3)))) | |
676 | ||
677 | ;; http://www.research.att.com/~njas/sequences/A051037 | |
678 | (pass-if-equal "returns 1000th Hamming number" | |
679 | 51200000 | |
680 | (stream-ref hamming 999))) |