From 50d7cedb3f13a157ad24789daae24db6759eaa38 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Wed, 6 Jul 2016 23:22:04 +0900 Subject: [PATCH] Fixing constructors and setters for nested structs (issue #370). --- tests/ffi/ffi-tests.scm | 27 +++++++++++++++++++++++++++ tools/chibi-ffi | 10 ++++++++-- 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/tests/ffi/ffi-tests.scm b/tests/ffi/ffi-tests.scm index bd48d936..ff6c07eb 100644 --- a/tests/ffi/ffi-tests.scm +++ b/tests/ffi/ffi-tests.scm @@ -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!) diff --git a/tools/chibi-ffi b/tools/chibi-ffi index 5e3120b7..523c6686 100755 --- a/tools/chibi-ffi +++ b/tools/chibi-ffi @@ -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)))