mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

Define `equal?' for pointer objects.

Browse source 
* libguile/eq.c (scm_equal_p): Handle pointer objects.

* test-suite/tests/foreign.test ("make-pointer")["equal?", "equal?
  modulo finalizer", "not equal?"]: New tests.
This commit is contained in:
Ludovic Courtès 2010-09-23 10:55:24 +02:00
parent fb5c4dc523
commit cb2d8076ef
2 changed files with 15 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/eq.c
View file

@ -303,6 +303,9 @@ scm_equal_p (SCM x, SCM y)
else else
goto generic_equal; goto generic_equal;
} }
if (SCM_POINTER_P (x) && SCM_POINTER_P (y))
return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
/* This ensures that types and scm_length are the same. */ /* This ensures that types and scm_length are the same. */
if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y)) if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
{ {

13
test-suite/tests/foreign.test
View file

@ -47,7 +47,18 @@
(with-test-prefix "make-pointer" (with-test-prefix "make-pointer"
(pass-if "address preserved" (pass-if "address preserved"
(= 123 (pointer-address (make-pointer 123))))) (= 123 (pointer-address (make-pointer 123))))
(pass-if "equal?"
(equal? (make-pointer 123) (make-pointer 123)))
(pass-if "equal? modulo finalizer"
(let ((finalizer (dynamic-func "scm_is_pair" (dynamic-link))))
(equal? (make-pointer 123)
(make-pointer 123 finalizer))))
(pass-if "not equal?"
(not (equal? (make-pointer 123) (make-pointer 456)))))
(with-test-prefix "pointer<->bytevector" (with-test-prefix "pointer<->bytevector"