mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-29 19:30:36 +02:00
50d08cd894
Incorporates suggestions from Mark H Weaver <mhw@netris.org> and Ian Price <ianprice90@googlemail.com>. * module/srfi/srfi-41.scm: New file. * module/Makefile.am (SRFI_SOURCES): Add srfi/srfi-41.scm. * test-suite/tests/srfi-41.test: New file. * test-suite/Makefile.am (SCM_TESTS): Add tests/srfi-41.test. * doc/ref/srfi-modules.texi (SRFI Support): Add SRFI-41. (SRFI-41): New node which refers the reader to <http://srfi.schemers.org/srfi-41/srfi-41.html>.
680 lines
30 KiB
Text
680 lines
30 KiB
Text
;;; 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)))
|