ffi callbacks sorta kinda work now.

2008-09-21 04:08:54 -04:00
parent 06fd988a17
commit e07d8f9760
11 changed files with 224 additions and 46 deletions
@@ -0,0 +1,37 @@
+
+(import (ikarus) (ikarus system $foreign))
+
+(define self (dlopen #f))
+(define hosym (dlsym self "ho"))
+
+(define ho 
+  ((make-ffi 'sint32 '(pointer sint32)) hosym))
+
+(define foradd1 
+  ((make-callback 'sint32 '(sint32)) 
+     (trace-lambda add1 (n) 
+       (add1 n))))
+
+(define foradd1^
+  ((make-callback 'sint32 '(sint32))
+     (lambda (n) 
+       (add1 n))))
+
+(define-syntax assert^
+  (syntax-rules ()
+    [(_ expr)
+     (begin 
+       (line)
+       (printf "TESTING ~s\n" 'expr)
+       (assert expr)
+       (printf "OK\n"))]))
+
+(define (line)
+  (printf "=========================================================\n"))
+
+(assert^ (= (ho (dlsym self "cadd1") 17) (+ 18 18)))
+(assert^ (= (ho foradd1^ 17) (+ 18 18)))
+(assert^ (= (ho foradd1 17) (+ 18 18)))
+
+(line)
+(printf "Happy Happy Joy Joy\n")