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

fix missed parts of the hash-table hahing bug

Browse Source
This commit is contained in:
Matthew Flatt 2010-06-23 07:09:59 -10:00
parent ccd13c4862
commit 42c7b2b9d3
2 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/tests/racket/basic.rktl
View File

@ -2351,6 +2351,9 @@
(let ()
(define ht (make-hash))
(define ht2 (make-hash))
(define wht (make-weak-hash))
(define wht2 (make-weak-hash))
(define keys (make-hash))
(struct a (x) #:transparent)
@ -2373,19 +2376,31 @@
i))
(define l2 (shuffle 7 l))
(define (reg v)
(hash-set! keys v #t)
v)
(for ([i (in-list l)])
(hash-set! ht (a i) (a (a i))))
(for ([i (in-list l2)])
(hash-set! ht2 (a i) (a (a i))))
(for ([i (in-list l)])
(hash-set! wht (reg (a i)) (a (a i))))
(for ([i (in-list l2)])
(hash-set! wht2 (reg (a i)) (a (a i))))
(test (equal-hash-code ht) values (equal-hash-code ht2))
(test (equal-hash-code wht) values (equal-hash-code wht2))
(test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))
(let ([ht (for/hash ([i (in-list l)])
(values (a i) (a (a i))))]
[ht2 (for/hash ([i (in-list l2)])
(values (a i) (a (a i))))])
(test (equal-hash-code ht) values (equal-hash-code ht2))))
(test (equal-hash-code ht) values (equal-hash-code ht2))
(test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc

16
src/racket/src/hash.c
View File

@ -1261,13 +1261,14 @@ static long equal_hash_key(Scheme_Object *o, long k, Hash_Info *hi)
Scheme_Bucket **buckets, *bucket;
const char *key;
int i, weak;
long vk;
long vk, old_depth;
# include "mzhashchk.inc"
buckets = ht->buckets;
weak = ht->weak;
hi->depth += 2;
old_depth = hi->depth;
k = (k << 1) + 7;
@ -1285,6 +1286,7 @@ static long equal_hash_key(Scheme_Object *o, long k, Hash_Info *hi)
vk += equal_hash_key((Scheme_Object *)key, 0, hi);
MZ_MIX(vk);
k += vk; /* can't mix k, because the key order shouldn't matter */
hi->depth = old_depth; /* also needed to avoid order-sensitivity */
}
}
}
@ -1610,11 +1612,12 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
Scheme_Hash_Table *ht = (Scheme_Hash_Table *)o;
Scheme_Object **vals, **keys;
int i;
long k = 0;
long k = 0, old_depth;
# include "mzhashchk.inc"
hi->depth += 2;
old_depth = hi->depth;
keys = ht->keys;
vals = ht->vals;
@ -1622,6 +1625,7 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
if (vals[i]) {
k += equal_hash_key2(keys[i], hi);
k += equal_hash_key2(vals[i], hi);
hi->depth = old_depth;
}
}
@ -1632,16 +1636,18 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
Scheme_Hash_Tree *ht = (Scheme_Hash_Tree *)o;
Scheme_Object *iv, *ik;
int i;
long k = 0;
long k = 0, old_depth;
# include "mzhashchk.inc"
hi->depth += 2;
old_depth = hi->depth;
for (i = ht->count; i--; ) {
scheme_hash_tree_index(ht, i, &ik, &iv);
k += equal_hash_key2(ik, hi);
k += equal_hash_key2(iv, hi);
hi->depth = old_depth;
}
return k;
@ -1652,7 +1658,7 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
Scheme_Bucket **buckets, *bucket;
const char *key;
int i, weak;
long k = 0;
long k = 0, old_depth;
# include "mzhashchk.inc"
@ -1660,6 +1666,7 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
weak = ht->weak;
hi->depth += 2;
old_depth = hi->depth;
for (i = ht->size; i--; ) {
bucket = buckets[i];
@ -1672,6 +1679,7 @@ static long equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
if (key) {
k += equal_hash_key2((Scheme_Object *)bucket->val, hi);
k += equal_hash_key2((Scheme_Object *)key, hi);
old_depth = hi->depth;
}
}
}