X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.pure.lisp;h=00040dd37130908b8c1144397b3f3a186c63af59;hb=df2d632ead05d542d3cdd2d8d162060ee586c151;hp=ea80fa33e06d9b4c2794953c52b2fe9cd98432ff;hpb=3cd0a9aafc20ce12075f38ebaed86676c922fde2;p=sbcl.git

diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index ea80fa3..00040dd 100644
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -594,3 +594,26 @@
                 (thread-error ()
                   :oops)))))
 
+;; SB-THREAD:MAKE-THREAD used to lock SB-THREAD:*MAKE-THREAD-LOCK*
+;; before entering WITHOUT-INTERRUPTS. When a thread which was
+;; executing SB-THREAD:MAKE-THREAD was interrupted with code which
+;; also called SB-THREAD:MAKE-THREAD, it could happen that the first
+;; thread already owned SB-THREAD:*MAKE-THREAD-LOCK* and the
+;; interrupting code thus made a recursive lock attempt.
+;;
+;; See (:TIMER :DISPATCH-THREAD :MAKE-THREAD :BUG-1180102) in
+;; timer.impure.lisp.
+(with-test (:name (make-thread :interrupt-with make-thread :bug-1180102)
+            :skipped-on '(not :sb-thread))
+  (dotimes (i 100)
+    (let ((threads '())
+          (parent *current-thread*))
+      (dotimes (i 100)
+        (push (make-thread
+               (lambda ()
+                 (interrupt-thread
+                  parent
+                  (lambda () (push (make-thread (lambda ())) threads)))))
+              threads)
+        (push (make-thread (lambda ())) threads))
+      (mapc #'join-thread threads))))