diff --git a/pkgs/racket-doc/scribblings/reference/chaperones.scrbl b/pkgs/racket-doc/scribblings/reference/chaperones.scrbl index d76a47ac71..ee7e211154 100644 --- a/pkgs/racket-doc/scribblings/reference/chaperones.scrbl +++ b/pkgs/racket-doc/scribblings/reference/chaperones.scrbl @@ -105,16 +105,29 @@ Otherwise, impersonators within @racket[v2] must be intact within @itemlist[ - @item{the same value that is a part of @racket[v2];} + @item{the same value that is a part of @racket[v2] (with a + special meaning of ``the same value`` in the case of + immutable hash tables, as described below);} - @item{a value further derived from the part of @racket[v2] - value using an impersonator constructor; or} + @item{a value further derived from the same value that is + part of @racket[v2] using an impersonator constructor; + or} @item{a value with the @racket[prop:impersonator-of] property - whose procedure produces an impersonator of the value - that is a part of @racket[v2].} + whose procedure produces an impersonator of the same value + that is part of @racket[v2].} - ]} + ] + + For most kinds of values, ``the same value'' means equal + according to @racket[eq?]. In the case of an immutable hash + table, two impersonated hash tables count as ``the same value'' + when their redirection procedures were originally attached to a + hash table by the same call to @racket[impersonate-hash] or + @racket[chaperone-hash] (and potentially propagated by + @racket[hash-set], @racket[hash-remove], or + @racket[hash-clear]), as long as the content of the first hash + table is @racket[impersonator-of?] of the second hash table.} @item{If a part of @racket[v2] is a structure or procedure impersonator that was created with no redirection procedures (i.e, @racket[#f] in diff --git a/pkgs/racket-test-core/tests/racket/chaperone.rktl b/pkgs/racket-test-core/tests/racket/chaperone.rktl index de9523ed4f..bceaf6bef7 100644 --- a/pkgs/racket-test-core/tests/racket/chaperone.rktl +++ b/pkgs/racket-test-core/tests/racket/chaperone.rktl @@ -1137,7 +1137,7 @@ make-weak-hash make-weak-hasheq make-weak-hasheqv))) (for-each - (lambda (h1) + (lambda (h1) (let* ([get-k #f] [get-v #f] [set-k #f] @@ -1199,7 +1199,27 @@ (set! get-v #f) (test #t values (equal? h2 (hash-set h1 'key 'val))) (test '(key val key2 val2 key2 key) list get-k get-v set-k set-v remove-k access-k) - (void))))))) + (void)))))) + ;; Check that `hash-set` propagates in a way that allows + ;; `chaperone-of?` to work recursively: + (let () + (define proc (lambda (x) (add1 x))) + (define h2 (hash-set h1 1 proc)) + (define (add-chap h2) + (chaperone-hash h2 + (λ (h k) (values k (λ (h k v) v))) + (λ (h k v) (values k v)) + (λ _ #f) + (λ (h k) k))) + (define h3 (add-chap h2)) + (test #t chaperone-of? h3 h2) + (test #f chaperone-of? h3 (add-chap h2)) + (define h4 (hash-set h3 1 proc)) + (test #t chaperone-of? h4 h3) + (define h5 (hash-set h3 1 (chaperone-procedure proc void))) + (test #t chaperone-of? h5 h3) + (test #f chaperone-of? (hash-set h3 1 sub1) h3) + (test #f chaperone-of? (hash-set h3 2 sub1) h3))) (list #hash() #hasheq() #hasheqv())) ;; ---------------------------------------- diff --git a/racket/src/racket/src/bool.c b/racket/src/racket/src/bool.c index 81f0235703..6b0010a873 100644 --- a/racket/src/racket/src/bool.c +++ b/racket/src/racket/src/bool.c @@ -576,6 +576,19 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql) && SCHEME_CHAPERONEP(obj1) && (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_IMPERSONATOR) || (eql->for_chaperone > 1))) { + /* `obj1` and `obj2` are not eq, otherwise is_fast_equal() + would have returned true */ + if (SCHEME_CHAPERONEP(obj2)) { + /* 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?`: */ + if (SAME_TYPE(SCHEME_TYPE(((Scheme_Chaperone *)obj1)->val), scheme_hash_tree_type) + && SAME_TYPE(SCHEME_TYPE(((Scheme_Chaperone *)obj2)->val), scheme_hash_tree_type) + /* eq redirects means redirects were propagated: */ + && SAME_OBJ(((Scheme_Chaperone *)obj1)->redirects, + ((Scheme_Chaperone *)obj2)->redirects)) + obj2 = ((Scheme_Chaperone *)obj2)->prev; + } obj1 = ((Scheme_Chaperone *)obj1)->prev; goto top_after_next; } diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c index db85b1f354..a7dd299e0b 100644 --- a/racket/src/racket/src/list.c +++ b/racket/src/racket/src/list.c @@ -2914,6 +2914,9 @@ static Scheme_Object *do_chaperone_hash(const char *name, int is_impersonator, i } else clear = scheme_false; + /* The allocation of this vector is used to detect when two + chaperoned immutable hash tables can be + `{chaperone,impersonator}-of?` when they're not eq. */ redirects = scheme_make_vector(5, NULL); SCHEME_VEC_ELS(redirects)[0] = argv[1]; SCHEME_VEC_ELS(redirects)[1] = argv[2];