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

Added C array utils and tests

This commit is contained in:
retropikzel 2025-04-06 17:11:31 +03:00
parent d5ad504f3a
commit 3834161c67
13 changed files with 315 additions and 190 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
README.md
View File

@ -35,7 +35,9 @@ conforming to some specification.
- [Chibi](#compiling-the-library-chibi)
- [Gauche](#compiling-the-library-gauche)
- [Dependencies](#dependencies)
- [Chibi](#dependencies-chibi)
- [Chicken](#dependencies-chicken)
- [Gauche](#dependencies-gauche)
- [Racket](#dependencies-racket)
- [Kawa](#dependencies-kawa)
- [Reference](#reference)
@ -202,12 +204,16 @@ to ./snow/retropikzel/pffi and run command corresponding to your implementation.
#### Dependencies <a name="dependencies"></a>
The library depends on (libffi)[https://sourceware.org/libffi/) and
some implementations have extra dependencies/requiremetns beyond that.
Some implementations have extra dependencies/requirements beyond just the
library.
#### Chibi <a name="dependencies-chibi"></a>
Building depends on libffi.
Debian/Ubuntu/Mint install with:
apt install libffi8 libffi-dev
apt install libffi-dev
#### Chicken <a name="dependencies-chicken"></a>
@ -215,6 +221,14 @@ Needs [r7rs egg](https://wiki.call-cc.org/eggref/5/r7rs), install with:
chicken-install r7rs
#### Gauche <a name="dependencies-gauche"></a>
Building depends on libffi.
Debian/Ubuntu/Mint install with:
apt install libffi-dev
#### Racket <a name="dependencies-racket"></a>
Needs [racket-r7rs](https://github.com/lexi-lambda/racket-r7rs), install with:

13
retropikzel/pffi.sld
View File

@ -125,7 +125,10 @@
(scheme char)
(scheme file)
(scheme process-context)
(stklos)))
(stklos))
(export make-external-function
calculate-struct-size-and-offsets
struct-make))
(tr7
(import (scheme base)
(scheme write)
@ -157,11 +160,17 @@
pffi-pointer-get
pffi-string->pointer
pffi-pointer->string
pffi-struct-make
pffi-define-struct
pffi-struct-pointer
pffi-struct-offset-get
pffi-struct-get
pffi-struct-set!
pffi-struct-dereference
pffi-array?
pffi-array-allocate
pffi-pointer->array
pffi-array-get
pffi-array-set!
pffi-list->array
pffi-array->list
pffi-define

2
retropikzel/pffi/kawa.scm
View File

@ -197,7 +197,7 @@
(integer->char r)
r))))
(define pffi-struct-dereference
#;(define pffi-struct-dereference
(lambda (struct)
;; WIP
(pffi-struct-pointer struct)

2
retropikzel/pffi/mosh.scm
View File

@ -156,6 +156,6 @@
(map pffi-type->native-type argument-types)
procedure)))))
(define pffi-struct-dereference
#;(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

2
retropikzel/pffi/racket.scm
View File

@ -115,6 +115,6 @@
(integer->char r)
r))))
(define pffi-struct-dereference
#;(define pffi-struct-dereference
(lambda (struct)
(pffi-struct-pointer struct)))

3
retropikzel/pffi/sagittarius.scm
View File

