Hi all,

As Ivan found out the hard way, I forgot to modify hash-table-copy
when introducing the new randomization factor.  Funny enough, the
tests did check whether the copied hash table has the same contents,
but it doesn't reference any values in the hash table, which means
the tests for copying passed with flying colours even though the
hash table would effectively be unusable.

I was a little tired yesterday, but meanwhile our tireless friend Mario
found the bug and proposed a patch.  Here it is as a git changeset, with
a small tweak to the regression tests to catch this situation.

Cheers,
Peter
-- 
http://sjamaan.ath.cx
--
"The process of preparing programs for a digital computer
 is especially attractive, not only because it can be economically
 and scientifically rewarding, but also because it can be an aesthetic
 experience much like composing poetry or music."
                                                        -- Donald Knuth
>From 50af6faf504fbc75cad33e99a03c539722e4147a Mon Sep 17 00:00:00 2001
From: Peter Bex <[email protected]>
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/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 91134b1..cd22df0 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)))
-- 
1.7.9.1

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to