mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Implement scm_to_pointer

Browse source 
* libguile/foreign.c, libguile/foreign.h (scm_to_pointer):
  New C function.

* test-suite/standalone/test-loose-ends.c: Add test.
This commit is contained in:
Mark H Weaver 2012-02-02 17:23:35 -05:00
parent 7fb9c4aff2
commit 1d00abb04f
3 changed files with 27 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

9
libguile/foreign.c
View file

@ -139,6 +139,15 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
}
#undef FUNC_NAME
void *
scm_to_pointer (SCM pointer)
#define FUNC_NAME "scm_to_pointer"
{
SCM_VALIDATE_POINTER (1, pointer);
return SCM_POINTER_VALUE (pointer);
}
#undef FUNC_NAME
SCM
scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
{

1
libguile/foreign.h
View file

@ -55,6 +55,7 @@ typedef void (*scm_t_pointer_finalizer) (void *);
#define SCM_POINTER_VALUE(x) \
((void *) SCM_CELL_WORD_1 (x))
SCM_API void *scm_to_pointer (SCM pointer);
SCM_API SCM scm_from_pointer (void *, scm_t_pointer_finalizer);
SCM_API SCM scm_alignof (SCM type);

17
test-suite/standalone/test-loose-ends.c
View file

@ -74,12 +74,29 @@ test_scm_call ()
assert (scm_is_eq (result, SCM_EOL));
}
static void
test_scm_to_pointer ()
{
int (*add3) (int a, int b, int c);
SCM int_type = scm_c_public_ref ("system foreign", "int");
add3 = scm_to_pointer
(scm_procedure_to_pointer (int_type,
scm_c_public_ref ("guile", "+"),
scm_list_3 (int_type,
int_type,
int_type)));
assert ((*add3) (1000000, 1000, -1) == 1000999);
}
static void
tests (void *data, int argc, char **argv)
{
test_scm_from_locale_keywordn ();
test_scm_local_eval ();
test_scm_call ();
test_scm_to_pointer ();
}
int