From bcb22a3adb84e9413ce1f57d176025a79ee79f97 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 11 Apr 2012 16:50:11 -0600 Subject: [PATCH] ffi/unsafe/com: repair for optional `any' arguments Merge to 5.3 --- collects/ffi/unsafe/com.rkt | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/collects/ffi/unsafe/com.rkt b/collects/ffi/unsafe/com.rkt index 16c57e4cae..ca979f1d94 100644 --- a/collects/ffi/unsafe/com.rkt +++ b/collects/ffi/unsafe/com.rkt @@ -1400,17 +1400,23 @@ _VARIANT)) (begin (set-VARIANT-vt! var VT_ERROR) - (variant-set! var _long DISP_E_PARAMNOTFOUND)))] - [(and elem-desc (not (eq? 'any scheme-type))) + (variant-set! var _ulong DISP_E_PARAMNOTFOUND)))] + [(and elem-desc (not (any-type? scheme-type))) (set-VARIANT-vt! var (get-var-type-from-elem-desc elem-desc)) (variant-set! var (to-ctype scheme-type) a)] [else - (define use-scheme-type (if (eq? scheme-type 'any) + (define use-scheme-type (if (any-type? scheme-type) (arg-to-type a) scheme-type)) (set-VARIANT-vt! var (to-vt use-scheme-type)) (variant-set! var (to-ctype use-scheme-type) a)])) +(define (any-type? t) + (or (eq? t 'any) + (and (pair? t) + (eq? (car t) 'opt) + (any-type? (cadr t))))) + (define _float* (make-ctype _float (lambda (v) (exact->inexact v)) @@ -1510,7 +1516,7 @@ [(com-enumeration) _int] [else (error 'to-ctype "Internal error: unknown type ~s" type)])] [(eq? 'opt (car type)) - (to-ctype type)] + (to-ctype (cadr type))] [(eq? 'box (car type)) (_box/permanent (to-ctype (cadr type)))] [(eq? 'array (car type)) @@ -1550,6 +1556,7 @@ (case (and (pair? type) (car type)) [(array) (bitwise-ior VT_ARRAY (to-vt (caddr type)))] + [(opt) (to-vt (cadr type))] [else (error 'to-vt "Internal error: unsupported type ~s" type)])]))