(use-package :test-util)
+(with-test (:name :heap)
+ (let* ((size 1000)
+ (heap (make-array size :adjustable t :fill-pointer 0))
+ (unsorted (loop for i below size collect (random size)))
+ (sorted (sort (copy-list unsorted) #'>=))
+ heap-sorted)
+ (map nil #'(lambda (val) (sb-impl::heap-insert heap val)) unsorted)
+ (setf heap-sorted (loop for i below size
+ collect (sb-impl::heap-extract-maximum heap)))
+ (unless (equal sorted heap-sorted)
+ (error "Heap sort failure ~S" heap-sorted))))
+
(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))
(defun make-limited-timer (fn n &rest args)
(let (timer)
(with-test (:name (:timer :deferrables-blocked))
(make-and-schedule-and-wait (lambda ()
- (check-deferrables-blocked-or-lose))
+ (check-deferrables-blocked-or-lose 0))
(random 0.1))
- (check-deferrables-unblocked-or-lose))
+ (check-deferrables-unblocked-or-lose 0))
(with-test (:name (:timer :deferrables-unblocked))
(make-and-schedule-and-wait (lambda ()
(sb-sys:with-interrupts
- (check-deferrables-unblocked-or-lose)))
+ (check-deferrables-unblocked-or-lose 0)))
(random 0.1))
- (check-deferrables-unblocked-or-lose))
+ (check-deferrables-unblocked-or-lose 0))
+#-win32
(with-test (:name (:timer :deferrables-unblocked :unwind))
(catch 'xxx
(make-and-schedule-and-wait (lambda ()
- (check-deferrables-blocked-or-lose)
+ (check-deferrables-blocked-or-lose 0)
(throw 'xxx nil))
(random 0.1))
(sleep 1))
- (check-deferrables-unblocked-or-lose))
+ (check-deferrables-unblocked-or-lose 0))
(defmacro raises-timeout-p (&body body)
`(handler-case (progn (progn ,@body) nil)
(with-test (:name (:timer :stress))
(let ((time (1+ (get-universal-time))))
(loop repeat 200 do
- (schedule-timer (make-timer (lambda ())) time :absolute-p t))
+ (schedule-timer (make-timer (lambda ())) time :absolute-p t))
+ (sleep 2)
+ (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
+
+(with-test (:name (:timer :stress2))
+ (let ((time (1+ (get-universal-time)))
+ (n 0))
+ (loop for time-n from time upto (+ 1/10 time) by (/ 1/10 200)
+ do (schedule-timer (make-timer (lambda ())) time-n :absolute-p t)
+ (incf n))
(sleep 2)
(assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
;;; running out of stack (due to repeating timers being rescheduled
;;; before they ran) and dying threads were open interrupts.
#+sb-thread
-(with-test (:name (:timer :parallel-unschedule))
+(with-test (:name (:timer :parallel-unschedule) :fails-on :ppc)
+ #+darwin
+ (error "Prone to hang on Darwin due to interrupt issues.")
+ #+ppc
+ (error "Prone to hang the host on linux/ppc for unknown reasons.")
(let ((timer (sb-ext:make-timer (lambda () 42) :name "parallel schedulers"))
(other nil))
(flet ((flop ()