diff options
author | Andy Wingo <wingo@pobox.com> | 2011-06-16 12:06:43 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-06-16 12:09:13 +0200 |
commit | 636c99d42ddfc44056622253eb66a356a91a3371 (patch) | |
tree | 94d6eae849ed05d784b3e39d5217388b5c266272 | |
parent | 589bc528bd63291d2faa4bbcef9e402e62e1f72d (diff) | |
download | guile-636c99d42ddfc44056622253eb66a356a91a3371.tar.gz |
fix hash-set! on weak tables
* test-suite/tests/weaks.test: Add tests.
* libguile/hashtab.c (scm_hash_fn_set_x): Fix updates to weak-value hash
tables to not deadlock inside the alloc lock.
-rw-r--r-- | libguile/hashtab.c | 53 | ||||
-rw-r--r-- | test-suite/tests/weaks.test | 26 |
2 files changed, 55 insertions, 24 deletions
diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 440738c11..6141e4fd2 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -760,34 +760,36 @@ scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, return dflt; } - - - -struct set_weak_cdr_data +struct weak_cdr_data { SCM pair; - SCM new_val; + SCM cdr; }; static void* -set_weak_cdr (void *data) +get_weak_cdr (void *data) { - struct set_weak_cdr_data *d = data; + struct weak_cdr_data *d = data; - if (SCM_NIMP (SCM_WEAK_PAIR_CDR (d->pair)) && !SCM_NIMP (d->new_val)) - { - GC_unregister_disappearing_link ((GC_PTR) SCM_CDRLOC (d->pair)); - SCM_SETCDR (d->pair, d->new_val); - } + if (SCM_WEAK_PAIR_CDR_DELETED_P (d->pair)) + d->cdr = SCM_BOOL_F; else - { - SCM_SETCDR (d->pair, d->new_val); - SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) SCM_CDRLOC (d->pair), - (GC_PTR) SCM2PTR (d->new_val)); - } + d->cdr = SCM_CDR (d->pair); + return NULL; } +static SCM +weak_pair_cdr (SCM x) +{ + struct weak_cdr_data data; + + data.pair = x; + GC_call_with_alloc_lock (get_weak_cdr, &data); + + return data.cdr; +} + SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, @@ -798,16 +800,21 @@ scm_hash_fn_set_x (SCM table, SCM obj, SCM val, pair = scm_hash_fn_create_handle_x (table, obj, val, hash_fn, assoc_fn, closure); - if (SCM_UNLIKELY (!scm_is_eq (SCM_CDR (pair), val))) + if (!scm_is_eq (SCM_CDR (pair), val)) { if (SCM_UNLIKELY (SCM_HASHTABLE_WEAK_VALUE_P (table))) { - struct set_weak_cdr_data data; - - data.pair = pair; - data.new_val = val; + /* If the former value was on the heap, we need to unregister + the weak link. */ + SCM prev = weak_pair_cdr (pair); - GC_call_with_alloc_lock (set_weak_cdr, &data); + SCM_SETCDR (pair, val); + + if (SCM_NIMP (prev) && !SCM_NIMP (val)) + GC_unregister_disappearing_link ((GC_PTR) SCM_CDRLOC (pair)); + else + SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) SCM_CDRLOC (pair), + (GC_PTR) SCM2PTR (val)); } else SCM_SETCDR (pair, val); diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test index 3c9a29018..d0f6c5ef5 100644 --- a/test-suite/tests/weaks.test +++ b/test-suite/tests/weaks.test @@ -1,5 +1,5 @@ ;;;; weaks.test --- tests guile's weaks -*- scheme -*- -;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -208,6 +208,30 @@ (hash-ref z test-key) #t)))) + (pass-if "hash-set!, weak val, im -> im" + (let ((t (make-weak-value-hash-table))) + (hash-set! t "foo" 1) + (hash-set! t "foo" 2) + (equal? (hash-ref t "foo") 2))) + + (pass-if "hash-set!, weak val, im -> nim" + (let ((t (make-weak-value-hash-table))) + (hash-set! t "foo" 1) + (hash-set! t "foo" "baz") + (equal? (hash-ref t "foo") "baz"))) + + (pass-if "hash-set!, weak val, nim -> nim" + (let ((t (make-weak-value-hash-table))) + (hash-set! t "foo" "bar") + (hash-set! t "foo" "baz") + (equal? (hash-ref t "foo") "baz"))) + + (pass-if "hash-set!, weak val, nim -> im" + (let ((t (make-weak-value-hash-table))) + (hash-set! t "foo" "bar") + (hash-set! t "foo" 1) + (equal? (hash-ref t "foo") 1))) + (pass-if "assoc can do anything" ;; Until 1.9.12, as hash table's custom ASSOC procedure was ;; called with the GC lock alloc held, which imposed severe |