summaryrefslogtreecommitdiff
path: root/test-suite/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2011-11-16 23:51:34 +0100
committerLudovic Courtès <ludo@gnu.org>2011-11-16 23:51:34 +0100
commit449c4d44d0dd82749ca1eb8cfeb2ba025caf6eaa (patch)
tree36cfeec524341fee6dfd1702d80581ef3550f59b /test-suite/tests
parent4b4b1e0b7044d47adcfabf28d57a31b2126e54ee (diff)
downloadguile-449c4d44d0dd82749ca1eb8cfeb2ba025caf6eaa.tar.gz
FFI: Add a `procedure->pointer' test.
* test-suite/tests/foreign.test ("procedure->pointer")["procedures returning a pointer"]: New test.
Diffstat (limited to 'test-suite/tests')
-rw-r--r--test-suite/tests/foreign.test10
1 files changed, 10 insertions, 0 deletions
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 5ddd31c1d..5657977d7 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -254,6 +254,16 @@
(map proc* arg1 arg2 arg3)))
(throw 'unresolved)))
+ (pass-if "procedures returning a pointer"
+ (if (defined? 'procedure->pointer)
+ (let* ((called? #f)
+ (proc (lambda (i) (set! called? #t) (make-pointer i)))
+ (pointer (procedure->pointer '* proc (list int)))
+ (proc* (pointer->procedure '* pointer (list int)))
+ (result (proc* 777)))
+ (and called? (equal? result (make-pointer 777))))
+ (throw 'unresolved)))
+
(pass-if "procedures returning void"
(if (defined? 'procedure->pointer)
(let* ((called? #f)