mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Fix bug #27450 ("Fat mutexes not GC'd until their owner dies").

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2009-09-15 22:46:55 +02:00
parent aef9e3bd01
commit a0faf7ddf9
2 changed files with 35 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/threads.c
View file

@ -53,6 +53,7 @@
#include "libguile/init.h" #include "libguile/init.h"
#include "libguile/scmsigs.h" #include "libguile/scmsigs.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/weaks.h"
#ifdef __MINGW32__ #ifdef __MINGW32__
#ifndef ETIMEDOUT #ifndef ETIMEDOUT
@ -440,14 +441,18 @@ do_thread_exit (void *v)
while (!scm_is_null (t->mutexes)) while (!scm_is_null (t->mutexes))
{ {
SCM mutex = SCM_CAR (t->mutexes); SCM mutex = SCM_WEAK_PAIR_CAR (t->mutexes);
if (!SCM_UNBNDP (mutex))
{
fat_mutex *m = SCM_MUTEX_DATA (mutex); fat_mutex *m = SCM_MUTEX_DATA (mutex);
scm_i_pthread_mutex_lock (&m->lock); scm_i_pthread_mutex_lock (&m->lock);
unblock_from_queue (m->waiting); unblock_from_queue (m->waiting);
scm_i_pthread_mutex_unlock (&m->lock); scm_i_pthread_mutex_unlock (&m->lock);
t->mutexes = SCM_CDR (t->mutexes); }
t->mutexes = SCM_WEAK_PAIR_CDR (t->mutexes);
} }
scm_i_pthread_mutex_unlock (&t->admin_mutex); 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_thread *t = SCM_I_THREAD_DATA (new_owner);
scm_i_pthread_mutex_lock (&t->admin_mutex); 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); scm_i_pthread_mutex_unlock (&t->admin_mutex);
} }
*ret = 1; *ret = 1;

18
test-suite/tests/threads.test
View file

@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -363,7 +363,21 @@
(pass-if "locking mutex with no owner" (pass-if "locking mutex with no owner"
(let ((m (make-mutex))) (let ((m (make-mutex)))
(lock-mutex m #f #f) (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 ;; mutex lock levels