From e02e04ff2a35e7dbe4b0c1ed2c1d6c331fdd7cff Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 20 Aug 2013 05:51:19 -0600
Subject: [PATCH] fix `hash-clear!' on impersonated hash tables

Closes PR 13977
---
 .../racket-test/tests/racket/chaperone.rktl    |  8 +++++---
 racket/src/racket/src/list.c                   | 18 ++++++++++++------
 2 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
index 64ead3f1c1..b2590e08ff 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
@@ -845,7 +845,10 @@
      (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)))))))
+                             (test v hash-ref ht k)
+                             (k (v 10))))
+     (test (void) hash-clear! ht)
+     (test 0 hash-count ht))))
 
 ;; ----------------------------------------
 
@@ -866,8 +869,7 @@
            (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))
-           (err/rt-test (hash-clear! h))))])
+           (err/rt-test (hash-for-each h void))))])
   (check (make-hash))
   (check (make-hasheq))
   (check (make-weak-hash))
diff --git a/racket/src/racket/src/list.c b/racket/src/racket/src/list.c
index b8ae9ed79b..e2007ee34c 100644
--- a/racket/src/racket/src/list.c
+++ b/racket/src/racket/src/list.c
@@ -2424,25 +2424,31 @@ static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[])
 
 static Scheme_Object *hash_table_clear_bang(int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *v;
+  Scheme_Object *v, *v2;
 
   v = argv[0];
 
-  if (!(SCHEME_HASHTP(v) && SCHEME_MUTABLEP(v)) && !SCHEME_BUCKTP(v))
+  v2 = (SCHEME_NP_CHAPERONEP(v) ? SCHEME_CHAPERONE_VAL(v) : v);
+
+  if (!(SCHEME_HASHTP(v2) && SCHEME_MUTABLEP(v2)) && !SCHEME_BUCKTP(v2))
     scheme_wrong_contract("hash-clear!", "(and/c hash? (not/c immutable?))", 0, argc, argv);
 
   if (SCHEME_NP_CHAPERONEP(v) && (SCHEME_HASHTP(SCHEME_CHAPERONE_VAL(v))
                                   || SCHEME_BUCKTP(SCHEME_CHAPERONE_VAL(v)))) {
-    /* Implement `(hash-clear! ht)' as `(hash-for-each ht hash-set!)'
+    /* Implement `(hash-clear! ht)' as `(hash-for-each ht (lambda (k) (hash-remove! ht k)))'
        to allow chaperones to interpose. */
-    Scheme_Object *i, *a[2];
+    Scheme_Object *i, *a[2], *key;
     a[0] = v;
     while (1) {
       i = scheme_hash_table_iterate_start(1, a);
       if (SCHEME_FALSEP(i))
         break;
-      a[2] = i;
-      hash_table_remove_bang(1, a);
+
+      a[1] = i;
+      key = scheme_hash_table_iterate_key(2, a);
+      a[1] = key;
+      
+      hash_table_remove_bang(2, a);
     }
   } else if (SCHEME_BUCKTP(v)) {
     scheme_clear_bucket_table((Scheme_Bucket_Table *)v);