From e289750b036219a12e9e78cc54e8d12024047e11 Mon Sep 17 00:00:00 2001
From: Daniel Feltey <dfeltey@gmail.com>
Date: Wed, 28 Jun 2017 14:43:23 -0500
Subject: [PATCH] Fix box/c typo/bug

Previously non-flat box/c contracts would always use the `write` contract to
check the contents of the box rather than the `read` contract.
---
 .../racket-test/tests/racket/contract/box.rkt | 79 ++++++++++++++++++-
 .../collects/racket/contract/private/box.rkt  |  2 +-
 2 files changed, 79 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/box.rkt b/pkgs/racket-test/tests/racket/contract/box.rkt
index da6eac37b8..d779ee603a 100644
--- a/pkgs/racket-test/tests/racket/contract/box.rkt
+++ b/pkgs/racket-test/tests/racket/contract/box.rkt
@@ -58,6 +58,75 @@
   (test/pos-blame
    'box/c8
    '(contract ((values box/c) any/c) #f 'pos 'neg))
+
+  (test/pos-blame
+   'box/c9
+   '(unbox (contract (box/c real? (>/c 0)) (box -1) 'pos 'neg)))
+
+  (test/neg-blame
+   'box/c10
+   '(set-box! (contract (box/c (>/c 0) real?) (box -1) 'pos 'neg) -2))
+
+  (test/pos-blame
+   'box/c11
+   '(unbox (contract (box/c integer?) (box 1.1) 'pos 'neg)))
+
+  (test/neg-blame
+   'box/c12
+   '(set-box! (contract (box/c integer?) (box 1) 'pos 'neg) 1.5))
+
+  ;; contract-stronger? tests
+  (contract-eval '(require (only-in racket/contract/combinator contract-stronger?)))
+
+  (test/spec-passed/result
+   'box/c-stronger1
+   '(contract-stronger? (box/c integer?) (box/c integer?))
+   #t)
+
+  (test/spec-passed/result
+   'box/c-stronger2
+   '(contract-stronger? (box/c (>/c 0)) (box/c real?))
+   #f)
+
+  (test/spec-passed/result
+   'box/c-stronger3
+   '(contract-stronger? (box/c real?) (box/c (>/c 0)))
+   #f)
+
+  (test/spec-passed/result
+   'box/c-stronger4
+   '(contract-stronger? (box/c integer? any/c) (box/c integer? any/c))
+   #t)
+
+  (test/spec-passed/result
+   'box/c-stronger5
+   '(contract-stronger? (box/c any/c integer?) (box/c any/c integer?))
+   #t)
+
+  (test/spec-passed/result
+   'box/c-stronger6
+   '(contract-stronger? (box/c real? any/c) (box/c (>/c 0) any/c))
+   #t)
+
+  (test/spec-passed/result
+   'box/c-stronger7
+   '(contract-stronger? (box/c any/c real?) (box/c any/c (>/c 0)))
+   #f)
+
+  (test/spec-passed/result
+   'box/c-stronger8
+   '(contract-stronger? (box/c (>/c 0) any/c) (box/c real? any/c))
+   #f)
+
+  (test/spec-passed/result
+   'box/c-stronger9
+   '(contract-stronger? (box/c any/c (>/c 0)) (box/c any/c real?))
+   #t)
+
+  (test/spec-passed/result
+   'box/c-stronger10
+   '(contract-stronger? (box/c real? (>/c 0)) (box/c (>/c 0) real?))
+   #t)
   
   (test/neg-blame
    'box/c-with-cons/c-inside
@@ -69,7 +138,15 @@
       ((car (unbox f)) 3)))
 
   (test/neg-blame
-   'box/c-with-cons/c-inside
+   'box/c-with-cons/c-inside-r
+   '(let ([f
+           (contract (box/c any/c (cons/c (-> boolean? boolean?) '()))
+                     (box (list values))
+                     'pos
+                     'neg)])
+      ((car (unbox f)) 3)))
+
+  (test/no-error
    '(let ([f
            (contract (box/c (cons/c (-> boolean? boolean?) '()) any/c)
                      (box (list values))
diff --git a/racket/collects/racket/contract/private/box.rkt b/racket/collects/racket/contract/private/box.rkt
index 4c9fdfbc9d..b6023a36c9 100644
--- a/racket/collects/racket/contract/private/box.rkt
+++ b/racket/collects/racket/contract/private/box.rkt
@@ -221,7 +221,7 @@
   (define ctc-r
     (if flat?
         (coerce-flat-contract 'box/c elem-r)
-        (coerce-contract 'box/c elem-w)))
+        (coerce-contract 'box/c elem-r)))
   (cond
     [(or flat?
          (and (equal? immutable #t)