X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftimer.impure.lisp;h=41ba421ae46b7321d0185d8fcb9c0f3316e43b63;hb=0a15b6bbf9d5d3a64b5ac08bb96b6e5ec221d2ae;hp=23029cba0ec9bdf244b7b1ef645d845df60a2de3;hpb=ae09f8fd7765f6cab6ad317a13e27ff22ab0c11e;p=sbcl.git

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 23029cb..41ba421 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)
@@ -143,7 +158,16 @@
 (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*))))))
+
+(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*))))))
 
@@ -225,7 +249,11 @@
 ;;; 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 ()