~ chicken-core (chicken-5) 735a6304b138dce0ca5a47577ff23a9a884d12df

commit 735a6304b138dce0ca5a47577ff23a9a884d12df
Author:     Christian Kellermann <ckeen@pestilenz.org>
AuthorDate: Mon Jul 16 11:39:10 2012 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jul 17 13:05:53 2012 +0200

    Set hash-table size to number of entries in hash-table-copy
    
    As reported by John Croisant before this patch hash-table-copied
    tables would report a size of 0.  This is due to *make-hash-table
    setting the number of entries to 0 regardless of the size of the
    hash-table's vector.
    
    This patch also adds a test to the testsuite.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/srfi-69.scm b/srfi-69.scm
index 67ee4a85..d8a22399 100644
--- a/srfi-69.scm
+++ b/srfi-69.scm
@@ -668,22 +668,24 @@
     (lambda (ht)
       (let* ([vec1 (##sys#slot ht 1)]
 	     [len (##sys#size vec1)]
-	     [vec2 (make-vector len '())] )
-	(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#setslot vec2 i
-	   (let copy-loop ([bucket (##sys#slot vec1 i)])
-	     (if (null? bucket)
-		 '()
-		 (let ([pare (##sys#slot bucket 0)])
-		   (cons (cons (##sys#slot pare 0) (##sys#slot pare 1))
-			 (copy-loop (##sys#slot bucket 1))))))) ) ) ) ) )
+	     [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#setslot vec2 i
+                                   (let copy-loop ([bucket (##sys#slot vec1 i)])
+                                     (if (null? bucket)
+                                         '()
+                                         (let ([pare (##sys#slot bucket 0)])
+                                           (cons (cons (##sys#slot pare 0) (##sys#slot pare 1))
+                                                 (copy-loop (##sys#slot bucket 1))))))) )])
+        (##sys#setslot ht2 2 (##sys#slot ht 2))
+        ht2 ) ) ) )
 
 (define (hash-table-copy ht)
   (##sys#check-structure ht 'hash-table 'hash-table-copy)
diff --git a/tests/hash-table-tests.scm b/tests/hash-table-tests.scm
index ff13c83d..91134b16 100644
--- a/tests/hash-table-tests.scm
+++ b/tests/hash-table-tests.scm
@@ -204,3 +204,12 @@
       [(fx= i stress-size)]
     (assert (fx= i (hash-table-ref ht i))) ) )
 
+(print "HT - copy")
+(define l '((1 a) (2 b) (3 c)))
+(set! ht (alist->hash-table l))
+(define ht2 (hash-table-copy ht))
+(assert (= (hash-table-size ht2) (hash-table-size ht)))
+(print l " -- " (hash-table->alist ht2))
+(assert (equal? l (sort (hash-table->alist ht2)
+                        (lambda (e1 e2) (< (car e1) (car e2))))))
+