~ chicken-core (chicken-5) d6c0b818e308d6cf7878035d21aa3da8282d5c83

commit d6c0b818e308d6cf7878035d21aa3da8282d5c83
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Tue Aug 28 21:04:30 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Aug 28 21:17:47 2012 +0200

    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)
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/srfi-69.scm b/srfi-69.scm
index d8a22399..9fba35e6 100644
--- a/srfi-69.scm
+++ b/srfi-69.scm
@@ -664,27 +664,30 @@
 ;; hash-table-copy:
 
 (define *hash-table-copy
-  (let ([make-vector make-vector])
+  (let ((make-vector make-vector))
     (lambda (ht)
-      (let* ([vec1 (##sys#slot ht 1)]
-	     [len (##sys#size vec1)]
-	     [vec2 (make-vector len '())]
-             [ht2 (do ([i 0 (fx+ i 1)])
-                      [(fx>= i len)
+      (let* ((vec1 (##sys#slot ht 1))
+	     (len (##sys#size vec1))
+	     (vec2 (make-vector len '()))
+             (ht2 (do ((i 0 (fx+ i 1)))
+                      ((fx>= i len)
                        (*make-hash-table
                         (##sys#slot ht 3) (##sys#slot ht 4)
                         (##sys#slot ht 2)
                         (##sys#slot ht 5) (##sys#slot ht 6)
                         (##sys#slot ht 7) (##sys#slot ht 8)
-                        (##sys#slot ht 9) vec2)]
+                        (##sys#slot ht 9) vec2))
                     (##sys#setslot vec2 i
-                                   (let copy-loop ([bucket (##sys#slot vec1 i)])
+                                   (let copy-loop ((bucket (##sys#slot vec1 i)))
                                      (if (null? bucket)
                                          '()
-                                         (let ([pare (##sys#slot bucket 0)])
+                                         (let ((pare (##sys#slot bucket 0)))
                                            (cons (cons (##sys#slot pare 0) (##sys#slot pare 1))
-                                                 (copy-loop (##sys#slot bucket 1))))))) )])
+                                                 (copy-loop (##sys#slot bucket 1))))))) )))
+        ;; Size and randomized hashing function are reset by *make-hash-table,
+        ;; so we copy over the ones from the original hash table.
         (##sys#setslot ht2 2 (##sys#slot ht 2))
+        (##sys#setslot ht2 10 (##sys#slot ht 10))
         ht2 ) ) ) )
 
 (define (hash-table-copy ht)
diff --git a/tests/hash-table-tests.scm b/tests/hash-table-tests.scm
index 91134b16..cd22df07 100644
--- a/tests/hash-table-tests.scm
+++ b/tests/hash-table-tests.scm
@@ -212,4 +212,5 @@
 (print l " -- " (hash-table->alist ht2))
 (assert (equal? l (sort (hash-table->alist ht2)
                         (lambda (e1 e2) (< (car e1) (car e2))))))
-
+;; Ensure that lookup still works (#905, randomization value was reset)
+(assert (equal? '(a) (hash-table-ref ht2 1)))