From 3c8111f93aa184c0b71e2ea09d82192503d51189 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Wed, 24 Oct 2012 19:09:48 -0700
Subject: [PATCH] Don't copy chaperoned immutable vectors. (cherry picked from
 commit 717cf332b6a12d0cb9bf476d8b78335ed80188a4)

---
 collects/racket/contract/private/box.rkt    |  2 +-
 collects/racket/contract/private/hash.rkt   |  2 +-
 collects/racket/contract/private/vector.rkt |  4 +-
 collects/tests/racket/contract-test.rktl    | 47 ++++++++++++++++++++-
 4 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/collects/racket/contract/private/box.rkt b/collects/racket/contract/private/box.rkt
index c2512cac9b..e0731d763e 100644
--- a/collects/racket/contract/private/box.rkt
+++ b/collects/racket/contract/private/box.rkt
@@ -78,7 +78,7 @@
               [neg-elem-proj ((contract-projection elem-ctc) (blame-swap blame))])
           (λ (val)
             (check-box/c ctc val blame)
-            (if (immutable? val)
+            (if (and (immutable? val) (not (chaperone? val)))
                 (box-immutable (pos-elem-proj (unbox val)))
                 (box-wrapper val
                              (λ (b v) (pos-elem-proj v))
diff --git a/collects/racket/contract/private/hash.rkt b/collects/racket/contract/private/hash.rkt
index b88c4da0ac..1fe4e68be4 100644
--- a/collects/racket/contract/private/hash.rkt
+++ b/collects/racket/contract/private/hash.rkt
@@ -169,7 +169,7 @@
         (define neg-rng-proj (rng-proc (blame-add-context blame "the values of" #:swap? #t)))
         (λ (val)
           (check-hash/c ctc val blame)
-          (if (immutable? val)
+          (if (and (immutable? val) (not (chaperone? val)))
               (let ([hash-maker
                      (cond
                        [(hash-equal? val) make-immutable-hash]
diff --git a/collects/racket/contract/private/vector.rkt b/collects/racket/contract/private/vector.rkt
index 6155074821..83568fb9d5 100644
--- a/collects/racket/contract/private/vector.rkt
+++ b/collects/racket/contract/private/vector.rkt
@@ -104,7 +104,7 @@
                                   (apply raise-blame-error blame val args)))
            (λ (val)
              (check val raise-blame #f)
-             (if (immutable? val)
+             (if (and (immutable? val) (not (chaperone? val)))
                  (apply vector-immutable
                         (for/list ([e (in-vector val)])
                           (elem-pos-proj e)))
@@ -249,7 +249,7 @@
                                   (blame-add-context blame (format "the ~a element of" (n->th i)) #:swap? #t)))])
            (λ (val)
              (check-vector/c ctc val blame)
-             (if (immutable? val)
+             (if (and (immutable? val) (not (chaperone? val)))
                  (apply vector-immutable
                         (for/list ([e (in-vector val)]
                                    [i (in-naturals)])
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 9177af5f49..77a2317ae8 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -4503,8 +4503,53 @@
    'make-flat-contract-bad-6
    '(chaperone-contract? proj:prime-list/c)
    #t)
+  
 
-
+;; Adding tests for using vector/box/hash contracts with already chaperoned values
+  
+  (test/no-error
+   '(let ([v (chaperone-vector (vector-immutable 1)
+                               (λ (vec i v) v)
+                               (λ (vec i v) v))])
+      (contract (vectorof any/c) v 'pos 'neg)))
+  
+  (test/no-error
+   '(let ([v (chaperone-vector (vector-immutable 1)
+                               (λ (vec i v) v)
+                               (λ (vec i v) v))])
+      (contract (vector/c any/c) v 'pos 'neg)))
+  
+  (test/no-error
+   '(let ([v (chaperone-box (box-immutable 1)
+                            (λ (box v) v)
+                            (λ (box v) v))])
+      (contract (box/c any/c) v 'pos 'neg)))
+  
+  (test/no-error
+   '(let ([v (chaperone-hash (make-immutable-hash (list (cons 1 2)))
+                             (λ (hash k) (values k (λ (h k v) v)))
+                             (λ (hash k v) (values k v))
+                             (λ (hash k) k)
+                             (λ (hash k) k))])
+      (contract (hash/c any/c any/c) v 'pos 'neg)))
+  
+  (test/no-error
+   '(let ([v (chaperone-hash (make-immutable-hasheq (list (cons 1 2)))
+                             (λ (hash k) (values k (λ (h k v) v)))
+                             (λ (hash k v) (values k v))
+                             (λ (hash k) k)
+                             (λ (hash k) k))])
+      (contract (hash/c any/c any/c) v 'pos 'neg)))
+  
+  (test/no-error
+   '(let ([v (chaperone-hash (make-immutable-hasheqv (list (cons 1 2)))
+                             (λ (hash k) (values k (λ (h k v) v)))
+                             (λ (hash k v) (values k v))
+                             (λ (hash k) k)
+                             (λ (hash k) k))])
+      (contract (hash/c any/c any/c) v 'pos 'neg)))
+  
+  
 ;
 ;
 ;