add missing lock on chaperoned/impersonated hash-table operations

For `equal?`-based hash tables, various operations are supposed to
take a lock on the table, but the lock was missing.

pkgs/racket-test-core/tests/racket/chaperone.rktl

@@ -2214,11 +2214,61 @@
       (test 'vec7 hash-ref ht (vector 7) #f)
       (hash-set! ht key 'vec2)
       (test 'vec2 hash-ref ht (vector 1 2))
-      (err/rt-test (hash-ref cht (vector 1 2) #f) one-exn?)
       (test 2 length (hash-keys cht)) ; can extract keys without hashing or comparing
       (test 'vec2 hash-ref ht key)
-      (test 'vec7 hash-ref ht key7))))
+      (test 'vec7 hash-ref ht key7)
-    
+      (err/rt-test (hash-ref cht (vector 1 2) #f) one-exn?))))
+
+;; ----------------------------------------
+;; Make sure chaperoned hash tables use a lock
+
+(for ([make-hash (list make-hash make-weak-hash)])
+  (define ht (make-hash))
+
+  (struct a (v)
+    #:property
+    prop:equal+hash
+    (list (lambda (a b eql?)
+            (when (zero? (random 20)) (sleep))
+            (eql? (a-v a) (a-v b)))
+          (lambda (a hc)
+            (when (zero? (random 20)) (sleep))
+            (hc (a-v a)))
+          (lambda (a hc)
+            (hc (a-v a)))))
+
+  (for ([i 1000])
+    (hash-set! ht (a i) i))
+
+  (define cht (chaperone-hash ht
+                              (lambda (ht k) (values k (lambda (ht k v) v)))
+                              (lambda (ht k v) (values k v))
+                              (lambda (ht k) k)
+                              (lambda (ht k) k)))
+
+  (define done (make-semaphore))
+  
+  (define ths
+    (for/list ([j 4])
+      (thread
+       (lambda ()
+         (for ([i 1000])
+           (define v (random 100000))
+           (define k (a v))
+           (hash-set! cht k v)
+           ;; Make sure the addition didn't get lost, which
+           ;; can happen when a lock is missing:
+           (unless (equal? (hash-ref cht k #f) v)
+             (error "oops")))
+         (semaphore-post done)))))
+
+  (for-each sync ths)
+
+  (test #t
+        'threads-finished
+        (for/and ([t ths])
+          (semaphore-try-wait? done))))
+
 ;; ----------------------------------------
 
 ;; Check broken key impersonator:

racket/src/racket/src/list.c

@@ -3317,17 +3317,28 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
         key_wraps = scheme_make_raw_pair((Scheme_Object *)who, key_wraps);
       if (mode == 0) {
         /* hash-ref */
-        if (SCHEME_HASHTP(o))
+        if (SCHEME_HASHTP(o)) {
-          return scheme_hash_get_w_key_wraps((Scheme_Hash_Table *)o, k, key_wraps);
+          Scheme_Hash_Table *t = (Scheme_Hash_Table *)o;
-        else if (SCHEME_HASHTRP(o))
+          if (t->mutex) scheme_wait_sema(t->mutex, 0);
-          return scheme_hash_tree_get_w_key_wraps((Scheme_Hash_Tree *)o, k, key_wraps);
+          v = scheme_hash_get_w_key_wraps(t, k, key_wraps);
-        else
+          if (t->mutex) scheme_post_sema(t->mutex);
-          return scheme_lookup_in_table_w_key_wraps((Scheme_Bucket_Table *)o, (const char *)k, key_wraps);
+        } else if (SCHEME_HASHTRP(o))
+          v = scheme_hash_tree_get_w_key_wraps((Scheme_Hash_Tree *)o, k, key_wraps);
+        else {
+          Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)o;
+          if (t->mutex) scheme_wait_sema(t->mutex, 0);
+          v = scheme_lookup_in_table_w_key_wraps(t, (const char *)k, key_wraps);
+          if (t->mutex) scheme_post_sema(t->mutex);
+        }
+        return v;
       } else if ((mode == 1) || (mode == 2)) {
         /* hash-set! or hash-remove! */
-        if (SCHEME_HASHTP(o))
+        if (SCHEME_HASHTP(o)) {
-          scheme_hash_set_w_key_wraps((Scheme_Hash_Table *)o, k, v, key_wraps);
+          Scheme_Hash_Table *t = (Scheme_Hash_Table *)o;
-        else if (SCHEME_HASHTRP(o)) {
+          if (t->mutex) scheme_wait_sema(t->mutex, 0);
+          scheme_hash_set_w_key_wraps(t, k, v, key_wraps);
+          if (t->mutex) scheme_post_sema(t->mutex);
+        } else if (SCHEME_HASHTRP(o)) {
           o = (Scheme_Object *)scheme_hash_tree_set_w_key_wraps((Scheme_Hash_Tree *)o, k, v, key_wraps);
           while (wraps) {
             o = transfer_chaperone(SCHEME_CAR(wraps), o);
@@ -3335,14 +3346,21 @@ static Scheme_Object *chaperone_hash_op(const char *who, Scheme_Object *o, Schem
           }
           return o;
         } else if (!v) {
+          Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)o;
           Scheme_Bucket *b;
-          b = scheme_bucket_or_null_from_table_w_key_wraps((Scheme_Bucket_Table *)o, (char *)k, 0, key_wraps);
+          if (t->mutex) scheme_wait_sema(t->mutex, 0);
+          b = scheme_bucket_or_null_from_table_w_key_wraps(t, (char *)k, 0, key_wraps);
+          if (t->mutex) scheme_post_sema(t->mutex);
           if (b) {
             HT_EXTRACT_WEAK(b->key) = NULL;
             b->val = NULL;
           }
-        } else
+        } else {
-          scheme_add_to_table_w_key_wraps((Scheme_Bucket_Table *)o, (const char *)k, v, 0, key_wraps);
+          Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)o;
+          if (t->mutex) scheme_wait_sema(t->mutex, 0);
+          scheme_add_to_table_w_key_wraps(t, (const char *)k, v, 0, key_wraps);
+          if (t->mutex) scheme_post_sema(t->mutex);
+        }
         return scheme_void;
       } else if (mode == 3)
         return k;