ffi/unsafe/com: fix arrays of 'any
This commit is contained in:
parent
89307edbce
commit
c695727aec
|
@ -1121,9 +1121,15 @@
|
||||||
,(if (zero? (vector-length arg))
|
,(if (zero? (vector-length arg))
|
||||||
'int
|
'int
|
||||||
(for/fold ([t (arg-to-type (vector-ref arg 0))]) ([v (in-vector arg)])
|
(for/fold ([t (arg-to-type (vector-ref arg 0))]) ([v (in-vector arg)])
|
||||||
(if (equal? t (arg-to-type v))
|
(define t2 (arg-to-type v))
|
||||||
t
|
(let loop ([t t] [t2 t2])
|
||||||
'any))))]
|
(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)]))
|
[else (error 'com "cannot infer marshal format for value: ~e" arg)]))
|
||||||
|
|
||||||
(define (elem-desc-ref func-desc i)
|
(define (elem-desc-ref func-desc i)
|
||||||
|
@ -1442,8 +1448,7 @@
|
||||||
(VariantInit var)
|
(VariantInit var)
|
||||||
var)
|
var)
|
||||||
|
|
||||||
(define (extract-variant-pointer var get?)
|
(define (extract-variant-pointer var get? [vt (VARIANT-vt var)])
|
||||||
(define vt (VARIANT-vt var))
|
|
||||||
(define ptr (union-ptr (VARIANT-u var)))
|
(define ptr (union-ptr (VARIANT-u var)))
|
||||||
(switch
|
(switch
|
||||||
vt
|
vt
|
||||||
|
@ -1456,7 +1461,8 @@
|
||||||
(define (_safe-array/vectors dims base)
|
(define (_safe-array/vectors dims base)
|
||||||
(make-ctype _pointer
|
(make-ctype _pointer
|
||||||
(lambda (v)
|
(lambda (v)
|
||||||
(define sa (SafeArrayCreate (to-vt base)
|
(define base-vt (to-vt base))
|
||||||
|
(define sa (SafeArrayCreate base-vt
|
||||||
(length dims)
|
(length dims)
|
||||||
(for/list ([d (in-list dims)])
|
(for/list ([d (in-list dims)])
|
||||||
(make-SAFEARRAYBOUND d 0))))
|
(make-SAFEARRAYBOUND d 0))))
|
||||||
|
@ -1470,7 +1476,7 @@
|
||||||
(let ([var (make-a-VARIANT)])
|
(let ([var (make-a-VARIANT)])
|
||||||
(scheme-to-variant! var v #f base)
|
(scheme-to-variant! var v #f base)
|
||||||
(SafeArrayPutElement sa (reverse idx)
|
(SafeArrayPutElement sa (reverse idx)
|
||||||
(extract-variant-pointer var #f)))
|
(extract-variant-pointer var #f base-vt)))
|
||||||
(loop v idx (cdr dims)))))
|
(loop v idx (cdr dims)))))
|
||||||
sa)
|
sa)
|
||||||
(lambda (_sa)
|
(lambda (_sa)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user