From 695734b2aff0e6b7ee7ea6f0424d3c0b46d088ca Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 3 Dec 2008 13:13:07 +0000 Subject: [PATCH] 1.0.23.15: GET-MUTEX to set new mutex owner unithreaded platforms * Can't believe no-one has complained about this... --- src/code/target-thread.lisp | 9 +++++++-- tests/threads.pure.lisp | 18 ++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 26 insertions(+), 3 deletions(-) diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index c534ca0..3493cfc 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -266,8 +266,13 @@ directly." #!-sb-thread (ignore waitp)) (unless new-owner (setq new-owner *current-thread*)) - (when (eql new-owner (mutex-%owner mutex)) - (error "Recursive lock attempt ~S." mutex)) + (let ((old (mutex-%owner mutex))) + (when (eq new-owner old) + (error "Recursive lock attempt ~S." mutex)) + #!-sb-thread + (if old + (error "Strange deadlock on ~S in an unithreaded build?" mutex) + (setf (mutex-%owner mutex) new-owner))) #!+sb-thread (progn ;; FIXME: Lutexes do not currently support deadlines, as at least diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp index 8187b51..fbffaaa 100644 --- a/tests/threads.pure.lisp +++ b/tests/threads.pure.lisp @@ -20,6 +20,24 @@ (use-package :test-util) +(with-test (:name mutex-owner) + ;; Make sure basics are sane on unithreaded ports as well + (let ((mutex (make-mutex))) + (get-mutex mutex) + (assert (eq *current-thread* (mutex-value mutex))) + (handler-bind ((warning #'error)) + (release-mutex mutex)) + (assert (not (mutex-value mutex))))) + +(with-test (:name spinlock-owner) + ;; Make sure basics are sane on unithreaded ports as well + (let ((spinlock (sb-thread::make-spinlock))) + (sb-thread::get-spinlock spinlock) + (assert (eq *current-thread* (sb-thread::spinlock-value spinlock))) + (handler-bind ((warning #'error)) + (sb-thread::release-spinlock spinlock)) + (assert (not (sb-thread::spinlock-value spinlock))))) + ;;; Terminating a thread that's waiting for the terminal. #+sb-thread diff --git a/version.lisp-expr b/version.lisp-expr index 14c8164..a87978a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,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.23.14" +"1.0.23.15" -- 1.7.10.4