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:
Matthew Flatt 2016-02-22 15:21:56 -07:00
parent 619ef41f7d
commit 9494216a9b
2 changed files with 45 additions and 1 deletions

View File

@ -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

View File

@ -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) {