summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2009-09-15 22:46:55 +0200
committerLudovic Courtès <ludo@gnu.org>2009-09-15 23:05:24 +0200
commita0faf7ddf9e260916aa1e64cc2ec48ac6925b2d6 (patch)
tree76f8f2a81384d67eecc5de933d6b65778c3e24db
parentaef9e3bd012fdf7b8fe126d89c48eb22019f0ec8 (diff)
downloadguile-a0faf7ddf9e260916aa1e64cc2ec48ac6925b2d6.tar.gz
Fix bug #27450 ("Fat mutexes not GC'd until their owner dies").
* libguile/threads.c (do_thread_exit): Deal with `t->mutexes' being a weak list. (fat_mutex_lock): Use weak-car pairs when building up `t->mutexes'. * test-suite/tests/threads.test ("mutex-ownership")["mutex with owner not retained (bug #27450)"]: New test.
-rw-r--r--libguile/threads.c26
-rw-r--r--test-suite/tests/threads.test18
2 files changed, 35 insertions, 9 deletions
diff --git a/libguile/threads.c b/libguile/threads.c
index 174562f92..8dce6043c 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -53,6 +53,7 @@
#include "libguile/init.h"
#include "libguile/scmsigs.h"
#include "libguile/strings.h"
+#include "libguile/weaks.h"
#ifdef __MINGW32__
#ifndef ETIMEDOUT
@@ -440,14 +441,18 @@ do_thread_exit (void *v)
while (!scm_is_null (t->mutexes))
{
- SCM mutex = SCM_CAR (t->mutexes);
- fat_mutex *m = SCM_MUTEX_DATA (mutex);
- scm_i_pthread_mutex_lock (&m->lock);
+ SCM mutex = SCM_WEAK_PAIR_CAR (t->mutexes);
- unblock_from_queue (m->waiting);
+ if (!SCM_UNBNDP (mutex))
+ {
+ fat_mutex *m = SCM_MUTEX_DATA (mutex);
- scm_i_pthread_mutex_unlock (&m->lock);
- t->mutexes = SCM_CDR (t->mutexes);
+ scm_i_pthread_mutex_lock (&m->lock);
+ unblock_from_queue (m->waiting);
+ scm_i_pthread_mutex_unlock (&m->lock);
+ }
+
+ t->mutexes = SCM_WEAK_PAIR_CDR (t->mutexes);
}
scm_i_pthread_mutex_unlock (&t->admin_mutex);
@@ -1196,7 +1201,14 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret)
{
scm_i_thread *t = SCM_I_THREAD_DATA (new_owner);
scm_i_pthread_mutex_lock (&t->admin_mutex);
- t->mutexes = scm_cons (mutex, t->mutexes);
+
+ /* Only keep a weak reference to MUTEX so that it's not
+ retained when not referenced elsewhere (bug #27450). Note
+ that the weak pair itself it still retained, but it's better
+ than retaining MUTEX and the threads referred to by its
+ associated queue. */
+ t->mutexes = scm_weak_car_pair (mutex, t->mutexes);
+
scm_i_pthread_mutex_unlock (&t->admin_mutex);
}
*ret = 1;
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index 26efe8580..58a2ebafa 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009 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
@@ -363,7 +363,21 @@
(pass-if "locking mutex with no owner"
(let ((m (make-mutex)))
(lock-mutex m #f #f)
- (not (mutex-owner m)))))
+ (not (mutex-owner m))))
+
+ (pass-if "mutex with owner not retained (bug #27450)"
+ (let ((g (make-guardian)))
+ (g (let ((m (make-mutex))) (lock-mutex m) m))
+
+ ;; Avoid false references to M on the stack.
+ (let cleanup ((i 20))
+ (and (> i 0)
+ (begin (cleanup (1- i)) i)))
+
+ (gc) (gc)
+ (let ((m (g)))
+ (and (mutex? m)
+ (eq? (mutex-owner m) (current-thread)))))))
;;
;; mutex lock levels