mutex))
(sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
- void)
+ void
+ (where sb-alien:unsigned-long))
(sb-alien:define-alien-routine "check_deferrables_unblocked_or_lose"
- void)
+ void
+ (where sb-alien:unsigned-long))
(with-test (:name (:interrupt-thread :deferrables-blocked))
(sb-thread:interrupt-thread sb-thread:*current-thread*
(lambda ()
- (check-deferrables-blocked-or-lose))))
+ (check-deferrables-blocked-or-lose 0))))
(with-test (:name (:interrupt-thread :deferrables-unblocked))
(sb-thread:interrupt-thread sb-thread:*current-thread*
(lambda ()
(with-interrupts
- (check-deferrables-unblocked-or-lose)))))
+ (check-deferrables-unblocked-or-lose 0)))))
(with-test (:name (:interrupt-thread :nlx))
(catch 'xxx
(sb-thread:interrupt-thread sb-thread:*current-thread*
(lambda ()
- (check-deferrables-blocked-or-lose)
+ (check-deferrables-blocked-or-lose 0)
(throw 'xxx nil))))
- (check-deferrables-unblocked-or-lose))
+ (check-deferrables-unblocked-or-lose 0))
#-sb-thread (sb-ext:quit :unix-status 104)
(sb-thread::get-spinlock spinlock)
(sb-thread:interrupt-thread thread
(lambda ()
- (check-deferrables-blocked-or-lose)
+ (check-deferrables-blocked-or-lose 0)
(sb-thread::get-spinlock spinlock)
- (check-deferrables-unblocked-or-lose)
+ (check-deferrables-unblocked-or-lose 0)
(sb-ext:quit)))
(sleep 1)
(sb-thread::release-spinlock spinlock)))
(format t "~&interrupt test done~%")
-(defparameter *interrupt-count* 0)
+(defstruct counter (n 0 :type sb-vm:word))
+(defvar *interrupt-counter* (make-counter))
(declaim (notinline check-interrupt-count))
(defun check-interrupt-count (i)
(princ cond)
(sb-debug:backtrace
most-positive-fixnum))))
- (loop (check-interrupt-count *interrupt-count*)))))))
+ (loop (check-interrupt-count (counter-n *interrupt-counter*))))))))
(let ((func (lambda ()
(princ ".")
(force-output)
- (sb-impl::atomic-incf/symbol *interrupt-count*))))
- (setq *interrupt-count* 0)
+ (sb-ext:atomic-incf (counter-n *interrupt-counter*)))))
+ (setf (counter-n *interrupt-counter*) 0)
(dotimes (i 100)
(sleep (random 0.1d0))
(interrupt-thread c func))
- (loop until (= *interrupt-count* 100) do (sleep 0.1))
+ (loop until (= (counter-n *interrupt-counter*) 100) do (sleep 0.1))
(terminate-thread c)
(wait-for-threads (list c))))
| (mp:make-process #'roomy)))
|#
+;;; KLUDGE: No deadlines while waiting on lutex-based condition variables. This test
+;;; would just hang.
+#-sb-lutex
+(with-test (:name (:condition-variable :wait-multiple))
+ (loop repeat 40 do
+ (let ((waitqueue (sb-thread:make-waitqueue :name "Q"))
+ (mutex (sb-thread:make-mutex :name "M"))
+ (failedp nil))
+ (format t ".")
+ (finish-output t)
+ (let ((threads (loop repeat 200
+ collect
+ (sb-thread:make-thread
+ (lambda ()
+ (handler-case
+ (sb-sys:with-deadline (:seconds 0.01)
+ (sb-thread:with-mutex (mutex)
+ (sb-thread:condition-wait waitqueue
+ mutex)
+ (setq failedp t)))
+ (sb-sys:deadline-timeout (c)
+ (declare (ignore c)))))))))
+ (mapc #'sb-thread:join-thread threads)
+ (assert (not failedp))))))
+
(with-test (:name (:condition-variable :notify-multiple))
(flet ((tester (notify-fun)
(let ((queue (make-waitqueue :name "queue"))