From 8f2874e4b53805e75556fd71b57f3e63ed413e54 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 26 Dec 2015 22:35:16 -0600 Subject: [PATCH] fix impersonator properties for chaperone-hash-set and impersonate-hash-set --- pkgs/racket-test-core/tests/racket/set.rktl | 21 +++++++ racket/collects/racket/private/set-types.rkt | 64 ++++++++++++-------- 2 files changed, 59 insertions(+), 26 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/set.rktl b/pkgs/racket-test-core/tests/racket/set.rktl index c1a3eb5c5c..2965ec0e7b 100644 --- a/pkgs/racket-test-core/tests/racket/set.rktl +++ b/pkgs/racket-test-core/tests/racket/set.rktl @@ -636,5 +636,26 @@ (λ (s e) (+ e 1)) (λ (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) diff --git a/racket/collects/racket/private/set-types.rkt b/racket/collects/racket/private/set-types.rkt index 08f52577ee..222ef87996 100644 --- a/racket/collects/racket/private/set-types.rkt +++ b/racket/collects/racket/private/set-types.rkt @@ -344,7 +344,7 @@ remove-proc . clear-proc+props) - (define-values (clear-proc args) + (define-values (clear-proc prop-args) (check-chap/imp-args #f s ref-proc @@ -357,19 +357,21 @@ "~s did not return a chaperone of ~e, got ~e" who original new)) new) - (update-custom-set-table - s - (apply - chaperone-hash - (custom-set-table s) - (λ (hash key) (values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)) - (λ (hash key val) val))) - (λ (hash key val) (values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key)) - val)) - (λ (hash key) (check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key))) - (λ (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)))) - args))) + (add-impersonator-properties + (update-custom-set-table + s + (chaperone-hash + (custom-set-table s) + (λ (hash key) + (values (check-it 'ref-proc key (ref-proc (update-custom-set-table s hash) key)) + (λ (hash key val) val))) + (λ (hash key val) + (values (check-it 'add-proc key (add-proc (update-custom-set-table s hash) key)) + val)) + (λ (hash key) (check-it 'remove-proc key (remove-proc (update-custom-set-table s hash) key))) + (λ (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 ref-proc @@ -377,24 +379,34 @@ remove-proc . clear-proc+props) - (define-values (clear-proc args) + (define-values (clear-proc prop-args) (check-chap/imp-args #t s ref-proc add-proc remove-proc clear-proc+props)) - (update-custom-set-table - s - (apply - impersonate-hash - (custom-set-table s) - (λ (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) (remove-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)))) - args))) + (add-impersonator-properties + (update-custom-set-table + s + (impersonate-hash + (custom-set-table s) + (λ (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) (remove-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)))))) + 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? s