path: root/test-suite/tests/srfi-41.test

;;; srfi-41.test -- test suite for SRFI 41

;; Copyright (c) 2007 Philip L. Bewig
;; Copyright (c) 2011, 2012, 2013 Free Software Foundation, Inc.

;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES, OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF, OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(define-module (test-srfi-41)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-8)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-31)
  #:use-module (srfi srfi-41)
  #:use-module (test-suite lib))

(define-stream (qsort lt? strm)
  (if (stream-null? strm) stream-null
      (let ((x (stream-car strm))
            (xs (stream-cdr strm)))
        (stream-append
         (qsort lt? (stream-filter (cut lt? <> x) xs))
         (stream x)
         (qsort lt? (stream-filter (cut (negate lt?) <> x) xs))))))

(define-stream (isort lt? strm)
  (define-stream (insert strm x)
    (stream-match strm
      (() (stream x))
      ((y . ys) (if (lt? y x)
                    (stream-cons y (insert ys x))
                    (stream-cons x strm)))))
  (stream-fold insert stream-null strm))

(define-stream (stream-merge lt? . strms)
  (stream-let loop ((strms strms))
    (cond ((null? strms) stream-null)
          ((null? (cdr strms)) (car strms))
          (else (stream-let merge ((xx (car strms))
                                   (yy (loop (cdr strms))))
                  (stream-match xx
                    (() yy)
                    ((x . xs)
                     (stream-match yy
                       (() xx)
                       ((y . ys)
                        (if (lt? y x)
                            (stream-cons y (merge xx ys))
                            (stream-cons x (merge xs yy))))))))))))

(define-stream (msort lt? strm)
  (let* ((n (quotient (stream-length strm) 2))
         (ts (stream-take n strm))
         (ds (stream-drop n strm)))
    (if (zero? n) strm
        (stream-merge lt? (msort < ts) (msort < ds)))))

(define-stream (stream-unique eql? strm)
  (if (stream-null? strm) stream-null
      (stream-cons (stream-car strm)
        (stream-unique eql?
          (stream-drop-while (cut eql? (stream-car strm) <>) strm)))))

(define nats
  (stream-cons 1
    (stream-map 1+ nats)))

(define hamming
  (stream-unique =
    (stream-cons 1
      (stream-merge <
        (stream-map (cut * 2 <>) hamming)
        (stream-merge <
          (stream-map (cut * 3 <>) hamming)
          (stream-map (cut * 5 <>) hamming))))))

(define primes (let ()
  (define-stream (next base mult strm)
    (let ((first (stream-car strm))
          (rest (stream-cdr strm)))
      (cond ((< first mult)
              (stream-cons first
                (next base mult rest)))
            ((< mult first)
              (next base (+ base mult) strm))
            (else (next base
                    (+ base mult) rest)))))
  (define-stream (sift base strm)
    (next base (+ base base) strm))
  (stream-let sieve ((strm (stream-from 2)))
    (let ((first (stream-car strm))
          (rest (stream-cdr strm)))
      (stream-cons first (sieve (sift first rest)))))))

(define strm123 (stream 1 2 3))

