X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftimer.impure.lisp;h=c478eb336a7b6c73a28cc12677dec90e2a98bfbe;hb=3fa2feb10ab827fc6cc2a85287e78b6e66b7bf4d;hp=3cea11c68394159106a317a5c96dd1414cdd6677;hpb=7b2aeb8180bfe97fa0becc98297177e875e09551;p=sbcl.git diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp index 3cea11c..c478eb3 100644 --- a/tests/timer.impure.lisp +++ b/tests/timer.impure.lisp @@ -13,6 +13,77 @@ (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 + (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)) + (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)) + (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)) + +#-win32 +(with-test (:name (:timer :deferrables-unblocked :unwind)) + (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)) + (defmacro raises-timeout-p (&body body) `(handler-case (progn (progn ,@body) nil) (sb-ext:timeout () t))) @@ -165,9 +236,10 @@ (loop (assert (eq wanted (subtypep type1 type2)))))))) -;;; Disabled. Hangs occasionally at least on x86. See comment before -;;; the next test case. -#+(and nil sb-thread) +;;; Used to hang occasionally at least on x86. Two bugs caused it: +;;; 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)) (let ((timer (sb-ext:make-timer (lambda () 42) :name "parallel schedulers")) (other nil)) @@ -180,42 +252,42 @@ (loop for i from 1 upto 10 collect (let* ((thread (sb-thread:make-thread #'flop :name (format nil "scheduler ~A" i))) - (ticker (sb-ext:make-timer (lambda () 13) :thread (or other thread) - :name (format nil "ticker ~A" i)))) + (ticker (make-limited-timer (lambda () 13) + 1000 + :thread (or other thread) + :name (format nil "ticker ~A" i)))) (setf other thread) (sb-ext:schedule-timer ticker 0 :repeat-interval 0.00001) thread))))))) ;;;; FIXME: OS X 10.4 doesn't like these being at all, and gives us a SIGSEGV ;;;; instead of using the Mach expection system! 10.5 on the other tends to -;;;; lose() where with interrupt already pending. :/ -;;;; -;;;; FIXME: This test also occasionally hangs on Linux/x86-64 at least. The -;;;; common feature is one thread in gc_stop_the_world, and another trying to -;;;; signal_interrupt_thread, but both (apparently) getting EAGAIN repeatedly. -;;;; Exactly how or why this is happening remains under investigation -- but -;;;; it seems plausible that the fast timers simply fill up the interrupt -;;;; queue completely. (On some occasions the process unwedges itself after -;;;; a few minutes, but not always.) +;;;; lose() here with interrupt already pending. :/ ;;;; -;;;; FIXME: Another failure mode on Linux: recursive entries to -;;;; RUN-EXPIRED-TIMERS blowing the stack. -#+nil +;;;; Used to have problems in genereal, see comment on (:TIMER +;;;; :PARALLEL-UNSCHEDULE). (with-test (:name (:timer :schedule-stress)) (flet ((test () - (let* ((slow-timers (loop for i from 1 upto 100 - collect (sb-ext:make-timer (lambda () 13) :name (format nil "slow ~A" i)))) - (fast-timer (sb-ext:make-timer (lambda () 42) :name "fast"))) - (sb-ext:schedule-timer fast-timer 0.0001 :repeat-interval 0.0001) - (dolist (timer slow-timers) - (sb-ext:schedule-timer timer (random 0.1) :repeat-interval (random 0.1))) - (dolist (timer slow-timers) - (sb-ext:unschedule-timer timer)) - (sb-ext:unschedule-timer fast-timer)))) - #+sb-thread - (mapcar #'sb-thread:join-thread (loop repeat 10 collect (sb-thread:make-thread #'test))) - #-sb-thread - (loop repeat 10 do (test)))) + (let* ((slow-timers + (loop for i from 1 upto 1 + collect (make-limited-timer + (lambda () 13) + 1000 + :name (format nil "slow ~A" i)))) + (fast-timer (make-limited-timer (lambda () 42) 1000 + :name "fast"))) + (sb-ext:schedule-timer fast-timer 0.0001 :repeat-interval 0.0001) + (dolist (timer slow-timers) + (sb-ext:schedule-timer timer (random 0.1) + :repeat-interval (random 0.1))) + (dolist (timer slow-timers) + (sb-ext:unschedule-timer timer)) + (sb-ext:unschedule-timer fast-timer)))) + #+sb-thread + (mapcar #'sb-thread:join-thread + (loop repeat 10 collect (sb-thread:make-thread #'test))) + #-sb-thread + (loop repeat 10 do (test)))) #+sb-thread (with-test (:name (:timer :threaded-stress))