>From 50af6faf504fbc75cad33e99a03c539722e4147a Mon Sep 17 00:00:00 2001
From: Peter Bex <peter.bex@xs4all.nl>
Date: Tue, 28 Aug 2012 21:04:30 +0200
Subject: [PATCH] For copy-hash-table, after making a new hash table, reset
the hash function to the one of the original table. This
fixes #905 (thanks to Mario)
---
srfi-69.scm | 23 +++++++++++++----------
tests/hash-table-tests.scm | 3 ++-
2 files changed, 15 insertions(+), 11 deletions(-)
diff --git a/srfi-69.scm b/srfi-69.scm
index d8a2239..9fba35e 100644
a
|
b
|
|
664 | 664 | ;; hash-table-copy: |
665 | 665 | |
666 | 666 | (define *hash-table-copy |
667 | | (let ([make-vector make-vector]) |
| 667 | (let ((make-vector make-vector)) |
668 | 668 | (lambda (ht) |
669 | | (let* ([vec1 (##sys#slot ht 1)] |
670 | | [len (##sys#size vec1)] |
671 | | [vec2 (make-vector len '())] |
672 | | [ht2 (do ([i 0 (fx+ i 1)]) |
673 | | [(fx>= i len) |
| 669 | (let* ((vec1 (##sys#slot ht 1)) |
| 670 | (len (##sys#size vec1)) |
| 671 | (vec2 (make-vector len '())) |
| 672 | (ht2 (do ((i 0 (fx+ i 1))) |
| 673 | ((fx>= i len) |
674 | 674 | (*make-hash-table |
675 | 675 | (##sys#slot ht 3) (##sys#slot ht 4) |
676 | 676 | (##sys#slot ht 2) |
677 | 677 | (##sys#slot ht 5) (##sys#slot ht 6) |
678 | 678 | (##sys#slot ht 7) (##sys#slot ht 8) |
679 | | (##sys#slot ht 9) vec2)] |
| 679 | (##sys#slot ht 9) vec2)) |
680 | 680 | (##sys#setslot vec2 i |
681 | | (let copy-loop ([bucket (##sys#slot vec1 i)]) |
| 681 | (let copy-loop ((bucket (##sys#slot vec1 i))) |
682 | 682 | (if (null? bucket) |
683 | 683 | '() |
684 | | (let ([pare (##sys#slot bucket 0)]) |
| 684 | (let ((pare (##sys#slot bucket 0))) |
685 | 685 | (cons (cons (##sys#slot pare 0) (##sys#slot pare 1)) |
686 | | (copy-loop (##sys#slot bucket 1))))))) )]) |
| 686 | (copy-loop (##sys#slot bucket 1))))))) ))) |
| 687 | ;; Size and randomized hashing function are reset by *make-hash-table, |
| 688 | ;; so we copy over the ones from the original hash table. |
687 | 689 | (##sys#setslot ht2 2 (##sys#slot ht 2)) |
| 690 | (##sys#setslot ht2 10 (##sys#slot ht 10)) |
688 | 691 | ht2 ) ) ) ) |
689 | 692 | |
690 | 693 | (define (hash-table-copy ht) |
diff --git a/tests/hash-table-tests.scm b/tests/hash-table-tests.scm
index 91134b1..cd22df0 100644
a
|
b
|
|
212 | 212 | (print l " -- " (hash-table->alist ht2)) |
213 | 213 | (assert (equal? l (sort (hash-table->alist ht2) |
214 | 214 | (lambda (e1 e2) (< (car e1) (car e2)))))) |
215 | | |
| 215 | ;; Ensure that lookup still works (#905, randomization value was reset) |
| 216 | (assert (equal? '(a) (hash-table-ref ht2 1))) |