From 564b828342b894e8d65d15c676a402a8bbc08334 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 11 May 2011 19:42:35 +0000 Subject: [PATCH] 1.0.48.12: fix bugs in deadlock detection and tests * No timeouts on mutexes on lutex builds: so don't mark the wait as having one. * No timeouts on spinlocks, so don't mark the wait as having one even if there is a deadline. * More tests. --- src/code/target-thread.lisp | 13 +++--- tests/threads.pure.lisp | 102 +++++++++++++++++++++++++++++++++++++++++-- version.lisp-expr | 2 +- 3 files changed, 108 insertions(+), 9 deletions(-) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index 4b89ca8..ba189b3 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -299,13 +299,16 @@ created and old ones may exit at any time." ;;;; Spinlocks -(defmacro with-deadlocks ((thread lock timeout) &body forms) +(defmacro with-deadlocks ((thread lock &optional timeout) &body forms) + (declare (ignorable timeout)) (with-unique-names (prev n-thread n-lock n-timeout new) `(let* ((,n-thread ,thread) (,n-lock ,lock) - (,n-timeout (or ,timeout - (when sb!impl::*deadline* - sb!impl::*deadline-seconds*))) + (,n-timeout #!-sb-lutex + ,(when timeout + `(or ,timeout + (when sb!impl::*deadline* + sb!impl::*deadline-seconds*)))) ;; If we get interrupted while waiting for a lock, etc. (,prev (thread-waiting-for ,n-thread)) (,new (if ,n-timeout @@ -331,7 +334,7 @@ created and old ones may exit at any time." (when (eq old new) (error "Recursive lock attempt on ~S." spinlock)) #!+sb-thread - (with-deadlocks (new spinlock nil) + (with-deadlocks (new spinlock) (flet ((cas () (if (sb!ext:compare-and-swap (spinlock-value spinlock) nil new) (thread-yield) diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp index 6fcd67a..aaa32ca 100644 --- a/tests/threads.pure.lisp +++ b/tests/threads.pure.lisp @@ -330,6 +330,7 @@ (assert (or (equal '(:deadlock :ok) res) (equal '(:ok :deadlock) res))))))) +#+sb-thread (with-test (:name deadlock-detection.2) (let* ((m1 (sb-thread:make-mutex :name "M1")) (m2 (sb-thread:make-mutex :name "M2")) @@ -365,6 +366,7 @@ (assert (stringp err))) (assert (eq :ok (sb-thread:join-thread t1))))) +#+sb-thread (with-test (:name deadlock-detection.3) (let* ((m1 (sb-thread:make-mutex :name "M1")) (m2 (sb-thread:make-mutex :name "M2")) @@ -379,8 +381,10 @@ :ok))) :name "T1"))) ;; Currently we don't consider it a deadlock - ;; if there is a timeout in the chain. - (assert (eq :deadline + ;; if there is a timeout in the chain. No + ;; Timeouts on lutex builds, though. + (assert (eq #-sb-lutex :deadline + #+sb-lutex :deadlock (handler-case (sb-thread:with-mutex (m2) (sb-thread:signal-semaphore s2) @@ -390,5 +394,97 @@ (sb-thread:with-mutex (m1) :ok))) (sb-sys:deadline-timeout () - :deadline)))) + :deadline) + (sb-thread:thread-deadlock () + :deadlock)))) + (assert (eq :ok (join-thread t1))))) + +#+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))))))) + +#+sb-thread +(with-test (:name deadlock-detection.5) + (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 + (lambda () + (sb-thread::with-spinlock (m1) + (sb-thread:signal-semaphore s1) + (sb-thread:wait-on-semaphore s2) + (sb-thread::with-spinlock (m2) + :ok))) + :name "T1"))) + (prog (err) + :retry + (handler-bind ((sb-thread:thread-deadlock + (lambda (e) + (unless err + ;; Make sure we can print the condition + ;; while it's active + (let ((*print-circle* nil)) + (setf err (princ-to-string e))) + (go :retry))))) + (when err + (sleep 1)) + (assert (eq :ok (sb-thread::with-spinlock (m2) + (unless err + (sb-thread:signal-semaphore s2) + (sb-thread:wait-on-semaphore s1) + (sleep 1)) + (sb-thread::with-spinlock (m1) + :ok))))) + (assert (stringp err))) + (assert (eq :ok (sb-thread:join-thread t1))))) + +#+sb-thread +(with-test (:name deadlock-detection.7) + (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 + (lambda () + (sb-thread::with-spinlock (m1) + (sb-thread:signal-semaphore s1) + (sb-thread:wait-on-semaphore s2) + (sb-thread::with-spinlock (m2) + :ok))) + :name "T1"))) + (assert (eq :deadlock + (handler-case + (sb-thread::with-spinlock (m2) + (sb-thread:signal-semaphore s2) + (sb-thread:wait-on-semaphore s1) + (sleep 1) + (sb-sys:with-deadline (:seconds 0.1) + (sb-thread::with-spinlock (m1) + :ok))) + (sb-sys:deadline-timeout () + :deadline) + (sb-thread:thread-deadlock () + :deadlock)))) (assert (eq :ok (join-thread t1))))) diff --git a/version.lisp-expr b/version.lisp-expr index 1b6080c..28fc138 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.11" +"1.0.48.12" -- 1.7.10.4