diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-01-30 22:47:35 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-01-30 23:29:30 +0100 |
commit | 6e0975603eb4e568def1a91f9b127a6a35bdbe44 (patch) | |
tree | 812e89fcf384ab9e76889d59dede9f02fe595c57 | |
parent | 690a0112e55823aa8b862daeddcf44cea97e7917 (diff) | |
download | guile-6e0975603eb4e568def1a91f9b127a6a35bdbe44.tar.gz |
Add `pointer?'.
* libguile/foreign.c (scm_pointer_p): New function.
* libguile/foreign.h (scm_pointer_p): New declaration.
* module/system/foreign.scm: Export `pointer?'.
* test-suite/tests/foreign.test ("null pointer")["pointer?"]: New
test.
("make-pointer")["pointer?"]: New test.
* doc/ref/api-foreign.texi (Foreign Variables): Document `pointer?'.
-rw-r--r-- | doc/ref/api-foreign.texi | 4 | ||||
-rw-r--r-- | libguile/foreign.c | 10 | ||||
-rw-r--r-- | libguile/foreign.h | 1 | ||||
-rw-r--r-- | module/system/foreign.scm | 1 | ||||
-rw-r--r-- | test-suite/tests/foreign.test | 6 |
5 files changed, 22 insertions, 0 deletions
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index 9b9e481dc..f275242ba 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -549,6 +549,10 @@ function that will be called when the pointer object becomes unreachable. @end deffn +@deffn {Scheme Procedure} pointer? obj +Return @code{#t} if @var{obj} is a pointer object, @code{#f} otherwise. +@end deffn + @defvr {Scheme Variable} %null-pointer A foreign pointer whose value is 0. @end defvr diff --git a/libguile/foreign.c b/libguile/foreign.c index 2402ad1f6..52da23f6e 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -100,6 +100,16 @@ pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data) finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr))); } +SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0, + (SCM obj), + "Return @code{#t} if @var{obj} is a pointer object, " + "@code{#f} otherwise.\n") +#define FUNC_NAME s_scm_pointer_p +{ + return scm_from_bool (SCM_POINTER_P (obj)); +} +#undef FUNC_NAME + SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0, (SCM address, SCM finalizer), "Return a foreign pointer object pointing to @var{address}. " diff --git a/libguile/foreign.h b/libguile/foreign.h index 825b1af7d..b29001962 100644 --- a/libguile/foreign.h +++ b/libguile/foreign.h @@ -66,6 +66,7 @@ SCM_API SCM scm_pointer_to_bytevector (SCM pointer, SCM type, SCM_API SCM scm_set_pointer_finalizer_x (SCM pointer, SCM finalizer); SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset); +SCM_INTERNAL SCM scm_pointer_p (SCM obj); SCM_INTERNAL SCM scm_make_pointer (SCM address, SCM finalizer); SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate); diff --git a/module/system/foreign.scm b/module/system/foreign.scm index a8779e421..4b0618b96 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -35,6 +35,7 @@ %null-pointer null-pointer? + pointer? make-pointer pointer-address diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index dc7371412..a0ded0b7a 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -30,6 +30,9 @@ (with-test-prefix "null pointer" + (pass-if "pointer?" + (pointer? %null-pointer)) + (pass-if "zero" (= 0 (pointer-address %null-pointer))) @@ -46,6 +49,9 @@ (with-test-prefix "make-pointer" + (pass-if "pointer?" + (pointer? (make-pointer 123))) + (pass-if "address preserved" (= 123 (pointer-address (make-pointer 123)))) |