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

cs: fix chaperone-of? for hash tables with nested chaperones

Browse Source
This commit is contained in:
Matthew Flatt 2019-05-22 08:30:20 -06:00
parent e2ab4869d7
commit 0b74787419
2 changed files with 42 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -2123,6 +2123,38 @@
(test #f chaperone-of? (hash-set h3 2 sub1) h3)))
(list #hash() #hasheq() #hasheqv()))
;; Make sure that multiple chaperone/impersonator layers
;; are allowed by `chaperone-of?` and `impersonator-of?`
(as-chaperone-or-impersonator
([chaperone-hash impersonate-hash]
[chaperone-of? impersonator-of?])
(define ht (make-hash))
(define (chaperone ht)
(chaperone-hash
ht
(lambda (ht k) (values k (lambda (hc k v) v)))
(lambda (ht k v)
(values (chaperone-hash
k
(lambda (ht k) (values k (lambda (hc k v) v)))
(lambda (ht k v) (values k v))
(lambda (ht k) k)
(lambda (ht k) k))
v))
(lambda (ht k) k)
(lambda (ht k) k)))
(define ht0 (chaperone ht))
(define ht1 (chaperone ht0))
(test #t chaperone-of? ht1 ht)
(test #t chaperone-of? ht1 ht0)
(test #f chaperone-of? ht ht1)
(test #f chaperone-of? ht0 ht1)
(hash-set! ht1 (make-hash '((a . b))) 'ok)
(test 'ok hash-ref ht1 (make-hash '((a . b)))))
;; ----------------------------------------
(as-chaperone-or-impersonator

18
racket/src/cs/rumble/equal.ss
View File

@ -12,17 +12,19 @@
;; For immutable hashes, it's ok for the two objects to not be eq,
;; as long as the interpositions are the same and the underlying
;; values are `{impersonator,chaperone}-of?`:
(and (eq? (hash-impersonator-procs a)
(hash-impersonator-procs b))
(loop (impersonator-next a)
(impersonator-next b)))]
(if (eq? (hash-impersonator-procs a)
(hash-impersonator-procs b))
(loop (impersonator-next a)
(impersonator-next b))
(loop (impersonator-next a) b))]
[(and (hash-chaperone? a)
(hash-chaperone? b))
;; Same as above
(and (eq? (hash-chaperone-procs a)
(hash-chaperone-procs b))
(loop (impersonator-next a)
(impersonator-next b)))]
(if (eq? (hash-chaperone-procs a)
(hash-chaperone-procs b))
(loop (impersonator-next a)
(impersonator-next b))
(loop (impersonator-next a) b))]
[(and (props-impersonator? b)
(not (eq? mode 'chaperone-of?)))
(loop a (impersonator-next b))]