mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Add `pointer?'.

Browse source 
* 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?'.
This commit is contained in:
Ludovic Courtès 2011-01-30 22:47:35 +01:00
parent 690a0112e5
commit 6e0975603e
5 changed files with 22 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
doc/ref/api-foreign.texi
View file

@ -549,6 +549,10 @@ function that will be called when the pointer object becomes
unreachable. unreachable.
@end deffn @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 @defvr {Scheme Variable} %null-pointer
A foreign pointer whose value is 0. A foreign pointer whose value is 0.
@end defvr @end defvr

10
libguile/foreign.c
View file

@ -100,6 +100,16 @@ pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr))); 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_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
(SCM address, SCM finalizer), (SCM address, SCM finalizer),
"Return a foreign pointer object pointing to @var{address}. " "Return a foreign pointer object pointing to @var{address}. "

1
libguile/foreign.h
View file

@ -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_set_pointer_finalizer_x (SCM pointer, SCM finalizer);
SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset); 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 SCM scm_make_pointer (SCM address, SCM finalizer);
SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port, SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
scm_print_state *pstate); scm_print_state *pstate);

1
module/system/foreign.scm
View file

@ -35,6 +35,7 @@
%null-pointer %null-pointer
null-pointer? null-pointer?
pointer?
make-pointer make-pointer
pointer-address pointer-address

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

@ -30,6 +30,9 @@
(with-test-prefix "null pointer" (with-test-prefix "null pointer"
(pass-if "pointer?"
(pointer? %null-pointer))
(pass-if "zero" (pass-if "zero"
(= 0 (pointer-address %null-pointer))) (= 0 (pointer-address %null-pointer)))
@ -46,6 +49,9 @@
(with-test-prefix "make-pointer" (with-test-prefix "make-pointer"
(pass-if "pointer?"
(pointer? (make-pointer 123)))
(pass-if "address preserved" (pass-if "address preserved"
(= 123 (pointer-address (make-pointer 123)))) (= 123 (pointer-address (make-pointer 123))))