fix hash proxying in the case that proxied key has no value

collects/scribblings/reference/chaperones.scrbl

@@ -291,6 +291,12 @@ other operations that use @scheme[hash-iterate-key] internally); it
 must produce a replacement for the key, which is then reported as a
 key extracted from the table.
 
+The @racket[hash-iterate-value], @racket[hash-map], or
+@racket[hash-for-each] functions use a combination of
+@racket[hash-iterate-key] and @racket[hash-ref]. If a key
+produced by @scheme[key-proc] does not yield a value through
+@racket[hash-ref], then the @exnraise[exn:fail:contract].
+
 Pairs of @scheme[prop] and @scheme[prop-val] (the number of arguments
 to @scheme[proxy-hash] must be odd) add proxy properties
 or override proxy-property values of @scheme[hash].}

collects/tests/racket/chaperone.rktl

@@ -828,6 +828,50 @@
 
 ;; ----------------------------------------
 
+;; Check broken key proxy:
+
+(let ([check
+       (lambda (orig)
+         (let ([h (proxy-hash
+                   orig
+                   (λ (h k) 
+                      (values 'bad1
+                              (λ (h k v)
+                                 'bad2)))
+                   (λ (h k v) (values 'bad3 'bad4))
+                   (λ (h k) 'bad5)
+                   (λ (h k) 'bad6))])
+           (test (void) hash-set! h 1 2)
+           (test #f hash-ref h 1 #f)
+           (err/rt-test (hash-iterate-value h (hash-iterate-first h)))
+           (err/rt-test (hash-map h void))
+           (err/rt-test (hash-for-each h void))))])
+  (check (make-hash))
+  (check (make-hasheq))
+  (check (make-weak-hash))
+  (check (make-weak-hasheq)))
+
+(let ([check
+       (lambda (orig)
+         (let ([h (chaperone-hash
+                   orig
+                   (λ (h k) 
+                      (values (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))
+                              (λ (h k v) v)))
+                   (λ (h k v) (values (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))
+                                      v))
+                   (λ (h k) (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v)))
+                   (λ (h k) (chaperone-vector k (lambda (b i v) v) (lambda (b i v) v))))])
+           (let* ([vec (vector 1 2 3)]
+                  [h (hash-set h vec 2)])
+             (test #f hash-ref h vec #f)
+             (err/rt-test (hash-iterate-value h (hash-iterate-first h)))
+             (err/rt-test (hash-map h void))
+             (err/rt-test (hash-for-each h void)))))])
+  (check (hasheq)))
+
+;; ----------------------------------------
+
 (let ()
   (define-struct a (x y) #:transparent)
   (let* ([a1 (make-a 1 2)]

src/racket/src/list.c

@@ -2021,6 +2021,7 @@ static Scheme_Object *hash_table_copy(int argc, Scheme_Object *argv[])
       scheme_hash_tree_index(t, i, &k, &val);
       if (!SAME_OBJ((Scheme_Object *)t, v))
         val = scheme_chaperone_hash_traversal_get(v, k);
+      if (val)
         scheme_hash_set(naya, k, val);
     }
 
@@ -2330,6 +2331,11 @@ static Scheme_Object *do_map_hash_table(int argc,
           v = chaperone_hash_key(name, chaperone, p[0]);
           p[0] = v;
           v = scheme_chaperone_hash_get(chaperone, v);
+          if (!v)
+            scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                             "%s: no value found for post-proxy key: %V",
+                             name,
+                             p[0]);
         } else
           v = (Scheme_Object *)bucket->val;
         if (v) {
@@ -2359,6 +2365,11 @@ static Scheme_Object *do_map_hash_table(int argc,
           v = chaperone_hash_key(name, chaperone, p[0]);
           p[0] = v;
           v = scheme_chaperone_hash_get(chaperone, v);
+          if (!v)
+            scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                             "%s: no value found for post-proxy key: %V",
+                             name,
+                             p[0]);
         } else {
           v = hash->vals[i];
         }
@@ -2391,6 +2402,11 @@ static Scheme_Object *do_map_hash_table(int argc,
       if (chaperone) {
         ik = chaperone_hash_key(name, chaperone, ik);
         iv = scheme_chaperone_hash_get(chaperone, ik);
+        if (!iv)
+          scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                           "%s: no value found for post-chaperone key: %V",
+                           name,
+                           ik);
       }
       if (iv) {
         p[1] = iv;
@@ -2524,7 +2540,7 @@ static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[])
 
 static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
 {
-  Scheme_Object *p = argv[1], *obj, *chaperone;
+  Scheme_Object *p = argv[1], *obj, *chaperone, *key;
   int pos, sz;
 
   obj = argv[0];
@@ -2551,9 +2567,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
     if (pos < sz) {
       if (hash->vals[pos]) {
         if (chaperone) {
-          if (get_val)
+          if (get_val) {
-            return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, hash->keys[pos]));
+            key = chaperone_hash_key(name, chaperone, hash->keys[pos]);
-          else
+            obj = scheme_chaperone_hash_get(chaperone, key);
+            if (!obj)
+              scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                               "hash-iterate-value: no value found for post-proxy key: %V",
+                               key);
+            return obj;
+          } else
             return chaperone_hash_key(name, chaperone, hash->keys[pos]);
         } else if (get_val)
           return hash->vals[pos];
@@ -2565,9 +2587,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
     Scheme_Object *v, *k;
     if (scheme_hash_tree_index((Scheme_Hash_Tree *)obj, pos, &k, &v)) {
       if (chaperone) {
-        if (get_val)
+        if (get_val) {
-          return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, k));
+          key = chaperone_hash_key(name, chaperone, k);
-        else
+          obj = scheme_chaperone_hash_get(chaperone, key);
+          if (!obj)
+            scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                             "hash-iterate-value: no value found for post-chaperone key: %V",
+                             key);
+          return obj;
+        } else
           return chaperone_hash_key(name, chaperone, k);
       } else
         return (get_val ? v : k);
@@ -2591,9 +2619,15 @@ static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object
           else
             obj = (Scheme_Object *)bucket->key;
           if (chaperone) {
-            if (get_val)
+            if (get_val) {
-              return scheme_chaperone_hash_get(chaperone, chaperone_hash_key(name, chaperone, obj));
+              key = chaperone_hash_key(name, chaperone, obj);
-            else
+              obj = scheme_chaperone_hash_get(chaperone, key);
+              if (!obj)
+                scheme_raise_exn(MZEXN_FAIL_CONTRACT,
+                                 "hash-iterate-value: no value found for post-proxy key: %V",
+                                 key);
+              return obj;
+            } else
               return chaperone_hash_key(name, chaperone, obj);
           } else
             return obj;
@@ -2709,7 +2743,12 @@ static Scheme_Object *chaperone_hash_op_k(void)
   p->ku.k.p3 = NULL;
   p->ku.k.p4 = NULL;
 
-  return chaperone_hash_op(who, o, k, v, p->ku.k.i1);
+  o = chaperone_hash_op(who, o, k, v, p->ku.k.i1);
+  
+  if (!o)
+    return scheme_false;
+  else
+    return scheme_box(o);
 }
 
 static Scheme_Object *chaperone_hash_op_overflow(const char *who, Scheme_Object *o, Scheme_Object *k, 
@@ -2723,7 +2762,12 @@ static Scheme_Object *chaperone_hash_op_overflow(const char *who, Scheme_Object
   p->ku.k.p4 = (void *)who;
   p->ku.k.i1 = mode;
 
-  return scheme_handle_stack_overflow(chaperone_hash_op_k);
+  o = scheme_handle_stack_overflow(chaperone_hash_op_k);
+
+  if (SCHEME_FALSEP(o)) 
+    return NULL;
+  else
+    return SCHEME_BOX_VAL(o);
 }
 
 static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Scheme_Object *k,