(define (stream-equal? s1 s2)
  (cond ((and (stream-null? s1) (stream-null? s2)) #t)
        ((or (stream-null? s1) (stream-null? s2)) #f)
        ((equal? (stream-car s1) (stream-car s2))
         (stream-equal? (stream-cdr s1) (stream-cdr s2)))
        (else #f)))

(with-test-prefix "stream-null"
  (pass-if "is a stream" (stream? stream-null))
  (pass-if "is a null stream" (stream-null? stream-null))
  (pass-if "is not a stream pair" (not (stream-pair? stream-null))))

(with-test-prefix "stream-cons"
  (pass-if "is a stream" (stream? (stream-cons 1 stream-null)))
  (pass-if "is not a null stream" (not (stream-null? (stream-cons 1 stream-null))))
  (pass-if "is a stream pair" (stream-pair? (stream-cons 1 stream-null))))

(with-test-prefix "stream?"
  (pass-if "is true for null stream" (stream? stream-null))
  (pass-if "is true for stream pair" (stream? (stream-cons 1 stream-null)))
  (pass-if "is false for non-stream" (not (stream? "four"))))

(with-test-prefix "stream-null?"
  (pass-if "is true for null stream" (stream-null? stream-null))
  (pass-if "is false for stream pair" (not (stream-null? (stream-cons 1 stream-null))))
  (pass-if "is false for non-stream" (not (stream-null? "four"))))

(with-test-prefix "stream-pair?"
  (pass-if "is false for null stream" (not (stream-pair? stream-null)))
  (pass-if "is true for stream pair" (stream-pair? (stream-cons 1 stream-null)))
  (pass-if "is false for non-stream" (not (stream-pair? "four"))))

(with-test-prefix "stream-car"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream")
                     (stream-car "four"))
  (pass-if-exception "throws for null stream"
                     '(wrong-type-arg . "null stream")
                     (stream-car stream-null))
  (pass-if "returns first of stream" (eqv? (stream-car strm123) 1)))

(with-test-prefix "stream-cdr"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream")
                     (stream-cdr "four"))
  (pass-if-exception "throws for null stream"
                     '(wrong-type-arg . "null stream")
                     (stream-cdr stream-null))
  (pass-if "returns rest of stream" (eqv? (stream-car (stream-cdr strm123)) 2)))

(with-test-prefix "stream-lambda"
  (pass-if "returns correct result"
           (stream-equal?
            ((rec double (stream-lambda (strm)
                           (if (stream-null? strm) stream-null
                               (stream-cons (* 2 (stream-car strm))
                                            (double (stream-cdr strm))))))
             strm123)
            (stream 2 4 6))))

(with-test-prefix "define-stream"
  (pass-if "returns correct result"
           (stream-equal?
            (let ()
              (define-stream (double strm)
                (if (stream-null? strm) stream-null
                    (stream-cons (* 2 (stream-car strm))
                                 (double (stream-cdr strm)))))
              (double strm123))
            (stream 2 4 6))))

(with-test-prefix "list->stream"
  (pass-if-exception "throws for non-list"
                     '(wrong-type-arg . "non-list argument")
                     (list->stream "four"))
  (pass-if "returns empty stream for empty list"
           (stream-null? (list->stream '())))
  (pass-if "returns stream with same content as given list"
           (stream-equal? (list->stream '(1 2 3)) strm123)))

(with-test-prefix "port->stream"
  (pass-if-exception "throws for non-input-port"
                     '(wrong-type-arg . "non-input-port argument")
                     (port->stream "four"))
  (call-with-input-string "Hello, world!"
    (lambda (p)
      (pass-if-equal "reads input string correctly"
                     "Hello, world!"
                     (list->string (stream->list (port->stream p)))))))

(with-test-prefix "stream"
  (pass-if-equal "with empty stream"
                 '()
                 (stream->list (stream)))
  (pass-if-equal "with one-element stream"
                 '(1)
                 (stream->list (stream 1)))
  (pass-if-equal "with three-element stream"
                 '(1 2 3)
                 (stream->list strm123)))

(with-test-prefix "stream->list"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream->list '()))
  (pass-if-exception "throws for non-integer count"
                     '(wrong-type-arg . "non-integer count")
                     (stream->list "four" strm123))
  (pass-if-exception "throws for negative count"
                     '(wrong-type-arg . "negative count")
                     (stream->list -1 strm123))
  (pass-if-equal "returns empty list for empty stream"
                 '()
                 (stream->list (stream)))
  (pass-if-equal "without count"
                 '(1 2 3)
                 (stream->list strm123))
  (pass-if-equal "with count longer than stream"
                 '(1 2 3)
                 (stream->list 5 strm123))
  (pass-if-equal "with count shorter than stream"
                 '(1 2 3)
                 (stream->list 3 (stream-from 1))))

(with-test-prefix "stream-append"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-append "four"))
  (pass-if "with one stream"
           (stream-equal? (stream-append strm123) strm123))
  (pass-if "with two streams"
           (stream-equal? (stream-append strm123 strm123) (stream 1 2 3 1 2 3)))
  (pass-if "with three streams"
           (stream-equal? (stream-append strm123 strm123 strm123)
                          (stream 1 2 3 1 2 3 1 2 3)))
  (pass-if "append with null is noop"
           (stream-equal? (stream-append strm123 stream-null) strm123))
  (pass-if "prepend with null is noop"
           (stream-equal? (stream-append stream-null strm123) strm123)))

(with-test-prefix "stream-concat"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-concat "four"))
  (pass-if "with one stream"
           (stream-equal? (stream-concat (stream strm123)) strm123))
  (pass-if "with two streams"
           (stream-equal? (stream-concat (stream strm123 strm123))
                          (stream 1 2 3 1 2 3))))

(with-test-prefix "stream-constant"
  (pass-if "circular stream of 1 has >100 elements"
           (eqv? (stream-ref (stream-constant 1) 100) 1))
  (pass-if "circular stream of 2 has >100 elements"
           (eqv? (stream-ref (stream-constant 1 2) 100) 1))
  (pass-if "circular stream of 3 repeats after 3"
           (eqv? (stream-ref (stream-constant 1 2 3) 3) 1))
  (pass-if "circular stream of 1 repeats at 1"
           (stream-equal? (stream-take 8 (stream-constant 1))
                          (stream 1 1 1 1 1 1 1 1)))
  (pass-if "circular stream of 2 repeats at 2"
           (stream-equal? (stream-take 8 (stream-constant 1 2))
                          (stream 1 2 1 2 1 2 1 2)))
  (pass-if "circular stream of 3 repeats at 3"
           (stream-equal? (stream-take 8 (stream-constant 1 2 3))
                          (stream 1 2 3 1 2 3 1 2))))

(with-test-prefix "stream-drop"
  (pass-if-exception "throws for non-integer count"
                     '(wrong-type-arg . "non-integer argument")
                     (stream-drop "four" strm123))
  (pass-if-exception "throws for negative count"
                     '(wrong-type-arg . "negative argument")
                     (stream-drop -1 strm123))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-drop 2 "four"))
  (pass-if "returns null when given null"
           (stream-null? (stream-drop 0 stream-null)))
  (pass-if "returns same stream when count is zero"
           (eq? (stream-drop 0 strm123) strm123))
  (pass-if "returns dropped-by-one stream when count is one"
           (stream-equal? (stream-drop 1 strm123) (stream 2 3)))
  (pass-if "returns null if count is longer than stream"
           (stream-null? (stream-drop 5 strm123))))

(with-test-prefix "stream-drop-while"
  (pass-if-exception "throws for invalid predicate"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-drop-while "four" strm123))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-drop-while odd? "four"))
  (pass-if "returns null when given null"
           (stream-null? (stream-drop-while odd? stream-null)))
  (pass-if "returns dropped stream when first element matches"
           (stream-equal? (stream-drop-while odd? strm123) (stream 2 3)))
  (pass-if "returns whole stream when first element doesn't match"
           (stream-equal? (stream-drop-while even? strm123) strm123))
  (pass-if "returns empty stream if all elements match"
           (stream-null? (stream-drop-while positive? strm123)))
  (pass-if "return whole stream if no elements match"
           (stream-equal? (stream-drop-while negative? strm123) strm123)))

(with-test-prefix "stream-filter"
  (pass-if-exception "throws for invalid predicate"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-filter "four" strm123))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-filter odd? '()))
  (pass-if "returns null when given null"
           (stream-null? (stream-filter odd? (stream))))
  (pass-if "filters out even numbers"
           (stream-equal? (stream-filter odd? strm123) (stream 1 3)))
  (pass-if "filters out odd numbers"
           (stream-equal? (stream-filter even? strm123) (stream 2)))
  (pass-if "returns all elements if predicate matches all"
           (stream-equal? (stream-filter positive? strm123) strm123))
  (pass-if "returns null if predicate matches none"
           (stream-null? (stream-filter negative? strm123)))
  (pass-if "all elements of an odd-filtered stream are odd"
           (every odd? (stream->list 10 (stream-filter odd? (stream-from 0)))))
  (pass-if "no elements of an odd-filtered stream are even"
           (not (any even? (stream->list 10 (stream-filter odd? (stream-from 0)))))))

