1.0.48.10: add deadlock detection to spinlocks and mutexes

[sbcl.git] / tests / timer.impure.lisp

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index c478eb3..457bfd2 100644 (file)
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -61,12 +61,14 @@
                            time)
     (loop until finishedp)))
 
+#-win32
 (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))
 
+#-win32
 (with-test (:name (:timer :deferrables-unblocked))
   (make-and-schedule-and-wait (lambda ()
                                 (sb-sys:with-interrupts
@@ -88,6 +90,7 @@
   `(handler-case (progn (progn ,@body) nil)
     (sb-ext:timeout () t)))
 
+#-win32
 (with-test (:name (:timer :relative)
             :fails-on '(and :sparc :linux))
   (let* ((has-run-p nil)
@@ -100,6 +103,7 @@
     (assert has-run-p)
     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
 
+#-win32
 (with-test (:name (:timer :absolute)
             :fails-on '(and :sparc :linux))
   (let* ((has-run-p nil)
@@ -130,6 +134,7 @@
                  :thread t)))
     (schedule-timer timer 0.1)))
 
+#-win32
 (with-test (:name (:timer :repeat-and-unschedule)
             :fails-on '(and :sparc :linux))
   (let* ((run-count 0)
@@ -145,6 +150,7 @@
     (assert (not (timer-scheduled-p timer)))
     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
 
+#-win32
 (with-test (:name (:timer :reschedule))
   (let* ((has-run-p nil)
          (timer (make-timer (lambda ()
@@ -155,29 +161,44 @@
     (assert has-run-p)
     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
 
+#-win32
 (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*))))))
+
+#-win32
+(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*))))))
 
+#-win32
 (with-test (:name (:with-timeout :timeout))
   (assert (raises-timeout-p
            (sb-ext:with-timeout 0.2
              (sleep 1)))))
 
+#-win32
 (with-test (:name (:with-timeout :fall-through))
   (assert (not (raises-timeout-p
                 (sb-ext:with-timeout 0.3
                   (sleep 0.1))))))
 
+#-win32
 (with-test (:name (:with-timeout :nested-timeout-smaller))
   (assert(raises-timeout-p
           (sb-ext:with-timeout 10
             (sb-ext:with-timeout 0.5
               (sleep 2))))))
 
+#-win32
 (with-test (:name (:with-timeout :nested-timeout-bigger))
   (assert(raises-timeout-p
           (sb-ext:with-timeout 0.5
@@ -240,25 +261,30 @@
 ;;; 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 ()
              (sleep (random 0.01))
              (loop repeat 10000
                    do (sb-ext:unschedule-timer timer))))
-      (loop repeat 5
-            do (mapcar #'sb-thread:join-thread
-                       (loop for i from 1 upto 10
-                             collect (let* ((thread (sb-thread:make-thread #'flop
-                                                                           :name (format nil "scheduler ~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)))))))
+      (sb-sys:with-deadline (:seconds 30)
+        (loop repeat 5
+              do (mapcar #'sb-thread:join-thread
+                           (loop for i from 1 upto 10
+                                 collect (let* ((thread (sb-thread:make-thread #'flop
+                                                                               :name (format nil "scheduler ~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
@@ -266,6 +292,7 @@
 ;;;;
 ;;;; Used to have problems in genereal, see comment on (:TIMER
 ;;;; :PARALLEL-UNSCHEDULE).
+#-win32
 (with-test (:name (:timer :schedule-stress))
   (flet ((test ()
          (let* ((slow-timers