1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 11:10:21 +02:00

Implement `hash' for structs.

* libguile/hash.c (scm_hasher): Call `scm_i_struct_hash' upon
  `scm_tcs_struct'.
* libguile/struct.c (scm_i_struct_hash): New function.
* libguile/struct.h (scm_i_struct_hash): New declaration.

* test-suite/tests/structs.test ("hash"): New test prefix.
This commit is contained in:
Ludovic Courtès 2012-10-12 23:03:39 +02:00
parent 6996f07f57
commit 8ac870dee4
4 changed files with 98 additions and 2 deletions

View file

@ -126,7 +126,49 @@
(not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
(equal? (make-ball red "Bob") (make-ball red "Bill"))))))
(with-test-prefix "hash"
(pass-if "simple structs"
(let* ((v (make-vtable "pr"))
(s1 (make-struct v 0 "hello"))
(s2 (make-struct v 0 "hello")))
(= (hash s1 7777) (hash s2 7777))))
(pass-if "different structs"
(let* ((v (make-vtable "pr"))
(s1 (make-struct v 0 "hello"))
(s2 (make-struct v 0 "world")))
(or (not (= (hash s1 7777) (hash s2 7777)))
(throw 'unresolved))))
(pass-if "different struct types"
(let* ((v1 (make-vtable "pr"))
(v2 (make-vtable "pr"))
(s1 (make-struct v1 0 "hello"))
(s2 (make-struct v2 0 "hello")))
(or (not (= (hash s1 7777) (hash s2 7777)))
(throw 'unresolved))))
(pass-if "more complex structs"
(let ((s1 (make-ball red (string-copy "Bob")))
(s2 (make-ball red (string-copy "Bob"))))
(= (hash s1 7777) (hash s2 7777))))
(pass-if "struct with weird fields"
(let* ((v (make-vtable "prurph"))
(s1 (make-struct v 0 "hello" 123 "invisible-secret1"))
(s2 (make-struct v 0 "hello" 123 "invisible-secret2")))
(= (hash s1 7777) (hash s2 7777))))
(pass-if "cyclic structs"
(let* ((v (make-vtable "pw"))
(a (make-struct v 0 #f))
(b (make-struct v 0 a)))
(struct-set! a 0 b)
(and (hash a 7777) (hash b 7777) #t))))
;;
;; make-struct
;;