Retropikzel
/
foreign-c
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make the struct members accessors and add tests

This commit is contained in:
retropikzel 2025-01-18 10:23:53 +02:00
parent ebba1db3f7
commit 77509b9620
7 changed files with 384 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -3,6 +3,7 @@
docuptmp
*.log
*.c
!libtest.c
*.so
*.o
*.so

63
Makefile
View File

@ -1,8 +1,11 @@
CC=gcc
DOCKER=docker run -it -v ${PWD}:/workdir
libtest.so: test.c
${CC} -o libtest.so -shared -fPIC libtest.c
CHIBI=chibi-scheme -A .
test-chibi-podman-amd64:
test-chibi-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chibi bash -c "cd /workdir && chibi-ffi retropikzel/r7rs-pffi/r7rs-pffi-chibi.stub"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chibi bash -c "cd /workdir && apt update && apt install -y build-essential libffi-dev && ${CC} -o retropikzel/r7rs-pffi/r7rs-pffi-chibi.so -fPIC -shared retropikzel/r7rs-pffi/r7rs-pffi-chibi.c -lchibi-scheme -lffi"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chibi bash -c "cd /workdir && ${CHIBI} test.scm"
@ -19,51 +22,51 @@ retropikzel/r7rs-pffi/r7rs-pffi-chibi.so: retropikzel/r7rs-pffi/r7rs-pffi-chibi.
-L${HOME}/.scman/chibi/lib \
-I${HOME}/.scman/chibi/include
test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so
test-chibi: retropikzel/r7rs-pffi/r7rs-pffi-chibi.so libtest.so
${CHIBI} test.scm
CHICKEN5=csc -X r7rs -R r7rs
CHICKEN5_LIB=csc -X r7rs -R r7rs -include-path ./retropikzel -s -J
test-chicken5-podman-amd65: clean
test-chicken5-podman-amd65: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:5 bash -c "cd /workdir && ${CHICKEN5} test.scm && ./test"
test-chicken5: clean
test-chicken5: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
${CHICKEN5_LIB} retropikzel.r7rs-pffi.sld
${CHICKEN5} test.scm && ./test
CHICKEN6=csc
CHICKEN6_LIB=csc -include-path ./retropikzel -s -J
test-chicken6-podman-amd65: clean
test-chicken6-podman-amd65: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN6_LIB} retropikzel.r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/chicken:6 bash -c "cd /workdir && ${CHICKEN6} test.scm && ./test"
test-chicken6: clean
test-chicken6: clean libtest.so
cp retropikzel/r7rs-pffi.sld retropikzel.r7rs-pffi.sld
${CHICKEN6_LIB} retropikzel.r7rs-pffi.sld
${CHICKEN6} test.scm && ./test
CYCLONE=cyclone -A .
test-cyclone-podman-amd64: clean
test-cyclone-podman-amd64: clean libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/cyclone bash -c "cd /workdir && ${CYCLONE} retropikzel/r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/cyclone bash -c "cd /workdir && ${CYCLONE} test.scm && ./test"
test-cyclone: clean
test-cyclone: clean libtest.so
${CYCLONE} retropikzel/r7rs-pffi.sld
${CYCLONE} test.scm
./test
GAMBIT_LIB=gsc -:search=.
GAMBIT_CC=gsc -exe ./ -nopreload
test-gambit-podman-amd64: clean
test-gambit-podman-amd64: clean libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/gambit bash -c "cd /workdir && ${GAMBIT_LIB} retropikzel/r7rs-pffi; echo $$?"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/gambit bash -c "cd /workdir && ${GAMBIT_CC} test.scm; echo $$?"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/gambit bash -c "cd /workdir && ./test -:search=.; echo $$?"
test-gambit: clean
test-gambit: clean libtest.so
${GAMBIT_LIB} retropikzel/r7rs-pffi; echo $$?
${GAMBIT_CC} test.scm; echo $$?
./test -:search=.; echo $$?
@ -73,7 +76,7 @@ test-gauche:
GERBIL_LIB=gxc -O
GERBIL=GERBIL_LOADPATH=. gxi --lang r7rs
test-gerbil-podman-amd64:
test-gerbil-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/gerbil bash -c "cd /workdir && ${GERBIL_LIB} retropikzel/r7rs-pffi.sld"
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/gerbil bash -c "cd /workdir && ${GERBIL} test.scm"
@ -81,65 +84,65 @@ test-gerbil:
gxi --lang r7rs test.scm
GUILE=guile --r7rs --fresh-auto-compile -L .
test-guile-podman-amd64:
test-guile-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/guile bash -c "cd /workdir && ${GUILE} test.scm"
test-guile:
test-guile: libtest.so
${GUILE} test.scm
KAWA=java --add-exports java.base/jdk.internal.foreign.abi=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign.layout=ALL-UNNAMED --add-exports java.base/jdk.internal.foreign=ALL-UNNAMED --enable-native-access=ALL-UNNAMED --enable-preview -jar kawa.jar --r7rs --full-tailcalls -Dkawa.import.path=.:*.sld
test-kawa-podman-amd64:
test-kawa-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/kawa bash -c "cd /workdir && ${KAWA} test.scm"
test-kawa:
test-kawa: libtest.so
${KAWA} test.scm
LARCENY=larceny -r7 -I .
test-larceny-docker:
test-larceny-docker: libtest.so
${DOCKER} schemers/larceny:latest bash -c "cd /workdir && ${LARCENY} test.scm"
test-larceny:
test-larceny: libtest.so
${LARCENY} test.scm
MOSH=mosh --loadpath=.
test-mosh-podman-amd64:
test-mosh-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/mosh:0 bash -c "cd /workdir && ${MOSH} test.scm"
test-mosh:
test-mosh: libtest.so
${MOSH} test.scm
SASH=sash -r7 -L . -L ./schubert
test-sagittarius-podman-amd64:
test-sagittarius-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/sagittarius bash -c "cd /workdir && ${SASH} test.scm"
test-sagittarius:
test-sagittarius: libtest.so
${SASH} test.scm
RACKET=racket -I r7rs -S . -S ./schubert --script
test-racket-podman-amd64:
test-racket-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/racket bash -c "cd /workdir && ${RACKET} test.scm"
test-racket:
test-racket: libtest.so
${RACKET} test.scm
test-skint:
test-skint: libtest.so
skint test.scm
STKLOS=stklos -A . -f
test-stklos-podman-amd64:
test-stklos-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/stklos bash -c "cd /workdir && ${STKLOS} test.scm"
test-stklos:
test-stklos: libtest.so
${STKLOS} test.scm
test-tr7:
test-tr7: libtest.so
tr7i test.scm
YPSILON=ypsilon --r7rs --loadpath=.
test-ypsilon-podman-amd64:
YPSILON=ypsilon --r7rs --sitelib=. --top-level-program
test-ypsilon-podman-amd64: libtest.so
podman run --arch=amd64 -it -v ${PWD}:/workdir docker.io/schemers/ypsilon bash -c "cd /workdir && ${YPSILON} test.scm"
test-ypsilon:
test-ypsilon: libtest.so
${YPSILON} test.scm
documentation:

92
libtest.c Normal file
View File

@ -0,0 +1,92 @@
#include <stdlib.h>
#include <stdio.h>
#include <assert.h>
#include <string.h>
#if defined(_MSC_VER)
#define EXPORT __declspec(dllexport)
#define IMPORT __declspec(dllimport)
#elif defined(__GNUC__)
#define EXPORT __attribute__((visibility("default")))
#define IMPORT
#else
#define EXPORT
#define IMPORT
#pragma warning Unknown dynamic link import/export semantics.
#endif
struct test {
int8_t a;
char b;
double c;
char d;
void* e;
float f;
char* g;
int8_t h;
void* i;
int j;
int k;
int l;
double m;
float n;
};
EXPORT struct test* test(struct test* test) {
test->a = 1;
test->b = 'b';
test->c = 3; //FIXME: Change to 3.0 and fix the library to work with it
test->d = 'd';
test->e = NULL;
test->f = 6.0;
char* foo = malloc(4);
snprintf(foo, 4, "foo");
test->g = foo;
test->h = 8;
test->i = NULL;
test->j = 10;
test->k = 11;
test->l = 12;
test->m = 13;
test->n = 14;
}
EXPORT int test_check(struct test* test) {
assert(test->a == 1);
assert(test->b == 'b');
//assert(test->c == 3); //FIXME: Change to 3.0 and fix the library to work with it
assert(test->d == 'd');
assert(test->e == NULL);
// assert(test->f == 6.0); //FIXME
//assert(strcmp(test->g, "foo") == 0); //FIXME
assert(test->h == 8);
assert(test->i == NULL);
assert(test->j == 10);
assert(test->k == 11);
assert(test->l == 12);
//assert(test->m == 13); //FIXME
//assert(test->n == 14); //FIXME
}
EXPORT struct test* test_new(struct test* test) {
struct test* t = malloc(sizeof(struct test));
t->a = 1;
t->b = 'b';
t->c = 3; //FIXME: Change to 3.0 and fix the library to work with it
t->d = 'd';
t->e = NULL;
t->f = 6.0;
char* foo = malloc(4);
snprintf(foo, 4, "foo");
t->g = foo;
t->h = 8;
t->i = NULL;
t->j = 10;
t->k = 11;
t->l = 12;
t->m = 13;
t->n = 14;
return t;
}