(with-test-prefix "stream-fold"
  (pass-if-exception "throws for invalid function"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-fold "four" 0 strm123))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-fold + 0 '()))
  (pass-if "returns the correct result" (eqv? (stream-fold + 0 strm123) 6)))

(with-test-prefix "stream-for-each"
  (pass-if-exception "throws for invalid function"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-for-each "four" strm123))
  (pass-if-exception "throws if given no streams" exception:wrong-num-args
                     (stream-for-each display))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-for-each display "four"))
  (pass-if "function is called for stream elements"
           (eqv? (let ((sum 0))
                   (stream-for-each (lambda (x)
                                      (set! sum (+ sum x)))
                                    strm123)
                   sum)
                 6)))

(with-test-prefix "stream-from"
  (pass-if-exception "throws for non-numeric start"
                     '(wrong-type-arg . "non-numeric starting number")
                     (stream-from "four"))
  (pass-if-exception "throws for non-numeric step"
                     '(wrong-type-arg . "non-numeric step size")
                     (stream-from 1 "four"))
  (pass-if "works for default values"
           (eqv? (stream-ref (stream-from 0) 100) 100))
  (pass-if "works for non-default start and step"
           (eqv? (stream-ref (stream-from 1 2) 100) 201))
  (pass-if "works for negative step"
           (eqv? (stream-ref (stream-from 0 -1) 100) -100)))

