Enclosed is a patch for test-suite/tests/hash.test that contains, among
other things, the segfaulting behavior.
Best,
Grem
I managed to compile 1.8.3 on debian and it shows much the same error,
substituting a Segmentation Fault for bus error in the last case.
Guile 1.3.4 simply returns #f in both cases.
I'm inclined to start poking at guile's source code for the first time. Could
someone give me helpful pointers in the right general direction?
Thanks,
Grem
On Thu, 10 Jan 2008, Gregory Marton wrote:
I may be misunderstanding something, but I thought this should yield 'bar:
guile> (let ((ht (make-hash-table)))
(hashx-set! (lambda (k s) 1) equal? ht 'foo 'bar)
(hashx-ref (lambda (k s) 1) equal? ht 'foo))
#f
guile> (version)
"1.8.1"
much as this does:
guile> (let ((ht (make-hash-table)))
(hash-set! ht 'foo 'bar)
(hash-ref ht 'foo))
bar
I thought perhaps the problem was with the equality test somehow, but then
even worse:
guile> (let ((ht (make-hash-table)))
(hashx-set! (lambda (k s) 1) (lambda (a b) #t) ht 'foo 'bar)
(hashx-ref (lambda (k s) 1) (lambda (a b) #t) ht 'foo))
Bus error
Thanks much,
Grem
p.s. Ludovic, I haven't forgotten about the module docs -- it's just taking
me a while to learn what I need. Sorry.
--
------ __@ Gregory A. Marton http://csail.mit.edu/~gremio/
--- _`\<,_ .
-- (*)/ (*) /. -- news for nerds, stuff that matters.
~~~~~~~~~~~~~~~~-~~~~~~~~_~~~_~~~~~v~~~~^^^^~~~~~--~~~~~~~~~~~~~~~++~~~~~~~
--- test-suite/tests/hash.test.1.8.3 2008-01-12 04:52:45.000000000 -0500
+++ test-suite/tests/hash.test 2008-01-12 04:49:27.000000000 -0500
@@ -63,6 +63,143 @@
(pass-if (= 0 (hashq noop 1))))
;;;
+;;; make-hash-table
+;;;
+
+(with-test-prefix
+ "make-hash-table, hash-table?"
+ (pass-if-exception "make-hash-table -1" exception:out-of-range
+ (make-hash-table -1))
+ (pass-if (hash-table? (make-hash-table 0))) ;; default
+ (pass-if (not (hash-table? 'not-a-hash-table)))
+ (pass-if (equal? "#<hash-table 0/113>"
+ (with-output-to-string
+ (lambda () (write (make-hash-table 100)))))))
+
+;;;
+;;; usual set and reference
+;;;
+
+(with-test-prefix
+ "hash-set and hash-ref"
+
+ ;; auto-resizing
+ (pass-if (let ((table (make-hash-table 1))) ;;actually makes size 31
+ (hash-set! table 'one 1)
+ (hash-set! table 'two #t)
+ (hash-set! table 'three #t)
+ (hash-set! table 'four #t)
+ (hash-set! table 'five #t)
+ (hash-set! table 'six #t)
+ (hash-set! table 'seven #t)
+ (hash-set! table 'eight #t)
+ (hash-set! table 'nine 9)
+ (hash-set! table 'ten #t)
+ (hash-set! table 'eleven #t)
+ (hash-set! table 'twelve #t)
+ (hash-set! table 'thirteen #t)
+ (hash-set! table 'fourteen #t)
+ (hash-set! table 'fifteen #t)
+ (hash-set! table 'sixteen #t)
+ (hash-set! table 'seventeen #t)
+ (hash-set! table 18 #t)
+ (hash-set! table 19 #t)
+ (hash-set! table 20 #t)
+ (hash-set! table 21 #t)
+ (hash-set! table 22 #t)
+ (hash-set! table 23 #t)
+ (hash-set! table 24 #t)
+ (hash-set! table 25 #t)
+ (hash-set! table 26 #t)
+ (hash-set! table 27 #t)
+ (hash-set! table 28 #t)
+ (hash-set! table 29 #t)
+ (hash-set! table 30 'thirty)
+ (hash-set! table 31 #t)
+ (hash-set! table 32 #t)
+ (hash-set! table 33 'thirty-three)
+ (hash-set! table 34 #t)
+ (hash-set! table 35 #t)
+ (hash-set! table 'foo 'bar)
+ (and (equal? 1 (hash-ref table 'one))
+ (equal? 9 (hash-ref table 'nine))
+ (equal? 'thirty (hash-ref table 30))
+ (equal? 'thirty-three (hash-ref table 33))
+ (equal? 'bar (hash-ref table 'foo))
+ (equal? "#<hash-table 36/61>"
+ (with-output-to-string (lambda () (write table)))))))
+
+ ;; 1/2 and 2/4 are equal? and eqv? but not eq?
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hash-set! table 1/2 'foo)
+ (hash-ref table 2/4))))
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hashv-set! table 1/2 'foo)
+ (hashv-ref table 2/4))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashq-set! table 1/2 'foo)
+ (hashq-ref table 2/4))))
+
+ ;; (list 1 2) is equal? but not eqv? or eq? to another (list 1 2)
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hash-set! table (list 1 2) 'foo)
+ (hash-ref table (list 1 2)))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashv-set! table (list 1 2) 'foo)
+ (hashv-ref table (list 1 2)))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashq-set! table (list 1 2) 'foo)
+ (hashq-ref table (list 1 2)))))
+
+ ;; ref default argument
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hash-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashv-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashq-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashx-ref hash equal? table 'foo 'bar))))
+
+ ;; wrong type argument
+ (pass-if-exception "(hash-ref 'not-a-table 'key)" exception:wrong-type-arg
+ (hash-ref 'not-a-table 'key))
+ )
+
+;;;
+;;; hashx
+;;;
+
+(with-test-prefix
+ "hashx"
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! (lambda (k v) 1) (lambda (a b) #t) table 'foo 'bar)
+ (equal?
+ 'bar (hashx-ref (lambda (k v) 1) (lambda (a b) #t) table 'baz))))
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! (lambda (k v) 1) equal? table 'foo 'bar)
+ (equal?
+ 'bar (hashx-ref (lambda (k v) 1) equal? table 'baz))))
+ (pass-if (let ((table (make-hash-table 31)))
+ (hashx-set! (lambda (k v) 1) equal? table 'foo 'bar)
+ (equal? #f
+ (hashx-ref (lambda (k v) 2) equal? table 'foo))))
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! hash equal? table 'foo 'bar)
+ (equal? #f
+ (hashx-ref hash (lambda (a b) #f) table 'foo)))))
+
+;;;
;;; hashx-remove!
;;;
(with-test-prefix "hashx-remove!"
