1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
;;; test-weak.scm -- weak hashtable tests for the MPS toy Scheme interpreter
;;; $Id$
(load "test-common.scm")
(define (populate ht kvs)
(let ((f (lambda (kv) (hashtable-set! ht (car kv) (cdr kv)))))
(for-each f kvs)))
;; The MPS doesn't actually guarantee promptness of splatting. But we
;; have to test it somehow!
(define (ht-test ht-fun hash cmp f1 f2 kvs)
(let* ((ht (ht-fun hash cmp))
(f (lambda (kv) (equal? (hashtable-ref ht (car kv) #f) (cdr kv)))))
(populate ht kvs)
(list (begin (gc) (all (map f kvs)))
(begin (for-each f1 kvs) (gc) (hashtable-size ht))
(begin (for-each f2 kvs) (gc) (hashtable-size ht)))))
(define (dk kv) (set-car! kv #f))
(define (dv kv) (set-cdr! kv #f))
(check '(ht-test make-hashtable string-hash string=? dk dv
'(("one" . 1) ("two" . 2) ("three" . 3)))
'(#t 3 3))
(check '(ht-test make-weak-key-hashtable eq-hash eq? dk dv
'((ONE . 1) (TWO . 2) (THREE . 3)))
'(#t 0 0))
(check '(ht-test make-weak-key-hashtable eqv-hash eqv? dv dk
'((1 . 1) (2 . 2) (3 . 3)))
'(#t 3 0))
(check '(ht-test make-weak-value-hashtable string-hash string=? dk dv
'(("one" . 1) ("two" . 2) ("three" . 3)))
'(#t 3 0))
(check '(ht-test make-weak-value-hashtable string-hash string=? dv dk
'(("one" . 1) ("two" . 2) ("three" . 3)))
'(#t 0 0))
(check '(ht-test make-doubly-weak-hashtable eq-hash eq? dk dv
'(("one" . 1) ("two" . 2) ("three" . 3)))
'(#t 0 0))
(check '(ht-test make-doubly-weak-hashtable eqv-hash eqv? dv dk
'((#\a . 1) (#\b . 2) (#\c . 3)))
'(#t 0 0))
(write-string "All tests pass.")
(newline)
|
