From 94b4d570ffa374e2adf2e27340472c13a487d1f5 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 14 May 2011 09:14:54 +0000 Subject: [PATCH] 1.0.48.16: deadlock detection fixes * The same deadlock may be reported in multiple threads: adjust tests to account for that. * CHECK-DEADLOCK/DEADLOCK-CHAIN could signal an error if the deadlock had disappeared between its detection and building up the chain due to one of the involved threads unwinding. To flush out issues like this a bit better, added looping to some of the deadlock tests. --- src/code/target-thread.lisp | 6 ++- tests/threads.pure.lisp | 98 ++++++++++++++++++++++++------------------- version.lisp-expr | 2 +- 3 files changed, 59 insertions(+), 47 deletions(-) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index ba189b3..89c5111 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -443,9 +443,11 @@ HOLDING-MUTEX-P." (detect-deadlock other-lock))))))) (deadlock-chain (thread lock) (let* ((other-thread (lock-owner lock)) - (other-lock (thread-waiting-for other-thread))) + (other-lock (when other-thread + (thread-waiting-for other-thread)))) (cond ((not other-thread) - ;; The deadlock is gone -- maybe someone timed out? + ;; The deadlock is gone -- maybe someone unwound + ;; from the same deadlock already? (return-from check-deadlock nil)) ((consp other-lock) ;; There's a timeout -- no deadlock. diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp index aaa32ca..9b6e91e 100644 --- a/tests/threads.pure.lisp +++ b/tests/threads.pure.lisp @@ -307,28 +307,33 @@ #+sb-thread (with-test (:name deadlock-detection.1) - (flet ((test (ma mb sa sb) - (lambda () - (handler-case - (sb-thread:with-mutex (ma) - (sb-thread:signal-semaphore sa) - (sb-thread:wait-on-semaphore sb) - (sb-thread:with-mutex (mb) - :ok)) - (sb-thread:thread-deadlock (e) - (princ e) - :deadlock))))) - (let* ((m1 (sb-thread:make-mutex :name "M1")) - (m2 (sb-thread:make-mutex :name "M2")) - (s1 (sb-thread:make-semaphore :name "S1")) - (s2 (sb-thread:make-semaphore :name "S2")) - (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1")) - (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2"))) - ;; One will deadlock, and the other will then complete normally - (let ((res (list (sb-thread:join-thread t1) - (sb-thread:join-thread t2)))) - (assert (or (equal '(:deadlock :ok) res) - (equal '(:ok :deadlock) res))))))) + (loop + repeat 1000 + do (flet ((test (ma mb sa sb) + (lambda () + (handler-case + (sb-thread:with-mutex (ma) + (sb-thread:signal-semaphore sa) + (sb-thread:wait-on-semaphore sb) + (sb-thread:with-mutex (mb) + :ok)) + (sb-thread:thread-deadlock (e) + (princ e) + :deadlock))))) + (let* ((m1 (sb-thread:make-mutex :name "M1")) + (m2 (sb-thread:make-mutex :name "M2")) + (s1 (sb-thread:make-semaphore :name "S1")) + (s2 (sb-thread:make-semaphore :name "S2")) + (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1")) + (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2"))) + ;; One will deadlock, and the other will then complete normally. + ;; ...except sometimes, when we get unlucky, and both will do + ;; the deadlock detection in parallel and both signal. + (let ((res (list (sb-thread:join-thread t1) + (sb-thread:join-thread t2)))) + (assert (or (equal '(:deadlock :ok) res) + (equal '(:ok :deadlock) res) + (equal '(:deadlock :deadlock) res)))))))) #+sb-thread (with-test (:name deadlock-detection.2) @@ -401,28 +406,33 @@ #+sb-thread (with-test (:name deadlock-detection.4) - (flet ((test (ma mb sa sb) - (lambda () - (handler-case - (sb-thread::with-spinlock (ma) - (sb-thread:signal-semaphore sa) - (sb-thread:wait-on-semaphore sb) - (sb-thread::with-spinlock (mb) - :ok)) - (sb-thread:thread-deadlock (e) - (princ e) - :deadlock))))) - (let* ((m1 (sb-thread::make-spinlock :name "M1")) - (m2 (sb-thread::make-spinlock :name "M2")) - (s1 (sb-thread:make-semaphore :name "S1")) - (s2 (sb-thread:make-semaphore :name "S2")) - (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1")) - (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2"))) - ;; One will deadlock, and the other will then complete normally - (let ((res (list (sb-thread:join-thread t1) - (sb-thread:join-thread t2)))) - (assert (or (equal '(:deadlock :ok) res) - (equal '(:ok :deadlock) res))))))) + (loop + repeat 1000 + do (flet ((test (ma mb sa sb) + (lambda () + (handler-case + (sb-thread::with-spinlock (ma) + (sb-thread:signal-semaphore sa) + (sb-thread:wait-on-semaphore sb) + (sb-thread::with-spinlock (mb) + :ok)) + (sb-thread:thread-deadlock (e) + (princ e) + :deadlock))))) + (let* ((m1 (sb-thread::make-spinlock :name "M1")) + (m2 (sb-thread::make-spinlock :name "M2")) + (s1 (sb-thread:make-semaphore :name "S1")) + (s2 (sb-thread:make-semaphore :name "S2")) + (t1 (sb-thread:make-thread (test m1 m2 s1 s2) :name "T1")) + (t2 (sb-thread:make-thread (test m2 m1 s2 s1) :name "T2"))) + ;; One will deadlock, and the other will then complete normally + ;; ...except sometimes, when we get unlucky, and both will do + ;; the deadlock detection in parallel and both signal. + (let ((res (list (sb-thread:join-thread t1) + (sb-thread:join-thread t2)))) + (assert (or (equal '(:deadlock :ok) res) + (equal '(:ok :deadlock) res) + (equal '(:deadlock :deadlock) res)))))))) #+sb-thread (with-test (:name deadlock-detection.5) diff --git a/version.lisp-expr b/version.lisp-expr index 78f6210..ff8ac68 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.48.15" +"1.0.48.16" -- 1.7.10.4