X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftimer.impure.lisp;h=c478eb336a7b6c73a28cc12677dec90e2a98bfbe;hb=2b0851c405b494143009f68e2bc7e91017a809d4;hp=23029cba0ec9bdf244b7b1ef645d845df60a2de3;hpb=ae09f8fd7765f6cab6ad317a13e27ff22ab0c11e;p=sbcl.git diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp index 23029cb..c478eb3 100644 --- a/tests/timer.impure.lisp +++ b/tests/timer.impure.lisp @@ -13,10 +13,24 @@ (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) @@ -49,25 +63,26 @@ (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)