fix make-custom-weak-hash (PR 10232)

svn: r14762
This commit is contained in:
Matthew Flatt 2009-05-09 13:37:28 +00:00
parent 99c19a552c
commit 440a60c8ad
2 changed files with 28 additions and 5 deletions

View File

@ -499,7 +499,7 @@
create-immutable-custom-hash
make-weak-custom-hash)
(let ([mk
(lambda (hash hash2 =? who make-custom-hash table)
(lambda (hash hash2 =? who make-custom-hash table wrap-make-box)
(unless (and (procedure? =?)
(procedure-arity-includes? =? 2))
(raise-type-error who "procedure (arity 2)" =?))
@ -518,16 +518,25 @@
(hash (hash-box-key v)))
(lambda (v recur)
(hash2 (hash-box-key v)))))
(make-custom-hash table make-box)))])
(make-custom-hash table (wrap-make-box make-box))))])
(let ([make-custom-hash
(lambda (=? hash [hash2 (lambda (v) 10001)])
(mk hash hash2 =? 'make-custom-hash make-custom-hash (make-hash)))]
(mk hash hash2 =? 'make-custom-hash make-custom-hash (make-hash) values))]
[make-immutable-custom-hash
(lambda (=? hash [hash2 (lambda (v) 10001)])
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash #hash()))]
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash #hash() values))]
[make-weak-custom-hash
(lambda (=? hash [hash2 (lambda (v) 10001)])
(mk hash hash2 =? 'make-immutable-custom-hash make-immutable-custom-hash (make-weak-hash)))])
(mk hash hash2 =? 'make-weak-custom-hash make-custom-hash (make-weak-hash)
(lambda (make-box)
(let ([ht (make-weak-hasheq)])
(lambda (v)
(let ([e (hash-ref ht v #f)])
(if e
(ephemeron-value e)
(let ([b (make-box v)])
(hash-set! ht v (make-ephemeron v b))
b))))))))])
(values make-custom-hash
make-immutable-custom-hash
make-weak-custom-hash))))

View File

@ -103,6 +103,20 @@
h)
#f #t #t
"1")
(let ([s1 (make-string 1 #\1)]
[s2 (make-string 1 #\2)])
(try-simple (let ([h (make-weak-custom-hash (lambda (a b)
(string=? (format "~a" a)
(format "~a" b)))
(lambda (a)
(equal-hash-code (format "~a" a))))])
(dict-set! h s1 'one)
(dict-set! h s2 'two)
h)
#t #t #f
"1")
;; preserve from GC:
(list s1 s2))
;; ----------------------------------------