suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Don't copy chaperoned immutable vectors.

Browse Source 
(cherry picked from commit 717cf332b6)
This commit is contained in:
Stevie Strickland 2012-10-24 19:09:48 -07:00 committed by Ryan Culpepper
parent 1a535768f4
commit 3c8111f93a
4 changed files with 50 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/contract/private/box.rkt
View File

@ -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))

2
collects/racket/contract/private/hash.rkt
View File

@ -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]

4
collects/racket/contract/private/vector.rkt
View File

@ -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)])

47
collects/tests/racket/contract-test.rktl
View File

@ -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)))
;
;
;