Ticket #905: 0001-For-copy-hash-table-after-making-a-new-hash-table-re.patch

srfi-69.scm

@@ -664 +664 @@
 ;; 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)

tests/hash-table-tests.scm

@@ -212 +212 @@
 (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)))