tests/timer.impure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (in-package "CL-USER")
  13
  14 (use-package :test-util)
  15
  16 (with-test (:name (:timer :relative))
  17   (let* ((has-run-p nil)
  18          (timer (make-timer (lambda () (setq has-run-p t))
  19                             :name "simple timer")))
  20     (schedule-timer timer 0.5)
  21     (sleep 0.2)
  22     (assert (not has-run-p))
  23     (sleep 0.5)
  24     (assert has-run-p)
  25     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  26
  27 (with-test (:name (:timer :absolute))
  28   (let* ((has-run-p nil)
  29          (timer (make-timer (lambda () (setq has-run-p t))
  30                             :name "simple timer")))
  31     (schedule-timer timer (+ 1/2 (get-universal-time)) :absolute-p t)
  32     (sleep 0.2)
  33     (assert (not has-run-p))
  34     (sleep 0.5)
  35     (assert has-run-p)
  36     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  37
  38 #+sb-thread
  39 (with-test (:name (:timer :other-thread))
  40   (let* ((thread (sb-thread:make-thread (lambda () (sleep 2))))
  41          (timer (make-timer (lambda ()
  42                               (assert (eq thread sb-thread:*current-thread*)))
  43                             :thread thread)))
  44     (schedule-timer timer 0.1)))
  45
  46 #+sb-thread
  47 (with-test (:name (:timer :new-thread))
  48   (let* ((original-thread sb-thread:*current-thread*)
  49          (timer (make-timer
  50                  (lambda ()
  51                    (assert (not (eq original-thread
  52                                     sb-thread:*current-thread*))))
  53                  :thread t)))
  54     (schedule-timer timer 0.1)))
  55
  56 (with-test (:name (:timer :repeat-and-unschedule))
  57   (let* ((run-count 0)
  58          timer)
  59     (setq timer
  60           (make-timer (lambda ()
  61                         (when (= 5 (incf run-count))
  62                           (unschedule-timer timer)))))
  63     (schedule-timer timer 0 :repeat-interval 0.2)
  64     (assert (timer-scheduled-p timer :delta 0.3))
  65     (sleep 1.3)
  66     (assert (= 5 run-count))
  67     (assert (not (timer-scheduled-p timer)))
  68     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  69
  70 (with-test (:name (:timer :reschedule))
  71   (let* ((has-run-p nil)
  72          (timer (make-timer (lambda ()
  73                               (setq has-run-p t)))))
  74     (schedule-timer timer 0.2)
  75     (schedule-timer timer 0.3)
  76     (sleep 0.5)
  77     (assert has-run-p)
  78     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  79
  80 (with-test (:name (:timer :stress))
  81   (let ((time (1+ (get-universal-time))))
  82     (loop repeat 200 do
  83           (schedule-timer (make-timer (lambda ())) time :absolute-p t))
  84     (sleep 2)
  85     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
  86
  87 (defmacro raises-timeout-p (&body body)
  88   `(handler-case (progn (progn ,@body) nil)
  89     (sb-ext:timeout () t)))
  90
  91 (with-test (:name (:with-timeout :timeout))
  92   (assert (raises-timeout-p
  93            (sb-ext:with-timeout 0.2
  94              (sleep 1)))))
  95
  96 (with-test (:name (:with-timeout :fall-through))
  97   (assert (not (raises-timeout-p
  98                 (sb-ext:with-timeout 0.3
  99                   (sleep 0.1))))))
 100
 101 (with-test (:name (:with-timeout :nested-timeout-smaller))
 102   (assert(raises-timeout-p
 103           (sb-ext:with-timeout 10
 104             (sb-ext:with-timeout 0.5
 105               (sleep 2))))))
 106
 107 (with-test (:name (:with-timeout :nested-timeout-bigger))
 108   (assert(raises-timeout-p
 109           (sb-ext:with-timeout 0.5
 110             (sb-ext:with-timeout 2
 111               (sleep 2))))))
 112
 113 #+sb-thread
 114 (with-test (:name (:with-timeout :many-at-the-same-time))
 115   (loop repeat 10 do
 116         (sb-thread:make-thread
 117          (lambda ()
 118            (sb-ext:with-timeout 0.5
 119              (sleep 5)
 120              (assert nil))))))