X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftimer.impure.lisp;h=734d810829820c85206fa0a62bbad9ebb10bb470;hb=d7875c296a4988e9f27e2776237884deb1984c62;hp=19bc3347b0e4d4a64aae57a966ce7250a9419b5b;hpb=69990bc42314706e9d646ddd8f6b911f46d0052c;p=sbcl.git diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp index 19bc334..734d810 100644 --- a/tests/timer.impure.lisp +++ b/tests/timer.impure.lisp @@ -196,7 +196,8 @@ (defun wait-for-threads (threads) (loop while (some #'sb-thread:thread-alive-p threads) do (sleep 0.01))) -(with-test (:name (:with-timeout :many-at-the-same-time) :skipped-on '(not :sb-thread)) +(with-test (:name (:with-timeout :many-at-the-same-time) + :skipped-on '(not :sb-thread)) (let ((ok t)) (let ((threads (loop repeat 10 collect (sb-thread:make-thread @@ -297,7 +298,11 @@ #-sb-thread (loop repeat 10 do (test)))) -(with-test (:name (:timer :threaded-stress) :skipped-on '(not :sb-thread)) +(with-test (:name (:timer :threaded-stress) + :skipped-on '(not :sb-thread) + :fails-on :win32) + #+win32 + (error "fixme") (let ((barrier (sb-thread:make-semaphore)) (goal 100)) (flet ((wait-for-goal () @@ -321,3 +326,29 @@ (dolist (thread threads) (sched thread))) (mapcar #'sb-thread:join-thread threads))))) + +;; 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. A timer with +;; :THREAD T or :THREAD could +;; also trigger this problem. +;; +;; See (MAKE-THREAD :INTERRUPT-WITH MAKE-THREAD :BUG-1180102) in +;; threads.pure.lisp. +(with-test (:name (:timer :dispatch-thread :make-thread :bug-1180102) + :skipped-on '(not :sb-thread)) + (flet ((test (thread) + (let ((timer (make-timer (lambda ()) :thread thread))) + (schedule-timer timer .01 :repeat-interval 0.1) + (dotimes (i 100) + (let ((threads '())) + (dotimes (i 100) + (push (sb-thread:make-thread (lambda () (sleep .01))) + threads)) + (mapc #'sb-thread:join-thread threads))) + (unschedule-timer timer)))) + (test t) + (test sb-thread:*current-thread*)))