adjust hash/c so that it always copies immutable hashes
before this commit it would copy them only when the weren't
already impersonated/chaperoned, leading to different
contract checking that can be confusing in that case
it did this because the chaperone-of? check wasn't general
enough to cope with copying always, but since commit
b05d07ad10
it now is
This commit is contained in:
parent
74786ed8d0
commit
a8ba4eca35
|
@ -191,6 +191,51 @@
|
|||
(for ([(k v) (in-hash h)])
|
||||
(hash-ref k v))))
|
||||
|
||||
(test/spec-passed
|
||||
'hash/c14
|
||||
'(let ()
|
||||
(define h (hash 1 #f))
|
||||
(hash-set (contract (hash/c integer? boolean?) h 'pos 'neg)
|
||||
1 "x")))
|
||||
|
||||
(test/spec-passed/result
|
||||
'hash/c15
|
||||
'(let ()
|
||||
(define h (hash 1 #f))
|
||||
(chaperone-of? (contract (hash/c integer? boolean?) h 'pos 'neg)
|
||||
h))
|
||||
#t)
|
||||
|
||||
(test/spec-passed
|
||||
'hash/c16
|
||||
'(let ()
|
||||
(define h (hash 1 #f))
|
||||
(define c-h
|
||||
(chaperone-hash
|
||||
h
|
||||
(λ (h k) (values k (λ (h k v) v)))
|
||||
(λ (h k v) (values k v))
|
||||
(λ (h k) k)
|
||||
(λ (h k) k)))
|
||||
(hash-set (contract (hash/c integer? boolean?) c-h 'pos 'neg)
|
||||
1 "x")))
|
||||
|
||||
(test/spec-passed/result
|
||||
'hash/c17
|
||||
'(let ()
|
||||
(define h (hash 1 #f))
|
||||
(define c-h
|
||||
(chaperone-hash
|
||||
h
|
||||
(λ (h k) (values k (λ (h k v) v)))
|
||||
(λ (h k v) (values k v))
|
||||
(λ (h k) k)
|
||||
(λ (h k) k)))
|
||||
(chaperone-of? (contract (hash/c integer? boolean?) c-h 'pos 'neg)
|
||||
c-h))
|
||||
#t)
|
||||
|
||||
|
||||
(test/pos-blame
|
||||
'hash/dc1
|
||||
'(contract (hash/dc [d integer?] [r (d) (if (even? d) string? symbol?)])
|
||||
|
|
|
@ -237,16 +237,11 @@
|
|||
(define (handle-the-hash val neg-party
|
||||
pos-dom-proj neg-dom-proj mk-pos-rng-proj mk-neg-rng-proj
|
||||
chaperone-or-impersonate-hash ctc blame)
|
||||
(if (and (immutable? val) (not (chaperone? val)))
|
||||
(let ([hash-maker
|
||||
(cond
|
||||
[(hash-equal? val) make-immutable-hash]
|
||||
[(hash-eqv? val) make-immutable-hasheqv]
|
||||
[(hash-eq? val) make-immutable-hasheq])])
|
||||
(hash-maker
|
||||
(for/list ([(k v) (in-hash val)])
|
||||
(cons ((pos-dom-proj k) neg-party)
|
||||
(((mk-pos-rng-proj k) v) neg-party)))))
|
||||
(if (immutable? val)
|
||||
(for/fold ([h val]) ([(k v) (in-hash val)])
|
||||
(hash-set h
|
||||
((pos-dom-proj k) neg-party)
|
||||
(((mk-pos-rng-proj k) v) neg-party)))
|
||||
(chaperone-or-impersonate-hash
|
||||
val
|
||||
(λ (h k)
|
||||
|
|
Loading…
Reference in New Issue
Block a user