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