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

fix impersonator properties for chaperone-hash-set and impersonate-hash-set

Browse Source
This commit is contained in:
Robby Findler 2015-12-26 22:35:16 -06:00
parent daf19869de
commit 8f2874e4b5
2 changed files with 59 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
pkgs/racket-test-core/tests/racket/set.rktl
View File

@ -636,5 +636,26 @@
(λ (s e) (+ e 1)) (λ (s e) (+ e 1))
(λ (s l) l) (λ (s l) l)
(λ (s l) l)))) (λ (s l) l))))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (chaperone-hash-set (set) (λ (s l) l) (λ (s l) l) (λ (s l) l) impersonator-prop:p 11)])
(test #t has-impersonator-prop:p? s)))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (chaperone-hash-set (set) (λ (s l) l) (λ (s l) l) (λ (s l) l) impersonator-prop:p 11)])
(test 11 get-impersonator-prop:p s)))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (impersonate-hash-set (weak-set) (λ (s l) l) (λ (s l) l) (λ (s l) l)
impersonator-prop:p 11)])
(test #t has-impersonator-prop:p? s)))
(let-values ([(impersonator-prop:p has-impersonator-prop:p? get-impersonator-prop:p)
(make-impersonator-property 'p)])
(let ([s (impersonate-hash-set (mutable-set) (λ (s l) l) (λ (s l) l) (λ (s l) l)
impersonator-prop:p 11)])
(test 11 get-impersonator-prop:p s)))
(report-errs) (report-errs)

64
racket/collects/racket/private/set-types.rkt
View File

@ -344,7 +344,7 @@
remove-proc remove-proc
. .
clear-proc+props) clear-proc+props)
(define-values (clear-proc args) (define-values (clear-proc prop-args)
(check-chap/imp-args #f (check-chap/imp-args #f
s s
ref-proc ref-proc
@ -357,19 +357,21 @@
"~s did not return a chaperone of ~e, got ~e" "~s did not return a chaperone of ~e, got ~e"
who original new)) who original new))
new) new)
(update-custom-set-table (add-impersonator-properties
s (update-custom-set-table
(apply s
chaperone-hash (chaperone-hash
(custom-set-table s) (custom-set-table s)
(λ (hash key) (values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)) (λ (hash key)
(λ (hash key val) val))) (values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key))
(λ (hash key val) (values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key)) (λ (hash key val) val)))
val)) (λ (hash key val)
(λ (hash key) (check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key))) (values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key))
(λ (hash key) (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key))) val))
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash)))) (λ (hash key) (check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key)))
args))) (λ (hash key) (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)))
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash))))))
prop-args))
(define (impersonate-hash-set s (define (impersonate-hash-set s
ref-proc ref-proc
@ -377,24 +379,34 @@
remove-proc remove-proc
. .
clear-proc+props) clear-proc+props)
(define-values (clear-proc args) (define-values (clear-proc prop-args)
(check-chap/imp-args #t (check-chap/imp-args #t
s s
ref-proc ref-proc
add-proc add-proc
remove-proc remove-proc
clear-proc+props)) clear-proc+props))
(update-custom-set-table (add-impersonator-properties
s (update-custom-set-table
(apply s
impersonate-hash (impersonate-hash
(custom-set-table s) (custom-set-table s)
(λ (hash key) (values (ref-proc (update-custom-set-table s hash) key) (λ (hash key val) val))) (λ (hash key) (values (ref-proc (update-custom-set-table s hash) key) (λ (hash key val) val)))
(λ (hash key val) (values (add-proc (update-custom-set-table s hash) key) val)) (λ (hash key val) (values (add-proc (update-custom-set-table s hash) key) val))
(λ (hash key) (remove-proc (update-custom-set-table s hash) key)) (λ (hash key) (remove-proc (update-custom-set-table s hash) key))
(λ (hash key) (ref-proc (update-custom-set-table s hash) key)) (λ (hash key) (ref-proc (update-custom-set-table s hash) key))
(and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash)))) (and clear-proc (λ (hash) (clear-proc (update-custom-set-table s hash))))))
args))) prop-args))
(define (add-impersonator-properties without-props prop-args)
(cond
[(null? prop-args) without-props]
[(immutable-custom-set? without-props)
(apply chaperone-struct without-props struct:immutable-custom-set prop-args)]
[(weak-custom-set? without-props)
(apply chaperone-struct without-props struct:weak-custom-set prop-args)]
[else
(apply chaperone-struct without-props struct:mutable-custom-set prop-args)]))
(define (check-chap/imp-args impersonate? (define (check-chap/imp-args impersonate?
s s