Hi, below is a patch that adresses the issue brought to our attention by John Croisant on chicken-users.
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. There is a deeper issue here. The size parameter for *make-hash-table is used to propagate the vector's size holding the buckets. This defaults to 307. For this reason the size *slot* in the hash-table-structure is always set to 0. This patch resets the size slot *after* the call to *make-hash-table to the real number of entries. I am not sure whether *make-hash-table should be rewritten to use the size parameter properly though. On the pro side this patch has no impact on the other procedures involved. Does this help at all ;) Christian -- 9 out of 10 voices in my head say, that I am crazy, one is humming.
>From 57108d43800b1f24856735841de01c3b4c79a8d1 Mon Sep 17 00:00:00 2001 From: Christian Kellermann <[email protected]> Date: Mon, 16 Jul 2012 11:39:10 +0200 Subject: [PATCH] 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. --- srfi-69.scm | 34 ++++++++++++++++++---------------- tests/hash-table-tests.scm | 9 +++++++++ 2 files changed, 27 insertions(+), 16 deletions(-) diff --git a/srfi-69.scm b/srfi-69.scm index 67ee4a8..d8a2239 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 ff13c83..91134b1 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)))))) + -- 1.7.9.5
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
