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