diff --git a/collects/scribblings/reference/chaperones.scrbl b/collects/scribblings/reference/chaperones.scrbl index c9a3275e07..52cb350e38 100644 --- a/collects/scribblings/reference/chaperones.scrbl +++ b/collects/scribblings/reference/chaperones.scrbl @@ -250,7 +250,7 @@ application) operations on the chaperoned hash table redirected. When @scheme[hash-set] or @scheme[hash-remove] is used on a chaperoned hash table, the resulting hash table is given all of the chaperones of the given hash table. In addition, operations like -@scheme[hash-iterate-key] or @scheme[hash-iterate-map], which extract +@scheme[hash-iterate-key] or @scheme[hash-map], which extract keys from the table, use @scheme[key-proc] to filter keys extracted from the table. Operations like @scheme[hash-iterate-value] or @scheme[hash-iterate-map] implicitly use @scheme[hash-ref] and diff --git a/collects/tests/racket/chaperone.rktl b/collects/tests/racket/chaperone.rktl index 44b27e837a..759084b270 100644 --- a/collects/tests/racket/chaperone.rktl +++ b/collects/tests/racket/chaperone.rktl @@ -626,6 +626,37 @@ ;; ---------------------------------------- +(letrec ([wrap + (lambda (v) + (cond + [(hash? v) + (chaperone-hash v + (lambda (h k) + (values (wrap k) + (lambda (h k v) (wrap v)))) + (lambda (h k v) + (values (wrap k) (wrap v))) + (lambda (h k) + (wrap k)) + (lambda (h k) + (wrap k)))] + [(procedure? v) (chaperone-procedure + v + (lambda args + (apply values + (lambda args + (apply values (map wrap args))) + (map wrap args))))] + [(number? v) v] + [else (error 'wrap "cannot wrap: ~v" v)]))]) + (let ([ht (wrap (wrap (make-hash)))]) + (hash-set! ht add1 sub1) + (test 9 (hash-ref ht add1) 10) + (test '(10) 'for-hash (for/list ([(k v) (in-hash ht)]) + (k (v 10)))))) + +;; ---------------------------------------- + (let () (define-struct a (x y) #:transparent) (let* ([a1 (make-a 1 2)] diff --git a/src/racket/src/list.c b/src/racket/src/list.c index 9a9c5d7ee7..bbb48e8aba 100644 --- a/src/racket/src/list.c +++ b/src/racket/src/list.c @@ -2692,6 +2692,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem while (1) { if (!SCHEME_NP_CHAPERONEP(o)) { if (mode == 0) { + /* hash-ref */ if (SCHEME_HASHTP(o)) return scheme_hash_get((Scheme_Hash_Table *)o, k); else if (SCHEME_HASHTRP(o)) @@ -2699,6 +2700,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem else return scheme_lookup_in_table((Scheme_Bucket_Table *)o, (const char *)k); } else if ((mode == 1) || (mode == 2)) { + /* hash-set! or hash-remove! */ if (SCHEME_HASHTP(o)) scheme_hash_set((Scheme_Hash_Table *)o, k, v); else if (SCHEME_HASHTRP(o)) { @@ -2734,9 +2736,10 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem if (mode == 0) orig = NULL; - else if (mode == 3) + else if (mode == 3) { orig = chaperone_hash_op(who, px->prev, k, v, mode); - else if (mode == 2) + k = orig; + } else if (mode == 2) orig = k; else orig = v; @@ -2753,7 +2756,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem a[2] = orig; if ((mode == 0) || (mode == 1)) { - /* hash-set! */ + /* hash-ref or hash-set! */ Scheme_Object **vals; int cnt; Scheme_Thread *p; @@ -2790,6 +2793,7 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem o = vals[1]; if (mode == 0) { + /* hash-ref */ red = o; if (!scheme_check_proc_arity(NULL, 3, 1, 2, vals)) scheme_raise_exn(MZEXN_FAIL_CONTRACT,