~ chicken-core (master) /tests/ffi-tests.scm

 1;;; FFI tests
 2
 3(import (only (scheme base) open-output-string get-output-string))
 4(import (chicken memory representation))
 5
 6(include "test.scm")
 7             
 8(import (chicken foreign))
 9                             
10(foreign-declare "typedef struct foo {int x;} FOO; 
11int bar(struct foo x) {return x.x;}
12struct foo baz(int x) {struct foo y;y.x=x;return y;}
13int bar_t(FOO x) {return x.x;}
14FOO baz_t(int x) {struct foo y;y.x=x;return y;}")
15
16(test-begin "struct arg/return")
17
18(define bar (foreign-lambda int "bar" (struct "foo")))
19(define bar_t (foreign-lambda int "bar" (struct ("FOO"))))
20
21(define safe-bar (foreign-safe-lambda int "bar" (struct "foo")))
22(define safe-bar_t (foreign-safe-lambda int "bar_t" (struct ("FOO"))))
23
24(define baz (foreign-lambda (struct "foo") "baz" int))
25(define baz_t (foreign-lambda (struct ("FOO")) "baz" int))
26
27(define safe-baz (foreign-safe-lambda (struct "foo") "baz" int))
28(define safe-baz_t (foreign-safe-lambda (struct ("FOO")) "baz" int))
29
30(define x (baz 123))
31(define x_t (baz_t 123))
32(define safe-x (safe-baz 123))
33(define safe-x_t (safe-baz_t 123))
34
35(test-assert "struct return" (record-instance? x '|struct foo|))
36(test-assert "struct return (typedef)" (record-instance? x_t '|FOO|))
37(test-assert "struct return (safe)" (record-instance? safe-x '|struct foo|))
38(test-assert "struct return (safe, typedef)" (record-instance? safe-x_t '|FOO|))
39
40(define out (open-output-string))
41(display x out)
42(test-equal "string representation" "#<struct foo>" (get-output-string out))
43(define out (open-output-string))
44(display x_t out)
45(test-equal "string representation" "#<FOO>" (get-output-string out))
46(test-equal "struct argument" 123 (bar x))
47(test-equal "struct argument (typedef)" 123 (bar_t x_t))
48(test-equal "struct arg (safe)" 123 (safe-bar x))
49(test-equal "struct arg (safe, typedef)" 123 (safe-bar_t x_t))
50(test-equal "foreign value" 99 (bar (foreign-value "(struct foo){99}" (struct foo))))
51(test-equal "location" 100 (let-location ((f1 (struct foo) (baz 100)))
52                              (bar f1)))            
53(test-end)
54(test-exit)