suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

orginal SRFI 40/43 tests from Schematics

Browse Source 
svn: r3335
This commit is contained in:
Chongkai Zhu 2006-06-11 21:44:01 +00:00
parent bc017f488e
commit 70d764c941
11 changed files with 648 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
collects/tests/srfi/40/all-srfi-40-tests.ss Normal file
View File

@ -0,0 +1,88 @@
(module all-srfi-40-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
(lib "40.ss" "srfi"))
(provide all-srfi-40-tests)
(define from0
(let loop ((x 0))
(stream-delay
(stream-cons x (loop (+ x 1))))))
(define (take5 s)
(stream-unfoldn
(lambda (x)
(let ((n (car x)) (s (cdr x)))
(if (zero? n)
(values 'dummy '())
(values
(cons (- n 1) (stream-cdr s))
(list (stream-car s))))))
(cons 5 s)
1))
(define (finite-stream->list s)
(if (stream-null? s)
null
(cons (stream-car s)
(finite-stream->list (stream-cdr s)))))
(define all-srfi-40-tests
(make-test-suite
"All tests for SRFI 40"
(make-test-case
"stream?"
(assert-true
(stream? stream-null))
(assert-true
(stream? (stream-cons 'a stream-null)))
(assert-false
(stream? 3)))
(make-test-case
"stream-null?"
(assert-true
(stream-null? stream-null))
(assert-false
(stream-null? (stream-cons 'a stream-null)))
(assert-false
(stream-null? 3)))
(make-test-case
"stream-pair?"
(assert-false
(stream-pair? stream-null))
(assert-true
(stream-pair? (stream-cons 'a stream-null)))
(assert-false
(stream-pair? 3)))
(make-test-case
"stream"
(assert-true
(stream-null? (stream)))
(assert-equal? (finite-stream->list (stream 'a (+ 3 4) 'c))
'(a 7 c)))
(make-test-case
"stream-unfoldn"
(assert-equal? (finite-stream->list (take5 from0))
'(0 1 2 3 4)))
(make-test-case
"stream-for-each"
(assert-equal?
(let ((l '()))
(stream-for-each (lambda (n) (set! l (cons n l)))
(take5 from0))
l)
'(4 3 2 1 0)))
(make-test-case
"stream-map"
(assert-equal? (finite-stream->list (take5 (stream-map (lambda (x) (+ x x)) from0)))
'(0 2 4 6 8))
(assert-equal? (finite-stream->list (stream-map + (stream 1 2 3) (stream 4 5 6)))
'(5 7 9))
(assert-equal? (finite-stream->list
(stream-map (lambda (x) (expt x x))
(stream 1 2 3 4 5)))
'(1 4 27 256 3125)))
(make-test-case
"stream-filter"
(assert-true
(stream-null? (stream-filter odd? stream-null)))
(assert-equal? (finite-stream->list (take5 (stream-filter odd? from0)))
'(1 3 5 7 9))))))

5
collects/tests/srfi/40/run-tests.ss Normal file
View File

@ -0,0 +1,5 @@
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 1 1)))
(require "all-srfi-40-tests.ss")
(test/text-ui all-srfi-40-tests)

20
collects/tests/srfi/43/all-srfi-43-tests.ss Normal file
View File

@ -0,0 +1,20 @@
(module all-srfi-43-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
"constructor-tests.ss"
"predicate-tests.ss"
"iteration-tests.ss"
"searching-tests.ss"
"mutator-tests.ss"
"conversion-tests.ss")
(provide all-srfi-43-tests)
(define all-srfi-43-tests
(make-test-suite
"all-tests-tests"
constructor-tests
predicate-tests
iteration-tests
searching-tests
mutator-tests
conversion-tests)))

111
collects/tests/srfi/43/constructor-tests.ss Normal file
View File

@ -0,0 +1,111 @@
(module constructor-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (lib "constructors.ss" "srfi" "43"))
(provide constructor-tests)
(define constructor-tests
(make-test-suite
"All tests for constructor"
(make-test-case
"vector-unfold"
(assert-equal?
(vector-unfold values 10)
#(0 1 2 3 4 5 6 7 8 9)
"No seed")
(assert-equal?
(vector-unfold (lambda (i x) (values x (- x 1))) 10 0)
#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)
"Single seed")
(assert-equal?
(vector-unfold (lambda (i a b) (values (/ a b) a b)) 4 5 5)
#(1 1 1 1)
"Two seeds"))
(make-test-case
"vector-unfold-right"
(assert-equal?
(vector-unfold-right values 10)
#(0 1 2 3 4 5 6 7 8 9)
"No seed")
(assert-equal?
(vector-unfold-right
(lambda (i x) (values x (- x 1)))
10
0)
#(-9 -8 -7 -6 -5 -4 -3 -2 -1 0)
"Single seed")
(assert-equal?
(vector-unfold-right
(lambda (i a b) (values (/ a b) a b))
4
5
5)
#(1 1 1 1)
"Two seeds"))
(make-test-case
"vector-copy"
(assert-equal?
(vector-copy '#(a b c d e f g h i))
#(a b c d e f g h i))
(assert-equal?
(vector-copy '#(a b c d e f g h i) 6)
#(g h i))
(assert-equal?
(vector-copy '#(a b c d e f g h i) 3 6)
#(d e f))
(assert-equal?
(vector-copy '#(a b c d e f g h i) 6 12 'x)
#(g h i x x x)))
(make-test-case
"vector-reverse-copy"
(assert-equal?
(vector-reverse-copy '#(5 4 3 2 1 0) 1 5)
#(1 2 3 4))
(assert-equal?
(vector-reverse-copy '#(5 4 3 2 1 0) 2)
#(0 1 2 3))
(assert-equal?
(vector-reverse-copy '#(5 4 3 2 1 0))
#(0 1 2 3 4 5)))
(make-test-case
"vector-append"
(assert-equal?
(vector-append '#(x) '#(y))
#(x y))
(assert-equal?
(vector-append '#(a) '#(b c d))
#(a b c d))
(assert-equal?
(vector-append '#(a #(b)) '#(#(c)))
#(a #(b) #(c)))
(assert-equal?
(vector-append '#(1 2) '#(3) '#(4 5 6 7))
#(1 2 3 4 5 6 7))
(assert-equal?
(vector-append)
#()))
(make-test-case
"vector-concatenate"
(assert-equal?
(vector-concatenate '(#(x) #(y)))
#(x y))
(assert-equal?
(vector-concatenate '(#(a) #(b c d)))
#(a b c d))
(assert-equal?
(vector-concatenate '(#(a #(b)) #(#(c))))
#(a #(b) #(c)))
(assert-equal?
(vector-concatenate '(#(1 2) #(3) #(4 5 6 7)))
#(1 2 3 4 5 6 7))
(assert-equal?
(vector-concatenate '())
#()))
))
)

45
collects/tests/srfi/43/conversion-tests.ss Normal file
View File

@ -0,0 +1,45 @@
(module conversion-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (all-except (lib "conversion.ss" "srfi" "43") vector->list)
(rename (lib "conversion.ss" "srfi" "43") s:vector->list vector->list))
(provide conversion-tests)
(define conversion-tests
(make-test-suite
"All tests for conversion"
(make-test-case
"vector->list"
(assert-equal?
(s:vector->list '#(1 2 3 4))
'(1 2 3 4))
(assert-equal?
(s:vector->list '#(1 2 3 4) 4)
'())
(assert-equal?
(s:vector->list '#(1 2 3 4) 1 3)
'(2 3)))
(make-test-case
"reverse-vector->list"
(assert-equal?
(reverse-vector->list '#(1 2 3 4))
'(4 3 2 1))
(assert-equal?
(reverse-vector->list '#(1 2 3 4) 4)
'())
(assert-equal?
(reverse-vector->list '#(1 2 3 4) 1 3)
'(3 2)))
(make-test-case
"reverse-list->vector"
(assert-equal?
(reverse-list->vector '(1 2 3 4))
'#(4 3 2 1))
(assert-equal?
(reverse-list->vector '())
'#()))
))
)

119
collects/tests/srfi/43/iteration-tests.ss Normal file
View File

@ -0,0 +1,119 @@
(module iteration-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (lib "iteration.ss" "srfi" "43")
(lib "constructors.ss" "srfi" "43"))
(provide iteration-tests)
(define iteration-tests
(make-test-suite
"All tests for iteration"
(make-test-case
"vector-fold"
(assert =
(vector-fold (lambda (index len str) (max (string-length str) len))
0 '#("abcde" "1234" "bar"))
5)
(assert-equal?
(vector-fold (lambda (index tail elt) (cons elt tail))
'() '#(1 2 3 4 5))
'(5 4 3 2 1)
"reverse-vector->list")
(assert =
(vector-fold (lambda (index counter n)
(if (even? n) (+ counter 1) counter))
0 '#(1 2 3 4 5))
2)
(assert-equal?
(vector-fold (lambda (index tail elt1 elt2)
(cons (list elt1 elt2) tail))
'()
'#(1 2 3 4 5)
'#(a b c d))
'((4 d) (3 c) (2 b) (1 a))
"two vectors"))
(make-test-case
"vector-fold-right"
(assert-equal?
(vector-fold-right (lambda (index tail elt) (cons elt tail))
'() '#(a b c d))
'(a b c d)
"vector->list")
(assert-equal?
(vector-fold-right (lambda (index tail elt1 elt2)
(cons (list elt1 elt2) tail))
'()
'#(1 2 3 4 5)
'#(a b c d))
'((1 a) (2 b) (3 c) (4 d))
"two vectors"))
(make-test-case
"vector-map"
(assert-equal?
(vector-map (lambda (i x) (* x x))
'#(1 2 3 4))
'#(1 4 9 16))
(assert-equal?
(vector-map (lambda (i x y) (* x y))
(vector-unfold (lambda (i x) (values x (+ x 1))) 5 1)
(vector-unfold (lambda (i x) (values x (- x 1))) 5 5))
'#(5 8 9 8 5))
(assert-equal?
(vector-map (lambda (i elt) (+ i elt)) '#(1 2 3 4))
'#(1 3 5 7)))
(make-test-case
"vector-map!"
(let ((vec '#(1 2 3 4)))
(assert-equal?
(begin (vector-map! (lambda (i x) (* x x))
vec)
vec)
'#(1 4 9 16)))
(let ((vec1 (vector-unfold (lambda (i x) (values x (+ x 1))) 5 1))
(vec2 (vector-unfold (lambda (i x) (values x (- x 1))) 5 5)))
(assert-equal?
(begin (vector-map! (lambda (i x y) (* x y))
vec1 vec2)
vec1)
'#(5 8 9 8 5)))
(let ((vec '#(1 2 3 4)))
(assert-equal?
(begin (vector-map! (lambda (i elt) (+ i elt))
vec)
vec)
'#(1 3 5 7))))
(make-test-case
"vector-for-each"
(let ((vec1 '#(1 2 3 4))
(vec2 (make-vector 4)))
(assert-equal?
(begin (vector-for-each (lambda (i elt)
(vector-set! vec2 i (+ i elt)))
vec1)
vec2)
'#(1 3 5 7)))
(let ((vec1 (vector-unfold (lambda (i x) (values x (+ x 1))) 5 1))
(vec2 (vector-unfold (lambda (i x) (values x (- x 1))) 5 5))
(vec3 (make-vector 5)))
(assert-equal?
(begin (vector-for-each (lambda (i x y)
(vector-set! vec3 i (* x y)))
vec1 vec2)
vec3)
'#(5 8 9 8 5))))
(make-test-case
"vector-count"
(assert =
(vector-count (lambda (i elt) (even? elt)) '#(3 1 4 1 5 9 2 5 6))
3)
(assert =
(vector-count (lambda (i x y) (< x y)) '#(1 3 6 9) '#(2 4 6 8 10 12))
2))
))
)

103
collects/tests/srfi/43/mutator-tests.ss Normal file
View File

@ -0,0 +1,103 @@
(module mutator-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (all-except (lib "mutators.ss" "srfi" "43") vector-fill!)
(rename (lib "mutators.ss" "srfi" "43") s:vector-fill! vector-fill!))
(provide mutator-tests)
(define mutator-tests
(make-test-suite
"All tests for mutator"
(make-test-case
"vector-swap!"
(let ((vec '#(a b c d e)))
(assert-equal?
(begin (vector-swap! vec 1 3)
vec)
'#(a d c b e)))
(let ((vec '#(0 1 2)))
(assert-equal?
(begin (vector-swap! vec 1 1)
vec)
'#(0 1 2))))
(make-test-case
"vector-fill!"
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (s:vector-fill! vec 0)
vec)
'#(0 0 0 0 0)))
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (s:vector-fill! vec 0 1)
vec)
'#(1 0 0 0 0)))
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (s:vector-fill! vec 0 1 4)
vec)
'#(1 0 0 0 5))))
(make-test-case
"vector-reverse!"
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (vector-reverse! vec)
vec)
'#(5 4 3 2 1)))
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (vector-reverse! vec 1)
vec)
'#(1 5 4 3 2)))
(let ((vec '#(1 2 3 4 5)))
(assert-equal?
(begin (vector-reverse! vec 1 4)
vec)
'#(1 4 3 2 5))))
(make-test-case
"vector-copy!"
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-copy! target 0 source)
target)
source))
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-copy! target 1 source 1)
target)
'#(0 2 3 4 5)))
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-copy! target 1 source 1 4)
target)
'#(0 2 3 4 0))))
(make-test-case
"vector-reverse-copy!"
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-reverse-copy! target 0 source)
target)
'#(5 4 3 2 1)))
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-reverse-copy! target 1 source 1)
target)
'#(0 5 4 3 2)))
(let ((source '#(1 2 3 4 5))
(target '#(0 0 0 0 0)))
(assert-equal?
(begin (vector-reverse-copy! target 1 source 1 4)
target)
'#(0 4 3 2 0))))
))
)

42
collects/tests/srfi/43/predicate-tests.ss Normal file
View File

@ -0,0 +1,42 @@
(module predicate-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (lib "predicates.ss" "srfi" "43"))
(provide predicate-tests)
(define predicate-tests
(make-test-suite
"All tests for predicate"
(make-test-case
"vector-empty?"
(assert-false
(vector-empty? '#(a)))
(assert-false
(vector-empty? '#(())))
(assert-false
(vector-empty? '#(#())))
(assert-true
(vector-empty? '#())))
(make-test-case
"vector="
(assert-true
(vector= eq? '#(a b c d) '#(a b c d)))
(assert-false
(vector= eq? '#(a b c d) '#(a b d c)))
(assert-false
(vector= = '#(1 2 3 4 5) '#(1 2 3 4)))
(assert-true
(vector= = '#(1 2 3 4) '#(1 2 3 4) '#(1 2 3 4)))
(assert-true
(vector= eq?))
(assert-true
(vector= eq? '#(a)))
(assert-false
(vector= eq? '#(a b c d) '#(a b c d) '#(a b d c)))
(assert-false
(vector= eq? '#(a b c d e) '#(a b c d) '#(a b c d))))
))
)

5
collects/tests/srfi/43/run-tests.ss Normal file
View File

@ -0,0 +1,5 @@
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 1 1)))
(require "all-srfi-43-tests.ss")
(test/text-ui all-srfi-43-tests)

106
collects/tests/srfi/43/searching-tests.ss Normal file
View File

@ -0,0 +1,106 @@
(module searching-tests mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (lib "searching.ss" "srfi" "43"))
(provide searching-tests)
(define searching-tests
(make-test-suite
"All tests for searching"
(make-test-case
"vector-index"
(assert =
(vector-index even? '#(3 1 4 1 5 9))
2)
(assert =
(vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
1)
(assert-false
(vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))))
(make-test-case
"vector-index-right"
(assert =
(vector-index-right even? '#(3 1 4 1 5 9))
2)
(assert =
(vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
3)
(assert-false
(vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))))
(make-test-case
"vector-skip"
(assert =
(vector-skip odd? '#(3 1 4 1 5 9))
2)
(assert =
(vector-skip > '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
1)
(assert-false
(vector-skip = '#(2 7 1 8 2 8) '#(2 7 1 8 2))))
(make-test-case
"vector-skip-right"
(assert =
(vector-skip-right odd? '#(3 1 4 1 5 9))
2)
(assert =
(vector-skip-right > '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
3)
(assert-false
(vector-skip-right = '#(2 7 1 8 2 8) '#(2 7 1 8 2))))
(make-test-case
"vector-binary-search"
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 0 -)
0)
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 3 -)
1)
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 4 -)
2)
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 6 -)
3)
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 8 -)
4)
(assert =
(vector-binary-search '#(0 3 4 6 8 9) 9 -)
5)
(assert-false
(vector-binary-search '#(0 3 4 6 8 9) 5 -))
(assert-false
(vector-binary-search '#(0 3 4 6 8 9) -2 -))
(assert-false
(vector-binary-search '#(0 3 4 6 8 9) 11 -))
(assert-false
(vector-binary-search '#(0 3 4 6 8 9) 1 -)))
(make-test-case
"vector-any"
(assert-false
(vector-any zero? '#(1 2 3 4)))
(assert-true
(vector-any zero? '#(2 0 1)))
(assert =
(vector-any / '#(1 1) '#(1 0))
1)
(assert-false
(vector-any (lambda x #t) '#())))
(make-test-case
"vector-every"
(assert-false
(vector-every zero? '#(0 0 7)))
(assert-true
(vector-every (lambda x #f) '#()))
(assert =
(vector-every - '#(1 1) '#(1 0))
1))
))
)

8
collects/tests/srfi/all-srfi-tests.ss
View File

@ -6,8 +6,8 @@
"13/string-test.ss"
"14/char-set-test.ss"
"26/cut-test.ss"
;"40/all-srfi-40-tests.ss"
;"43/all-srfi-43-tests.ss"
"40/all-srfi-40-tests.ss"
"43/all-srfi-43-tests.ss"
"69/hash-tests.ss")
(provide all-srfi-tests)
@ -19,8 +19,8 @@
string-tests
char-set-tests
cut-tests
;all-srfi-40-tests
;all-srfi-43-tests
all-srfi-40-tests
all-srfi-43-tests
hash-tests
))
)