(with-test-prefix "stream-iterate"
  (pass-if-exception "throws for invalid function"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-iterate "four" 0))
  (pass-if "returns correct iterated stream with 1+"
           (stream-equal? (stream-take 3 (stream-iterate 1+ 1)) strm123))
  (pass-if "returns correct iterated stream with exact-integer-sqrt"
           (stream-equal? (stream-take 5 (stream-iterate exact-integer-sqrt 65536))
                          (stream 65536 256 16 4 2))))

(with-test-prefix "stream-length"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-length "four"))
  (pass-if "returns 0 for empty stream" (zero? (stream-length (stream))))
  (pass-if "returns correct stream length" (eqv? (stream-length strm123) 3)))

(with-test-prefix "stream-let"
  (pass-if "returns correct result"
           (stream-equal?
            (stream-let loop ((strm strm123))
              (if (stream-null? strm)
                  stream-null
                  (stream-cons (* 2 (stream-car strm))
                               (loop (stream-cdr strm)))))
            (stream 2 4 6))))

(with-test-prefix "stream-map"
  (pass-if-exception "throws for invalid function"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-map "four" strm123))
  (pass-if-exception "throws if given no streams" exception:wrong-num-args
                     (stream-map odd?))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-map odd? "four"))
  (pass-if "works for one stream"
           (stream-equal? (stream-map - strm123) (stream -1 -2 -3)))
  (pass-if "works for two streams"
           (stream-equal? (stream-map + strm123 strm123) (stream 2 4 6)))
  (pass-if "returns finite stream for finite first stream"
           (stream-equal? (stream-map + strm123 (stream-from 1)) (stream 2 4 6)))
  (pass-if "returns finite stream for finite last stream"
           (stream-equal? (stream-map + (stream-from 1) strm123) (stream 2 4 6)))
  (pass-if "works for three streams"
           (stream-equal? (stream-map + strm123 strm123 strm123) (stream 3 6 9))))

