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:
parent
1f6b31aa3e
commit
9c48ee003a
|
@ -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))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue
Block a user