@ -22,8 +22,7 @@
((equal? type 'string) 'void*)
((equal? type 'void) 'void)
((equal? type 'callback) 'callback)
((equal? type 'struct) 'void*)
((list? type) (map pffi-type->native-type type))
((and (pair? type) (equal? 'struct (car type))) 'void*)
(else #f))))
(define pffi-pointer?

50
retropikzel/pffi/shared/array.scm
View File

@ -1,22 +1,58 @@
(define-record-type <pffi-array>
(array-make type size pointer)
pffi-array?
(type pffi-array-type)
(size pffi-array-size)
(pointer pffi-array-pointer))
(define pffi-list->array
(lambda (type list-arg)
(let* ((type-size (pffi-size-of type))
(array (pffi-pointer-allocate (* type-size (length list-arg))))
(let* ((array-size (length list-arg))
(type-size (pffi-size-of type))
(array (pffi-pointer-allocate (* type-size array-size)))
(offset 0))
(for-each
(lambda (item)
(pffi-pointer-set! array type offset item)
(set! offset (+ offset type-size)))
list-arg)
array)))
(array-make type array-size array))))
(define pffi-pointer->array
(lambda (pointer type size)
(array-make type size pointer)))
(define pffi-array->list
(lambda (type array size)
(letrec* ((type-size (pffi-size-of type))
(max-offset (* type-size size))
(lambda (array)
(letrec* ((type (pffi-array-type array))
(type-size (pffi-size-of type))
(max-offset (* type-size (pffi-array-size array)))
(array-pointer (pffi-array-pointer array))
(looper (lambda (offset result)
(if (= offset max-offset)
result
(looper (+ offset type-size)
(append result (list (pffi-pointer-get array type offset))))))))
(append result
(list (pffi-pointer-get array-pointer
type
offset))))))))
(looper 0 (list)))))
(define pffi-array-allocate
(lambda (type size)
(array-make type size (pffi-pointer-allocate-calloc size (pffi-size-of type)))))
(define pffi-array-get
(lambda (array index)
(let ((type (pffi-array-type array)))
(pffi-pointer-get (pffi-array-pointer array)
type
(* (pffi-size-of type) index)))))
(define pffi-array-set!
(lambda (array index value)
(let ((type (pffi-array-type array)))
(pffi-pointer-set! (pffi-array-pointer array)
type
(* (pffi-size-of type) index)
value))))

10
retropikzel/pffi/shared/main.scm
View File

@ -1,5 +1,6 @@
(cond-expand
((or chicken-5 chicken-6)
(mosh (define pffi-init (lambda () #t)))
(chicken
(define-syntax pffi-init
(er-macro-transformer
(lambda (expr rename compare)
@ -7,6 +8,12 @@
(chicken memory))
#t))))
(gambit #t)
(ypsilon
(define-syntax pffi-init
(syntax-rules ()
((_)
(import (ypsilon ffi)
(ypsilon c-types))))))
(else (define pffi-init (lambda () #t))))
(define pffi-type?
@ -18,7 +25,6 @@
(define pffi-size-of
(lambda (object)
(cond ((pffi-struct? object) (pffi-struct-size object))
;((pffi-union? object) (pffi-union-size object))
((pffi-type? object) (size-of-type object))
(else (error "Not pffi-struct, pffi-enum of pffi-type" object)))))

11
retropikzel/pffi/shared/pointer.scm
View File

@ -1,5 +1,4 @@
(cond-expand
;(kawa #t) ; JVM
(windows (pffi-define-library pffi-libc-stdlib
'("stdlib.h")
"ucrtbase"
@ -12,12 +11,10 @@
(cond-expand
(chibi #t) ; FIXME
(else (pffi-define pffi-pointer-allocate pffi-libc-stdlib 'malloc 'pointer '(int))))
;(pffi-define pffi-pointer-allocate-aligned pffi-libc-stdlib 'aligned_alloc 'pointer '(int int))
(pffi-define pffi-pointer-allocate-aligned pffi-libc-stdlib 'aligned_alloc 'pointer '(int int))
(pffi-define pffi-pointer-allocate-calloc pffi-libc-stdlib 'calloc 'pointer '(int int))
(cond-expand
(chibi #t) ; FIXME
(else (pffi-define pffi-pointer-free pffi-libc-stdlib 'free 'void '(pointer))))
#;(define pffi-pointer-null
(lambda ()
; Make aligned_alloc fail and return us a null pointer
(pffi-pointer-allocate-aligned -1 -1)))

51
retropikzel/pffi/shared/struct.scm
View File

@ -1,3 +1,4 @@
(pffi-define-library pffi-libc-stdlib '("ffi.h") "ffi" '())
(define-record-type <pffi-struct>
(struct-make c-type size pointer members)
@ -7,18 +8,58 @@
(pointer pffi-struct-pointer)
(members pffi-struct-members))
(define-syntax pffi-define-struct
(syntax-rules ()
((_ name c-type members)
(define name
(lambda arguments
(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 (if (and (not (null? arguments))
(pffi-pointer? (car arguments)))
(car arguments)
(pffi-pointer-allocate size)))
(c-type-string (if (string? c-type) c-type (symbol->string c-type))))
(struct-make c-type-string size pointer offsets)))))))
(define pffi-struct-dereference
(lambda (struct)
(let ((pointer (pffi-pointer-allocate (pffi-struct-size struct)))
(offset 0))
(for-each
(lambda (struct-member)
(let* ((member-type (cadr struct-member))
(member-name (car struct-member))
(member-size (pffi-size-of member-type)))
(display "HERE: ")
(write member-size)
(newline)
(pffi-pointer-set! pointer
member-type
offset
(pffi-struct-get struct member-name))
(set! offset (+ offset member-size))))
(pffi-struct-members struct))
;(pffi-pointer-get (pffi-struct-pointer struct) 'pointer 0)
;(pffi-pointer-get pointer 'pointer 0)
pointer
)))
(define pffi-align-of
(lambda (type)
(cond-expand
;(guile (alignof (pffi-type->native-type type)))
(else (size-of-type type)))))
(define (round-to-next-modulo-of to-round roundee)
(define round-to-next-modulo-of
(lambda (to-round roundee)
(if (= (floor-remainder to-round roundee) 0)
to-round
(round-to-next-modulo-of (+ to-round 1) roundee)))
(round-to-next-modulo-of (+ to-round 1) roundee))))
(define (calculate-struct-size-and-offsets members)
(define calculate-struct-size-and-offsets
(lambda (members)
(let* ((size 0)
(largest-member-size 0)
(offsets (map (lambda (member)
@ -45,9 +86,9 @@
(if (= (modulo size largest-member-size) 0)
size
(round-to-next-modulo-of size largest-member-size)))))
(cons 'offsets offsets))))
(cons 'offsets offsets)))))
(define pffi-struct-make
#;(define pffi-struct-make
(lambda (c-type members . pointer)
(for-each
(lambda (member)

4
retropikzel/pffi/ypsilon.scm
View File

@ -25,8 +25,8 @@
((eq? type 'void) 0)
(else #f))))
(define c-malloc (c-function void* malloc (size_t)))
(define c-free (c-function int free (void*)))
;(define c-malloc (c-function void* malloc (size_t)))
;(define c-free (c-function int free (void*)))
#;(define pffi-pointer-allocate
(lambda (size)

34
src/libtest.c
View File

@ -160,11 +160,11 @@ EXPORT int color_check(struct color* color) {
printf("C: Value of r is %c\n", color->r);
assert(color->r == 100);
printf("C: Value of g is %c\n", color->g);
assert(color->g == 100);
assert(color->g == 101);
printf("C: Value of b is %c\n", color->b);
assert(color->b == 100);
assert(color->b == 102);
printf("C: Value of a is %c\n", color->a);
assert(color->a == 100);
assert(color->a == 103);
return 0;
}
@ -223,33 +223,33 @@ EXPORT int test_check(struct test* test) {
EXPORT int test_check_by_value(struct test test) {
print_offsets();
printf("C: Value of a is %i\n", test.a);
//assert(test.a == 1);
assert(test.a == 1);
printf("C: Value of b is %c\n", test.b);
//assert(test.b == 'b');
assert(test.b == 'b');
printf("C: Value of c is %lf\n", test.c);
//assert(test.c == 3.0);
assert(test.c == 3.0);
printf("C: Value of d is %c\n", test.d);
//assert(test.d == 'd');
assert(test.d == 'd');
printf("C: Value of e is %s\n", test.e);
//assert(test.e == NULL);
assert(test.e == NULL);
printf("C: Value of f is %f\n", test.f);
//assert(test.f == 6.0);
assert(test.f == 6.0);
printf("C: Value of g is %f\n", test.g);
//assert(strcmp(test.g, "foo") == 0);
assert(strcmp(test.g, "foo") == 0);
printf("C: Value of h is %i\n", test.h);
//assert(test.h == 8);
assert(test.h == 8);
printf("C: Value of i is %s\n", test.i);
//assert(test.i == NULL);
assert(test.i == NULL);
printf("C: Value of j is %i\n", test.j);
//assert(test.j == 10);
assert(test.j == 10);
printf("C: Value of k is %i\n", test.k);
//assert(test.k == 11);
assert(test.k == 11);
printf("C: Value of l is %i\n", test.l);
//assert(test.l == 12);
assert(test.l == 12);
printf("C: Value of m is %i\n", test.m);
//assert(test.m == 13);
assert(test.m == 13);
printf("C: Value of n is %i\n", test.n);
//assert(test.n == 14);
assert(test.n == 14);
}
EXPORT struct test* test_new() {

217
tests/compliance.scm
View File

@ -548,36 +548,41 @@
(debug (pffi-pointer-get set-pointer 'double offset))
(assert = (pffi-pointer-get set-pointer 'double offset) 1.5)
; pffi-struct-make
; pffi-define-struct
(print-header "pffi-struct")
(print-header "pffi-define-struct")
(define struct1 (pffi-struct-make 'test '((int . r) (int . g) (int . b))))
(pffi-define-struct test-struct1 'teststruct1 '((int . r) (int . g) (int . b)))
(define struct1 (test-struct1))
(debug struct1)
(debug (pffi-size-of struct1))
(assert = (pffi-size-of struct1) 12)
(define struct2 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(pffi-define-struct test-struct2 'test2 '((int8 . r) (int8 . g) (int . b)))
(define struct2 (test-struct2))
(debug struct2)
(debug (pffi-size-of struct2))
(assert = (pffi-size-of struct2) 8)
(define struct3 (pffi-struct-make 'test '((int8 . r) (int8 . g) (int . b))))
(pffi-define-struct test-struct3 'test3 '((int8 . r) (int8 . g) (int . b)))
(define struct3 (test-struct3))
(debug struct3)
(debug (pffi-size-of struct3))
(assert = (pffi-size-of struct3) 8)
(define struct4 (pffi-struct-make 'test '((int8 . r) (pointer . a) (int8 . g) (int . b))))
(pffi-define-struct test-struct4 'test4 '((int8 . r) (pointer . a) (int8 . g) (int . b)))
(define struct4 (test-struct4))
(debug struct4)
(debug (pffi-size-of struct4))
(assert = (pffi-size-of struct4) 24)
(define struct5 (pffi-struct-make 'test '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b))))
(pffi-define-struct test-struct5 'test5 '((int8 . r) (char . b) (pointer . a) (int8 . g) (int . b)))
(define struct5 (test-struct5))
(debug struct5)
(debug (pffi-size-of struct5))
(assert = (pffi-size-of struct5) 24)
(define struct6 (pffi-struct-make 'test '((int8 . a)
(pffi-define-struct test-struct6 'test6 '((int8 . a)
(char . b)
(double . c)
(char . d)
@ -590,7 +595,8 @@
(int . k)
(int . l)
(double . m)
(float . n))))
(float . n)))
(define struct6 (test-struct6))
(debug struct6)
(debug (pffi-size-of struct6))
(assert = (pffi-size-of struct6) 96)
@ -726,7 +732,7 @@
(pffi-define c-init-struct c-testlib 'init_struct 'pointer '(pointer))
(pffi-define c-check-offset c-testlib 'check_offset 'void '(int int))
(define struct-test (pffi-struct-make 'test
(pffi-define-struct struct-test-get1 'test_get1
'((int8 . a)
(char . b)
(double . c)
@ -740,7 +746,8 @@
(int . k)
(int . l)
(double . m)
(float . n))))
(float . n)))
(define struct-test (struct-test-get1))
(c-check-offset 1 (pffi-struct-offset-get struct-test 'a))
(c-check-offset 2 (pffi-struct-offset-get struct-test 'b))
(c-check-offset 3 (pffi-struct-offset-get struct-test 'c))
@ -796,7 +803,7 @@
(print-header "pffi-struct-set! 1")
(pffi-define c-test-check c-testlib 'test_check 'int '(pointer))
(define struct-test1 (pffi-struct-make 'test
(pffi-define-struct struct-test-set1 'test_set1
'((int8 . a)
(char . b)
(double . c)
@ -810,7 +817,8 @@
(int . k)
(int . l)
(double . m)
(float . n))))
(float . n)))
(define struct-test1 (struct-test-set1))
(pffi-struct-set! struct-test1 'a 1)
(pffi-struct-set! struct-test1 'b #\b)
(pffi-struct-set! struct-test1 'c 3.0)
@ -827,13 +835,13 @@
(pffi-struct-set! struct-test1 'n 14.0)
(c-test-check (pffi-struct-pointer struct-test1))
;; pffi-struct-make with pointer
;; pffi-struct constructor with pointer
(print-header "pffi-struct-make with pointer")
;(print-header "pffi-struct constructor with pointer")
(pffi-define c-test-new c-testlib 'test_new 'pointer '())
(define struct-test2-pointer (c-test-new))
(define struct-test2 (pffi-struct-make 'test
;(pffi-define c-test-new c-testlib 'test_new 'pointer '())
;(define struct-test2-pointer (c-test-new))
#;(define struct-test2 (pffi-struct-make 'test
'((int8 . a)
(char . b)
(double . c)
@ -849,40 +857,40 @@
(double . m)
(float . n))
struct-test2-pointer))
(debug struct-test2)
;(debug struct-test2)
(debug (pffi-pointer-get struct-test2-pointer 'int8 0))
(debug (pffi-struct-get struct-test2 'a))
(assert = (pffi-struct-get struct-test2 'a) 1)
(debug (pffi-pointer-get struct-test2-pointer 'char 1))
(debug (pffi-struct-get struct-test2 'b))
(assert char=? (pffi-struct-get struct-test2 'b) #\b)
(debug (pffi-struct-get struct-test2 'c))
(assert = (pffi-struct-get struct-test2 'c) 3)
(debug (pffi-struct-get struct-test2 'd))
(assert char=? (pffi-struct-get struct-test2 'd) #\d)
(debug (pffi-struct-get struct-test2 'e))
(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'e)))
(assert equal? (pffi-pointer-null? (pffi-struct-get struct-test2 'e)) #t)
(debug (pffi-struct-get struct-test2 'f))
(assert = (pffi-struct-get struct-test2 'f) 6.0)
(debug (pffi-pointer->string (pffi-struct-get struct-test2 'g)))
(assert equal? (string=? (pffi-pointer->string (pffi-struct-get struct-test2 'g)) "FOOBAR") #t)
(debug (pffi-struct-get struct-test2 'h))
(assert = (pffi-struct-get struct-test2 'h) 8)
(debug (pffi-struct-get struct-test2 'i))
(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'i)))
(assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test2 'i) #t)
(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))
(assert = (pffi-struct-get struct-test2 'm) 13.0)
(debug (pffi-struct-get struct-test2 'n))
(assert = (pffi-struct-get struct-test2 'n) 14.0)
;(debug (pffi-pointer-get struct-test2-pointer 'int8 0))
;(debug (pffi-struct-get struct-test2 'a))
;(assert = (pffi-struct-get struct-test2 'a) 1)
;(debug (pffi-pointer-get struct-test2-pointer 'char 1))
;(debug (pffi-struct-get struct-test2 'b))
;(assert char=? (pffi-struct-get struct-test2 'b) #\b)
;(debug (pffi-struct-get struct-test2 'c))
;(assert = (pffi-struct-get struct-test2 'c) 3)
;(debug (pffi-struct-get struct-test2 'd))
;(assert char=? (pffi-struct-get struct-test2 'd) #\d)
;(debug (pffi-struct-get struct-test2 'e))
;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'e)))
;(assert equal? (pffi-pointer-null? (pffi-struct-get struct-test2 'e)) #t)
;(debug (pffi-struct-get struct-test2 'f))
;(assert = (pffi-struct-get struct-test2 'f) 6.0)
;(debug (pffi-pointer->string (pffi-struct-get struct-test2 'g)))
;(assert equal? (string=? (pffi-pointer->string (pffi-struct-get struct-test2 'g)) "FOOBAR") #t)
;(debug (pffi-struct-get struct-test2 'h))
;(assert = (pffi-struct-get struct-test2 'h) 8)
;(debug (pffi-struct-get struct-test2 'i))
;(debug (pffi-pointer-null? (pffi-struct-get struct-test2 'i)))
;(assert (lambda (p t) (pffi-pointer-null? p)) (pffi-struct-get struct-test2 'i) #t)
;(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))
;(assert = (pffi-struct-get struct-test2 'm) 13.0)
;(debug (pffi-struct-get struct-test2 'n))
;(assert = (pffi-struct-get struct-test2 'n) 14.0)
; Array utilities
@ -891,35 +899,49 @@
(define test-list1 (list 1 2 3))
(debug test-list1)
(debug (pffi-list->array 'int test-list1))
(assert equal? (pffi-array->list 'int (pffi-list->array 'int test-list1) 3) test-list1)
(assert equal? (pffi-array->list (pffi-list->array 'int test-list1)) test-list1)
(define test-array1 (pffi-pointer-allocate (* (pffi-size-of 'int) 3)))
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 0) 4)
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 1) 5)
(pffi-pointer-set! test-array1 'int (* (pffi-size-of 'int) 2) 6)
(debug test-array1)
(debug (pffi-array->list 'int test-array1 3))
(debug (pffi-array->list (pffi-pointer->array test-array1 'int 3)))
(define check-list1 (list 4 5 6))
(assert equal? (pffi-array->list 'int test-array1 3) check-list1)
(assert equal? (pffi-array->list (pffi-pointer->array test-array1 'int 3)) check-list1)
;; pffi-struct-dereference
(define test-array2 (pffi-array-allocate 'int 5))
(debug (pffi-array->list test-array2))
(assert equal? (pffi-array->list test-array2) (list 0 0 0 0 0))
(pffi-array-set! test-array2 2 1)
(debug (pffi-array->list test-array2))
(assert equal? (pffi-array->list test-array2) (list 0 0 1 0 0))
(assert = (pffi-array-get test-array2 1) 0)
(assert = (pffi-array-get test-array2 2) 1)
(assert = (pffi-array-get test-array2 3) 0)
;(print-header "pffi-struct-dereference 1")
;(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '(uint32))
#;(define struct-color (pffi-struct-make 'color '((int8 . r)
;; pffi-struct-dereference 1
(print-header "pffi-struct-dereference 1")
(pffi-define c-color-check-by-value c-testlib 'color_check_by_value 'int '((struct . color)))
(pffi-define-struct make-struct-color 'color '((int8 . r)
(int8 . g)
(int8 . b)
(int8 . a))))
;(debug (pffi-struct-set! struct-color 'r 100))
;(debug (pffi-struct-set! struct-color 'g 101))
;(debug (pffi-struct-set! struct-color 'b 102))
;(debug (pffi-struct-set! struct-color 'a 103))
;(assert = (c-color-check-by-value (pffi-pointer-address (pffi-struct-pointer struct-color))) 0)
(int8 . a)))
(define struct-color (make-struct-color))
(debug (pffi-struct-set! struct-color 'r 100))
(debug (pffi-struct-set! struct-color 'g 101))
(debug (pffi-struct-set! struct-color 'b 102))
(debug (pffi-struct-set! struct-color 'a 103))
(assert = (c-color-check-by-value (pffi-struct-dereference struct-color)) 0)
;(print-header "pffi-struct-dereference 2")
(exit 0)
;(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '(int))
#;(define struct-test3 (pffi-struct-make 'test
(print-header "pffi-struct-dereference 2")
(pffi-define c-test-check-by-value c-testlib 'test_check_by_value 'int '((struct . test)))
(pffi-define-struct make-struct-test-dereference2
'test
'((int8 . a)
(char . b)
(double . c)
@ -933,36 +955,37 @@
(int . k)
(int . l)
(double . m)
(float . n))))
;(debug (pffi-struct-set! struct-test3 'a 1))
;(debug (pffi-struct-set! struct-test3 'b #\b))
;(debug (pffi-struct-set! struct-test3 'c 3.0))
;(debug (pffi-struct-set! struct-test3 'd #\d))
;(debug (pffi-struct-set! struct-test3 'e (pffi-pointer-null)))
;(debug (pffi-struct-set! struct-test3 'f 6.0))
;(debug (pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo")))
;(debug (pffi-struct-set! struct-test3 'h 8))
;(debug (pffi-struct-set! struct-test3 'i (pffi-pointer-null)))
;(debug (pffi-struct-set! struct-test3 'j 10))
;(debug (pffi-struct-set! struct-test3 'k 11))
;(debug (pffi-struct-set! struct-test3 'l 12))
;(debug (pffi-struct-set! struct-test3 'm 13.0))
;(debug (pffi-struct-set! struct-test3 'n 14.0))
;(debug (pffi-struct-get struct-test3 'a))
;(debug (pffi-struct-get struct-test3 'b))
;(debug (pffi-struct-get struct-test3 'c))
;(debug (pffi-struct-get struct-test3 'd))
;(debug (pffi-struct-get struct-test3 'e))
;(debug (pffi-struct-get struct-test3 'f))
;(debug (pffi-struct-get struct-test3 'g))
;(debug (pffi-struct-get struct-test3 'h))
;(debug (pffi-struct-get struct-test3 'i))
;(debug (pffi-struct-get struct-test3 'j))
;(debug (pffi-struct-get struct-test3 'k))
;(debug (pffi-struct-get struct-test3 'l))
;(debug (pffi-struct-get struct-test3 'm))
;(debug (pffi-struct-get struct-test3 'n))
;(c-test-check-by-value (pffi-pointer-address (pffi-struct-pointer struct-test3)))
(float . n)))
(define struct-test3 (make-struct-test-dereference2))
(debug (pffi-struct-set! struct-test3 'a 1))
(debug (pffi-struct-set! struct-test3 'b #\b))
(debug (pffi-struct-set! struct-test3 'c 3.0))
(debug (pffi-struct-set! struct-test3 'd #\d))
(debug (pffi-struct-set! struct-test3 'e (pffi-pointer-null)))
(debug (pffi-struct-set! struct-test3 'f 6.0))
(debug (pffi-struct-set! struct-test3 'g (pffi-string->pointer "foo")))
(debug (pffi-struct-set! struct-test3 'h 8))
(debug (pffi-struct-set! struct-test3 'i (pffi-pointer-null)))
(debug (pffi-struct-set! struct-test3 'j 10))
(debug (pffi-struct-set! struct-test3 'k 11))
(debug (pffi-struct-set! struct-test3 'l 12))
(debug (pffi-struct-set! struct-test3 'm 13.0))
(debug (pffi-struct-set! struct-test3 'n 14.0))
(debug (pffi-struct-get struct-test3 'a))
(debug (pffi-struct-get struct-test3 'b))
(debug (pffi-struct-get struct-test3 'c))
(debug (pffi-struct-get struct-test3 'd))
(debug (pffi-struct-get struct-test3 'e))
(debug (pffi-struct-get struct-test3 'f))
(debug (pffi-struct-get struct-test3 'g))
(debug (pffi-struct-get struct-test3 'h))
(debug (pffi-struct-get struct-test3 'i))
(debug (pffi-struct-get struct-test3 'j))
(debug (pffi-struct-get struct-test3 'k))
(debug (pffi-struct-get struct-test3 'l))
(debug (pffi-struct-get struct-test3 'm))
(debug (pffi-struct-get struct-test3 'n))
(c-test-check-by-value (pffi-struct-dereference struct-test3))
;; pffi-define-callback