ffi/com: implement vardesc-based dispatch

The `title' property of IE9 triggers the new code, which wasn't
implemented before because I didn't have an example.

collects/ffi/unsafe/com.rkt

@@ -1826,6 +1826,17 @@
 			(error "cannot handle combination of `any ...' and lcid/retval")
 			(length scheme-types))
 		    base-count))
+  (build-method-arguments-from-desc count
+				    (lambda (i)
+				      (and func-desc 
+					   (or (not last-is-repeat-any?)
+					       (i . < . (sub1 base-count)))
+					   (elem-desc-ref func-desc i)))
+				    scheme-types
+				    inv-kind
+				    args))
+
+(define (build-method-arguments-from-desc count get-elem-desc scheme-types inv-kind args)
   (define vars (if (zero? count)
                    #f
                    (malloc count _VARIANTARG 'raw)))
@@ -1843,10 +1854,7 @@
       (VariantInit var)
       (scheme-to-variant! var 
 			  a 
-			  (and func-desc 
-			       (or (not last-is-repeat-any?)
-				   (i . < . (sub1 base-count)))
-			       (elem-desc-ref func-desc i)) 
+			  (get-elem-desc i)
 			  scheme-type)))
   (define disp-params (cast (malloc _DISPPARAMS 'raw)
 			    _pointer
@@ -1866,6 +1874,16 @@
           (cons (lambda () (free disp-params)) (unbox cleanup))
           (unbox commit)))
 
+(define (build-method-arguments-using-var-desc var-desc scheme-types inv-kind args)
+  (build-method-arguments-from-desc (if (= inv-kind INVOKE_PROPERTYPUT)
+					1
+					0)
+				    (lambda (i)
+				      (VARDESC-elemdescVar var-desc))
+				    scheme-types
+				    inv-kind
+				    args))
+
 (define (variant-to-scheme var #:mode [mode '(out)])
   (define _t (to-ctype (vt-to-scheme-type (VARIANT-vt var)) #:mode mode))
   (if _t
@@ -1883,9 +1901,9 @@
                                                 scheme-types
                                                 inv-kind args)]
    [else
-    (error "unimplemented") ; FIXME?
-    '(build-method-arguments-using-var-desc (mx-com-type-desc-desc type-desc)
-                                            inv-kind args)]))
+    (build-method-arguments-using-var-desc (mx-com-type-desc-desc type-desc)
+					   scheme-types
+					   inv-kind args)]))
 
 (define (find-memid who obj name)
   (define-values (r memid)

collects/tests/racket/com.rkt

@@ -4,13 +4,19 @@
          racket/system
          setup/dirs)
 
-(define-syntax-rule (test expect expr)
-  (let ([val expr]
-        [ex expect])
-    (printf "~s\n" 'expr)
-    (unless (equal? ex val)
-      (error 'test "~s failed: ~e" 'expr val))
-    (set! count (add1 count))))
+(define-syntax test
+  (syntax-rules ()
+    [(_ expect expr)
+     (test expect #:alts '() expr)]
+    [(_ expect #:alts alts-expr expr)
+     (let ([val expr]
+	   [ex expect]
+	   [alts alts-expr])
+       (printf "~s\n" 'expr)
+       (unless (or (equal? ex val)
+		   (member val alts))
+         (error 'test "~s failed: ~e" 'expr val))
+       (set! count (add1 count)))]))
 
 (define count 0)
 
@@ -130,8 +136,8 @@
   (test "The Racket Language" (com-get-property ie "Document" "title"))
   (test (void) (com-set-property! ie "Document" "title" "The Racket Documentation"))
   (test "The Racket Documentation" (com-get-property ie "Document" "title"))
-  (test '(-> () string) (com-get-property-type doc "title"))
-  (test '(-> (string) void) (com-set-property-type doc "title"))
+  (test '(-> () string) #:alts '((-> () any)) (com-get-property-type doc "title"))
+  (test '(-> (string) void) #:alts '((-> (any) void)) (com-set-property-type doc "title"))
 
   (test (void) (com-set-property! ie "Visible" #t))
   (test (void) (com-invoke ie "Quit"))