summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-06-16 12:06:43 +0200
committerAndy Wingo <wingo@pobox.com>2011-06-16 12:09:13 +0200
commit636c99d42ddfc44056622253eb66a356a91a3371 (patch)
tree94d6eae849ed05d784b3e39d5217388b5c266272
parent589bc528bd63291d2faa4bbcef9e402e62e1f72d (diff)
downloadguile-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.c53
-rw-r--r--test-suite/tests/weaks.test26
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