X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.pure.lisp;h=3d7d5242aebea4408be4605ea059c8a1053d60bf;hb=c1aa8b6b5b870f21bc8c81da85708e9d71d4eb93;hp=f078b5b6dd8e9671945b7ca30d3dd3af0a8ed181;hpb=f2847d6ed16e60390d000410d36ec7fb2570cdaf;p=sbcl.git

diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index f078b5b..3d7d524 100644
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -50,3 +50,26 @@
     (condition-notify queue)
     (sleep 1)
     (assert (not (thread-alive-p thread)))))
+
+;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
+
+#+sb-thread
+(with-test (:name without-interrupts+get-mutex
+            :fails-on :sb-lutex)
+  (let* ((lock (make-mutex))
+         (foo (get-mutex lock))
+         (bar nil)
+         (thread (make-thread (lambda ()
+                                (sb-sys:without-interrupts
+                                    (with-mutex (lock)
+                                      (setf bar t)))))))
+    (sleep 1)
+    (assert (thread-alive-p thread))
+    (terminate-thread thread)
+    (sleep 1)
+    (assert (thread-alive-p thread))
+    (release-mutex lock)
+    (sleep 1)
+    (assert (not (thread-alive-p thread)))
+    (assert (eq :aborted (join-thread thread :default :aborted)))
+    (assert bar)))