(with-test-prefix "stream-match"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-match '(1 2 3) (_ 'ok)))
  (pass-if-exception "throws when no pattern matches"
                     '(match-error . "no matching pattern")
                     (stream-match strm123 (() 42)))
  (pass-if-equal "matches empty stream correctly"
                 'ok
                 (stream-match stream-null (() 'ok)))
  (pass-if-equal "matches non-empty stream correctly"
                 'ok
                 (stream-match strm123 (() 'no) (else 'ok)))
  (pass-if-equal "matches stream of one element"
                 1
                 (stream-match (stream 1) (() 'no) ((a) a)))
  (pass-if-equal "matches wildcard"
                 'ok
                 (stream-match (stream 1) (() 'no) ((_) 'ok)))
  (pass-if-equal "matches stream of three elements"
                 '(1 2 3)
                 (stream-match strm123 ((a b c) (list a b c))))
  (pass-if-equal "matches first element with wildcard rest"
                 1
                 (stream-match strm123 ((a . _) a)))
  (pass-if-equal "matches first two elements with wildcard rest"
                 '(1 2)
                 (stream-match strm123 ((a b . _) (list a b))))
  (pass-if-equal "rest variable matches as stream"
                 '(1 2 3)
                 (stream-match strm123 ((a b . c) (list a b (stream-car c)))))
  (pass-if-equal "rest variable can match whole stream"
                 '(1 2 3)
                 (stream-match strm123 (s (stream->list s))))
  (pass-if-equal "successful guard match"
                 'ok
                 (stream-match strm123 ((a . _) (= a 1) 'ok)))
  (pass-if-equal "unsuccessful guard match"
                 'no
                 (stream-match strm123 ((a . _) (= a 2) 'yes) (_ 'no)))
  (pass-if-equal "unsuccessful guard match with two variables"
                 'no
                 (stream-match strm123 ((a b c) (= a b) 'yes) (_ 'no)))
  (pass-if-equal "successful guard match with two variables"
                 'yes
                 (stream-match (stream 1 1 2) ((a b c) (= a b) 'yes) (_ 'no))))

(with-test-prefix "stream-of"
  (pass-if "all 3 clause types work"
           (stream-equal? (stream-of (+ y 6)
                                     (x in (stream-range 1 6))
                                     (odd? x)
                                     (y is (* x x)))
                          (stream 7 15 31)))
  (pass-if "using two streams creates cartesian product"
           (stream-equal? (stream-of (* x y)
                                     (x in (stream-range 1 4))
                                     (y in (stream-range 1 5)))
                          (stream 1 2 3 4 2 4 6 8 3 6 9 12)))
  (pass-if "using no clauses returns just the expression"
           (stream-equal? (stream-of 1) (stream 1))))

(with-test-prefix "stream-range"
  (pass-if-exception "throws for non-numeric start"
                     '(wrong-type-arg . "non-numeric starting number")
                     (stream-range "four" 0))
  (pass-if-exception "throws for non-numeric end"
                     '(wrong-type-arg . "non-numeric ending number")
                     (stream-range 0 "four"))
  (pass-if-exception "throws for non-numeric step"
                     '(wrong-type-arg . "non-numeric step size")
                     (stream-range 1 2 "three"))
  (pass-if "returns increasing range if start < end"
           (stream-equal? (stream-range 0 5) (stream 0 1 2 3 4)))
  (pass-if "returns decreasing range if start > end"
           (stream-equal? (stream-range 5 0) (stream 5 4 3 2 1)))
  (pass-if "returns increasing range of step 2"
           (stream-equal? (stream-range 0 5 2) (stream 0 2 4)))
  (pass-if "returns decreasing range of step 2"
           (stream-equal? (stream-range 5 0 -2) (stream 5 3 1)))
  (pass-if "returns empty range if start is past end value"
           (stream-null? (stream-range 0 1 -1))))

(with-test-prefix "stream-ref"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-ref '() 4))
  (pass-if-exception "throws for non-integer index"
                     '(wrong-type-arg . "non-integer argument")
                     (stream-ref nats 3.5))
  (pass-if-exception "throws for negative index"
                     '(wrong-type-arg . "negative argument")
                     (stream-ref nats -3))
  (pass-if-exception "throws if index goes past end of stream"
                     '(wrong-type-arg . "beyond end of stream")
                     (stream-ref strm123 5))
  (pass-if-equal "returns first element when index = 0"
                 1
                 (stream-ref nats 0))
  (pass-if-equal "returns second element when index = 1"
                 2
                 (stream-ref nats 1))
  (pass-if-equal "returns third element when index = 2"
                 3
                 (stream-ref nats 2)))

(with-test-prefix "stream-reverse"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-reverse '()))
  (pass-if "returns null when given null"
           (stream-null? (stream-reverse (stream))))
  (pass-if "returns (3 2 1) for (1 2 3)"
           (stream-equal? (stream-reverse strm123) (stream 3 2 1))))

(with-test-prefix "stream-scan"
  (pass-if-exception "throws for invalid function"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-scan "four" 0 strm123))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-scan + 0 '()))
  (pass-if "returns the correct result"
           (stream-equal? (stream-scan + 0 strm123) (stream 0 1 3 6))))

(with-test-prefix "stream-take"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-take 5 "four"))
  (pass-if-exception "throws for non-integer index"
                     '(wrong-type-arg . "non-integer argument")
                     (stream-take "four" strm123))
  (pass-if-exception "throws for negative index"
                     '(wrong-type-arg . "negative argument")
                     (stream-take -4 strm123))
  (pass-if "returns null for empty stream"
           (stream-null? (stream-take 5 stream-null)))
  (pass-if "using 0 index returns null for empty stream"
           (stream-null? (stream-take 0 stream-null)))
  (pass-if "using 0 index returns null for non-empty stream"
           (stream-null? (stream-take 0 strm123)))
  (pass-if "returns first 2 elements of stream"
           (stream-equal? (stream-take 2 strm123) (stream 1 2)))
  (pass-if "returns whole stream when index is same as length"
           (stream-equal? (stream-take 3 strm123) strm123))
  (pass-if "returns whole stream when index exceeds length"
           (stream-equal? (stream-take 5 strm123) strm123)))

(with-test-prefix "stream-take-while"
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-take-while odd? "four"))
  (pass-if-exception "throws for invalid predicate"
                     '(wrong-type-arg . "non-procedural argument")
                     (stream-take-while "four" strm123))
  (pass-if "returns stream up to first non-matching item"
           (stream-equal? (stream-take-while odd? strm123) (stream 1)))
  (pass-if "returns empty stream if first item doesn't match"
           (stream-null? (stream-take-while even? strm123)))
  (pass-if "returns whole stream if every item matches"
           (stream-equal? (stream-take-while positive? strm123) strm123))
  (pass-if "return empty stream if no item matches"
           (stream-null? (stream-take-while negative? strm123))))

(with-test-prefix "stream-unfold"
  (pass-if-exception "throws for invalid mapper"
                     '(wrong-type-arg . "non-procedural mapper")
                     (stream-unfold "four" odd? + 0))
  (pass-if-exception "throws for invalid predicate"
                     '(wrong-type-arg . "non-procedural pred?")
                     (stream-unfold + "four" + 0))
  (pass-if-exception "throws for invalid generator"
                     '(wrong-type-arg . "non-procedural generator")
                     (stream-unfold + odd? "four" 0))

  (pass-if "returns the correct result"
           (stream-equal? (stream-unfold (cut expt <> 2) (cut < <> 10) 1+ 0)
                           (stream 0 1 4 9 16 25 36 49 64 81))))

(with-test-prefix "stream-unfolds"
  (pass-if "returns the correct result"
           (stream-equal? (stream-unfolds
                           (lambda (x)
                             (receive (n s) (car+cdr x)
                               (if (zero? n)
                                   (values 'dummy '())
                                   (values
                                    (cons (- n 1) (stream-cdr s))
                                    (list (stream-car s))))))
                           (cons 5 (stream-from 0)))
                          (stream 0 1 2 3 4)))
  (pass-if "handles returns of multiple elements correctly"
           (stream-equal? (stream-take 16 (stream-unfolds
                                           (lambda (n)
                                             (values (1+ n) (iota n)))
                                           1))
                          (stream 0 0 1 0 1 2 0 1 2 3 0 1 2 3 4 0)))
  (receive (p np)
           (stream-unfolds (lambda (x)
                             (receive (n p) (car+cdr x)
                               (if (= n (stream-car p))
                                   (values (cons (1+ n) (stream-cdr p))
                                           (list n) #f)
                                   (values (cons (1+ n) p)
                                           #f (list n)))))
                           (cons 1 primes))
    (pass-if "returns first stream correctly"
             (stream-equal? (stream-take 15 p)
                            (stream 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)))
    (pass-if "returns second stream correctly"
             (stream-equal? (stream-take 15 np)
                            (stream 1 4 6 8 9 10 12 14 15 16 18 20 21 22 24)))))

(with-test-prefix "stream-zip"
  (pass-if-exception "throws if given no streams" exception:wrong-num-args
                     (stream-zip))
  (pass-if-exception "throws for non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-zip "four"))
  (pass-if-exception "throws if any argument is non-stream"
                     '(wrong-type-arg . "non-stream argument")
                     (stream-zip strm123 "four"))
  (pass-if "returns null when given null as any argument"
           (stream-null? (stream-zip strm123 stream-null)))
  (pass-if "returns single-element lists when given one stream"
           (stream-equal? (stream-zip strm123) (stream '(1) '(2) '(3))))
  (pass-if "returns double-element lists when given two streams"
           (stream-equal? (stream-zip strm123 strm123)
                          (stream '(1 1) '(2 2) '(3 3))))
  (pass-if "returns finite stream if at least one given stream is"
           (stream-equal? (stream-zip strm123 (stream-from 1))
                          (stream '(1 1) '(2 2) '(3 3))))
  (pass-if "returns triple-element lists when given three streams"
           (stream-equal? (stream-zip strm123 strm123 strm123)
                          (stream '(1 1 1) '(2 2 2) '(3 3 3)))))

(with-test-prefix "other tests"
  (pass-if-equal "returns biggest prime under 1000"
                 997
                 (stream-car
                  (stream-reverse (stream-take-while (cut < <> 1000) primes))))

  (pass-if "quicksort returns same result as insertion sort"
           (stream-equal? (qsort < (stream 3 1 5 2 4))
                          (isort < (stream 2 5 1 4 3))))

  (pass-if "merge sort returns same result as insertion sort"
           (stream-equal? (msort < (stream 3 1 5 2 4))
                          (isort < (stream 2 5 1 4 3))))

  ;; http://www.research.att.com/~njas/sequences/A051037
  (pass-if-equal "returns 1000th Hamming number"
                 51200000
                 (stream-ref hamming 999)))