fix problem with chaperone of chaperoned hash

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

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)]

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,