164 lines
6.0 KiB
Scheme
164 lines
6.0 KiB
Scheme
#!r6rs
|
|
|
|
(library (tests r6rs hashtables)
|
|
(export run-hashtables-tests)
|
|
(import (rnrs)
|
|
(tests r6rs test))
|
|
|
|
(define-syntax test-ht
|
|
(syntax-rules ()
|
|
[(_ mk key=? ([key val] ...)
|
|
key/r orig-val new-val
|
|
key/a a-val
|
|
key/rm)
|
|
(let ([h mk])
|
|
(test (hashtable? h) #t)
|
|
(test (hashtable-size h) 0)
|
|
(test (hashtable-ref h key/r 'nope) 'nope)
|
|
(test/unspec (hashtable-delete! h key)) ...
|
|
(test (hashtable-size h) 0)
|
|
|
|
(test (hashtable-ref h key/r 'nope) 'nope)
|
|
(test (hashtable-contains? h key/r) #f)
|
|
(test/unspec (hashtable-set! h key/r orig-val))
|
|
(test (hashtable-ref h key/r 'nope) orig-val)
|
|
(test (hashtable-contains? h key/r) #t)
|
|
(test (hashtable-size h) 1)
|
|
|
|
(test/unspec (hashtable-set! h key val)) ...
|
|
(test (hashtable-size h) (length '(key ...)))
|
|
(test (hashtable-ref h key/r 'nope) orig-val)
|
|
(test (hashtable-ref h key 'nope) val) ...
|
|
|
|
(let ([h1 (hashtable-copy h #t)]
|
|
[h1i (hashtable-copy h)])
|
|
(test (hashtable-mutable? h) #t)
|
|
(test (hashtable-mutable? h1) #t)
|
|
(test (hashtable-mutable? h1i) #f)
|
|
|
|
(test (vector-length (hashtable-keys h))
|
|
(hashtable-size h))
|
|
(test (vector-length (let-values ([(k e) (hashtable-entries h)])
|
|
e))
|
|
(hashtable-size h))
|
|
(test (exists (lambda (v) (key=? v key/r))
|
|
(vector->list (hashtable-keys h)))
|
|
#t)
|
|
|
|
(test/unspec (hashtable-set! h key/r new-val))
|
|
(test (hashtable-contains? h key/r) #t)
|
|
(test (hashtable-ref h key/r 'nope) new-val)
|
|
|
|
(test/unspec (hashtable-update! h key/r (lambda (v)
|
|
(test v new-val)
|
|
orig-val)
|
|
'nope))
|
|
(test (hashtable-ref h key/r 'nope) orig-val)
|
|
(test/unspec (hashtable-update! h key/r (lambda (v)
|
|
(test v orig-val)
|
|
new-val)
|
|
'nope))
|
|
(test (hashtable-ref h key/r 'nope) new-val)
|
|
|
|
(test/unspec (hashtable-update! h key/a (lambda (v)
|
|
(test v 'nope)
|
|
a-val)
|
|
'nope))
|
|
(test (hashtable-ref h key/a 'nope) a-val)
|
|
(test/unspec (hashtable-delete! h key/a))
|
|
|
|
(test (hashtable-contains? h key/rm) #t)
|
|
(hashtable-delete! h key/rm)
|
|
(test (hashtable-contains? h key/rm) #f)
|
|
(test (hashtable-ref h key/rm 'nope) 'nope)
|
|
|
|
(test (hashtable-ref h1 key 'nope) val) ...
|
|
(test (hashtable-ref h1i key 'nope) val) ...
|
|
(test (hashtable-contains? h1 key/rm) #t)
|
|
(test (hashtable-contains? h1i key/rm) #t)
|
|
|
|
(hashtable-clear! h)
|
|
(test (hashtable-contains? h key) #f) ...
|
|
(test (hashtable-contains? h1 key) #t) ...
|
|
(test (hashtable-contains? h1i key) #t) ...
|
|
|
|
(test/unspec (hashtable-clear! h1))
|
|
|
|
(test/exn (hashtable-set! h1i key/r #f) &violation)
|
|
(test/exn (hashtable-delete! h1i key/r) &violation)
|
|
(test/exn (hashtable-update! h1i key/r (lambda (q) q) 'none) &violation)
|
|
(test/exn (hashtable-clear! h1i) &violation)))]))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define (run-hashtables-tests)
|
|
|
|
(let-values ([(kv vv)
|
|
(let ((h (make-eqv-hashtable)))
|
|
(hashtable-set! h 1 'one)
|
|
(hashtable-set! h 2 'two)
|
|
(hashtable-set! h 3 'three)
|
|
(hashtable-entries h))])
|
|
(test/alts (cons kv vv)
|
|
'(#(1 2 3) . #(one two three))
|
|
'(#(1 3 2) . #(one three two))
|
|
'(#(2 1 3) . #(two one three))
|
|
'(#(2 3 1) . #(two three one))
|
|
'(#(3 1 2) . #(three one two))
|
|
'(#(3 2 1) . #(three two one))))
|
|
|
|
(test-ht (make-eq-hashtable) eq?
|
|
(['a 7] ['b "bee"]
|
|
[#t 8] [#f 9]
|
|
['c 123456789101112])
|
|
'b "bee" "bumble"
|
|
'd 12
|
|
'c)
|
|
|
|
(test-ht (make-eqv-hashtable) eqv?
|
|
(['a 7] [#\b "bee"]
|
|
[#t 8] [0.0 85]
|
|
[123456789101112 'c])
|
|
#\b "bee" "bumble"
|
|
'd 12
|
|
123456789101112)
|
|
|
|
(let ([val-of (lambda (a)
|
|
(if (number? a)
|
|
a
|
|
(string->number a)))])
|
|
(test-ht (make-hashtable val-of
|
|
(lambda (a b)
|
|
(= (val-of a) (val-of b))))
|
|
equal?
|
|
([1 'one]["2" 'two]
|
|
[3 'three]["4" 'four])
|
|
2 'two 'er
|
|
5 'five
|
|
4))
|
|
|
|
(test (hashtable? (make-eq-hashtable 10)) #t)
|
|
(test (hashtable? (make-eqv-hashtable 10)) #t)
|
|
(test (hashtable? (make-hashtable (lambda (x) 0) equal? 10)) #t)
|
|
|
|
(let ([zero (lambda (a) 0)]
|
|
[same? (lambda (a b) #t)])
|
|
(let ([ht (make-hashtable zero same?)])
|
|
(test (hashtable-equivalence-function ht) same?)
|
|
(test (hashtable-hash-function ht) zero)))
|
|
|
|
(test (equal-hash "a") (equal-hash (make-string 1 #\a)))
|
|
(test (equal-hash 1024) (equal-hash (expt 2 10)))
|
|
(test (equal-hash '(1 2 3)) (equal-hash (list 1 2 3)))
|
|
|
|
(test (string-hash "a") (string-hash (make-string 1 #\a)))
|
|
(test (string-hash "aaaaa") (string-hash (make-string 5 #\a)))
|
|
(test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\a)))
|
|
(test (string-ci-hash "aAaAA") (string-ci-hash (make-string 5 #\A)))
|
|
|
|
(test (symbol-hash 'a) (symbol-hash 'a))
|
|
|
|
;;
|
|
))
|
|
|