suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ffi: fix prop:cpointer so that it works with a procedure value

Browse Source
This commit is contained in:
Jon Zeppieri 2012-12-03 18:47:12 -05:00 committed by Matthew Flatt
parent a193cd9efb
commit 8489448e42
3 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/racket/foreign-test.rktl
View File

@ -463,6 +463,18 @@
(test (cast p _thing-pointer _intptr)
cast q _stuff-pointer _intptr))
(let ()
(struct foo (ptr)
#:property prop:cpointer 0)
(define a-foo (foo (malloc 16 'raw)))
(free a-foo)
(struct bar (ptr)
#:property prop:cpointer (λ (s) (bar-ptr s)))
(define a-bar (bar (malloc 16 'raw)))
(free a-bar))
(delete-test-files)
(report-errs)

2
src/foreign/foreign.c
View File

@ -1532,7 +1532,7 @@ static Scheme_Object *unwrap_cpointer_property(Scheme_Object *orig_v)
if (val) {
if (SCHEME_INTP(val))
v = scheme_struct_ref(v, SCHEME_INT_VAL(val));
else if (SCHEME_PROCP(v)) {
else if (SCHEME_PROCP(val)) {
Scheme_Object *a[1];
a[0] = v;
v = _scheme_apply(val, 1, a);

2
src/foreign/foreign.rktc
View File

@ -1320,7 +1320,7 @@ static Scheme_Object *unwrap_cpointer_property(Scheme_Object *orig_v)
if (val) {
if (SCHEME_INTP(val))
v = scheme_struct_ref(v, SCHEME_INT_VAL(val));
else if (SCHEME_PROCP(v)) {
else if (SCHEME_PROCP(val)) {
Scheme_Object *a[1];
a[0] = v;
v = _scheme_apply(val, 1, a);