From 443f25dcff49f0a920d4149e29bcb3ae9f64ee02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 29 Mar 2011 23:35:24 +0200 Subject: [PATCH] Fix `procedure->pointer' for functions returning `void'. * libguile/foreign.c (unpack): Handle `FFI_TYPE_VOID'. * test-suite/tests/foreign.test ("procedure->pointer")["procedures returning void"]: New test. Reported by Tristan Colgate . --- libguile/foreign.c | 3 +++ test-suite/tests/foreign.test | 10 ++++++++++ 2 files changed, 13 insertions(+) diff --git a/libguile/foreign.c b/libguile/foreign.c index 494ab5b4c..dbfba8770 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -905,6 +905,9 @@ unpack (const ffi_type *type, void *loc, SCM x) SCM_VALIDATE_POINTER (1, x); *(void **) loc = SCM_POINTER_VALUE (x); break; + case FFI_TYPE_VOID: + /* Do nothing. */ + break; default: abort (); } diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test index 3ff232eb2..93e5fe1ca 100644 --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@ -225,6 +225,16 @@ (arg3 (map (cut / <> 4.0) (iota 123 100 4)))) (equal? (map proc arg1 arg2 arg3) (map proc* arg1 arg2 arg3))) + (throw 'unresolved))) + + (pass-if "procedures returning void" + (if (defined? 'procedure->pointer) + (let* ((called? #f) + (proc (lambda () (set! called? #t))) + (pointer (procedure->pointer void proc '())) + (proc* (pointer->procedure void pointer '()))) + (proc*) + called?) (throw 'unresolved))))