diff --git a/collects/ffi/unsafe/com.rkt b/collects/ffi/unsafe/com.rkt index ca979f1d94..0866774b25 100644 --- a/collects/ffi/unsafe/com.rkt +++ b/collects/ffi/unsafe/com.rkt @@ -1121,9 +1121,15 @@ ,(if (zero? (vector-length arg)) 'int (for/fold ([t (arg-to-type (vector-ref arg 0))]) ([v (in-vector arg)]) - (if (equal? t (arg-to-type v)) - t - 'any))))] + (define t2 (arg-to-type v)) + (let loop ([t t] [t2 t2]) + (cond + [(equal? t t2) t] + [(and (pair? t) (pair? t2) + (eq? (car t) 'array) (eq? (car t2) 'array) + (equal? (cadr t) (cadr t2))) + `(array ,(cadr t) ,(loop (caddr t) (caddr t2)))] + [else 'any])))))] [else (error 'com "cannot infer marshal format for value: ~e" arg)])) (define (elem-desc-ref func-desc i) @@ -1442,8 +1448,7 @@ (VariantInit var) var) -(define (extract-variant-pointer var get?) - (define vt (VARIANT-vt var)) +(define (extract-variant-pointer var get? [vt (VARIANT-vt var)]) (define ptr (union-ptr (VARIANT-u var))) (switch vt @@ -1456,7 +1461,8 @@ (define (_safe-array/vectors dims base) (make-ctype _pointer (lambda (v) - (define sa (SafeArrayCreate (to-vt base) + (define base-vt (to-vt base)) + (define sa (SafeArrayCreate base-vt (length dims) (for/list ([d (in-list dims)]) (make-SAFEARRAYBOUND d 0)))) @@ -1470,7 +1476,7 @@ (let ([var (make-a-VARIANT)]) (scheme-to-variant! var v #f base) (SafeArrayPutElement sa (reverse idx) - (extract-variant-pointer var #f))) + (extract-variant-pointer var #f base-vt))) (loop v idx (cdr dims))))) sa) (lambda (_sa)