1.0.23.15: GET-MUTEX to set new mutex owner unithreaded platforms

 * Can't believe no-one has complained about this...

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index c534ca0..3493cfc 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"