From a04ba8aef3afc7dad498b23a5da1f661a0619cb8 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 22 Jun 2012 06:33:33 +0800
Subject: [PATCH] ffi/com: allow a `com-object' as an 'iunknown argument

---
 collects/ffi/unsafe/com.rkt                 | 22 +++++++++++++++++----
 collects/scribblings/foreign/com-auto.scrbl |  2 +-
 2 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/collects/ffi/unsafe/com.rkt b/collects/ffi/unsafe/com.rkt
index f3a2c48353..60e569ab61 100644
--- a/collects/ffi/unsafe/com.rkt
+++ b/collects/ffi/unsafe/com.rkt
@@ -1049,8 +1049,8 @@
     ;; that the caller and callee have agreed upon.  For our purposes,
     ;; it is an IUnknown pointer.
     (if is-opt?
-        'iunknown
-        '(opt iunknown))]
+        '(opt iunknown)
+        'iunknown)]
    [(bit-and? vt VT_ARRAY)
     (define array-desc (cast (union-ref (TYPEDESC-u (ELEMDESC-tdesc elem-desc)) 1)
                              _pointer
@@ -1363,7 +1363,8 @@
       [(date) (date? arg)]
       [(boolean) #t]
       [(scode) (signed-int? arg 32)]
-      [(iunknown) (IUnknown? arg)]
+      [(iunknown) (or (IUnknown? arg)
+                      (com-object? arg))]
       [(com-object) (com-object? arg)]
       [(any) #t]
       [(com-enumeration) (signed-int? arg 32)]
@@ -1558,6 +1559,19 @@
 			  (variant-to-scheme var))
 			(loop (cdr dims) (add1 level) (cons i index))))))))
 
+(define _IUnknown-pointer-or-com-object
+  (make-ctype 
+   _IUnknown-pointer
+   (lambda (v)
+     (if (com-object? v)
+         (com-object-get-iunknown v)
+         v))
+   (lambda (p) 
+     (((allocator Release) (lambda () p)))
+     (define obj (make-com-object p))
+     (register-with-custodian obj)
+     obj)))
+
 (define (to-ctype type)
   (cond
    [(symbol? type)
@@ -1578,7 +1592,7 @@
       [(date) _date]
       [(boolean) _bool]
       [(scode) _SCODE]
-      [(iunknown) _IUnknown-pointer]
+      [(iunknown) _IUnknown-pointer-or-com-object]
       [(com-object) _com-object]
       [(any) (error "internal error: cannot marshal to any")]
       [(com-enumeration) _int]
diff --git a/collects/scribblings/foreign/com-auto.scrbl b/collects/scribblings/foreign/com-auto.scrbl
index 800604d618..19ce668b70 100644
--- a/collects/scribblings/foreign/com-auto.scrbl
+++ b/collects/scribblings/foreign/com-auto.scrbl
@@ -433,7 +433,7 @@ used to represent various atomic types:
 
  @item{@racket['com-object] --- a @tech{COM object} as in @racket[com-object?]}
 
- @item{@racket['iunknown] --- an @cpp{IUnknown} pointer as in @racket[com-iunknown?]}
+ @item{@racket['iunknown] --- like @racket['com-object], but also accepts an @cpp{IUnknown} pointer as in @racket[com-iunknown?]}
 
  @item{@racket['com-enumeration] --- a 32-bit signed integer}