diff --git a/pkgs/racket-test-core/tests/racket/hash.rktl b/pkgs/racket-test-core/tests/racket/hash.rktl index bc6615c580..fb41a3bc31 100644 --- a/pkgs/racket-test-core/tests/racket/hash.rktl +++ b/pkgs/racket-test-core/tests/racket/hash.rktl @@ -112,6 +112,10 @@ ;; 5 bits for both keys: (define ht3 (hash (a 1 0) #t (a 33 0) #t)) + ;; A hash with the same (colliding) keys as h1 but + ;; different values: + (define ht4 (hash (a 1 0) #f + (a 1 2) #f)) ;; Subset must compare a collision node with a subtree node (that ;; contains a collision node): @@ -125,7 +129,18 @@ (test #f hash-keys-subset? ht2 ht1) (test #f hash-keys-subset? ht2 ht0) (test #f hash-keys-subset? ht1 ht0) - (test #f hash-keys-subset? ht1 ht3)) + (test #f hash-keys-subset? ht1 ht3) + + ;; Equality of collision nodes: + (test #f equal? ht1 ht4) + (let ([ht4a (hash-set ht4 (a 1 0) #t)] + [ht4b (hash-set ht4 (a 1 2) #t)] + [ht5 (hash-set* ht4 + (a 1 0) #t + (a 1 2) #t)]) + (test #f equal? ht1 ht4a) + (test #f equal? ht1 ht4b) + (test #t equal? ht1 ht5))) (let () (define-syntax (define-hash-iterations-tester stx) diff --git a/racket/src/cs/rumble/intmap.ss b/racket/src/cs/rumble/intmap.ss index 5a62859b82..0efc152335 100644 --- a/racket/src/cs/rumble/intmap.ss +++ b/racket/src/cs/rumble/intmap.ss @@ -206,12 +206,6 @@ [(key=? et key (caar xs)) (loop (cdr xs))] [else (cons (car xs) (loop (cdr xs)))]))) -(define ($collision-has-key? et t key) - (let loop ([xs (Co-pairs t)]) - (cond [(null? xs) #f] - [(key=? et key (caar xs)) #t] - [else (loop (cdr xs))]))) - ;; bit twiddling (define-syntax-rule (match-prefix? h p m) (fx= (mask h m) p)) @@ -390,9 +384,13 @@ (let ([xs (Co-pairs a)]) (and (fx= (length xs) (length (Co-pairs b))) (let loop ([xs xs]) - (cond [(null? xs) #t] - [($collision-has-key? et b (caar xs)) (loop (cdr xs))] - [else #f])))))] + (cond [(null? xs) + #t] + [else + (let ([pair ($collision-ref et b (caar xs) values #f)]) + (and pair + (eql? (cdar xs) (cdr pair)) + (loop (cdr xs))))])))))] [else (and (not a) (not b))])))