Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-18 21:29:19 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing constructors and setters for nested structs (issue #370).

Browse source
This commit is contained in:
Alex Shinn 2016-07-06 23:22:04 +09:00
parent 62ca18c1a4
commit 50d7cedb3f
2 changed files with 35 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
tests/ffi/ffi-tests.scm
View file

@ -484,6 +484,33 @@ void complex_imag_set(struct VirtComplex* c, double y) {
(map round (list r orig-i (virt-complex-imag c))))))))
)
(test-ffi
"nestedstructs"
(begin
(c-declare "
struct vec2 {
float x, y;
};
struct vec2box {
struct vec2 position;
};
")
(define-c-struct vec2
predicate: vec2?
constructor: (make-vec2 x y)
(float x vec2-x vec2-x!)
(float y vec2-y vec2-y!))
(define-c-struct vec2box
predicate: vec2box?
constructor: (make-vec2box position)
((struct vec2) position vec2box-pos vec2box-pos-set!)))
(test-assert (vec2? (make-vec2 17.0 23.0)))
(test '(17.0 23.0)
(let ((v (make-vec2 17.0 23.0)))
(list (vec2-x v) (vec2-y v))))
(test-assert (vec2box? (make-vec2box (make-vec2 17.0 23.0)))))
;; TODO: virtual method accessors
(cleanup-shared-objects!)

10
tools/chibi-ffi
View file

@ -52,7 +52,11 @@
(define (parse-type type . o)
(cond
((vector? type)
type)
(if (and (pair? o) (car o))
(let ((res (vector-copy type)))
(type-index-set! res (car o))
res)
type))
(else
(let lp ((type type) (free? #f) (const? #f) (null-ptr? #f)
(ptr? #f) (ref? #f) (struct? #f) (link? #f) (result? #f) (array #f)
@ -103,6 +107,7 @@
(define (type-template type) (vector-ref type 12))
(define (type-new? type) (vector-ref type 13))
(define (type-index type) (vector-ref type 14))
(define (type-index-set! type i) (vector-set! type 14 i))
(define (type-auto-expand? type)
(and (pair? (type-array type))
@ -1729,7 +1734,8 @@
(let ((subname (x->string (cadr subfield))))
(cat
" "
(string-append dst "." (x->string (cadr subfield)))
ptr "->" (x->string (cadr field))
"." (x->string (cadr subfield))
" = "
(string-append
"((" (x->string (or (type-struct-type (type-name (car field)))