+(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
+ (where sb-alien:unsigned-long))
+(sb-alien:define-alien-routine "check_deferrables_unblocked_or_lose"
+ void
+ (where sb-alien:unsigned-long))
+
+(defun make-limited-timer (fn n &rest args)
+ (let (timer)
+ (setq timer
+ (apply #'sb-ext:make-timer
+ (lambda ()
+ (sb-sys:without-interrupts
+ (decf n)
+ (cond ((minusp n)
+ (warn "Unscheduling timer ~A ~
+ upon reaching run limit. System too slow?"
+ timer)
+ (sb-ext:unschedule-timer timer))
+ (t
+ (sb-sys:allow-with-interrupts
+ (funcall fn))))))
+ args))))
+
+(defun make-and-schedule-and-wait (fn time)
+ (let ((finishedp nil))
+ (sb-ext:schedule-timer (sb-ext:make-timer
+ (lambda ()
+ (sb-sys:without-interrupts
+ (unwind-protect
+ (sb-sys:allow-with-interrupts
+ (funcall fn))
+ (setq finishedp t)))))
+ time)
+ (loop until finishedp)))
+
+(with-test (:name (:timer :deferrables-blocked) :skipped-on :win32)
+ (make-and-schedule-and-wait (lambda ()
+ (check-deferrables-blocked-or-lose 0))
+ (random 0.1))
+ (check-deferrables-unblocked-or-lose 0))
+
+(with-test (:name (:timer :deferrables-unblocked) :skipped-on :win32)
+ (make-and-schedule-and-wait (lambda ()
+ (sb-sys:with-interrupts
+ (check-deferrables-unblocked-or-lose 0)))
+ (random 0.1))
+ (check-deferrables-unblocked-or-lose 0))
+
+(with-test (:name (:timer :deferrables-unblocked :unwind) :skipped-on :win32)
+ (catch 'xxx
+ (make-and-schedule-and-wait (lambda ()
+ (check-deferrables-blocked-or-lose 0)
+ (throw 'xxx nil))
+ (random 0.1))
+ (sleep 1))
+ (check-deferrables-unblocked-or-lose 0))
+