From 3b56866fc156865bf590bfcaf5cc4660906fae1c Mon Sep 17 00:00:00 2001
From: Daniel Feltey <dfeltey@gmail.com>
Date: Mon, 2 Oct 2017 15:12:17 -0500
Subject: [PATCH] Fix object/c contract-stronger?

---
 .../tests/racket/contract/object.rkt          | 34 +++++++++++++++++++
 .../collects/racket/private/class-c-old.rkt   |  8 ++++-
 2 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/pkgs/racket-test/tests/racket/contract/object.rkt b/pkgs/racket-test/tests/racket/contract/object.rkt
index b5aba9bd82..6c4febe720 100644
--- a/pkgs/racket-test/tests/racket/contract/object.rkt
+++ b/pkgs/racket-test/tests/racket/contract/object.rkt
@@ -299,5 +299,39 @@
                (class object% (super-new)))
               'pos 'neg))
 
+  (test/spec-passed/result
+   'object/c-multi-wrap-just-check-existence/field
+   '(let ([ctc (object/c (field foo))]
+          [v (new (class object% (super-new) (field (foo 0))))])
+      (get-field
+       foo
+       (contract
+        ctc
+        (contract
+         ctc
+         (contract
+          ctc
+          v
+          'p 'n)
+         'p 'n)
+        'p 'n)))
+   0)
 
+  (test/spec-passed/result
+   'object/c-multi-wrap-just-check-existence/method
+   '(let ([ctc (object/c foo)]
+          [v (new (class object% (super-new) (define/public (foo) 0)))])
+      (send
+       (contract
+        ctc
+        (contract
+         ctc
+         (contract
+          ctc
+          v
+          'p 'n)
+         'p 'n)
+        'p 'n)
+       foo))
+   0)
 )
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index 820cfebb33..a8978b6025 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -1521,7 +1521,13 @@
         (for/or ([that-name (in-list (names-sel that))]
                  [that-ctc (in-list (ctcs-sel that))])
           (and (equal? this-name that-name)
-               (contract-stronger? this-ctc that-ctc))))))
+               (contract-stronger?
+                (if (just-check-existence? this-ctc)
+                    any/c
+                    this-ctc)
+                (if (just-check-existence? that-ctc)
+                    any/c
+                    that-ctc)))))))
 
 (define-struct base-object/c (methods method-contracts fields field-contracts)
   #:property prop:custom-write custom-write-property-proc