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.
This commit is contained in:
Matthew Flatt 2017-07-24 19:23:29 -06:00
parent 1f6b31aa3e
commit 9c48ee003a
2 changed files with 83 additions and 15 deletions

View File

@ -2214,10 +2214,60 @@
(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))))
;; ----------------------------------------

View File

@ -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))
return scheme_hash_get_w_key_wraps((Scheme_Hash_Table *)o, k, key_wraps);
else if (SCHEME_HASHTRP(o))
return scheme_hash_tree_get_w_key_wraps((Scheme_Hash_Tree *)o, k, key_wraps);
else
return scheme_lookup_in_table_w_key_wraps((Scheme_Bucket_Table *)o, (const char *)k, key_wraps);
if (SCHEME_HASHTP(o)) {
Scheme_Hash_Table *t = (Scheme_Hash_Table *)o;
if (t->mutex) scheme_wait_sema(t->mutex, 0);
v = scheme_hash_get_w_key_wraps(t, k, key_wraps);
if (t->mutex) scheme_post_sema(t->mutex);
} 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))
scheme_hash_set_w_key_wraps((Scheme_Hash_Table *)o, k, v, key_wraps);
else if (SCHEME_HASHTRP(o)) {
if (SCHEME_HASHTP(o)) {
Scheme_Hash_Table *t = (Scheme_Hash_Table *)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
scheme_add_to_table_w_key_wraps((Scheme_Bucket_Table *)o, (const char *)k, v, 0, key_wraps);
} else {
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;