64
retropikzel/r7rs-pffi.sld
View File

@ -23,9 +23,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -57,9 +59,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
pffi-pointer-address
@ -87,9 +91,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -116,9 +122,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -144,9 +152,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -172,9 +182,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -203,9 +215,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
pffi-pointer-address
@ -230,9 +244,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -263,9 +279,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -293,9 +311,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
;pffi-pointer-address
@ -326,9 +346,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
pffi-pointer-address
@ -355,9 +377,11 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
pffi-define
pffi-define-callback
pffi-pointer-address
@ -382,9 +406,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -411,9 +437,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -439,9 +467,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address
@ -467,9 +497,11 @@
;pffi-pointer-get
;pffi-string->pointer
;pffi-pointer->string
pffi-struct-allocate
pffi-struct-make
pffi-struct-size
pffi-struct-pointer
pffi-struct-get
pffi-struct-set!
;pffi-define
;pffi-define-callback
;pffi-pointer-address

38
retropikzel/r7rs-pffi/struct.scm
View File

@ -1,5 +1,5 @@
(define-record-type <pffi-struct>
(pffi-struct-make name size pointer members)
(struct-make name size pointer members)
pffi-struct?
(name pffi-struct-name)
(size pffi-struct-size)
@ -49,14 +49,38 @@
(define pffi-word-size
(cond-expand
(larceny 4) ; 32-bit system
(i386 4) ; 32-bit system
(else 8))) ; 64-bit system
(define (pffi-struct-allocate name members)
(define (pffi-struct-make name members . pointer)
(for-each
(lambda (member)
(write member)
(newline)
(when (not (pair? member))
(error "All struct members must be pairs" (list name member)))
(when (not (symbol? (car member)))
(error "All struct member types must be symbols" (list name member)))
(when (not (symbol? (cdr member)))
(error "All struct member names must be symbols" (list name member))))
members)
(let* ((size-and-offsets (calculate-struct-size-and-offsets members))
(size (cdr (assoc 'size size-and-offsets)))
(offsets (cdr (assoc 'offsets size-and-offsets)))
(pointer (pffi-pointer-allocate size)))
(write size-and-offsets)
(newline)
(pffi-struct-make name size pointer members)))
(pointer (if (null? pointer) (pffi-pointer-allocate size) (car pointer)))
(name (if (string? name) name (symbol->string name))))
(struct-make name size pointer offsets)))
(define (pffi-struct-get struct member-name)
(when (not (assoc member-name (pffi-struct-members struct)))
(error "Struct has no such member" (list struct member-name)))
(let ((type (car (cdr (assoc member-name (pffi-struct-members struct)))))
(offset (car (cdr (cdr (assoc member-name (pffi-struct-members struct)))))))
(pffi-pointer-get (pffi-struct-pointer struct) type offset)))
(define (pffi-struct-set! struct member-name value)
(when (not (assoc member-name (pffi-struct-members struct)))
(error "Struct has no such member" (list struct member-name)))
(let ((type (car (cdr (assoc member-name (pffi-struct-members struct)))))
(offset (car (cdr (cdr (assoc member-name (pffi-struct-members struct)))))))
(pffi-pointer-set! (pffi-struct-pointer struct) type offset value)))

1
test.h Normal file
View File

@ -0,0 +1 @@
struct test* function(struct test* test);

209
test.scm
View File

@ -340,6 +340,13 @@
(debug libc-stdlib)
(define c-testlib
(cond-expand
(windows (pffi-shared-object-auto-load (list "test.h") (list ".") "test" (list "")))
(else (pffi-shared-object-auto-load (list "test.h") (list ".") "test" (list "")))))
(debug c-testlib)
;; pffi-pointer-null
(print-header 'pffi-pointer-null)
@ -431,55 +438,53 @@
(debug (pffi-pointer-get set-pointer 'double offset))
(assert = (pffi-pointer-get set-pointer 'double offset) 1.5)
; pffi-struct-allocate
; pffi-struct-make
(print-header "pffi-struct")
(define struct1 (pffi-struct-allocate 'test '((int . r) (int . g) (int . b))))
(define struct1 (pffi-struct-make 'test '((int . r) (int . g) (int . b))))
(debug struct1)
(debug (pffi-struct-size struct1))
(assert = (pffi-struct-size struct1) 12)
(define struct2 (pffi-struct-allocate 'test '((int8 . r) (int8 . g) (int . b))))
(define struct2 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(debug struct2)
(debug (pffi-struct-size struct2))
(assert = (pffi-struct-size struct2) 8)
(define struct3 (pffi-struct-allocate 'test '((int8 . r) (int8 . g) (int . b))))
(define struct3 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(debug struct3)
(debug (pffi-struct-size struct3))
(assert = (pffi-struct-size struct3) 8)
(define struct4 (pffi-struct-allocate 'test '((int8 . r) (pointer . a) (int8 . g) (int . b))))
(define struct4 (pffi-struct-make 'test '((int8 . r) (pointer . a) (int8 . g) (int . b))))
(debug struct4)
(debug (pffi-struct-size struct4))
(assert = (pffi-struct-size struct4) 24)
(define struct5 (pffi-struct-allocate 'test '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))))
(define struct5 (pffi-struct-make 'test '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))))
(debug struct5)
(debug (pffi-struct-size struct5))
(assert = (pffi-struct-size struct5) 24)
(define struct6 (pffi-struct-allocate 'test '((int8 . r)
(char . b)
(double . c)
(char bb)
(pointer . a)
(float . d)
(pointer . aa)
(int8 . g)
(pointer . aaa)
(int . bbb)
(int . bbbb)
(int . bbbb)
(double . c)
(float . d)
)))
(define struct6 (pffi-struct-make 'test '((int8 . a)
(char . b)
(double . c)
(char . d)
(pointer . e)
(float . f)
(pointer . g)
(int8 . h)
(pointer . i)
(int . j)
(int . k)
(int . l)
(double . m)
(float . n))))
(debug struct6)
(debug (pffi-struct-size struct6))
(assert = (pffi-struct-size struct6) 96)
#|
;; pffi-string->pointer
(print-header 'pffi-string->pointer)
@ -561,16 +566,158 @@
(print-header 'pffi-define)
(pffi-define puts libc-stdlib 'puts 'int (list 'pointer))
(let ((chars-writter (puts (pffi-string->pointer "Hello from testing, I am C function puts"))))
(display "I have written: ")
(display chars-writter)
(display " characters.")
(newline))
(pffi-define c-puts libc-stdlib 'puts 'int (list 'pointer))
(define chars-written (c-puts (pffi-string->pointer "Hello from testing, I am C function puts")))
(assert = chars-written 41)
(pffi-define atoi libc-stdlib 'atoi 'int (list 'pointer))
(assert = (atoi (pffi-string->pointer "100")) 100)
(pffi-define c-atoi libc-stdlib 'atoi 'int (list 'pointer))
(assert = (c-atoi (pffi-string->pointer "100")) 100)
;; pffi-struct-get
(print-header 'pffi-struct-get)
(pffi-define c-test c-testlib 'test 'pointer (list 'pointer))
(define struct-test (pffi-struct-make 'test
'((int8 . a)
(char . b)
(double . c)
(char . d)
(pointer . e)
(float . f)
(pointer . g)
(int8 . h)
(pointer . i)
(int . j)
(int . k)
(int . l)
(double . m)
(float . n))))
(debug struct-test)
(c-test (pffi-struct-pointer struct-test))
(debug struct-test)
(debug (pffi-struct-get struct-test 'a))
(assert = (pffi-struct-get struct-test 'a) 1)
(debug (pffi-struct-get struct-test 'b))
(assert char=? (pffi-struct-get struct-test 'b) #\b)
;(debug (pffi-struct-get struct-test 'c)) ; FIXME
;(assert = (pffi-struct-get struct-test 'c) 3) ; FIXME
(debug (pffi-struct-get struct-test 'd))
(assert char=? (pffi-struct-get struct-test 'd) #\d)
;(debug (pffi-struct-get struct-test 'e)) ; FIXME
;(debug (pffi-pointer-null? (pffi-struct-get struct-test 'e))) ; FIXME
; (assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test 'e) #t) ; FIXME
(debug (pffi-struct-get struct-test 'f))
(assert = (pffi-struct-get struct-test 'f) 6.0)
;(debug (pffi-struct-get struct-test 'g)) ; FIXME
;(assert (lambda (p t) (string=? (pffi-pointer->string p) "foo")) (pffi-struct-get struct-test 'g) #t) ; FIXME
(debug (pffi-struct-get struct-test 'h))
(assert = (pffi-struct-get struct-test 'h) 8)
;(debug (pffi-struct-get struct-test 'i)) ; FIXME
;(debug (pffi-pointer-null? (pffi-struct-get struct-test 'i))) ; FIXME
; (assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test 'i) #t) ; FIXME
(debug (pffi-struct-get struct-test 'j))
(assert = (pffi-struct-get struct-test 'j) 10)
(debug (pffi-struct-get struct-test 'k))
(assert = (pffi-struct-get struct-test 'k) 11)
(debug (pffi-struct-get struct-test 'l))
(assert = (pffi-struct-get struct-test 'l) 12)
;(debug (pffi-struct-get struct-test 'm)) ; FIXME
;(assert = (pffi-struct-get struct-test 'm) 13) ; FIXME
(debug (pffi-struct-get struct-test 'n))
(assert = (pffi-struct-get struct-test 'n) 14)
;; pffi-struct-set!
(print-header 'pffi-struct-set!)
(pffi-define c-test-check c-testlib 'test_check 'int (list 'pointer))
(define struct-test1 (pffi-struct-make 'test
'((int8 . a)
(char . b)
(double . c)
(char . d)
(pointer . e)
(float . f)
(pointer . g)
(int8 . h)
(pointer . i)
(int . j)
(int . k)
(int . l)
(double . m)
(float . n))))
(pffi-struct-set! struct-test1 'a 1)
(pffi-struct-set! struct-test1 'b #\b)
;(pffi-struct-set! struct-test1 'c 3) ;FIXME
(pffi-struct-set! struct-test1 'd #\d)
(pffi-struct-set! struct-test1 'e (pffi-pointer-null))
(pffi-struct-set! struct-test1 'f 6.0)
(pffi-struct-set! struct-test1 'g (pffi-string->pointer "foo"))
(pffi-struct-set! struct-test1 'h 8)
(pffi-struct-set! struct-test1 'i (pffi-pointer-null))
(pffi-struct-set! struct-test1 'j 10)
(pffi-struct-set! struct-test1 'k 11)
(pffi-struct-set! struct-test1 'l 12)
;(pffi-struct-set! struct-test1 'm 13) ;FIXME
;(pffi-struct-set! struct-test1 'n 14) ;FIXME
(c-test-check (pffi-struct-pointer struct-test1))
;; pffi-struct-make with pointer
(print-header 'pffi-struct-pointer-set!)
(pffi-define c-test-new c-testlib 'test_new 'pointer (list))
(define struct-test2 (pffi-struct-make 'test
'((int8 . a)
(char . b)
(double . c)
(char . d)
(pointer . e)
(float . f)
(pointer . g)
(int8 . h)
(pointer . i)
(int . j)
(int . k)
(int . l)
(double . m)
(float . n))
(c-test-new)))
(debug struct-test2)
(debug (pffi-struct-get struct-test2 'a))
(assert = (pffi-struct-get struct-test2 'a) 1)
(debug (pffi-struct-get struct-test2 'b))
(assert char=? (pffi-struct-get struct-test2 'b) #\b)
;(debug (pffi-struct-get struct-test2 'c)) ; FIXME
;(assert = (pffi-struct-get struct-test2 'c) 3) ; FIXME
(debug (pffi-struct-get struct-test2 'd))
(assert char=? (pffi-struct-get struct-test2 'd) #\d)
;(debug (pffi-struct-get struct-test2 'e)) ; FIXME
;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'e))) ; FIXME
; (assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test2 'e) #t) ; FIXME
(debug (pffi-struct-get struct-test2 'f))
(assert = (pffi-struct-get struct-test2 'f) 6.0)
;(debug (pffi-struct-get struct-test2 'g)) ; FIXME
;(assert (lambda (p t) (string=? (pffi-pointer->string p) "foo")) (pffi-struct-get struct-test2 'g) #t) ; FIXME
(debug (pffi-struct-get struct-test2 'h))
(assert = (pffi-struct-get struct-test2 'h) 8)
;(debug (pffi-struct-get struct-test2 'i)) ; FIXME
;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'i))) ; FIXME
; (assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test2 'i) #t) ; FIXME
(debug (pffi-struct-get struct-test2 'j))
(assert = (pffi-struct-get struct-test2 'j) 10)
(debug (pffi-struct-get struct-test2 'k))
(assert = (pffi-struct-get struct-test2 'k) 11)
(debug (pffi-struct-get struct-test2 'l))
(assert = (pffi-struct-get struct-test2 'l) 12)
;(debug (pffi-struct-get struct-test2 'm)) ; FIXME
;(assert = (pffi-struct-get struct-test2 'm) 13) ; FIXME
(debug (pffi-struct-get struct-test2 'n))
(assert = (pffi-struct-get struct-test2 'n) 14)
#|
;; pffi-define-callback
(print-header 'pffi-define-callback)
@ -606,6 +753,6 @@
(pffi-pointer-get array 'int (* (pffi-size-of 'int) 1))
(pffi-pointer-get array 'int (* (pffi-size-of 'int) 2))))
(newline)
|#
(exit 0)