- argument conversion for callbacks now work.

- added more tests in lab/test-ffi.ss

lab/test-ffi.ss

@@ -1,43 +1,107 @@
 
 (import (ikarus) (ikarus system $foreign))
 
+(define-syntax check
+  (syntax-rules ()
+    [(_ pred expr expected)
+     (begin 
+       (line)
+       (printf "TESTING ~s\n" 'expr)
+       (let ([v0 expr] [v1 expected])
+         (unless (pred v0 v1)
+           (error 'pred "failed" v0 v1)))
+       (printf "OK\n"))]))
+
+(define (line)
+  (printf "=========================================================\n"))
+
+
 (define self (dlopen #f))
 (define hosym (dlsym self "ho"))
 
 (define ho 
   ((make-ffi 'sint32 '(pointer sint32)) hosym))
 
-(define foradd1 
+(define traced-foradd1 
   ((make-callback 'sint32 '(sint32)) 
      (trace-lambda add1 (n) 
-       (printf "collecting ...\n")
        (collect)
-       (printf "collecting done\n")
        (add1 n))))
 
-(define foradd1^
+(define foradd1
   ((make-callback 'sint32 '(sint32))
      (lambda (n) 
-       (printf "collecting ...\n")
        (collect)
-       (printf "collecting done\n")
        (add1 n))))
 
-(define-syntax assert^
-  (syntax-rules ()
-    [(_ expr)
-     (begin 
-       (line)
-       (printf "TESTING ~s\n" 'expr)
-       (assert expr)
-       (printf "OK\n"))]))
+(define foradd1-by-foreign-call
+  ((make-callback 'sint32 '(sint32))
+     (trace-lambda foradd1-by-foreign-call (n) 
+       (/ (ho traced-foradd1 n) 2))))
+
+(check = (ho (dlsym self "cadd1") 17) (+ 18 18))
+(check = (ho foradd1 17) (+ 18 18))
+(check = (ho traced-foradd1 17) (+ 18 18))
+(check = (ho foradd1-by-foreign-call 17) (+ 18 18))
+
+
+(define test_I_I 
+  ((make-ffi 'sint32 '(pointer sint32)) (dlsym self "test_I_I")))
+(define test_I_II
+  ((make-ffi 'sint32 '(pointer sint32 sint32)) (dlsym self "test_I_II")))
+(define test_I_III
+  ((make-ffi 'sint32 '(pointer sint32 sint32 sint32)) (dlsym self "test_I_III")))
+
+(define C_add_I_I (dlsym self "add_I_I"))
+(define C_add_I_II (dlsym self "add_I_II"))
+(define C_add_I_III (dlsym self "add_I_III"))
+
+(check = (test_I_I C_add_I_I 12) (+ 12))
+(check = (test_I_II C_add_I_II 12 13) (+ 12 13))
+(check = (test_I_III C_add_I_III 12 13 14) (+ 12 13 14))
+
+(define S_add_I_I ((make-callback 'sint32 '(sint32)) +))
+(define S_add_I_II ((make-callback 'sint32 '(sint32 sint32)) +))
+(define S_add_I_III ((make-callback 'sint32 '(sint32 sint32 sint32)) +))
+
+(check = (test_I_I S_add_I_I 12) (+ 12))
+(check = (test_I_II S_add_I_II 12 13) (+ 12 13))
+(check = (test_I_III S_add_I_III 12 13 14) (+ 12 13 14))
+
+
+(define test_D_D 
+  ((make-ffi 'double '(pointer double)) (dlsym self "test_D_D")))
+(define test_D_DD
+  ((make-ffi 'double '(pointer double double)) (dlsym self "test_D_DD")))
+(define test_D_DDD
+  ((make-ffi 'double '(pointer double double double)) (dlsym self "test_D_DDD")))
+
+(define C_add_D_D (dlsym self "add_D_D"))
+(define C_add_D_DD (dlsym self "add_D_DD"))
+(define C_add_D_DDD (dlsym self "add_D_DDD"))
+
+(check = (test_D_D C_add_D_D 12.0) (+ 12.0))
+(check = (test_D_DD C_add_D_DD 12.0 13.0) (+ 12.0 13.0))
+(check = (test_D_DDD C_add_D_DDD 12.0 13.0 14.0) (+ 12.0 13.0 14.0))
+
+(define S_add_D_D ((make-callback 'double '(double)) +))
+(define S_add_D_DD ((make-callback 'double '(double double)) +))
+(define S_add_D_DDD ((make-callback 'double '(double double double)) +))
+
+(check = (test_D_D S_add_D_D 12.0) (+ 12.0))
+(check = (test_D_DD S_add_D_DD 12.0 13.0) (+ 12.0 13.0))
+(check = (test_D_DDD S_add_D_DDD 12.0 13.0 14.0) (+ 12.0 13.0 14.0))
+
+
+
+
+
+
+
+
+
 
-(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")