test-suite/tests/srfi-41.test

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