(assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
(with-test (:name (:timer :other-thread) :skipped-on '(not :sb-thread))
- (let* ((thread (sb-thread:make-thread (lambda () (sleep 2))))
+ (let* ((thread (make-kill-thread (lambda () (sleep 2))))
(timer (make-timer (lambda ()
(assert (eq thread sb-thread:*current-thread*)))
:thread thread)))
(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
(assert ok))))
(with-test (:name (:with-timeout :dead-thread) :skipped-on '(not :sb-thread))
- (sb-thread:make-thread
+ (make-join-thread
(lambda ()
(let ((timer (make-timer (lambda ()))))
(schedule-timer timer 3)
;;; Used to hang occasionally at least on x86. Two bugs caused it:
;;; running out of stack (due to repeating timers being rescheduled
;;; before they ran) and dying threads were open interrupts.
-(with-test (:name (:timer :parallel-unschedule) :fails-on :ppc :skipped-on '(not :sb-thread) :broken-on '(or :darwin :ppc))
+(with-test (:name (:timer :parallel-unschedule)
+ :skipped-on '(not :sb-thread)
+ :broken-on ':ppc)
(let ((timer (sb-ext:make-timer (lambda () 42) :name "parallel schedulers"))
(other nil))
(flet ((flop ()
#-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 ()
(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 <some thread spawning child threads> 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*)))