fix hash-ref' bugs on immutable eq?'-based tables

There were two:
   * new: after finding a hash code, the key wasn't
          always checked to be `eq?' to the desired key
   * old: the hash code wan't downshifted by 2, so
          changes in the low two bits (like when a pair
          is determined to start a list) could break
          lookup

 Merge to 5.1.2
This commit is contained in:
Matthew Flatt 2011-07-09 20:09:41 -06:00
parent 35c9bd90ab
commit e765231dad
3 changed files with 22 additions and 11 deletions

View File

@ -2388,9 +2388,11 @@
(check-all-bad hash-iterate-key) (check-all-bad hash-iterate-key)
(check-all-bad hash-iterate-value)) (check-all-bad hash-iterate-value))
(test (list 1 2 3) hash-keys #hasheq((1 . a)(2 . b)(3 . c))) (test (list 1 2 3) sort (hash-keys #hasheq((1 . a) (2 . b) (3 . c))) <)
(test (list 'a 'b 'c) hash-values #hasheq((1 . a)(2 . b)(3 . c))) (test (list 'a 'b 'c)
(test (list (cons 1 'a) (cons 2 'b) (cons 3 'c)) hash->list #hasheq((1 . a)(2 . b)(3 . c))) sort (hash-values #hasheq((1 . a) (2 . b) (3 . c))) string<? #:key symbol->string)
(test (list (cons 1 'a) (cons 2 'b) (cons 3 'c))
sort (hash->list #hasheq((1 . a) (2 . b) (3 . c))) < #:key car)
(err/rt-test (hash-set*! im-t 1 2) exn:fail?) (err/rt-test (hash-set*! im-t 1 2) exn:fail?)
(err/rt-test (hash-set* (make-hasheq null) 1 2) exn:fail?) (err/rt-test (hash-set* (make-hasheq null) 1 2) exn:fail?)
@ -2495,6 +2497,19 @@
(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)))) (test (equal-secondary-hash-code ht) values (equal-secondary-hash-code ht2))))
;; Check that immutable hash trees aren't confused by an
;; "is a list" bit set in a key:
(let ()
(define p (list 1 2 3 4))
(define ht (hasheq p 1 'a 7 'b 10 'c 13))
(test 1 hash-ref ht p #f)
(list? p)
(list? p)
(list? (list* 1 2 p))
(list? (list* 1 2 p))
(list? (list* 1 2 p))
(test 1 hash-ref ht p #f))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc ;; Misc

View File

@ -2276,6 +2276,7 @@ Scheme_Hash_Tree *scheme_hash_tree_set(Scheme_Hash_Tree *tree, Scheme_Object *ke
} }
} else { } else {
h = PTR_TO_LONG((Scheme_Object *)key); h = PTR_TO_LONG((Scheme_Object *)key);
h = h >> 2;
} }
if (!val) { if (!val) {
@ -2417,6 +2418,7 @@ Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *ke
RBNode *rb; RBNode *rb;
h = PTR_TO_LONG((Scheme_Object *)key); h = PTR_TO_LONG((Scheme_Object *)key);
h = h >> 2;
rb = rb_find(h, tree->root); rb = rb_find(h, tree->root);
if (rb) { if (rb) {
@ -2429,7 +2431,7 @@ Scheme_Object *scheme_eq_hash_tree_get(Scheme_Hash_Tree *tree, Scheme_Object *ke
return SCHEME_CDR(a); return SCHEME_CDR(a);
prs = SCHEME_CDR(prs); prs = SCHEME_CDR(prs);
} }
} else } else if (SAME_OBJ(rb->key, key))
return rb->val; return rb->val;
} }

View File

@ -258,12 +258,6 @@ typedef struct Thread_Cell {
Scheme_Object so; Scheme_Object so;
char inherited, assigned; char inherited, assigned;
Scheme_Object *def_val; Scheme_Object *def_val;
/* A thread's thread_cell table maps cells to keys weakly.
This table maps keys to values weakly. The two weak
levels ensure that thread cells are properly GCed
when the value of a thread cell references the thread
cell. */
Scheme_Bucket_Table *vals;
} Thread_Cell; } Thread_Cell;
#ifdef MZ_PRECISE_GC #ifdef MZ_PRECISE_GC