fix a problem with hash-remove
When a key is removed at a level that other only has a collision table, the HAMT representation was not adjusted properly by eliminating the layer. As aresult, table comparison via `equal?` could fail. The problem could show up with hash tables used to represent scope sets, where an internal "subset?" test could fail and produce an incorrect binding resolution.
This commit is contained in:
parent
619ef41f7d
commit
9494216a9b
|
@ -2680,6 +2680,48 @@
|
|||
(for ([(k v) (in-hash ht2)])
|
||||
v))
|
||||
|
||||
;; Check remove in the vicinity of a hash collision:
|
||||
(let ()
|
||||
(struct a (x y)
|
||||
#:property prop:equal+hash
|
||||
(list
|
||||
(lambda (a b eql?) (and (equal? (a-x a)
|
||||
(a-x b))
|
||||
(equal? (a-y a)
|
||||
(a-y b))))
|
||||
(lambda (a hc) (a-x a))
|
||||
(lambda (a hc) 1)))
|
||||
|
||||
(define k (+ (arithmetic-shift 1 10) 1))
|
||||
(define k2 (+ (arithmetic-shift 1 15) 1))
|
||||
|
||||
;; The second hash here is intended to provoke a
|
||||
;; collision in a subtable, and then remove an
|
||||
;; element that causes the subtable, in which
|
||||
;; case the collision should be moved up a layer.
|
||||
(equal? (hash (a 1 'a) 1
|
||||
(a 1 'b) 2
|
||||
(a 2 'c) 3)
|
||||
(hash-remove (hash (a 1 'a) 1
|
||||
(a 1 'b) 2
|
||||
(a 2 'c) 3
|
||||
(a k 'd) 4)
|
||||
(a k 'd)))
|
||||
|
||||
;; The second hash here is meanto to provoke
|
||||
;; a similar shape as above, but where the
|
||||
;; nested table is created to distinguish
|
||||
;; hash keys instead of handle a collision,
|
||||
;; and so it should not be moved up.
|
||||
(equal? (hash (a 1 'a) 1
|
||||
(a k2 'b) 2
|
||||
(a 2 'c) 3)
|
||||
(hash-remove (hash (a 1 'a) 1
|
||||
(a k2 'b) 2
|
||||
(a 2 'c) 3
|
||||
(a k 'd) 4)
|
||||
(a k 'd))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Misc
|
||||
|
||||
|
|
|
@ -2690,7 +2690,9 @@ static Scheme_Hash_Tree *hamt_remove(Scheme_Hash_Tree *ht, uintptr_t code, int s
|
|||
return hamt_contract(ht, popcount, index, pos);
|
||||
ht = hamt_dup(ht, popcount);
|
||||
ht->count -= 1;
|
||||
if ((sub_ht->count == 1) && !HASHTR_SUBTREEP(sub_ht->els[0])) {
|
||||
if (((sub_ht->count == 1) && !HASHTR_SUBTREEP(sub_ht->els[0]))
|
||||
|| (HASHTR_COLLISIONP(sub_ht->els[0])
|
||||
&& (sub_ht->count == ((Scheme_Hash_Tree *)sub_ht->els[0])->count))) {
|
||||
/* drop extra layer that has 1 immediate entry */
|
||||
ht->els[pos] = sub_ht->els[0];
|
||||
if (SCHEME_HASHTR_FLAGS(ht) & HASHTR_HAS_VAL) {
|
||||
|
|
Loading…
Reference in New Issue
Block a user