From a0faf7ddf9e260916aa1e64cc2ec48ac6925b2d6 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 15 Sep 2009 22:46:55 +0200 Subject: [PATCH] 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. --- libguile/threads.c | 26 +++++++++++++++++++------- test-suite/tests/threads.test | 18 ++++++++++++++++-- 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 -- 2.20.1