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)))
681