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

fix `hash-clear!' on impersonated hash tables

Browse Source 
Closes PR 13977
This commit is contained in:
Matthew Flatt 2013-08-20 05:51:19 -06:00
parent 5f0c06956a
commit e02e04ff2a
2 changed files with 17 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
View File

@ -845,7 +845,10 @@
(hash-set! ht add1 sub1) (hash-set! ht add1 sub1)
(test 9 (hash-ref ht add1) 10) (test 9 (hash-ref ht add1) 10)
(test '(10) 'for-hash (for/list ([(k v) (in-hash ht)]) (test '(10) 'for-hash (for/list ([(k v) (in-hash ht)])
(k (v 10))))))) (test v hash-ref ht k)
(k (v 10))))
(test (void) hash-clear! ht)
(test 0 hash-count ht))))
;; ---------------------------------------- ;; ----------------------------------------
@ -866,8 +869,7 @@
(test #f hash-ref h 1 #f) (test #f hash-ref h 1 #f)
(err/rt-test (hash-iterate-value h (hash-iterate-first h))) (err/rt-test (hash-iterate-value h (hash-iterate-first h)))
(err/rt-test (hash-map h void)) (err/rt-test (hash-map h void))
(err/rt-test (hash-for-each h void)) (err/rt-test (hash-for-each h void))))])
(err/rt-test (hash-clear! h))))])
(check (make-hash)) (check (make-hash))
(check (make-hasheq)) (check (make-hasheq))
(check (make-weak-hash)) (check (make-weak-hash))

18
racket/src/racket/src/list.c
View File

@ -2424,25 +2424,31 @@ static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[])
static Scheme_Object *hash_table_clear_bang(int argc, Scheme_Object *argv[]) static Scheme_Object *hash_table_clear_bang(int argc, Scheme_Object *argv[])
{ {
Scheme_Object *v; Scheme_Object *v, *v2;
v = argv[0]; v = argv[0];
if (!(SCHEME_HASHTP(v) && SCHEME_MUTABLEP(v)) && !SCHEME_BUCKTP(v)) v2 = (SCHEME_NP_CHAPERONEP(v) ? SCHEME_CHAPERONE_VAL(v) : v);
if (!(SCHEME_HASHTP(v2) && SCHEME_MUTABLEP(v2)) && !SCHEME_BUCKTP(v2))
scheme_wrong_contract("hash-clear!", "(and/c hash? (not/c immutable?))", 0, argc, argv); scheme_wrong_contract("hash-clear!", "(and/c hash? (not/c immutable?))", 0, argc, argv);
if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v)) if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v))
|| SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v)))) { || SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v)))) {
/* Implement `(hash-clear! ht)' as `(hash-for-each ht hash-set!)' /* Implement `(hash-clear! ht)' as `(hash-for-each ht (lambda (k) (hash-remove! ht k)))'
to allow chaperones to interpose. */ to allow chaperones to interpose. */
Scheme_Object *i, *a[2]; Scheme_Object *i, *a[2], *key;
a[0] = v; a[0] = v;
while (1) { while (1) {
i = scheme_hash_table_iterate_start(1, a); i = scheme_hash_table_iterate_start(1, a);
if (SCHEME_FALSEP(i)) if (SCHEME_FALSEP(i))
break; break;
a[2] = i;
hash_table_remove_bang(1, a); a[1] = i;
key = scheme_hash_table_iterate_key(2, a);
a[1] = key;
hash_table_remove_bang(2, a);
} }
} else if (SCHEME_BUCKTP(v)) { } else if (SCHEME_BUCKTP(v)) {
scheme_clear_bucket_table((Scheme_Bucket_Table *)v); scheme_clear_bucket_table((Scheme_Bucket_Table *)v);