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

Waypoint for moving to a module based test

Browse Source 
svn: r1634
This commit is contained in:
Noel Welsh 2005-12-17 10:14:05 +00:00
parent f16cb07e0e
commit c65252212c
1 changed files with 141 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

283
collects/tests/srfi/69/hashtest.scm
View File

@ -1,201 +1,200 @@
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)) (module hash-tests mzscheme
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 1 1)))
(require (lib "1.ss" "srfi") (require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1)))
(lib "69.ss" "srfi"))
(define test-hash-table1 (require (lib "1.ss" "srfi")
(alist->hash-table '((a . 1) (b . 2) (c . 3)))) (lib "69.ss" "srfi"))
(define test-hash-table2
(alist->hash-table '(("a" . 1) ("b" . 2) ("c" . 3)) string-ci=? string-ci-hash))
(define test-hash-table1
(alist->hash-table '((a . 1) (b . 2) (c . 3))))
(define test-hash-table2
(alist->hash-table '(("a" . 1) ("b" . 2) ("c" . 3)) string-ci=? string-ci-hash))
(define test-suite (define test-suite
(make-test-suite (make-test-suite
"srfi-69 test suit" "srfi-69 test suit"
(make-test-case (make-test-case
"make-hash-table and hash-table?" "make-hash-table and hash-table?"
(assert-true (assert-true
(hash-table? (make-hash-table)))) (hash-table? (make-hash-table))))
(make-test-case (make-test-case
"alist->hash-table" "alist->hash-table"
(assert-true (assert-true
(hash-table? test-hash-table1))) (hash-table? test-hash-table1)))
(make-test-case (make-test-case
"hash-table-equivalence-function" "hash-table-equivalence-function"
(assert-eq? (assert-eq?
(hash-table-equivalence-function (make-hash-table)) (hash-table-equivalence-function (make-hash-table))
equal?) equal?)
(assert-eq? (assert-eq?
(hash-table-equivalence-function (make-hash-table eq?)) (hash-table-equivalence-function (make-hash-table eq?))
eq?) eq?)
(assert-eq? (assert-eq?
(hash-table-equivalence-function test-hash-table2) (hash-table-equivalence-function test-hash-table2)
string-ci=?)) string-ci=?))
(make-test-case (make-test-case
"hash-table-hash-function" "hash-table-hash-function"
(assert-eq? (assert-eq?
(hash-table-hash-function (make-hash-table)) (hash-table-hash-function (make-hash-table))
hash) hash)
(assert-eq? (assert-eq?
(hash-table-hash-function (make-hash-table eq?)) (hash-table-hash-function (make-hash-table eq?))
hash-by-identity) hash-by-identity)
(assert-eq? (assert-eq?
(hash-table-hash-function test-hash-table2) (hash-table-hash-function test-hash-table2)
string-ci-hash)) string-ci-hash))
(make-test-case (make-test-case
"hash-table-ref" "hash-table-ref"
(assert-equal? (assert-equal?
(hash-table-ref test-hash-table1 'b) (hash-table-ref test-hash-table1 'b)
2) 2)
(assert-equal? (assert-equal?
(hash-table-ref test-hash-table2 "C") (hash-table-ref test-hash-table2 "C")
3) 3)
(assert-false (assert-false
(hash-table-ref test-hash-table1 'd (lambda () #f)))) (hash-table-ref test-hash-table1 'd (lambda () #f))))
(make-test-case (make-test-case
"hash-table-ref/default" "hash-table-ref/default"
(assert-false (assert-false
(hash-table-ref/default test-hash-table2 "d" #f))) (hash-table-ref/default test-hash-table2 "d" #f)))
(make-test-case (make-test-case
"hash-table-set!" "hash-table-set!"
(assert-equal? (assert-equal?
(begin (hash-table-set! test-hash-table1 'c 4) (begin (hash-table-set! test-hash-table1 'c 4)
(hash-table-ref test-hash-table1 'c)) (hash-table-ref test-hash-table1 'c))
4) 4)
(assert-equal? (assert-equal?
(begin (hash-table-set! test-hash-table2 "d" 4) (begin (hash-table-set! test-hash-table2 "d" 4)
(hash-table-ref test-hash-table2 "D")) (hash-table-ref test-hash-table2 "D"))
4)) 4))
(make-test-case (make-test-case
"hash-table-delete!" "hash-table-delete!"
(assert-false (assert-false
(begin (hash-table-delete! test-hash-table2 "D") (begin (hash-table-delete! test-hash-table2 "D")
(hash-table-ref/default test-hash-table2 "d" #f)))) (hash-table-ref/default test-hash-table2 "d" #f))))
(make-test-case (make-test-case
"hash-table-exists?" "hash-table-exists?"
(assert-true (assert-true
(hash-table-exists? test-hash-table2 "B")) (hash-table-exists? test-hash-table2 "B"))
(assert-false (assert-false
(hash-table-exists? test-hash-table1 'd))) (hash-table-exists? test-hash-table1 'd)))
(make-test-case (make-test-case
"hash-table-update!" "hash-table-update!"
(assert-equal? (assert-equal?
(begin (hash-table-update! test-hash-table1 'c sub1) (begin (hash-table-update! test-hash-table1 'c sub1)
(hash-table-ref test-hash-table1 'c)) (hash-table-ref test-hash-table1 'c))
3) 3)
(assert-equal? (assert-equal?
(begin (hash-table-update! test-hash-table2 "d" add1 (lambda () 3)) (begin (hash-table-update! test-hash-table2 "d" add1 (lambda () 3))
(hash-table-ref test-hash-table2 "d")) (hash-table-ref test-hash-table2 "d"))
4)) 4))
(make-test-case (make-test-case
"hash-table-update!/default" "hash-table-update!/default"
(assert-equal? (assert-equal?
(begin (hash-table-update!/default test-hash-table1 'd add1 3) (begin (hash-table-update!/default test-hash-table1 'd add1 3)
(hash-table-ref test-hash-table1 'd)) (hash-table-ref test-hash-table1 'd))
4)) 4))
(make-test-case (make-test-case
"hash-table-size" "hash-table-size"
(assert-equal? (assert-equal?
(hash-table-size test-hash-table1) (hash-table-size test-hash-table1)
4) 4)
(assert-equal? (assert-equal?
(hash-table-size test-hash-table2) (hash-table-size test-hash-table2)
4)) 4))
(make-test-case (make-test-case
"hash-table-keys" "hash-table-keys"
(assert-true (assert-true
(lset= eq? (lset= eq?
(hash-table-keys test-hash-table1) (hash-table-keys test-hash-table1)
'(a b c d))) '(a b c d)))
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table-keys test-hash-table2) (hash-table-keys test-hash-table2)
(list "a" "b" "c" "d")))) (list "a" "b" "c" "d"))))
(make-test-case (make-test-case
"hash-table-values" "hash-table-values"
(assert-true (assert-true
(lset= eqv? (lset= eqv?
(hash-table-values test-hash-table1) (hash-table-values test-hash-table1)
'(1 2 3 4))) '(1 2 3 4)))
(assert-true (assert-true
(lset= eqv? (lset= eqv?
(hash-table-values test-hash-table2) (hash-table-values test-hash-table2)
'(1 2 3 4)))) '(1 2 3 4))))
(make-test-case (make-test-case
"hash-table-walk" "hash-table-walk"
(assert-true (assert-true
(let ((a '())) (let ((a '()))
(hash-table-walk test-hash-table1 (hash-table-walk test-hash-table1
(lambda (key value) (lambda (key value)
(set! a (cons (cons key value) a)))) (set! a (cons (cons key value) a))))
(lset= equal? (lset= equal?
a a
'((a . 1) (b . 2) (c . 3) (d . 4)))))) '((a . 1) (b . 2) (c . 3) (d . 4))))))
(make-test-case (make-test-case
"hash-table-fold" "hash-table-fold"
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table-fold test-hash-table2 (hash-table-fold test-hash-table2
(lambda (key value accu) (lambda (key value accu)
(cons (cons key value) accu)) (cons (cons key value) accu))
'()) '())
(list (cons "a" 1) (list (cons "a" 1)
(cons "b" 2) (cons "b" 2)
(cons "c" 3) (cons "c" 3)
(cons "d" 4))))) (cons "d" 4)))))
(make-test-case (make-test-case
"hash-table->alist" "hash-table->alist"
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table->alist test-hash-table1) (hash-table->alist test-hash-table1)
'((a . 1) (b . 2) (c . 3) (d . 4))))) '((a . 1) (b . 2) (c . 3) (d . 4)))))
(make-test-case (make-test-case
"hash-table-copy" "hash-table-copy"
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table->alist (hash-table-copy test-hash-table2)) (hash-table->alist (hash-table-copy test-hash-table2))
(list (cons "a" 1) (list (cons "a" 1)
(cons "b" 2) (cons "b" 2)
(cons "c" 3) (cons "c" 3)
(cons "d" 4)))) (cons "d" 4))))
(assert-false (assert-false
(eq? (hash-table-copy test-hash-table1) (eq? (hash-table-copy test-hash-table1)
test-hash-table1)) test-hash-table1))
(assert-eq? (assert-eq?
(hash-table-equivalence-function (hash-table-equivalence-function
test-hash-table1) test-hash-table1)
(hash-table-equivalence-function (hash-table-equivalence-function
(hash-table-copy test-hash-table1))) (hash-table-copy test-hash-table1)))
(assert-eq? (assert-eq?
(hash-table-hash-function (hash-table-hash-function
test-hash-table2) test-hash-table2)
(hash-table-hash-function (hash-table-hash-function
(hash-table-copy test-hash-table2)))) (hash-table-copy test-hash-table2))))
(make-test-case (make-test-case
"hash-table->alist" "hash-table->alist"
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table->alist (hash-table->alist
(hash-table-merge! test-hash-table1 (hash-table-merge! test-hash-table1
test-hash-table2)) test-hash-table2))
'(("a" . 1) '(("a" . 1)
("b" . 2) ("b" . 2)
("c" . 3) ("c" . 3)
("d" . 4) ("d" . 4)
(a . 1) (a . 1)
(b . 2) (b . 2)
(c . 3) (c . 3)
(d . 4)))) (d . 4))))
(assert-true (assert-true
(lset= equal? (lset= equal?
(hash-table->alist (hash-table->alist
(hash-table-merge! test-hash-table2 (hash-table-merge! test-hash-table2
test-hash-table2)) test-hash-table2))
'(("a" . 1) '(("a" . 1)
("b" . 2) ("b" . 2)
("c" . 3) ("c" . 3)
("d" . 4))))))) ("d" . 4)))))))
(test/text-ui test-suite) )