From 89ef600b6e3f57760e0d998f046ff3dca4367c82 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 3 Apr 2012 17:33:52 -0600
Subject: [PATCH] ffi/unsafe/com: `com-object->eq?' implies `equal?'

---
 collects/ffi/unsafe/com.rkt                 |  9 ++++++++-
 collects/scribblings/foreign/com-auto.scrbl | 11 ++++++++---
 collects/tests/racket/com.rkt               |  6 ++++++
 3 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/collects/ffi/unsafe/com.rkt b/collects/ffi/unsafe/com.rkt
index 13578667ac..408d7b9269 100644
--- a/collects/ffi/unsafe/com.rkt
+++ b/collects/ffi/unsafe/com.rkt
@@ -480,7 +480,14 @@
                     [connection-cookie #:mutable]
                     [sink #:mutable]
                     [types #:mutable]
-                    [mref #:mutable]))
+                    [mref #:mutable])
+  #:property prop:equal+hash (list
+                              (lambda (a b eql?)
+                                (ptr-equal? (com-object-unknown a) (com-object-unknown b)))
+                              (lambda (a ehc)
+                                (ehc (com-object-unknown a)))
+                              (lambda (a ehc2)
+                                (ehc2 (com-object-unknown a)))))
 
 (define (com-object-eq? a b)
   (check-com-obj 'com-object-eq? a)
diff --git a/collects/scribblings/foreign/com-auto.scrbl b/collects/scribblings/foreign/com-auto.scrbl
index 1136869e08..5e46a956e1 100644
--- a/collects/scribblings/foreign/com-auto.scrbl
+++ b/collects/scribblings/foreign/com-auto.scrbl
@@ -78,7 +78,7 @@ produces a @tech{ProgID} with its version.}
 
 @defproc[(com-object? [obj com-object?]) boolean?]{
 
-  Returns @racket[#t] if the argument is a COM object, @racket[#f]
+  Returns @racket[#t] if the argument represents a @tech{COM object}, @racket[#f]
   otherwise.}
 
 
@@ -135,8 +135,13 @@ unsafe operations).}
 @defproc[(com-object-eq? [obj1 com-object?] [obj2 com-object?])
          boolean?]{
 
-  Returns @racket[#t] if the two COM objects are the same,
-  @racket[#f] otherwise.}
+  Returns @racket[#t] if @racket[obj1] and @racket[obj2] refer to the
+  same @tech{COM object}, @racket[#f] otherwise.
+
+  If two references to a COM object are the same according to
+  @racket[com-object-eq?], then they are also the same according to
+  @racket[equal?]. Two @racket[com-object-eq?]  references are not
+  necessarily @racket[eq?], however.}
 
 
 @defproc[(com-type? [v any/c]) boolean?]{
diff --git a/collects/tests/racket/com.rkt b/collects/tests/racket/com.rkt
index 2d89f355c8..aa4374a544 100644
--- a/collects/tests/racket/com.rkt
+++ b/collects/tests/racket/com.rkt
@@ -1,5 +1,6 @@
 #lang racket/base
 (require ffi/com
+         (only-in ffi/unsafe/com make-com-object)
          racket/system
          setup/dirs)
 
@@ -39,6 +40,11 @@
   (test #t (guid=? (progid->clsid mzcom-progid) (com-object-clsid mzcom)))
   (test (void) (com-object-set-clsid! mzcom (progid->clsid mzcom-progid)))
   (test #t (com-object-eq? mzcom mzcom))
+  (let ([mzcom2 (make-com-object (com-object-get-iunknown mzcom) #f)])
+    (test #t (com-object-eq? mzcom mzcom2))
+    (test #t (equal? mzcom mzcom2))
+    (test (equal-hash-code mzcom) (equal-hash-code mzcom2))
+    (test (equal-secondary-hash-code mzcom) (equal-secondary-hash-code mzcom2)))
   (test '("About" "Eval" "Reset") (com-methods mzcom))
   (test '("About" "Eval" "Reset") (com-methods (com-object-type mzcom)))
   (test '(-> () void) (com-method-type mzcom "About"))