summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/foreign.c9
-rw-r--r--libguile/foreign.h1
-rw-r--r--test-suite/standalone/test-loose-ends.c17
3 files changed, 27 insertions, 0 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 611b08fac..b3d1cc69a 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -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)
{
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 75e3bf529..41c0b657d 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -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);
diff --git a/test-suite/standalone/test-loose-ends.c b/test-suite/standalone/test-loose-ends.c
index ee0fcf3f3..b4ea5b94a 100644
--- a/test-suite/standalone/test-loose-ends.c
+++ b/test-suite/standalone/test-loose-ends.c
@@ -75,11 +75,28 @@ test_scm_call ()
}
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