+(sb-alien:define-alien-routine "check_deferrables_blocked_or_lose"
+ void)
+(sb-alien:define-alien-routine "check_deferrables_unblocked_or_lose"
+ void)
+
+(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))
+ (make-and-schedule-and-wait (lambda ()
+ (check-deferrables-blocked-or-lose))
+ (random 0.1))
+ (check-deferrables-unblocked-or-lose))
+
+(with-test (:name (:timer :deferrables-unblocked))
+ (make-and-schedule-and-wait (lambda ()
+ (sb-sys:with-interrupts
+ (check-deferrables-unblocked-or-lose)))
+ (random 0.1))
+ (check-deferrables-unblocked-or-lose))
+
+(with-test (:name (:timer :deferrables-unblocked :unwind))
+ (catch 'xxx
+ (make-and-schedule-and-wait (lambda ()
+ (check-deferrables-blocked-or-lose)
+ (throw 'xxx nil))
+ (random 0.1))
+ (sleep 1))
+ (check-deferrables-unblocked-or-lose))
+